source: WorldVistAEHR/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFMIN.m

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PRPFMIN ;ALTOONA/CTB-CREATE MIN/MAS SEARCH LISTS ;4/15/02
2V ;;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
10DQ ;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
25OUT K DIJ,DP,DQTIME,IOX,IOY,MAX1,MAX2,MIN1,MIN2,PRPFQ,PRPFRNG,PRPFRNG2,PRIOP,SBAL,PRIOP,DIOEND
26 S ZTREQ="@"
27 QUIT
28NONE 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
30CK ;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)=""
35CK1 I MIN2=0!(MAX2=0) Q
36 I MIN2<MAX2,SBAL>MAX2!(SBAL<MIN2) S ^TMP("PRPFAG",$J,DA)=""
37 Q
Note: See TracBrowser for help on using the repository browser.