1 | PRPFMIN ;ALTOONA/CTB-CREATE MIN/MAS SEARCH LISTS ;4/15/02
|
---|
2 | V ;;3.0;PATIENT FUNDS;**6,8,13**;JUNE 1, 1989
|
---|
3 | D SELRNG^PRPFQ
|
---|
4 | I PRPFRNG="" D OUT QUIT
|
---|
5 | I PRPFRNG="@" S PRPFRNG2=""
|
---|
6 | E S PRPFRNG2=PRPFRNG
|
---|
7 | S ZTSAVE("PRPFRNG")=PRPFRNG,ZTSAVE("PRPFRNG2")=PRPFRNG2
|
---|
8 | S ZTRTN="DQ^PRPFMIN",ZTDESC=$P($T(DQ),";",3) D ^PRPFQ
|
---|
9 | K %X,DFN,DG1,DGT,DGX Q
|
---|
10 | DQ ;MIN/MAX PATIENT FUNDS REPORT
|
---|
11 | S PRIOP=ION
|
---|
12 | K ^TMP("PRPFAF",$J)
|
---|
13 | K ^TMP("PRPFAG",$J)
|
---|
14 | S DA=0 S X="I'm now beginning to search the file." D MSG^PRPFQ
|
---|
15 | F I=1:1 S DA=$O(^PRPF(470,DA)) Q:'DA D CK I I#25=0,'$D(ZTQUEUED) W "."
|
---|
16 | I '$D(^TMP("PRPFAF",$J)),'$D(^TMP("PRPFAG",$J)) D NONE QUIT
|
---|
17 | S IOP=PRIOP,DIC="^PRPF(470,",L=0,L(0)=1,BY="@73:99;S1,.01",BY(0)="^TMP(""PRPFAF"",$J,",FLDS="[PRPF MIN/MAX1]",FR=""_PRPFRNG_"",TO=""_PRPFRNG2_""
|
---|
18 | S DIOEND="K ^TMP(""PRPFAF"") W !,""The information contained in this report is protected by the Privacy Act of 1974""" D:'$D(ZTQUEUED) WAIT^PRPFYN
|
---|
19 | S:PRPFRNG="@" BY="@73,@73:99;S1,.01",FR="@,@",TO=","
|
---|
20 | W !,"" D EN1^DIP I '$D(ZTQUEUED) D ENCON^PRPFQ
|
---|
21 | S IOP=PRIOP,DIC="^PRPF(470,",L=0,L(0)=1,BY="@73:99;S1,.01",BY(0)="^TMP(""PRPFAG"",$J,",FLDS="[PRPF MIN/MAX2]",FR=""_PRPFRNG_"",TO=""_PRPFRNG2_""
|
---|
22 | S DIOEND="K ^TMP(""PRPFAG"") W !,""The information contained in this report is protected by the Privacy Act of 1974""" D:'$D(ZTQUEUED) WAIT^PRPFYN
|
---|
23 | S:PRPFRNG="@" BY="@73,@73:99;S1,.01",FR="@,@",TO=","
|
---|
24 | W !,"" D EN1^DIP I '$D(ZTQUEUED) D ENCON^PRPFQ
|
---|
25 | OUT K DIJ,DP,DQTIME,IOX,IOY,MAX1,MAX2,MIN1,MIN2,PRPFQ,PRPFRNG,PRPFRNG2,PRIOP,SBAL,PRIOP,DIOEND
|
---|
26 | S ZTREQ="@"
|
---|
27 | QUIT
|
---|
28 | NONE S IOP=ION W @IOF D NOW^PRPFQ W "PATIENT FUNDS MIN/MAX REPORT",?50,%X,!!,"No matches were found while running this report." W:$E($G(IOST))="P" @IOF
|
---|
29 | Q
|
---|
30 | CK ;CHECKS BALANCES
|
---|
31 | Q:'+$D(^PRPF(470,DA,2)) S A=^(2),MIN1=+$P(A,U),MAX1=+$P(A,U,2),MIN2=+$P(A,U,3),MAX2=+$P(A,U,4),SBAL=$S($D(^(1)):$P(^(1),U,4),1:0)
|
---|
32 | Q:$P(^PRPF(470,DA,0),U,2)="I" ; <<<< by REW in patch 8 to suppress inactives
|
---|
33 | I MIN1=0!(MAX1=0) G CK1
|
---|
34 | I MIN1<MAX1 I SBAL>MAX1!(SBAL<MIN1) S ^TMP("PRPFAF",$J,DA)=""
|
---|
35 | CK1 I MIN2=0!(MAX2=0) Q
|
---|
36 | I MIN2<MAX2,SBAL>MAX2!(SBAL<MIN2) S ^TMP("PRPFAG",$J,DA)=""
|
---|
37 | Q
|
---|