source: FOIAVistA/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFBAL.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1PRPFBAL ;ALTOONA/CTB-PATIENT LOOKUP AND COMPUTE BALANCE ;08/29/02
2V ;;3.0;PATIENT FUNDS;**6,8,13,14**;JUNE 1, 1989
3EN S DIC(0)="ZAEQM",DIC=470 D ^DIC I +Y>0 S DFN=+Y,DFN(0)=Y(0),DFN(0,0)=Y(0,0),DFN(1)=$S($D(^PRPF(470,DFN,1)):^(1),1:"") D EN1 G EN
4 W:$D(IOF) @IOF K %,%W,%X,%Y,C,DFN,DIC,DIYS,POP,Y
5OUT K %H,%I,%TG,D,D1,DG1,DGT,DGX,DIW,DIWT,DN,I,N,PFHI,PFLO,PFNORM,PRBAL,Q3,RES,TMP,TYPE,X,X2,Y,Z Q
6EN1 D HILO S PRBAL("DEF")=$P(^DD(470,30.5,0),"^",5,99) S DFN(0)=^PRPF(470,DFN,0),DFN(1)=$S($D(^(1)):^(1),1:""),DFN(0,0)=$P(^DPT(DFN,0),"^") D EN^PRPFRES S PRBAL("SB")=$P(DFN(1),"^",4),PRBAL("PB")=$P(DFN(1),"^",5),PRBAL("GB")=$P(DFN(1),"^",6)
7 S RES=$P(DFN(0),U,3) S TYPE=$S(RES="R":"RESTRICTED",RES="L":"LIMITED UNRESTRICTED",RES="U":"UNRESTRICTED",1:"UNKNOWN")
8A D ^PRPFDEF S D0=DFN X PRBAL("DEF") K D0 S PRBAL("DEF")=X
9 W:$D(IOF) @IOF W !,@PFHI,$P(DFN(0,0),"^"),@PFLO,?40 W "SSN: ",@PFHI S SSN=$P(^DPT(+DFN(0),0),"^",9)
10 W $E(SSN,1,3),@PFLO,"-",@PFHI,$E(SSN,4,5),@PFLO,"-",@PFHI,$E(SSN,6,9),?60,@PFLO,"CLAIM #: ",@PFHI,$S($D(^DPT(+DFN(0),.31)):$P(^(.31),"^",3),1:""),@PFLO K SSN
11 D DGINPW^PRPFU1 W @PFHI D DEAD^PRPFED W @PFLO,!
12 W ?18,"* * * ACCOUNT TYPE IS ",@PFHI,TYPE,@PFLO," * * *",!,"WARD: ",@PFHI,DFN(.1),@PFLO
13 I $D(^PRPF(470,DFN,12)) I (^PRPF(470,DFN,12))'="" W !,"STATION NAME: ",@PFHI,$$GET1^DIQ(4,(^PRPF(470,DFN,12)),.01),@PFLO
14 I $D(^PRPF(470,DFN,12)) I (^PRPF(470,DFN,12))="" W !,"STATION NAME:"
15 W:'$D(^PRPF(470,DFN,12)) !,"STATION NAME:"
16 I "UX"[RES G B
17 W !,"AUTH WD/MONTH: ",@PFHI S X=$P(DFN(1),U,7) D C W X,@PFLO,?39,"AUTH WD/WEEK: ",@PFHI S X=$P(DFN(1),U,8) D C W X,@PFLO,!,?7,"ACTUAL: ",@PFHI S X=$P(DFN(1),"^",11) D C W X,@PFLO,?45,"ACTUAL: ",@PFHI S X=$P(DFN(1),"^",12) D C W X
18B W @PFLO S XI="",$P(XI,"*",80)="" W !,XI
19 W !,?10," TOTAL BALANCE: ",@PFHI S X=PRBAL("SB") D C W X,@PFLO,?45,"PRIVATE SOURCE: ",@PFHI S X=PRBAL("PB") D C W X,@PFLO,!,?16,"DEFERRED: ",@PFHI S X=PRBAL("DEF") D C W X,@PFLO,?49
20 W "GRATUITOUS: ",@PFHI S X=PRBAL("GB") D C W X,@PFLO,!!,"AVAILABLE FOR WITHDRAWAL: " S (PRBAL("PB"),X)=PRBAL("SB")-PRBAL("DEF") W @PFHI D C W X,@PFLO,!
21 W XI K XI
22 I +PRBAL("DEF")>0 W !,"DEFERRAL INFORMATION:",?30,"TRANSACTION",?50,"DEF DATE",?69,"AMOUNT" D DEF
23GI ;PRINT GENERAL INFORMATION REMARKS
24T2 W !,"GENERAL REMARKS/INFORMATION:"
25 K ^UTILITY($J,"W") ; <<< Added by REW in patch 8 since Eng. doesn't kill -- see NOIS CLE-1097-42161
26 W @PFHI S N=0,DIWF="W",DIWL=5,DIWR=IOM-10 F I=1:1 S N=$O(^PRPF(470,DFN,7,N)) Q:N="" S X=^(N,0) D ^DIWP
27 D ^DIWW K DIWF,DIWL,DIWR,X
28 W @PFNORM
29T3 G:'$D(^XUSEC("PRPF CLERK",DUZ)) OUT W !,"SPECIAL REMARKS:"
30 W @PFHI S N=0,DIWF="W",DIWL=5,DIWR=IOM-10 F I=1:1 S N=$O(^PRPF(470,DFN,8,N)) Q:N="" S X=^(N,0) D ^DIWP
31 D ^DIWW
32 W !,"The information contained in this report is protected by the Privacy Act of 1974"
33 K DIWF,DIWL,DIWR,X W @PFNORM G OUT
34DEF ;WRITES DEFERRAL INFORMATION
35 F I=0:0 S I=$O(^PRPF(470,DFN,4,I)) Q:I'=+I I $D(^(I,0)) S PRPF(1)=^PRPF(470,DFN,4,I,0) W !,?35,@PFHI,$P(PRPF(1),"^"),?49 S Y=$P(PRPF(1),"^",2) X ^DD("DD") W Y,?64 S X=$P(PRPF(1),"^",3) D C W X,@PFLO
36 K PRPF(1) Q
37HILO S IOP=0 D ^%ZIS S (PFHI,PFLO,PFNORM)="*0" I ^%ZOSF("OS")'["M/11" Q
38 ;HI/LO INTENSITY DISABLED FOR DSM DUE TO INAPPROPRIATE HANDLING OF COLUMN POSITIONING
39 S:$D(^%ZIS(2,IOST(0),7)) TMP=^(7),PFHI=$P(TMP,"^",1),PFLO=$P(TMP,"^",2),PFNORM=$P(TMP,"^",3) I PFHI=""!(PFLO="")!(PFNORM="") S (PFLO,PFHI,PFNORM)="*0"
40 Q
41 ;
42C S X2="2$"
43 S %D=X<0 S:%D X=-X S %=$S($D(X2):+X2,1:2),X=$J(X,1,%),%=$L(X)-3-$E(23456789,%)
44 F %=%:-3 Q:$E(X,%)="" S X=$E(X,1,%)_","_$E(X,%+1,99)
45 S:$D(X2) X=$E("$",X2["$")_X S X=$J($E("(",%D)_X_$E(" )",%D+1),12) K %,%D Q
Note: See TracBrowser for help on using the repository browser.