source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW44.m@ 1096

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1SCRPW44 ;RENO/KEITH - Means Test/Eligibility/Enrollment Report (cont.) ; 03 Feb 99 2:10 PM
2 ;;5.3;Scheduling;**144,176**;AUG 13, 1993
3START ;Print report
4 D S44^SCRPW42 Q
5 ;
6DPRT(SDIV) ;Print a division
7 ;Required input: SDIV=division ifn or '0' for facility totals
8 I 'SDPG S SDTIT(2)="Report parameters selected",SDPAGE=1 D HDR Q:SDOUT D PD1^SCRPW43(0) Q:SDOUT
9 S SDPAGE=1 D DHDR^SCRPW40(2,.SDTIT)
10 D HDR Q:SDOUT I '$D(^TMP("SCRPW",$J,0,SDIV)) S SDX="No activity found that meets the report criteria!" W !!?(IOM-$L(SDX)\2),SDX Q
11 D SUMM(SDIV) Q:SDOUT Q:$P(SD("FMT",1),U)'="D"
12 S SDTIT(2)="Detail by "_$P(SD("FMT",2),U,2)_" for:"_$P(SDTIT(2),":",2) D PRTD Q
13 ;
14STOP ;Check for stop task request
15 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
16 ;
17HDR ;Print report header
18 I $E(IOST)="C",SDPG N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
19 D STOP Q:SDOUT
20 I SDPG!($E(IOST)="C") W $$XY^SCRPW50(IOF,1,0)
21 W:$X $$XY^SCRPW50("",0,0) W SDLINE N SDI S SDI=0 F S SDI=$O(SDTIT(SDI)) Q:'SDI W !?(IOM-$L(SDTIT(SDI))\2),SDTIT(SDI)
22 W !,SDLINE,!,"For date range: ",$P(SD("BDT"),U,2)," to ",$P(SD("EDT"),U,2),!,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPG=1,SDPAGE=SDPAGE+1,SDPGL=0 Q
23 ;
24SUMM(SDIV) ;Print summary for a division
25 ;Required input: SDIV=division ifn or '0' for facility total
26 D SHDS("E N C O U N T E R M E A N S T E S T I N D I C A T O R","Means Test indicator") Q:SDOUT D SLP("MT") Q:SDOUT D STOT Q:SDOUT
27 D SHDS("E N C O U N T E R E L I G I B I L I T Y","Encounter eligibility") Q:SDOUT D SLP("EE") Q:SDOUT D STOT Q:SDOUT
28 D SHDS("C U R R E N T E N R O L L M E N T P R I O R I T Y","Enrollment priority") Q:SDOUT D SLP("EP") Q:SDOUT D STOT Q
29 ;
30SHDS(SDX,SDY) ;Print subheader for summary
31 D:$Y>(IOSL-8) HDR Q:SDOUT
32 W !!?(IOM-$L(SDX)\2),SDX,!?(IOM-$L(SDX)\2),$E(SDLINE,1,$L(SDX))
33 W !?(C),SDY,?(C+40),"Encounters",?(C+59),"Visits",?(C+73),"Uniques",!?(C),$E(SDLINE,1,30),?(C+40),$E(SDLINE,1,10),?(C+55),$E(SDLINE,1,10),?(C+70),$E(SDLINE,1,10) Q
34 ;
35SLP(SDI) ;Print summary line
36 S SDX="" F S SDX=$O(^TMP("SCRPW",$J,0,SDIV,SDI,SDX)) Q:SDX=""!SDOUT D
37 .S SDE=^TMP("SCRPW",$J,0,SDIV,SDI,SDX,"ENC"),SDV=$P(SDE,U,2),SDU=$P(SDE,U,3),SDE=$P(SDE,U)
38 .Q:SDOUT D:$Y>(IOSL-2) HDR Q:SDOUT
39 .W !?(C),SDX,?(C+40),$J(SDE,10,0),?(C+55),$J(SDV,10,0),?(C+70),$J(SDU,10,0)
40 .Q
41 Q
42 ;
43STOT ;Print summary total
44 D:$Y>(IOSL-3) HDR Q:SDOUT
45 S SDE=^TMP("SCRPW",$J,0,SDIV,"RPT","ENC"),SDV=$P(SDE,U,2),SDU=$P(SDE,U,3),SDE=$P(SDE,U)
46 W !?(C),$E(SDLINE,1,30),?(C+40),$E(SDLINE,1,10),?(C+55),$E(SDLINE,1,10),?(C+70),$E(SDLINE,1,10),!?(C),"TOTAL:",?(C+40),$J(SDE,10,0),?(C+55),$J(SDV,10,0),?(C+70),$J(SDU,10,0)
47 Q
48 ;
49PRTD ;Print detail
50 I '$D(^TMP("SCRPW",$J,1,SDIV)) D HDR Q:SDOUT N SDX S SDX="No activity found for this division for selected detail category elements." W !!?(IOM-$L(SDX)\2),SDX Q
51 S S0="" F S S0=$O(^TMP("SCRPW",$J,1,SDIV,S0)) Q:S0=""!SDOUT D HDR,HD1 Q:SDOUT D PRT0
52 Q
53 ;
54PRT0 ;Print 0 sorts
55 S SDT(0)=0 I SD("SORT") D PRT1 Q
56 D SHD(0),HD2 S SDPNAM=""
57 F S SDPNAM=$O(^TMP("SCRPW",$J,1,SDIV,S0,SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,1,SDIV,S0,SDPNAM,DFN)) Q:'DFN!SDOUT S SDX=^TMP("SCRPW",$J,1,SDIV,S0,SDPNAM,DFN) D PLINE(0)
58 Q
59 ;
60PRT1 ;Print 1 sort
61 S S1="" F S S1=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1)) Q:S1=""!SDOUT D
62 .S SDT(1)=0 D:SD("PAGE")=1&SDPGL HDR,HD1 Q:SDOUT
63 .I SD("SORT")=1 D PRT11 Q
64 .D PRT2,SST(1) Q
65 Q
66 ;
67PRT2 ;Print 2 sorts
68 S S2="" F S S2=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1,S2)) Q:S2=""!SDOUT D
69 .S SDT(2)=0 D:SD("PAGE")=2&SDPGL HDR,HD1 Q:SDOUT
70 .I SD("SORT")=2 D PRT21 Q
71 .D PRT3,SST(2) Q
72 Q
73 ;
74PRT3 ;Print 3 sorts
75 S S3="" F S S3=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1,S2,S3)) Q:S3=""!SDOUT D
76 .S SDT(3)=0 D:SD("PAGE")=3&SDPGL HDR,HD1 Q:SDOUT
77 .I SD("SORT")=3 D PRT31 Q
78 .D PRT4,SST(3) Q
79 Q
80 ;
81PRT4 ;Print 4 sorts
82 S S4="" F S S4=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1,S2,S3,S4)) Q:S4=""!SDOUT D
83 .S SDUI=$$DSV^SCRPW43(SDIV,S0,S1,S2,S3,S4)
84 .S SDT(4)=0 D:SD("PAGE")=4&SDPGL HDR,HD1 Q:SDOUT
85 .I SD("SORT")=4 D PRT41 Q
86 .D PRT5,SST(4) Q
87 Q
88 ;
89PRT5 ;Print 5 sorts
90 S S5="" F S S5=$O(^TMP("SCRPW",$J,2,SDUI,S5)) Q:S5=""!SDOUT D
91 .S SDT(5)=0 D:SD("PAGE")=5&SDPGL HDR,HD1 Q:SDOUT
92 .I SD("SORT")=5 D PRT51 Q
93 .D PRT6,SST(5) Q
94 Q
95 ;
96PRT6 ;Print 6 sorts
97 S S6="" F S S6=$O(^TMP("SCRPW",$J,2,SDUI,S5,S6)) Q:S6=""!SDOUT S SDT(6)=0 D:SD("PAGE")=6&SDPGL HDR,HD1 Q:SDOUT D PRT61
98 Q
99 ;
100PRT11 D SHD(1),HD2 S SDPNAM=""
101 F S SDPNAM=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1,SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1,SDPNAM,DFN)) Q:'DFN!SDOUT S SDX=^TMP("SCRPW",$J,1,SDIV,S0,S1,SDPNAM,DFN) D PLINE(1)
102 W ! D SST(1) Q
103 ;
104PRT21 D SHD(2),HD2 S SDPNAM=""
105 F S SDPNAM=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1,S2,SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1,S2,SDPNAM,DFN)) Q:'DFN!SDOUT S SDX=^TMP("SCRPW",$J,1,SDIV,S0,S1,S2,SDPNAM,DFN) D PLINE(2)
106 W ! D SST(2) Q
107 ;
108PRT31 D SHD(3),HD2 S SDPNAM=""
109 F S SDPNAM=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1,S2,S3,SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,1,SDIV,S0,S1,S2,S3,SDPNAM,DFN)) Q:'DFN!SDOUT S SDX=^TMP("SCRPW",$J,1,SDIV,S0,S1,S2,S3,SDPNAM,DFN) D PLINE(3)
110 W ! D SST(3) Q
111 ;
112PRT41 D SHD(4),HD2 S SDPNAM=""
113 F S SDPNAM=$O(^TMP("SCRPW",$J,2,SDUI,SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,2,SDUI,SDPNAM,DFN)) Q:'DFN!SDOUT S SDX=^TMP("SCRPW",$J,2,SDUI,SDPNAM,DFN) D PLINE(4)
114 W ! D SST(4) Q
115 ;
116PRT51 D SHD(5),HD2 S SDPNAM=""
117 F S SDPNAM=$O(^TMP("SCRPW",$J,2,SDUI,S5,SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,2,SDUI,S5,SDPNAM,DFN)) Q:'DFN!SDOUT S SDX=^TMP("SCRPW",$J,2,SDUI,S5,SDPNAM,DFN) D PLINE(5)
118 W ! D SST(5) Q
119 ;
120PRT61 D SHD(6),HD2 S SDPNAM=""
121 F S SDPNAM=$O(^TMP("SCRPW",$J,2,SDUI,S5,S6,SDPNAM)) Q:SDPNAM=""!SDOUT S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,2,SDUI,S5,S6,SDPNAM,DFN)) Q:'DFN!SDOUT S SDX=^TMP("SCRPW",$J,2,SDUI,S5,S6,SDPNAM,DFN) D PLINE(6)
122 W ! D SST(6) Q
123 ;
124SHD(SDLEV) ;Print sort subheaders
125 ;Required input: SDLEV=number of sort levels
126 Q:SDOUT
127 I $Y>(IOSL-SDLEV-6) D HDR,HD1 S SDPGL=0 Q:SDOUT
128 W:(SD("PAGE")'=SD("SORT")&SDPGL) !!,SDLINE S SDPGL=1
129 I SD("SORT") W ! N SDI S SDI=0 D W !
130 .F S SDI=$O(SD("SORT",SDI)) Q:'SDI W !?(5*SDI),$P(SD("SORT",SDI),U,2),": ",@("S"_SDI)
131 .Q
132 Q
133 ;
134PLINE(SDLEV) ;Print detail line
135 D:$Y>(IOSL-3) HDR,HD1,HD2 Q:SDOUT D ELIG^VADPT S SDMTS=$P(VAEL(9),U,2),SDMTS=$S($L(SDMTS)>13:$E(SDMTS,1,13)_".",1:SDMTS)
136 W !,SDPNAM,?32,$P(SDX,U),?44,$P(SDX,U,2),?67,$P(SDX,U,3),?99,$P(SDX,U,4)
137 N SDI F SDI=0:1:SDLEV S SDT(SDI)=SDT(SDI)+1
138 Q
139 ;
140SST(SDLEV) ;Print sort subtotal
141 D:$Y>(IOSL-3) HDR,HD1 Q:SDOUT
142 W !?(5*SDLEV),"SUBTOTAL: ",SDT(SDLEV)," " S SDX=$P(SD("SORT",SDLEV),U,2)_" = "_@("S"_SDLEV),SDX=$E(SDX,1,(130-$X)) W "(",SDX,")" Q
143 ;
144HD1 ;Print detail category
145 Q:SDOUT S SDZ=$P(SD("FMT",2),U,2)_": "_S0 W !?(IOM-$L(SDZ)\2),SDZ,!?(IOM-$L(SDZ)\2),$E(SDLINE,1,$L(SDZ)) Q
146 ;
147HD2 ;Print detail subheader
148 Q:SDOUT D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT W !,"Patient:",?32,"SSN:",?44,"Means Test Indicator:",?67,"Encounter Eligibility:",?99,"Enrollment Priority:" Q
Note: See TracBrowser for help on using the repository browser.