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

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

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