46 lines
3.6 KiB
Mathematica
46 lines
3.6 KiB
Mathematica
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
|