Routine: PRPFS

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  Mar 13, 2025@21:06:47                                                                                                                                                                                                       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

PRPFS.m