source: qrda/C0Q/trunk/kids/C0Q_1P_PAT1T1.KID@ 1482

Last change on this file since 1482 was 1458, checked in by Sam Habiel, 13 years ago

Some clean-up

File size: 127.0 KB
RevLine 
[1458]1KIDS Distribution saved on Jun 13, 2012@17:53:55
2C0Q 1.0 T1 PATCH 1
3**KIDS**:C0Q*1.0T1*1^
4
5**INSTALL NAME**
6C0Q*1.0T1*1
7"BLD",7937,0)
8C0Q*1.0T1*1^QUALITY MEASURES^0^3120613^y
9"BLD",7937,1,0)
10^^90^90^3120613^^
11"BLD",7937,1,1,0)
12ePrescribing MU measure in this package.
13"BLD",7937,1,2,0)
14
15"BLD",7937,1,3,0)
16Dependencies:
17"BLD",7937,1,4,0)
18This build requires C0P*1*4 for the new WebService entry that gets MU
19"BLD",7937,1,5,0)
20data from New Crop.
21"BLD",7937,1,6,0)
22This build requires the base C0Q 1.0 to be installed.
23"BLD",7937,1,7,0)
24
25"BLD",7937,1,8,0)
26This build performs the following:
27"BLD",7937,1,9,0)
28Routines:
29"BLD",7937,1,10,0)
301. Adds routine C0QMUERX for calculation of ePrescribing stats.
31"BLD",7937,1,11,0)
322. Mods routine C0QMU12 to call C0QMUERX for the ERX measure for
33"BLD",7937,1,12,0)
34Outpatients.
35"BLD",7937,1,13,0)
363. Mods routine C0QUPDT to handle the special case of ePrescribing stats.
37"BLD",7937,1,14,0)
38Also, some checks and quits so that we won't crash if no patient lists
39"BLD",7937,1,15,0)
40are associated with the measure.
41"BLD",7937,1,16,0)
42
43"BLD",7937,1,17,0)
44Data Dictionary:
45"BLD",7937,1,18,0)
461. File C0Q PARAMETER has two new indexes:
47"BLD",7937,1,19,0)
48 AMMS REGULAR
49"BLD",7937,1,20,0)
50 Field: EP MU MEASUREMENT SET (1130580001.401,2)
51"BLD",7937,1,21,0)
52 Description: Indexes the IEN of the Measurement Set. Used so that we can
53"BLD",7937,1,22,0)
54 walk back to a parameter when processing a specific IEN.
55"BLD",7937,1,23,0)
56
57"BLD",7937,1,24,0)
58 You can get the IEN of the measurement set using
59"BLD",7937,1,25,0)
60 $O(^C0Q(401,"AMMS",MSIEN,"")).
61"BLD",7937,1,26,0)
62 1)= S ^C0Q(401,"AMMS",$E(X,1,30),DA)=""
63"BLD",7937,1,27,0)
64 2)= K ^C0Q(401,"AMMS",$E(X,1,30),DA)
65"BLD",7937,1,28,0)
66 3)= USED BY THE CODE. SEE DESCRIPTION.
67"BLD",7937,1,29,0)
68
69"BLD",7937,1,30,0)
70 AQMS REGULAR
71"BLD",7937,1,31,0)
72 Field: EP QUALITY MEASUREMENT SET (1130580001.401,2.1)
73"BLD",7937,1,32,0)
74 Description: Indexes the IEN of the Measurement Set. Used so that we can
75"BLD",7937,1,33,0)
76 walk back to a parameter when processing a specific IEN.
77"BLD",7937,1,34,0)
78
79"BLD",7937,1,35,0)
80 You can get the IEN of the measurement set using
81"BLD",7937,1,36,0)
82 $O(^C0Q(401,"AQMS",MSIEN,"")).
83"BLD",7937,1,37,0)
84 1)= S ^C0Q(401,"AQMS",$E(X,1,30),DA)=""
85"BLD",7937,1,38,0)
86 2)= K ^C0Q(401,"AQMS",$E(X,1,30),DA)
87"BLD",7937,1,39,0)
88 3)= USED BY THE CODE. SEE DESCRIPTION.
89"BLD",7937,1,40,0)
90
91"BLD",7937,1,41,0)
922. File C0Q QUALITY MEASURE has a new field, MEASURE TYPE (#4):
93"BLD",7937,1,42,0)
94
95"BLD",7937,1,43,0)
961130580001.101,4MEASURE TYPE 0;5 SET
97"BLD",7937,1,44,0)
98
99"BLD",7937,1,45,0)
100 'P' FOR Performance;
101"BLD",7937,1,46,0)
102 'Q' FOR Quality;
103"BLD",7937,1,47,0)
104 'E' FOR Electronic Prescribing Performance;
105"BLD",7937,1,48,0)
106 LAST EDITED: MAY 30, 2012
107"BLD",7937,1,49,0)
108 HELP-PROMPT: Enter a code P, Q or E
109"BLD",7937,1,50,0)
110 DESCRIPTION: This field designates the measure type. It can
111"BLD",7937,1,51,0)
112 be P, Q or M.
113"BLD",7937,1,52,0)
114
115"BLD",7937,1,53,0)
116 P is for Performance. Performance measures are
117"BLD",7937,1,54,0)
118 MU measures to measure how meaningfully used an
119"BLD",7937,1,55,0)
120 EMR is. An example of a performance measure is
121"BLD",7937,1,56,0)
122 whether allergies are documented in the EMR.
123"BLD",7937,1,57,0)
124 Performance measures reference a Patient List
125"BLD",7937,1,58,0)
126 created by this package.
127"BLD",7937,1,59,0)
128
129"BLD",7937,1,60,0)
130 Q is for Quality Measures. Quality measures are
131"BLD",7937,1,61,0)
132 MU measures to assess how well the patients are
133"BLD",7937,1,62,0)
134 cared for. An example of a quality measure is
135"BLD",7937,1,63,0)
136 whether Hemoglobin A1c Poor Control. Quality
137"BLD",7937,1,64,0)
138 measures reference Patient Lists in the
139"BLD",7937,1,65,0)
140 Reminders package.
141"BLD",7937,1,66,0)
142
143"BLD",7937,1,67,0)
144 E is for Electronic Prescribing. This is a
145"BLD",7937,1,68,0)
146 Performance measure, except that it is handled
147"BLD",7937,1,69,0)
148 differently than the rest. Instead of the
149"BLD",7937,1,70,0)
150 numerators and denominators being lists of
151"BLD",7937,1,71,0)
152 patients as with all the other measurements,
153"BLD",7937,1,72,0)
154 they are a number of prescriptions. That's why
155"BLD",7937,1,73,0)
156 we have a special flag for it. It references a
157"BLD",7937,1,74,0)
158 Patient List created by this package. The
159"BLD",7937,1,75,0)
160 numerator and denominators are stored in
161"BLD",7937,1,76,0)
162 subfiles for each patient.
163"BLD",7937,1,77,0)
164
165"BLD",7937,1,78,0)
166 TECHNICAL DESCR: As of version C0P*1.0*1, the software doesn't
167"BLD",7937,1,79,0)
168 use this field except to check for an
169"BLD",7937,1,80,0)
170 electronic prescribing type (code E).
171"BLD",7937,1,81,0)
172
173"BLD",7937,1,82,0)
174 I anticipate using this field for other
175"BLD",7937,1,83,0)
176 purposes in the future.
177"BLD",7937,1,84,0)
178
179"BLD",7937,1,85,0)
180INPUT TEMPLATE:
181"BLD",7937,1,86,0)
182C0Q EDIT MU MEASURE adds the new field MEASURE TYPE mentioned above.
183"BLD",7937,1,87,0)
184
185"BLD",7937,1,88,0)
186DATA:
187"BLD",7937,1,89,0)
188The entry MU EP ERX for processing ePrescribing stats in C0Q QUALITY
189"BLD",7937,1,90,0)
190MEASURE is sent to destination sites.
191"BLD",7937,4,0)
192^9.64PA^1130580001.101^2
193"BLD",7937,4,1130580001.101,0)
1941130580001.101
195"BLD",7937,4,1130580001.101,222)
196y^y^f^^n^^y^o^n
197"BLD",7937,4,1130580001.101,224)
198I $P(^(0),U)="MU EP ERX"
199"BLD",7937,4,1130580001.401,0)
2001130580001.401
201"BLD",7937,4,1130580001.401,2,0)
202^9.641^1130580001.401^1
203"BLD",7937,4,1130580001.401,2,1130580001.401,0)
204C0Q PARAMETER (File-top level)
205"BLD",7937,4,1130580001.401,2,1130580001.401,1,0)
206^9.6411^2.1^2
207"BLD",7937,4,1130580001.401,2,1130580001.401,1,2,0)
208EP MU MEASUREMENT SET
209"BLD",7937,4,1130580001.401,2,1130580001.401,1,2.1,0)
210EP QUALITY MEASUREMENT SET
211"BLD",7937,4,1130580001.401,222)
212y^n^p^^^^n^^n
213"BLD",7937,4,1130580001.401,224)
214
215"BLD",7937,4,"APDD",1130580001.401,1130580001.401)
216
217"BLD",7937,4,"APDD",1130580001.401,1130580001.401,2)
218
219"BLD",7937,4,"APDD",1130580001.401,1130580001.401,2.1)
220
221"BLD",7937,4,"B",1130580001.101,1130580001.101)
222
223"BLD",7937,4,"B",1130580001.401,1130580001.401)
224
225"BLD",7937,6.3)
22629
227"BLD",7937,"ABPKG")
228n
229"BLD",7937,"INIT")
230POST^C0QP1
231"BLD",7937,"KRN",0)
232^9.67PA^779.2^20
233"BLD",7937,"KRN",.4,0)
234.4
235"BLD",7937,"KRN",.4,"NM",0)
236^9.68A^^0
237"BLD",7937,"KRN",.401,0)
238.401
239"BLD",7937,"KRN",.401,"NM",0)
240^9.68A^^
241"BLD",7937,"KRN",.402,0)
242.402
243"BLD",7937,"KRN",.402,"NM",0)
244^9.68A^1^1
245"BLD",7937,"KRN",.402,"NM",1,0)
246C0Q EDIT MU MEASURE FILE #1130580001.101^1130580001.101^0
247"BLD",7937,"KRN",.402,"NM","B","C0Q EDIT MU MEASURE FILE #1130580001.101",1)
248
249"BLD",7937,"KRN",.403,0)
250.403
251"BLD",7937,"KRN",.5,0)
252.5
253"BLD",7937,"KRN",.84,0)
254.84
255"BLD",7937,"KRN",3.6,0)
2563.6
257"BLD",7937,"KRN",3.8,0)
2583.8
259"BLD",7937,"KRN",9.2,0)
2609.2
261"BLD",7937,"KRN",9.8,0)
2629.8
263"BLD",7937,"KRN",9.8,"NM",0)
264^9.68A^3^3
265"BLD",7937,"KRN",9.8,"NM",1,0)
266C0QMUERX^^0^B83718518
267"BLD",7937,"KRN",9.8,"NM",2,0)
268C0QUPDT^^0^B79261186
269"BLD",7937,"KRN",9.8,"NM",3,0)
270C0QMU12^^0^B952450497
271"BLD",7937,"KRN",9.8,"NM","B","C0QMU12",3)
272
273"BLD",7937,"KRN",9.8,"NM","B","C0QMUERX",1)
274
275"BLD",7937,"KRN",9.8,"NM","B","C0QUPDT",2)
276
277"BLD",7937,"KRN",19,0)
27819
279"BLD",7937,"KRN",19,"NM",0)
280^9.68A^^0
281"BLD",7937,"KRN",19.1,0)
28219.1
283"BLD",7937,"KRN",101,0)
284101
285"BLD",7937,"KRN",409.61,0)
286409.61
287"BLD",7937,"KRN",771,0)
288771
289"BLD",7937,"KRN",779.2,0)
290779.2
291"BLD",7937,"KRN",870,0)
292870
293"BLD",7937,"KRN",8989.51,0)
2948989.51
295"BLD",7937,"KRN",8989.52,0)
2968989.52
297"BLD",7937,"KRN",8994,0)
2988994
299"BLD",7937,"KRN","B",.4,.4)
300
301"BLD",7937,"KRN","B",.401,.401)
302
303"BLD",7937,"KRN","B",.402,.402)
304
305"BLD",7937,"KRN","B",.403,.403)
306
307"BLD",7937,"KRN","B",.5,.5)
308
309"BLD",7937,"KRN","B",.84,.84)
310
311"BLD",7937,"KRN","B",3.6,3.6)
312
313"BLD",7937,"KRN","B",3.8,3.8)
314
315"BLD",7937,"KRN","B",9.2,9.2)
316
317"BLD",7937,"KRN","B",9.8,9.8)
318
319"BLD",7937,"KRN","B",19,19)
320
321"BLD",7937,"KRN","B",19.1,19.1)
322
323"BLD",7937,"KRN","B",101,101)
324
325"BLD",7937,"KRN","B",409.61,409.61)
326
327"BLD",7937,"KRN","B",771,771)
328
329"BLD",7937,"KRN","B",779.2,779.2)
330
331"BLD",7937,"KRN","B",870,870)
332
333"BLD",7937,"KRN","B",8989.51,8989.51)
334
335"BLD",7937,"KRN","B",8989.52,8989.52)
336
337"BLD",7937,"KRN","B",8994,8994)
338
339"BLD",7937,"QDEF")
340^^^^NO^^^^NO^^NO
341"BLD",7937,"QUES",0)
342^9.62^^
343"BLD",7937,"REQB",0)
344^9.611^2^2
345"BLD",7937,"REQB",1,0)
346C0P*1.0*4^2
347"BLD",7937,"REQB",2,0)
348C0Q 1.0^2
349"BLD",7937,"REQB","B","C0P*1.0*4",1)
350
351"BLD",7937,"REQB","B","C0Q 1.0",2)
352
353"DATA",1130580001.101,104,0)
354MU EP ERX^^^^E
355"DATA",1130580001.101,104,1)
356More than 40% of all permissible prescriptions written by the EP are transmitted electronically using certified EHR technology.
357"DATA",1130580001.101,104,5)
358Eligibile Prescriptions transmitted electronically
359"DATA",1130580001.101,104,6,0)
360^1130580001.111^6^6^3120613^^
361"DATA",1130580001.101,104,6,1,0)
362Final Rule Text: § 170.304(b).
363"DATA",1130580001.101,104,6,2,0)
364Electronic prescribing. Enable a user to electronically generate
365"DATA",1130580001.101,104,6,3,0)
366and transmit prescriptions and prescription-related information
367"DATA",1130580001.101,104,6,4,0)
368in accordance with:
369"DATA",1130580001.101,104,6,5,0)
370(1) The standard specified in § 170.205(b)(1) or § 170.205(b)(2); and
371"DATA",1130580001.101,104,6,6,0)
372(2) The standard specified in 170.207(d).
373"DATA",1130580001.101,104,7)
374^^^^^MU12
375"FIA",1130580001.101)
376C0Q QUALITY MEASURE
377"FIA",1130580001.101,0)
378^C0Q(101,
379"FIA",1130580001.101,0,0)
3801130580001.101I
381"FIA",1130580001.101,0,1)
382y^y^f^^n^^y^o^n
383"FIA",1130580001.101,0,10)
384
385"FIA",1130580001.101,0,11)
386I $P(^(0),U)="MU EP ERX"
387"FIA",1130580001.101,0,"RLRO")
388
389"FIA",1130580001.101,0,"VR")
3901.0T1^C0Q
391"FIA",1130580001.101,1130580001.101)
3920
393"FIA",1130580001.101,1130580001.111)
3940
395"FIA",1130580001.401)
396C0Q PARAMETER
397"FIA",1130580001.401,0)
398^C0Q(401,
399"FIA",1130580001.401,0,0)
4001130580001.401
401"FIA",1130580001.401,0,1)
402y^n^p^^^^n^^n
403"FIA",1130580001.401,0,10)
404
405"FIA",1130580001.401,0,11)
406
407"FIA",1130580001.401,0,"RLRO")
408
409"FIA",1130580001.401,0,"VR")
4101.0T1^C0Q
411"FIA",1130580001.401,1130580001.401)
4121
413"FIA",1130580001.401,1130580001.401,2)
414
415"FIA",1130580001.401,1130580001.401,2.1)
416
417"INIT")
418POST^C0QP1
419"IX",1130580001.101,1130580001.101,"MU",0)
4201130580001.101^MU^MEANINGFUL USE YEAR KEY^R^^F^IR^I^1130580001.101^^^^^LS
421"IX",1130580001.101,1130580001.101,"MU",1)
422S ^C0Q(101,"MU",$E(X,1,30),DA)=""
423"IX",1130580001.101,1130580001.101,"MU",2)
424K ^C0Q(101,"MU",$E(X,1,30),DA)
425"IX",1130580001.101,1130580001.101,"MU",2.5)
426K ^C0Q(101,"MU")
427"IX",1130580001.101,1130580001.101,"MU",11.1,0)
428^.114IA^1^1
429"IX",1130580001.101,1130580001.101,"MU",11.1,1,0)
4301^F^1130580001.101^.3^30^1^F
431"KRN",.402,1746,-1)
4320^1
433"KRN",.402,1746,0)
434C0Q EDIT MU MEASURE^3120530.1643^@^1130580001.101^^@^3120613
435"KRN",.402,1746,"DR",1,1130580001.101)
436.01;4;.3;.5;.61;.7;.8;1.1;2.1;
437"MBREQ")
4380
439"ORD",7,.402)
440.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
441"ORD",7,.402,0)
442INPUT TEMPLATE
443"PKG",213,-1)
4441^1
445"PKG",213,0)
446QUALITY MEASURES^C0Q^Tracks and Prints Quality Measures
447"PKG",213,20,0)
448^9.402P^^
449"PKG",213,22,0)
450^9.49I^1^1
451"PKG",213,22,1,0)
4521.0T1
453"PKG",213,22,1,"PAH",1,0)
4541^3120613
455"PKG",213,22,1,"PAH",1,1,0)
456^^90^90^3120613
457"PKG",213,22,1,"PAH",1,1,1,0)
458ePrescribing MU measure in this package.
459"PKG",213,22,1,"PAH",1,1,2,0)
460
461"PKG",213,22,1,"PAH",1,1,3,0)
462Dependencies:
463"PKG",213,22,1,"PAH",1,1,4,0)
464This build requires C0P*1*4 for the new WebService entry that gets MU
465"PKG",213,22,1,"PAH",1,1,5,0)
466data from New Crop.
467"PKG",213,22,1,"PAH",1,1,6,0)
468This build requires the base C0Q 1.0 to be installed.
469"PKG",213,22,1,"PAH",1,1,7,0)
470
471"PKG",213,22,1,"PAH",1,1,8,0)
472This build performs the following:
473"PKG",213,22,1,"PAH",1,1,9,0)
474Routines:
475"PKG",213,22,1,"PAH",1,1,10,0)
4761. Adds routine C0QMUERX for calculation of ePrescribing stats.
477"PKG",213,22,1,"PAH",1,1,11,0)
4782. Mods routine C0QMU12 to call C0QMUERX for the ERX measure for
479"PKG",213,22,1,"PAH",1,1,12,0)
480Outpatients.
481"PKG",213,22,1,"PAH",1,1,13,0)
4823. Mods routine C0QUPDT to handle the special case of ePrescribing stats.
483"PKG",213,22,1,"PAH",1,1,14,0)
484Also, some checks and quits so that we won't crash if no patient lists
485"PKG",213,22,1,"PAH",1,1,15,0)
486are associated with the measure.
487"PKG",213,22,1,"PAH",1,1,16,0)
488
489"PKG",213,22,1,"PAH",1,1,17,0)
490Data Dictionary:
491"PKG",213,22,1,"PAH",1,1,18,0)
4921. File C0Q PARAMETER has two new indexes:
493"PKG",213,22,1,"PAH",1,1,19,0)
494 AMMS REGULAR
495"PKG",213,22,1,"PAH",1,1,20,0)
496 Field: EP MU MEASUREMENT SET (1130580001.401,2)
497"PKG",213,22,1,"PAH",1,1,21,0)
498 Description: Indexes the IEN of the Measurement Set. Used so that we can
499"PKG",213,22,1,"PAH",1,1,22,0)
500 walk back to a parameter when processing a specific IEN.
501"PKG",213,22,1,"PAH",1,1,23,0)
502
503"PKG",213,22,1,"PAH",1,1,24,0)
504 You can get the IEN of the measurement set using
505"PKG",213,22,1,"PAH",1,1,25,0)
506 $O(^C0Q(401,"AMMS",MSIEN,"")).
507"PKG",213,22,1,"PAH",1,1,26,0)
508 1)= S ^C0Q(401,"AMMS",$E(X,1,30),DA)=""
509"PKG",213,22,1,"PAH",1,1,27,0)
510 2)= K ^C0Q(401,"AMMS",$E(X,1,30),DA)
511"PKG",213,22,1,"PAH",1,1,28,0)
512 3)= USED BY THE CODE. SEE DESCRIPTION.
513"PKG",213,22,1,"PAH",1,1,29,0)
514
515"PKG",213,22,1,"PAH",1,1,30,0)
516 AQMS REGULAR
517"PKG",213,22,1,"PAH",1,1,31,0)
518 Field: EP QUALITY MEASUREMENT SET (1130580001.401,2.1)
519"PKG",213,22,1,"PAH",1,1,32,0)
520 Description: Indexes the IEN of the Measurement Set. Used so that we can
521"PKG",213,22,1,"PAH",1,1,33,0)
522 walk back to a parameter when processing a specific IEN.
523"PKG",213,22,1,"PAH",1,1,34,0)
524
525"PKG",213,22,1,"PAH",1,1,35,0)
526 You can get the IEN of the measurement set using
527"PKG",213,22,1,"PAH",1,1,36,0)
528 $O(^C0Q(401,"AQMS",MSIEN,"")).
529"PKG",213,22,1,"PAH",1,1,37,0)
530 1)= S ^C0Q(401,"AQMS",$E(X,1,30),DA)=""
531"PKG",213,22,1,"PAH",1,1,38,0)
532 2)= K ^C0Q(401,"AQMS",$E(X,1,30),DA)
533"PKG",213,22,1,"PAH",1,1,39,0)
534 3)= USED BY THE CODE. SEE DESCRIPTION.
535"PKG",213,22,1,"PAH",1,1,40,0)
536
537"PKG",213,22,1,"PAH",1,1,41,0)
5382. File C0Q QUALITY MEASURE has a new field, MEASURE TYPE (#4):
539"PKG",213,22,1,"PAH",1,1,42,0)
540
541"PKG",213,22,1,"PAH",1,1,43,0)
5421130580001.101,4MEASURE TYPE 0;5 SET
543"PKG",213,22,1,"PAH",1,1,44,0)
544
545"PKG",213,22,1,"PAH",1,1,45,0)
546 'P' FOR Performance;
547"PKG",213,22,1,"PAH",1,1,46,0)
548 'Q' FOR Quality;
549"PKG",213,22,1,"PAH",1,1,47,0)
550 'E' FOR Electronic Prescribing Performance;
551"PKG",213,22,1,"PAH",1,1,48,0)
552 LAST EDITED: MAY 30, 2012
553"PKG",213,22,1,"PAH",1,1,49,0)
554 HELP-PROMPT: Enter a code P, Q or E
555"PKG",213,22,1,"PAH",1,1,50,0)
556 DESCRIPTION: This field designates the measure type. It can
557"PKG",213,22,1,"PAH",1,1,51,0)
558 be P, Q or M.
559"PKG",213,22,1,"PAH",1,1,52,0)
560
561"PKG",213,22,1,"PAH",1,1,53,0)
562 P is for Performance. Performance measures are
563"PKG",213,22,1,"PAH",1,1,54,0)
564 MU measures to measure how meaningfully used an
565"PKG",213,22,1,"PAH",1,1,55,0)
566 EMR is. An example of a performance measure is
567"PKG",213,22,1,"PAH",1,1,56,0)
568 whether allergies are documented in the EMR.
569"PKG",213,22,1,"PAH",1,1,57,0)
570 Performance measures reference a Patient List
571"PKG",213,22,1,"PAH",1,1,58,0)
572 created by this package.
573"PKG",213,22,1,"PAH",1,1,59,0)
574
575"PKG",213,22,1,"PAH",1,1,60,0)
576 Q is for Quality Measures. Quality measures are
577"PKG",213,22,1,"PAH",1,1,61,0)
578 MU measures to assess how well the patients are
579"PKG",213,22,1,"PAH",1,1,62,0)
580 cared for. An example of a quality measure is
581"PKG",213,22,1,"PAH",1,1,63,0)
582 whether Hemoglobin A1c Poor Control. Quality
583"PKG",213,22,1,"PAH",1,1,64,0)
584 measures reference Patient Lists in the
585"PKG",213,22,1,"PAH",1,1,65,0)
586 Reminders package.
587"PKG",213,22,1,"PAH",1,1,66,0)
588
589"PKG",213,22,1,"PAH",1,1,67,0)
590 E is for Electronic Prescribing. This is a
591"PKG",213,22,1,"PAH",1,1,68,0)
592 Performance measure, except that it is handled
593"PKG",213,22,1,"PAH",1,1,69,0)
594 differently than the rest. Instead of the
595"PKG",213,22,1,"PAH",1,1,70,0)
596 numerators and denominators being lists of
597"PKG",213,22,1,"PAH",1,1,71,0)
598 patients as with all the other measurements,
599"PKG",213,22,1,"PAH",1,1,72,0)
600 they are a number of prescriptions. That's why
601"PKG",213,22,1,"PAH",1,1,73,0)
602 we have a special flag for it. It references a
603"PKG",213,22,1,"PAH",1,1,74,0)
604 Patient List created by this package. The
605"PKG",213,22,1,"PAH",1,1,75,0)
606 numerator and denominators are stored in
607"PKG",213,22,1,"PAH",1,1,76,0)
608 subfiles for each patient.
609"PKG",213,22,1,"PAH",1,1,77,0)
610
611"PKG",213,22,1,"PAH",1,1,78,0)
612 TECHNICAL DESCR: As of version C0P*1.0*1, the software doesn't
613"PKG",213,22,1,"PAH",1,1,79,0)
614 use this field except to check for an
615"PKG",213,22,1,"PAH",1,1,80,0)
616 electronic prescribing type (code E).
617"PKG",213,22,1,"PAH",1,1,81,0)
618
619"PKG",213,22,1,"PAH",1,1,82,0)
620 I anticipate using this field for other
621"PKG",213,22,1,"PAH",1,1,83,0)
622 purposes in the future.
623"PKG",213,22,1,"PAH",1,1,84,0)
624
625"PKG",213,22,1,"PAH",1,1,85,0)
626INPUT TEMPLATE:
627"PKG",213,22,1,"PAH",1,1,86,0)
628C0Q EDIT MU MEASURE adds the new field MEASURE TYPE mentioned above.
629"PKG",213,22,1,"PAH",1,1,87,0)
630
631"PKG",213,22,1,"PAH",1,1,88,0)
632DATA:
633"PKG",213,22,1,"PAH",1,1,89,0)
634The entry MU EP ERX for processing ePrescribing stats in C0Q QUALITY
635"PKG",213,22,1,"PAH",1,1,90,0)
636MEASURE is sent to destination sites.
637"QUES","XPF1",0)
638Y
639"QUES","XPF1","??")
640^D REP^XPDH
641"QUES","XPF1","A")
642Shall I write over your |FLAG| File
643"QUES","XPF1","B")
644YES
645"QUES","XPF1","M")
646D XPF1^XPDIQ
647"QUES","XPF2",0)
648Y
649"QUES","XPF2","??")
650^D DTA^XPDH
651"QUES","XPF2","A")
652Want my data |FLAG| yours
653"QUES","XPF2","B")
654YES
655"QUES","XPF2","M")
656D XPF2^XPDIQ
657"QUES","XPI1",0)
658YO
659"QUES","XPI1","??")
660^D INHIBIT^XPDH
661"QUES","XPI1","A")
662Want KIDS to INHIBIT LOGONs during the install
663"QUES","XPI1","B")
664NO
665"QUES","XPI1","M")
666D XPI1^XPDIQ
667"QUES","XPM1",0)
668PO^VA(200,:EM
669"QUES","XPM1","??")
670^D MG^XPDH
671"QUES","XPM1","A")
672Enter the Coordinator for Mail Group '|FLAG|'
673"QUES","XPM1","B")
674
675"QUES","XPM1","M")
676D XPM1^XPDIQ
677"QUES","XPO1",0)
678Y
679"QUES","XPO1","??")
680^D MENU^XPDH
681"QUES","XPO1","A")
682Want KIDS to Rebuild Menu Trees Upon Completion of Install
683"QUES","XPO1","B")
684NO
685"QUES","XPO1","M")
686D XPO1^XPDIQ
687"QUES","XPZ1",0)
688Y
689"QUES","XPZ1","??")
690^D OPT^XPDH
691"QUES","XPZ1","A")
692Want to DISABLE Scheduled Options, Menu Options, and Protocols
693"QUES","XPZ1","B")
694NO
695"QUES","XPZ1","M")
696D XPZ1^XPDIQ
697"QUES","XPZ2",0)
698Y
699"QUES","XPZ2","??")
700^D RTN^XPDH
701"QUES","XPZ2","A")
702Want to MOVE routines to other CPUs
703"QUES","XPZ2","B")
704NO
705"QUES","XPZ2","M")
706D XPZ2^XPDIQ
707"RTN")
7084
709"RTN","C0QMU12")
7100^3^B952450497
711"RTN","C0QMU12",1,0)
712C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List ; 6/13/12 12:38pm
713"RTN","C0QMU12",2,0)
714 ;;1.0;C0Q;;May 21, 2012;Build 29
715"RTN","C0QMU12",3,0)
716 ;
717"RTN","C0QMU12",4,0)
718 ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU
719"RTN","C0QMU12",5,0)
720 ;General Public License See attached copy of the License.
721"RTN","C0QMU12",6,0)
722 ;
723"RTN","C0QMU12",7,0)
724 ;This program is free software; you can redistribute it and/or modify
725"RTN","C0QMU12",8,0)
726 ;it under the terms of the GNU General Public License as published by
727"RTN","C0QMU12",9,0)
728 ;the Free Software Foundation; either version 2 of the License, or
729"RTN","C0QMU12",10,0)
730 ;(at your option) any later version.
731"RTN","C0QMU12",11,0)
732 ;
733"RTN","C0QMU12",12,0)
734 ;This program is distributed in the hope that it will be useful,
735"RTN","C0QMU12",13,0)
736 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
737"RTN","C0QMU12",14,0)
738 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
739"RTN","C0QMU12",15,0)
740 ;GNU General Public License for more details.
741"RTN","C0QMU12",16,0)
742 ;
743"RTN","C0QMU12",17,0)
744 ;You should have received a copy of the GNU General Public License along
745"RTN","C0QMU12",18,0)
746 ;with this program; if not, write to the Free Software Foundation, Inc.,
747"RTN","C0QMU12",19,0)
748 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
749"RTN","C0QMU12",20,0)
750 ;
751"RTN","C0QMU12",21,0)
752 ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED
753"RTN","C0QMU12",22,0)
754 ; FOR MEANINGFUL USE CALCULATION FOR FISCAL YEAR 2012 AT OROVILLE HOSPITAL
755"RTN","C0QMU12",23,0)
756 ;
757"RTN","C0QMU12",24,0)
758C0QPFN() Q 1130580001.401 ; PARAMETER FILE
759"RTN","C0QMU12",25,0)
760C0QPCFN() Q 1130580001.411 ; CLINIC SUBFILE
761"RTN","C0QMU12",26,0)
762C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
763"RTN","C0QMU12",27,0)
764C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
765"RTN","C0QMU12",28,0)
766INIT(ZARY,ZTYP) ; INITIALIZE THE PARAMETERS FOR BUILDING PATIENT LISTS
767"RTN","C0QMU12",29,0)
768 ; ZARY IS PASSED BY NAME
769"RTN","C0QMU12",30,0)
770 ; ZTYP IS "INP" OR "EP"
771"RTN","C0QMU12",31,0)
772 N ZMU S ZMU="MU12" ; THIS IS THE ONLY HARD CODED VALUE LEFT
773"RTN","C0QMU12",32,0)
774 ; TBD - CHANGE IT TO A READ FROM SYSTEM PARAMETERS
775"RTN","C0QMU12",33,0)
776 K @ZARY ; CLEAR RETURN ARRAY
777"RTN","C0QMU12",34,0)
778 N ZIEN,ZCNT,ZX
779"RTN","C0QMU12",35,0)
780 I $O(^C0Q(401,"MUTYP",ZMU,ZTYP,""))="" D Q ; OOPS NO RECORD THERE
781"RTN","C0QMU12",36,0)
782 . W !,"ERROR, NO PARAMETERS AVAILABLE"
783"RTN","C0QMU12",37,0)
784 S ZIEN=""
785"RTN","C0QMU12",38,0)
786 S ZCNT=0
787"RTN","C0QMU12",39,0)
788 F S ZIEN=$O(^C0Q(401,"MUTYP",ZMU,ZTYP,ZIEN)) Q:ZIEN="" D ;
789"RTN","C0QMU12",40,0)
790 . S ZCNT=ZCNT+1
791"RTN","C0QMU12",41,0)
792 . S @ZARY@(ZCNT,"MU")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.02)
793"RTN","C0QMU12",42,0)
794 . S @ZARY@(ZCNT,"TYPE")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.03)
795"RTN","C0QMU12",43,0)
796 . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",1,"I")
797"RTN","C0QMU12",44,0)
798 . S @ZARY@(ZCNT,"InpatientMeasurementSet")=ZX
799"RTN","C0QMU12",45,0)
800 . S @ZARY@(ZCNT,"InpatientBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
801"RTN","C0QMU12",46,0)
802 . S @ZARY@(ZCNT,"InpatientEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
803"RTN","C0QMU12",47,0)
804 . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
805"RTN","C0QMU12",48,0)
806 . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",2,"I")
807"RTN","C0QMU12",49,0)
808 . S @ZARY@(ZCNT,"EPMeasurementSet")=ZX
809"RTN","C0QMU12",50,0)
810 . S @ZARY@(ZCNT,"EPBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
811"RTN","C0QMU12",51,0)
812 . S @ZARY@(ZCNT,"EPEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
813"RTN","C0QMU12",52,0)
814 . S @ZARY@(ZCNT,"EPQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",2.1,"I")
815"RTN","C0QMU12",53,0)
816 . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
817"RTN","C0QMU12",54,0)
818 . D CLEAN^DILF
819"RTN","C0QMU12",55,0)
820 . D LIST^DIC($$C0QPCFN,","_ZIEN_",",".01I")
821"RTN","C0QMU12",56,0)
822 . I $D(^TMP("DIERR",$J)) D Q ; ERROR READING CLINIC LIST
823"RTN","C0QMU12",57,0)
824 . . W !,"ERROR READING CLINIC PARAMETER LIST"
825"RTN","C0QMU12",58,0)
826 . M @ZARY@(ZCNT,"CLINICS")=^TMP("DILIST",$J)
827"RTN","C0QMU12",59,0)
828 ;
829"RTN","C0QMU12",60,0)
830 Q
831"RTN","C0QMU12",61,0)
832 ;
833"RTN","C0QMU12",62,0)
834BUILD ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
835"RTN","C0QMU12",63,0)
836 ; patient lists
837"RTN","C0QMU12",64,0)
838 ;N GRSLT ; ARRAY FOR RESULTS
839"RTN","C0QMU12",65,0)
840 I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
841"RTN","C0QMU12",66,0)
842 I '$D(C0QPR) S C0QPR=0 ;default don't print out results
843"RTN","C0QMU12",67,0)
844 I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
845"RTN","C0QMU12",68,0)
846 S ZYR="MU12-"
847"RTN","C0QMU12",69,0)
848 D INITCLST ; initialize C0QLIST
849"RTN","C0QMU12",70,0)
850 N G1 ; ONE SET OF VALUES - RNF1 FORMAT
851"RTN","C0QMU12",71,0)
852 N C0QPARM
853"RTN","C0QMU12",72,0)
854 D INIT("C0QPARM","INP") ; initialize inpatient parms
855"RTN","C0QMU12",73,0)
856 I $O(C0QPARM(""))="" D Q ; no parms for inpatient
857"RTN","C0QMU12",74,0)
858 . W !,"No inpatient parameters"
859"RTN","C0QMU12",75,0)
860 N ZDIV S ZDIV=""
861"RTN","C0QMU12",76,0)
862 F S ZDIV=$O(C0QPARM(ZDIV)) Q:ZDIV="" D ; for each inpatient division
863"RTN","C0QMU12",77,0)
864 . D ALL ; all currently admitted patients in the hospital
865"RTN","C0QMU12",78,0)
866 . D DIS ; all patients discharged since the reporting period began
867"RTN","C0QMU12",79,0)
868 . I C0QSS ZWRITE GRSLT
869"RTN","C0QMU12",80,0)
870 . ;D ICUPAT ; GENERATE ICU PATIENT LIST
871"RTN","C0QMU12",81,0)
872 . I C0QPL D ;
873"RTN","C0QMU12",82,0)
874 . . D FILE ; FILE THE PATIENT LISTS
875"RTN","C0QMU12",83,0)
876 . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientMeasurementSet")) ;
877"RTN","C0QMU12",84,0)
878 . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientQualitySet")) ;
879"RTN","C0QMU12",85,0)
880 . K C0QLIST
881"RTN","C0QMU12",86,0)
882 Q
883"RTN","C0QMU12",87,0)
884 ;
885"RTN","C0QMU12",88,0)
886INITCLST ; initialize C0QLIST
887"RTN","C0QMU12",89,0)
888 ; INITIALIZE LISTS
889"RTN","C0QMU12",90,0)
890 ; this is done so that if there are no matching patients, the patient list
891"RTN","C0QMU12",91,0)
892 ; will be zeroed out
893"RTN","C0QMU12",92,0)
894 K C0QLIST
895"RTN","C0QMU12",93,0)
896 S C0QLIST(ZYR_"HasDemographics")=""
897"RTN","C0QMU12",94,0)
898 S C0QLIST(ZYR_"Patient")=""
899"RTN","C0QMU12",95,0)
900 S C0QLIST(ZYR_"HasProblem")=""
901"RTN","C0QMU12",96,0)
902 S C0QLIST(ZYR_"HasAllergy")=""
903"RTN","C0QMU12",97,0)
904 S C0QLIST(ZYR_"HasMed")=""
905"RTN","C0QMU12",98,0)
906 S C0QLIST(ZYR_"HasVitalSigns")=""
907"RTN","C0QMU12",99,0)
908 S C0QLIST(ZYR_"HasMedOrders")=""
909"RTN","C0QMU12",100,0)
910 S C0QLIST(ZYR_"HasSmokingStatus")=""
911"RTN","C0QMU12",101,0)
912 Q
913"RTN","C0QMU12",102,0)
914 ;
915"RTN","C0QMU12",103,0)
916ALL ;retrieve active inpatients
917"RTN","C0QMU12",104,0)
918 N WARD S WARD=""
919"RTN","C0QMU12",105,0)
920 F D Q:WARD=""
921"RTN","C0QMU12",106,0)
922 . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
923"RTN","C0QMU12",107,0)
924 . Q:WARD=""
925"RTN","C0QMU12",108,0)
926 . N WIEN S WIEN=""
927"RTN","C0QMU12",109,0)
928 . F S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN D ;wards IEN
929"RTN","C0QMU12",110,0)
930 . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
931"RTN","C0QMU12",111,0)
932 . . N DFN,RB S DFN=""
933"RTN","C0QMU12",112,0)
934 . . F S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN D ;DFN of patient on ward
935"RTN","C0QMU12",113,0)
936 . . . D DEMO
937"RTN","C0QMU12",114,0)
938 . . . D PROBLEM
939"RTN","C0QMU12",115,0)
940 . . . D ALLERGY
941"RTN","C0QMU12",116,0)
942 . . . D MEDS4
943"RTN","C0QMU12",117,0)
944 . . . D RECON2
945"RTN","C0QMU12",118,0)
946 . . . D ADVDIR
947"RTN","C0QMU12",119,0)
948 . . . D SMOKING
949"RTN","C0QMU12",120,0)
950 . . . D VITALS
951"RTN","C0QMU12",121,0)
952 . . . D VTE1
953"RTN","C0QMU12",122,0)
954 . . . D COD
955"RTN","C0QMU12",123,0)
956 . . . D EDTIME
957"RTN","C0QMU12",124,0)
958 . . . I C0QPR D PRINT
959"RTN","C0QMU12",125,0)
960 . . . I C0QSS D SS
961"RTN","C0QMU12",126,0)
962 . . . I C0QPL D PATLIST
963"RTN","C0QMU12",127,0)
964 Q
965"RTN","C0QMU12",128,0)
966 ;
967"RTN","C0QMU12",129,0)
968DEMO ; patient demographics
969"RTN","C0QMU12",130,0)
970 K PTDOB
971"RTN","C0QMU12",131,0)
972 N PTNAME,PTSEX,PTHRN,PTRLANG,PTLANG,RACE,RACEDSC,ETHN,ETHNDSC,RB
973"RTN","C0QMU12",132,0)
974 S PTNAME=$P(^DPT(DFN,0),U) ;patient name
975"RTN","C0QMU12",133,0)
976 S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
977"RTN","C0QMU12",134,0)
978 S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
979"RTN","C0QMU12",135,0)
980 D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
981"RTN","C0QMU12",136,0)
982 S PTHRN=$P($G(VA("PID")),U) ;health record number
983"RTN","C0QMU12",137,0)
984 S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
985"RTN","C0QMU12",138,0)
986 I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
987"RTN","C0QMU12",139,0)
988 S RACE=""
989"RTN","C0QMU12",140,0)
990 F D Q:RACE=""
991"RTN","C0QMU12",141,0)
992 . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN
993"RTN","C0QMU12",142,0)
994 . Q:'RACE
995"RTN","C0QMU12",143,0)
996 . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description
997"RTN","C0QMU12",144,0)
998 S ETHN=""
999"RTN","C0QMU12",145,0)
1000 F D Q:ETHN=""
1001"RTN","C0QMU12",146,0)
1002 . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN
1003"RTN","C0QMU12",147,0)
1004 . Q:'ETHN
1005"RTN","C0QMU12",148,0)
1006 . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description
1007"RTN","C0QMU12",149,0)
1008 S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed
1009"RTN","C0QMU12",150,0)
1010 N DEMOYN S DEMOYN=1
1011"RTN","C0QMU12",151,0)
1012 I $G(PTSEX)="" S DEMOYN=0
1013"RTN","C0QMU12",152,0)
1014 I $G(PTDOB)="" S DEMOYN=0
1015"RTN","C0QMU12",153,0)
1016 I $G(PTHRN)="" S DEMOYN=0
1017"RTN","C0QMU12",154,0)
1018 I $G(PTLANG)="" S DEMOYN=0
1019"RTN","C0QMU12",155,0)
1020 I $G(RACEDSC)="" S DEMOYN=0
1021"RTN","C0QMU12",156,0)
1022 I $G(ETHNDSC)="" S DEMOYN=0
1023"RTN","C0QMU12",157,0)
1024 I DEMOYN S C0QLIST(ZYR_"HasDemographics",DFN)=""
1025"RTN","C0QMU12",158,0)
1026 E S C0QLIST(ZYR_"FailedDemographics",DFN)=""
1027"RTN","C0QMU12",159,0)
1028 Q
1029"RTN","C0QMU12",160,0)
1030 ;
1031"RTN","C0QMU12",161,0)
1032PROBLEM ; PATIENT PROBLEMS
1033"RTN","C0QMU12",162,0)
1034 D LIST^ORQQPL(.PROBL,DFN,"A")
1035"RTN","C0QMU12",163,0)
1036 S PBCNT=""
1037"RTN","C0QMU12",164,0)
1038 F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
1039"RTN","C0QMU12",165,0)
1040 . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
1041"RTN","C0QMU12",166,0)
1042 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
1043"RTN","C0QMU12",167,0)
1044 E S C0QLIST(ZYR_"HasProblem",DFN)=""
1045"RTN","C0QMU12",168,0)
1046 K PROBL
1047"RTN","C0QMU12",169,0)
1048 Q
1049"RTN","C0QMU12",170,0)
1050 ;
1051"RTN","C0QMU12",171,0)
1052ALLERGY ; ALLERGY LIST
1053"RTN","C0QMU12",172,0)
1054 ; WANT TO CHANGE ALLERGIES FOR 2012 TO POPULATE THE C0QLIST DIRECTLY. GPL
1055"RTN","C0QMU12",173,0)
1056 D LIST^ORQQAL(.ALRGYL,DFN)
1057"RTN","C0QMU12",174,0)
1058 S ALCNT=""
1059"RTN","C0QMU12",175,0)
1060 F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
1061"RTN","C0QMU12",176,0)
1062 . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
1063"RTN","C0QMU12",177,0)
1064 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
1065"RTN","C0QMU12",178,0)
1066 E S C0QLIST(ZYR_"HasAllergy",DFN)=""
1067"RTN","C0QMU12",179,0)
1068 K ALRGYL
1069"RTN","C0QMU12",180,0)
1070 Q
1071"RTN","C0QMU12",181,0)
1072 ;
1073"RTN","C0QMU12",182,0)
1074MEDS4 ; USE OCL^PSOORRL TO GET ALL MEDS
1075"RTN","C0QMU12",183,0)
1076 ; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4
1077"RTN","C0QMU12",184,0)
1078 N BEG,END
1079"RTN","C0QMU12",185,0)
1080 S BEG=$$DT^C0QUTIL("JULY 3,2011")
1081"RTN","C0QMU12",186,0)
1082 S END=$$DT^C0QUTIL("NOW")
1083"RTN","C0QMU12",187,0)
1084 D OCL^PSOORRL(DFN,BEG,END) ;DBIA #2400
1085"RTN","C0QMU12",188,0)
1086 N C0QMEDS
1087"RTN","C0QMU12",189,0)
1088 M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL
1089"RTN","C0QMU12",190,0)
1090 N FOUND
1091"RTN","C0QMU12",191,0)
1092 N ZI
1093"RTN","C0QMU12",192,0)
1094 I '$D(C0QMEDS(1)) D Q ; QUIT IF NO MEDS
1095"RTN","C0QMU12",193,0)
1096 . S C0QLIST(ZYR_"NoMed",DFN)=""
1097"RTN","C0QMU12",194,0)
1098 E D ; HAS MEDS
1099"RTN","C0QMU12",195,0)
1100 . S C0QLIST(ZYR_"HasMed",DFN)=""
1101"RTN","C0QMU12",196,0)
1102 S ZI="" S FOUND=0
1103"RTN","C0QMU12",197,0)
1104 F S ZI=$O(C0QMEDS(ZI)) Q:ZI="" D ; FOR EACH MED
1105"RTN","C0QMU12",198,0)
1106 . N ZM
1107"RTN","C0QMU12",199,0)
1108 . S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION
1109"RTN","C0QMU12",200,0)
1110 . I $P($P(ZM,"^",1),";",2)="I" D ; IE 1U;I FOR AN INPATIENT UNIT DOSE
1111"RTN","C0QMU12",201,0)
1112 . . S FOUND=1
1113"RTN","C0QMU12",202,0)
1114 I FOUND S C0QLIST(ZYR_"HasMedOrders",DFN)="" ; MET CPOE MEASURE
1115"RTN","C0QMU12",203,0)
1116 E S C0QLIST(ZYR_"NoMedOrders",DFN)=""
1117"RTN","C0QMU12",204,0)
1118 Q
1119"RTN","C0QMU12",205,0)
1120 ;
1121"RTN","C0QMU12",206,0)
1122RECON ; MEDICATIONS RECONCILIATION
1123"RTN","C0QMU12",207,0)
1124 ; WANT TO SIMPLIFY MEDS RECON FOR 2012. GPL
1125"RTN","C0QMU12",208,0)
1126 ;
1127"RTN","C0QMU12",209,0)
1128 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ;
1129"RTN","C0QMU12",210,0)
1130 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
1131"RTN","C0QMU12",211,0)
1132 N HASRECON S HASRECON=0
1133"RTN","C0QMU12",212,0)
1134 N GT,G
1135"RTN","C0QMU12",213,0)
1136 S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
1137"RTN","C0QMU12",214,0)
1138 S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
1139"RTN","C0QMU12",215,0)
1140 I $$TXTALL^C0QNOTES(.G,.GT,DFN) D ; SEARCH ALL NOTES FOR MED RECON
1141"RTN","C0QMU12",216,0)
1142 . S HASRECON=1
1143"RTN","C0QMU12",217,0)
1144 ;N ZT
1145"RTN","C0QMU12",218,0)
1146 ;S ZT="MEDICATION RECONCILIATION COMPLET"
1147"RTN","C0QMU12",219,0)
1148 ;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D ;
1149"RTN","C0QMU12",220,0)
1150 ;. S HASRECON=1
1151"RTN","C0QMU12",221,0)
1152 ;E D ;
1153"RTN","C0QMU12",222,0)
1154 ;. S ZT="Medication Reconcilation Complete"
1155"RTN","C0QMU12",223,0)
1156 ;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D ;
1157"RTN","C0QMU12",224,0)
1158 ;. . S HASRECON=1
1159"RTN","C0QMU12",225,0)
1160 ;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1
1161"RTN","C0QMU12",226,0)
1162 I HASRECON D ;
1163"RTN","C0QMU12",227,0)
1164 . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
1165"RTN","C0QMU12",228,0)
1166 E S C0QLIST(ZYR_"NoMedRecon",DFN)=""
1167"RTN","C0QMU12",229,0)
1168 Q
1169"RTN","C0QMU12",230,0)
1170 ;
1171"RTN","C0QMU12",231,0)
1172RECON2 ; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION
1173"RTN","C0QMU12",232,0)
1174 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ;
1175"RTN","C0QMU12",233,0)
1176 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
1177"RTN","C0QMU12",234,0)
1178 I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D ;
1179"RTN","C0QMU12",235,0)
1180 . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
1181"RTN","C0QMU12",236,0)
1182 E S C0QLIST(ZYR_"NoMedRecon",DFN)=""
1183"RTN","C0QMU12",237,0)
1184 Q
1185"RTN","C0QMU12",238,0)
1186 ;
1187"RTN","C0QMU12",239,0)
1188ERX ; FOR EP, WE LOOK AT ERX MEDS
1189"RTN","C0QMU12",240,0)
1190 N ZI S ZI=""
1191"RTN","C0QMU12",241,0)
1192 N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
1193"RTN","C0QMU12",242,0)
1194 F S ZI=$O(@ZERX@(ZI)) Q:ZI="" D ;
1195"RTN","C0QMU12",243,0)
1196 . ;B
1197"RTN","C0QMU12",244,0)
1198 . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" D ;
1199"RTN","C0QMU12",245,0)
1200 . . S C0QLIST(ZYR_"HasMed",DFN)=""
1201"RTN","C0QMU12",246,0)
1202 . . S C0QLIST(ZYR_"HasMedOrders",DFN)=""
1203"RTN","C0QMU12",247,0)
1204 . . S C0QLIST(ZYR_"HasERX",DFN)=""
1205"RTN","C0QMU12",248,0)
1206 . . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
1207"RTN","C0QMU12",249,0)
1208 . E D ;
1209"RTN","C0QMU12",250,0)
1210 . . S C0QLIST(ZYR_"NoMed",DFN)=""
1211"RTN","C0QMU12",251,0)
1212 . . S C0QLIST(ZYR_"NoMedOrders",DFN)=""
1213"RTN","C0QMU12",252,0)
1214 . . S C0QLIST(ZYR_"NoERX",DFN)=""
1215"RTN","C0QMU12",253,0)
1216 . . S C0QLIST(ZYR_"NoMedRecon",DFN)=""
1217"RTN","C0QMU12",254,0)
1218 Q
1219"RTN","C0QMU12",255,0)
1220 ;
1221"RTN","C0QMU12",256,0)
1222ADVDIR ; ADVANCE DIRECTIVE
1223"RTN","C0QMU12",257,0)
1224 ;
1225"RTN","C0QMU12",258,0)
1226 I $$AGE^C0QUTIL(DFN)>64 D ; ONLY FOR PATIENTS 65 AND OLDER
1227"RTN","C0QMU12",259,0)
1228 . S C0QLIST(ZYR_"Over65",DFN)=""
1229"RTN","C0QMU12",260,0)
1230 . I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D ;
1231"RTN","C0QMU12",261,0)
1232 . . S C0QLIST(ZYR_"HasAdvanceDirective",DFN)=""
1233"RTN","C0QMU12",262,0)
1234 . E D ;
1235"RTN","C0QMU12",263,0)
1236 . . S C0QLIST(ZYR_"NoAdvanceDirective",DFN)=""
1237"RTN","C0QMU12",264,0)
1238 Q
1239"RTN","C0QMU12",265,0)
1240 ;
1241"RTN","C0QMU12",266,0)
1242SMOKING ;
1243"RTN","C0QMU12",267,0)
1244 ; WANT TO CHANGE SMOKING STATUS CHECKING FOR 2012 TO A SIMPLE SET OF
1245"RTN","C0QMU12",268,0)
1246 ; HEALTH FACTORS. GPL
1247"RTN","C0QMU12",269,0)
1248 I $$INLIST(ZYR_"HasSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STAT CHECK
1249"RTN","C0QMU12",270,0)
1250 . S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
1251"RTN","C0QMU12",271,0)
1252 . S C0QLIST(ZYR_"Over12",DFN)=""
1253"RTN","C0QMU12",272,0)
1254 I $$INLIST(ZYR_"NoSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STATUS CHECK
1255"RTN","C0QMU12",273,0)
1256 . S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
1257"RTN","C0QMU12",274,0)
1258 . S C0QLIST(ZYR_"Over12",DFN)=""
1259"RTN","C0QMU12",275,0)
1260 N C0QSMOKE,C0QSYN
1261"RTN","C0QMU12",276,0)
1262 S C0QSYN=0
1263"RTN","C0QMU12",277,0)
1264 I $$AGE^C0QUTIL(DFN)<13 Q ; DON'T CHECK UNDER AGE 13
1265"RTN","C0QMU12",278,0)
1266 D HFCAT^C0QHF(.C0QSMOKE,DFN,"TOBACCO") ; GET ALL HEALTH FACTORS FOR THE
1267"RTN","C0QMU12",279,0)
1268 ; PATIENT IN THE CATEGORY OF TOBACCO
1269"RTN","C0QMU12",280,0)
1270 I $D(C0QSMOKE) S C0QSYN=1
1271"RTN","C0QMU12",281,0)
1272 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco <1 Yr Ago")
1273"RTN","C0QMU12",282,0)
1274 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco > 20 Yrs Ago")
1275"RTN","C0QMU12",283,0)
1276 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 1-5 Yrs Ago")
1277"RTN","C0QMU12",284,0)
1278 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 10-20 Yrs Ago")
1279"RTN","C0QMU12",285,0)
1280 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 5-10 Yrs Ago")
1281"RTN","C0QMU12",286,0)
1282 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking")
1283"RTN","C0QMU12",287,0)
1284 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking < 1 Yr Ago")
1285"RTN","C0QMU12",288,0)
1286 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking > 20 Yrs Ago")
1287"RTN","C0QMU12",289,0)
1288 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 1-5 Yrs Ago")
1289"RTN","C0QMU12",290,0)
1290 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 10-20 Yrs Ago")
1291"RTN","C0QMU12",291,0)
1292 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 5-10 Yrs Ago")
1293"RTN","C0QMU12",292,0)
1294 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
1295"RTN","C0QMU12",293,0)
1296 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 1-5 YRS AGO")
1297"RTN","C0QMU12",294,0)
1298 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 10-20 YRS AGO")
1299"RTN","C0QMU12",295,0)
1300 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 5-10 YRS AGO")
1301"RTN","C0QMU12",296,0)
1302 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: < 1 YR AGO")
1303"RTN","C0QMU12",297,0)
1304 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: > 20 YRS AGO")
1305"RTN","C0QMU12",298,0)
1306 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER")
1307"RTN","C0QMU12",299,0)
1308 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 10-20 YRS")
1309"RTN","C0QMU12",300,0)
1310 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 20+ YRS")
1311"RTN","C0QMU12",301,0)
1312 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR")
1313"RTN","C0QMU12",302,0)
1314 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR AGO")
1315"RTN","C0QMU12",303,0)
1316 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER > 20 YRS AGO")
1317"RTN","C0QMU12",304,0)
1318 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS")
1319"RTN","C0QMU12",305,0)
1320 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS AGO")
1321"RTN","C0QMU12",306,0)
1322 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 10-20 YRS AGO")
1323"RTN","C0QMU12",307,0)
1324 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS")
1325"RTN","C0QMU12",308,0)
1326 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS AGO")
1327"RTN","C0QMU12",309,0)
1328 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
1329"RTN","C0QMU12",310,0)
1330 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
1331"RTN","C0QMU12",311,0)
1332 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
1333"RTN","C0QMU12",312,0)
1334 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
1335"RTN","C0QMU12",313,0)
1336 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
1337"RTN","C0QMU12",314,0)
1338 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
1339"RTN","C0QMU12",315,0)
1340 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
1341"RTN","C0QMU12",316,0)
1342 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
1343"RTN","C0QMU12",317,0)
1344 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
1345"RTN","C0QMU12",318,0)
1346 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
1347"RTN","C0QMU12",319,0)
1348 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
1349"RTN","C0QMU12",320,0)
1350 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
1351"RTN","C0QMU12",321,0)
1352 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
1353"RTN","C0QMU12",322,0)
1354 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
1355"RTN","C0QMU12",323,0)
1356 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
1357"RTN","C0QMU12",324,0)
1358 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
1359"RTN","C0QMU12",325,0)
1360 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
1361"RTN","C0QMU12",326,0)
1362 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
1363"RTN","C0QMU12",327,0)
1364 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
1365"RTN","C0QMU12",328,0)
1366 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
1367"RTN","C0QMU12",329,0)
1368 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking Cessation (OPH)")
1369"RTN","C0QMU12",330,0)
1370 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
1371"RTN","C0QMU12",331,0)
1372 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
1373"RTN","C0QMU12",332,0)
1374 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
1375"RTN","C0QMU12",333,0)
1376 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
1377"RTN","C0QMU12",334,0)
1378 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
1379"RTN","C0QMU12",335,0)
1380 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
1381"RTN","C0QMU12",336,0)
1382 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
1383"RTN","C0QMU12",337,0)
1384 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
1385"RTN","C0QMU12",338,0)
1386 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
1387"RTN","C0QMU12",339,0)
1388 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
1389"RTN","C0QMU12",340,0)
1390 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
1391"RTN","C0QMU12",341,0)
1392 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
1393"RTN","C0QMU12",342,0)
1394 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
1395"RTN","C0QMU12",343,0)
1396 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
1397"RTN","C0QMU12",344,0)
1398 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
1399"RTN","C0QMU12",345,0)
1400 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
1401"RTN","C0QMU12",346,0)
1402 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
1403"RTN","C0QMU12",347,0)
1404 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
1405"RTN","C0QMU12",348,0)
1406 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
1407"RTN","C0QMU12",349,0)
1408 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
1409"RTN","C0QMU12",350,0)
1410 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
1411"RTN","C0QMU12",351,0)
1412 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
1413"RTN","C0QMU12",352,0)
1414 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
1415"RTN","C0QMU12",353,0)
1416 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
1417"RTN","C0QMU12",354,0)
1418 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
1419"RTN","C0QMU12",355,0)
1420 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
1421"RTN","C0QMU12",356,0)
1422 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
1423"RTN","C0QMU12",357,0)
1424 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
1425"RTN","C0QMU12",358,0)
1426 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
1427"RTN","C0QMU12",359,0)
1428 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
1429"RTN","C0QMU12",360,0)
1430 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
1431"RTN","C0QMU12",361,0)
1432 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
1433"RTN","C0QMU12",362,0)
1434 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
1435"RTN","C0QMU12",363,0)
1436 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
1437"RTN","C0QMU12",364,0)
1438 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
1439"RTN","C0QMU12",365,0)
1440 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
1441"RTN","C0QMU12",366,0)
1442 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
1443"RTN","C0QMU12",367,0)
1444 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
1445"RTN","C0QMU12",368,0)
1446 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
1447"RTN","C0QMU12",369,0)
1448 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
1449"RTN","C0QMU12",370,0)
1450 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
1451"RTN","C0QMU12",371,0)
1452 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
1453"RTN","C0QMU12",372,0)
1454 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
1455"RTN","C0QMU12",373,0)
1456 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
1457"RTN","C0QMU12",374,0)
1458 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
1459"RTN","C0QMU12",375,0)
1460 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
1461"RTN","C0QMU12",376,0)
1462 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
1463"RTN","C0QMU12",377,0)
1464 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
1465"RTN","C0QMU12",378,0)
1466 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
1467"RTN","C0QMU12",379,0)
1468 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
1469"RTN","C0QMU12",380,0)
1470 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
1471"RTN","C0QMU12",381,0)
1472 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
1473"RTN","C0QMU12",382,0)
1474 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
1475"RTN","C0QMU12",383,0)
1476 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
1477"RTN","C0QMU12",384,0)
1478 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
1479"RTN","C0QMU12",385,0)
1480 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
1481"RTN","C0QMU12",386,0)
1482 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
1483"RTN","C0QMU12",387,0)
1484 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
1485"RTN","C0QMU12",388,0)
1486 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
1487"RTN","C0QMU12",389,0)
1488 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
1489"RTN","C0QMU12",390,0)
1490 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
1491"RTN","C0QMU12",391,0)
1492 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
1493"RTN","C0QMU12",392,0)
1494 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
1495"RTN","C0QMU12",393,0)
1496 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
1497"RTN","C0QMU12",394,0)
1498 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
1499"RTN","C0QMU12",395,0)
1500 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
1501"RTN","C0QMU12",396,0)
1502 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
1503"RTN","C0QMU12",397,0)
1504 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
1505"RTN","C0QMU12",398,0)
1506 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
1507"RTN","C0QMU12",399,0)
1508 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
1509"RTN","C0QMU12",400,0)
1510 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
1511"RTN","C0QMU12",401,0)
1512 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
1513"RTN","C0QMU12",402,0)
1514 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
1515"RTN","C0QMU12",403,0)
1516 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
1517"RTN","C0QMU12",404,0)
1518 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
1519"RTN","C0QMU12",405,0)
1520 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
1521"RTN","C0QMU12",406,0)
1522 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
1523"RTN","C0QMU12",407,0)
1524 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
1525"RTN","C0QMU12",408,0)
1526 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
1527"RTN","C0QMU12",409,0)
1528 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker (PMH)")
1529"RTN","C0QMU12",410,0)
1530 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Tobacco User")
1531"RTN","C0QMU12",411,0)
1532 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - No")
1533"RTN","C0QMU12",412,0)
1534 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - Yes")
1535"RTN","C0QMU12",413,0)
1536 S C0QLIST(ZYR_"Over12",DFN)=""
1537"RTN","C0QMU12",414,0)
1538 ;N GT
1539"RTN","C0QMU12",415,0)
1540 ;S GT(1,"HasSmokingStatus","SMOK")=""
1541"RTN","C0QMU12",416,0)
1542 ;S GT(2,"HasSmokingStatus","Smok")=""
1543"RTN","C0QMU12",417,0)
1544 ;S GT(3,"HasSmokingStatus","smok")=""
1545"RTN","C0QMU12",418,0)
1546 ;I 'C0QSYN D ;
1547"RTN","C0QMU12",419,0)
1548 ;. N G
1549"RTN","C0QMU12",420,0)
1550 ;. S OK=$$TXTALL^C0QNOTES(.G,.GT,DFN)
1551"RTN","C0QMU12",421,0)
1552 ;. I $D(G) S C0QSYN=1
1553"RTN","C0QMU12",422,0)
1554 I C0QSYN S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
1555"RTN","C0QMU12",423,0)
1556 E S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
1557"RTN","C0QMU12",424,0)
1558 Q
1559"RTN","C0QMU12",425,0)
1560 ;
1561"RTN","C0QMU12",426,0)
1562VITALS ;
1563"RTN","C0QMU12",427,0)
1564 ;
1565"RTN","C0QMU12",428,0)
1566 N C0QSDT,C0QEDT
1567"RTN","C0QMU12",429,0)
1568 D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
1569"RTN","C0QMU12",430,0)
1570 D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
1571"RTN","C0QMU12",431,0)
1572 D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
1573"RTN","C0QMU12",432,0)
1574 I $D(VITRSLT) D ;ZWR VITRSLT B ;
1575"RTN","C0QMU12",433,0)
1576 . I VITRSLT(1)["No vitals found." S C0QLIST(ZYR_"NoVitalSigns",DFN)=""
1577"RTN","C0QMU12",434,0)
1578 . E S C0QLIST(ZYR_"HasVitalSigns",DFN)=""
1579"RTN","C0QMU12",435,0)
1580 Q
1581"RTN","C0QMU12",436,0)
1582 ;
1583"RTN","C0QMU12",437,0)
1584VTE1 ; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL
1585"RTN","C0QMU12",438,0)
1586 ;
1587"RTN","C0QMU12",439,0)
1588 I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D ;
1589"RTN","C0QMU12",440,0)
1590 . S C0QLIST(ZYR_"HasVTE24",DFN)=""
1591"RTN","C0QMU12",441,0)
1592 E S C0QLIST(ZYR_"NoVTE24",DFN)=""
1593"RTN","C0QMU12",442,0)
1594 Q
1595"RTN","C0QMU12",443,0)
1596 ;
1597"RTN","C0QMU12",444,0)
1598COD ; TEST FOR PRELIMINARY CAUSE OF DEATH NOTE
1599"RTN","C0QMU12",445,0)
1600 I $$HASNTYN^C0QNOTES("PRELIMINARY CAUSE OF DEATH",DFN) D ;
1601"RTN","C0QMU12",446,0)
1602 . S C0QLIST(ZYR_"CauseOfDeath",DFN)=""
1603"RTN","C0QMU12",447,0)
1604 Q
1605"RTN","C0QMU12",448,0)
1606 ;
1607"RTN","C0QMU12",449,0)
1608EDTIME ; CHECK FOR EMERGENCY DEPT TIME FACTORS
1609"RTN","C0QMU12",450,0)
1610 N FOUND
1611"RTN","C0QMU12",451,0)
1612 S FOUND=0
1613"RTN","C0QMU12",452,0)
1614 I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1
1615"RTN","C0QMU12",453,0)
1616 I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0
1617"RTN","C0QMU12",454,0)
1618 I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0
1619"RTN","C0QMU12",455,0)
1620 I FOUND D ;
1621"RTN","C0QMU12",456,0)
1622 . S C0QLIST(ZYR_"HasEDtime",DFN)=""
1623"RTN","C0QMU12",457,0)
1624 E S C0QLIST(ZYR_"NoEDtime",DFN)=""
1625"RTN","C0QMU12",458,0)
1626 Q
1627"RTN","C0QMU12",459,0)
1628 ;
1629"RTN","C0QMU12",460,0)
1630ICUPAT ; CREATE LIST OF ICU PATIENTS
1631"RTN","C0QMU12",461,0)
1632 N ZICU
1633"RTN","C0QMU12",462,0)
1634 S ZICU=$O(^SC("B","IC","")) ; IEN OF ICU HOSPITAL LOCATION
1635"RTN","C0QMU12",463,0)
1636 N ZI,ZJ,ZP
1637"RTN","C0QMU12",464,0)
1638 S ZI=""
1639"RTN","C0QMU12",465,0)
1640 F S ZI=$O(^AUPNVSIT("AHL",ZICU,ZI)) Q:ZI="" D ; EACH DATE
1641"RTN","C0QMU12",466,0)
1642 . S ZJ=""
1643"RTN","C0QMU12",467,0)
1644 . F S ZJ=$O(^AUPNVSIT("AHL",ZICU,ZI,ZJ)) Q:ZJ="" D ; EACH VISIT
1645"RTN","C0QMU12",468,0)
1646 . . S ZP=$P(^AUPNVSIT(ZJ,0),"^",5) ; DFN
1647"RTN","C0QMU12",469,0)
1648 . . S C0QLIST(ZYR_"ICUPatient",ZP)=""
1649"RTN","C0QMU12",470,0)
1650 Q
1651"RTN","C0QMU12",471,0)
1652 ;
1653"RTN","C0QMU12",472,0)
1654FILTER ; CALLED AFTER ALL THE PATIENT LISTS HAVE BEEN FILED
1655"RTN","C0QMU12",473,0)
1656 ; WILL KILL C0QLIST AND CREATE DERIVATIVE PATIENT LISTS BY FILTERING
1657"RTN","C0QMU12",474,0)
1658 K C0QLIST
1659"RTN","C0QMU12",475,0)
1660 N ZPAT
1661"RTN","C0QMU12",476,0)
1662 S ZPAT=$$PATLN(ZYR_"Patient") ; name of patient list of all patients admitted
1663"RTN","C0QMU12",477,0)
1664 ; during the reporting period. used to filter other lists
1665"RTN","C0QMU12",478,0)
1666 ;
1667"RTN","C0QMU12",479,0)
1668 ; filter ICU patients against ZPAT
1669"RTN","C0QMU12",480,0)
1670 N GN,GO,GF
1671"RTN","C0QMU12",481,0)
1672 S GN=ZPAT
1673"RTN","C0QMU12",482,0)
1674 S GO=$$PATLN(ZYR_"ICUPatient") ; all ICU patient
1675"RTN","C0QMU12",483,0)
1676 S GF=$NA(C0QLIST(ZYR_"ICUReporting")) ; the filtered list destination
1677"RTN","C0QMU12",484,0)
1678 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
1679"RTN","C0QMU12",485,0)
1680 ;
1681"RTN","C0QMU12",486,0)
1682 ; FILTER VTE-2 DENOMINATOR FOR QUALITY MEASURE
1683"RTN","C0QMU12",487,0)
1684 ;
1685"RTN","C0QMU12",488,0)
1686 S GN=$NA(C0QLIST(ZYR_"ICUReporting")) ; ICU patients admitted inside rpt period
1687"RTN","C0QMU12",489,0)
1688 S GO=$$RPATLN("MU VTE-2 DENOM PL") ; TAXONOMY BASED DENOMENATOR
1689"RTN","C0QMU12",490,0)
1690 S GF=$NA(C0QLIST(ZYR_"VTE2DEN")) ; NEW DENOMINATOR PL
1691"RTN","C0QMU12",491,0)
1692 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
1693"RTN","C0QMU12",492,0)
1694 ;
1695"RTN","C0QMU12",493,0)
1696 S GN=ZPAT
1697"RTN","C0QMU12",494,0)
1698 S GO=$$RPATLN("MU VTE-3 DENOM PL") ; TAXONOMY BASED DENOMENATOR
1699"RTN","C0QMU12",495,0)
1700 S GF=$NA(C0QLIST(ZYR_"VTE3DEN")) ; NEW DENOMINATOR PL
1701"RTN","C0QMU12",496,0)
1702 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
1703"RTN","C0QMU12",497,0)
1704 ;
1705"RTN","C0QMU12",498,0)
1706 S GN=ZPAT
1707"RTN","C0QMU12",499,0)
1708 S GO=$$RPATLN("MU VTE-4 DENOM PL") ; TAXONOMY BASED DENOMENATOR
1709"RTN","C0QMU12",500,0)
1710 S GF=$NA(C0QLIST(ZYR_"VTE4DEN")) ; NEW DENOMINATOR PL
1711"RTN","C0QMU12",501,0)
1712 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
1713"RTN","C0QMU12",502,0)
1714 ;
1715"RTN","C0QMU12",503,0)
1716 S GN=ZPAT
1717"RTN","C0QMU12",504,0)
1718 S GO=$$RPATLN("MU VTE-5 DENOM PL") ; TAXONOMY BASED DENOMENATOR
1719"RTN","C0QMU12",505,0)
1720 S GF=$NA(C0QLIST(ZYR_"VTE5DEN")) ; NEW DENOMINATOR PL
1721"RTN","C0QMU12",506,0)
1722 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
1723"RTN","C0QMU12",507,0)
1724 ;
1725"RTN","C0QMU12",508,0)
1726 D FILE ; FILE ALL THE PATIENT LISTS
1727"RTN","C0QMU12",509,0)
1728 D UPDATE^C0QUPDT(.G,5) ; UPDATE THE HOS 2011 MEANINGFUL USE measure set
1729"RTN","C0QMU12",510,0)
1730 Q
1731"RTN","C0QMU12",511,0)
1732 ;
1733"RTN","C0QMU12",512,0)
1734ED1 ;
1735"RTN","C0QMU12",513,0)
1736 S ZYR="MU12-"
1737"RTN","C0QMU12",514,0)
1738 D DOTIME("ED DEPARTURE TIME")
1739"RTN","C0QMU12",515,0)
1740 Q
1741"RTN","C0QMU12",516,0)
1742 ;
1743"RTN","C0QMU12",517,0)
1744ED2 ;
1745"RTN","C0QMU12",518,0)
1746 S ZYR="MU12-"
1747"RTN","C0QMU12",519,0)
1748 D DOTIME2("TIME DECISION TO ADMIT MADE")
1749"RTN","C0QMU12",520,0)
1750 Q
1751"RTN","C0QMU12",521,0)
1752 ;
1753"RTN","C0QMU12",522,0)
1754DOTIME(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
1755"RTN","C0QMU12",523,0)
1756 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
1757"RTN","C0QMU12",524,0)
1758 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
1759"RTN","C0QMU12",525,0)
1760 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
1761"RTN","C0QMU12",526,0)
1762 N ZP
1763"RTN","C0QMU12",527,0)
1764 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
1765"RTN","C0QMU12",528,0)
1766 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
1767"RTN","C0QMU12",529,0)
1768 S ZVFN=9000010 ; VISIT FILE NUMBER
1769"RTN","C0QMU12",530,0)
1770 K ZARY1,ZARY2
1771"RTN","C0QMU12",531,0)
1772 N ZI S ZI=""
1773"RTN","C0QMU12",532,0)
1774 S COUNT=0
1775"RTN","C0QMU12",533,0)
1776 F S ZI=$O(@ZP@(ZI)) Q:ZI="" D ; FOR EACH PATIENT
1777"RTN","C0QMU12",534,0)
1778 . S COUNT=COUNT+1
1779"RTN","C0QMU12",535,0)
1780 . N ZA,ZD
1781"RTN","C0QMU12",536,0)
1782 . S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
1783"RTN","C0QMU12",537,0)
1784 . S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
1785"RTN","C0QMU12",538,0)
1786 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
1787"RTN","C0QMU12",539,0)
1788 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT
1789"RTN","C0QMU12",540,0)
1790 . ; THE COMMENT IS THE TIME XXYY
1791"RTN","C0QMU12",541,0)
1792 . N OK,TMP
1793"RTN","C0QMU12",542,0)
1794 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
1795"RTN","C0QMU12",543,0)
1796 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
1797"RTN","C0QMU12",544,0)
1798 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
1799"RTN","C0QMU12",545,0)
1800 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
1801"RTN","C0QMU12",546,0)
1802 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
1803"RTN","C0QMU12",547,0)
1804 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
1805"RTN","C0QMU12",548,0)
1806 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
1807"RTN","C0QMU12",549,0)
1808 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
1809"RTN","C0QMU12",550,0)
1810 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
1811"RTN","C0QMU12",551,0)
1812 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
1813"RTN","C0QMU12",552,0)
1814 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
1815"RTN","C0QMU12",553,0)
1816 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
1817"RTN","C0QMU12",554,0)
1818 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
1819"RTN","C0QMU12",555,0)
1820 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
1821"RTN","C0QMU12",556,0)
1822 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
1823"RTN","C0QMU12",557,0)
1824 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
1825"RTN","C0QMU12",558,0)
1826 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
1827"RTN","C0QMU12",559,0)
1828 . S GTOT=G1-G2
1829"RTN","C0QMU12",560,0)
1830 . W !,"TIME: ",GTOT," ESTIMATED"
1831"RTN","C0QMU12",561,0)
1832 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
1833"RTN","C0QMU12",562,0)
1834 . W !,"COMPUTED MINUTES: ",ZT
1835"RTN","C0QMU12",563,0)
1836 . ;I ZT'=GTOT B ; LET'S FIND OUT WHAT'S WRONG
1837"RTN","C0QMU12",564,0)
1838 . I ZT<0 D Q ; SKIP PATIENTS WITH NEGATIVE TIMES
1839"RTN","C0QMU12",565,0)
1840 . . W !,"****EXCLUDED****"
1841"RTN","C0QMU12",566,0)
1842 . I ZT>400000 D Q ; THESE ARE ERRORS
1843"RTN","C0QMU12",567,0)
1844 . . W !,"****EXCLUDED****"
1845"RTN","C0QMU12",568,0)
1846 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
1847"RTN","C0QMU12",569,0)
1848 N ZY,ZZ S ZY="" S ZZ=""
1849"RTN","C0QMU12",570,0)
1850 N ZCOUNT S ZCOUNT=0
1851"RTN","C0QMU12",571,0)
1852 F S ZY=$O(ZARY1(ZY)) Q:ZY="" D ; FOR EACH TIME
1853"RTN","C0QMU12",572,0)
1854 . F S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ="" D ; FOR EACH PATIENT WITH THIS TIME
1855"RTN","C0QMU12",573,0)
1856 . . S ZCOUNT=ZCOUNT+1
1857"RTN","C0QMU12",574,0)
1858 . . S ZARY2(ZCOUNT,ZY,ZZ)=""
1859"RTN","C0QMU12",575,0)
1860 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
1861"RTN","C0QMU12",576,0)
1862 N ZMID
1863"RTN","C0QMU12",577,0)
1864 S ZMID=$P(ZCOUNT/2,".")
1865"RTN","C0QMU12",578,0)
1866 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
1867"RTN","C0QMU12",579,0)
1868 W !,"ED ARRIVAL TIME UNTIL ",ZHF
1869"RTN","C0QMU12",580,0)
1870 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
1871"RTN","C0QMU12",581,0)
1872 Q
1873"RTN","C0QMU12",582,0)
1874 ;
1875"RTN","C0QMU12",583,0)
1876DOTIME2(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
1877"RTN","C0QMU12",584,0)
1878 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
1879"RTN","C0QMU12",585,0)
1880 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
1881"RTN","C0QMU12",586,0)
1882 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
1883"RTN","C0QMU12",587,0)
1884 N ZP
1885"RTN","C0QMU12",588,0)
1886 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
1887"RTN","C0QMU12",589,0)
1888 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
1889"RTN","C0QMU12",590,0)
1890 S ZVFN=9000010 ; VISIT FILE NUMBER
1891"RTN","C0QMU12",591,0)
1892 K ZARY1,ZARY2
1893"RTN","C0QMU12",592,0)
1894 N ZI S ZI=""
1895"RTN","C0QMU12",593,0)
1896 S COUNT=0
1897"RTN","C0QMU12",594,0)
1898 F S ZI=$O(@ZP@(ZI)) Q:ZI="" D ; FOR EACH PATIENT
1899"RTN","C0QMU12",595,0)
1900 . S COUNT=COUNT+1
1901"RTN","C0QMU12",596,0)
1902 . N ZA,ZD
1903"RTN","C0QMU12",597,0)
1904 . ;S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
1905"RTN","C0QMU12",598,0)
1906 . ;S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
1907"RTN","C0QMU12",599,0)
1908 . S ZA=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
1909"RTN","C0QMU12",600,0)
1910 . S ZD=$$VHFIEN^C0QHF(ZI,"ED DEPARTURE TIME") ; IEN OF ARRIVAL HEALTH FACTOR
1911"RTN","C0QMU12",601,0)
1912 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
1913"RTN","C0QMU12",602,0)
1914 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT
1915"RTN","C0QMU12",603,0)
1916 . ; THE COMMENT IS THE TIME XXYY
1917"RTN","C0QMU12",604,0)
1918 . N OK,TMP
1919"RTN","C0QMU12",605,0)
1920 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
1921"RTN","C0QMU12",606,0)
1922 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
1923"RTN","C0QMU12",607,0)
1924 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
1925"RTN","C0QMU12",608,0)
1926 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
1927"RTN","C0QMU12",609,0)
1928 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
1929"RTN","C0QMU12",610,0)
1930 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
1931"RTN","C0QMU12",611,0)
1932 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
1933"RTN","C0QMU12",612,0)
1934 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
1935"RTN","C0QMU12",613,0)
1936 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
1937"RTN","C0QMU12",614,0)
1938 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
1939"RTN","C0QMU12",615,0)
1940 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
1941"RTN","C0QMU12",616,0)
1942 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
1943"RTN","C0QMU12",617,0)
1944 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
1945"RTN","C0QMU12",618,0)
1946 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
1947"RTN","C0QMU12",619,0)
1948 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
1949"RTN","C0QMU12",620,0)
1950 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
1951"RTN","C0QMU12",621,0)
1952 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
1953"RTN","C0QMU12",622,0)
1954 . S GTOT=G1-G2
1955"RTN","C0QMU12",623,0)
1956 . W !,"TIME: ",GTOT," ESTIMATED"
1957"RTN","C0QMU12",624,0)
1958 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
1959"RTN","C0QMU12",625,0)
1960 . W !,"COMPUTED MINUTES: ",ZT
1961"RTN","C0QMU12",626,0)
1962 . ;I ZT'=GTOT B ; LET'S FIND OUT WHAT'S WRONG
1963"RTN","C0QMU12",627,0)
1964 . I ZT<0 D Q ; SKIP PATIENTS WITH NEGATIVE TIMES
1965"RTN","C0QMU12",628,0)
1966 . . W !,"****EXCLUDED****"
1967"RTN","C0QMU12",629,0)
1968 . I ZT>400000 D Q ; THESE ARE ERRORS
1969"RTN","C0QMU12",630,0)
1970 . . W !,"****EXCLUDED****"
1971"RTN","C0QMU12",631,0)
1972 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
1973"RTN","C0QMU12",632,0)
1974 N ZY,ZZ S ZY="" S ZZ=""
1975"RTN","C0QMU12",633,0)
1976 N ZCOUNT S ZCOUNT=0
1977"RTN","C0QMU12",634,0)
1978 F S ZY=$O(ZARY1(ZY)) Q:ZY="" D ; FOR EACH TIME
1979"RTN","C0QMU12",635,0)
1980 . F S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ="" D ; FOR EACH PATIENT WITH THIS TIME
1981"RTN","C0QMU12",636,0)
1982 . . S ZCOUNT=ZCOUNT+1
1983"RTN","C0QMU12",637,0)
1984 . . S ZARY2(ZCOUNT,ZY,ZZ)=""
1985"RTN","C0QMU12",638,0)
1986 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
1987"RTN","C0QMU12",639,0)
1988 N ZMID
1989"RTN","C0QMU12",640,0)
1990 S ZMID=$P(ZCOUNT/2,".")
1991"RTN","C0QMU12",641,0)
1992 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
1993"RTN","C0QMU12",642,0)
1994 W !,"ED ARRIVAL TIME UNTIL ",ZHF
1995"RTN","C0QMU12",643,0)
1996 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
1997"RTN","C0QMU12",644,0)
1998 Q
1999"RTN","C0QMU12",645,0)
2000 ;
2001"RTN","C0QMU12",646,0)
2002RPATLN(ZLST) ; EXTRINSIC RETURNS THE GLOBAL NAME OF THE REMINDER PATIENT LIST
2003"RTN","C0QMU12",647,0)
2004 ; WHOSE NAME IS ZLST
2005"RTN","C0QMU12",648,0)
2006 N ZIEN,ZN
2007"RTN","C0QMU12",649,0)
2008 S ZIEN=$O(^PXRMXP(810.5,"B",ZLST,"")) ; ien of patient list
2009"RTN","C0QMU12",650,0)
2010 S ZN=$NA(^PXRMXP(810.5,ZIEN,30,"B")) ; GLOBAL NAME IN REMINDER PATIENT LIST
2011"RTN","C0QMU12",651,0)
2012 Q ZN
2013"RTN","C0QMU12",652,0)
2014 ;
2015"RTN","C0QMU12",653,0)
2016PATLN(ZATTR) ; EXTRINSIC RETURNS THE NAME OF THE PATIENT LIST WITH
2017"RTN","C0QMU12",654,0)
2018 ; THE ATTRIBUTE ZATTR
2019"RTN","C0QMU12",655,0)
2020 N ZIEN,ZN
2021"RTN","C0QMU12",656,0)
2022 S ZIEN=$O(^C0Q(301,"CATTR",ZATTR,"")) ; ien of patient list
2023"RTN","C0QMU12",657,0)
2024 S ZN=$NA(^C0Q(301,ZIEN,1,"B")) ; NAME OF PATIENT LIST IN C0Q PATIENT LIST
2025"RTN","C0QMU12",658,0)
2026 Q ZN
2027"RTN","C0QMU12",659,0)
2028 ;
2029"RTN","C0QMU12",660,0)
2030INLIST(ZLIST,DFN) ; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST
2031"RTN","C0QMU12",661,0)
2032 N ZL,ZR
2033"RTN","C0QMU12",662,0)
2034 S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE
2035"RTN","C0QMU12",663,0)
2036 I ZL="" Q 0 ; LIST DOES NOT EXIST
2037"RTN","C0QMU12",664,0)
2038 S ZR=0 ; ASSUME NOT IN LIST
2039"RTN","C0QMU12",665,0)
2040 I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
2041"RTN","C0QMU12",666,0)
2042 Q ZR
2043"RTN","C0QMU12",667,0)
2044 ;
2045"RTN","C0QMU12",668,0)
2046 ; LOOK AT GETTING RID OF PRINT AND SS AS THEY ARE NOT BEING USED. GPL
2047"RTN","C0QMU12",669,0)
2048PRINT ; PRINT TO SCREEN
2049"RTN","C0QMU12",670,0)
2050 I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "
2051"RTN","C0QMU12",671,0)
2052 I $D(EXDTE) D ;
2053"RTN","C0QMU12",672,0)
2054 . W !,"Discharge Date: ",EXDTE
2055"RTN","C0QMU12",673,0)
2056 . W !,DFN," ",PTNAME
2057"RTN","C0QMU12",674,0)
2058 W !,"DOB: ",PTDOB," HRN: ",PTHRN
2059"RTN","C0QMU12",675,0)
2060 W !,"Language Spoken: ",$G(PTLANG)
2061"RTN","C0QMU12",676,0)
2062 W !,"Race: ",RACEDSC
2063"RTN","C0QMU12",677,0)
2064 W !,"Ethnicity: ",$G(ETHNDSC)
2065"RTN","C0QMU12",678,0)
2066 W !,"Problems: "
2067"RTN","C0QMU12",679,0)
2068 W !,PBDESC
2069"RTN","C0QMU12",680,0)
2070 W !,"Allergies: "
2071"RTN","C0QMU12",681,0)
2072 W !,ALDESC
2073"RTN","C0QMU12",682,0)
2074 W !,"Medications: "
2075"RTN","C0QMU12",683,0)
2076 W !
2077"RTN","C0QMU12",684,0)
2078 Q
2079"RTN","C0QMU12",685,0)
2080 ;
2081"RTN","C0QMU12",686,0)
2082SS ; CREATE SPREADSHEET ARRAY
2083"RTN","C0QMU12",687,0)
2084 S G1("Patient")=DFN
2085"RTN","C0QMU12",688,0)
2086 I $D(WARD) D ;
2087"RTN","C0QMU12",689,0)
2088 . S G1("WardName")=WARDNAME
2089"RTN","C0QMU12",690,0)
2090 . S G1("RoomAndBed")=RB
2091"RTN","C0QMU12",691,0)
2092 I $D(EXDTE) D ;
2093"RTN","C0QMU12",692,0)
2094 . S G1("DischargeDate")=EXDTE
2095"RTN","C0QMU12",693,0)
2096 S G1("PatientName")=PTNAME
2097"RTN","C0QMU12",694,0)
2098 S G1("Gender")=PTSEX
2099"RTN","C0QMU12",695,0)
2100 S G1("DateOfBirth")=PTDOB
2101"RTN","C0QMU12",696,0)
2102 S G1("HealthRecordNumber")=PTHRN
2103"RTN","C0QMU12",697,0)
2104 S G1("LanguageSpoken")=$G(PTLANG)
2105"RTN","C0QMU12",698,0)
2106 S G1("Race")=RACEDSC
2107"RTN","C0QMU12",699,0)
2108 S G1("Ehtnicity")=$G(ETHNDSC)
2109"RTN","C0QMU12",700,0)
2110 S G1("Problem")=PBDESC
2111"RTN","C0QMU12",701,0)
2112 I PBDESC["No problems found" S G1("HasProblem")=0
2113"RTN","C0QMU12",702,0)
2114 E S G1("HasProblem")=1
2115"RTN","C0QMU12",703,0)
2116 S G1("Allergies")=ALDESC
2117"RTN","C0QMU12",704,0)
2118 I ALDESC["No Allergy" S G1("HasAllergy")=0
2119"RTN","C0QMU12",705,0)
2120 E S G1("HasAllergy")=1
2121"RTN","C0QMU12",706,0)
2122 I $D(MDITEM) D ;
2123"RTN","C0QMU12",707,0)
2124 . S G1("HasMed")=1
2125"RTN","C0QMU12",708,0)
2126 E S G1("HasMed")=0
2127"RTN","C0QMU12",709,0)
2128 S G1("MedDescription")=$G(MDDESC)
2129"RTN","C0QMU12",710,0)
2130 I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E W !,MDDESC
2131"RTN","C0QMU12",711,0)
2132 D RNF1TO2B^C0CRNF("GRSLT","G1")
2133"RTN","C0QMU12",712,0)
2134 K G1
2135"RTN","C0QMU12",713,0)
2136 Q ; DON'T WANT TO DO THE NHIN STUFF NOW
2137"RTN","C0QMU12",714,0)
2138 ;
2139"RTN","C0QMU12",715,0)
2140PATLIST ; CREATE PATIENT LISTS
2141"RTN","C0QMU12",716,0)
2142 ; WANT TO GET RID OF PATLIST AND MOVE FUNCTION TO OTHER ROUTINES. GPL
2143"RTN","C0QMU12",717,0)
2144 S C0QLIST(ZYR_"Patient",DFN)="" ; THE PATIENT LIST
2145"RTN","C0QMU12",718,0)
2146 N DEMOYN S DEMOYN=1
2147"RTN","C0QMU12",719,0)
2148 I $G(PTSEX)="" S DEMOYN=0
2149"RTN","C0QMU12",720,0)
2150 I $G(PTDOB)="" S DEMOYN=0
2151"RTN","C0QMU12",721,0)
2152 I $G(PTHRN)="" S DEMOYN=0
2153"RTN","C0QMU12",722,0)
2154 I $G(PTLANG)="" S DEMOYN=0
2155"RTN","C0QMU12",723,0)
2156 I $G(RACEDSC)="" S DEMOYN=0
2157"RTN","C0QMU12",724,0)
2158 I $G(ETHNDSC)="" S DEMOYN=0
2159"RTN","C0QMU12",725,0)
2160 ;I DEMOYN S C0QLIST("HasDemographics",DFN)=""
2161"RTN","C0QMU12",726,0)
2162 ;E S C0QLIST("FailedDemographics",DFN)=""
2163"RTN","C0QMU12",727,0)
2164 ;S G1("Gender")=PTSEX
2165"RTN","C0QMU12",728,0)
2166 ;S G1("DateOfBirth")=PTDOB
2167"RTN","C0QMU12",729,0)
2168 ;S G1("HealthRecordNumber")=PTHRN
2169"RTN","C0QMU12",730,0)
2170 ;S G1("LanguageSpoken")=$G(PTLANG)
2171"RTN","C0QMU12",731,0)
2172 ;S G1("Race")=RACEDSC
2173"RTN","C0QMU12",732,0)
2174 ;S G1("Ehtnicity")=$G(ETHNDSC)
2175"RTN","C0QMU12",733,0)
2176 S G1("Problem")=PBDESC
2177"RTN","C0QMU12",734,0)
2178 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
2179"RTN","C0QMU12",735,0)
2180 E S C0QLIST(ZYR_"HasProblem",DFN)=""
2181"RTN","C0QMU12",736,0)
2182 ;S G1("Allergies")=ALDESC
2183"RTN","C0QMU12",737,0)
2184 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
2185"RTN","C0QMU12",738,0)
2186 E S C0QLIST(ZYR_"HasAllergy",DFN)=""
2187"RTN","C0QMU12",739,0)
2188 ;I $D(MDITEM) D ;
2189"RTN","C0QMU12",740,0)
2190 ;. S C0QLIST("HasMed",DFN)=""
2191"RTN","C0QMU12",741,0)
2192 ;E S G1("NoMed",DFN)=""
2193"RTN","C0QMU12",742,0)
2194 ;S G1("MedDescription")=$G(MDDESC)
2195"RTN","C0QMU12",743,0)
2196 Q
2197"RTN","C0QMU12",744,0)
2198 ;
2199"RTN","C0QMU12",745,0)
2200NHIN ; SHOW THE NHIN ARRAY FOR THIS PATIENT
2201"RTN","C0QMU12",746,0)
2202 Q:DFN=137!14
2203"RTN","C0QMU12",747,0)
2204 D EN^C0CNHIN(.G,DFN,"")
2205"RTN","C0QMU12",748,0)
2206 ZWRITE G
2207"RTN","C0QMU12",749,0)
2208 K G
2209"RTN","C0QMU12",750,0)
2210 ;
2211"RTN","C0QMU12",751,0)
2212 QUIT ;end of WARD
2213"RTN","C0QMU12",752,0)
2214 ;
2215"RTN","C0QMU12",753,0)
2216LOCPAT(PREFIX,LOC) ;retrieve active outpatients
2217"RTN","C0QMU12",754,0)
2218 ; PREFIX WILL GO IN C0XLIST(PREFIX_"-PATIENT",DFN)=""
2219"RTN","C0QMU12",755,0)
2220 ; LOC IS HOSPITAL LOCATION
2221"RTN","C0QMU12",756,0)
2222 S ULOC=$O(^SC("B",LOC,"")) ; IEN OF HOSPITAL LOCATION
2223"RTN","C0QMU12",757,0)
2224 I ULOC="" D Q ; OOPS
2225"RTN","C0QMU12",758,0)
2226 . W !,"HOSPITAL LOCATION NOT FOUND: ",LOC
2227"RTN","C0QMU12",759,0)
2228 S IDTE=9999999-DTE ; INVERSE DATE
2229"RTN","C0QMU12",760,0)
2230 N ZI
2231"RTN","C0QMU12",761,0)
2232 S ZI="" ; BEGIN AT LATEST DATE FOR THIS LOC IN VISIT FILE
2233"RTN","C0QMU12",762,0)
2234 F S ZI=$O(^AUPNVSIT("AHL",ULOC,ZI)) Q:(ZI="")!(ZI>IDTE) D ; FOR EACH DATE
2235"RTN","C0QMU12",763,0)
2236 . W !,$$FMTE^XLFDT(9999999-ZI) ;B ;
2237"RTN","C0QMU12",764,0)
2238 . I ZI="" Q ;
2239"RTN","C0QMU12",765,0)
2240 . N ZJ S ZJ=""
2241"RTN","C0QMU12",766,0)
2242 . F S ZJ=$O(^AUPNVSIT("AHL",ULOC,ZI,ZJ)) Q:ZJ="" D ; FOR EACH VISIT
2243"RTN","C0QMU12",767,0)
2244 . . S DFN=$$GET1^DIQ(9000010,ZJ,.05,"I") ; PATIENT
2245"RTN","C0QMU12",768,0)
2246 . . S C0QLIST(PREFIX_"Patient",DFN)=""
2247"RTN","C0QMU12",769,0)
2248 Q
2249"RTN","C0QMU12",770,0)
2250 ;
2251"RTN","C0QMU12",771,0)
2252EPPAT(ZYR) ; BUILD ALL PATIENT LISTS FOR CLINICS
2253"RTN","C0QMU12",772,0)
2254 ;
2255"RTN","C0QMU12",773,0)
2256 S DTE=3111000
2257"RTN","C0QMU12",774,0)
2258 S MUYR=ZYR
2259"RTN","C0QMU12",775,0)
2260 N ZC,ZN
2261"RTN","C0QMU12",776,0)
2262 S ZN=0
2263"RTN","C0QMU12",777,0)
2264 N ZI S ZI=0
2265"RTN","C0QMU12",778,0)
2266 F S ZI=$O(^SC(ZI)) Q:+ZI=0 D ; FOR EVERY HOSPITAL LOCATION
2267"RTN","C0QMU12",779,0)
2268 . I $$GET1^DIQ(44,ZI_",",2,"I")'="C" Q ; NOT A CLINIC
2269"RTN","C0QMU12",780,0)
2270 . S ZC=$$GET1^DIQ(44,ZI_",",.01) ; NAME OF CLINIC
2271"RTN","C0QMU12",781,0)
2272 . S ZCIEN=ZI ; IEN OF CLINIC
2273"RTN","C0QMU12",782,0)
2274 . S ZN=ZN+1 ; COUNT OF CLINICS
2275"RTN","C0QMU12",783,0)
2276 . S PRE=MUYR_"-EP-"_ZC_"-"
2277"RTN","C0QMU12",784,0)
2278 . D LOCPAT(PRE,ZC)
2279"RTN","C0QMU12",785,0)
2280 W !,"NUMBER OF CLINICS: ",ZN
2281"RTN","C0QMU12",786,0)
2282 D FILE ; CREATE ALL THE EP PATIENT LISTS
2283"RTN","C0QMU12",787,0)
2284 Q
2285"RTN","C0QMU12",788,0)
2286 ;
2287"RTN","C0QMU12",789,0)
2288DOEP ; DO EP COMPUTATIONS
2289"RTN","C0QMU12",790,0)
2290 S ZYR="MU12-"
2291"RTN","C0QMU12",791,0)
2292 N C0QPARM,C0QCLNC
2293"RTN","C0QMU12",792,0)
2294 D INIT("C0QPARM","EP") ; INITIALIZE PARAMETERS
2295"RTN","C0QMU12",793,0)
2296 K C0QLIST ; CLEAR THE LIST
2297"RTN","C0QMU12",794,0)
2298 N ZI S ZI=""
2299"RTN","C0QMU12",795,0)
2300 F S ZI=$O(C0QPARM(ZI)) Q:ZI="" D ; FOR EACH EP
2301"RTN","C0QMU12",796,0)
2302 . S DTE=C0QPARM(ZI,"EPBeginDate") ; beginning of measurement period
2303"RTN","C0QMU12",797,0)
2304 . S EDTE=C0QPARM(ZI,"EPEndDate") ; end of measurement period -- tbd use this
2305"RTN","C0QMU12",798,0)
2306 . S C0QCLNC=C0QPARM(ZI,"CLINICS",1,1) ; only one clinic for now
2307"RTN","C0QMU12",799,0)
2308 . S PRE=ZYR_"EP-"_C0QCLNC_"-"
2309"RTN","C0QMU12",800,0)
2310 . D LOCPAT(PRE,C0QCLNC) ; GET THE PATIENTS
2311"RTN","C0QMU12",801,0)
2312 . I $D(DEBUG) ZWRITE C0QLIST
2313"RTN","C0QMU12",802,0)
2314 . M C0QLIST(ZYR_"EP-ALL-PATIENTS")=C0QLIST(PRE_"Patient")
2315"RTN","C0QMU12",803,0)
2316 S DFN=""
2317"RTN","C0QMU12",804,0)
2318 S ZYR=ZYR_"EP-"
2319"RTN","C0QMU12",805,0)
2320 F S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN="" D ; EACH PATIENT
2321"RTN","C0QMU12",806,0)
2322 . D DEMO
2323"RTN","C0QMU12",807,0)
2324 . D PROBLEM
2325"RTN","C0QMU12",808,0)
2326 . D ALLERGY
2327"RTN","C0QMU12",809,0)
2328 . ;D MEDS
2329"RTN","C0QMU12",810,0)
2330 . D ERX
2331"RTN","C0QMU12",811,0)
2332 . D SMOKING
2333"RTN","C0QMU12",812,0)
2334 . D VITALS
2335"RTN","C0QMU12",813,0)
2336 D FILE ; FILE THE PATIENT LISTS
2337"RTN","C0QMU12",814,0)
2338 ;
2339"RTN","C0QMU12",815,0)
2340 ; Now process eRx MU measures for these patients
2341"RTN","C0QMU12",816,0)
2342 ; Check for eRx template and code first; if they exist, run the code
2343"RTN","C0QMU12",817,0)
2344 I $D(^C0PX("B","GETMEDS6")),$L($T(SOAP^C0PWS2)) DO
2345"RTN","C0QMU12",818,0)
2346 . N C0QDEBUG S C0QDEBUG=1 ; This causes the code to print out data;
2347"RTN","C0QMU12",819,0)
2348 . D EN^C0QMUERX($$PATLN^C0QMU12(ZYR_"HasERX")) ; Pass the eRx patient list
2349"RTN","C0QMU12",820,0)
2350 ;
2351"RTN","C0QMU12",821,0)
2352 N C0QCIEN
2353"RTN","C0QMU12",822,0)
2354 S ZI=""
2355"RTN","C0QMU12",823,0)
2356 F S ZI=$O(C0QPARM(ZI)) Q:ZI="" D ;
2357"RTN","C0QMU12",824,0)
2358 . S C0QCIEN=C0QPARM(ZI,"EPMeasurementSet") ; ien of measurement set
2359"RTN","C0QMU12",825,0)
2360 . N C0QDEBUG S C0QDEBUG=1 ; This causes the code to print out data;
2361"RTN","C0QMU12",826,0)
2362 . D UPDATE^C0QUPDT(.G,C0QCIEN) ; UPDATE THE MU MEASUREMENT SET
2363"RTN","C0QMU12",827,0)
2364 Q
2365"RTN","C0QMU12",828,0)
2366 ;
2367"RTN","C0QMU12",829,0)
2368DIS ;
2369"RTN","C0QMU12",830,0)
2370 N DFN,DTE,EXDTE S DTE=""
2371"RTN","C0QMU12",831,0)
2372 F D Q:DTE=""
2373"RTN","C0QMU12",832,0)
2374 . S DTE=$O(^DGPM("B",DTE))
2375"RTN","C0QMU12",833,0)
2376 . Q:'DTE
2377"RTN","C0QMU12",834,0)
2378 . ;Q:$P(DTE,".")<3110703
2379"RTN","C0QMU12",835,0)
2380 . Q:$P(DTE,".")<3111000 ; NEW BEGIN DATE FOR FISCAL YEAR 2012
2381"RTN","C0QMU12",836,0)
2382 . S EXDTE=$$FMTE^XLFDT(DTE)
2383"RTN","C0QMU12",837,0)
2384 . N PTFM S PTFM=""
2385"RTN","C0QMU12",838,0)
2386 . D
2387"RTN","C0QMU12",839,0)
2388 . . S PTFM=$O(^DGPM("B",DTE,PTFM))
2389"RTN","C0QMU12",840,0)
2390 . . Q:'PTFM
2391"RTN","C0QMU12",841,0)
2392 . . S DFN=$P(^DGPM(PTFM,0),U,3)
2393"RTN","C0QMU12",842,0)
2394 . . S C0QLIST(ZYR_"Patient",DFN)=""
2395"RTN","C0QMU12",843,0)
2396 . . D DEMO
2397"RTN","C0QMU12",844,0)
2398 . . D PROBLEM
2399"RTN","C0QMU12",845,0)
2400 . . D ALLERGY
2401"RTN","C0QMU12",846,0)
2402 . . D MEDS4
2403"RTN","C0QMU12",847,0)
2404 . . D RECON2
2405"RTN","C0QMU12",848,0)
2406 . . D ADVDIR
2407"RTN","C0QMU12",849,0)
2408 . . D SMOKING
2409"RTN","C0QMU12",850,0)
2410 . . D VITALS
2411"RTN","C0QMU12",851,0)
2412 . . ;D:$P(DTE,".")>3110912 VTE1
2413"RTN","C0QMU12",852,0)
2414 . . D VTE1
2415"RTN","C0QMU12",853,0)
2416 . . D COD
2417"RTN","C0QMU12",854,0)
2418 . . D EDTIME
2419"RTN","C0QMU12",855,0)
2420 . . I C0QPR D PRINT
2421"RTN","C0QMU12",856,0)
2422 . . I C0QSS D SS
2423"RTN","C0QMU12",857,0)
2424 . . I C0QPL D PATLIST
2425"RTN","C0QMU12",858,0)
2426 Q
2427"RTN","C0QMU12",859,0)
2428 ;
2429"RTN","C0QMU12",860,0)
2430C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
2431"RTN","C0QMU12",861,0)
2432C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
2433"RTN","C0QMU12",862,0)
2434FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
2435"RTN","C0QMU12",863,0)
2436 ;
2437"RTN","C0QMU12",864,0)
2438 I '$D(C0QLIST) Q ;
2439"RTN","C0QMU12",865,0)
2440 N LFN S LFN=$$C0QALFN()
2441"RTN","C0QMU12",866,0)
2442 N ZI,ZN
2443"RTN","C0QMU12",867,0)
2444 S ZI=""
2445"RTN","C0QMU12",868,0)
2446 F S ZI=$O(C0QLIST(ZI)) Q:ZI="" D ;
2447"RTN","C0QMU12",869,0)
2448 . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
2449"RTN","C0QMU12",870,0)
2450 . I ZN="" D ; LIST NOT FOUND, CREATE IT
2451"RTN","C0QMU12",871,0)
2452 . . K C0QFDA
2453"RTN","C0QMU12",872,0)
2454 . . S FN=$$C0QPLF ; C0Q PATIENT LIST FILE
2455"RTN","C0QMU12",873,0)
2456 . . S C0QFDA(FN,"+1,",.01)=ZI
2457"RTN","C0QMU12",874,0)
2458 . . S C0QFDA(FN,"+1,",999)=ZI ; ATTRIBUTE
2459"RTN","C0QMU12",875,0)
2460 . . W !,"CREATING ",ZI
2461"RTN","C0QMU12",876,0)
2462 . . D UPDIE ; ADD THE RECORD
2463"RTN","C0QMU12",877,0)
2464 . . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) ; THE NEW IEN
2465"RTN","C0QMU12",878,0)
2466 . ;I ZN="" D Q ; OOPS
2467"RTN","C0QMU12",879,0)
2468 . ;. W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
2469"RTN","C0QMU12",880,0)
2470 . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
2471"RTN","C0QMU12",881,0)
2472 . N C0QNEW,C0QOLD,C0QRSLT
2473"RTN","C0QMU12",882,0)
2474 . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
2475"RTN","C0QMU12",883,0)
2476 . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
2477"RTN","C0QMU12",884,0)
2478 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
2479"RTN","C0QMU12",885,0)
2480 . N ZJ,ZK
2481"RTN","C0QMU12",886,0)
2482 . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
2483"RTN","C0QMU12",887,0)
2484 . K C0QFDA
2485"RTN","C0QMU12",888,0)
2486 . S ZJ=""
2487"RTN","C0QMU12",889,0)
2488 . F S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ="" D ; MARKED WITH A 2 FROM UNITY
2489"RTN","C0QMU12",890,0)
2490 . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
2491"RTN","C0QMU12",891,0)
2492 . . I ZK="" D Q ; OOPS SHOULDN'T HAPPEN
2493"RTN","C0QMU12",892,0)
2494 . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
2495"RTN","C0QMU12",893,0)
2496 . . . S $EC=",U1130580001," ; smh - instead of a BREAK
2497"RTN","C0QMU12",894,0)
2498 . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
2499"RTN","C0QMU12",895,0)
2500 . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
2501"RTN","C0QMU12",896,0)
2502 . ; SECOND, PROCESS THE ADDITIONS
2503"RTN","C0QMU12",897,0)
2504 . K C0QFDA
2505"RTN","C0QMU12",898,0)
2506 . S ZJ="" S ZK=1
2507"RTN","C0QMU12",899,0)
2508 . F S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ="" D ; PATIENTS TO ADD ARE MARKED WITH 0
2509"RTN","C0QMU12",900,0)
2510 . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
2511"RTN","C0QMU12",901,0)
2512 . . S ZK=ZK+1
2513"RTN","C0QMU12",902,0)
2514 . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
2515"RTN","C0QMU12",903,0)
2516 ;. Q
2517"RTN","C0QMU12",904,0)
2518 ;. K C0QFDA
2519"RTN","C0QMU12",905,0)
2520 ;. N ZJ,ZC
2521"RTN","C0QMU12",906,0)
2522 ;. S ZJ="" S ZC=1
2523"RTN","C0QMU12",907,0)
2524 ;. F S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ="" D ; FOR EACH PAT IN LIST
2525"RTN","C0QMU12",908,0)
2526 ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
2527"RTN","C0QMU12",909,0)
2528 ;. . S ZC=ZC+1
2529"RTN","C0QMU12",910,0)
2530 ;. D UPDIE
2531"RTN","C0QMU12",911,0)
2532 ;. W !,"FOUND:"_ZI
2533"RTN","C0QMU12",912,0)
2534 Q
2535"RTN","C0QMU12",913,0)
2536 ;
2537"RTN","C0QMU12",914,0)
2538KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
2539"RTN","C0QMU12",915,0)
2540 ;
2541"RTN","C0QMU12",916,0)
2542 N C0QFDA,ZFN,LIST,ATTR
2543"RTN","C0QMU12",917,0)
2544 S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
2545"RTN","C0QMU12",918,0)
2546 D CLEAN^DILF
2547"RTN","C0QMU12",919,0)
2548 S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ; MEASURE NAME
2549"RTN","C0QMU12",920,0)
2550 S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
2551"RTN","C0QMU12",921,0)
2552 D CLEAN^DILF
2553"RTN","C0QMU12",922,0)
2554 K ZERR
2555"RTN","C0QMU12",923,0)
2556 S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
2557"RTN","C0QMU12",924,0)
2558 D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
2559"RTN","C0QMU12",925,0)
2560 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
2561"RTN","C0QMU12",926,0)
2562 ;. W "ERROR",!
2563"RTN","C0QMU12",927,0)
2564 ;. ZWR ZERR
2565"RTN","C0QMU12",928,0)
2566 ;. B
2567"RTN","C0QMU12",929,0)
2568 K C0QFDA
2569"RTN","C0QMU12",930,0)
2570 S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
2571"RTN","C0QMU12",931,0)
2572 S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
2573"RTN","C0QMU12",932,0)
2574 D UPDIE ; CREATE THE SUBFILE
2575"RTN","C0QMU12",933,0)
2576 N ZR ; NEW IEN FOR THE RECORD
2577"RTN","C0QMU12",934,0)
2578 S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
2579"RTN","C0QMU12",935,0)
2580 ;
2581"RTN","C0QMU12",936,0)
2582 Q ZR
2583"RTN","C0QMU12",937,0)
2584 ;
2585"RTN","C0QMU12",938,0)
2586UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
2587"RTN","C0QMU12",939,0)
2588 K ZERR
2589"RTN","C0QMU12",940,0)
2590 D CLEAN^DILF
2591"RTN","C0QMU12",941,0)
2592 D UPDATE^DIE("","C0QFDA","","ZERR")
2593"RTN","C0QMU12",942,0)
2594 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
2595"RTN","C0QMU12",943,0)
2596 ;. W "ERROR",!
2597"RTN","C0QMU12",944,0)
2598 ;. ZWR ZERR
2599"RTN","C0QMU12",945,0)
2600 ;. B
2601"RTN","C0QMU12",946,0)
2602 K C0QFDA
2603"RTN","C0QMU12",947,0)
2604 Q
2605"RTN","C0QMU12",948,0)
2606 ;
2607"RTN","C0QMU12",949,0)
2608 ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
2609"RTN","C0QMU12",950,0)
2610 ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
2611"RTN","C0QMU12",951,0)
2612 ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
2613"RTN","C0QMU12",952,0)
2614 ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
2615"RTN","C0QMU12",953,0)
2616 ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
2617"RTN","C0QMU12",954,0)
2618 ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
2619"RTN","C0QMU12",955,0)
2620 ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
2621"RTN","C0QMU12",956,0)
2622 ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
2623"RTN","C0QMU12",957,0)
2624 ;. . S RACE=""
2625"RTN","C0QMU12",958,0)
2626 ;. . F D Q:RACE=""
2627"RTN","C0QMU12",959,0)
2628 ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
2629"RTN","C0QMU12",960,0)
2630 ;. . . Q:'RACE
2631"RTN","C0QMU12",961,0)
2632 ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
2633"RTN","C0QMU12",962,0)
2634 ;. . N ETHNDSC
2635"RTN","C0QMU12",963,0)
2636 ;. . N ETHNDSC S ETHNDSC=""
2637"RTN","C0QMU12",964,0)
2638 ;. . S ETHN=""
2639"RTN","C0QMU12",965,0)
2640 ;. . F D Q:ETHN=""
2641"RTN","C0QMU12",966,0)
2642 ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
2643"RTN","C0QMU12",967,0)
2644 ;. . . Q:'ETHN
2645"RTN","C0QMU12",968,0)
2646 ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
2647"RTN","C0QMU12",969,0)
2648 ;. . D LIST^ORQQPL(.PROBL,DFN,"A")
2649"RTN","C0QMU12",970,0)
2650 ;. . S PBCNT=""
2651"RTN","C0QMU12",971,0)
2652 ;. . F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
2653"RTN","C0QMU12",972,0)
2654 ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
2655"RTN","C0QMU12",973,0)
2656 ;. . K PROBL
2657"RTN","C0QMU12",974,0)
2658 ;. . D LIST^ORQQAL(.ALRGYL,DFN)
2659"RTN","C0QMU12",975,0)
2660 ;. . S ALCNT=""
2661"RTN","C0QMU12",976,0)
2662 ;. . F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
2663"RTN","C0QMU12",977,0)
2664 ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
2665"RTN","C0QMU12",978,0)
2666 ;. . K ALRGYL
2667"RTN","C0QMU12",979,0)
2668 ;. . D COVER^ORWPS(.MEDSL,DFN)
2669"RTN","C0QMU12",980,0)
2670 ;. . S MDCNT=""
2671"RTN","C0QMU12",981,0)
2672 ;. . F S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT="" D
2673"RTN","C0QMU12",982,0)
2674 ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only
2675"RTN","C0QMU12",983,0)
2676 ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
2677"RTN","C0QMU12",984,0)
2678 ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
2679"RTN","C0QMU12",985,0)
2680 ;. . K MEDSL
2681"RTN","C0QMU12",986,0)
2682 ;. . W !,"Discharge Date: ",EXDTE
2683"RTN","C0QMU12",987,0)
2684 ;. . W !,DFN," ",PTNAME
2685"RTN","C0QMU12",988,0)
2686 ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
2687"RTN","C0QMU12",989,0)
2688 ;. . W !,"Language Spoken: ",$G(PTLANG)
2689"RTN","C0QMU12",990,0)
2690 ;. . W !,"Race: ",RACEDSC
2691"RTN","C0QMU12",991,0)
2692 ;. . W !,"Ethnicity: ",ETHNDSC
2693"RTN","C0QMU12",992,0)
2694 ;. . W !,"Problems: "
2695"RTN","C0QMU12",993,0)
2696 ;. . W !,PBDESC
2697"RTN","C0QMU12",994,0)
2698 ;. . W !,"Allergies: "
2699"RTN","C0QMU12",995,0)
2700 ;. . W !,ALDESC
2701"RTN","C0QMU12",996,0)
2702 ;. . W !,"Medications: "
2703"RTN","C0QMU12",997,0)
2704 ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E W !,MDDESC
2705"RTN","C0QMU12",998,0)
2706 ;. . W !
2707"RTN","C0QMU12",999,0)
2708 ;Q
2709"RTN","C0QMU12",1000,0)
2710 ;
2711"RTN","C0QMU12",1001,0)
2712 ;
2713"RTN","C0QMU12",1002,0)
2714 ;
2715"RTN","C0QMU12",1003,0)
2716 ;
2717"RTN","C0QMU12",1004,0)
2718END ;end of C0QPRML;
2719"RTN","C0QMUERX")
27200^1^B83718518
2721"RTN","C0QMUERX",1,0)
2722C0QMUERX ; VEN - Analyze ERx Data for Patients ; 6/13/12 12:44pm
2723"RTN","C0QMUERX",2,0)
2724 ;;1.0;C0Q;;May 21, 2012;Build 29
2725"RTN","C0QMUERX",3,0)
2726 QUIT ; No Entry from the top
2727"RTN","C0QMUERX",4,0)
2728 ;
2729"RTN","C0QMUERX",5,0)
2730UT ; Unit Tests
2731"RTN","C0QMUERX",6,0)
2732 N C0QDEBUG S C0QDEBUG=1
2733"RTN","C0QMUERX",7,0)
2734 W "Testing ^DPT B Index",!
2735"RTN","C0QMUERX",8,0)
2736 D EN("^DPT(""B"")")
2737"RTN","C0QMUERX",9,0)
2738 W !,"Testing B Index on a C0Q Patient List",!
2739"RTN","C0QMUERX",10,0)
2740 D EN("^C0Q(301,4,1,""B"")")
2741"RTN","C0QMUERX",11,0)
2742 W !,"Testing ^AUPNPAT B Index",!
2743"RTN","C0QMUERX",12,0)
2744 D EN("^AUPNPAT(""B"")")
2745"RTN","C0QMUERX",13,0)
2746 W !,"Testing Reminder Patient List B Index",!
2747"RTN","C0QMUERX",14,0)
2748 D EN("^PXRMXP(810.5,80,30,""B"")")
2749"RTN","C0QMUERX",15,0)
2750 W !,"Testing upright file ^DPT",!
2751"RTN","C0QMUERX",16,0)
2752 D EN("^DPT")
2753"RTN","C0QMUERX",17,0)
2754 W !,"Testing a file with no data",!
2755"RTN","C0QMUERX",18,0)
2756 D EN("^ALKJSDF")
2757"RTN","C0QMUERX",19,0)
2758 W !,"Testing a no valid parameters",!
2759"RTN","C0QMUERX",20,0)
2760 D EN("")
2761"RTN","C0QMUERX",21,0)
2762UT2 ; Units Tests 2
2763"RTN","C0QMUERX",22,0)
2764 N C0QDEBUG S C0QDEBUG=1
2765"RTN","C0QMUERX",23,0)
2766 D EN("^C0Q(301,4,1,""B"")")
2767"RTN","C0QMUERX",24,0)
2768 QUIT
2769"RTN","C0QMUERX",25,0)
2770UT3 ; More Unit Tests
2771"RTN","C0QMUERX",26,0)
2772 N C0QDEBUG S C0QDEBUG=1
2773"RTN","C0QMUERX",27,0)
2774 D EN($$PATLN^C0QMU12("MU12-EP-HasERX"))
2775"RTN","C0QMUERX",28,0)
2776 W $$COUNT($$PATLN^C0QMU12("MU12-EP-HasERX"))
2777"RTN","C0QMUERX",29,0)
2778 QUIT
2779"RTN","C0QMUERX",30,0)
2780EN(C0QLIST) ; PEP - Analyze ERx Data and store
2781"RTN","C0QMUERX",31,0)
2782 ; Parameters:
2783"RTN","C0QMUERX",32,0)
2784 ; C0QLIST - Pass by Name. Global or Local Reference.
2785"RTN","C0QMUERX",33,0)
2786 ; Can be: ^DPT("B") for all patients or ^C0Q(301,2,1,"B") for a specific patient list
2787"RTN","C0QMUERX",34,0)
2788 ; Future: Can be a search template on file 2 or 9000001
2789"RTN","C0QMUERX",35,0)
2790 ;
2791"RTN","C0QMUERX",36,0)
2792 ; Check if XML Soap Message is installed
2793"RTN","C0QMUERX",37,0)
2794 I '$D(^C0PX("B","GETMEDS6")) WRITE "GETMEDS6 Soap Message not installed",! QUIT
2795"RTN","C0QMUERX",38,0)
2796 ;
2797"RTN","C0QMUERX",39,0)
2798 ; Check if SOAP^C0PWS2 exists
2799"RTN","C0QMUERX",40,0)
2800 I '$L($T(SOAP^C0PWS2)) WRITE "C0PWS2 Doesn't exist",! QUIT
2801"RTN","C0QMUERX",41,0)
2802 ;
2803"RTN","C0QMUERX",42,0)
2804 ; Check C0QLIST for sanity. Must be a single node.
2805"RTN","C0QMUERX",43,0)
2806 IF '($DATA(C0QLIST)#2)!(C0QLIST="") WRITE "You didn't pass the list",! QUIT
2807"RTN","C0QMUERX",44,0)
2808 ;
2809"RTN","C0QMUERX",45,0)
2810 ; Contents must be a Reference with Data
2811"RTN","C0QMUERX",46,0)
2812 IF '$DATA(@C0QLIST) WRITE "Destination doesn't contain any data",! QUIT
2813"RTN","C0QMUERX",47,0)
2814 ;
2815"RTN","C0QMUERX",48,0)
2816 ; Is this a B index?
2817"RTN","C0QMUERX",49,0)
2818 NEW C0QB
2819"RTN","C0QMUERX",50,0)
2820 IF $QSUBSCRIPT(C0QLIST,$QLENGTH(C0QLIST))="B" DO
2821"RTN","C0QMUERX",51,0)
2822 . SET C0QB=1
2823"RTN","C0QMUERX",52,0)
2824 . ; DEBUG
2825"RTN","C0QMUERX",53,0)
2826 . W:$G(C0QDEBUG) "B index passed",!
2827"RTN","C0QMUERX",54,0)
2828 . ; DEBUG
2829"RTN","C0QMUERX",55,0)
2830 ELSE SET C0QB=0
2831"RTN","C0QMUERX",56,0)
2832 ;
2833"RTN","C0QMUERX",57,0)
2834 ; Make sure our TMP is empty
2835"RTN","C0QMUERX",58,0)
2836 K ^TMP($J)
2837"RTN","C0QMUERX",59,0)
2838 ;
2839"RTN","C0QMUERX",60,0)
2840 ; Walk the global
2841"RTN","C0QMUERX",61,0)
2842 N C0QWALK S C0QWALK=$SELECT(C0QB:"",'C0QB:0) ; Walker, start of $ORDER?
2843"RTN","C0QMUERX",62,0)
2844 N C0QDONE S C0QDONE=0 ; Finish Flag
2845"RTN","C0QMUERX",63,0)
2846 FOR SET C0QWALK=$O(@C0QLIST@(C0QWALK)) QUIT:C0QDONE DO
2847"RTN","C0QMUERX",64,0)
2848 . ; Are we done?
2849"RTN","C0QMUERX",65,0)
2850 . I C0QB,C0QWALK="" S C0QDONE=1 QUIT ; If in index and we are out, done
2851"RTN","C0QMUERX",66,0)
2852 . I 'C0QB,'+C0QWALK S C0QDONE=1 QUIT ; If not in index and we are not numeric, done
2853"RTN","C0QMUERX",67,0)
2854 . ;
2855"RTN","C0QMUERX",68,0)
2856 . N C0QDFN ; DFN of Patient
2857"RTN","C0QMUERX",69,0)
2858 . ; If Walking B Index and Index not numeric, grab DFN (assuming ^DPT or ^AUPNPAT)
2859"RTN","C0QMUERX",70,0)
2860 . ; TODO: Should I check that the global is ^DPT or ^AUPNPAT?
2861"RTN","C0QMUERX",71,0)
2862 . I C0QB,'+C0QWALK S C0QDFN=$O(@C0QLIST@(C0QWALK,""))
2863"RTN","C0QMUERX",72,0)
2864 . ; Otherwise, we will assume the contents of the index are the DFNs
2865"RTN","C0QMUERX",73,0)
2866 . E S C0QDFN=C0QWALK
2867"RTN","C0QMUERX",74,0)
2868 . I $G(C0QDEBUG) W C0QDFN," "
2869"RTN","C0QMUERX",75,0)
2870 . ;
2871"RTN","C0QMUERX",76,0)
2872 . ; Now, check to see if the patient has e-Rx's
2873"RTN","C0QMUERX",77,0)
2874 . I $$HASERX(C0QDFN) S ^TMP($J,C0QDFN)=""
2875"RTN","C0QMUERX",78,0)
2876 ;
2877"RTN","C0QMUERX",79,0)
2878 W:$G(C0QDEBUG) ! ;
2879"RTN","C0QMUERX",80,0)
2880 ;
2881"RTN","C0QMUERX",81,0)
2882 ; Loop through collected DFNs, send to WS, and get data back, store in ^TMP($J,DFN)
2883"RTN","C0QMUERX",82,0)
2884 N C0QDFN S C0QDFN=0
2885"RTN","C0QMUERX",83,0)
2886 F S C0QDFN=$O(^TMP($J,C0QDFN)) Q:C0QDFN="" DO
2887"RTN","C0QMUERX",84,0)
2888 . N C0POUT
2889"RTN","C0QMUERX",85,0)
2890 . W:$G(C0QDEBUG) "Calling GETMEDS6 SOAP Web Service Call for "_C0QDFN,!
2891"RTN","C0QMUERX",86,0)
2892 . D SOAP^C0PWS2("C0POUT","GETMEDS6",DUZ,C0QDFN)
2893"RTN","C0QMUERX",87,0)
2894 . Q:$G(C0POUT(1,"RowCount"))=0 ; WS says no data
2895"RTN","C0QMUERX",88,0)
2896 . M ^TMP($J,C0QDFN)=C0POUT
2897"RTN","C0QMUERX",89,0)
2898 ;
2899"RTN","C0QMUERX",90,0)
2900 ; From the New Crop Meaningful Use documentation:
2901"RTN","C0QMUERX",91,0)
2902 ; Appendix G: Meaningful Use Certification FAQ Question 10
2903"RTN","C0QMUERX",92,0)
2904 ;
2905"RTN","C0QMUERX",93,0)
2906 ; DENOMINATOR NUMERATOR
2907"RTN","C0QMUERX",94,0)
2908 ; DeaClassCode = 0, 9 DeaClassCode = 0, 9
2909"RTN","C0QMUERX",95,0)
2910 ; PharmacyType = 1 PharmacyType = 1
2911"RTN","C0QMUERX",96,0)
2912 ; PharmacyDetailType = 1, 2 PharmacyDetailType = 1, 2
2913"RTN","C0QMUERX",97,0)
2914 ; FinalDestinationType = 1, 2, 3, 4 FinalDestinationType = 3, 4
2915"RTN","C0QMUERX",98,0)
2916 ; FinalStatusType = 1, 4, 5 FinalStatusType = 1, 5
2917"RTN","C0QMUERX",99,0)
2918 ;
2919"RTN","C0QMUERX",100,0)
2920 ; DeMorgan's Law
2921"RTN","C0QMUERX",101,0)
2922 ; NOT(A or B) = NOT(A) and NOT(B)
2923"RTN","C0QMUERX",102,0)
2924 ; So to collect prescriptions for which DeaClassCode is 0 or 9
2925"RTN","C0QMUERX",103,0)
2926 ; We exclude all those who are not 0 AND not 9.
2927"RTN","C0QMUERX",104,0)
2928 ; See: http://en.wikipedia.org/wiki/De_Morgan%27s_laws#Negation_of_a_disjunction
2929"RTN","C0QMUERX",105,0)
2930 ;
2931"RTN","C0QMUERX",106,0)
2932 ; The algorithms below use an Onion Peeling method. Any prescription which
2933"RTN","C0QMUERX",107,0)
2934 ; fails makes you jump to the next prescription.
2935"RTN","C0QMUERX",108,0)
2936 ; The "Onion levels" are:
2937"RTN","C0QMUERX",109,0)
2938 ; DeaClassCode, PharamcyType, PharmacyDetailType, FinalDestinationType, FinalStatusType
2939"RTN","C0QMUERX",110,0)
2940 ;
2941"RTN","C0QMUERX",111,0)
2942 ; Now walk through collected DFNs and accumulate MU stats
2943"RTN","C0QMUERX",112,0)
2944 ;
2945"RTN","C0QMUERX",113,0)
2946 ; WARNING: Naked References below
2947"RTN","C0QMUERX",114,0)
2948 ;
2949"RTN","C0QMUERX",115,0)
2950 N C0QDFN,C0QRXNO S (C0QDFN,C0QRXNO)=0
2951"RTN","C0QMUERX",116,0)
2952 N C0QD S C0QD=0 ; Denominator - Overall (cf C0QDP below)
2953"RTN","C0QMUERX",117,0)
2954 ;
2955"RTN","C0QMUERX",118,0)
2956 ; Calculate Denominator below
2957"RTN","C0QMUERX",119,0)
2958 F S C0QDFN=$O(^TMP($J,C0QDFN)) Q:C0QDFN="" DO
2959"RTN","C0QMUERX",120,0)
2960 . N C0QDP S C0QDP=0 ; Denominator - Patient Specific
2961"RTN","C0QMUERX",121,0)
2962 . F S C0QRXNO=$O(^TMP($J,C0QDFN,C0QRXNO)) Q:C0QRXNO="" DO
2963"RTN","C0QMUERX",122,0)
2964 .. W:$G(C0QDEBUG) "Patient "_C0QDFN_" Rx "_C0QRXNO,!
2965"RTN","C0QMUERX",123,0)
2966 .. ;
2967"RTN","C0QMUERX",124,0)
2968 .. I ^(C0QRXNO,"DeaClassCode") ; Change $REFERENCE
2969"RTN","C0QMUERX",125,0)
2970 .. ;
2971"RTN","C0QMUERX",126,0)
2972 .. N DEA S DEA=^("DeaClassCode")
2973"RTN","C0QMUERX",127,0)
2974 .. W:$G(C0QDEBUG) "DeaClassCode: "_DEA,!
2975"RTN","C0QMUERX",128,0)
2976 .. Q:((DEA'=0)&(DEA'=9))
2977"RTN","C0QMUERX",129,0)
2978 .. ;
2979"RTN","C0QMUERX",130,0)
2980 .. N PT S PT=^("PharmacyType")
2981"RTN","C0QMUERX",131,0)
2982 .. W:$G(C0QDEBUG) "PharmacyType: "_PT,!
2983"RTN","C0QMUERX",132,0)
2984 .. Q:(PT'=1)
2985"RTN","C0QMUERX",133,0)
2986 .. ;
2987"RTN","C0QMUERX",134,0)
2988 .. N PDT S PDT=^("PharmacyDetailType")
2989"RTN","C0QMUERX",135,0)
2990 .. W:$G(C0QDEBUG) "PharmacyDetailType: "_PDT,!
2991"RTN","C0QMUERX",136,0)
2992 .. Q:((PDT'=1)&(PDT'=2))
2993"RTN","C0QMUERX",137,0)
2994 .. ;
2995"RTN","C0QMUERX",138,0)
2996 .. N FDT S FDT=^("FinalDestinationType")
2997"RTN","C0QMUERX",139,0)
2998 .. W:$G(C0QDEBUG) "FinalDestinationType: "_FDT,!
2999"RTN","C0QMUERX",140,0)
3000 .. Q:((FDT'=1)&(FDT'=2)&(FDT'=3)&(FDT'=4))
3001"RTN","C0QMUERX",141,0)
3002 .. ;
3003"RTN","C0QMUERX",142,0)
3004 .. N FST S FST=^("FinalStatusType")
3005"RTN","C0QMUERX",143,0)
3006 .. W:$G(C0QDEBUG) "FinalStatusType: "_FST,!
3007"RTN","C0QMUERX",144,0)
3008 .. Q:((FST'=1)&(FST'=4)&(FST'=5))
3009"RTN","C0QMUERX",145,0)
3010 .. ;
3011"RTN","C0QMUERX",146,0)
3012 .. W:$G(C0QDEBUG) "Adding to Denominator",!
3013"RTN","C0QMUERX",147,0)
3014 .. S C0QDP=C0QDP+1
3015"RTN","C0QMUERX",148,0)
3016 .. S C0QD=C0QD+1
3017"RTN","C0QMUERX",149,0)
3018 . ;
3019"RTN","C0QMUERX",150,0)
3020 . ; SAVE C0QDP - while it lasts!
3021"RTN","C0QMUERX",151,0)
3022 . D SAVE(C0QLIST,C0QDFN,"ERXDEN",C0QDP)
3023"RTN","C0QMUERX",152,0)
3024 ;
3025"RTN","C0QMUERX",153,0)
3026 ; Calculate Numerator below
3027"RTN","C0QMUERX",154,0)
3028 N C0QDFN,C0QRXNO S (C0QDFN,C0QRXNO)=0
3029"RTN","C0QMUERX",155,0)
3030 N C0QN S C0QN=0 ; Numerator - Overall (cf C0QNP below)
3031"RTN","C0QMUERX",156,0)
3032 F S C0QDFN=$O(^TMP($J,C0QDFN)) Q:C0QDFN="" DO
3033"RTN","C0QMUERX",157,0)
3034 . N C0QNP S C0QNP=0 ; Numerator - Patient Specific
3035"RTN","C0QMUERX",158,0)
3036 . F S C0QRXNO=$O(^TMP($J,C0QDFN,C0QRXNO)) Q:C0QRXNO="" DO
3037"RTN","C0QMUERX",159,0)
3038 .. W:$G(C0QDEBUG) "Patient "_C0QDFN_" Rx "_C0QRXNO,!
3039"RTN","C0QMUERX",160,0)
3040 .. ;
3041"RTN","C0QMUERX",161,0)
3042 .. I ^(C0QRXNO,"DeaClassCode") ; Change $REFERENCE
3043"RTN","C0QMUERX",162,0)
3044 .. ;
3045"RTN","C0QMUERX",163,0)
3046 .. N DEA S DEA=^("DeaClassCode")
3047"RTN","C0QMUERX",164,0)
3048 .. W:$G(C0QDEBUG) "DeaClassCode: "_DEA,!
3049"RTN","C0QMUERX",165,0)
3050 .. Q:((DEA'=0)&(DEA'=9))
3051"RTN","C0QMUERX",166,0)
3052 .. ;
3053"RTN","C0QMUERX",167,0)
3054 .. N PT S PT=^("PharmacyType")
3055"RTN","C0QMUERX",168,0)
3056 .. W:$G(C0QDEBUG) "PharmacyType: "_PT,!
3057"RTN","C0QMUERX",169,0)
3058 .. Q:(PT'=1)
3059"RTN","C0QMUERX",170,0)
3060 .. ;
3061"RTN","C0QMUERX",171,0)
3062 .. N PDT S PDT=^("PharmacyDetailType")
3063"RTN","C0QMUERX",172,0)
3064 .. W:$G(C0QDEBUG) "PharmacyDetailType: "_PDT,!
3065"RTN","C0QMUERX",173,0)
3066 .. Q:((PDT'=1)&(PDT'=2))
3067"RTN","C0QMUERX",174,0)
3068 .. ;
3069"RTN","C0QMUERX",175,0)
3070 .. N FDT S FDT=^("FinalDestinationType")
3071"RTN","C0QMUERX",176,0)
3072 .. W:$G(C0QDEBUG) "FinalDestinationType: "_FDT,!
3073"RTN","C0QMUERX",177,0)
3074 .. Q:((FDT'=3)&(FDT'=4))
3075"RTN","C0QMUERX",178,0)
3076 .. ;
3077"RTN","C0QMUERX",179,0)
3078 .. N FST S FST=^("FinalStatusType")
3079"RTN","C0QMUERX",180,0)
3080 .. W:$G(C0QDEBUG) "FinalStatusType: "_FST,!
3081"RTN","C0QMUERX",181,0)
3082 .. Q:((FST'=1)&(FST'=5))
3083"RTN","C0QMUERX",182,0)
3084 .. ;
3085"RTN","C0QMUERX",183,0)
3086 .. W:$G(C0QDEBUG) "Adding to Numerator",!
3087"RTN","C0QMUERX",184,0)
3088 .. S C0QNP=C0QNP+1
3089"RTN","C0QMUERX",185,0)
3090 .. S C0QN=C0QN+1
3091"RTN","C0QMUERX",186,0)
3092 . ;
3093"RTN","C0QMUERX",187,0)
3094 . ; Save C0QNP while it lasts
3095"RTN","C0QMUERX",188,0)
3096 . D SAVE(C0QLIST,C0QDFN,"ERXNUM",C0QNP)
3097"RTN","C0QMUERX",189,0)
3098 ;
3099"RTN","C0QMUERX",190,0)
3100 S ^TMP($J)=C0QN_U_C0QD
3101"RTN","C0QMUERX",191,0)
3102 ;
3103"RTN","C0QMUERX",192,0)
3104 ; TODO: Over here, do something with the numerator and denominator..
3105"RTN","C0QMUERX",193,0)
3106 ; Probably store them somewhere.
3107"RTN","C0QMUERX",194,0)
3108 ;
3109"RTN","C0QMUERX",195,0)
3110 I '$G(C0QDEBUG) K ^TMP($J) ; Empty out in production not testing
3111"RTN","C0QMUERX",196,0)
3112 QUIT
3113"RTN","C0QMUERX",197,0)
3114 ;
3115"RTN","C0QMUERX",198,0)
3116HASERX(DFN) ; $$ - Private; Has E-Prescriptions?
3117"RTN","C0QMUERX",199,0)
3118 ; Parameters
3119"RTN","C0QMUERX",200,0)
3120 ; - DFN by Value
3121"RTN","C0QMUERX",201,0)
3122 ; Output
3123"RTN","C0QMUERX",202,0)
3124 ; 0 or 1 (false or true)
3125"RTN","C0QMUERX",203,0)
3126 N ZI S ZI=""
3127"RTN","C0QMUERX",204,0)
3128 N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
3129"RTN","C0QMUERX",205,0)
3130 N DONE,HASERX
3131"RTN","C0QMUERX",206,0)
3132 F S ZI=$O(@ZERX@(ZI)) Q:ZI="" Q:$G(DONE) D
3133"RTN","C0QMUERX",207,0)
3134 . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" S (DONE,HASERX)=1
3135"RTN","C0QMUERX",208,0)
3136 Q +$G(HASERX)
3137"RTN","C0QMUERX",209,0)
3138 ;
3139"RTN","C0QMUERX",210,0)
3140SAVE(C0QLIST,C0QDFN,TYPE,COUNT) ; Proc - Private; Save Count in C0Q(301, file
3141"RTN","C0QMUERX",211,0)
3142 ; Layman's Explanation: Save the denominator or numerator for ePrescribing for
3143"RTN","C0QMUERX",212,0)
3144 ; each of the patients in the Subfile for that patient in ^C0Q(301,
3145"RTN","C0QMUERX",213,0)
3146 ; Still hard to understand though! Here's a demo:
3147"RTN","C0QMUERX",214,0)
3148 ; ^C0Q(301,IEN has a subfile under node 1 which stores the patients. E.g.
3149"RTN","C0QMUERX",215,0)
3150 ; ^C0Q(301,48,1,15,0)=91$
3151"RTN","C0QMUERX",216,0)
3152 ; ^C0Q(301,48,1,16,0)=93$
3153"RTN","C0QMUERX",217,0)
3154 ; ^C0Q(301,48,1,17,0)=173$
3155"RTN","C0QMUERX",218,0)
3156 ;
3157"RTN","C0QMUERX",219,0)
3158 ; I store the numerator and denominator under each of the patients. The numerator
3159"RTN","C0QMUERX",220,0)
3160 ; stands for the number of prescriptions that were electronically transmitted;
3161"RTN","C0QMUERX",221,0)
3162 ; the denominator stands for the numbers of prescriptions that COULD HAVE BEEN
3163"RTN","C0QMUERX",222,0)
3164 ; electronically transmitted. End result for Patient 173 is as follows:
3165"RTN","C0QMUERX",223,0)
3166 ; ^C0Q(301,48,1,17,0)=173
3167"RTN","C0QMUERX",224,0)
3168 ; ^C0Q(301,48,1,17,1,0)="^1130580001.3111^2^2"
3169"RTN","C0QMUERX",225,0)
3170 ; ^C0Q(301,48,1,17,1,1,0)="ERXDEN^0"
3171"RTN","C0QMUERX",226,0)
3172 ; ^C0Q(301,48,1,17,1,2,0)="ERXNUM^0"
3173"RTN","C0QMUERX",227,0)
3174 ; ^C0Q(301,48,1,17,1,"B","ERXDEN",1)=""
3175"RTN","C0QMUERX",228,0)
3176 ; ^C0Q(301,48,1,17,1,"B","ERXNUM",2)=""
3177"RTN","C0QMUERX",229,0)
3178 ;
3179"RTN","C0QMUERX",230,0)
3180 ; Subroutine COUNT (below) goes and counts the data
3181"RTN","C0QMUERX",231,0)
3182 ;
3183"RTN","C0QMUERX",232,0)
3184 ; Params:
3185"RTN","C0QMUERX",233,0)
3186 ; C0QLIST (by val): "B" x-ref where patients are located. Only supports ^C0Q(301, file.
3187"RTN","C0QMUERX",234,0)
3188 ; C0QDFN (by val): Patient DFN for whom to file data.
3189"RTN","C0QMUERX",235,0)
3190 ; TYPE (by val): Either ERXDEN or ERXNUM for eRx Denominator or eRx Numerator
3191"RTN","C0QMUERX",236,0)
3192 ; COUNT (by val): The number to save
3193"RTN","C0QMUERX",237,0)
3194 ;
3195"RTN","C0QMUERX",238,0)
3196 ; First, QUIT if this isn't a Quality Measures List?
3197"RTN","C0QMUERX",239,0)
3198 ; $QS(x,0) gets you the global name
3199"RTN","C0QMUERX",240,0)
3200 ;
3201"RTN","C0QMUERX",241,0)
3202 ; This should give you an idea of what I am dealing with!
3203"RTN","C0QMUERX",242,0)
3204 ;
3205"RTN","C0QMUERX",243,0)
3206 ; ^C0Q(301,48,1,15,0)=91
3207"RTN","C0QMUERX",244,0)
3208 ; ^C0Q(301,48,1,16,0)=93
3209"RTN","C0QMUERX",245,0)
3210 ; ^C0Q(301,48,1,17,0)=173
3211"RTN","C0QMUERX",246,0)
3212 ; ^C0Q(301,48,1,18,0)=174
3213"RTN","C0QMUERX",247,0)
3214 ; ^C0Q(301,48,1,"B",5,1)=""
3215"RTN","C0QMUERX",248,0)
3216 ; ^C0Q(301,48,1,"B",10,2)=""
3217"RTN","C0QMUERX",249,0)
3218 ; ^C0Q(301,48,1,"B",11,3)=""
3219"RTN","C0QMUERX",250,0)
3220 ; ^C0Q(301,48,1,"B",14,4)=""
3221"RTN","C0QMUERX",251,0)
3222 ;
3223"RTN","C0QMUERX",252,0)
3224 I $QS(C0QLIST,0)'="^C0Q" W:$G(C0QDEBUG) "Not Saving Patient "_C0QDFN,! QUIT
3225"RTN","C0QMUERX",253,0)
3226 ;
3227"RTN","C0QMUERX",254,0)
3228 ; Otherwise, prepare to save
3229"RTN","C0QMUERX",255,0)
3230 N C0QFDA ; Fileman Data Array
3231"RTN","C0QMUERX",256,0)
3232 N C0QIENS ; IENS
3233"RTN","C0QMUERX",257,0)
3234 N L1,L2 ; Top Level, Level 2
3235"RTN","C0QMUERX",258,0)
3236 S L1=$QS(C0QLIST,2) ; Top Level IEN
3237"RTN","C0QMUERX",259,0)
3238 S L2=$O(^C0Q(301,L1,1,"B",C0QDFN,"")) ; Patient IEN
3239"RTN","C0QMUERX",260,0)
3240 S C0QIENS="?+1"_C0QDFN_","_L2_","_L1_"," ; TODO: Here C0QDFN is a dummy for uniqueness in FDA, not meaningful! - DO BETTER!
3241"RTN","C0QMUERX",261,0)
3242 W:$G(C0QDEBUG) "IENs "_C0QIENS_" ready to file",!
3243"RTN","C0QMUERX",262,0)
3244 W:$G(C0QDEBUG) "Saving "_TYPE_" of "_COUNT_" for Patient "_$P(^DPT(C0QDFN,0),U)_" ("_C0QDFN_")",!
3245"RTN","C0QMUERX",263,0)
3246 S C0QFDA(1130580001.3111,C0QIENS,.01)=TYPE
3247"RTN","C0QMUERX",264,0)
3248 S C0QFDA(1130580001.3111,C0QIENS,.02)=COUNT
3249"RTN","C0QMUERX",265,0)
3250 ;
3251"RTN","C0QMUERX",266,0)
3252 W:$G(C0QDEBUG) "Fileman Data Array",!
3253"RTN","C0QMUERX",267,0)
3254 I $G(C0QDEBUG) N % S %=$NA(C0QFDA) F S %=$Q(@%) Q:%="" W %_": "_@%,!
3255"RTN","C0QMUERX",268,0)
3256 ;
3257"RTN","C0QMUERX",269,0)
3258 N C0QERR ; Errors
3259"RTN","C0QMUERX",270,0)
3260 D UPDATE^DIE("","C0QFDA","","C0QERR")
3261"RTN","C0QMUERX",271,0)
3262 ;
3263"RTN","C0QMUERX",272,0)
3264 I $D(C0QERR) DO
3265"RTN","C0QMUERX",273,0)
3266 . W "Error in filing data",!
3267"RTN","C0QMUERX",274,0)
3268 . N % S %=$NAME(C0QERR) F S %=$Q(@%) Q:%="" W %_": "_@%,!
3269"RTN","C0QMUERX",275,0)
3270 ;
3271"RTN","C0QMUERX",276,0)
3272 QUIT
3273"RTN","C0QMUERX",277,0)
3274 ;
3275"RTN","C0QMUERX",278,0)
3276COUNT(C0QLIST) ; $$ - Private; Count Numerator and Denominator for a Patient List
3277"RTN","C0QMUERX",279,0)
3278 ; Input: C0QLIST - Pass by Value - Patient Listing B index (only C0Q(301,IEN,1,"B", listing is supported)
3279"RTN","C0QMUERX",280,0)
3280 ; Output: (as string) NUMERATOR/DENOMINATOR
3281"RTN","C0QMUERX",281,0)
3282 ; Optional Symtab input: C0QDEBUG to print out debug messages to STDOUT.
3283"RTN","C0QMUERX",282,0)
3284 ;
3285"RTN","C0QMUERX",283,0)
3286 I $QS(C0QLIST,0)'="^C0Q" W:$G(C0QDEBUG) "Counting for files other than C0Q(301, not supported ",! QUIT "0/0"
3287"RTN","C0QMUERX",284,0)
3288 ; MEASURE -----------
3289"RTN","C0QMUERX",285,0)
3290 ; IEN ----------- |
3291"RTN","C0QMUERX",286,0)
3292 ; L1 ------| | |
3293"RTN","C0QMUERX",287,0)
3294 ; V V V
3295"RTN","C0QMUERX",288,0)
3296 ; ^C0Q(301,48,1,2,1,1,0)="ERXDEN^0"
3297"RTN","C0QMUERX",289,0)
3298 ; ^C0Q(301,48,1,2,1,2,0)="ERXNUM^0"
3299"RTN","C0QMUERX",290,0)
3300 ; ^C0Q(301,48,1,2,1,"B","ERXDEN",1)=""
3301"RTN","C0QMUERX",291,0)
3302 ; ^C0Q(301,48,1,2,1,"B","ERXNUM",2)=""
3303"RTN","C0QMUERX",292,0)
3304 ; ^C0Q(301,48,1,2,1,"B"
3305"RTN","C0QMUERX",293,0)
3306 W:$G(C0QDEBUG) "DFN",?20,"Denominator",?40,"Numerator",!
3307"RTN","C0QMUERX",294,0)
3308 ;
3309"RTN","C0QMUERX",295,0)
3310 N L1 S L1=$QS(C0QLIST,2) ; Top Level IEN
3311"RTN","C0QMUERX",296,0)
3312 ;
3313"RTN","C0QMUERX",297,0)
3314 N DENTOT,NUMTOT S (DENTOT,NUMTOT)=0 ; Denominator Total, Numerator Total
3315"RTN","C0QMUERX",298,0)
3316 ;
3317"RTN","C0QMUERX",299,0)
3318 N C0QDFN S C0QDFN=0 ; Walker through B index
3319"RTN","C0QMUERX",300,0)
3320 F S C0QDFN=$O(^C0Q(301,L1,1,"B",C0QDFN)) Q:C0QDFN="" DO
3321"RTN","C0QMUERX",301,0)
3322 . N IEN S IEN=$O(^(C0QDFN,"")) ; naked naked - get IEN from B index
3323"RTN","C0QMUERX",302,0)
3324 . W:$G(C0QDEBUG) C0QDFN
3325"RTN","C0QMUERX",303,0)
3326 . ;
3327"RTN","C0QMUERX",304,0)
3328 . ; Denom Processing
3329"RTN","C0QMUERX",305,0)
3330 . N DENIEN S DENIEN=$O(^C0Q(301,L1,1,IEN,1,"B","ERXDEN","")) ; Denom IEN
3331"RTN","C0QMUERX",306,0)
3332 . N DEN S DEN=$S(DENIEN:$P(^C0Q(301,L1,1,IEN,1,DENIEN,0),U,2),1:"N/A") ; Denominator
3333"RTN","C0QMUERX",307,0)
3334 . W:$G(C0QDEBUG) ?20,DEN
3335"RTN","C0QMUERX",308,0)
3336 . S DENTOT=DENTOT+DEN ; Total it up (N/A becomes zero)
3337"RTN","C0QMUERX",309,0)
3338 . ;
3339"RTN","C0QMUERX",310,0)
3340 . N NUMIEN S NUMIEN=$O(^C0Q(301,L1,1,IEN,1,"B","ERXNUM","")) ; Numerator IEN
3341"RTN","C0QMUERX",311,0)
3342 . N NUM S NUM=$S(NUMIEN:$P(^C0Q(301,L1,1,IEN,1,NUMIEN,0),U,2),1:"N/A") ; Numerator
3343"RTN","C0QMUERX",312,0)
3344 . W:$G(C0QDEBUG) ?40,NUM
3345"RTN","C0QMUERX",313,0)
3346 . S NUMTOT=NUMTOT+NUM ; Total it up (N/A becomes zero)
3347"RTN","C0QMUERX",314,0)
3348 . ;
3349"RTN","C0QMUERX",315,0)
3350 . w:$G(C0QDEBUG) !
3351"RTN","C0QMUERX",316,0)
3352 ;
3353"RTN","C0QMUERX",317,0)
3354 ; Write the totals
3355"RTN","C0QMUERX",318,0)
3356 D:$G(C0QDEBUG)
3357"RTN","C0QMUERX",319,0)
3358 . W ?20,"==="
3359"RTN","C0QMUERX",320,0)
3360 . W ?40,"==="
3361"RTN","C0QMUERX",321,0)
3362 . W !
3363"RTN","C0QMUERX",322,0)
3364 . ;
3365"RTN","C0QMUERX",323,0)
3366 . W ?20,DENTOT
3367"RTN","C0QMUERX",324,0)
3368 . W ?40,NUMTOT
3369"RTN","C0QMUERX",325,0)
3370 . W !
3371"RTN","C0QMUERX",326,0)
3372 ;
3373"RTN","C0QMUERX",327,0)
3374 ; Quit with Numeartor/Denominator
3375"RTN","C0QMUERX",328,0)
3376 QUIT NUMTOT_"/"_DENTOT
3377"RTN","C0QP1")
33780^^B541099
3379"RTN","C0QP1",1,0)
3380C0QP1 ; VEN/SMH - Inits for Patch 1 ; 6/13/12 5:33pm
3381"RTN","C0QP1",2,0)
3382 ;;1.0;C0Q;;May 21, 2012;Build 29
3383"RTN","C0QP1",3,0)
3384 ;
3385"RTN","C0QP1",4,0)
3386POST ; Post-Install hook for Patch 1; PEP
3387"RTN","C0QP1",5,0)
3388 ; Fire off the new x-refs for entries in the parameter file
3389"RTN","C0QP1",6,0)
3390 N C0QI S C0QI=0 ; Walk through starting with number 1
3391"RTN","C0QP1",7,0)
3392 F S C0QI=$O(^C0Q(401,C0QI)) Q:'C0QI D
3393"RTN","C0QP1",8,0)
3394 . N DA,DIK S DIK="^C0Q(401,",DIK(1)="2^AMMS",DA=C0QI D EN^DIK
3395"RTN","C0QP1",9,0)
3396 . N DA,DIK S DIK="^C0Q(401,",DIK(1)="2.1^AQMS",DA=C0QI D EN^DIK
3397"RTN","C0QP1",10,0)
3398 QUIT
3399"RTN","C0QUPDT")
34000^2^B79261186
3401"RTN","C0QUPDT",1,0)
3402C0QUPDT ; GPL - Quality Reporting List Update Routines ; 6/13/12 12:42pm
3403"RTN","C0QUPDT",2,0)
3404 ;;1.0;C0Q;;May 21, 2012;Build 29
3405"RTN","C0QUPDT",3,0)
3406 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
3407"RTN","C0QUPDT",4,0)
3408 ;General Public License See attached copy of the License.
3409"RTN","C0QUPDT",5,0)
3410 ;
3411"RTN","C0QUPDT",6,0)
3412 ;This program is free software; you can redistribute it and/or modify
3413"RTN","C0QUPDT",7,0)
3414 ;it under the terms of the GNU General Public License as published by
3415"RTN","C0QUPDT",8,0)
3416 ;the Free Software Foundation; either version 2 of the License, or
3417"RTN","C0QUPDT",9,0)
3418 ;(at your option) any later version.
3419"RTN","C0QUPDT",10,0)
3420 ;
3421"RTN","C0QUPDT",11,0)
3422 ;This program is distributed in the hope that it will be useful,
3423"RTN","C0QUPDT",12,0)
3424 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
3425"RTN","C0QUPDT",13,0)
3426 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
3427"RTN","C0QUPDT",14,0)
3428 ;GNU General Public License for more details.
3429"RTN","C0QUPDT",15,0)
3430 ;
3431"RTN","C0QUPDT",16,0)
3432 ;You should have received a copy of the GNU General Public License along
3433"RTN","C0QUPDT",17,0)
3434 ;with this program; if not, write to the Free Software Foundation, Inc.,
3435"RTN","C0QUPDT",18,0)
3436 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
3437"RTN","C0QUPDT",19,0)
3438 ;
3439"RTN","C0QUPDT",20,0)
3440 Q
3441"RTN","C0QUPDT",21,0)
3442 ;
3443"RTN","C0QUPDT",22,0)
3444C0QQFN() Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE
3445"RTN","C0QUPDT",23,0)
3446C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
3447"RTN","C0QUPDT",24,0)
3448C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
3449"RTN","C0QUPDT",25,0)
3450C0QMMNFN() Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE
3451"RTN","C0QUPDT",26,0)
3452C0QMMDFN() Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE
3453"RTN","C0QUPDT",27,0)
3454RLSTFN() Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE
3455"RTN","C0QUPDT",28,0)
3456RLSTPFN() Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE
3457"RTN","C0QUPDT",29,0)
3458C0QPLF() Q 1130580001.301 ; C0Q PATIENT LIST FILE
3459"RTN","C0QUPDT",30,0)
3460C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ;
3461"RTN","C0QUPDT",31,0)
3462 ;
3463"RTN","C0QUPDT",32,0)
3464UPDATE(RNT,MSET) ; UPDATE A MEASURE SET BY ADDING NEW ENTRIES TO PATIENT
3465"RTN","C0QUPDT",33,0)
3466 ; LISTS AND DELETING ENTRIES THAT ARE NO LONGER VALID. ALSO UPDATE
3467"RTN","C0QUPDT",34,0)
3468 ; NUMERATOR AND DENOMINATOR COUNTS
3469"RTN","C0QUPDT",35,0)
3470 ; MAKES HEAVY USE OF UNITY^C0QSET TO DETERMINE WHAT TO ADD AND DELETE
3471"RTN","C0QUPDT",36,0)
3472 ;
3473"RTN","C0QUPDT",37,0)
3474 ; THIS IS A REPLACEMENT FOR C0QRPC^C0QMAIN WHICH DELETES THE PATIENT
3475"RTN","C0QUPDT",38,0)
3476 ; LISTS AND RECREATES THEM, WHICH IS A LOT OF UNNECESSARY PROCESSING
3477"RTN","C0QUPDT",39,0)
3478 ;
3479"RTN","C0QUPDT",40,0)
3480 N ZI S ZI=""
3481"RTN","C0QUPDT",41,0)
3482 N C0QM ; FOR HOLDING THE MEASURES IN THE SET
3483"RTN","C0QUPDT",42,0)
3484 I $$GET1^DIQ($$C0QMFN,MSET_",",.05,"I")="Y" D Q ; IS IT LOCKED?
3485"RTN","C0QUPDT",43,0)
3486 . W !,"ERROR MEASURE SET IS LOCKED, EXITING"
3487"RTN","C0QUPDT",44,0)
3488 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I;1.2I;2.2I") ; GET ALL THE MEASURES
3489"RTN","C0QUPDT",45,0)
3490 D DELIST("C0QM")
3491"RTN","C0QUPDT",46,0)
3492 N ZII S ZII=""
3493"RTN","C0QUPDT",47,0)
3494 F S ZII=$O(C0QM(ZII)) Q:ZII="" D ; FOR EACH MEASURE
3495"RTN","C0QUPDT",48,0)
3496 . ;
3497"RTN","C0QUPDT",49,0)
3498 . ; Special processing for eRx measure.
3499"RTN","C0QUPDT",50,0)
3500 . I $$GET1^DIQ(1130580001.101,+C0QM(ZII)_",",4,"I")="E" D ERXCOUNT(MSET,ZII) Q
3501"RTN","C0QUPDT",51,0)
3502 . ;
3503"RTN","C0QUPDT",52,0)
3504 . ; Otherwise, we go on
3505"RTN","C0QUPDT",53,0)
3506 . N C0QNL,C0QDL,C0QFLTN,C0QFLTD
3507"RTN","C0QUPDT",54,0)
3508 . S C0QFLTN=$P(C0QM(ZII),U,3) ;IEN OF NUMERATOR FILTER LIST
3509"RTN","C0QUPDT",55,0)
3510 . S C0QFLTD=$P(C0QM(ZII),U,4) ; IEN OF DENOMINATOR FILTER LIST
3511"RTN","C0QUPDT",56,0)
3512 . S ZI=$P(C0QM(ZII),U,1) ; IEN OF THE MEASURE IN THE C0Q QUALITY MEAS FILE
3513"RTN","C0QUPDT",57,0)
3514 . ;
3515"RTN","C0QUPDT",58,0)
3516 . ; Numerator
3517"RTN","C0QUPDT",59,0)
3518 . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1,"I") ; NUMERATOR POINTER
3519"RTN","C0QUPDT",60,0)
3520 . I C0QNL="" D ; CHECK ALTERNATE LIST
3521"RTN","C0QUPDT",61,0)
3522 . . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1.1,"I") ; NUMERATOR POINTER
3523"RTN","C0QUPDT",62,0)
3524 . . I C0QNL'="" S C0QNALT=1
3525"RTN","C0QUPDT",63,0)
3526 . I C0QNL="" QUIT ; No Numerator. Can't perform calculation.--smh
3527"RTN","C0QUPDT",64,0)
3528 . ;
3529"RTN","C0QUPDT",65,0)
3530 . ; Denominator
3531"RTN","C0QUPDT",66,0)
3532 . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2,"I") ; DENOMINATOR POINTER
3533"RTN","C0QUPDT",67,0)
3534 . I C0QDL="" D ; CHECK ALTERNATE LIST
3535"RTN","C0QUPDT",68,0)
3536 . . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2.1,"I") ; DENOMINATOR POINTER
3537"RTN","C0QUPDT",69,0)
3538 . . I C0QDL'="" S C0QDALT=1
3539"RTN","C0QUPDT",70,0)
3540 . I C0QDL="" QUIT ; No Denominator. Can't perform calcuation.--smh
3541"RTN","C0QUPDT",71,0)
3542 . ;
3543"RTN","C0QUPDT",72,0)
3544 . ; FIRST PROCESS THE NUMERATOR
3545"RTN","C0QUPDT",73,0)
3546 . ;
3547"RTN","C0QUPDT",74,0)
3548 . N C0QNEW ; REFERENCE TO NEW NUMBERATOR LIST B INDEX
3549"RTN","C0QUPDT",75,0)
3550 . I $G(C0QNALT)=1 D ; USING ALTERNATE LIST FOR NUMERATOR
3551"RTN","C0QUPDT",76,0)
3552 . . S C0QNEW=$NA(^C0Q(301,C0QNL,1,"B")) ; B INDEX FOR THIS LIST
3553"RTN","C0QUPDT",77,0)
3554 . E D ; USE THE REMINDER PACKAGE PATIENT LISTS
3555"RTN","C0QUPDT",78,0)
3556 . . S C0QNEW=$NA(^PXRMXP(810.5,C0QNL,30,"B")) ; REMINDER LIST PATIENTS
3557"RTN","C0QUPDT",79,0)
3558 . I C0QFLTN'="" D ; USE A NUMERATOR FILTER LIST
3559"RTN","C0QUPDT",80,0)
3560 . . N ZNEW
3561"RTN","C0QUPDT",81,0)
3562 . . S ZNEW=$NA(^C0Q(301,C0QFLTN,1,"B")) ; B INDEX OF FILTER LIST
3563"RTN","C0QUPDT",82,0)
3564 . . K C0QFLTRD
3565"RTN","C0QUPDT",83,0)
3566 . . D AND^C0QSET("C0QFLTRD",ZNEW,C0QNEW)
3567"RTN","C0QUPDT",84,0)
3568 . . S C0QNEW="C0QFLTRD"
3569"RTN","C0QUPDT",85,0)
3570 . N C0QOLD ; REFERENCE FOR OLD PATIENT LIST
3571"RTN","C0QUPDT",86,0)
3572 . S C0QOLD=$NA(^C0Q(201,MSET,5,ZII,1,"B")) ; NUMERATOR LIST IN MEASURE SET
3573"RTN","C0QUPDT",87,0)
3574 . N C0QRSLT ; ARRAY FOR THE UNITY DIFFERENCES
3575"RTN","C0QUPDT",88,0)
3576 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND THE DIFFERENCES
3577"RTN","C0QUPDT",89,0)
3578 . N C0QCNT
3579"RTN","C0QUPDT",90,0)
3580 . S C0QNCNT=$G(C0QRSLT("COUNT"))
3581"RTN","C0QUPDT",91,0)
3582 . I C0QNCNT="" D ;
3583"RTN","C0QUPDT",92,0)
3584 . . S C0QNCNT=0 ; DEFAULT COUNT IS ZERO
3585"RTN","C0QUPDT",93,0)
3586 . . N GZZ S GZZ=""
3587"RTN","C0QUPDT",94,0)
3588 . . F S GZZ=$O(C0QRSLT(0,GZZ)) Q:GZZ="" D ; EVERY ADD ENTRY
3589"RTN","C0QUPDT",95,0)
3590 . . . S C0QNCNT=C0QNCNT+1
3591"RTN","C0QUPDT",96,0)
3592 . . F S GZZ=$O(C0QRSLT(1,GZZ)) Q:GZZ="" D ; EVERY EQUAL ENTRY
3593"RTN","C0QUPDT",97,0)
3594 . . . S C0QNCNT=C0QNCNT+1
3595"RTN","C0QUPDT",98,0)
3596 . K C0QFDA ; CLEAR THE FDA
3597"RTN","C0QUPDT",99,0)
3598 . N C0QONCNT ; OLD COUNT
3599"RTN","C0QUPDT",100,0)
3600 . S C0QONCNT=$$GET1^DIQ($$C0QMMFN(),ZII_","_MSET_",",1.1)
3601"RTN","C0QUPDT",101,0)
3602 . I C0QNCNT'=C0QONCNT D ; COUNT HAS CHANGED
3603"RTN","C0QUPDT",102,0)
3604 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",1.1)=C0QNCNT ; NUMERATOR COUNT
3605"RTN","C0QUPDT",103,0)
3606 . . D UPDIE ; UPDATE THE NUMERATOR COUNT
3607"RTN","C0QUPDT",104,0)
3608 . I $D(C0QRSLT) D ;B ;
3609"RTN","C0QUPDT",105,0)
3610 . . ;ZWR C0QRSLT
3611"RTN","C0QUPDT",106,0)
3612 . ; FIRST PROCESS DELETIONS
3613"RTN","C0QUPDT",107,0)
3614 . K C0QFDA ; CLEAR OUT THE FDA
3615"RTN","C0QUPDT",108,0)
3616 . N ZG,ZIEN S ZG=""
3617"RTN","C0QUPDT",109,0)
3618 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION
3619"RTN","C0QUPDT",110,0)
3620 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
3621"RTN","C0QUPDT",111,0)
3622 . . I ZIEN="" D Q ; OOPS
3623"RTN","C0QUPDT",112,0)
3624 . . . W !,"ERROR DELETING ENTRY!! ",ZG
3625"RTN","C0QUPDT",113,0)
3626 . . S C0QFDA($$C0QMMNFN(),ZIEN_","_ZII_","_MSET_",",.01)="@" ; DELETE
3627"RTN","C0QUPDT",114,0)
3628 . I $D(C0QFDA) D UPDIE ; PROCESS
3629"RTN","C0QUPDT",115,0)
3630 . ; SECOND, PROCESS ADDITIONS
3631"RTN","C0QUPDT",116,0)
3632 . K C0QFDA ; CLEAR OUT THE FDA
3633"RTN","C0QUPDT",117,0)
3634 . N ZG,ZC S ZG="" S ZC=1
3635"RTN","C0QUPDT",118,0)
3636 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION
3637"RTN","C0QUPDT",119,0)
3638 . . S C0QFDA($$C0QMMNFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
3639"RTN","C0QUPDT",120,0)
3640 . . S ZC=ZC+1
3641"RTN","C0QUPDT",121,0)
3642 . I $D(C0QFDA) D UPDIE ; PROCESS
3643"RTN","C0QUPDT",122,0)
3644 . ;
3645"RTN","C0QUPDT",123,0)
3646 . ; PROCESS THE DENOMINATOR
3647"RTN","C0QUPDT",124,0)
3648 . ;
3649"RTN","C0QUPDT",125,0)
3650 . N C0QNEW ; REFERENCE TO NEW NUMBERATOR LIST B INDEX
3651"RTN","C0QUPDT",126,0)
3652 . I $G(C0QNALT)=1 D ; USING ALTERNATE LIST FOR NUMERATOR
3653"RTN","C0QUPDT",127,0)
3654 . . S C0QNEW=$NA(^C0Q(301,C0QDL,1,"B")) ; B INDEX FOR THIS LIST
3655"RTN","C0QUPDT",128,0)
3656 . E D ; USE THE REMINDER PACKAGE PATIENT LISTS
3657"RTN","C0QUPDT",129,0)
3658 . . S C0QNEW=$NA(^PXRMXP(810.5,C0QDL,30,"B")) ; REMINDER LIST PATIENTS
3659"RTN","C0QUPDT",130,0)
3660 . I C0QFLTD'="" D ; USE A DENOMINATOR FILTER LIST
3661"RTN","C0QUPDT",131,0)
3662 . . N ZNEW
3663"RTN","C0QUPDT",132,0)
3664 . . S ZNEW=$NA(^C0Q(301,C0QFLTD,1,"B")) ; B INDEX OF FILTER LIST
3665"RTN","C0QUPDT",133,0)
3666 . . K C0QFLTRD
3667"RTN","C0QUPDT",134,0)
3668 . . D AND^C0QSET("C0QFLTRD",ZNEW,C0QNEW)
3669"RTN","C0QUPDT",135,0)
3670 . . S C0QNEW="C0QFLTRD"
3671"RTN","C0QUPDT",136,0)
3672 . N C0QOLD ; REFERENCE FOR OLD PATIENT LIST
3673"RTN","C0QUPDT",137,0)
3674 . S C0QOLD=$NA(^C0Q(201,MSET,5,ZII,3,"B")) ; DENOMINATOR LIST IN MEASURE SET
3675"RTN","C0QUPDT",138,0)
3676 . N C0QRSLT ; ARRAY FOR THE UNITY DIFFERENCES
3677"RTN","C0QUPDT",139,0)
3678 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND THE DIFFERENCES
3679"RTN","C0QUPDT",140,0)
3680 . N C0QDCNT
3681"RTN","C0QUPDT",141,0)
3682 . S C0QDCNT=$G(C0QRSLT("COUNT"))
3683"RTN","C0QUPDT",142,0)
3684 . I C0QDCNT="" D ;
3685"RTN","C0QUPDT",143,0)
3686 . . S C0QDCNT=0 ; DEFAULT COUNT IS ZERO
3687"RTN","C0QUPDT",144,0)
3688 . . N GZZ S GZZ=""
3689"RTN","C0QUPDT",145,0)
3690 . . F S GZZ=$O(C0QRSLT(0,GZZ)) Q:GZZ="" D ; EVERY ADD ENTRY
3691"RTN","C0QUPDT",146,0)
3692 . . . S C0QDCNT=C0QDCNT+1
3693"RTN","C0QUPDT",147,0)
3694 . . F S GZZ=$O(C0QRSLT(1,GZZ)) Q:GZZ="" D ; EVERY EQUAL ENTRY
3695"RTN","C0QUPDT",148,0)
3696 . . . S C0QDCNT=C0QDCNT+1
3697"RTN","C0QUPDT",149,0)
3698 . K C0QFDA ; CLEAR THE FDA
3699"RTN","C0QUPDT",150,0)
3700 . N C0QODCNT ; OLD COUNT
3701"RTN","C0QUPDT",151,0)
3702 . S C0QODCNT=$$GET1^DIQ($$C0QMMFN(),ZII_","_MSET_",",2.1)
3703"RTN","C0QUPDT",152,0)
3704 . I C0QDCNT'=C0QODCNT D ; COUNT HAS CHANGED
3705"RTN","C0QUPDT",153,0)
3706 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",2.1)=C0QDCNT ; DENOMINATOR COUNT
3707"RTN","C0QUPDT",154,0)
3708 . . D UPDIE ; UPDATE THE DENOMINATOR COUNT
3709"RTN","C0QUPDT",155,0)
3710 . I $D(C0QRSLT) D ;B ;
3711"RTN","C0QUPDT",156,0)
3712 . . ;ZWR C0QRSLT
3713"RTN","C0QUPDT",157,0)
3714 . I '$D(C0QRSLT) Q ; NO RESULTS TO USE
3715"RTN","C0QUPDT",158,0)
3716 . ; FIRST PROCESS DELETIONS
3717"RTN","C0QUPDT",159,0)
3718 . K C0QFDA ; CLEAR OUT THE FDA
3719"RTN","C0QUPDT",160,0)
3720 . N ZG,ZIEN S ZG=""
3721"RTN","C0QUPDT",161,0)
3722 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION
3723"RTN","C0QUPDT",162,0)
3724 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
3725"RTN","C0QUPDT",163,0)
3726 . . I ZIEN="" D Q ; OOPS
3727"RTN","C0QUPDT",164,0)
3728 . . . W !,"ERROR DELETING ENTRY!! ",ZG
3729"RTN","C0QUPDT",165,0)
3730 . . S C0QFDA($$C0QMMDFN(),ZIEN_","_ZII_","_MSET_",",.01)="@" ; DELETE
3731"RTN","C0QUPDT",166,0)
3732 . I $D(C0QFDA) D UPDIE ; PROCESS
3733"RTN","C0QUPDT",167,0)
3734 . ; SECOND, PROCESS ADDITIONS
3735"RTN","C0QUPDT",168,0)
3736 . K C0QFDA ; CLEAR OUT THE FDA
3737"RTN","C0QUPDT",169,0)
3738 . N ZG,ZC S ZG="" S ZC=1
3739"RTN","C0QUPDT",170,0)
3740 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION
3741"RTN","C0QUPDT",171,0)
3742 . . S C0QFDA($$C0QMMDFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
3743"RTN","C0QUPDT",172,0)
3744 . . S ZC=ZC+1
3745"RTN","C0QUPDT",173,0)
3746 . I $D(C0QFDA) D UPDIE ; PROCESS
3747"RTN","C0QUPDT",174,0)
3748 . ;
3749"RTN","C0QUPDT",175,0)
3750 . ; File Percentage
3751"RTN","C0QUPDT",176,0)
3752 . N C0QPCT ; PERCENT
3753"RTN","C0QUPDT",177,0)
3754 . D ;
3755"RTN","C0QUPDT",178,0)
3756 . . I C0QDCNT>0 D ;
3757"RTN","C0QUPDT",179,0)
3758 . . . S C0QPCT=$J(100*C0QNCNT/C0QDCNT,0,0)
3759"RTN","C0QUPDT",180,0)
3760 . . E S C0QPCT=0
3761"RTN","C0QUPDT",181,0)
3762 . . K C0QFDA
3763"RTN","C0QUPDT",182,0)
3764 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",3)=C0QPCT ; PERCENT
3765"RTN","C0QUPDT",183,0)
3766 . . D UPDIE
3767"RTN","C0QUPDT",184,0)
3768 Q
3769"RTN","C0QUPDT",185,0)
3770 ;
3771"RTN","C0QUPDT",186,0)
3772DELIST(RTN) ; DECODES ^TMP("DILIST",$J) INTO
3773"RTN","C0QUPDT",187,0)
3774 ; @RTN@(IEN)=INTERNAL VALUE^EXTERNAL VALUE
3775"RTN","C0QUPDT",188,0)
3776 ; ADDED A B INDEX @RTN@("B",INTERNAL VALUE,IEN)=EXTERNAL VALUE
3777"RTN","C0QUPDT",189,0)
3778 N ZI,IV,EV,ZDI,ZIEN,FLTN,FLTD
3779"RTN","C0QUPDT",190,0)
3780 S ZI=""
3781"RTN","C0QUPDT",191,0)
3782 S ZDI=$NA(^TMP("DILIST",$J))
3783"RTN","C0QUPDT",192,0)
3784 K @RTN
3785"RTN","C0QUPDT",193,0)
3786 F S ZI=$O(@ZDI@(1,ZI)) Q:ZI="" D ;
3787"RTN","C0QUPDT",194,0)
3788 . S EV=@ZDI@(1,ZI) ;EXTERNAL VALUE
3789"RTN","C0QUPDT",195,0)
3790 . S IV=$G(@ZDI@("ID",ZI,.01)) ; INTERNAL VALUE
3791"RTN","C0QUPDT",196,0)
3792 . S FLTN=$G(@ZDI@("ID",ZI,1.2)) ; NUMERATOR FILTER LIST
3793"RTN","C0QUPDT",197,0)
3794 . S FLTD=$G(@ZDI@("ID",ZI,2.2)) ; DENOMINATOR FILTER LIST
3795"RTN","C0QUPDT",198,0)
3796 . S ZIEN=@ZDI@(2,ZI) ; IEN
3797"RTN","C0QUPDT",199,0)
3798 . S @RTN@(ZIEN)=IV_"^"_EV_"^"_FLTN_"^"_FLTD
3799"RTN","C0QUPDT",200,0)
3800 . ;S @RTN@("B",IV,ZIEN)=EV
3801"RTN","C0QUPDT",201,0)
3802 Q
3803"RTN","C0QUPDT",202,0)
3804 ;
3805"RTN","C0QUPDT",203,0)
3806UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
3807"RTN","C0QUPDT",204,0)
3808 K ZERR
3809"RTN","C0QUPDT",205,0)
3810 D CLEAN^DILF
3811"RTN","C0QUPDT",206,0)
3812 N % S %=$NA(C0QFDA) F S %=$Q(@%) Q:%="" W %_"="_@%,! ; smh instead of zwrite
3813"RTN","C0QUPDT",207,0)
3814 D UPDATE^DIE("","C0QFDA","","ZERR")
3815"RTN","C0QUPDT",208,0)
3816 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
3817"RTN","C0QUPDT",209,0)
3818 ;. W "ERROR",!
3819"RTN","C0QUPDT",210,0)
3820 ;. ZWR ZERR
3821"RTN","C0QUPDT",211,0)
3822 ;. B
3823"RTN","C0QUPDT",212,0)
3824 K C0QFDA
3825"RTN","C0QUPDT",213,0)
3826 Q
3827"RTN","C0QUPDT",214,0)
3828 ;
3829"RTN","C0QUPDT",215,0)
3830ERXCOUNT(MSETIEN,MIEN) ; Private Proc; Get eRx and file as Numerator, Denominator, and %
3831"RTN","C0QUPDT",216,0)
3832 ; Inputs:
3833"RTN","C0QUPDT",217,0)
3834 ; MSETIEN - Measurement Set IEN - By Value
3835"RTN","C0QUPDT",218,0)
3836 ; MIEN - Measurement IEN inside the Measurement Set - By Value
3837"RTN","C0QUPDT",219,0)
3838 ;
3839"RTN","C0QUPDT",220,0)
3840 ; Optional Symtab input: C0QDEBUG to print out debug messages to STDOUT.
3841"RTN","C0QUPDT",221,0)
3842 ;
3843"RTN","C0QUPDT",222,0)
3844 ; No check is done to see if the caller is sending bad data. Measurement must be
3845"RTN","C0QUPDT",223,0)
3846 ; in a subfile under Measurement Set.
3847"RTN","C0QUPDT",224,0)
3848 ;
3849"RTN","C0QUPDT",225,0)
3850 W:$G(C0QDEBUG) "Processing E-Prescribing Counts",!
3851"RTN","C0QUPDT",226,0)
3852 ; Example of Data we go through in the C0Q Parameter File, so the code below
3853"RTN","C0QUPDT",227,0)
3854 ; will make sense.
3855"RTN","C0QUPDT",228,0)
3856 ; ^C0Q(401,"AMMS",2,1)=""
3857"RTN","C0QUPDT",229,0)
3858 ; ^C0Q(401,"AMMS",2,2)=""
3859"RTN","C0QUPDT",230,0)
3860 ; ^C0Q(401,"AQMS",6,2)=""
3861"RTN","C0QUPDT",231,0)
3862 ; ^C0Q(401,"B","INPATIENT",2)=""
3863"RTN","C0QUPDT",232,0)
3864 ; ^C0Q(401,"B","OUTPATIENT",1)=""
3865"RTN","C0QUPDT",233,0)
3866 ; ^C0Q(401,"MU","MU12",1)=""
3867"RTN","C0QUPDT",234,0)
3868 ; ^C0Q(401,"MU","MU12",2)=""
3869"RTN","C0QUPDT",235,0)
3870 ; ^C0Q(401,"MUTYP","MU12","EP",1)=""
3871"RTN","C0QUPDT",236,0)
3872 ; ^C0Q(401,"MUTYP","MU12","INP",2)=""
3873"RTN","C0QUPDT",237,0)
3874 ;
3875"RTN","C0QUPDT",238,0)
3876 ; Get Parameter year from the Parameters file.
3877"RTN","C0QUPDT",239,0)
3878 ; 1. Get parameter associated with this measurement set from AMMS x-ref (new in C0Q*1*1).
3879"RTN","C0QUPDT",240,0)
3880 N C0QPARAM
3881"RTN","C0QUPDT",241,0)
3882 N % S %="" F S %=$O(^C0Q(401,"AMMS",MSETIEN,%)) Q:%="" S C0QPARAM(%)=""
3883"RTN","C0QUPDT",242,0)
3884 ;
3885"RTN","C0QUPDT",243,0)
3886 ; 2. Find the year for each of those--store as value of node; IEN still subscript.
3887"RTN","C0QUPDT",244,0)
3888 N % S %="" F S %=$O(C0QPARAM(%)) Q:%="" S C0QPARAM(%)=$$GET1^DIQ(1130580001.401,%_",",.02)
3889"RTN","C0QUPDT",245,0)
3890 ;
3891"RTN","C0QUPDT",246,0)
3892 ; 3. Now make sure that this parameter that point to an Outpatient Parameters
3893"RTN","C0QUPDT",247,0)
3894 ; WARNING: CONFUSING CODE WRITTEN BY ME AHEAD
3895"RTN","C0QUPDT",248,0)
3896 ; The % loop will stop with a valid value if found; % is used in the lines immediately below
3897"RTN","C0QUPDT",249,0)
3898 N % S %="" F S %=$O(C0QPARAM(%)) Q:%="" Q:$D(^C0Q(401,"MUTYP",C0QPARAM(%),"EP",%))
3899"RTN","C0QUPDT",250,0)
3900 ;
3901"RTN","C0QUPDT",251,0)
3902 ; 4. If % has a valid IEN (there can be multiple, we take the first), then off we go.
3903"RTN","C0QUPDT",252,0)
3904 ; Otherwise, if it is back to "", we quit.
3905"RTN","C0QUPDT",253,0)
3906 N MUYEAR
3907"RTN","C0QUPDT",254,0)
3908 IF '% W "No suitable parameter found. Cannot determine Measurement Year.",! QUIT
3909"RTN","C0QUPDT",255,0)
3910 ELSE S MUYEAR=C0QPARAM(%)
3911"RTN","C0QUPDT",256,0)
3912 ;
3913"RTN","C0QUPDT",257,0)
3914 ; Now, based on the MU year, construct the patient list name that has the eRx data.
3915"RTN","C0QUPDT",258,0)
3916 N LISTNAME S LISTNAME=MUYEAR_"-"_"EP"_"-"_"HasERX"
3917"RTN","C0QUPDT",259,0)
3918 ;
3919"RTN","C0QUPDT",260,0)
3920 ; Call the API in C0QMUERX to get the counts already calculated
3921"RTN","C0QUPDT",261,0)
3922 ; Data is returned NUM/DEN
3923"RTN","C0QUPDT",262,0)
3924 N COUNTS S COUNTS=$$COUNT^C0QMUERX($$PATLN^C0QMU12(LISTNAME))
3925"RTN","C0QUPDT",263,0)
3926 ;
3927"RTN","C0QUPDT",264,0)
3928 ; File the count
3929"RTN","C0QUPDT",265,0)
3930 N NUM S NUM=$P(COUNTS,"/") ; Numerator
3931"RTN","C0QUPDT",266,0)
3932 N DEN S DEN=$P(COUNTS,"/",2) ; Denominator
3933"RTN","C0QUPDT",267,0)
3934 ;
3935"RTN","C0QUPDT",268,0)
3936 ; Prepare FDA
3937"RTN","C0QUPDT",269,0)
3938 N C0QFDA,C0QERR
3939"RTN","C0QUPDT",270,0)
3940 S C0QFDA($$C0QMMFN(),MIEN_","_MSETIEN_",",1.1)=NUM ; Numerator
3941"RTN","C0QUPDT",271,0)
3942 S C0QFDA($$C0QMMFN(),MIEN_","_MSETIEN_",",2.1)=DEN ; Denominator
3943"RTN","C0QUPDT",272,0)
3944 S C0QFDA($$C0QMMFN(),MIEN_","_MSETIEN_",",3)=$S(DEN=0:0,1:$J(100*NUM/DEN,0,0)) ; Percentage; avoid dividing by zero!
3945"RTN","C0QUPDT",273,0)
3946 ;
3947"RTN","C0QUPDT",274,0)
3948 ; File FDA using Filer not updater (editing existing entry only)
3949"RTN","C0QUPDT",275,0)
3950 D FILE^DIE("ET",$NAME(C0QFDA),$NAME(C0QERR)) ; Flags: External, Transaction
3951"RTN","C0QUPDT",276,0)
3952 ;
3953"RTN","C0QUPDT",277,0)
3954 ; If error, print it out
3955"RTN","C0QUPDT",278,0)
3956 I $D(C0QERR) DO
3957"RTN","C0QUPDT",279,0)
3958 . W "Error filing data",!
3959"RTN","C0QUPDT",280,0)
3960 . N % S %=$NAME(C0QERR) F S %=$Q(@%) Q:%="" W %_": "_@%,!
3961"RTN","C0QUPDT",281,0)
3962 ;
3963"RTN","C0QUPDT",282,0)
3964 QUIT
3965"SEC","^DD",1130580001.101,1130580001.101,3.1,9)
3966
3967"SEC","^DIC",1130580001.101,1130580001.101,0,"AUDIT")
3968@
3969"SEC","^DIC",1130580001.101,1130580001.101,0,"DD")
3970@
3971"SEC","^DIC",1130580001.101,1130580001.101,0,"DEL")
3972@
3973"SEC","^DIC",1130580001.101,1130580001.101,0,"LAYGO")
3974@
3975"SEC","^DIC",1130580001.101,1130580001.101,0,"RD")
3976@
3977"SEC","^DIC",1130580001.101,1130580001.101,0,"WR")
3978@
3979"VER")
39808.0^22.0
3981"^DD",1130580001.101,1130580001.101,0)
3982FIELD^^4^16
3983"^DD",1130580001.101,1130580001.101,0,"DDA")
3984N
3985"^DD",1130580001.101,1130580001.101,0,"DT")
39863120530
3987"^DD",1130580001.101,1130580001.101,0,"ID",.7)
3988W:$D(^(5)) " ",$P(^(5),U,1)
3989"^DD",1130580001.101,1130580001.101,0,"IX","B",1130580001.101,.01)
3990
3991"^DD",1130580001.101,1130580001.101,0,"NM","C0Q QUALITY MEASURE")
3992
3993"^DD",1130580001.101,1130580001.101,0,"PT",1130580001.2011,.01)
3994
3995"^DD",1130580001.101,1130580001.101,0,"VRPK")
3996C0Q
3997"^DD",1130580001.101,1130580001.101,.01,0)
3998NAME^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X
3999"^DD",1130580001.101,1130580001.101,.01,.1)
4000MEASURE NAME
4001"^DD",1130580001.101,1130580001.101,.01,1,0)
4002^.1
4003"^DD",1130580001.101,1130580001.101,.01,1,1,0)
40041130580001.101^B
4005"^DD",1130580001.101,1130580001.101,.01,1,1,1)
4006S ^C0Q(101,"B",$E(X,1,30),DA)=""
4007"^DD",1130580001.101,1130580001.101,.01,1,1,2)
4008K ^C0Q(101,"B",$E(X,1,30),DA)
4009"^DD",1130580001.101,1130580001.101,.01,3)
4010Answer must be 1-30 characters in length
4011"^DD",1130580001.101,1130580001.101,.01,"DT")
40123101012
4013"^DD",1130580001.101,1130580001.101,.3,0)
4014MU YEAR KEY^F^^7;6^K:$L(X)>30!($L(X)<1) X
4015"^DD",1130580001.101,1130580001.101,.3,.1)
4016MEANINGFUL USE YEAR KEY
4017"^DD",1130580001.101,1130580001.101,.3,3)
4018Answer must be 1-30 characters in length.
4019"^DD",1130580001.101,1130580001.101,.3,"DT")
40203111201
4021"^DD",1130580001.101,1130580001.101,.5,0)
4022TITLE^F^^1;1^K:$L(X)>240!($L(X)<3) X
4023"^DD",1130580001.101,1130580001.101,.5,.1)
4024MEASURE TITLE
4025"^DD",1130580001.101,1130580001.101,.5,3)
4026Answer must be 3-240 characters in length
4027"^DD",1130580001.101,1130580001.101,.5,"DT")
40283110430
4029"^DD",1130580001.101,1130580001.101,.61,0)
4030VERY LONG DESCRIPTION^1130580001.111^^6;0
4031"^DD",1130580001.101,1130580001.101,.7,0)
4032DISPLAY NAME^F^^5;1^K:$L(X)>240!($L(X)<3) X
4033"^DD",1130580001.101,1130580001.101,.7,.1)
4034QRDA DISPLAY NAME
4035"^DD",1130580001.101,1130580001.101,.7,3)
4036Answer must be 3-240 characters in length
4037"^DD",1130580001.101,1130580001.101,.7,"DT")
40383101012
4039"^DD",1130580001.101,1130580001.101,.8,0)
4040REPORTING NAME^F^^7;1^K:$L(X)>30!($L(X)<3) X
4041"^DD",1130580001.101,1130580001.101,.8,.1)
4042REPORTING MEASURE NAME
4043"^DD",1130580001.101,1130580001.101,.8,3)
4044Answer must be 3-30 characters in length
4045"^DD",1130580001.101,1130580001.101,.8,"DT")
40463110615
4047"^DD",1130580001.101,1130580001.101,1,0)
4048NUMERATOR PATIENT LIST^P810.5'^PXRMXP(810.5,^0;2^Q
4049"^DD",1130580001.101,1130580001.101,1,.1)
4050MEASURE NUMERATOR PATIENT LIST
4051"^DD",1130580001.101,1130580001.101,1,"DT")
40523101012
4053"^DD",1130580001.101,1130580001.101,1.1,0)
4054ALTERNATIVE NUMERATOR LIST^P1130580001.301'^C0Q(301,^7;2^Q
4055"^DD",1130580001.101,1130580001.101,1.1,"DT")
40563110805
4057"^DD",1130580001.101,1130580001.101,1.5,0)
4058NEGATIVE NUMERATOR LIST^P810.5'^PXRMXP(810.5,^7;4^Q
4059"^DD",1130580001.101,1130580001.101,1.5,.1)
4060LIST OF PATIENTS THAT DO NOT MEET THE REQUIREMENTS
4061"^DD",1130580001.101,1130580001.101,1.5,"DT")
40623110809
4063"^DD",1130580001.101,1130580001.101,1.51,0)
4064ALTERNATE NEGATIVE NUM LIST^P1130580001.301'^C0Q(301,^7;5^Q
4065"^DD",1130580001.101,1130580001.101,1.51,.1)
4066NEGATIVE NUMERATOR LIST IN C0Q PATIENT LIST FILE
4067"^DD",1130580001.101,1130580001.101,1.51,"DT")
40683110809
4069"^DD",1130580001.101,1130580001.101,2,0)
4070DENOMINATOR PATIENT LIST^P810.5'^PXRMXP(810.5,^0;3^Q
4071"^DD",1130580001.101,1130580001.101,2,.1)
4072MEASURE DENOMINATOR PATIENT LIST
4073"^DD",1130580001.101,1130580001.101,2,"DT")
40743101012
4075"^DD",1130580001.101,1130580001.101,2.1,0)
4076ALTERNATIVE DENOMINATOR LIST^P1130580001.301'^C0Q(301,^7;3^Q
4077"^DD",1130580001.101,1130580001.101,2.1,"DT")
40783110805
4079"^DD",1130580001.101,1130580001.101,3,0)
4080QRDA TEMPLATE ROOT^F^^0;4^K:$L(X)>120!($L(X)<3) X
4081"^DD",1130580001.101,1130580001.101,3,.1)
4082MEASURE TEMPLATE ROOT FOR QRDA DOCUMENT
4083"^DD",1130580001.101,1130580001.101,3,3)
4084Answer must be 3-120 characters in length
4085"^DD",1130580001.101,1130580001.101,3,"DT")
40863101012
4087"^DD",1130580001.101,1130580001.101,3.1,0)
4088QRDA MEASURE SYSTEM OID^CJ^^ ; ^S X="2.16.840.1.113883.3.249.12"
4089"^DD",1130580001.101,1130580001.101,3.1,.1)
4090QRDA SYSTEM OID (FIXED)
4091"^DD",1130580001.101,1130580001.101,3.1,9.01)
4092
4093"^DD",1130580001.101,1130580001.101,3.1,9.1)
4094S X="2.16.840.1.113883.3.249.12"
4095"^DD",1130580001.101,1130580001.101,3.1,"DT")
40963101012
4097"^DD",1130580001.101,1130580001.101,3.2,0)
4098QRDA CODE^F^^4;1^K:$L(X)>80!($L(X)<1) X
4099"^DD",1130580001.101,1130580001.101,3.2,.1)
4100QRDA MEASURE CODE
4101"^DD",1130580001.101,1130580001.101,3.2,3)
4102Answer must be 1-80 characters in length
4103"^DD",1130580001.101,1130580001.101,3.2,"DT")
41043101012
4105"^DD",1130580001.101,1130580001.101,4,0)
4106MEASURE TYPE^S^P:Performance;Q:Quality;E:Electronic Prescribing Performance;^0;5^Q
4107"^DD",1130580001.101,1130580001.101,4,3)
4108Enter a code P, Q or E
4109"^DD",1130580001.101,1130580001.101,4,21,0)
4110^^19^19^3120530^
4111"^DD",1130580001.101,1130580001.101,4,21,1,0)
4112This field designates the measure type. It can be P, Q or M.
4113"^DD",1130580001.101,1130580001.101,4,21,2,0)
4114
4115"^DD",1130580001.101,1130580001.101,4,21,3,0)
4116P is for Performance. Performance measures are MU measures to measure
4117"^DD",1130580001.101,1130580001.101,4,21,4,0)
4118how meaningfully used an EMR is. An example of a performance measure
4119"^DD",1130580001.101,1130580001.101,4,21,5,0)
4120is whether allergies are documented in the EMR. Performance measures
4121"^DD",1130580001.101,1130580001.101,4,21,6,0)
4122reference a Patient List created by this package.
4123"^DD",1130580001.101,1130580001.101,4,21,7,0)
4124
4125"^DD",1130580001.101,1130580001.101,4,21,8,0)
4126Q is for Quality Measures. Quality measures are MU measures to assess how
4127"^DD",1130580001.101,1130580001.101,4,21,9,0)
4128well the patients are cared for. An example of a quality measure is
4129"^DD",1130580001.101,1130580001.101,4,21,10,0)
4130whether Hemoglobin A1c Poor Control. Quality measures reference Patient
4131"^DD",1130580001.101,1130580001.101,4,21,11,0)
4132Lists in the Reminders package.
4133"^DD",1130580001.101,1130580001.101,4,21,12,0)
4134
4135"^DD",1130580001.101,1130580001.101,4,21,13,0)
4136E is for Electronic Prescribing. This is a Performance measure, except
4137"^DD",1130580001.101,1130580001.101,4,21,14,0)
4138that it is handled differently than the rest. Instead of the numerators
4139"^DD",1130580001.101,1130580001.101,4,21,15,0)
4140and denominators being lists of patients as with all the other
4141"^DD",1130580001.101,1130580001.101,4,21,16,0)
4142measurements, they are a number of prescriptions. That's why we have a
4143"^DD",1130580001.101,1130580001.101,4,21,17,0)
4144special flag for it. It references a Patient List created by this
4145"^DD",1130580001.101,1130580001.101,4,21,18,0)
4146package. The numerator and denominators are stored in subfiles for each
4147"^DD",1130580001.101,1130580001.101,4,21,19,0)
4148patient.
4149"^DD",1130580001.101,1130580001.101,4,23,0)
4150^^4^4^3120530^
4151"^DD",1130580001.101,1130580001.101,4,23,1,0)
4152As of version C0P*1.0*1, the software doesn't use this field except to
4153"^DD",1130580001.101,1130580001.101,4,23,2,0)
4154check for an electronic prescribing type (code E).
4155"^DD",1130580001.101,1130580001.101,4,23,3,0)
4156
4157"^DD",1130580001.101,1130580001.101,4,23,4,0)
4158I anticipate using this field for other purposes in the future.
4159"^DD",1130580001.101,1130580001.101,4,"DT")
41603120530
4161"^DD",1130580001.101,1130580001.111,0)
4162VERY LONG DESCRIPTION SUB-FIELD^^.01^1
4163"^DD",1130580001.101,1130580001.111,0,"DT")
41643101013
4165"^DD",1130580001.101,1130580001.111,0,"NM","VERY LONG DESCRIPTION")
4166
4167"^DD",1130580001.101,1130580001.111,0,"UP")
41681130580001.101
4169"^DD",1130580001.101,1130580001.111,.01,0)
4170VERY LONG DESCRIPTION^Wx^^0;1
4171"^DD",1130580001.101,1130580001.111,.01,.1)
4172LONGER DESCRIPTION - IF IT DOESN'T FIT IN .6
4173"^DD",1130580001.101,1130580001.111,.01,3)
4174LONGER DESCRIPTION - INSTEAD OF LONG DESCRIPTION
4175"^DD",1130580001.101,1130580001.111,.01,"DT")
41763101013
4177"^DD",1130580001.401,1130580001.401,2,0)
4178EP MU MEASUREMENT SET^P1130580001.201'^C0Q(201,^0;6^Q
4179"^DD",1130580001.401,1130580001.401,2,.1)
4180OUTPATIENT MEANINGFUL USE MEASUREMENT SET
4181"^DD",1130580001.401,1130580001.401,2,1,0)
4182^.1
4183"^DD",1130580001.401,1130580001.401,2,1,1,0)
41841130580001.401^AMMS
4185"^DD",1130580001.401,1130580001.401,2,1,1,1)
4186S ^C0Q(401,"AMMS",$E(X,1,30),DA)=""
4187"^DD",1130580001.401,1130580001.401,2,1,1,2)
4188K ^C0Q(401,"AMMS",$E(X,1,30),DA)
4189"^DD",1130580001.401,1130580001.401,2,1,1,3)
4190USED BY THE CODE. SEE DESCRIPTION.
4191"^DD",1130580001.401,1130580001.401,2,1,1,"%D",0)
4192^.101^5^5^3120530^^^
4193"^DD",1130580001.401,1130580001.401,2,1,1,"%D",1,0)
4194Indexes the IEN of the Measurement Set. Used so that we can walk back to
4195"^DD",1130580001.401,1130580001.401,2,1,1,"%D",2,0)
4196a parameter when processing a specific IEN.
4197"^DD",1130580001.401,1130580001.401,2,1,1,"%D",3,0)
4198
4199"^DD",1130580001.401,1130580001.401,2,1,1,"%D",4,0)
4200You can get the IEN of the measurement set using
4201"^DD",1130580001.401,1130580001.401,2,1,1,"%D",5,0)
4202$O(^C0Q(401,"AMMS",MSIEN,"")).
4203"^DD",1130580001.401,1130580001.401,2,1,1,"DT")
42043120530
4205"^DD",1130580001.401,1130580001.401,2,"DT")
42063120530
4207"^DD",1130580001.401,1130580001.401,2.1,0)
4208EP QUALITY MEASUREMENT SET^P1130580001.201'^C0Q(201,^0;7^Q
4209"^DD",1130580001.401,1130580001.401,2.1,.1)
4210OUTPATIENT QUALITY MEASUREMENT SET
4211"^DD",1130580001.401,1130580001.401,2.1,1,0)
4212^.1
4213"^DD",1130580001.401,1130580001.401,2.1,1,1,0)
42141130580001.401^AQMS
4215"^DD",1130580001.401,1130580001.401,2.1,1,1,1)
4216S ^C0Q(401,"AQMS",$E(X,1,30),DA)=""
4217"^DD",1130580001.401,1130580001.401,2.1,1,1,2)
4218K ^C0Q(401,"AQMS",$E(X,1,30),DA)
4219"^DD",1130580001.401,1130580001.401,2.1,1,1,3)
4220USED BY THE CODE. SEE DESCRIPTION.
4221"^DD",1130580001.401,1130580001.401,2.1,1,1,"%D",0)
4222^^5^5^3120530^
4223"^DD",1130580001.401,1130580001.401,2.1,1,1,"%D",1,0)
4224Indexes the IEN of the Measurement Set. Used so that we can walk back to
4225"^DD",1130580001.401,1130580001.401,2.1,1,1,"%D",2,0)
4226a parameter when processing a specific IEN.
4227"^DD",1130580001.401,1130580001.401,2.1,1,1,"%D",3,0)
4228
4229"^DD",1130580001.401,1130580001.401,2.1,1,1,"%D",4,0)
4230You can get the IEN of the measurement set using
4231"^DD",1130580001.401,1130580001.401,2.1,1,1,"%D",5,0)
4232$O(^C0Q(401,"AQMS",MSIEN,"")).
4233"^DD",1130580001.401,1130580001.401,2.1,1,1,"DT")
42343120530
4235"^DD",1130580001.401,1130580001.401,2.1,"DT")
42363120530
4237"^DIC",1130580001.101,1130580001.101,0)
4238C0Q QUALITY MEASURE^1130580001.101
4239"^DIC",1130580001.101,1130580001.101,0,"GL")
4240^C0Q(101,
4241"^DIC",1130580001.101,"B","C0Q QUALITY MEASURE",1130580001.101)
4242
4243**END**
4244**END**
Note: See TracBrowser for help on using the repository browser.