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

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

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