source: qrda/C0Q/trunk/p/C0QMU12.m@ 1572

Last change on this file since 1572 was 1572, checked in by Sam Habiel, 12 years ago

Updated routines with changes for patch 1 and 5. Patch 5 fixes several bugs:
Vitals date range now includes today's date.
Empty lists are now created in advance for Outpatient Measures.
Inverse date display for visit was incorrect. That is fixed.
Outpatient Quality Measure Set in Parameters is now used; before it was ignored.
In C0QUPDT, (all previous are in C0QMU12), the variable C0QNALT is newed. This variable is a flag to indicate whether a measure uses the reminders package or uses the quality measures package for a patient list. Previously, if not newed it adversely affects subsequenet processing of lists, as the counts of the patients depends on the value of the flag. For example, a measurement set that mixes quality measures with performance measures will calculate wrong counts for the quality measures.

Patch 1 adds support for real-data MU ERx Measure based on data from the eRx vendor.
File size: 17.6 KB
Line 
1C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List ; 10/10/12 11:28am
2 ;;1.0;QUALITY MEASURES;**1**;May 21, 2012;Build 32
3 ;
4 ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU
5 ;General Public License See attached copy of the License.
6 ;
7 ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED
8 ; FOR MEANINGFUL USE CALCULATION FOR FISCAL YEAR 2012 AT OROVILLE HOSPITAL
9 ;
10C0QPFN() Q 1130580001.401 ; PARAMETER FILE
11C0QPCFN() Q 1130580001.411 ; CLINIC SUBFILE
12C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
13C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
14INIT(ZARY,ZTYP) ; INITIALIZE THE PARAMETERS FOR BUILDING PATIENT LISTS
15 ; ZARY IS PASSED BY NAME
16 ; ZTYP IS "INP" OR "EP"
17 N ZMU S ZMU="MU12" ; THIS IS THE ONLY HARD CODED VALUE LEFT
18 ; TBD - CHANGE IT TO A READ FROM SYSTEM PARAMETERS
19 K @ZARY ; CLEAR RETURN ARRAY
20 N ZIEN,ZCNT,ZX
21 I $O(^C0Q(401,"MUTYP",ZMU,ZTYP,""))="" D Q ; OOPS NO RECORD THERE
22 . W !,"ERROR, NO PARAMETERS AVAILABLE"
23 S ZIEN=""
24 S ZCNT=0
25 F S ZIEN=$O(^C0Q(401,"MUTYP",ZMU,ZTYP,ZIEN)) Q:ZIEN="" D ;
26 . S ZCNT=ZCNT+1
27 . S @ZARY@(ZCNT,"MU")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.02)
28 . S @ZARY@(ZCNT,"TYPE")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.03)
29 . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",1,"I")
30 . S @ZARY@(ZCNT,"InpatientMeasurementSet")=ZX
31 . S @ZARY@(ZCNT,"InpatientBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
32 . S @ZARY@(ZCNT,"InpatientEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
33 . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
34 . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",2,"I")
35 . S @ZARY@(ZCNT,"EPMeasurementSet")=ZX
36 . S @ZARY@(ZCNT,"EPBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
37 . S @ZARY@(ZCNT,"EPEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
38 . S @ZARY@(ZCNT,"EPQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",2.1,"I")
39 . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
40 . D CLEAN^DILF
41 . D LIST^DIC($$C0QPCFN,","_ZIEN_",",".01I")
42 . I $D(^TMP("DIERR",$J)) D Q ; ERROR READING CLINIC LIST
43 . . W !,"ERROR READING CLINIC PARAMETER LIST"
44 . M @ZARY@(ZCNT,"CLINICS")=^TMP("DILIST",$J)
45 ;
46 Q
47 ;
48BUILD ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
49 ; patient lists
50 ;N GRSLT ; ARRAY FOR RESULTS
51 I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
52 I '$D(C0QPR) S C0QPR=0 ;default don't print out results
53 I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
54 S ZYR="MU12-"
55 D INITCLST ; initialize C0QLIST
56 N G1 ; ONE SET OF VALUES - RNF1 FORMAT
57 N C0QPARM
58 D INIT("C0QPARM","INP") ; initialize inpatient parms
59 I $O(C0QPARM(""))="" D Q ; no parms for inpatient
60 . W !,"No inpatient parameters"
61 N ZDIV S ZDIV=""
62 F S ZDIV=$O(C0QPARM(ZDIV)) Q:ZDIV="" D ; for each inpatient division
63 . D ALL ; all currently admitted patients in the hospital
64 . D DIS ; all patients discharged since the reporting period began
65 . I C0QSS D ZWRITE^C0QUTIL("GRSLT")
66 . ;D ICUPAT ; GENERATE ICU PATIENT LIST
67 . I C0QPL D ;
68 . . D FILE ; FILE THE PATIENT LISTS
69 . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientMeasurementSet")) ;
70 . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientQualitySet")) ;
71 . K C0QLIST
72 Q
73 ;
74INITCLST ; initialize C0QLIST
75 ; INITIALIZE LISTS
76 ; this is done so that if there are no matching patients, the patient list
77 ; will be zeroed out
78 K C0QLIST
79 S C0QLIST(ZYR_"HasDemographics")=""
80 S C0QLIST(ZYR_"Patient")="" ; VEN/SMH - Is this needed? Not used in EP.
81 S C0QLIST(ZYR_"HasProblem")=""
82 S C0QLIST(ZYR_"HasAllergy")=""
83 S C0QLIST(ZYR_"HasMed")=""
84 S C0QLIST(ZYR_"HasERX")="" ; VEN/SMH C0Q*1*5
85 S C0QLIST(ZYR_"HasMedRecon")="" ; VEN/SMH C0Q*1*5
86 S C0QLIST(ZYR_"HasVitalSigns")=""
87 S C0QLIST(ZYR_"HasMedOrders")=""
88 S C0QLIST(ZYR_"HasSmokingStatus")=""
89 Q
90 ;
91ALL ;retrieve active inpatients
92 N WARD S WARD=""
93 F D Q:WARD=""
94 . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
95 . Q:WARD=""
96 . N WIEN S WIEN=""
97 . F S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN D ;wards IEN
98 . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
99 . . N DFN,RB S DFN=""
100 . . F S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN D ;DFN of patient on ward
101 . . . D DEMO^C0QMU122
102 . . . D PROBLEM
103 . . . D ALLERGY
104 . . . D MEDS4
105 . . . D RECON2
106 . . . D ADVDIR
107 . . . D SMOKING
108 . . . D VITALS
109 . . . D VTE1
110 . . . D COD
111 . . . D EDTIME
112 . . . I C0QPR D PRINT^C0QMU121
113 . . . I C0QSS D SS^C0QMU121
114 . . . I C0QPL D PATLIST^C0QMU121
115 Q
116 ;
117PROBLEM ; PATIENT PROBLEMS
118 D LIST^ORQQPL(.PROBL,DFN,"A")
119 S PBCNT=""
120 F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
121 . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
122 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
123 E S C0QLIST(ZYR_"HasProblem",DFN)=""
124 K PROBL
125 Q
126 ;
127ALLERGY ; ALLERGY LIST
128 ; WANT TO CHANGE ALLERGIES FOR 2012 TO POPULATE THE C0QLIST DIRECTLY. GPL
129 D LIST^ORQQAL(.ALRGYL,DFN)
130 S ALCNT=""
131 F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
132 . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
133 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
134 E S C0QLIST(ZYR_"HasAllergy",DFN)=""
135 K ALRGYL
136 Q
137 ;
138MEDS4 ; USE OCL^PSOORRL TO GET ALL MEDS
139 ; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4
140 N BEG,END
141 S BEG=$$DT^C0QUTIL("JULY 3,2011")
142 S END=$$DT^C0QUTIL("NOW")
143 D OCL^PSOORRL(DFN,BEG,END) ;DBIA #2400
144 N C0QMEDS
145 M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL
146 N FOUND
147 N ZI
148 I '$D(C0QMEDS(1)) D Q ; QUIT IF NO MEDS
149 . S C0QLIST(ZYR_"NoMed",DFN)=""
150 E D ; HAS MEDS
151 . S C0QLIST(ZYR_"HasMed",DFN)=""
152 S ZI="" S FOUND=0
153 F S ZI=$O(C0QMEDS(ZI)) Q:ZI="" D ; FOR EACH MED
154 . N ZM
155 . S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION
156 . I $P($P(ZM,"^",1),";",2)="I" D ; IE 1U;I FOR AN INPATIENT UNIT DOSE
157 . . S FOUND=1
158 I FOUND S C0QLIST(ZYR_"HasMedOrders",DFN)="" ; MET CPOE MEASURE
159 E S C0QLIST(ZYR_"NoMedOrders",DFN)=""
160 Q
161 ;
162RECON ; MEDICATIONS RECONCILIATION
163 ; WANT TO SIMPLIFY MEDS RECON FOR 2012. GPL
164 ;
165 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ;
166 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
167 N HASRECON S HASRECON=0
168 N GT,G
169 S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
170 S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
171 I $$TXTALL^C0QNOTES(.G,.GT,DFN) D ; SEARCH ALL NOTES FOR MED RECON
172 . S HASRECON=1
173 ;N ZT
174 ;S ZT="MEDICATION RECONCILIATION COMPLET"
175 ;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D ;
176 ;. S HASRECON=1
177 ;E D ;
178 ;. S ZT="Medication Reconcilation Complete"
179 ;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D ;
180 ;. . S HASRECON=1
181 ;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1
182 I HASRECON D ;
183 . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
184 E S C0QLIST(ZYR_"NoMedRecon",DFN)=""
185 Q
186 ;
187RECON2 ; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION
188 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ;
189 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
190 I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D ;
191 . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
192 E S C0QLIST(ZYR_"NoMedRecon",DFN)=""
193 Q
194 ;
195ERX ; FOR EP, WE LOOK AT ERX MEDS
196 N ZI S ZI=""
197 N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
198 F S ZI=$O(@ZERX@(ZI)) Q:ZI="" D ;
199 . ;B
200 . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" D ;
201 . . S C0QLIST(ZYR_"HasMed",DFN)=""
202 . . S C0QLIST(ZYR_"HasMedOrders",DFN)=""
203 . . S C0QLIST(ZYR_"HasERX",DFN)=""
204 . . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
205 . E D ;
206 . . S C0QLIST(ZYR_"NoMed",DFN)=""
207 . . S C0QLIST(ZYR_"NoMedOrders",DFN)=""
208 . . S C0QLIST(ZYR_"NoERX",DFN)=""
209 . . S C0QLIST(ZYR_"NoMedRecon",DFN)=""
210 Q
211 ;
212ADVDIR ; ADVANCE DIRECTIVE
213 ;
214 I $$AGE^C0QUTIL(DFN)>64 D ; ONLY FOR PATIENTS 65 AND OLDER
215 . S C0QLIST(ZYR_"Over65",DFN)=""
216 . I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D ;
217 . . S C0QLIST(ZYR_"HasAdvanceDirective",DFN)=""
218 . E D ;
219 . . S C0QLIST(ZYR_"NoAdvanceDirective",DFN)=""
220 Q
221 ;
222SMOKING G SMOKING^C0QMU121
223VITALS ;
224 ;
225 N C0QSDT,C0QEDT
226 D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
227 D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
228 S C0QEDT=C0QEDT+.999999 ; Move to the end of the day! VEN/SMH C0Q*1*5
229 D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
230 I $D(VITRSLT) D ;ZWR VITRSLT B ;
231 . I VITRSLT(1)["No vitals found." S C0QLIST(ZYR_"NoVitalSigns",DFN)=""
232 . E S C0QLIST(ZYR_"HasVitalSigns",DFN)=""
233 Q
234 ;
235VTE1 ; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL
236 ;
237 I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D ;
238 . S C0QLIST(ZYR_"HasVTE24",DFN)=""
239 E S C0QLIST(ZYR_"NoVTE24",DFN)=""
240 Q
241 ;
242COD ; TEST FOR PRELIMINARY CAUSE OF DEATH NOTE
243 I $$HASNTYN^C0QNOTES("PRELIMINARY CAUSE OF DEATH",DFN) D ;
244 . S C0QLIST(ZYR_"CauseOfDeath",DFN)=""
245 Q
246 ;
247EDTIME ; CHECK FOR EMERGENCY DEPT TIME FACTORS
248 N FOUND
249 S FOUND=0
250 I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1
251 I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0
252 I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0
253 I FOUND D ;
254 . S C0QLIST(ZYR_"HasEDtime",DFN)=""
255 E S C0QLIST(ZYR_"NoEDtime",DFN)=""
256 Q
257 ;
258ICUPAT ; CREATE LIST OF ICU PATIENTS
259 N ZICU
260 S ZICU=$O(^SC("B","IC","")) ; IEN OF ICU HOSPITAL LOCATION
261 N ZI,ZJ,ZP
262 S ZI=""
263 F S ZI=$O(^AUPNVSIT("AHL",ZICU,ZI)) Q:ZI="" D ; EACH DATE
264 . S ZJ=""
265 . F S ZJ=$O(^AUPNVSIT("AHL",ZICU,ZI,ZJ)) Q:ZJ="" D ; EACH VISIT
266 . . S ZP=$P(^AUPNVSIT(ZJ,0),"^",5) ; DFN
267 . . S C0QLIST(ZYR_"ICUPatient",ZP)=""
268 Q
269 ;
270FILTER ; CALLED AFTER ALL THE PATIENT LISTS HAVE BEEN FILED
271 ; WILL KILL C0QLIST AND CREATE DERIVATIVE PATIENT LISTS BY FILTERING
272 K C0QLIST
273 N ZPAT
274 S ZPAT=$$PATLN(ZYR_"Patient") ; name of patient list of all patients admitted
275 ; during the reporting period. used to filter other lists
276 ;
277 ; filter ICU patients against ZPAT
278 N GN,GO,GF
279 S GN=ZPAT
280 S GO=$$PATLN(ZYR_"ICUPatient") ; all ICU patient
281 S GF=$NA(C0QLIST(ZYR_"ICUReporting")) ; the filtered list destination
282 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
283 ;
284 ; FILTER VTE-2 DENOMINATOR FOR QUALITY MEASURE
285 ;
286 S GN=$NA(C0QLIST(ZYR_"ICUReporting")) ; ICU patients admitted inside rpt period
287 S GO=$$RPATLN("MU VTE-2 DENOM PL") ; TAXONOMY BASED DENOMENATOR
288 S GF=$NA(C0QLIST(ZYR_"VTE2DEN")) ; NEW DENOMINATOR PL
289 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
290 ;
291 S GN=ZPAT
292 S GO=$$RPATLN("MU VTE-3 DENOM PL") ; TAXONOMY BASED DENOMENATOR
293 S GF=$NA(C0QLIST(ZYR_"VTE3DEN")) ; NEW DENOMINATOR PL
294 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
295 ;
296 S GN=ZPAT
297 S GO=$$RPATLN("MU VTE-4 DENOM PL") ; TAXONOMY BASED DENOMENATOR
298 S GF=$NA(C0QLIST(ZYR_"VTE4DEN")) ; NEW DENOMINATOR PL
299 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
300 ;
301 S GN=ZPAT
302 S GO=$$RPATLN("MU VTE-5 DENOM PL") ; TAXONOMY BASED DENOMENATOR
303 S GF=$NA(C0QLIST(ZYR_"VTE5DEN")) ; NEW DENOMINATOR PL
304 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
305 ;
306 D FILE ; FILE ALL THE PATIENT LISTS
307 D UPDATE^C0QUPDT(.G,5) ; UPDATE THE HOS 2011 MEANINGFUL USE measure set
308 Q
309 ;
310ED1 ;
311 S ZYR="MU12-"
312 D DOTIME^C0QMU121("ED DEPARTURE TIME")
313 Q
314 ;
315ED2 ;
316 S ZYR="MU12-"
317 D DOTIME2^C0QMU121("TIME DECISION TO ADMIT MADE")
318 Q
319 ;
320RPATLN(ZLST) ; EXTRINSIC RETURNS THE GLOBAL NAME OF THE REMINDER PATIENT LIST
321 ; WHOSE NAME IS ZLST
322 N ZIEN,ZN
323 S ZIEN=$O(^PXRMXP(810.5,"B",ZLST,"")) ; ien of patient list
324 S ZN=$NA(^PXRMXP(810.5,ZIEN,30,"B")) ; GLOBAL NAME IN REMINDER PATIENT LIST
325 Q ZN
326 ;
327PATLN(ZATTR) ; EXTRINSIC RETURNS THE NAME OF THE PATIENT LIST WITH
328 ; THE ATTRIBUTE ZATTR
329 N ZIEN,ZN
330 S ZIEN=$O(^C0Q(301,"CATTR",ZATTR,"")) ; ien of patient list
331 S ZN=$NA(^C0Q(301,ZIEN,1,"B")) ; NAME OF PATIENT LIST IN C0Q PATIENT LIST
332 Q ZN
333 ;
334INLIST(ZLIST,DFN) ; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST
335 N ZL,ZR
336 S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE
337 I ZL="" Q 0 ; LIST DOES NOT EXIST
338 S ZR=0 ; ASSUME NOT IN LIST
339 I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
340 Q ZR
341 ;
342LOCPAT(PREFIX,LOC) ;retrieve active outpatients
343 ; PREFIX WILL GO IN C0XLIST(PREFIX_"-PATIENT",DFN)=""
344 ; LOC IS HOSPITAL LOCATION
345 S ULOC=$O(^SC("B",LOC,"")) ; IEN OF HOSPITAL LOCATION
346 I ULOC="" D Q ; OOPS
347 . W !,"HOSPITAL LOCATION NOT FOUND: ",LOC
348 S IDTE=9999999-DTE ; INVERSE DATE
349 N ZI
350 S ZI="" ; BEGIN AT LATEST DATE FOR THIS LOC IN VISIT FILE
351 F S ZI=$O(^AUPNVSIT("AHL",ULOC,ZI)) Q:(ZI="")!(ZI>IDTE) D ; FOR EACH DATE
352 . N C0QDATE S C0QDATE=9999999-$P(ZI,".")_"."_$P(ZI,".",2) ; VEN/SMH *5
353 . W !,$$FMTE^XLFDT(C0QDATE) ; VEN/SMH *5
354 . I ZI="" Q ;
355 . N ZJ S ZJ=""
356 . F S ZJ=$O(^AUPNVSIT("AHL",ULOC,ZI,ZJ)) Q:ZJ="" D ; FOR EACH VISIT
357 . . S DFN=$$GET1^DIQ(9000010,ZJ,.05,"I") ; PATIENT
358 . . S C0QLIST(PREFIX_"Patient",DFN)=""
359 Q
360 ;
361EPPAT(ZYR) ; BUILD ALL PATIENT LISTS FOR CLINICS
362 ;
363 S DTE=3111000
364 S MUYR=ZYR
365 N ZC,ZN
366 S ZN=0
367 N ZI S ZI=0
368 F S ZI=$O(^SC(ZI)) Q:+ZI=0 D ; FOR EVERY HOSPITAL LOCATION
369 . I $$GET1^DIQ(44,ZI_",",2,"I")'="C" Q ; NOT A CLINIC
370 . S ZC=$$GET1^DIQ(44,ZI_",",.01) ; NAME OF CLINIC
371 . S ZCIEN=ZI ; IEN OF CLINIC
372 . S ZN=ZN+1 ; COUNT OF CLINICS
373 . S PRE=MUYR_"-EP-"_ZC_"-"
374 . D LOCPAT(PRE,ZC)
375 W !,"NUMBER OF CLINICS: ",ZN
376 D FILE ; CREATE ALL THE EP PATIENT LISTS
377 Q
378 ;
379DOEP ; DO EP COMPUTATIONS
380 S ZYR="MU12-"
381 N C0QPARM,C0QCLNC
382 D INIT("C0QPARM","EP") ; INITIALIZE PARAMETERS
383 K C0QLIST ; CLEAR THE LIST
384 N ZI S ZI=""
385 F S ZI=$O(C0QPARM(ZI)) Q:ZI="" D ; FOR EACH EP
386 . S DTE=C0QPARM(ZI,"EPBeginDate") ; beginning of measurement period
387 . S EDTE=C0QPARM(ZI,"EPEndDate") ; end of measurement period -- tbd use this
388 . S C0QCLNC=C0QPARM(ZI,"CLINICS",1,1) ; only one clinic for now
389 . S PRE=ZYR_"EP-"_C0QCLNC_"-"
390 . D LOCPAT(PRE,C0QCLNC) ; GET THE PATIENTS
391 . I $D(DEBUG) D ZWRITE^C0QUTIL("C0QLIST")
392 . M C0QLIST(ZYR_"EP-ALL-PATIENTS")=C0QLIST(PRE_"Patient")
393 S DFN=""
394 S ZYR=ZYR_"EP-"
395 D INITCLST ; VEN/SMH - Initialize Empty Lists just in case we don't have
396 ; any. C0Q*1*5
397 F S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN="" D ; EACH PATIENT
398 . D DEMO^C0QMU122
399 . D PROBLEM
400 . D ALLERGY
401 . ;D MEDS
402 . D ERX
403 . D SMOKING
404 . D VITALS
405 D FILE ; FILE THE PATIENT LISTS
406 ;
407 ; Now process eRx MU measures for these patients
408 ; Check for eRx template and code first; if they exist, run the code
409 I $D(^C0PX("B","GETMEDS6")),$L($T(SOAP^C0PWS2)) DO
410 . N C0QDEBUG S C0QDEBUG=1 ; This causes the code to print out data;
411 . D EN^C0QMUERX($$PATLN^C0QMU12(ZYR_"HasERX")) ; Pass the eRx patient list
412 ;
413 N ZI S ZI=""
414 F S ZI=$O(C0QPARM(ZI)) Q:ZI="" D ;
415 . N C0QDEBUG S C0QDEBUG=1 ; This causes the code to print out data;
416 . D UPDATE^C0QUPDT(.G,C0QPARM(ZI,"EPMeasurementSet")) ; UPDATE THE MU MEASUREMENT SET
417 . ; VEN/SMH -- Quality Set missing for Outpatient -- adding
418 . D UPDATE^C0QUPDT(.G,C0QPARM(ZI,"EPQualitySet")) ; C0Q*1*5
419 Q
420 ;
421DIS ;
422 N DFN,DTE,EXDTE S DTE=""
423 F D Q:DTE=""
424 . S DTE=$O(^DGPM("B",DTE))
425 . Q:'DTE
426 . ;Q:$P(DTE,".")<3110703
427 . Q:$P(DTE,".")<3111000 ; NEW BEGIN DATE FOR FISCAL YEAR 2012
428 . S EXDTE=$$FMTE^XLFDT(DTE)
429 . N PTFM S PTFM=""
430 . D
431 . . S PTFM=$O(^DGPM("B",DTE,PTFM))
432 . . Q:'PTFM
433 . . S DFN=$P(^DGPM(PTFM,0),U,3)
434 . . S C0QLIST(ZYR_"Patient",DFN)=""
435 . . D DEMO^C0QMU122
436 . . D PROBLEM
437 . . D ALLERGY
438 . . D MEDS4
439 . . D RECON2
440 . . D ADVDIR
441 . . D SMOKING
442 . . D VITALS
443 . . ;D:$P(DTE,".")>3110912 VTE1
444 . . D VTE1
445 . . D COD
446 . . D EDTIME
447 . . I C0QPR D PRINT^C0QMU121
448 . . I C0QSS D SS^C0QMU121
449 . . I C0QPL D PATLIST^C0QMU121
450 Q
451 ;
452C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
453C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
454FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
455 ;
456 I '$D(C0QLIST) Q ;
457 N LFN S LFN=$$C0QALFN()
458 N ZI,ZN
459 S ZI=""
460 F S ZI=$O(C0QLIST(ZI)) Q:ZI="" D ;
461 . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
462 . I ZN="" D ; LIST NOT FOUND, CREATE IT
463 . . K C0QFDA
464 . . S FN=$$C0QPLF ; C0Q PATIENT LIST FILE
465 . . S C0QFDA(FN,"+1,",.01)=ZI
466 . . S C0QFDA(FN,"+1,",999)=ZI ; ATTRIBUTE
467 . . W !,"CREATING ",ZI
468 . . D UPDIE ; ADD THE RECORD
469 . . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) ; THE NEW IEN
470 . ;I ZN="" D Q ; OOPS
471 . ;. W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
472 . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
473 . N C0QNEW,C0QOLD,C0QRSLT
474 . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
475 . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
476 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
477 . N ZJ,ZK
478 . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
479 . K C0QFDA
480 . S ZJ=""
481 . F S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ="" D ; MARKED WITH A 2 FROM UNITY
482 . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
483 . . I ZK="" D Q ; OOPS SHOULDN'T HAPPEN
484 . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
485 . . . S $EC=",U1130580001," ; smh - instead of a BREAK
486 . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
487 . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
488 . ; SECOND, PROCESS THE ADDITIONS
489 . K C0QFDA
490 . S ZJ="" S ZK=1
491 . F S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ="" D ; PATIENTS TO ADD ARE MARKED WITH 0
492 . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
493 . . S ZK=ZK+1
494 . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
495 ;. Q
496 ;. K C0QFDA
497 ;. N ZJ,ZC
498 ;. S ZJ="" S ZC=1
499 ;. F S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ="" D ; FOR EACH PAT IN LIST
500 ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
501 ;. . S ZC=ZC+1
502 ;. D UPDIE
503 ;. W !,"FOUND:"_ZI
504 Q
505 ;
506KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
507 ;
508 N C0QFDA,ZFN,LIST,ATTR
509 S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
510 D CLEAN^DILF
511 S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ; MEASURE NAME
512 S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
513 D CLEAN^DILF
514 K ZERR
515 S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
516 D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
517 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
518 ;. W "ERROR",!
519 ;. ZWR ZERR
520 ;. B
521 K C0QFDA
522 S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
523 S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
524 D UPDIE ; CREATE THE SUBFILE
525 N ZR ; NEW IEN FOR THE RECORD
526 S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
527 ;
528 Q ZR
529 ;
530UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
531 K ZERR
532 D CLEAN^DILF
533 D UPDATE^DIE("","C0QFDA","","ZERR")
534 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
535 K C0QFDA
536 Q
537 ;
538END ;end of C0QPRML;
Note: See TracBrowser for help on using the repository browser.