source: WorldVistAEHR/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFOBR.m@ 789

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1PRPFOBR ;ALTOONA/CTB-OPTION TO RECALCULATE PATIENT BALANCES ;04/15/02
2V ;;3.0;PATIENT FUNDS;**6,13**;JUNE 1, 1989
3SE S %A="This option will recalculate the balances of a patient account",%A(1)="It should only be used after the account has be audited and it",%A(2)="has been determined that all transactions are valid."
4 S %=2,U="^" W !,*7 S %A(3)="Do you really want to run this option",%B="" D ^PRPFYN G:%'=1 NA
5SE1 W !! S DIC="^PRPF(470,",DIC(0)="AEQMNZ" D ^DIC G:Y<0 OUT S (PF("PBAL"),PF("GBAL"),PF("BAL"))=0,DFN=+Y D CALC
6 W !,?10,"BALANCE IN ACCOUNT",?50,"CORRECTED BALANCE" S X=$S($D(^PRPF(470,DFN,1)):^(1),1:"")
7 W !,"TOTAL",?15,$J($P(X,U,4),8,2),?55,$J(PF("BAL"),8,2),!,"P/S",?15,$J($P(X,U,5),8,2),?55,$J(PF("PBAL"),8,2),!,"GRAT",?15,$J($P(X,U,6),8,2),?55,$J(PF("GBAL"),8,2)
8 S %=2 W ! S %A="Are you ready to Post the corrected balances to the account",%B="" D ^PRPFYN G:%<0 NA I %'=1 D NA S DIC("A")="Select Next Patient: " G SE1
9 S %A="ARE YOU SURE",%B="",%=2 D ^PRPFYN G:%<0 NA I %'=1 D NA S DIC("A")="Select Next Patient: " G SE1
10 S $P(^PRPF(470,DFN,1),U,4,6)=PF("BAL")_U_PF("PBAL")_U_PF("GBAL") W " ---Done---" R X:2 D OUT
11 W !! S DIC("A")="Select Next Patient: " G SE1
12CALC S (DA,PF("BAL"),PF("PBAL"),PF("GBAL"))=0 F N=0:0 S DA=$O(^PRPF(470,DFN,3,DA)) Q:'DA D CALC1
13 Q
14CALC1 S X=^PRPF(470,DFN,3,DA,0) S PF("PBAL")=PF("PBAL")+$P(X,U,4),PF("GBAL")=PF("GBAL")+$P(X,U,5),PF("BAL")=PF("BAL")+$P(X,U,3),$P(^(0),U,6)=PF("BAL") Q
15TM S PRPFRNG="@",PRPFRNG2=""
16ALL ;;SCREEN ALL PATIENT FUND ACCOUNTS AND PRINT LIST OF OUT OF BALANCES
17 K ^TMP("PRPFAH",$J)
18 S X=" Hold on while I search the file . . .*" D MSG^PRPFQ
19 S DFN=0,U="^" F I=1:1 S DFN=$O(^PRPF(470,DFN)) Q:DFN'=+DFN D CHECK
20 I '$D(^TMP("PRPFAH",$J)) D NONE G OUT
21 S DIC="^PRPF(470,",L=0,L(0)=1,BY="@73:99;S1,.01",BY(0)="^TMP(""PRPFAH"",$J,",FLDS="[PRPF OUT OF BALANCE]",FR=""_PRPFRNG_"",TO=""_PRPFRNG2_"" S IOP=$S($D(PRIOP):PRIOP,1:ION)
22 S DIOEND="K ^TMP(""PRPFAH"") W !,""The information contained in this report is protected by the Privacy Act of 1974"""
23 S:PRPFRNG="@" BY="@73,@73:99;S1,.01",FR="@,@",TO=","
24 D EN1^DIP
25 S ZTREQ="@"
26OUT K %,%W,C,DA,DFN,DIC,DIYS,K,N,PF,POP,PRPFRNG,PRPFRNG2,S,X,XBAL,XPBAL,XGBAL,X1,Y D DIKILL^PRPFQ,ZTKILL^PRPFQ
27 Q
28NONE S IOP=ION W @IOF D NOW^PRPFQ W "PATIENT FUNDS OUT OF BALANCE REPORT",?50,%X,!!,"No Out of Balance Accounts Were Found While Running This Report" W:$E($G(IOST))="P" @IOF
29 Q
30CHECK D CALC S X=PF("BAL")+PF("PBAL")+PF("GBAL"),X2=$S($D(^PRPF(470,DFN,1)):^(1),1:""),XBAL=$P(X2,U,4),XPBAL=$P(X2,U,5),XGBAL=$P(X2,U,6)
31 S X1=XBAL+XPBAL+XGBAL
32 I +X'=+X1 G SET
33 I +PF("BAL")'=+XBAL G SET
34 I +PF("PBAL")'=+XPBAL G SET
35 I +PF("GBAL")'=+XGBAL G SET
36 Q
37SET S ^TMP("PRPFAH",$J,DFN)=""
38 Q
39NA W:(IOM-$X)<25 ! W " <No action taken>",*7 R X:3 W !! G OUT
40QUE ;QUEUE ALL^PRPFOBR TO RUN AS TASKMAN JOB
41 W !,"This program will review all Patient Funds Accounts and print a",!,"report of all accounts which are out of balance in any way. ",!!
42 W "Due to the length of time that this report may take, it is suggested that it,",!," be queued.",!!
43 D SELRNG^PRPFQ
44 I PRPFRNG="" D OUT QUIT
45 I PRPFRNG="@" S PRPFRNG2=""
46 E S PRPFRNG2=PRPFRNG
47 S ZTSAVE("PRPFRNG")=PRPFRNG,ZTSAVE("PRPFRNG2")=PRPFRNG2
48 S ZTRTN="ALL^PRPFOBR",ZTDESC=$P($T(ALL),";",3) D ^PRPFQ G OUT
Note: See TracBrowser for help on using the repository browser.