source: WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTOA3.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1DGBTOA3 ;ALB/TT,ALB/MAC - BENEFICIARY TRAVEL OUTPUTS PR ROUTINE ;4/4/91 15:29
2 ;;1.0;Beneficiary Travel;**7**;September 25, 2001
3 ;Loops thru ^Utility
4PR Q:'$D(^UTILITY($J)) S (DGBTDN,DGBTF,DGBTX,DGBTS,DGBTSD,DGBTDD,DGBT3,DGBTCH,DGBTSDT,DGBTAT,DGBTGT,DGBTP,DGBTSSN,DGBTD1,DGBTPG,SSN)=0
5 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"
6 Q:DGBTU D:DGBTZ="F" TT D:DGBTZ="T" SM^DGBTOA4 D RT Q
7PRA 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
8 Q
9 ;For patients
10PRP F L1=0:0 S DGBTX=$O(^UTILITY($J,1,DGBTDN,DGBTX)) Q:DGBTX=""!(DGBTU) S DGBTX1=DGBTX Q:DGBTU D PRP1
11 Q
12PRP1 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
13 Q
14 ;For account, account type and carrier
15AC 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
16 Q
17AC1 F DGBTD=0:0 S DGBTD=$O(^UTILITY($J,1,DGBTDN,DGBTX,DGBTP,SSN,DGBTD)) Q:DGBTD=""!(DGBTU) D PR3
18 Q
19PR3 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))
20 I DGBTSL="PAT" D:DGBTSSN'=SSN!(DGBTDN'=DGBTDD)!(DGBTS) HDR
21 I DGBTSL'="PAT" D:DGBTX'=DGBTG!(DGBTDN'=DGBTDD)!(DGBT2) HDR
22 S DGBTSSN=SSN,DGBTDD=DGBTDN,DGBTODV=DGBTDV,DGBT2=0 D DAT I DGBTZ="F" D PATP:DGBTSL="PAT",ACCTP:DGBTSL'="PAT"
23 Q
24 ;Prints patient entries
25PATP 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
26 ;Print for account, account type and carrier entries
27ACCTP 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
28DAT S VADAT("W")=DGBTD D ^VADATE S X=$P(VADATE("E"),"@",1) Q
29RT Q:$Y=0 Q:DGBTU Q:IOST'?1"C-".E F X=$Y:1:(IOSL-2) W !
30 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
31RP I $Y+6>IOSL D RT:(IOST?1"C-".E) Q:DGBTU D HE^DGBTOA4 D:DGBTX=DGBTG HDR
32 Q
33HDR 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
34 Q
35 ;Totals at end of divisions
36TT 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
37 I DGBTZ="F" D DTC^DGBTOA4 D:DGBTDD'=DGBTDN SM^DGBTOA4 S (DGBTF,DGBTAT,DGBTGT,DGBTSDT,DGBTD1,DGBTPG)=0 I DGBTDN="" S DGBTF=1
38 Q
39 ;Individual totals
40TOT 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
41 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
42 ;Totals for only totals report
43TTT D RP Q:DGBTU D DTC^DGBTOA4 S DGBT3=1 Q
44CM N X3 D COMMA^%DTC Q
45NO S DGBTDV=$S('$D(^DG(40.8,DGBTDN,0)):"UNKNOWN",1:$P(^DG(40.8,DGBTDN,0),"^")) S:DGBTDV']"" DGBTDV="UNKNOWN" Q
Note: See TracBrowser for help on using the repository browser.