1 | PRPFRPT ;ALTOONA/CTB-PATIENT FUNDS MISC REPORT GENERATOR ;4/22/02
|
---|
2 | V ;;3.0;PATIENT FUNDS;**6,13**;JUNE 1, 1989
|
---|
3 | DORMANT ;;REPORT OF DORMANT PATIENT ACCOUNTS
|
---|
4 | W !!,"Enter number of days since last transaction for account to be included",!,"on this report. 180// " R X:$S($D(DTIME):DTIME,1:60) G:'$T!(X["^") OUT I X="" S X=180
|
---|
5 | I +X'=X!(X<1)!(X[".") W *7,?$X+5,"RESPONSE MUST BE AN INTEGER GREATER THAN ZER0",! G DORMANT Q
|
---|
6 | S X="T-"_X,%DT="EX" D ^%DT G:Y<0 OUT S PRPF("SDAT")=Y
|
---|
7 | S %A="Do you wish to include accounts with zero (0) balances",%B="",%=2 D ^PRPFYN G:%<0 OUT S PRPF("ZERO")=$S(%=1:"XXX",1:0)
|
---|
8 | D SELRNG^PRPFQ
|
---|
9 | I PRPFRNG="" D OUT QUIT
|
---|
10 | I PRPFRNG="@" S PRPFRNG2=""
|
---|
11 | E S PRPFRNG2=PRPFRNG
|
---|
12 | S ZTRTN="DQ^PRPFRPT",ZTDESC=$P($T(DORMANT),";",3),ZTSAVE("PRPF*")="" D ^PRPFQ D:'$D(XQY) ENCON^PRPFQ G OUT
|
---|
13 | CK S PRPF("DATE")=$P(^PRPF(470,DA,0),"^",11),PRPF("BAL")=$P(^(1),"^",4)
|
---|
14 | I +PRPF("BAL")'=PRPF("ZERO"),+PRPF("DATE")'>PRPF("SDAT") S ^TMP("PRPFAE",$J,DA)="" I '$D(ZTQUEUED),I#25=0 W "."
|
---|
15 | Q
|
---|
16 | DQ ;ENTRY POINT FOR QUEUED OUTPUT
|
---|
17 | S IOP=PRIOP
|
---|
18 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
19 | E D WAIT^PRPFYN
|
---|
20 | K ^TMP("PRPFAE",$J)
|
---|
21 | S DA=0 F I=1:1 S DA=$O(^PRPF(470,DA)) Q:'DA D CK
|
---|
22 | S Y=PRPF("SDAT") D D^PRPFU1 S DHD="LISTING OF PATIENT FUNDS ACCOUNTS INACTIVE SINCE "_Y
|
---|
23 | I '$D(^TMP("PRPFAE",$J)) W !!,DHD D NOW^PRPFQ S X="DATE: "_%X D MSG^PRPFU1 W !!,"THERE ARE NO ACCOUNTS IN THE FILE MEETING THE ABOVE CRITERION AT THIS TIME.",!! G OUT
|
---|
24 | S DIC="^PRPF(470,",L=0,L(0)=1,BY="@73:99;S1,.01",BY(0)="^TMP(""PRPFAE"",$J,",FLDS="[PRPF DORMANT ACCOUNT LIST]",FR=""_PRPFRNG_"",TO=""_PRPFRNG2_""
|
---|
25 | S DIOEND="K ^TMP(""PRPFAE"",$J) W !,""The information contained in this report is protected by the Privacy Act of 1974"""
|
---|
26 | S:PRPFRNG="@" BY="@73,@73:99;S1,.01",FR="@,@",TO=","
|
---|
27 | W !,"" D EN1^DIP
|
---|
28 | OUT K %,%DT,%X,%Y,DFN,DG1,DGA1,DGT,DGX,DIJ,DP,PRIOP,PRPF,PRPFRNG,PRPFRNG2,IOY,X,Y,DIOEND Q
|
---|
29 | DISPLAY ;DISPLAY INDIVIDUAL TRANSACTION
|
---|
30 | S DIC=470.1,DIC(0)="AEQ" D ^DIC I +Y>0 S DA=+Y,DR=0 D EN^DIQ G DISPLAY
|
---|