DGBTOA3 ;ALB/TT,ALB/MAC - BENEFICIARY TRAVEL OUTPUTS PR ROUTINE ;4/4/91 15:29
;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
;Loops thru ^Utility
PR Q:'$D(^UTILITY($J)) S (DGBTDN,DGBTF,DGBTX,DGBTS,DGBTSD,DGBTDD,DGBT3,DGBTCH,DGBTSDT,DGBTAT,DGBTGT,DGBTP,DGBTSSN,DGBTD1,DGBTPG,SSN)=0
F K1=0:0 S DGBTDN=$O(^UTILITY($J,1,DGBTDN)) Q:DGBTDN=""!(DGBTU) D NO S:DGBTZ="T" DGBTPG=0 D:DGBTZ="T" SM^DGBTOA4 D:DGBTF TT,RT Q:DGBTU D:DGBTZ="T"&(DGBT3) RT Q:DGBTU D HE^DGBTOA4 D PRA:DGBTSL'="PAT",PRP:DGBTSL="PAT"
Q:DGBTU D:DGBTZ="F" TT D:DGBTZ="T" SM^DGBTOA4 D RT Q
PRA F L1=0:0 S DGBTX=$O(^UTILITY($J,1,DGBTDN,DGBTX)) Q:DGBTX=""!(DGBTU) S DGBTX1=DGBTX D:DGBTF&(DGBTZ="F") TOT D:DGBTZ="T" TTT,RP Q:DGBTU D AC
Q
;For patients
PRP F L1=0:0 S DGBTX=$O(^UTILITY($J,1,DGBTDN,DGBTX)) Q:DGBTX=""!(DGBTU) S DGBTX1=DGBTX Q:DGBTU D PRP1
Q
PRP1 F M1=0:0 S SSN=$O(^UTILITY($J,1,DGBTDN,DGBTX,SSN)) D:DGBTF&(DGBTZ="F")&(SSN>"") TOT Q:SSN=""!(DGBTU) D:DGBTZ="T" TTT,RP F DGBTD=0:0 S DGBTD=$O(^UTILITY($J,1,DGBTDN,DGBTX,SSN,DGBTD)) Q:DGBTD=""!(DGBTU) D PR3
Q
;For account, account type and carrier
AC F M=0:0 S DGBTP=$O(^UTILITY($J,1,DGBTDN,DGBTX,DGBTP)) Q:DGBTP=""!(DGBTU) F M1=0:0 S SSN=$O(^UTILITY($J,1,DGBTDN,DGBTX,DGBTP,SSN)) Q:SSN=""!(DGBTU) D AC1
Q
AC1 F DGBTD=0:0 S DGBTD=$O(^UTILITY($J,1,DGBTDN,DGBTX,DGBTP,SSN,DGBTD)) Q:DGBTD=""!(DGBTU) D PR3
Q
PR3 D:DGBTZ="F" RP Q:DGBTU S DGBTNO=$S(DGBTSL="PAT":^UTILITY($J,1,DGBTDN,DGBTX,SSN,DGBTD),1:^UTILITY($J,1,DGBTDN,DGBTX,DGBTP,SSN,DGBTD))
I DGBTSL="PAT" D:DGBTSSN'=SSN!(DGBTDN'=DGBTDD)!(DGBTS) HDR
I DGBTSL'="PAT" D:DGBTX'=DGBTG!(DGBTDN'=DGBTDD)!(DGBT2) HDR
S DGBTSSN=SSN,DGBTDD=DGBTDN,DGBTODV=DGBTDV,DGBT2=0 D DAT I DGBTZ="F" D PATP:DGBTSL="PAT",ACCTP:DGBTSL'="PAT"
Q
;Prints patient entries
PATP K X2 W !?2,X,?23,$P(DGBTNO,"^",4),?38 K X S X=$P(DGBTNO,"^",6) D CM W X,?52 S X=$P(DGBTNO,"^",2) D CM W X,?63,$E($P(DGBTNO,"^",5),1,16) Q
;Print for account, account type and carrier entries
ACCTP S DGSCR=X K X2 W !?2,$E($P(DGBTNO,"^",1),1,15),?19,SSN,?32,DGSCR,?45 K X,DGSCR S X=$P(DGBTNO,"^",6) D CM W X,?54 S X=$P(DGBTNO,"^",2) D CM W X,?65,$S(DGBTSL="CAR":$E($P(DGBTNO,"^",4),1,11),1:$E($P(DGBTNO,"^",5),1,11)) Q
DAT S VADAT("W")=DGBTD D ^VADATE S X=$P(VADATE("E"),"@",1) Q
RT Q:$Y=0 Q:DGBTU Q:IOST'?1"C-".E F X=$Y:1:(IOSL-2) W !
S DIR("A",1)="",DIR("A")="Enter <RET> to continue or ^ to QUIT ",DIR(0)="FO" D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) DGBTU=1 Q:DGBTU W:DGBTZ="T" @IOF Q
RP I $Y+6>IOSL D RT:(IOST?1"C-".E) Q:DGBTU D HE^DGBTOA4 D:DGBTX=DGBTG HDR
Q
HDR I DGBTZ="F" S DGBTXX=$S(DGBTSL="ACCT"!(DGBTSL="TYP"):DGBTX_":",DGBTSL="PAT":$P(DGBTNO,"^",1)_":"_SSN,1:$P(DGBTNO,"^",5)_":"_$P(DGBTNO,"^",3)),DGBTG=DGBTX W !,DGBTXX S DGBTF=1
Q
;Totals at end of divisions
TT I $Y+6>IOSL S DGBT2=1 D RT Q:DGBTU S:DGBTX="" DGBTD1=1 D HE^DGBTOA4,DTC^DGBTOA4 D:DGBTDD'=DGBTDN!(('VAUTD)&'$D(VAUTD(+DGBTDN))) SM^DGBTOA4 S (DGBTF,DGBTAT,DGBTSDT,DGBTGT,DGBTD1,DGBTPG)=0 S:DGBTDN="" DGBTF=1 Q
I DGBTZ="F" D DTC^DGBTOA4 D:DGBTDD'=DGBTDN SM^DGBTOA4 S (DGBTF,DGBTAT,DGBTGT,DGBTSDT,DGBTD1,DGBTPG)=0 I DGBTDN="" S DGBTF=1
Q
;Individual totals
TOT S DGBTOD=$S(DGBTSL="PAT":^UTILITY($J,2,DGBTDD,DGBTG,DGBTSSN,"T"),1:^UTILITY($J,2,DGBTDD,DGBTG,"T")) D RP Q:DGBTU W:DGBTSL="PAT" !?32,"TOTAL",?38 W:DGBTSL'="PAT" !?35,"TOTAL",?45
K X S X2="2$",X=$P(DGBTOD,"^",2),DGBTSDT=DGBTSDT+X D CM W X,?52 S X2="2$",X=$P(DGBTOD,"^",1),DGBTAT=DGBTAT+X D CM W X K X2 S DGBTGT(DGBTDV)=DGBTAT_"^"_DGBTSDT Q
;Totals for only totals report
TTT D RP Q:DGBTU D DTC^DGBTOA4 S DGBT3=1 Q
CM D COMMA^%DTC Q
NO S DGBTDV=$S('$D(^DG(40.8,DGBTDN,0)):"UNKNOWN",1:$P(^DG(40.8,DGBTDN,0),"^")) S:DGBTDV']"" DGBTDV="UNKNOWN" Q
DGBTOA3 ;ALB/TT,ALB/MAC - BENEFICIARY TRAVEL OUTPUTS PR ROUTINE ;4/4/91 15:29
+1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
+2 ;Loops thru ^Utility
PR IF '$DATA(^UTILITY($JOB))
QUIT
SET (DGBTDN,DGBTF,DGBTX,DGBTS,DGBTSD,DGBTDD,DGBT3,DGBTCH,DGBTSDT,DGBTAT,DGBTGT,DGBTP,DGBTSSN,DGBTD1,DGBTPG,SSN)=0
+1 FOR K1=0:0
SET DGBTDN=$ORDER(^UTILITY($JOB,1,DGBTDN))
IF DGBTDN=""!(DGBTU)
QUIT
DO NO
IF DGBTZ="T"
SET DGBTPG=0
IF DGBTZ="T"
DO SM^DGBTOA4
IF DGBTF
DO TT
DO RT
IF DGBTU
QUIT
IF DGBTZ="T"&(DGBT3)
DO RT
IF DGBTU
QUIT
DO HE^DGBTOA4
IF DGBTSL'="PAT"
DO PRA
IF DGBTSL="PAT"
DO PRP
+2 IF DGBTU
QUIT
IF DGBTZ="F"
DO TT
IF DGBTZ="T"
DO SM^DGBTOA4
DO RT
QUIT
PRA FOR L1=0:0
SET DGBTX=$ORDER(^UTILITY($JOB,1,DGBTDN,DGBTX))
IF DGBTX=""!(DGBTU)
QUIT
SET DGBTX1=DGBTX
IF DGBTF&(DGBTZ="F")
DO TOT
IF DGBTZ="T"
DO TTT
DO RP
IF DGBTU
QUIT
DO AC
+1 QUIT
+2 ;For patients
PRP FOR L1=0:0
SET DGBTX=$ORDER(^UTILITY($JOB,1,DGBTDN,DGBTX))
IF DGBTX=""!(DGBTU)
QUIT
SET DGBTX1=DGBTX
IF DGBTU
QUIT
DO PRP1
+1 QUIT
PRP1 FOR M1=0:0
SET SSN=$ORDER(^UTILITY($JOB,1,DGBTDN,DGBTX,SSN))
IF DGBTF&(DGBTZ="F")&(SSN>"")
DO TOT
IF SSN=""!(DGBTU)
QUIT
IF DGBTZ="T"
DO TTT
DO RP
FOR DGBTD=0:0
SET DGBTD=$ORDER(^UTILITY($JOB,1,DGBTDN,DGBTX,SSN,DGBTD))
IF DGBTD=""!(DGBTU)
QUIT
DO PR3
+1 QUIT
+2 ;For account, account type and carrier
AC FOR M=0:0
SET DGBTP=$ORDER(^UTILITY($JOB,1,DGBTDN,DGBTX,DGBTP))
IF DGBTP=""!(DGBTU)
QUIT
FOR M1=0:0
SET SSN=$ORDER(^UTILITY($JOB,1,DGBTDN,DGBTX,DGBTP,SSN))
IF SSN=""!(DGBTU)
QUIT
DO AC1
+1 QUIT
AC1 FOR DGBTD=0:0
SET DGBTD=$ORDER(^UTILITY($JOB,1,DGBTDN,DGBTX,DGBTP,SSN,DGBTD))
IF DGBTD=""!(DGBTU)
QUIT
DO PR3
+1 QUIT
PR3 IF DGBTZ="F"
DO RP
IF DGBTU
QUIT
SET DGBTNO=$SELECT(DGBTSL="PAT":^UTILITY($JOB,1,DGBTDN,DGBTX,SSN,DGBTD),1:^UTILITY($JOB,1,DGBTDN,DGBTX,DGBTP,SSN,DGBTD))
+1 IF DGBTSL="PAT"
IF DGBTSSN'=SSN!(DGBTDN'=DGBTDD)!(DGBTS)
DO HDR
+2 IF DGBTSL'="PAT"
IF DGBTX'=DGBTG!(DGBTDN'=DGBTDD)!(DGBT2)
DO HDR
+3 SET DGBTSSN=SSN
SET DGBTDD=DGBTDN
SET DGBTODV=DGBTDV
SET DGBT2=0
DO DAT
IF DGBTZ="F"
IF DGBTSL="PAT"
DO PATP
IF DGBTSL'="PAT"
DO ACCTP
+4 QUIT
+5 ;Prints patient entries
PATP KILL X2
WRITE !?2,X,?23,$PIECE(DGBTNO,"^",4),?38
KILL X
SET X=$PIECE(DGBTNO,"^",6)
DO CM
WRITE X,?52
SET X=$PIECE(DGBTNO,"^",2)
DO CM
WRITE X,?63,$EXTRACT($PIECE(DGBTNO,"^",5),1,16)
QUIT
+1 ;Print for account, account type and carrier entries
ACCTP SET DGSCR=X
KILL X2
WRITE !?2,$EXTRACT($PIECE(DGBTNO,"^",1),1,15),?19,SSN,?32,DGSCR,?45
KILL X,DGSCR
SET X=$PIECE(DGBTNO,"^",6)
DO CM
WRITE X,?54
SET X=$PIECE(DGBTNO,"^",2)
DO CM
WRITE X,?65,$SELECT(DGBTSL="CAR":$EXTRACT($PIECE(DGBTNO,"^",4),1,11),1:$EXTRACT($PIECE(DGBTNO,"^",5),1,11))
QUIT
DAT SET VADAT("W")=DGBTD
DO ^VADATE
SET X=$PIECE(VADATE("E"),"@",1)
QUIT
RT IF $Y=0
QUIT
IF DGBTU
QUIT
IF IOST'?1"C-".E
QUIT
FOR X=$Y:1:(IOSL-2)
WRITE !
+1 SET DIR("A",1)=""
SET DIR("A")="Enter <RET> to continue or ^ to QUIT "
SET DIR(0)="FO"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET DGBTU=1
IF DGBTU
QUIT
IF DGBTZ="T"
WRITE @IOF
QUIT
RP IF $Y+6>IOSL
IF (IOST?1"C-".E)
DO RT
IF DGBTU
QUIT
DO HE^DGBTOA4
IF DGBTX=DGBTG
DO HDR
+1 QUIT
HDR IF DGBTZ="F"
SET DGBTXX=$SELECT(DGBTSL="ACCT"!(DGBTSL="TYP"):DGBTX_":",DGBTSL="PAT":$PIECE(DGBTNO,"^",1)_":"_SSN,1:$PIECE(DGBTNO,"^",5)_":"_$PIECE(DGBTNO,"^",3))
SET DGBTG=DGBTX
WRITE !,DGBTXX
SET DGBTF=1
+1 QUIT
+2 ;Totals at end of divisions
TT IF $Y+6>IOSL
SET DGBT2=1
DO RT
IF DGBTU
QUIT
IF DGBTX=""
SET DGBTD1=1
DO HE^DGBTOA4
DO DTC^DGBTOA4
IF DGBTDD'=DGBTDN!(('VAUTD)&'$DATA(VAUTD(+DGBTDN)))
DO SM^DGBTOA4
SET (DGBTF,DGBTAT,DGBTSDT,DGBTGT,DGBTD1,DGBTPG)=0
IF DGBTDN=""
SET DGBTF=1
QUIT
+1 IF DGBTZ="F"
DO DTC^DGBTOA4
IF DGBTDD'=DGBTDN
DO SM^DGBTOA4
SET (DGBTF,DGBTAT,DGBTGT,DGBTSDT,DGBTD1,DGBTPG)=0
IF DGBTDN=""
SET DGBTF=1
+2 QUIT
+3 ;Individual totals
TOT SET DGBTOD=$SELECT(DGBTSL="PAT":^UTILITY($JOB,2,DGBTDD,DGBTG,DGBTSSN,"T"),1:^UTILITY($JOB,2,DGBTDD,DGBTG,"T"))
DO RP
IF DGBTU
QUIT
IF DGBTSL="PAT"
WRITE !?32,"TOTAL",?38
IF DGBTSL'="PAT"
WRITE !?35,"TOTAL",?45
+1 KILL X
SET X2="2$"
SET X=$PIECE(DGBTOD,"^",2)
SET DGBTSDT=DGBTSDT+X
DO CM
WRITE X,?52
SET X2="2$"
SET X=$PIECE(DGBTOD,"^",1)
SET DGBTAT=DGBTAT+X
DO CM
WRITE X
KILL X2
SET DGBTGT(DGBTDV)=DGBTAT_"^"_DGBTSDT
QUIT
+2 ;Totals for only totals report
TTT DO RP
IF DGBTU
QUIT
DO DTC^DGBTOA4
SET DGBT3=1
QUIT
CM DO COMMA^%DTC
QUIT
NO SET DGBTDV=$SELECT('$DATA(^DG(40.8,DGBTDN,0)):"UNKNOWN",1:$PIECE(^DG(40.8,DGBTDN,0),"^"))
IF DGBTDV']""
SET DGBTDV="UNKNOWN"
QUIT
