- DGBTOA4 ;ALB/MAC - BENEFICIARY OUTPUTS HEADER ROUTINE ;2/21/91 15:57
- ;;1.0;Beneficiary Travel;**7**;September 25, 2001
- ;Adds up totals
- DTC K X,X2 I DGBTSL="PAT" S:DGBTZ="T" DGBTSSN=SSN I DGBTSL="PAT" S DGBTOD=$S(DGBTZ="F":^UTILITY($J,2,DGBTDD,DGBTX1,DGBTSSN,"T"),1:^UTILITY($J,2,DGBTDN,DGBTX,DGBTSSN,"T"))
- I DGBTSL'="PAT" S DGBTOD=$S(DGBTZ="F":^UTILITY($J,2,DGBTDD,DGBTX1,"T"),1:^UTILITY($J,2,DGBTDN,DGBTX,"T"))
- W ! I DGBTZ="T" W DGBTX,?32
- I DGBTZ="F" W:DGBTSL'="PAT" !?35,"TOTAL",?45 W:DGBTSL="PAT" !?32,"TOTAL",?38
- S:DGBTZ="F" X2="2$" S X=$P(DGBTOD,"^",2) S DGBTSDT=DGBTSDT+X D CM W X W:DGBTZ="T" ?46 I DGBTZ="F" W:DGBTSL="PAT" ?52 W:DGBTSL'="PAT" ?57
- S:DGBTZ="F" X2="2$" S X=$P(DGBTOD,"^",1) S DGBTAT=DGBTAT+X D CM W X
- I DGBTZ="T" S X=$P(DGBTOD,"^",1)+$P(DGBTOD,"^",2) S DGBTGT=DGBTGT+X D CM W ?60,X W:DGBTSL'="PAT" ?76,$J(DGBTOTX(DGBTDN,DGBTX1),4) S DGBTGT(DGBTDV)=DGBTAT_"^"_DGBTSDT Q
- S DGBTGT(DGBTODV)=DGBTAT_"^"_DGBTSDT Q
- ;Prints page headings
- HE S DGBTPG=DGBTPG+1
- W @IOF W:'DGBT4 !?3,"DIVISION: ",$S(DGBTDV="ZNOT SPECIFIED":"NOT SPECIFIED",DGBTD1:DGBTODV,1:DGBTDV) W ?50,DGBTDT," PAGE ",DGBTPG
- S X="BENEFICIARY TRAVEL OUTPUT "_"BY "_$S(DGBTSL="CAR":"CARRIER",DGBTSL="ACCT":"ACCOUNT",DGBTSL="TYP":"ACCOUNT TYPE",1:"PATIENT")
- W !?(40-($L(X)/2)),X I DGBTZ="T" W !?32,"DIVISION TOTALS"
- S DGBTBG=DGBTBEG+.0001,DGBTT=$S(DGBTBG=(DGBTEND\1):"FOR ",1:"FROM "),VADAT("W")=DGBTBG D ^VADATE S DGBTT=DGBTT_$P(VADATE("E"),"@",1) I DGBTEND\1'=DGBTBG S VADAT("W")=DGBTEND\1 D ^VADATE S DGBTT=DGBTT_" TO "_$P(VADATE("E"),"@",1)
- S DGBTY=40-($L(DGBTT)/2) W !?DGBTY,DGBTT,!
- W ! I DGBTSL="PAT" W:DGBTZ="F" ?7,"DATE",?25,"ACCOUNT",?43
- I DGBTSL'="PAT" W:DGBTZ="F" ?7,"NAME",?22,"PT ID",?35,"DATE",?50
- I DGBTZ="T" W:DGBT4 ?5 W:'DGBT4 ?10 W $S(DGBT4:"DIVISION NAME",DGBTSL="PAT":"NAME",DGBTSL="CAR":"CARRIER",1:"ACCOUNT")
- I DGBTZ="F" W "$DEDUC" W:DGBTSL="PAT" ?55 W:DGBTSL'="PAT" ?60 W "$PAYABLE" W:DGBTZ="F" ?70,$S(DGBTSL="CAR":"ACCOUNT",1:"CARRIER") W !,DGBTCL,! Q
- W ?37,"$DEDUC",?49,"$PAYABLE",?65,"$TOTAL" W:DGBTSL'="PAT" ?75,"# PAT" W !,DGBTCL Q
- RT Q:$Y=0 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 D:DGBTX=DGBTG HDR S DGBTF=1
- Q
- HDR I DGBTZ="F" S DGBTXX=$S(DGBTSL="ACCT":DGBTX_":",DGBTSL="PAT":$P(DGBTNO,"^",1)_":"_SSN,1:$P(DGBTNO,"^",5)_":"_$P(DGBTNO,"^",3)),DGBTG=DGBTX W !,DGBTXX S DGBTF=1
- Q
- ;prints total for divisions
- SM I DGBTZ="T" Q:'DGBT3
- I DGBTZ="F" Q:'DGBTF
- S:DGBTX="" DGBTD1=1 D RP Q:DGBTU S DGBTD1=0 W !! W:DGBTZ="T" ?3 W:DGBTZ="F" ?10 W "DIVISION TOTAL" S X=DGBTSDT,X2="2$" D CM W:DGBTZ="T" ?32,X I DGBTZ="F" W:DGBTSL="PAT" ?38 W:DGBTSL'="PAT" ?45 W X
- S X=DGBTAT,X2="2$" D CM W:DGBTZ="T" ?46,X I DGBTZ="F" W:DGBTSL="PAT" ?52 W:DGBTSL'="PAT" ?57 W X
- I DGBTZ="T" S X=DGBTGT,X2="2$" D CM W ?60,X I DGBTSL'="PAT" W ?76,$J(DGBTPTC(DGBTODV),4)
- S (DGBTAT,DGBTSDT,DGBTGT,DGBTPTC)=0 Q
- ;Prints total page plus grand total.
- TOTAL S DGBTZ="T",DGBT4=1,DGBTPG=0 D HE S (DGBTDV,DGBTC)=0 F X=0:0 S DGBTDV=$O(DGBTGT(DGBTDV)) Q:DGBTDV="" D:DGBT3 RP Q:DGBTU D CON
- D RP Q:DGBTU W !!?12,"GRAND TOTAL",?32 S X2="2$",X=DGBTSDT D CM W X S X2="2$",X=DGBTAT D CM W ?46,X S X2="2$",X=DGBTGT D CM W ?60,X I DGBTSL'="PAT" W ?74,$J(DGBTPTC,6)
- Q
- CON S:DGBTSL'="PAT" DGBTPTC=DGBTPTC+DGBTPTC(DGBTDV) W !,$S(DGBTDV="ZNOT SPECIFIED":"NOT SPECIFIED",1:$E(DGBTDV,1,30)),?32 S X2="2$",X=$P(DGBTGT(DGBTDV),"^",2),DGBTSDT=DGBTSDT+X D CM W X
- S X2="2$",X=$P(DGBTGT(DGBTDV),"^",1),DGBTAT=DGBTAT+X D CM W ?46,X S X2="2$",X=$P(DGBTGT(DGBTDV),"^",1)+$P(DGBTGT(DGBTDV),"^",2),DGBTGT=DGBTGT+X D CM W ?60,X I DGBTSL'="PAT" W ?74,$J(DGBTPTC(DGBTDV),6)
- S DGBT3=1 D:$O(DGBTGT(DGBTDV))'="" RP
- Q
- CM N X3 D COMMA^%DTC Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTOA4 3847 printed Jan 18, 2025@02:42:06 Page 2
- DGBTOA4 ;ALB/MAC - BENEFICIARY OUTPUTS HEADER ROUTINE ;2/21/91 15:57
- +1 ;;1.0;Beneficiary Travel;**7**;September 25, 2001
- +2 ;Adds up totals
- DTC KILL X,X2
- IF DGBTSL="PAT"
- if DGBTZ="T"
- SET DGBTSSN=SSN
- IF DGBTSL="PAT"
- SET DGBTOD=$SELECT(DGBTZ="F":^UTILITY($JOB,2,DGBTDD,DGBTX1,DGBTSSN,"T"),1:^UTILITY($JOB,2,DGBTDN,DGBTX,DGBTSSN,"T"))
- +1 IF DGBTSL'="PAT"
- SET DGBTOD=$SELECT(DGBTZ="F":^UTILITY($JOB,2,DGBTDD,DGBTX1,"T"),1:^UTILITY($JOB,2,DGBTDN,DGBTX,"T"))
- +2 WRITE !
- IF DGBTZ="T"
- WRITE DGBTX,?32
- +3 IF DGBTZ="F"
- if DGBTSL'="PAT"
- WRITE !?35,"TOTAL",?45
- if DGBTSL="PAT"
- WRITE !?32,"TOTAL",?38
- +4 if DGBTZ="F"
- SET X2="2$"
- SET X=$PIECE(DGBTOD,"^",2)
- SET DGBTSDT=DGBTSDT+X
- DO CM
- WRITE X
- if DGBTZ="T"
- WRITE ?46
- IF DGBTZ="F"
- if DGBTSL="PAT"
- WRITE ?52
- if DGBTSL'="PAT"
- WRITE ?57
- +5 if DGBTZ="F"
- SET X2="2$"
- SET X=$PIECE(DGBTOD,"^",1)
- SET DGBTAT=DGBTAT+X
- DO CM
- WRITE X
- +6 IF DGBTZ="T"
- SET X=$PIECE(DGBTOD,"^",1)+$PIECE(DGBTOD,"^",2)
- SET DGBTGT=DGBTGT+X
- DO CM
- WRITE ?60,X
- if DGBTSL'="PAT"
- WRITE ?76,$JUSTIFY(DGBTOTX(DGBTDN,DGBTX1),4)
- SET DGBTGT(DGBTDV)=DGBTAT_"^"_DGBTSDT
- QUIT
- +7 SET DGBTGT(DGBTODV)=DGBTAT_"^"_DGBTSDT
- QUIT
- +8 ;Prints page headings
- HE SET DGBTPG=DGBTPG+1
- +1 WRITE @IOF
- if 'DGBT4
- WRITE !?3,"DIVISION: ",$SELECT(DGBTDV="ZNOT SPECIFIED":"NOT SPECIFIED",DGBTD1:DGBTODV,1:DGBTDV)
- WRITE ?50,DGBTDT," PAGE ",DGBTPG
- +2 SET X="BENEFICIARY TRAVEL OUTPUT "_"BY "_$SELECT(DGBTSL="CAR":"CARRIER",DGBTSL="ACCT":"ACCOUNT",DGBTSL="TYP":"ACCOUNT TYPE",1:"PATIENT")
- +3 WRITE !?(40-($LENGTH(X)/2)),X
- IF DGBTZ="T"
- WRITE !?32,"DIVISION TOTALS"
- +4 SET DGBTBG=DGBTBEG+.0001
- SET DGBTT=$SELECT(DGBTBG=(DGBTEND\1):"FOR ",1:"FROM ")
- SET VADAT("W")=DGBTBG
- DO ^VADATE
- SET DGBTT=DGBTT_$PIECE(VADATE("E"),"@",1)
- IF DGBTEND\1'=DGBTBG
- SET VADAT("W")=DGBTEND\1
- DO ^VADATE
- SET DGBTT=DGBTT_" TO "_$PIECE(VADATE("E"),"@",1)
- +5 SET DGBTY=40-($LENGTH(DGBTT)/2)
- WRITE !?DGBTY,DGBTT,!
- +6 WRITE !
- IF DGBTSL="PAT"
- if DGBTZ="F"
- WRITE ?7,"DATE",?25,"ACCOUNT",?43
- +7 IF DGBTSL'="PAT"
- if DGBTZ="F"
- WRITE ?7,"NAME",?22,"PT ID",?35,"DATE",?50
- +8 IF DGBTZ="T"
- if DGBT4
- WRITE ?5
- if 'DGBT4
- WRITE ?10
- WRITE $SELECT(DGBT4:"DIVISION NAME",DGBTSL="PAT":"NAME",DGBTSL="CAR":"CARRIER",1:"ACCOUNT")
- +9 IF DGBTZ="F"
- WRITE "$DEDUC"
- if DGBTSL="PAT"
- WRITE ?55
- if DGBTSL'="PAT"
- WRITE ?60
- WRITE "$PAYABLE"
- if DGBTZ="F"
- WRITE ?70,$SELECT(DGBTSL="CAR":"ACCOUNT",1:"CARRIER")
- WRITE !,DGBTCL,!
- QUIT
- +10 WRITE ?37,"$DEDUC",?49,"$PAYABLE",?65,"$TOTAL"
- if DGBTSL'="PAT"
- WRITE ?75,"# PAT"
- WRITE !,DGBTCL
- QUIT
- RT if $Y=0
- 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
- if DGBTX=DGBTG
- DO HDR
- SET DGBTF=1
- +1 QUIT
- HDR IF DGBTZ="F"
- SET DGBTXX=$SELECT(DGBTSL="ACCT":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 ;prints total for divisions
- SM IF DGBTZ="T"
- if 'DGBT3
- QUIT
- +1 IF DGBTZ="F"
- if 'DGBTF
- QUIT
- +2 if DGBTX=""
- SET DGBTD1=1
- DO RP
- if DGBTU
- QUIT
- SET DGBTD1=0
- WRITE !!
- if DGBTZ="T"
- WRITE ?3
- if DGBTZ="F"
- WRITE ?10
- WRITE "DIVISION TOTAL"
- SET X=DGBTSDT
- SET X2="2$"
- DO CM
- if DGBTZ="T"
- WRITE ?32,X
- IF DGBTZ="F"
- if DGBTSL="PAT"
- WRITE ?38
- if DGBTSL'="PAT"
- WRITE ?45
- WRITE X
- +3 SET X=DGBTAT
- SET X2="2$"
- DO CM
- if DGBTZ="T"
- WRITE ?46,X
- IF DGBTZ="F"
- if DGBTSL="PAT"
- WRITE ?52
- if DGBTSL'="PAT"
- WRITE ?57
- WRITE X
- +4 IF DGBTZ="T"
- SET X=DGBTGT
- SET X2="2$"
- DO CM
- WRITE ?60,X
- IF DGBTSL'="PAT"
- WRITE ?76,$JUSTIFY(DGBTPTC(DGBTODV),4)
- +5 SET (DGBTAT,DGBTSDT,DGBTGT,DGBTPTC)=0
- QUIT
- +6 ;Prints total page plus grand total.
- TOTAL SET DGBTZ="T"
- SET DGBT4=1
- SET DGBTPG=0
- DO HE
- SET (DGBTDV,DGBTC)=0
- FOR X=0:0
- SET DGBTDV=$ORDER(DGBTGT(DGBTDV))
- if DGBTDV=""
- QUIT
- if DGBT3
- DO RP
- if DGBTU
- QUIT
- DO CON
- +1 DO RP
- if DGBTU
- QUIT
- WRITE !!?12,"GRAND TOTAL",?32
- SET X2="2$"
- SET X=DGBTSDT
- DO CM
- WRITE X
- SET X2="2$"
- SET X=DGBTAT
- DO CM
- WRITE ?46,X
- SET X2="2$"
- SET X=DGBTGT
- DO CM
- WRITE ?60,X
- IF DGBTSL'="PAT"
- WRITE ?74,$JUSTIFY(DGBTPTC,6)
- +2 QUIT
- CON if DGBTSL'="PAT"
- SET DGBTPTC=DGBTPTC+DGBTPTC(DGBTDV)
- WRITE !,$SELECT(DGBTDV="ZNOT SPECIFIED":"NOT SPECIFIED",1:$EXTRACT(DGBTDV,1,30)),?32
- SET X2="2$"
- SET X=$PIECE(DGBTGT(DGBTDV),"^",2)
- SET DGBTSDT=DGBTSDT+X
- DO CM
- WRITE X
- +1 SET X2="2$"
- SET X=$PIECE(DGBTGT(DGBTDV),"^",1)
- SET DGBTAT=DGBTAT+X
- DO CM
- WRITE ?46,X
- SET X2="2$"
- SET X=$PIECE(DGBTGT(DGBTDV),"^",1)+$PIECE(DGBTGT(DGBTDV),"^",2)
- SET DGBTGT=DGBTGT+X
- DO CM
- WRITE ?60,X
- IF DGBTSL'="PAT"
- WRITE ?74,$JUSTIFY(DGBTPTC(DGBTDV),6)
- +2 SET DGBT3=1
- if $ORDER(DGBTGT(DGBTDV))'=""
- DO RP
- +3 QUIT
- CM NEW X3
- DO COMMA^%DTC
- QUIT