| 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
|
|---|
