source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW301.m@ 1147

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

initial load of WorldVistAEHR
File size: 7.5 KB
Line 
1SCRPW301 ; BPFO/JRC - Performance Monitor Detailed Report ; 2/3/04 7:33am
2 ;;5.3;SCHEDULING;**292,335**;AUG 13, 1993
3 ;
4EN ;Main entry point for generation of local detailed report
5 ;Declare variable(s) and arrays
6 N SCRNARR,SORTARR
7 S SCRNARR="^TMP(""SCRPW"",$J,""SCRNARR"")"
8 S SORTARR="^TMP(""SCRPW"",$J,""SORTARR"")"
9 K @SCRNARR,@SORTARR
10 ;Get time limit
11 I '$$TLMT^SCRPW302(SCRNARR) D EX1 Q
12 ;Get date frame
13 I '$$DATE^SCRPW302("","",SCRNARR) D EX1 Q
14 ;Get division (one/many/all)
15 I '$$DIV^SCRPW302(SCRNARR) D EX1 Q
16 ;Get provider (one/many/all)
17 I '$$PROV^SCRPW302(SCRNARR) D EX1 Q
18 ;Get stop code (one/man/all)
19 I '$$DSS^SCRPW303(SCRNARR) D EX1 Q
20 ;Include scanned notes
21 I '$$SCAN^SCRPW302(SCRNARR) D EX1 Q
22 ;Get primary & secondary sort
23 I '$$SORT^SCRPW303(SORTARR) D EX1 Q
24 ;Queue report
25 W !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **",!!
26 N ZTDESC,ZTIO,ZTSAVE,TMP
27 S ZTIO=""
28 S ZTDESC="Performance Monitor Detailed Report"
29 S ZTSAVE("SCRNARR")=""
30 S TMP=$$OREF^DILF(SCRNARR)
31 S ZTSAVE(TMP)=""
32 I $D(@SCRNARR)#2 S ZTSAVE(SCRNARR)=""
33 S ZTSAVE("SORTARR")=""
34 S TMP=$$OREF^DILF(SORTARR)
35 S ZTSAVE(TMP)=""
36 I $D(@SORTARR)#2 S ZTSAVE(SORTARR)=""
37 D EN^XUTMDEVQ("EN1^SCRPW301",ZTDESC,.ZTSAVE)
38 D EX1
39 Q
40 ;
41EN1 ;Tasked entry point
42 ;Input : SCRNARR - Screen array
43 ; SORTARR - Sort array
44 ;Output : None
45 ;
46 ;Declare variables
47 N OUTARR,PAGENUM,ENODE,DFN,TMP
48 N SUB1,SUB2,PTRENC,DIV,PROV,TNODE,STOP
49 S OUTARR="^TMP(""SCRPW"",$J,""OUTARR"")"
50 S STOP=0
51 K @OUTARR
52 ;Get data
53 D GETDATA^SDPMUT1(SCRNARR,SORTARR,OUTARR)
54 ;Print summary page
55 S PAGENUM=1
56 D SUMMARY,WAIT I STOP D EXIT Q
57 ;Print detailed report
58 I '$D(@OUTARR) D EXIT Q
59 ;Loop through data
60 S STOP=0
61 S SUB1="" F S SUB1=$O(@OUTARR@("DETAIL",SUB1)) Q:SUB1="" D Q:STOP
62 .D PRTHEAD
63 .S SUB2="" F S SUB2=$O(@OUTARR@("DETAIL",SUB1,SUB2)) Q:SUB2="" D Q:STOP
64 ..S DFN=0 F S DFN=+$O(@OUTARR@("DETAIL",SUB1,SUB2,DFN)) Q:'DFN D Q:STOP
65 ...S PTRENC=0 F S PTRENC=+$O(@OUTARR@("DETAIL",SUB1,SUB2,DFN,PTRENC)) Q:'PTRENC D Q:STOP
66 ....S INFO=$G(@OUTARR@("DETAIL",SUB1,SUB2,DFN,PTRENC))
67 ....D PRTDTL
68 ....I $Y>(IOSL-5) D WAIT Q:STOP D PRTHEAD
69 ....Q
70 ...Q
71 ..Q
72 .Q:STOP
73 .D SUB1SUM,WAIT
74 .Q
75 ;Clean up and quit
76 D EXIT
77 Q
78 ;
79SUMMARY ;Summary Page
80 ;Input : SCRNARR - Screen array
81 ; OUTARR - Data array
82 ; PAGENUM - Page number
83 ;Output : None
84 ; PAGENUM is incremented by 1
85 ;
86 N DIV,PROV,DSS,INFO,PS
87 I $E(IOST)="C" W @IOF
88 W !,"Performance Monitor Detailed Report",?120,"Page: ",PAGENUM
89 W !!,"Run Date: ",$$HTE^XLFDT($H)
90 W !!,"Encounter Date Range: ",?15,$$FMTE^XLFDT($P(@SCRNARR@("RANGE"),U,1))
91 W " to ",$$FMTE^XLFDT($P(@SCRNARR@("RANGE"),U,2))
92 W !!,"Time limit for acceptable signatures: ",@SCRNARR@("TLMT")
93 W !!,"Division(s): "
94 I @SCRNARR@("DIVISION")=0 D
95 .S PS=0
96 .S DIV=0 F S DIV=$O(@SCRNARR@("DIVISION",DIV)) Q:'DIV D
97 ..S INFO=@SCRNARR@("DIVISION",DIV)
98 ..I ($L(INFO)+$X+3)>(IOM-1) W !,?13,"/ " S PS=0
99 ..I PS W " / "
100 ..W INFO
101 ..S PS=1
102 .Q
103 I @SCRNARR@("DIVISION")=1 W "All"
104 W !!,"Provider(s): "
105 I @SCRNARR@("PROVIDERS")=0 D
106 .S PS=0
107 .S PROV=0 F S PROV=$O(@SCRNARR@("PROVIDERS",PROV)) Q:'PROV D
108 ..S INFO=@SCRNARR@("PROVIDERS",PROV)
109 ..I ($L(INFO)+$X+3)>(IOM-1) W !,?13,"/ " S PS=0
110 ..I PS W " / "
111 ..W INFO
112 ..S PS=1
113 .Q
114 I @SCRNARR@("PROVIDERS")=1 W "All"
115 W !!,"DSS ID(s) : "
116 I @SCRNARR@("DSS")=0 D
117 .I @SCRNARR@("DSS-NTNL") W "All stop codes & credit pairs in national cohort" Q
118 .S PS=0
119 .S DSS=0 F S DSS=$O(@SCRNARR@("DSS",DSS)) Q:'DSS D
120 ..S INFO=@SCRNARR@("DSS",DSS)
121 ..I ($L(INFO)+$X+3)>(IOM-1) W !,?13,"/ " S PS=0
122 ..I PS W " / "
123 ..W INFO
124 ..S PS=1
125 I @SCRNARR@("DSS")=1 W "All"
126 W !!,"Count encounters with scanned notes: ",$S(@SCRNARR@("SCANNED"):"YES",1:"NO")
127 I '$D(@OUTARR) D Q
128 .W !
129 .W !,"*********************************************"
130 .W !,"* NOTHING TO REPORT FOR SELECTED CRITERIA *"
131 .W !,"*********************************************"
132 S INFO=$$SITE^VASITE()
133 W !!,"Total for facility ",$P(INFO,"^",2)," (",$P(INFO,"^",3),")"
134 I $$S^%ZTLOAD() W !! Q
135 S INFO=$G(@OUTARR@("SUMMARY"))
136 D PRTSUMS
137 Q
138 ;
139PRTSUMS ;Print summaries
140 ;Input : INFO - Summary information to print
141 ; SCRNARR - Screen array
142 ;Output : None
143 ;
144 N VAL
145 W !,"Encounters (denominator): ",+$P(INFO,U,1)
146 W ?34,"Compliant Notes (numerator): ",+$P(INFO,U,2)
147 W ?69,"Compliance Rate: "
148 S VAL=0 I +$P(INFO,U,1)&($P(INFO,U,1)-$P(INFO,U,7))>0 S VAL=100*($P(INFO,U,2)/($P(INFO,U,1)-$P(INFO,U,7)))
149 W $TR($J(VAL,3,0)," ")_" %"
150 W !,?5,"Encounter Providers: ",+$P(INFO,U,4)
151 W ?34,"DSS IDs: ",+$P(INFO,U,5),?53,"Ave Time: "
152 S VAL=0 I +$P(INFO,U,8) S VAL=$P(INFO,U,6)/$P(INFO,U,8)
153 W $TR($J(VAL,3,0)," ")
154 I $G(@SCRNARR@("SCANNED")) W ?71,"Scanned Notes: ",+$P(INFO,U,7)
155 Q
156 ;
157WAIT ;End of page logic
158 ;Input : None
159 ;Output : STOP - Flag indicating if printing should continue
160 ; 1 = Stop 0 = Continue
161 ;
162 S STOP=0
163 ;CRT - Prompt for continue
164 I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
165 .F Q:$Y>(IOSL-3) W !
166 .N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
167 .S DIR(0)="E"
168 .D ^DIR
169 .S STOP=$S(Y'=1:1,1:0)
170 ;Background task - check TaskMan
171 S STOP=$$S^%ZTLOAD()
172 I STOP D
173 .W !,"*********************************************"
174 .W !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
175 .W !,"*********************************************"
176 Q
177 ;
178PRTHEAD ;Report Heading
179 ;Input : SORTARR - Sort array
180 ; PAGENUM - Page number
181 ; SUB1 - Primary sort value
182 ;Output : None
183 ; PAGENUM is incremented by 1
184 ;
185 N SORT,SORTTEXT,DASH,TYPE
186 S SORT=$G(@SORTARR)
187 S SORTTEXT=$G(@SORTARR@("TEXT"))
188 S PAGENUM=PAGENUM+1
189 S $P(DASH,"-",IOM)="-"
190 W @IOF
191 W !,"Performance indicator detailed report",?120,"Page: ",PAGENUM
192 W !!,"Report for ",$P(SORTTEXT,U,1)," "
193 S TYPE=$P(SORT,U,1) D
194 .I TYPE=1 W $P(SUB1,U,1)," (",$P(SUB1,U,2),")" Q
195 .I TYPE=5 W $$FMTE^XLFDT(SUB1,"D") Q
196 .W SUB1
197 W " sorted by ",$P(SORTTEXT,U,2)
198 W !!,"Encounter",?40,"Primary Encounter",?62,"DSS"
199 W ?89,"Acceptable Provider",?112,"Date",?122,"Time"
200 W !,"Date",?11,"Patient Name",?34,"SSN",?40,"Provider",?62,"ID"
201 W ?67,"Clinic Name",?89,"Signing Progress Note",?112,"Signed"
202 W ?122,"Span"
203 W !,$E(DASH,1,9),?11,$E(DASH,1,21),?34,$E(DASH,1,4),?40,$E(DASH,1,20)
204 W ?62,$E(DASH,1,3),?67,$E(DASH,1,20),?89,$E(DASH,1,21),?112,$E(DASH,1,8)
205 W ?122,$E(DASH,1,5)
206 Q
207 ;
208PRTDTL ;Print detail line
209 ;Input : INFO - Detail information to print
210 ; DFN - Pointer to Patient
211 ; PTRENC - Pointer to Outpatient Encounter
212 ;Output : None
213 ;
214 N PROV,ENODE,VAL,VADM,VAERR,VA
215 D DEM^VADPT
216 S PROV=$$ENCPROV^SDPMUT2(PTRENC)
217 S ENODE=$G(^SCE(PTRENC,0))
218 S VAL=$$FMTE^XLFDT($P(ENODE,U,1),"2DF")
219 W !,$TR(VAL," ","0")
220 W ?11,$E(VADM(1),1,21)
221 W ?34,$E($P(VADM(2),U,1),6,10)
222 I PROV W ?40,$E($P($G(^VA(200,PROV,0)),U,1),1,20)
223 I 'PROV W ?40,"Provider Unknown"
224 S VAL=$P(ENODE,U,3)
225 S VAL=$P($G(^DIC(40.7,VAL,0)),U,2)
226 S:VAL="" VAL="???"
227 W ?62,VAL
228 S VAL=$P(ENODE,U,4)
229 S VAL=$P($G(^SC(VAL,0)),U,1)
230 S:VAL="" VAL="Clinic Unknown"
231 W ?67,$E(VAL,1,20)
232 S VAL=$P(INFO,U,1)
233 I VAL W ?89,$E($P($G(^VA(200,VAL,0)),U,1),1,21)
234 S VAL=$P(INFO,U,2)
235 I VAL S VAL=$$FMTE^XLFDT(VAL,"2DF") W ?112,$TR(VAL," ","0")
236 W ?122,$P(INFO,U,3)
237 Q
238 ;
239SUB1SUM ;Summary for primary sort
240 ;Input : SORTARR - Sort array
241 ; OUTARR - Data array
242 ; SUB1 - Primary sort value (1st subscript in OUTARR)
243 ;Output : None
244 ;
245 N SORT,SORTTEXT,TYPE,INFO
246 I $Y>(IOSL+6) D WAIT Q:STOP D PRTHEAD
247 S SORT=$G(@SORTARR)
248 S SORTTEXT=$G(@SORTARR@("TEXT"))
249 S INFO=$G(@OUTARR@("SUBTOTAL",SUB1))
250 W !!,"Total for ",$P(SORTTEXT,U,1)," "
251 S TYPE=$P(SORT,U,1) D
252 .I TYPE=1 W $P(SUB1,U,1)," (",$P(SUB1,U,2),")" Q
253 .I TYPE=5 W $$FMTE^XLFDT(SUB1,"D") Q
254 .W SUB1
255 D PRTSUMS
256 Q
257 ;
258EXIT ;Kill temporary arrays
259 K @OUTARR
260EX1 K @SCRNARR,@SORTARR
261 Q
Note: See TracBrowser for help on using the repository browser.