PRPFMIN ;ALTOONA/CTB-CREATE MIN/MAS SEARCH LISTS ;4/15/02
V ;;3.0;PATIENT FUNDS;**6,8,13**;JUNE 1, 1989
 D SELRNG^PRPFQ
 I PRPFRNG="" D OUT QUIT
 I PRPFRNG="@" S PRPFRNG2=""
 E  S PRPFRNG2=PRPFRNG
 S ZTSAVE("PRPFRNG")=PRPFRNG,ZTSAVE("PRPFRNG2")=PRPFRNG2
 S ZTRTN="DQ^PRPFMIN",ZTDESC=$P($T(DQ),";",3) D ^PRPFQ
 K %X,DFN,DG1,DGT,DGX Q
DQ ;MIN/MAX PATIENT FUNDS REPORT
 S PRIOP=ION
 K ^TMP("PRPFAF",$J)
 K ^TMP("PRPFAG",$J)
 S DA=0 S X="I'm now beginning to search the file." D MSG^PRPFQ
 F I=1:1 S DA=$O(^PRPF(470,DA)) Q:'DA  D CK I I#25=0,'$D(ZTQUEUED) W "."
 I '$D(^TMP("PRPFAF",$J)),'$D(^TMP("PRPFAG",$J)) D NONE QUIT
 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_""
 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
 S:PRPFRNG="@" BY="@73,@73:99;S1,.01",FR="@,@",TO=","
 W !,"" D EN1^DIP I '$D(ZTQUEUED) D ENCON^PRPFQ
 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_""
 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
 S:PRPFRNG="@" BY="@73,@73:99;S1,.01",FR="@,@",TO=","
 W !,"" D EN1^DIP I '$D(ZTQUEUED) D ENCON^PRPFQ
OUT K DIJ,DP,DQTIME,IOX,IOY,MAX1,MAX2,MIN1,MIN2,PRPFQ,PRPFRNG,PRPFRNG2,PRIOP,SBAL,PRIOP,DIOEND
 S ZTREQ="@"
 QUIT
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
 Q
CK ;CHECKS BALANCES
 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)
 Q:$P(^PRPF(470,DA,0),U,2)="I"  ; <<<< by REW in patch 8 to suppress inactives
 I MIN1=0!(MAX1=0) G CK1
 I MIN1<MAX1 I SBAL>MAX1!(SBAL<MIN1) S ^TMP("PRPFAF",$J,DA)=""
CK1 I MIN2=0!(MAX2=0) Q
 I MIN2<MAX2,SBAL>MAX2!(SBAL<MIN2) S ^TMP("PRPFAG",$J,DA)=""
 Q