| [613] | 1 | DVBAB98 ;ALB/SPH - CAPRI CONVERSION OF DVBARAD1 FOR SUPPORT ;09/06/00
 | 
|---|
 | 2 |  ;;2.7;AMIE;**35**;Apr 10, 1995
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 |  S ZX="PENSION   ",ZY="A & A     "
 | 
|---|
 | 5 |  S MSG="" F ZZ=1:1:7 S MSG=MSG_ZX
 | 
|---|
 | 6 |  S MSG1="" F ZZ=1:1:7 S MSG1=MSG1_ZY
 | 
|---|
 | 7 |  U IO K DVBAQUIT
 | 
|---|
 | 8 |  F DVBAT="PEN","A&A" W:((IOST?1"C-".E)!(IOST'?1"P-OTHER".E)) @IOF W !!!!!!!!!! D PRINT Q:$D(DVBAQUIT)
 | 
|---|
 | 9 |  G KILL
 | 
|---|
 | 10 |  ;
 | 
|---|
 | 11 | PRINTB S DATA1=$S($D(^TMP("DVBA",DVBAT,$J,XCN,XCFLOC,K,DA,"LADM")):^("LADM"),1:"") S (LADMDT,ADMDT)=$P(DATA1,U),LTDIS=$P(DATA1,U,2),DFN=DA,QUIT1=1 K DATA1 D ADM^DVBAVDPT K QUIT1,DVBAQ
 | 
|---|
 | 12 |  S LBEDSEC=BEDSEC,LDIAG=DIAG,LDCHGDT=DCHGDT,ADMDT=$P(DATA,U),RCVAA=$P(DATA,U,2),RCVPEN=$P(DATA,U,3),CNUM=$P(DATA,U,4),TDIS=$P(DATA,U,5) D ADM^DVBAVDPT
 | 
|---|
 | 13 |  S RCVPEN=$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),RCVAA=$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")
 | 
|---|
 | 14 |  W @IOF,!!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!,?(80-$L(HEADDT)\2),HEADDT,!!!
 | 
|---|
 | 15 |  S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
 | 
|---|
 | 16 |  S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
 | 
|---|
 | 17 |  S:LADMDT]"" LADMDT=$$FMTE^XLFDT(LADMDT,"5DZ")
 | 
|---|
 | 18 |  S:LDCHGDT]"" LDCHGDT=$$FMTE^XLFDT(LDCHGDT,"5DZ")
 | 
|---|
 | 19 |  S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
 | 
|---|
 | 20 |  S ZMSG(DVBABCNT)="Patient: "_PNAM_"  SSN: "_SSN_"  Claim Folder Loc: "_CFLOC,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 21 |  S ZMSG(DVBABCNT)="Claim #: "_CNUM_"  Pension: "_RCVPEN_"  A&A: "_RCVAA,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 22 |  S ZMSG(DVBABCNT)="================================================================================",DVBABCNT=DVBABCNT+1
 | 
|---|
 | 23 |  D ELIG
 | 
|---|
 | 24 |  S ZMSG(DVBABCNT)="Current Admission Data:",DVBABCNT=DVBABCNT+1
 | 
|---|
 | 25 |  S ZMSG(DVBABCNT)="-----------------------",DVBABCNT=DVBABCNT+1
 | 
|---|
 | 26 |  S ZMSG(DVBABCNT)="Admission Date:      "_ADMDT,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 27 |  S ZMSG(DVBABCNT)="Admitting Diagnosis: "_DIAG,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 28 |  S ZMSG(DVBABCNT)="Discharge Date:      "_DCHGDT,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 29 |  S ZMSG(DVBABCNT)="Discharge Type:      "_TDIS,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 30 |  S ZMSG(DVBABCNT)="Bed Service:         "_BEDSEC,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 31 |  S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
 | 
|---|
 | 32 |  S ZMSG(DVBABCNT)="Prior Admission Data:",DVBABCNT=DVBABCNT+1
 | 
|---|
 | 33 |  S ZMSG(DVBABCNT)="---------------------",DVBABCNT=DVBABCNT+1
 | 
|---|
 | 34 |  S ZMSG(DVBABCNT)="Admission Date:      "_LADMDT,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 35 |  S ZMSG(DVBABCNT)="Admitting Diagnosis: "_LDIAG,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 36 |  S ZMSG(DVBABCNT)="Discharge Date:      "_LDCHGDT,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 37 |  S ZMSG(DVBABCNT)="Discharge Type:      "_LTDIS,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 38 |  S ZMSG(DVBABCNT)="Bed Service:         "_LBEDSEC,DVBABCNT=DVBABCNT+1
 | 
|---|
 | 39 |  S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
 | 
|---|
 | 40 |  ;I IOST?1"C-".E W *7,!,"Press RETURN to continue or ""^"" to stop    " R ANS:DTIME S:ANS=U!('$T) XCN="ZZZZ" I '$T S DVBAQUIT=1
 | 
|---|
 | 41 |  Q
 | 
|---|
 | 42 |  ;
 | 
|---|
 | 43 | PRINT S NODTA=1 S (XCN,XCFLOC,ANS)=""
 | 
|---|
 | 44 |  I $D(^TMP("DVBA",DVBAT,$J)) F XLINE=1:1:5 W ?5,$S(DVBAT="PEN":MSG,DVBAT="A&A":MSG1,1:""),!!
 | 
|---|
 | 45 |  F DVBAM=0:0 S XCN=$O(^TMP("DVBA",DVBAT,$J,XCN)) Q:XCN=""  F J=0:0 S XCFLOC=$O(^TMP("DVBA",DVBAT,$J,XCN,XCFLOC)) Q:XCFLOC=""  F K=0:0 S K=$O(^TMP("DVBA",DVBAT,$J,XCN,XCFLOC,K)) Q:K=""  D PRINTC
 | 
|---|
 | 46 |  Q
 | 
|---|
 | 47 |  ;
 | 
|---|
 | 48 | PRINTC F DA=0:0 S DA=$O(^TMP("DVBA",DVBAT,$J,XCN,XCFLOC,K,DA)) Q:DA=""  S DATA=^(DA) D PRINTB
 | 
|---|
 | 49 |  Q
 | 
|---|
 | 50 |  ;
 | 
|---|
 | 51 | KILL K ^TMP("DVBA","A&A",$J),^TMP("DVBA","PEN",$J)
 | 
|---|
 | 52 |  D ^%ZISC S X=7 D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
 | 
|---|
 | 53 |  ;
 | 
|---|
 | 54 | ELIG S ELIG=DVBAELIG,INCMP=0
 | 
|---|
 | 55 |  W "Eligibility: "
 | 
|---|
 | 56 |  I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
 | 
|---|
 | 57 |  I $D(^DPT(DA,.29)),$P(^(.29),U,1)]"" S INCMP=1 ;date ruled incomp, VA
 | 
|---|
 | 58 |  I $D(^DPT(DA,.29)),$P(^(.29),U,12)=1 S INCMP=1 ;ruled incomp field
 | 
|---|
 | 59 |  W ELIG_$S(ELIG]"":", ",1:"") W:$X>60 !?14 W $S(INCMP=1:"Incompetent",1:""),!
 | 
|---|