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

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

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