VistA-WorldVistAEHR/r/INTEGRATED_PATIENT_FUNDS-PR.../PRPFS.m

48 lines
2.4 KiB
Mathematica

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