source: WorldVistAEHR/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFS.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1PRPFS ;ALTOONA/CTB SUSPENSE FILE MAINTENANCE ;4/22/97 9:00 AM
2V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
3ADD ;ADD/EDIT SUSPENSE ITEM
4 D GETPAT G OUT:Y<0 S DIE=DIC,DA=+Y,DR="[PRPF SUSPENSE ENTER EDIT]" D ^DIE,OUT G ADD
5DELDATE ;DELETE ENTIRE SUSPENSE DATE
6 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
7DELITEM ;DELETE INDIVIDUAL ITEM IN SUSPENSE FILE
8 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
9 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
10 D DONE
11 G DELITEM
12EMPTY ;DELETE EMPTY DATES FOR ALL PATIENTS
13 NEW NEXT,DA,DIK
14 S NEXT=0 F S NEXT=$O(^PRPF(470,NEXT)) Q:'NEXT D ONE(NEXT)
15 QUIT
16ONE(NEXT) ;DELETE EMPTY SUSPENSE DATES FOR ONE PATIENT
17 NEW DA,DIK,X
18 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
19 QUIT
20REPORT ;SUSPENSE REPORT
21 S DIC="^PRPF(470,",(BY,FLDS)="[PRPF SUSPENSE LIST]",(FR,TO)="?"
22 D DIP^PRPFPNT QUIT
23TASKMAN ;QUEUED SUSPENSE REPORT
24 S IOP=ION
25 S L=0,DIC="^PRPF(470,",(BY,FLDS)="[PRPF SUSPENSE LIST]",FR="1/1/1901",TO="T+5"
26 D EN1^DIP QUIT
27 ;D DIP^PRPFPNT QUIT
28REVIEW ;REVIEW ITEMS IN SUSPENSE FILE
29 D GETPAT Q:Y<0 S PRPF("DA")=+Y
30 S ZTRTN="DQREV^PRPFS",ZTDHD="REVIEW INDIVIDUAL PATIENT FUNDS SUSPENSE FILE",ZTSAVE("PRPF*")="",ZTSAVE("DI*")="" D ^PRPFQ
31 I $D(XQY) D DONE Q
32 D OUT
33 QUIT
34DQREV ;DQ POINT FOR REVIEW ITEMS IN SUSPENSE
35 I $D(ZTQUEUED) S ZTREQ="@"
36 K ^TMP("PRPFAI",$J)
37 S ^TMP("PRPFAI",$J,+PRPF("DA"))=""
38 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
39DONE W:IOM-$X<10 ! W " ----DONE----" R X:2 G OUT
40GETPAT ;GET PATIENT IRN
41 S DIC=470,DIC(0)="AEMNQ" D ^DIC Q
42GETDATE ;GET SUSPENSE DATE
43 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
44GETITEM ;GET SUSPENSE ITEM
45 D GETDATE Q:Y<0 S DA(2)=DA(1),DA(1)=+Y,DIC=DIC_DA(1)_",1," D ^DIC Q
46NA W:IOM-$X<30 ! W " <Option terminated, no action taken>",*7 R X:2
47OUT K %W,C,DI,DIK,DIYS D DIKILL^PRPFQ,DIWKILL^PRPFQ,ZTKILL^PRPFQ Q
Note: See TracBrowser for help on using the repository browser.