source: FOIAVistA/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTOA3.m@ 1397

DGBTOA3 ;ALB/TT,ALB/MAC - BENEFICIARY TRAVEL OUTPUTS PR ROUTINE ;4/4/91  15:29
 ;;1.0;Beneficiary Travel;**7**;September 25, 2001
 ;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 N X3 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