DVBARAD1 ;RE-ADMISSION REPORT, PRINT DRIVER ; 1/23/91 7:37 AM
;;2.7;AMIE;**17**;Apr 10, 1995
;
S ZX="PENSION ",ZY="A & A "
S MSG="" F ZZ=1:1:7 S MSG=MSG_ZX
S MSG1="" F ZZ=1:1:7 S MSG1=MSG1_ZY
U IO K DVBAQUIT
F DVBAT="PEN","A&A" W:((IOST?1"C-".E)!(IOST'?1"P-OTHER".E)) @IOF W !!!!!!!!!! D PRINT Q:$D(DVBAQUIT)
G KILL
;
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
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
S RCVPEN=$S(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified"),RCVAA=$S(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")
W @IOF,!!!,?(80-$L(HEAD)\2),HEAD,!,?(80-$L(HEAD1)\2),HEAD1,!,?(80-$L(HEADDT)\2),HEADDT,!!!
S:ADMDT]"" ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
S:DCHGDT]"" DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
S:LADMDT]"" LADMDT=$$FMTE^XLFDT(LADMDT,"5DZ")
S:LDCHGDT]"" LDCHGDT=$$FMTE^XLFDT(LDCHGDT,"5DZ")
W "Patient: ",PNAM,?60,"SSN: ",SSN,!,"Claim #: ",CNUM,?56,"Pension: ",RCVPEN,!,"Claim Folder Loc: ",CFLOC,?60,"A&A: ",RCVAA,! D ELIG F LINE=1:1:80 W "="
W !?26,"------- Admission data -------",!!?18,"Current",?57,"Prior",!,?18,"-------",?57,"-----",!
W ?(25-$L(ADMDT)),ADMDT,?26,"------ Admission date ------- ",LADMDT,!
W ?(25-$L(DIAG)),$E(DIAG,1,26),?26,"---- Admitting diagnosis ---- ",$E(LDIAG,1,23),!
W ?(25-$L(DCHGDT)),DCHGDT,?26,"------- Discharge date ------- ",LDCHGDT,!
W ?(25-$L(TDIS)),$E(TDIS,1,26),?26,"------- Discharge type ------- ",$E(LTDIS,1,23),!
W ?(25-$L(BEDSEC)),BEDSEC,?26,"-------- Bed Service --------- ",LBEDSEC,!
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
Q
;
PRINT S NODTA=1 S (XCN,XCFLOC,ANS)=""
I $D(^TMP("DVBA",DVBAT,$J)) F XLINE=1:1:5 W ?5,$S(DVBAT="PEN":MSG,DVBAT="A&A":MSG1,1:""),!!
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
Q
;
PRINTC F DA=0:0 S DA=$O(^TMP("DVBA",DVBAT,$J,XCN,XCFLOC,K,DA)) Q:DA="" S DATA=^(DA) D PRINTB
Q
;
KILL K ^TMP("DVBA","A&A",$J),^TMP("DVBA","PEN",$J)
D ^%ZISC S X=7 D:$D(ZTQUEUED) KILL^%ZTLOAD G FINAL^DVBAUTIL
;
ELIG S ELIG=DVBAELIG,INCMP=0
W "Eligibility: "
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)),$P(^(.29),U,1)]"" S INCMP=1 ;date ruled incomp, VA
I $D(^DPT(DA,.29)),$P(^(.29),U,12)=1 S INCMP=1 ;ruled incomp field
W ELIG_$S(ELIG]"":", ",1:"") W:$X>60 !?14 W $S(INCMP=1:"Incompetent",1:""),!
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBARAD1 2833 printed Apr 09, 2024@20:46:11 Page 2
DVBARAD1 ;RE-ADMISSION REPORT, PRINT DRIVER ; 1/23/91 7:37 AM
+1 ;;2.7;AMIE;**17**;Apr 10, 1995
+2 ;
+3 SET ZX="PENSION "
SET ZY="A & A "
+4 SET MSG=""
FOR ZZ=1:1:7
SET MSG=MSG_ZX
+5 SET MSG1=""
FOR ZZ=1:1:7
SET MSG1=MSG1_ZY
+6 USE IO
KILL DVBAQUIT
+7 FOR DVBAT="PEN","A&A"
if ((IOST?1"C-".E)!(IOST'?1"P-OTHER".E))
WRITE @IOF
WRITE !!!!!!!!!!
DO PRINT
if $DATA(DVBAQUIT)
QUIT
+8 GOTO KILL
+9 ;
PRINTB SET DATA1=$SELECT($DATA(^TMP("DVBA",DVBAT,$JOB,XCN,XCFLOC,K,DA,"LADM")):^("LADM"),1:"")
SET (LADMDT,ADMDT)=$PIECE(DATA1,U)
SET LTDIS=$PIECE(DATA1,U,2)
SET DFN=DA
SET QUIT1=1
KILL DATA1
DO ADM^DVBAVDPT
KILL QUIT1,DVBAQ
+1 SET LBEDSEC=BEDSEC
SET LDIAG=DIAG
SET LDCHGDT=DCHGDT
SET ADMDT=$PIECE(DATA,U)
SET RCVAA=$PIECE(DATA,U,2)
SET RCVPEN=$PIECE(DATA,U,3)
SET CNUM=$PIECE(DATA,U,4)
SET TDIS=$PIECE(DATA,U,5)
DO ADM^DVBAVDPT
+2 SET RCVPEN=$SELECT(RCVPEN=0:"NO",RCVPEN=1:"YES",1:"Not specified")
SET RCVAA=$SELECT(RCVAA=0:"NO",RCVAA=1:"YES",1:"Not specified")
+3 WRITE @IOF,!!!,?(80-$LENGTH(HEAD)\2),HEAD,!,?(80-$LENGTH(HEAD1)\2),HEAD1,!,?(80-$LENGTH(HEADDT)\2),HEADDT,!!!
+4 if ADMDT]""
SET ADMDT=$$FMTE^XLFDT(ADMDT,"5DZ")
+5 if DCHGDT]""
SET DCHGDT=$$FMTE^XLFDT(DCHGDT,"5DZ")
+6 if LADMDT]""
SET LADMDT=$$FMTE^XLFDT(LADMDT,"5DZ")
+7 if LDCHGDT]""
SET LDCHGDT=$$FMTE^XLFDT(LDCHGDT,"5DZ")
+8 WRITE "Patient: ",PNAM,?60,"SSN: ",SSN,!,"Claim #: ",CNUM,?56,"Pension: ",RCVPEN,!,"Claim Folder Loc: ",CFLOC,?60,"A&A: ",RCVAA,!
DO ELIG
FOR LINE=1:1:80
WRITE "="
+9 WRITE !?26,"------- Admission data -------",!!?18,"Current",?57,"Prior",!,?18,"-------",?57,"-----",!
+10 WRITE ?(25-$LENGTH(ADMDT)),ADMDT,?26,"------ Admission date ------- ",LADMDT,!
+11 WRITE ?(25-$LENGTH(DIAG)),$EXTRACT(DIAG,1,26),?26,"---- Admitting diagnosis ---- ",$EXTRACT(LDIAG,1,23),!
+12 WRITE ?(25-$LENGTH(DCHGDT)),DCHGDT,?26,"------- Discharge date ------- ",LDCHGDT,!
+13 WRITE ?(25-$LENGTH(TDIS)),$EXTRACT(TDIS,1,26),?26,"------- Discharge type ------- ",$EXTRACT(LTDIS,1,23),!
+14 WRITE ?(25-$LENGTH(BEDSEC)),BEDSEC,?26,"-------- Bed Service --------- ",LBEDSEC,!
+15 IF IOST?1"C-".E
WRITE *7,!,"Press RETURN to continue or ""^"" to stop "
READ ANS:DTIME
if ANS=U!('$TEST)
SET XCN="ZZZZ"
IF '$TEST
SET DVBAQUIT=1
+16 QUIT
+17 ;
PRINT SET NODTA=1
SET (XCN,XCFLOC,ANS)=""
+1 IF $DATA(^TMP("DVBA",DVBAT,$JOB))
FOR XLINE=1:1:5
WRITE ?5,$SELECT(DVBAT="PEN":MSG,DVBAT="A&A":MSG1,1:""),!!
+2 FOR DVBAM=0:0
SET XCN=$ORDER(^TMP("DVBA",DVBAT,$JOB,XCN))
if XCN=""
QUIT
FOR J=0:0
SET XCFLOC=$ORDER(^TMP("DVBA",DVBAT,$JOB,XCN,XCFLOC))
if XCFLOC=""
QUIT
FOR K=0:0
SET K=$ORDER(^TMP("DVBA",DVBAT,$JOB,XCN,XCFLOC,K))
if K=""
QUIT
DO PRINTC
+3 QUIT
+4 ;
PRINTC FOR DA=0:0
SET DA=$ORDER(^TMP("DVBA",DVBAT,$JOB,XCN,XCFLOC,K,DA))
if DA=""
QUIT
SET DATA=^(DA)
DO PRINTB
+1 QUIT
+2 ;
KILL KILL ^TMP("DVBA","A&A",$JOB),^TMP("DVBA","PEN",$JOB)
+1 DO ^%ZISC
SET X=7
if $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
GOTO FINAL^DVBAUTIL
+2 ;
ELIG SET ELIG=DVBAELIG
SET INCMP=0
+1 WRITE "Eligibility: "
+2 IF ELIG]""
SET ELIG=ELIG_" ("_$SELECT(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
+3 ;date ruled incomp, VA
IF $DATA(^DPT(DA,.29))
IF $PIECE(^(.29),U,1)]""
SET INCMP=1
+4 ;ruled incomp field
IF $DATA(^DPT(DA,.29))
IF $PIECE(^(.29),U,12)=1
SET INCMP=1
+5 WRITE ELIG_$SELECT(ELIG]"":", ",1:"")
if $X>60
WRITE !?14
WRITE $SELECT(INCMP=1:"Incompetent",1:""),!
