PRPFS ;ALTOONA/CTB SUSPENSE FILE MAINTENANCE ;4/22/97 9:00 AM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
ADD ;ADD/EDIT SUSPENSE ITEM
D GETPAT G OUT:Y<0 S DIE=DIC,DA=+Y,DR="[PRPF SUSPENSE ENTER EDIT]" D ^DIE,OUT G ADD
DELDATE ;DELETE ENTIRE SUSPENSE DATE
D GETDATE G:Y<0 OUT S DA=+Y,Y=$P(Y,"^",2) D D^PRPFU1 S DIK=DIC,%A="Are you sure you wish to delete all items for "_Y,%B="",%=2 D ^PRPFYN G:%'=1 NA S DIC(0)="" D ^DIK,DONE G DELDATE
DELITEM ;DELETE INDIVIDUAL ITEM IN SUSPENSE FILE
D GETITEM G:Y<0 OUT S DA=+Y,Y=$P(Y,"^",2) S DIK=DIC,%A="Are you sure you wish to delete the "_Y_" item",%B="",%=2 D ^PRPFYN G:%'=1 NA S DIC(0)="" D ^DIK
I +$P(^PRPF(470,DA(2),5,DA(1),1,0),"^",4)=0 S DA=DA(1),DA(1)=DA(2) K DA(2) S DIK="^PRPF(470,"_DA(1)_",5," D ^DIK
D DONE
G DELITEM
EMPTY ;DELETE EMPTY DATES FOR ALL PATIENTS
NEW NEXT,DA,DIK
S NEXT=0 F S NEXT=$O(^PRPF(470,NEXT)) Q:'NEXT D ONE(NEXT)
QUIT
ONE(NEXT) ;DELETE EMPTY SUSPENSE DATES FOR ONE PATIENT
NEW DA,DIK,X
S DA(1)=NEXT S DA=0 F S DA=$O(^PRPF(470,DA(1),5,DA)) Q:'DA S X=$G(^PRPF(470,DA(1),5,DA,1,0)) I X]"",+$P(X,"^",4)=0 S DIK="^PRPF(470,"_DA(1)_",5," D ^DIK
QUIT
REPORT ;SUSPENSE REPORT
S DIC="^PRPF(470,",(BY,FLDS)="[PRPF SUSPENSE LIST]",(FR,TO)="?"
D DIP^PRPFPNT QUIT
TASKMAN ;QUEUED SUSPENSE REPORT
S IOP=ION
S L=0,DIC="^PRPF(470,",(BY,FLDS)="[PRPF SUSPENSE LIST]",FR="1/1/1901",TO="T+5"
D EN1^DIP QUIT
;D DIP^PRPFPNT QUIT
REVIEW ;REVIEW ITEMS IN SUSPENSE FILE
D GETPAT Q:Y<0 S PRPF("DA")=+Y
S ZTRTN="DQREV^PRPFS",ZTDHD="REVIEW INDIVIDUAL PATIENT FUNDS SUSPENSE FILE",ZTSAVE("PRPF*")="",ZTSAVE("DI*")="" D ^PRPFQ
I $D(XQY) D DONE Q
D OUT
QUIT
DQREV ;DQ POINT FOR REVIEW ITEMS IN SUSPENSE
I $D(ZTQUEUED) S ZTREQ="@"
K ^TMP("PRPFAI",$J)
S ^TMP("PRPFAI",$J,+PRPF("DA"))=""
S DIC="^PRPF(470,",BY=".01,32,.01;S",FR=",,?",TO=",,?",FLDS="[PRPF SUSPENSE DISPLAY]",BY(0)="^TMP(""PRPFAI"",$J,",IOP=PRIOP,L(0)=1,DIOEND="K ^TMP(""PRPFAI"",$J)" G DIP^PRPFPNT
DONE W:IOM-$X<10 ! W " ----DONE----" R X:2 G OUT
GETPAT ;GET PATIENT IRN
S DIC=470,DIC(0)="AEMNQ" D ^DIC Q
GETDATE ;GET SUSPENSE DATE
D GETPAT Q:Y<0 K DIC S:'$D(^PRPF(470,+Y,5,0)) ^(0)="^470.03D^^" S DA(1)=+Y,DIC="^PRPF(470,"_DA(1)_",5,",DIC(0)="AEQM",DIC("A")="Select SUSPENSE DATE: " D ^DIC S X=DIC K DIC("A") S DIC=X Q
GETITEM ;GET SUSPENSE ITEM
D GETDATE Q:Y<0 S DA(2)=DA(1),DA(1)=+Y,DIC=DIC_DA(1)_",1," D ^DIC Q
NA W:IOM-$X<30 ! W " <Option terminated, no action taken>",*7 R X:2
OUT K %W,C,DI,DIK,DIYS D DIKILL^PRPFQ,DIWKILL^PRPFQ,ZTKILL^PRPFQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFS 2539 printed Apr 09, 2024@21:04:35 Page 2
PRPFS ;ALTOONA/CTB SUSPENSE FILE MAINTENANCE ;4/22/97 9:00 AM
V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
ADD ;ADD/EDIT SUSPENSE ITEM
+1 DO GETPAT
if Y<0
GOTO OUT
SET DIE=DIC
SET DA=+Y
SET DR="[PRPF SUSPENSE ENTER EDIT]"
DO ^DIE
DO OUT
GOTO ADD
DELDATE ;DELETE ENTIRE SUSPENSE DATE
+1 DO GETDATE
if Y<0
GOTO OUT
SET DA=+Y
SET Y=$PIECE(Y,"^",2)
DO D^PRPFU1
SET DIK=DIC
SET %A="Are you sure you wish to delete all items for "_Y
SET %B=""
SET %=2
DO ^PRPFYN
if %'=1
GOTO NA
SET DIC(0)=""
DO ^DIK
DO DONE
GOTO DELDATE
DELITEM ;DELETE INDIVIDUAL ITEM IN SUSPENSE FILE
+1 DO GETITEM
if Y<0
GOTO OUT
SET DA=+Y
SET Y=$PIECE(Y,"^",2)
SET DIK=DIC
SET %A="Are you sure you wish to delete the "_Y_" item"
SET %B=""
SET %=2
DO ^PRPFYN
if %'=1
GOTO NA
SET DIC(0)=""
DO ^DIK
+2 IF +$PIECE(^PRPF(470,DA(2),5,DA(1),1,0),"^",4)=0
SET DA=DA(1)
SET DA(1)=DA(2)
KILL DA(2)
SET DIK="^PRPF(470,"_DA(1)_",5,"
DO ^DIK
+3 DO DONE
+4 GOTO DELITEM
EMPTY ;DELETE EMPTY DATES FOR ALL PATIENTS
+1 NEW NEXT,DA,DIK
+2 SET NEXT=0
FOR
SET NEXT=$ORDER(^PRPF(470,NEXT))
if 'NEXT
QUIT
DO ONE(NEXT)
+3 QUIT
ONE(NEXT) ;DELETE EMPTY SUSPENSE DATES FOR ONE PATIENT
+1 NEW DA,DIK,X
+2 SET DA(1)=NEXT
SET DA=0
FOR
SET DA=$ORDER(^PRPF(470,DA(1),5,DA))
if 'DA
QUIT
SET X=$GET(^PRPF(470,DA(1),5,DA,1,0))
IF X]""
IF +$PIECE(X,"^",4)=0
SET DIK="^PRPF(470,"_DA(1)_",5,"
DO ^DIK
+3 QUIT
REPORT ;SUSPENSE REPORT
+1 SET DIC="^PRPF(470,"
SET (BY,FLDS)="[PRPF SUSPENSE LIST]"
SET (FR,TO)="?"
+2 DO DIP^PRPFPNT
QUIT
TASKMAN ;QUEUED SUSPENSE REPORT
+1 SET IOP=ION
+2 SET L=0
SET DIC="^PRPF(470,"
SET (BY,FLDS)="[PRPF SUSPENSE LIST]"
SET FR="1/1/1901"
SET TO="T+5"
+3 DO EN1^DIP
QUIT
+4 ;D DIP^PRPFPNT QUIT
REVIEW ;REVIEW ITEMS IN SUSPENSE FILE
+1 DO GETPAT
if Y<0
QUIT
SET PRPF("DA")=+Y
+2 SET ZTRTN="DQREV^PRPFS"
SET ZTDHD="REVIEW INDIVIDUAL PATIENT FUNDS SUSPENSE FILE"
SET ZTSAVE("PRPF*")=""
SET ZTSAVE("DI*")=""
DO ^PRPFQ
+3 IF $DATA(XQY)
DO DONE
QUIT
+4 DO OUT
+5 QUIT
DQREV ;DQ POINT FOR REVIEW ITEMS IN SUSPENSE
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL ^TMP("PRPFAI",$JOB)
+3 SET ^TMP("PRPFAI",$JOB,+PRPF("DA"))=""
+4 SET DIC="^PRPF(470,"
SET BY=".01,32,.01;S"
SET FR=",,?"
SET TO=",,?"
SET FLDS="[PRPF SUSPENSE DISPLAY]"
SET BY(0)="^TMP(""PRPFAI"",$J,"
SET IOP=PRIOP
SET L(0)=1
SET DIOEND="K ^TMP(""PRPFAI"",$J)"
GOTO DIP^PRPFPNT
DONE if IOM-$X<10
WRITE !
WRITE " ----DONE----"
READ X:2
GOTO OUT
GETPAT ;GET PATIENT IRN
+1 SET DIC=470
SET DIC(0)="AEMNQ"
DO ^DIC
QUIT
GETDATE ;GET SUSPENSE DATE
+1 DO GETPAT
if Y<0
QUIT
KILL DIC
if '$DATA(^PRPF(470,+Y,5,0))
SET ^(0)="^470.03D^^"
SET DA(1)=+Y
SET DIC="^PRPF(470,"_DA(1)_",5,"
SET DIC(0)="AEQM"
SET DIC("A")="Select SUSPENSE DATE: "
DO ^DIC
SET X=DIC
KILL DIC("A")
SET DIC=X
QUIT
GETITEM ;GET SUSPENSE ITEM
+1 DO GETDATE
if Y<0
QUIT
SET DA(2)=DA(1)
SET DA(1)=+Y
SET DIC=DIC_DA(1)_",1,"
DO ^DIC
QUIT
NA if IOM-$X<30
WRITE !
WRITE " <Option terminated, no action taken>",*7
READ X:2
OUT KILL %W,C,DI,DIK,DIYS
DO DIKILL^PRPFQ
DO DIWKILL^PRPFQ
DO ZTKILL^PRPFQ
QUIT
