- 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
