Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBAB52

DVBAB52.m

Go to the documentation of this file.
DVBAB52 ;ALB/SPH - CAPRI ADMISSION INQ BY DATE ;09/01/00
 ;;2.7;AMIE;**35**;Apr 10, 1995
 ;
STRT(ZMSG,BDATE,EDATE) ;
 S DVBABCNT=0
 K ^TMP($J) G TERM
SET Q:$D(^DPT(DA,0))  S DFN=DA D RCV^DVBAVDPT Q:CFLOC'=RONUM&(RO="Y")&(CFLOC'=0)&(CFLOC'=376)
 S ^TMP($J,XCN,CFLOC,MB,DA)=MA_U_RCVAA_U_RCVPEN_U_CNUM
 Q
 ;
PRINTB S MA=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),DFN=DA,QUIT1=1 D ADM^DVBAVDPT
 S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
 S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
 W:(IOST?1"C-".E!($D(DVBAON2))) @IOF
 S ZMSG(DVBABCNT)=""  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)=""  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="          Patient Name:    "_PNAM  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="              Claim No:    "_CNUM  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="      Claim Folder Loc:    "_CFLOC  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="         Social Sec No:    "_SSN  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="        Admission Date:    "_ADMDT  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="   Admitting Diagnosis:    "_DIAG  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="        Discharge Date:    "_DCHGDT  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="           Bed Service:    "_BEDSEC  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="             Recv A&A?:    "_$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")  S DVBABCNT=DVBABCNT+1
 S ZMSG(DVBABCNT)="              Pension?:    "_$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")  S DVBABCNT=DVBABCNT+1
 ;
 ;ELIG INFO...
 S ELIG=DVBAELIG,INCMP=""
 I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
 I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
 S ZMSG(DVBABCNT)="       Eligibility data:   "_ELIG_$S(ELIG]"":", ",1:"")
 S DVBABCNT=DVBABCNT+1
 W:$X>60 !?26 S ZMSG(DVBABCNT)=INCMP  S DVBABCNT=DVBABCNT+1
 Q
 ;END OF ELIG INFO
 ;
PRINT U IO S QUIT="" K MA,MB
 S XCN="" F M=0:0 S XCN=$O(^TMP($J,XCN)) Q:XCN=""!(QUIT=1)  S CFLOC="" F J=0:0 S CFLOC=$O(^TMP($J,XCN,CFLOC)) Q:CFLOC=""!(QUIT=1)  D PRINT1
 Q
PRINT1 S ADM="" F K=0:0 S ADM=$O(^TMP($J,XCN,CFLOC,ADM)) Q:ADM=""!(QUIT=1)  S DA="" F L=0:0 S DA=$O(^TMP($J,XCN,CFLOC,ADM,DA)) Q:DA=""!(QUIT=1)  S DATA=^(DA) D PRINTB
 Q
 ;
TERM ;
SETUP ;
EN1 ;
QUEUE ;
 S RO="N"
 S RONUM=0
 S HEAD=""
 S HEAD1=""
GO S MA=BDATE F J=0:0 S MA=$O(^DGPM("AMV1",MA)) Q:$P(MA,".")>EDATE!(MA="")  W:'$D(NOASK) "." F DA=0:0 S DA=$O(^DGPM("AMV1",MA,DA)) Q:DA=""  F MB=0:0 S MB=$O(^DGPM("AMV1",MA,DA,MB)) Q:MB=""  I MA'>EDATE D SET
 I '$D(^TMP($J)) U IO W !!,*7,"No data found for parameters entered.",!! H 2 G KILL
 I $D(^TMP($J)) D PRINT I $D(DVBAQUIT) K DVBAON2,DCHPTR,M,Y,J G KILL^DVBAUTIL
 ;
KILL D ^%ZISC S X=3 K DVBAON2,DCHPTR,M,Y,J D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
 ;
DEQUE K ^TMP($J) G GO