Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

C0Q_1P_PAT1T1.KID@ 1495

Last change on this file since 1495 was 1458, checked in by Sam Habiel, 12 years ago
Some clean-up
File size: 127.0 KB

Line
1	KIDS Distribution saved on Jun 13, 2012@17:53:55
2	C0Q 1.0 T1 PATCH 1
3	KIDS:C0Q1.0T11^
4
5	INSTALL NAME
6	C0Q1.0T11
7	"BLD",7937,0)
8	C0Q1.0T11^QUALITY MEASURES^0^3120613^y
9	"BLD",7937,1,0)
10	^^90^90^3120613^^
11	"BLD",7937,1,1,0)
12	ePrescribing MU measure in this package.
13	"BLD",7937,1,2,0)
14
15	"BLD",7937,1,3,0)
16	Dependencies:
17	"BLD",7937,1,4,0)
18	This build requires C0P14 for the new WebService entry that gets MU
19	"BLD",7937,1,5,0)
20	data from New Crop.
21	"BLD",7937,1,6,0)
22	This build requires the base C0Q 1.0 to be installed.
23	"BLD",7937,1,7,0)
24
25	"BLD",7937,1,8,0)
26	This build performs the following:
27	"BLD",7937,1,9,0)
28	Routines:
29	"BLD",7937,1,10,0)
30	1. Adds routine C0QMUERX for calculation of ePrescribing stats.
31	"BLD",7937,1,11,0)
32	2. Mods routine C0QMU12 to call C0QMUERX for the ERX measure for
33	"BLD",7937,1,12,0)
34	Outpatients.
35	"BLD",7937,1,13,0)
36	3. Mods routine C0QUPDT to handle the special case of ePrescribing stats.
37	"BLD",7937,1,14,0)
38	Also, some checks and quits so that we won't crash if no patient lists
39	"BLD",7937,1,15,0)
40	are associated with the measure.
41	"BLD",7937,1,16,0)
42
43	"BLD",7937,1,17,0)
44	Data Dictionary:
45	"BLD",7937,1,18,0)
46	1. 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)
92	2. File C0Q QUALITY MEASURE has a new field, MEASURE TYPE (#4):
93	"BLD",7937,1,42,0)
94
95	"BLD",7937,1,43,0)
96	1130580001.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 C0P1.01, 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)
180	INPUT TEMPLATE:
181	"BLD",7937,1,86,0)
182	C0Q EDIT MU MEASURE adds the new field MEASURE TYPE mentioned above.
183	"BLD",7937,1,87,0)
184
185	"BLD",7937,1,88,0)
186	DATA:
187	"BLD",7937,1,89,0)
188	The entry MU EP ERX for processing ePrescribing stats in C0Q QUALITY
189	"BLD",7937,1,90,0)
190	MEASURE is sent to destination sites.
191	"BLD",7937,4,0)
192	^9.64PA^1130580001.101^2
193	"BLD",7937,4,1130580001.101,0)
194	1130580001.101
195	"BLD",7937,4,1130580001.101,222)
196	y^y^f^^n^^y^o^n
197	"BLD",7937,4,1130580001.101,224)
198	I $P(^(0),U)="MU EP ERX"
199	"BLD",7937,4,1130580001.401,0)
200	1130580001.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)
204	C0Q 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)
208	EP MU MEASUREMENT SET
209	"BLD",7937,4,1130580001.401,2,1130580001.401,1,2.1,0)
210	EP QUALITY MEASUREMENT SET
211	"BLD",7937,4,1130580001.401,222)
212	y^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)
226	29
227	"BLD",7937,"ABPKG")
228	n
229	"BLD",7937,"INIT")
230	POST^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)
246	C0Q 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)
256	3.6
257	"BLD",7937,"KRN",3.8,0)
258	3.8
259	"BLD",7937,"KRN",9.2,0)
260	9.2
261	"BLD",7937,"KRN",9.8,0)
262	9.8
263	"BLD",7937,"KRN",9.8,"NM",0)
264	^9.68A^3^3
265	"BLD",7937,"KRN",9.8,"NM",1,0)
266	C0QMUERX^^0^B83718518
267	"BLD",7937,"KRN",9.8,"NM",2,0)
268	C0QUPDT^^0^B79261186
269	"BLD",7937,"KRN",9.8,"NM",3,0)
270	C0QMU12^^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)
278	19
279	"BLD",7937,"KRN",19,"NM",0)
280	^9.68A^^0
281	"BLD",7937,"KRN",19.1,0)
282	19.1
283	"BLD",7937,"KRN",101,0)
284	101
285	"BLD",7937,"KRN",409.61,0)
286	409.61
287	"BLD",7937,"KRN",771,0)
288	771
289	"BLD",7937,"KRN",779.2,0)
290	779.2
291	"BLD",7937,"KRN",870,0)
292	870
293	"BLD",7937,"KRN",8989.51,0)
294	8989.51
295	"BLD",7937,"KRN",8989.52,0)
296	8989.52
297	"BLD",7937,"KRN",8994,0)
298	8994
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)
346	C0P1.04^2
347	"BLD",7937,"REQB",2,0)
348	C0Q 1.0^2
349	"BLD",7937,"REQB","B","C0P1.04",1)
350
351	"BLD",7937,"REQB","B","C0Q 1.0",2)
352
353	"DATA",1130580001.101,104,0)
354	MU EP ERX^^^^E
355	"DATA",1130580001.101,104,1)
356	More than 40% of all permissible prescriptions written by the EP are transmitted electronically using certified EHR technology.
357	"DATA",1130580001.101,104,5)
358	Eligibile Prescriptions transmitted electronically
359	"DATA",1130580001.101,104,6,0)
360	^1130580001.111^6^6^3120613^^
361	"DATA",1130580001.101,104,6,1,0)
362	Final Rule Text: § 170.304(b).
363	"DATA",1130580001.101,104,6,2,0)
364	Electronic prescribing. Enable a user to electronically generate
365	"DATA",1130580001.101,104,6,3,0)
366	and transmit prescriptions and prescription-related information
367	"DATA",1130580001.101,104,6,4,0)
368	in 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)
376	C0Q QUALITY MEASURE
377	"FIA",1130580001.101,0)
378	^C0Q(101,
379	"FIA",1130580001.101,0,0)
380	1130580001.101I
381	"FIA",1130580001.101,0,1)
382	y^y^f^^n^^y^o^n
383	"FIA",1130580001.101,0,10)
384
385	"FIA",1130580001.101,0,11)
386	I $P(^(0),U)="MU EP ERX"
387	"FIA",1130580001.101,0,"RLRO")
388
389	"FIA",1130580001.101,0,"VR")
390	1.0T1^C0Q
391	"FIA",1130580001.101,1130580001.101)
392	0
393	"FIA",1130580001.101,1130580001.111)
394	0
395	"FIA",1130580001.401)
396	C0Q PARAMETER
397	"FIA",1130580001.401,0)
398	^C0Q(401,
399	"FIA",1130580001.401,0,0)
400	1130580001.401
401	"FIA",1130580001.401,0,1)
402	y^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")
410	1.0T1^C0Q
411	"FIA",1130580001.401,1130580001.401)
412	1
413	"FIA",1130580001.401,1130580001.401,2)
414
415	"FIA",1130580001.401,1130580001.401,2.1)
416
417	"INIT")
418	POST^C0QP1
419	"IX",1130580001.101,1130580001.101,"MU",0)
420	1130580001.101^MU^MEANINGFUL USE YEAR KEY^R^^F^IR^I^1130580001.101^^^^^LS
421	"IX",1130580001.101,1130580001.101,"MU",1)
422	S ^C0Q(101,"MU",$E(X,1,30),DA)=""
423	"IX",1130580001.101,1130580001.101,"MU",2)
424	K ^C0Q(101,"MU",$E(X,1,30),DA)
425	"IX",1130580001.101,1130580001.101,"MU",2.5)
426	K ^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)
430	1^F^1130580001.101^.3^30^1^F
431	"KRN",.402,1746,-1)
432	0^1
433	"KRN",.402,1746,0)
434	C0Q 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")
438	0
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)
442	INPUT TEMPLATE
443	"PKG",213,-1)
444	1^1
445	"PKG",213,0)
446	QUALITY 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)
452	1.0T1
453	"PKG",213,22,1,"PAH",1,0)
454	1^3120613
455	"PKG",213,22,1,"PAH",1,1,0)
456	^^90^90^3120613
457	"PKG",213,22,1,"PAH",1,1,1,0)
458	ePrescribing 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)
462	Dependencies:
463	"PKG",213,22,1,"PAH",1,1,4,0)
464	This build requires C0P14 for the new WebService entry that gets MU
465	"PKG",213,22,1,"PAH",1,1,5,0)
466	data from New Crop.
467	"PKG",213,22,1,"PAH",1,1,6,0)
468	This 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)
472	This build performs the following:
473	"PKG",213,22,1,"PAH",1,1,9,0)
474	Routines:
475	"PKG",213,22,1,"PAH",1,1,10,0)
476	1. Adds routine C0QMUERX for calculation of ePrescribing stats.
477	"PKG",213,22,1,"PAH",1,1,11,0)
478	2. Mods routine C0QMU12 to call C0QMUERX for the ERX measure for
479	"PKG",213,22,1,"PAH",1,1,12,0)
480	Outpatients.
481	"PKG",213,22,1,"PAH",1,1,13,0)
482	3. Mods routine C0QUPDT to handle the special case of ePrescribing stats.
483	"PKG",213,22,1,"PAH",1,1,14,0)
484	Also, some checks and quits so that we won't crash if no patient lists
485	"PKG",213,22,1,"PAH",1,1,15,0)
486	are 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)
490	Data Dictionary:
491	"PKG",213,22,1,"PAH",1,1,18,0)
492	1. 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)
538	2. 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)
542	1130580001.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 C0P1.01, 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)
626	INPUT TEMPLATE:
627	"PKG",213,22,1,"PAH",1,1,86,0)
628	C0Q 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)
632	DATA:
633	"PKG",213,22,1,"PAH",1,1,89,0)
634	The entry MU EP ERX for processing ePrescribing stats in C0Q QUALITY
635	"PKG",213,22,1,"PAH",1,1,90,0)
636	MEASURE is sent to destination sites.
637	"QUES","XPF1",0)
638	Y
639	"QUES","XPF1","??")
640	^D REP^XPDH
641	"QUES","XPF1","A")
642	Shall I write over your \|FLAG\| File
643	"QUES","XPF1","B")
644	YES
645	"QUES","XPF1","M")
646	D XPF1^XPDIQ
647	"QUES","XPF2",0)
648	Y
649	"QUES","XPF2","??")
650	^D DTA^XPDH
651	"QUES","XPF2","A")
652	Want my data \|FLAG\| yours
653	"QUES","XPF2","B")
654	YES
655	"QUES","XPF2","M")
656	D XPF2^XPDIQ
657	"QUES","XPI1",0)
658	YO
659	"QUES","XPI1","??")
660	^D INHIBIT^XPDH
661	"QUES","XPI1","A")
662	Want KIDS to INHIBIT LOGONs during the install
663	"QUES","XPI1","B")
664	NO
665	"QUES","XPI1","M")
666	D XPI1^XPDIQ
667	"QUES","XPM1",0)
668	PO^VA(200,:EM
669	"QUES","XPM1","??")
670	^D MG^XPDH
671	"QUES","XPM1","A")
672	Enter the Coordinator for Mail Group '\|FLAG\|'
673	"QUES","XPM1","B")
674
675	"QUES","XPM1","M")
676	D XPM1^XPDIQ
677	"QUES","XPO1",0)
678	Y
679	"QUES","XPO1","??")
680	^D MENU^XPDH
681	"QUES","XPO1","A")
682	Want KIDS to Rebuild Menu Trees Upon Completion of Install
683	"QUES","XPO1","B")
684	NO
685	"QUES","XPO1","M")
686	D XPO1^XPDIQ
687	"QUES","XPZ1",0)
688	Y
689	"QUES","XPZ1","??")
690	^D OPT^XPDH
691	"QUES","XPZ1","A")
692	Want to DISABLE Scheduled Options, Menu Options, and Protocols
693	"QUES","XPZ1","B")
694	NO
695	"QUES","XPZ1","M")
696	D XPZ1^XPDIQ
697	"QUES","XPZ2",0)
698	Y
699	"QUES","XPZ2","??")
700	^D RTN^XPDH
701	"QUES","XPZ2","A")
702	Want to MOVE routines to other CPUs
703	"QUES","XPZ2","B")
704	NO
705	"QUES","XPZ2","M")
706	D XPZ2^XPDIQ
707	"RTN")
708	4
709	"RTN","C0QMU12")
710	0^3^B952450497
711	"RTN","C0QMU12",1,0)
712	C0QMU12 ;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)
758	C0QPFN() Q 1130580001.401 ; PARAMETER FILE
759	"RTN","C0QMU12",25,0)
760	C0QPCFN() Q 1130580001.411 ; CLINIC SUBFILE
761	"RTN","C0QMU12",26,0)
762	C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
763	"RTN","C0QMU12",27,0)
764	C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
765	"RTN","C0QMU12",28,0)
766	INIT(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)
834	BUILD ; 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)
886	INITCLST ; 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)
916	ALL ;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)
968	DEMO ; 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)
1032	PROBLEM ; 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)
1052	ALLERGY ; 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)
1074	MEDS4 ; 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)
1122	RECON ; 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)
1172	RECON2 ; 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)
1188	ERX ; 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)
1222	ADVDIR ; 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)
1242	SMOKING ;
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)
1562	VITALS ;
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)
1584	VTE1 ; 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)
1598	COD ; 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)
1608	EDTIME ; 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)
1630	ICUPAT ; 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)
1654	FILTER ; 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)
1734	ED1 ;
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)
1744	ED2 ;
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)
1754	DOTIME(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)
1876	DOTIME2(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)
2002	RPATLN(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)
2016	PATLN(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)
2030	INLIST(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)
2048	PRINT ; 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)
2082	SS ; 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)
2140	PATLIST ; 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)
2200	NHIN ; 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)
2216	LOCPAT(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)
2252	EPPAT(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)
2288	DOEP ; 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)
2368	DIS ;
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)
2430	C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
2431	"RTN","C0QMU12",861,0)
2432	C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
2433	"RTN","C0QMU12",862,0)
2434	FILE ; 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)
2538	KLNCR(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)
2586	UPDIE ; 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)
2718	END ;end of C0QPRML;
2719	"RTN","C0QMUERX")
2720	0^1^B83718518
2721	"RTN","C0QMUERX",1,0)
2722	C0QMUERX ; 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)
2730	UT ; 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)
2762	UT2 ; 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)
2770	UT3 ; 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)
2780	EN(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)
3116	HASERX(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)
3140	SAVE(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)
3276	COUNT(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")
3378	0^^B541099
3379	"RTN","C0QP1",1,0)
3380	C0QP1 ; 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)
3386	POST ; 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")
3400	0^2^B79261186
3401	"RTN","C0QUPDT",1,0)
3402	C0QUPDT ; 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)
3444	C0QQFN() Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE
3445	"RTN","C0QUPDT",23,0)
3446	C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
3447	"RTN","C0QUPDT",24,0)
3448	C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
3449	"RTN","C0QUPDT",25,0)
3450	C0QMMNFN() Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE
3451	"RTN","C0QUPDT",26,0)
3452	C0QMMDFN() Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE
3453	"RTN","C0QUPDT",27,0)
3454	RLSTFN() Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE
3455	"RTN","C0QUPDT",28,0)
3456	RLSTPFN() Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE
3457	"RTN","C0QUPDT",29,0)
3458	C0QPLF() Q 1130580001.301 ; C0Q PATIENT LIST FILE
3459	"RTN","C0QUPDT",30,0)
3460	C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ;
3461	"RTN","C0QUPDT",31,0)
3462	;
3463	"RTN","C0QUPDT",32,0)
3464	UPDATE(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)
3772	DELIST(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)
3806	UPDIE ; 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)
3830	ERXCOUNT(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 C0Q11).
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")
3980	8.0^22.0
3981	"^DD",1130580001.101,1130580001.101,0)
3982	FIELD^^4^16
3983	"^DD",1130580001.101,1130580001.101,0,"DDA")
3984	N
3985	"^DD",1130580001.101,1130580001.101,0,"DT")
3986	3120530
3987	"^DD",1130580001.101,1130580001.101,0,"ID",.7)
3988	W:$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")
3996	C0Q
3997	"^DD",1130580001.101,1130580001.101,.01,0)
3998	NAME^RF^^0;1^K:$L(X)>30!($L(X)<1)!'(X'?1P.E) X
3999	"^DD",1130580001.101,1130580001.101,.01,.1)
4000	MEASURE NAME
4001	"^DD",1130580001.101,1130580001.101,.01,1,0)
4002	^.1
4003	"^DD",1130580001.101,1130580001.101,.01,1,1,0)
4004	1130580001.101^B
4005	"^DD",1130580001.101,1130580001.101,.01,1,1,1)
4006	S ^C0Q(101,"B",$E(X,1,30),DA)=""
4007	"^DD",1130580001.101,1130580001.101,.01,1,1,2)
4008	K ^C0Q(101,"B",$E(X,1,30),DA)
4009	"^DD",1130580001.101,1130580001.101,.01,3)
4010	Answer must be 1-30 characters in length
4011	"^DD",1130580001.101,1130580001.101,.01,"DT")
4012	3101012
4013	"^DD",1130580001.101,1130580001.101,.3,0)
4014	MU YEAR KEY^F^^7;6^K:$L(X)>30!($L(X)<1) X
4015	"^DD",1130580001.101,1130580001.101,.3,.1)
4016	MEANINGFUL USE YEAR KEY
4017	"^DD",1130580001.101,1130580001.101,.3,3)
4018	Answer must be 1-30 characters in length.
4019	"^DD",1130580001.101,1130580001.101,.3,"DT")
4020	3111201
4021	"^DD",1130580001.101,1130580001.101,.5,0)
4022	TITLE^F^^1;1^K:$L(X)>240!($L(X)<3) X
4023	"^DD",1130580001.101,1130580001.101,.5,.1)
4024	MEASURE TITLE
4025	"^DD",1130580001.101,1130580001.101,.5,3)
4026	Answer must be 3-240 characters in length
4027	"^DD",1130580001.101,1130580001.101,.5,"DT")
4028	3110430
4029	"^DD",1130580001.101,1130580001.101,.61,0)
4030	VERY LONG DESCRIPTION^1130580001.111^^6;0
4031	"^DD",1130580001.101,1130580001.101,.7,0)
4032	DISPLAY NAME^F^^5;1^K:$L(X)>240!($L(X)<3) X
4033	"^DD",1130580001.101,1130580001.101,.7,.1)
4034	QRDA DISPLAY NAME
4035	"^DD",1130580001.101,1130580001.101,.7,3)
4036	Answer must be 3-240 characters in length
4037	"^DD",1130580001.101,1130580001.101,.7,"DT")
4038	3101012
4039	"^DD",1130580001.101,1130580001.101,.8,0)
4040	REPORTING NAME^F^^7;1^K:$L(X)>30!($L(X)<3) X
4041	"^DD",1130580001.101,1130580001.101,.8,.1)
4042	REPORTING MEASURE NAME
4043	"^DD",1130580001.101,1130580001.101,.8,3)
4044	Answer must be 3-30 characters in length
4045	"^DD",1130580001.101,1130580001.101,.8,"DT")
4046	3110615
4047	"^DD",1130580001.101,1130580001.101,1,0)
4048	NUMERATOR PATIENT LIST^P810.5'^PXRMXP(810.5,^0;2^Q
4049	"^DD",1130580001.101,1130580001.101,1,.1)
4050	MEASURE NUMERATOR PATIENT LIST
4051	"^DD",1130580001.101,1130580001.101,1,"DT")
4052	3101012
4053	"^DD",1130580001.101,1130580001.101,1.1,0)
4054	ALTERNATIVE NUMERATOR LIST^P1130580001.301'^C0Q(301,^7;2^Q
4055	"^DD",1130580001.101,1130580001.101,1.1,"DT")
4056	3110805
4057	"^DD",1130580001.101,1130580001.101,1.5,0)
4058	NEGATIVE NUMERATOR LIST^P810.5'^PXRMXP(810.5,^7;4^Q
4059	"^DD",1130580001.101,1130580001.101,1.5,.1)
4060	LIST OF PATIENTS THAT DO NOT MEET THE REQUIREMENTS
4061	"^DD",1130580001.101,1130580001.101,1.5,"DT")
4062	3110809
4063	"^DD",1130580001.101,1130580001.101,1.51,0)
4064	ALTERNATE NEGATIVE NUM LIST^P1130580001.301'^C0Q(301,^7;5^Q
4065	"^DD",1130580001.101,1130580001.101,1.51,.1)
4066	NEGATIVE NUMERATOR LIST IN C0Q PATIENT LIST FILE
4067	"^DD",1130580001.101,1130580001.101,1.51,"DT")
4068	3110809
4069	"^DD",1130580001.101,1130580001.101,2,0)
4070	DENOMINATOR PATIENT LIST^P810.5'^PXRMXP(810.5,^0;3^Q
4071	"^DD",1130580001.101,1130580001.101,2,.1)
4072	MEASURE DENOMINATOR PATIENT LIST
4073	"^DD",1130580001.101,1130580001.101,2,"DT")
4074	3101012
4075	"^DD",1130580001.101,1130580001.101,2.1,0)
4076	ALTERNATIVE DENOMINATOR LIST^P1130580001.301'^C0Q(301,^7;3^Q
4077	"^DD",1130580001.101,1130580001.101,2.1,"DT")
4078	3110805
4079	"^DD",1130580001.101,1130580001.101,3,0)
4080	QRDA TEMPLATE ROOT^F^^0;4^K:$L(X)>120!($L(X)<3) X
4081	"^DD",1130580001.101,1130580001.101,3,.1)
4082	MEASURE TEMPLATE ROOT FOR QRDA DOCUMENT
4083	"^DD",1130580001.101,1130580001.101,3,3)
4084	Answer must be 3-120 characters in length
4085	"^DD",1130580001.101,1130580001.101,3,"DT")
4086	3101012
4087	"^DD",1130580001.101,1130580001.101,3.1,0)
4088	QRDA MEASURE SYSTEM OID^CJ^^ ; ^S X="2.16.840.1.113883.3.249.12"
4089	"^DD",1130580001.101,1130580001.101,3.1,.1)
4090	QRDA SYSTEM OID (FIXED)
4091	"^DD",1130580001.101,1130580001.101,3.1,9.01)
4092
4093	"^DD",1130580001.101,1130580001.101,3.1,9.1)
4094	S X="2.16.840.1.113883.3.249.12"
4095	"^DD",1130580001.101,1130580001.101,3.1,"DT")
4096	3101012
4097	"^DD",1130580001.101,1130580001.101,3.2,0)
4098	QRDA CODE^F^^4;1^K:$L(X)>80!($L(X)<1) X
4099	"^DD",1130580001.101,1130580001.101,3.2,.1)
4100	QRDA MEASURE CODE
4101	"^DD",1130580001.101,1130580001.101,3.2,3)
4102	Answer must be 1-80 characters in length
4103	"^DD",1130580001.101,1130580001.101,3.2,"DT")
4104	3101012
4105	"^DD",1130580001.101,1130580001.101,4,0)
4106	MEASURE TYPE^S^P:Performance;Q:Quality;E:Electronic Prescribing Performance;^0;5^Q
4107	"^DD",1130580001.101,1130580001.101,4,3)
4108	Enter 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)
4112	This 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)
4116	P is for Performance. Performance measures are MU measures to measure
4117	"^DD",1130580001.101,1130580001.101,4,21,4,0)
4118	how meaningfully used an EMR is. An example of a performance measure
4119	"^DD",1130580001.101,1130580001.101,4,21,5,0)
4120	is whether allergies are documented in the EMR. Performance measures
4121	"^DD",1130580001.101,1130580001.101,4,21,6,0)
4122	reference 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)
4126	Q is for Quality Measures. Quality measures are MU measures to assess how
4127	"^DD",1130580001.101,1130580001.101,4,21,9,0)
4128	well the patients are cared for. An example of a quality measure is
4129	"^DD",1130580001.101,1130580001.101,4,21,10,0)
4130	whether Hemoglobin A1c Poor Control. Quality measures reference Patient
4131	"^DD",1130580001.101,1130580001.101,4,21,11,0)
4132	Lists 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)
4136	E is for Electronic Prescribing. This is a Performance measure, except
4137	"^DD",1130580001.101,1130580001.101,4,21,14,0)
4138	that it is handled differently than the rest. Instead of the numerators
4139	"^DD",1130580001.101,1130580001.101,4,21,15,0)
4140	and denominators being lists of patients as with all the other
4141	"^DD",1130580001.101,1130580001.101,4,21,16,0)
4142	measurements, they are a number of prescriptions. That's why we have a
4143	"^DD",1130580001.101,1130580001.101,4,21,17,0)
4144	special flag for it. It references a Patient List created by this
4145	"^DD",1130580001.101,1130580001.101,4,21,18,0)
4146	package. The numerator and denominators are stored in subfiles for each
4147	"^DD",1130580001.101,1130580001.101,4,21,19,0)
4148	patient.
4149	"^DD",1130580001.101,1130580001.101,4,23,0)
4150	^^4^4^3120530^
4151	"^DD",1130580001.101,1130580001.101,4,23,1,0)
4152	As of version C0P1.01, the software doesn't use this field except to
4153	"^DD",1130580001.101,1130580001.101,4,23,2,0)
4154	check 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)
4158	I anticipate using this field for other purposes in the future.
4159	"^DD",1130580001.101,1130580001.101,4,"DT")
4160	3120530
4161	"^DD",1130580001.101,1130580001.111,0)
4162	VERY LONG DESCRIPTION SUB-FIELD^^.01^1
4163	"^DD",1130580001.101,1130580001.111,0,"DT")
4164	3101013
4165	"^DD",1130580001.101,1130580001.111,0,"NM","VERY LONG DESCRIPTION")
4166
4167	"^DD",1130580001.101,1130580001.111,0,"UP")
4168	1130580001.101
4169	"^DD",1130580001.101,1130580001.111,.01,0)
4170	VERY LONG DESCRIPTION^Wx^^0;1
4171	"^DD",1130580001.101,1130580001.111,.01,.1)
4172	LONGER DESCRIPTION - IF IT DOESN'T FIT IN .6
4173	"^DD",1130580001.101,1130580001.111,.01,3)
4174	LONGER DESCRIPTION - INSTEAD OF LONG DESCRIPTION
4175	"^DD",1130580001.101,1130580001.111,.01,"DT")
4176	3101013
4177	"^DD",1130580001.401,1130580001.401,2,0)
4178	EP MU MEASUREMENT SET^P1130580001.201'^C0Q(201,^0;6^Q
4179	"^DD",1130580001.401,1130580001.401,2,.1)
4180	OUTPATIENT 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)
4184	1130580001.401^AMMS
4185	"^DD",1130580001.401,1130580001.401,2,1,1,1)
4186	S ^C0Q(401,"AMMS",$E(X,1,30),DA)=""
4187	"^DD",1130580001.401,1130580001.401,2,1,1,2)
4188	K ^C0Q(401,"AMMS",$E(X,1,30),DA)
4189	"^DD",1130580001.401,1130580001.401,2,1,1,3)
4190	USED 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)
4194	Indexes 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)
4196	a 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)
4200	You 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")
4204	3120530
4205	"^DD",1130580001.401,1130580001.401,2,"DT")
4206	3120530
4207	"^DD",1130580001.401,1130580001.401,2.1,0)
4208	EP QUALITY MEASUREMENT SET^P1130580001.201'^C0Q(201,^0;7^Q
4209	"^DD",1130580001.401,1130580001.401,2.1,.1)
4210	OUTPATIENT 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)
4214	1130580001.401^AQMS
4215	"^DD",1130580001.401,1130580001.401,2.1,1,1,1)
4216	S ^C0Q(401,"AQMS",$E(X,1,30),DA)=""
4217	"^DD",1130580001.401,1130580001.401,2.1,1,1,2)
4218	K ^C0Q(401,"AQMS",$E(X,1,30),DA)
4219	"^DD",1130580001.401,1130580001.401,2.1,1,1,3)
4220	USED 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)
4224	Indexes 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)
4226	a 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)
4230	You 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")
4234	3120530
4235	"^DD",1130580001.401,1130580001.401,2.1,"DT")
4236	3120530
4237	"^DIC",1130580001.101,1130580001.101,0)
4238	C0Q 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.

Download in other formats:

Original Format