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