2. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 10/2/2017 3:32:58 PM Eastern Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

2.1 Files compared

#	Location	File	Last Modified
1	OSCIF_ CPRS Enh P1_OR_3.0_439_build_4_August_2017.zip\patches.zip	OR_3_453.KID	Fri Sep 29 14:02:52 2017 UTC
2	OSCIF_ CPRS Enh P1_OR_3.0_439_build_4_August_2017.zip\patches.zip	OR_3_453.KID	Mon Oct 2 16:49:37 2017 UTC

2.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	1	5664
Changed	0	0
Inserted	1	1
Removed	0	0

2.3 Comparison options

Whitespace
Character case	Differences in character case are significant
Line endings	Differences in line endings (`CR` and `LF` characters) are ignored
CR/LF characters	Not shown in the comparison detail

2.4 Active regular expressions

No regular expressions were active.

2.5 Comparison detail

		1
2	Packman Ma il Message :
3	========== ========== =
4
5	$END TXT
6	$KID OR3. 0453
7	INSTALL NAME
8	OR3.0453
9	"BLD",1001 8,0)
10	OR3.0453 ^ORDER ENT RY/RESULTS REPORTING ^0^3170717 ^y
11	"BLD",1001 8,4,0)
12	^9.64PA^10 0^1
13	"BLD",1001 8,4,100,0)
14	100
15	"BLD",1001 8,4,100,2, 0)
16	^9.641^100 .011^2
17	"BLD",1001 8,4,100,2, 100.008,0)
18	ORDER ACTI ONS (sub- file)
19	"BLD",1001 8,4,100,2, 100.008,1, 0)
20	^9.6411^3^ 2
21	"BLD",1001 8,4,100,2, 100.008,1, .01,0)
22	DATE/TIME ORDERED
23	"BLD",1001 8,4,100,2, 100.008,1, 3,0)
24	PROVIDER
25	"BLD",1001 8,4,100,2, 100.011,0)
26	ORDER TRAN SFERS (su b-file)
27	"BLD",1001 8,4,100,2, 100.011,1, 0)
28	^9.6411^.0 4^4
29	"BLD",1001 8,4,100,2, 100.011,1, .01,0)
30	TRANSFER D ATE/TIME
31	"BLD",1001 8,4,100,2, 100.011,1, .02,0)
32	TRANSFERRE D FROM
33	"BLD",1001 8,4,100,2, 100.011,1, .03,0)
34	TRANSFERRE D TO
35	"BLD",1001 8,4,100,2, 100.011,1, .04,0)
36	TRANSFER U SER
37	"BLD",1001 8,4,100,22 2)
38	y^n^p^^^^n ^^n
39	"BLD",1001 8,4,100,22 4)
40
41	"BLD",1001 8,4,"APDD" ,100,100.0 08)
42
43	"BLD",1001 8,4,"APDD" ,100,100.0 08,.01)
44
45	"BLD",1001 8,4,"APDD" ,100,100.0 08,3)
46
47	"BLD",1001 8,4,"APDD" ,100,100.0 11)
48
49	"BLD",1001 8,4,"APDD" ,100,100.0 11,.01)
50
51	"BLD",1001 8,4,"APDD" ,100,100.0 11,.02)
52
53	"BLD",1001 8,4,"APDD" ,100,100.0 11,.03)
54
55	"BLD",1001 8,4,"APDD" ,100,100.0 11,.04)
56
57	"BLD",1001 8,4,"B",10 0,100)
58
59	"BLD",1001 8,6.3)
60	4
61	"BLD",1001 8,"INID")
62	n^y
63	"BLD",1001 8,"INIT")
64	POST^OR3P4 53
65	"BLD",1001 8,"KRN",0)
66	^9.67PA^77 9.2^20
67	"BLD",1001 8,"KRN",.4 ,0)
68	.4
69	"BLD",1001 8,"KRN",.4 01,0)
70	.401
71	"BLD",1001 8,"KRN",.4 02,0)
72	.402
73	"BLD",1001 8,"KRN",.4 03,0)
74	.403
75	"BLD",1001 8,"KRN",.5 ,0)
76	.5
77	"BLD",1001 8,"KRN",.8 4,0)
78	.84
79	"BLD",1001 8,"KRN",3. 6,0)
80	3.6
81	"BLD",1001 8,"KRN",3. 8,0)
82	3.8
83	"BLD",1001 8,"KRN",9. 2,0)
84	9.2
85	"BLD",1001 8,"KRN",9. 8,0)
86	9.8
87	"BLD",1001 8,"KRN",9. 8,"NM",0)
88	^9.68A^6^6
89	"BLD",1001 8,"KRN",9. 8,"NM",1,0 )
90	ORB3^^0^B1 52335140
91	"BLD",1001 8,"KRN",9. 8,"NM",2,0 )
92	ORCSAVE^^0 ^B13445875 0
93	"BLD",1001 8,"KRN",9. 8,"NM",3,0 )
94	ORELR5^^0^ B27530747
95	"BLD",1001 8,"KRN",9. 8,"NM",4,0 )
96	ORQ2^^0^B9 4012922
97	"BLD",1001 8,"KRN",9. 8,"NM",5,0 )
98	ORQ3^^0^B2 4175232
99	"BLD",1001 8,"KRN",9. 8,"NM",6,0 )
100	OR3P453^^0 ^B18567612
101	"BLD",1001 8,"KRN",9. 8,"NM","B" ,"OR3P453" ,6)
102
103	"BLD",1001 8,"KRN",9. 8,"NM","B" ,"ORB3",1)
104
105	"BLD",1001 8,"KRN",9. 8,"NM","B" ,"ORCSAVE" ,2)
106
107	"BLD",1001 8,"KRN",9. 8,"NM","B" ,"ORELR5", 3)
108
109	"BLD",1001 8,"KRN",9. 8,"NM","B" ,"ORQ2",4)
110
111	"BLD",1001 8,"KRN",9. 8,"NM","B" ,"ORQ3",5)
112
113	"BLD",1001 8,"KRN",19 ,0)
114	19
115	"BLD",1001 8,"KRN",19 .1,0)
116	19.1
117	"BLD",1001 8,"KRN",10 1,0)
118	101
119	"BLD",1001 8,"KRN",40 9.61,0)
120	409.61
121	"BLD",1001 8,"KRN",77 1,0)
122	771
123	"BLD",1001 8,"KRN",77 9.2,0)
124	779.2
125	"BLD",1001 8,"KRN",87 0,0)
126	870
127	"BLD",1001 8,"KRN",89 89.51,0)
128	8989.51
129	"BLD",1001 8,"KRN",89 89.52,0)
130	8989.52
131	"BLD",1001 8,"KRN",89 94,0)
132	8994
133	"BLD",1001 8,"KRN",89 94,"NM",0)
134	^9.68A^2^2
135	"BLD",1001 8,"KRN",89 94,"NM",1, 0)
136	ORQ3 EN^^0
137	"BLD",1001 8,"KRN",89 94,"NM",2, 0)
138	ORQ3 XFER^ ^0
139	"BLD",1001 8,"KRN",89 94,"NM","B ","ORQ3 EN ",1)
140
141	"BLD",1001 8,"KRN",89 94,"NM","B ","ORQ3 XF ER",2)
142
143	"BLD",1001 8,"KRN","B ",.4,.4)
144
145	"BLD",1001 8,"KRN","B ",.401,.40 1)
146
147	"BLD",1001 8,"KRN","B ",.402,.40 2)
148
149	"BLD",1001 8,"KRN","B ",.403,.40 3)
150
151	"BLD",1001 8,"KRN","B ",.5,.5)
152
153	"BLD",1001 8,"KRN","B ",.84,.84)
154
155	"BLD",1001 8,"KRN","B ",3.6,3.6)
156
157	"BLD",1001 8,"KRN","B ",3.8,3.8)
158
159	"BLD",1001 8,"KRN","B ",9.2,9.2)
160
161	"BLD",1001 8,"KRN","B ",9.8,9.8)
162
163	"BLD",1001 8,"KRN","B ",19,19)
164
165	"BLD",1001 8,"KRN","B ",19.1,19. 1)
166
167	"BLD",1001 8,"KRN","B ",101,101)
168
169	"BLD",1001 8,"KRN","B ",409.61,4 09.61)
170
171	"BLD",1001 8,"KRN","B ",771,771)
172
173	"BLD",1001 8,"KRN","B ",779.2,77 9.2)
174
175	"BLD",1001 8,"KRN","B ",870,870)
176
177	"BLD",1001 8,"KRN","B ",8989.51, 8989.51)
178
179	"BLD",1001 8,"KRN","B ",8989.52, 8989.52)
180
181	"BLD",1001 8,"KRN","B ",8994,899 4)
182
183	"BLD",1001 8,"PRE")
184	OR3P453
185	"BLD",1001 8,"QDEF")
186	^^^^NO^^^^ NO^^NO
187	"BLD",1001 8,"QUES",0 )
188	^9.62^^
189	"BLD",1001 8,"REQB",0 )
190	^9.611^3^3
191	"BLD",1001 8,"REQB",1 ,0)
192	OR3.042^ 2
193	"BLD",1001 8,"REQB",2 ,0)
194	OR3.0377 ^2
195	"BLD",1001 8,"REQB",3 ,0)
196	OR3.0405 ^2
197	"BLD",1001 8,"REQB"," B","OR3.0 377",2)
198
199	"BLD",1001 8,"REQB"," B","OR3.0 405",3)
200
201	"BLD",1001 8,"REQB"," B","OR3.0 42",1)
202
203	"FIA",100)
204	ORDER
205	"FIA",100, 0)
206	^OR(100,
207	"FIA",100, 0,0)
208	100I
209	"FIA",100, 0,1)
210	y^n^p^^^^n ^^n
211	"FIA",100, 0,10)
212
213	"FIA",100, 0,11)
214
215	"FIA",100, 0,"RLRO")
216
217	"FIA",100, 0,"VR")
218	3.0^OR
219	"FIA",100, 100)
220	1
221	"FIA",100, 100,.8)
222
223	"FIA",100, 100,70)
224
225	"FIA",100, 100.008)
226	1
227	"FIA",100, 100.008,.0 1)
228
229	"FIA",100, 100.008,3)
230
231	"FIA",100, 100.011)
232	1
233	"FIA",100, 100.011,.0 1)
234
235	"FIA",100, 100.011,.0 2)
236
237	"FIA",100, 100.011,.0 3)
238
239	"FIA",100, 100.011,.0 4)
240
241	"INIT")
242	POST^OR3P4 53
243	"IX",100,1 00,"EPRACD T",0)
244	100^EPRACD T^Index on PROVIDER & ACTION D ATE/TIME f or Activit ies^R^^R^I R^W^100.00 8^^^^^LS
245	"IX",100,1 00,"EPRACD T",.1,0)
246	^^5^5^3170 620^
247	"IX",100,1 00,"EPRACD T",.1,1,0)
248	This index will be u sed as par t of the n ew ORQ3 EN Remote Pr ocedure Ca ll
249	"IX",100,1 00,"EPRACD T",.1,2,0)
250	to speedil y pick up all Orders for a spe cific Orde ring Provi der and
251	"IX",100,1 00,"EPRACD T",.1,3,0)
252	within a d ate range that has b een select ed by the end user s o that the
253	"IX",100,1 00,"EPRACD T",.1,4,0)
254	Orders tha t come up can be Re- Assigned ( Transferre d) to one or more Ne w
255	"IX",100,1 00,"EPRACD T",.1,5,0)
256	Providers.
257	"IX",100,1 00,"EPRACD T",1)
258	S ^OR(100, "EPRACDT", X(1),X(2), DA(1),DA)= ""
259	"IX",100,1 00,"EPRACD T",2)
260	K ^OR(100, "EPRACDT", X(1),X(2), DA(1),DA)
261	"IX",100,1 00,"EPRACD T",2.5)
262	K ^OR(100, "EPRACDT")
263	"IX",100,1 00,"EPRACD T",11.1,0)
264	^.114IA^2^ 2
265	"IX",100,1 00,"EPRACD T",11.1,1, 0)
266	1^F^100.00 8^3^^1^F
267	"IX",100,1 00,"EPRACD T",11.1,2, 0)
268	2^F^100.00 8^.01^^2^F
269	"IX",100,1 00,"EPRTRD T",0)
270	100^EPRTRD T^Index on TRANSFERR ED TO Prov ider and T RANSFER DA TE/TIME^R^ ^R^IR^W^10 0.011^^^^^ LS
271	"IX",100,1 00,"EPRTRD T",.1,0)
272	^^8^8^3170 621^
273	"IX",100,1 00,"EPRTRD T",.1,1,0)
274	This index will be u sed as par t of the n ew ORQ3 EN Remote Pr ocedure Ca ll
275	"IX",100,1 00,"EPRTRD T",.1,2,0)
276	to speedil y pick up all Orders which hav e already been trans ferred
277	"IX",100,1 00,"EPRTRD T",.1,3,0)
278	from the o riginal Or dering Pro vider to o ne or more New Provi ders in th e
279	"IX",100,1 00,"EPRTRD T",.1,4,0)
280	case where a New Pro vider also happens t o need his or her Or ders
281	"IX",100,1 00,"EPRTRD T",.1,5,0)
282	transferre d to a thi rd New Pro vider, the n this ind ex can the n be
283	"IX",100,1 00,"EPRTRD T",.1,6,0)
284	conducive to this ty pe of scen ario. It works simi lar to EPR ACDT Index
285	"IX",100,1 00,"EPRTRD T",.1,7,0)
286	but will u tilize TRA NSFERRED T O Provider & TRANSFE R DATE/TIM E to quick ly
287	"IX",100,1 00,"EPRTRD T",.1,8,0)
288	bring up O rders for additional Re-Assign ment (Tran sfer).
289	"IX",100,1 00,"EPRTRD T",1)
290	S ^OR(100, "EPRTRDT", X(1),X(2), DA(1),DA)= ""
291	"IX",100,1 00,"EPRTRD T",2)
292	K ^OR(100, "EPRTRDT", X(1),X(2), DA(1),DA)
293	"IX",100,1 00,"EPRTRD T",2.5)
294	K ^OR(100, "EPRTRDT")
295	"IX",100,1 00,"EPRTRD T",11.1,0)
296	^.114IA^2^ 2
297	"IX",100,1 00,"EPRTRD T",11.1,1, 0)
298	1^F^100.01 1^.03^^1^F
299	"IX",100,1 00,"EPRTRD T",11.1,2, 0)
300	2^F^100.01 1^.01^^2^F
301	"KRN",8994 ,3756,-1)
302	0^1
303	"KRN",8994 ,3756,0)
304	ORQ3 EN^EN ^ORQ3^4^^^ ^1^^^1
305	"KRN",8994 ,3756,1,0)
306	^^6^6^3170 516^
307	"KRN",8994 ,3756,1,1, 0)
308	This RPC c all will g enerate a list sorte d by Patie nt Name, P atient IEN ,
309	"KRN",8994 ,3756,1,2, 0)
310	and Order IEN based on all Ord ers for a particular PROVIDER at the
311	"KRN",8994 ,3756,1,3, 0)
312	ORDER ACTI ONS level where the Activity D ate/Time i s within t he date
313	"KRN",8994 ,3756,1,4, 0)
314	range pass ed in. Th e list wil l also con tain the O rder Statu s and Date
315	"KRN",8994 ,3756,1,5, 0)
316	Order Ente red In. P arameters it accepts are Provi der IEN fr om File
317	"KRN",8994 ,3756,1,6, 0)
318	#200 along with Begi n Date and End Date in FileMan format.
319	"KRN",8994 ,3756,2,0)
320	^8994.02A^ 3^3
321	"KRN",8994 ,3756,2,1, 0)
322	ORPRIEN^1^ ^1^1
323	"KRN",8994 ,3756,2,1, 1,0)
324	^^1^1^3170 516^
325	"KRN",8994 ,3756,2,1, 1,1,0)
326	This is th e Provider IEN that gets passe d in.
327	"KRN",8994 ,3756,2,2, 0)
328	ORDT1^1^^1 ^2
329	"KRN",8994 ,3756,2,2, 1,0)
330	^^1^1^3170 516^
331	"KRN",8994 ,3756,2,2, 1,1,0)
332	This is th e Starting Date that gets pass ed in.
333	"KRN",8994 ,3756,2,3, 0)
334	ORDT2^1^^1 ^3
335	"KRN",8994 ,3756,2,3, 1,0)
336	^^1^1^3170 516^
337	"KRN",8994 ,3756,2,3, 1,1,0)
338	This is th e Ending D ate that g ets passed in.
339	"KRN",8994 ,3756,2,"B ","ORDT1", 2)
340
341	"KRN",8994 ,3756,2,"B ","ORDT2", 3)
342
343	"KRN",8994 ,3756,2,"B ","ORPRIEN ",1)
344
345	"KRN",8994 ,3756,2,"P ARAMSEQ",1 ,1)
346
347	"KRN",8994 ,3756,2,"P ARAMSEQ",2 ,2)
348
349	"KRN",8994 ,3756,2,"P ARAMSEQ",3 ,3)
350
351	"KRN",8994 ,3756,3,0)
352	^^4^4^3170 516^
353	"KRN",8994 ,3756,3,1, 0)
354	This retur ns a list of Patient Names, Pa tient IENs , and Orde r IENs
355	"KRN",8994 ,3756,3,2, 0)
356	along with Order Sta tus and Da te When Or der Entere d In, e.g. :
357	"KRN",8994 ,3756,3,3, 0)
358	^TMP("O RPATORD",$ J,1)=<Pati ent Name>^ <Patient I EN>^<Order IEN>^
359	"KRN",8994 ,3756,3,4, 0)
360	<Orde r Status>^ <Date When Order Ent ered In>
361	"KRN",8994 ,3757,-1)
362	0^2
363	"KRN",8994 ,3757,0)
364	ORQ3 XFER^ XFER^ORQ3^ 4^^^^1^^^1
365	"KRN",8994 ,3757,1,0)
366	^^7^7^3170 516^
367	"KRN",8994 ,3757,1,1, 0)
368	This RPC c all will t ake a list of Order IENs along with Tran sferring F rom
369	"KRN",8994 ,3757,1,2, 0)
370	Provider, Transferri ng To Prov ider, Tran sferring U ser & Tran sfer Date/ Time
371	"KRN",8994 ,3757,1,3, 0)
372	and will c reate an e ntry in th e ORDER TR ANSFERS Mu ltiple whi ch holds
373	"KRN",8994 ,3757,1,4, 0)
374	the four T ransfer re lated fiel ds just me ntioned.
375	"KRN",8994 ,3757,1,5, 0)
376
377	"KRN",8994 ,3757,1,6, 0)
378	It should return a l ist of Ord er IENs wi th a 0 for Unsuccess ful or a 1 for
379	"KRN",8994 ,3757,1,7, 0)
380	Successful . If 0, t hen an Err or Messaag e will be returned a lso.
381	"KRN",8994 ,3757,2,0)
382	^8994.02A^ 1^1
383	"KRN",8994 ,3757,2,1, 0)
384	LST^2^^1^1
385	"KRN",8994 ,3757,2,1, 1,0)
386	^^2^2^3170 516^
387	"KRN",8994 ,3757,2,1, 1,1,0)
388	This is th e list of Order IENs , Transfer ring From Providers, Transferr ing
389	"KRN",8994 ,3757,2,1, 1,2,0)
390	To Provide rs, Transf erring Use rs and Tra nsfer Date /Times.
391	"KRN",8994 ,3757,2,"B ","LST",1)
392
393	"KRN",8994 ,3757,2,"P ARAMSEQ",1 ,1)
394
395	"KRN",8994 ,3757,3,0)
396	^^3^3^3170 516^
397	"KRN",8994 ,3757,3,1, 0)
398	This retur ns a list of Order I ENs, Succe ss or Fail ure Flag & optionall y
399	"KRN",8994 ,3757,3,2, 0)
400	Error Mess age, e.g.:
401	"KRN",8994 ,3757,3,3, 0)
402	^TMP("OR ORDRTN",$J )=<Order I EN>^1 or 0 ^Error Mes sage (opti onally)
403	"MBREQ")
404	0
405	"ORD",16,8 994)
406	8994;16;1; ;;;;;;RPCD EL^XPDIA1
407	"ORD",16,8 994,0)
408	REMOTE PRO CEDURE
409	"PKG",170, -1)
410	1^1
411	"PKG",170, 0)
412	ORDER ENTR Y/RESULTS REPORTING^ OR^Order E ntry/Resul ts Reporti ng
413	"PKG",170, 20,0)
414	^9.402P^^
415	"PKG",170, 22,0)
416	^9.49I^1^1
417	"PKG",170, 22,1,0)
418	3.0^297121 7^2980917^ 11712
419	"PKG",170, 22,1,"PAH" ,1,0)
420	453^317071 7
421	"PRE")
422	OR3P453
423	"QUES","XP F1",0)
424	Y
425	"QUES","XP F1","??")
426	^D REP^XPD H
427	"QUES","XP F1","A")
428	Shall I wr ite over y our \|FLAG\| File
429	"QUES","XP F1","B")
430	YES
431	"QUES","XP F1","M")
432	D XPF1^XPD IQ
433	"QUES","XP F2",0)
434	Y
435	"QUES","XP F2","??")
436	^D DTA^XPD H
437	"QUES","XP F2","A")
438	Want my da ta \|FLAG\| yours
439	"QUES","XP F2","B")
440	YES
441	"QUES","XP F2","M")
442	D XPF2^XPD IQ
443	"QUES","XP I1",0)
444	YO
445	"QUES","XP I1","??")
446	^D INHIBIT ^XPDH
447	"QUES","XP I1","A")
448	Want KIDS to INHIBIT LOGONs du ring the i nstall
449	"QUES","XP I1","B")
450	NO
451	"QUES","XP I1","M")
452	D XPI1^XPD IQ
453	"QUES","XP M1",0)
454	PO^VA(200, :EM
455	"QUES","XP M1","??")
456	^D MG^XPDH
457	"QUES","XP M1","A")
458	Enter the Coordinato r for Mail Group '\|F LAG\|'
459	"QUES","XP M1","B")
460
461	"QUES","XP M1","M")
462	D XPM1^XPD IQ
463	"QUES","XP O1",0)
464	Y
465	"QUES","XP O1","??")
466	^D MENU^XP DH
467	"QUES","XP O1","A")
468	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
469	"QUES","XP O1","B")
470	NO
471	"QUES","XP O1","M")
472	D XPO1^XPD IQ
473	"QUES","XP Z1",0)
474	Y
475	"QUES","XP Z1","??")
476	^D OPT^XPD H
477	"QUES","XP Z1","A")
478	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
479	"QUES","XP Z1","B")
480	NO
481	"QUES","XP Z1","M")
482	D XPZ1^XPD IQ
483	"QUES","XP Z2",0)
484	Y
485	"QUES","XP Z2","??")
486	^D RTN^XPD H
487	"QUES","XP Z2","A")
488	Want to MO VE routine s to other CPUs
489	"QUES","XP Z2","B")
490	NO
491	"QUES","XP Z2","M")
492	D XPZ2^XPD IQ
493	"RTN")
494	6
495	"RTN","OR3 P453")
496	0^6^B18567 612^n/a
497	"RTN","OR3 P453",1,0)
498	OR3P453 ;S LC/RBD Pos t Install 453 ;07/14 /17 10:52
499	"RTN","OR3 P453",2,0)
500	;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;4 53;Dec 1 7, 1997;Bu ild 4
501	"RTN","OR3 P453",3,0)
502	;
503	"RTN","OR3 P453",4,0)
504	ENV ; ensu re that us er underst ands what is about t o happen w ith creati on
505	"RTN","OR3 P453",5,0)
506	; of New Style cros s referenc e.
507	"RTN","OR3 P453",6,0)
508	N DIR,DIR UT,DTOUT,D UOUT,Y
509	"RTN","OR3 P453",7,0)
510	S XPDABOR T=""
511	"RTN","OR3 P453",8,0)
512	W !!,$C(7 ),"**** Creation o f New Styl e 'EPRACDT ' Cross Re ference ****",!
513	"RTN","OR3 P453",9,0)
514	W !,"This will loop through t he ORDER A CTIONS Mul tiple of t he entire ORDER"
515	"RTN","OR3 P453",10,0 )
516	W !,"File (#100) an d create t he 'EPRACD T' New Sty le Cross R eference b ased"
517	"RTN","OR3 P453",11,0 )
518	W !,"on t he PROVIDE R & DATE/T IME ORDERE D sub-fiel ds.",!
519	"RTN","OR3 P453",12,0 )
520	W !,"WARN ING: Once you agree to create this, you should let it run un til"
521	"RTN","OR3 P453",13,0 )
522	W !,"it h as finishe d complete ly !!",!
523	"RTN","OR3 P453",14,0 )
524	S DIR("A" )="Are you sure you want to do this"
525	"RTN","OR3 P453",15,0 )
526	S DIR("A" ,1)="You a re about t o create t he index w hich could take quit e awhile."
527	"RTN","OR3 P453",16,0 )
528	S DIR("B" )="NO"
529	"RTN","OR3 P453",17,0 )
530	S DIR(0)= "Y"
531	"RTN","OR3 P453",18,0 )
532	D ^DIR
533	"RTN","OR3 P453",19,0 )
534	I $D(DIRU T)!$D(DTOU T)!$D(DUOU T)!(Y'=1) W !!,"Ok, I am stopp ing the in stall." S XPDABORT=1 Q
535	"RTN","OR3 P453",20,0 )
536	E W !,"O k, let's c ontinue!", !
537	"RTN","OR3 P453",21,0 )
538	I XPDABOR T="" K XPD ABORT
539	"RTN","OR3 P453",22,0 )
540	Q
541	"RTN","OR3 P453",23,0 )
542	;
543	"RTN","OR3 P453",24,0 )
544	POST ; Pos t-Install for OR3.0 453
545	"RTN","OR3 P453",25,0 )
546	; This wi ll assist with EPRAC DT cross r eference c reation al ong with
547	"RTN","OR3 P453",26,0 )
548	; Creatio n of new E PRACDT Ind ices
549	"RTN","OR3 P453",27,0 )
550	N ORMSG
551	"RTN","OR3 P453",28,0 )
552	S ORMSG(1 )="This pa tch will c reate a ne w New Styl e cross re ference"
553	"RTN","OR3 P453",29,0 )
554	S ORMSG(2 )="called 'EPRACDT' which will be at the ORDER fil e level"
555	"RTN","OR3 P453",30,0 )
556	S ORMSG(3 )="but on PROVIDER & DATE/TIME ORDERED s ub-fields of the"
557	"RTN","OR3 P453",31,0 )
558	S ORMSG(4 )="ORDER A CTIONS Mul tiple."
559	"RTN","OR3 P453",32,0 )
560	S ORMSG(5 )=" "
561	"RTN","OR3 P453",33,0 )
562	S ORMSG(6 )="Creatio n of 'EPRA CDT' will now go for ward in th e"
563	"RTN","OR3 P453",34,0 )
564	S ORMSG(7 )="Backgro und."
565	"RTN","OR3 P453",35,0 )
566	S ORMSG(8 )=" "
567	"RTN","OR3 P453",36,0 )
568	S ORMSG(9 )="You wil l be given a TaskMan task # to check on or,"
569	"RTN","OR3 P453",37,0 )
570	S ORMSG(1 0)="altern ately, you can check your mail on MailMa n for a"
571	"RTN","OR3 P453",38,0 )
572	S ORMSG(1 1)="messag e expressi ng Complet ion of thi s Task wit h"
573	"RTN","OR3 P453",39,0 )
574	S ORMSG(1 2)="approp riate deta ils."
575	"RTN","OR3 P453",40,0 )
576	S ORMSG(1 3)=" "
577	"RTN","OR3 P453",41,0 )
578	S ORMSG(1 4)="Note I nstall of this Patch cannot be considere d"
579	"RTN","OR3 P453",42,0 )
580	S ORMSG(1 5)="Comple te unless and until this Task is Complet ed."
581	"RTN","OR3 P453",43,0 )
582	S ORMSG(1 6)=" "
583	"RTN","OR3 P453",44,0 )
584	D BMES^XP DUTL(.ORMS G)
585	"RTN","OR3 P453",45,0 )
586	I $D(^XTM P("OR3P453 ","START") ) D
587	"RTN","OR3 P453",46,0 )
588	. D MES^X PDUTL("Tas k to Creat e 'EPRACDT ' Already Begun "_$$ HTE^XLFDT( ^XTMP("OR3 P453","STA RT"))_".")
589	"RTN","OR3 P453",47,0 )
590	. D MES^X PDUTL("")
591	"RTN","OR3 P453",48,0 )
592	I $D(^XTM P("OR3P453 ","FINISH" )) D Q
593	"RTN","OR3 P453",49,0 )
594	. D MES^X PDUTL("... and Comple ted "_$$HT E^XLFDT(^X TMP("OR3P4 53","FINIS H"))_".")
595	"RTN","OR3 P453",50,0 )
596	. D MES^X PDUTL("")
597	"RTN","OR3 P453",51,0 )
598	Q:$D(^XTM P("OR3P453 "))
599	"RTN","OR3 P453",52,0 )
600	S ZTRTN=" SETXREF^OR 3P453",ZTI O="",ZTDTH =$H
601	"RTN","OR3 P453",53,0 )
602	S ZTDESC= "Creation of New Sty le X-Ref ' EPRACDT' i n ORDER fi le" D ^%ZT LOAD
603	"RTN","OR3 P453",54,0 )
604	I $G(ZTSK ) D MES^XP DUTL("Task #"_ZTSK_" queued to start "_$ $HTE^XLFDT ($G(ZTSK(" D")))) I 1
605	"RTN","OR3 P453",55,0 )
606	E D MES^ XPDUTL(" * UNABLE TO QUEUE CREATION O F 'EPRACDT ' ORDER FI LE X-REF * ****")
607	"RTN","OR3 P453",56,0 )
608	K ZTRTN,Z TIO,ZTDTH, ZTDESC,ZTS K
609	"RTN","OR3 P453",57,0 )
610	Q
611	"RTN","OR3 P453",58,0 )
612	;
613	"RTN","OR3 P453",59,0 )
614	SETXREF ; Set new EP RACDT New Style cros s referenc e for old data
615	"RTN","OR3 P453",60,0 )
616	N DA,DIK, ORIEN,XTMP CNT,XTMPMS G,ZTREQ
617	"RTN","OR3 P453",61,0 )
618	K ^XTMP(" OR3P453")
619	"RTN","OR3 P453",62,0 )
620	S ^XTMP(" OR3P453",0 )=$$FMADD^ XLFDT($$DT ^XLFDT(),9 0)
621	"RTN","OR3 P453",63,0 )
622	S ^XTMP(" OR3P453"," START")=$H
623	"RTN","OR3 P453",64,0 )
624	S XTMPCNT =0
625	"RTN","OR3 P453",65,0 )
626	S XTMPCNT =XTMPCNT+1
627	"RTN","OR3 P453",66,0 )
628	S XTMPMSG ="Creation of 'EPRAC DT' X-Ref for ORDER file Start ed "
629	"RTN","OR3 P453",67,0 )
630	S XTMPMSG =XTMPMSG_$ $HTE^XLFDT (^XTMP("OR 3P453","ST ART"))_"."
631	"RTN","OR3 P453",68,0 )
632	S ^XTMP(" OR3P453",X TMPCNT)=XT MPMSG
633	"RTN","OR3 P453",69,0 )
634	S XTMPCNT =XTMPCNT+1 ,^XTMP("OR 3P453",XTM PCNT)=" "
635	"RTN","OR3 P453",70,0 )
636	K ^OR(100 ,"EPRACDT" )
637	"RTN","OR3 P453",71,0 )
638	S ORIEN=0
639	"RTN","OR3 P453",72,0 )
640	F S ORIE N=$O(^OR(1 00,ORIEN)) Q:'ORIEN D
641	"RTN","OR3 P453",73,0 )
642	. S DIK=" ^OR(100,"_ ORIEN_",8, ",DIK(1)=" .01^EPRACD T",DA(1)=O RIEN D ENA LL^DIK
643	"RTN","OR3 P453",74,0 )
644	S XTMPMSG ="Creation of 'EPRAC DT' X-Ref Completed. "
645	"RTN","OR3 P453",75,0 )
646	S XTMPCNT =XTMPCNT+1 ,^XTMP("OR 3P453",XTM PCNT)=XTMP MSG
647	"RTN","OR3 P453",76,0 )
648	S XTMPCNT =XTMPCNT+1 ,^XTMP("OR 3P453",XTM PCNT)=" "
649	"RTN","OR3 P453",77,0 )
650	S ^XTMP(" OR3P453"," FINISH")=$ H
651	"RTN","OR3 P453",78,0 )
652	S XTMPMSG ="Backgrou nd Task Fi nished "
653	"RTN","OR3 P453",79,0 )
654	S XTMPMSG =XTMPMSG_$ $HTE^XLFDT (^XTMP("OR 3P453","FI NISH"))_". "
655	"RTN","OR3 P453",80,0 )
656	S XTMPCNT =XTMPCNT+1 ,^XTMP("OR 3P453",XTM PCNT)=XTMP MSG
657	"RTN","OR3 P453",81,0 )
658	;
659	"RTN","OR3 P453",82,0 )
660	; Send Ma il to inst aller to n otify of c ompletion
661	"RTN","OR3 P453",83,0 )
662	S XMSUB=" OR3.0453 post inst all has ru n to compl etion."
663	"RTN","OR3 P453",84,0 )
664	S XMDUZ=" Patch OR3 .0453"
665	"RTN","OR3 P453",85,0 )
666	S XTMPCNT =0
667	"RTN","OR3 P453",86,0 )
668	XRFLOOP S XTMPCNT=$O (^XTMP("OR 3P453",XTM PCNT)) G:X TMPCNT'?1N .N FIN
669	"RTN","OR3 P453",87,0 )
670	S ^TMP($J ,"OR3P453" ,XTMPCNT,0 )=^XTMP("O R3P453",XT MPCNT)
671	"RTN","OR3 P453",88,0 )
672	G XRFLOOP
673	"RTN","OR3 P453",89,0 )
674	;
675	"RTN","OR3 P453",90,0 )
676	FIN S XMTE XT="^TMP($ J,""OR3P45 3"","
677	"RTN","OR3 P453",91,0 )
678	S XMY(DUZ )="" D ^XM D K ^TMP($ J,"OR3P453 ") S ZTREQ ="@"
679	"RTN","OR3 P453",92,0 )
680	K XMDUZ,X MSUB,XMTEX T,XMY
681	"RTN","OR3 P453",93,0 )
682	Q
683	"RTN","OR3 P453",94,0 )
684	;
685	"RTN","ORB 3")
686	0^1^B15233 5140^B1402 13780
687	"RTN","ORB 3",1,0)
688	ORB3 ;SLC/ CLA,WAT,TC - MAIN RO UTINE FOR OE/RR 3 NO TIFICATION S;10/04/16 11:08 ;0 6/26/17 0 9:24
689	"RTN","ORB 3",2,0)
690	;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;3 1,74,91,10 5,139,190, 220,253,26 5,296,348, 350,377,45 3;Dec 17 , 1997;Bui ld 4
691	"RTN","ORB 3",3,0)
692	;;Per VHA Directive 2004-038, this rout ine should not be mo dified.
693	"RTN","ORB 3",4,0)
694	;
695	"RTN","ORB 3",5,0)
696	;This rou tine invok es to foll owing ICR( s):
697	"RTN","ORB 3",6,0)
698	;ICR 4156 ;REGI STRATION, COMBAT VET ERAN STATU S
699	"RTN","ORB 3",7,0)
700	;ICR 5697 ;SCHE DULING, PC MM MHTC AP I's
701	"RTN","ORB 3",8,0)
702	;
703	"RTN","ORB 3",9,0)
704	EN(ORN,ORB DFN,ORNUM, ORBADUZ,OR BPMSG,ORBP DATA) ;
705	"RTN","ORB 3",10,0)
706	;
707	"RTN","ORB 3",11,0)
708	N ORBENT
709	"RTN","ORB 3",12,0)
710	S ORN=+$G (ORN)
711	"RTN","ORB 3",13,0)
712	S ORBENT= $$ENTITY^O RB31($G(OR NUM))
713	"RTN","ORB 3",14,0)
714	;
715	"RTN","ORB 3",15,0)
716	Q:$$GET^X PAR(ORBENT ,"ORB SYST EM ENABLE/ DISABLE",1 ,"I")="D"
717	"RTN","ORB 3",16,0)
718	Q:'$L($G( ^ORD(100.9 ,ORN,0)))
719	"RTN","ORB 3",17,0)
720	Q:+$$ONOF F^ORB3FN(O RN)=0
721	"RTN","ORB 3",18,0)
722	;
723	"RTN","ORB 3",19,0)
724	;add hook for smart
725	"RTN","ORB 3",20,0)
726	N ORHOOK S ORHOOK=$ $HOOK^ORBS MART(ORN,$ G(ORBDFN), $G(ORNUM), .ORBADUZ,$ G(ORBPMSG) ,$G(ORBPDA TA))
727	"RTN","ORB 3",21,0)
728	Q:ORHOOK
729	"RTN","ORB 3",22,0)
730	;
731	"RTN","ORB 3",23,0)
732	;if msg f rom notif file or oc notif (#5 4), quit i f dup w/in past 1 mi n:
733	"RTN","ORB 3",24,0)
734	N ORBDUP, ORBN
735	"RTN","ORB 3",25,0)
736	S ORBN=^O RD(100.9,O RN,0)
737	"RTN","ORB 3",26,0)
738	I ($P(ORB N,U,4)="NO T")!(ORN=5 4) D
739	"RTN","ORB 3",27,0)
740	.S ORBDUP =$$DUP^ORB 31(ORN,$G( ORBDFN),$G (ORBPMSG), $G(ORNUM))
741	"RTN","ORB 3",28,0)
742	Q:+$G(ORB DUP)=1
743	"RTN","ORB 3",29,0)
744	;
745	"RTN","ORB 3",30,0)
746	N ORBDESC
747	"RTN","ORB 3",31,0)
748	S ORBDESC =" Send Al ert Notifi cation ("_ (+ORN)_") "_$P($G(^O RD(100.9,+ ORN,0)),U, 1)_" "
749	"RTN","ORB 3",32,0)
750	;
751	"RTN","ORB 3",33,0)
752	N ORQUD S ORQUD=0
753	"RTN","ORB 3",34,0)
754	I ORN=90 D START S ORQUD=1
755	"RTN","ORB 3",35,0)
756	I ORQUD=0 D QUEUE^O RB31(ORN,$ G(ORBDFN), $G(ORNUM), .ORBADUZ,$ G(ORBPMSG) ,$G(ORBPDA TA),$H,ORB DESC,$G(DG PMA))
757	"RTN","ORB 3",36,0)
758	Q
759	"RTN","ORB 3",37,0)
760	ZTSK ;
761	"RTN","ORB 3",38,0)
762	D START
763	"RTN","ORB 3",39,0)
764	S ZTREQ=" @"
765	"RTN","ORB 3",40,0)
766	Q
767	"RTN","ORB 3",41,0)
768	UTL(ORBU,O RN,ORBDFN, ORNUM,ORBA DUZ,ORBPMS G,ORBPDATA ) ;
769	"RTN","ORB 3",42,0)
770	Q:$G(ORBU )'=1
771	"RTN","ORB 3",43,0)
772	START Q:$G (ORN)=""!( $G(ORBDFN) ="")
773	"RTN","ORB 3",44,0)
774	Q:'$L($G( ^ORD(100.9 ,ORN,0)))
775	"RTN","ORB 3",45,0)
776	N ORBNOW, ORBID,ORBL OCK,ORBDES C
777	"RTN","ORB 3",46,0)
778	S ORBNOW= $$NOW^XLFD T
779	"RTN","ORB 3",47,0)
780	S ORBLOCK =0
781	"RTN","ORB 3",48,0)
782	;
783	"RTN","ORB 3",49,0)
784	;lock to prevent co ncurrent p rocessing by other r esource sl ots:
785	"RTN","ORB 3",50,0)
786	I '$D(ORB U) D
787	"RTN","ORB 3",51,0)
788	.S ^XTMP( "ORBLOCK", 0)=$$FMADD ^XLFDT(ORB NOW,1,""," ","")_U_OR BNOW
789	"RTN","ORB 3",52,0)
790	.S ORBID= $P($P($G(O RBPDATA)," \|",2),"@") ;get uni que data i d
791	"RTN","ORB 3",53,0)
792	.I $L(ORB ID) D
793	"RTN","ORB 3",54,0)
794	..LOCK +^ XTMP("ORBL OCK",ORBDF N,ORN,ORBI D):60 E D Q
795	"RTN","ORB 3",55,0)
796	...S ORBD ESC=" Requ eue Alert Notificati on ("_(+OR N)_") "_$P ($G(^ORD(1 00.9,+ORN, 0)),U,1)_" "
797	"RTN","ORB 3",56,0)
798	...D QUEU E^ORB31(OR N,ORBDFN,$ G(ORNUM),. ORBADUZ,$G (ORBPMSG), $G(ORBPDAT A),$$HADD^ XLFDT($H," ","",5,"") ,ORBDESC,$ G(DGPMA)) ;requeue i n 5 min.
799	"RTN","ORB 3",57,0)
800	...S ORBL OCK=1
801	"RTN","ORB 3",58,0)
802	.;
803	"RTN","ORB 3",59,0)
804	.I '$L(OR BID) D
805	"RTN","ORB 3",60,0)
806	..LOCK +^ XTMP("ORBL OCK",ORBDF N,ORN):60 E D Q
807	"RTN","ORB 3",61,0)
808	...S ORBD ESC=" Requ eue Alert Notificati on ("_(+OR N)_") "_$P ($G(^ORD(1 00.9,+ORN, 0)),U,1)_" "
809	"RTN","ORB 3",62,0)
810	...D QUEU E^ORB31(OR N,ORBDFN,$ G(ORNUM),. ORBADUZ,$G (ORBPMSG), $G(ORBPDAT A),$$HADD^ XLFDT($H," ","",5,"") ,ORBDESC,$ G(DGPMA)) ;requeue i n 5 min.
811	"RTN","ORB 3",63,0)
812	...S ORBL OCK=1
813	"RTN","ORB 3",64,0)
814	.;
815	"RTN","ORB 3",65,0)
816	I ORBLOCK =1 D QUIT Q
817	"RTN","ORB 3",66,0)
818	;
819	"RTN","ORB 3",67,0)
820	DOALERT ; Entry poin t for aler t logic ou tside of T askMan
821	"RTN","ORB 3",68,0)
822	N ORBDUZ, ORBN,ORBXQ AID,ORPTNA M,ORBPRIM, ORBATTD,OR BDEV,ORBEN T
823	"RTN","ORB 3",69,0)
824	N ORBUI,O RBASPEC,OR BSMSG,ORBA DT,ORBSDEV ,ORBDEL,OR BDI,ORBTDE V,ORY
825	"RTN","ORB 3",70,0)
826	N ORBIDX, ORBFLAGS
827	"RTN","ORB 3",71,0)
828	S ORBUI=1 ,ORBADT=0
829	"RTN","ORB 3",72,0)
830	S:'$L($G( ORBPMSG)) ORBPMSG=""
831	"RTN","ORB 3",73,0)
832	I '$L(ORB PDATA),(+$ G(ORNUM)>0 ) S ORBPDA TA=+$G(ORN UM)_"@"
833	"RTN","ORB 3",74,0)
834	S ORBN=^O RD(100.9,O RN,0)
835	"RTN","ORB 3",75,0)
836	S ORBIDX= 0 F S ORB IDX=$O(^OR D(100.9,OR N,5,ORBIDX )) Q:'ORBI DX D
837	"RTN","ORB 3",76,0)
838	.S ORBFLA GS=$P($G(^ ORD(100.9, ORN,5,ORBI DX,0)),U)
839	"RTN","ORB 3",77,0)
840	.S:ORBFLA GS'="" ORB FLAGS(ORBF LAGS)="",O RBFLAGS=""
841	"RTN","ORB 3",78,0)
842	;
843	"RTN","ORB 3",79,0)
844	S ORBENT= $$ENTITY^O RB31(ORNUM )
845	"RTN","ORB 3",80,0)
846	;
847	"RTN","ORB 3",81,0)
848	N DFN S D FN=ORBDFN, VA200="" D OERR^VADP T
849	"RTN","ORB 3",82,0)
850	I ('$L($G (VA("BID") )))!('$L($ G(VADM(1)) )) D QUIT Q
851	"RTN","ORB 3",83,0)
852	I (ORN=18 )!(ORN=20) !(ORN=35) S ORBADT=1 ;A/D/T no tif
853	"RTN","ORB 3",84,0)
854	;if not a n A/D/T no tif, get p rimary & a ttending f rom OERR^V ADPT:
855	"RTN","ORB 3",85,0)
856	I ORBADT= 0 S ORBPRI M=+$P(VAIN (2),U),ORB ATTD=+$P(V AIN(11),U)
857	"RTN","ORB 3",86,0)
858	I ORBADT= 1 D ADT^OR B31(ORN,OR BDFN,.ORBP RIM,.ORBAT TD,$G(ORDG PMA)) ;A/D /T notif
859	"RTN","ORB 3",87,0)
860	I $D(ORBU ) D ;crea te debug m sg
861	"RTN","ORB 3",88,0)
862	.S ORBU(O RBUI)="Pro cessing no tification : "_$P(ORB N,U),ORBUI =ORBUI+1
863	"RTN","ORB 3",89,0)
864	.S ORBU(O RBUI)=" f or patient : "_VADM(1 ),ORBUI=OR BUI+1
865	"RTN","ORB 3",90,0)
866	.I $G(ORN UM)>0 S OR BU(ORBUI)= " for o rder: "_OR NUM,ORBUI= ORBUI+1
867	"RTN","ORB 3",91,0)
868	D REGULAR ^ORB3REG(O RN,.XQA,.O RBU,.ORBUI ,.ORBDEV,O RBDFN)
869	"RTN","ORB 3",92,0)
870	D SPECIAL ^ORB3SPEC( ORN,.ORBAS PEC,.ORBU, .ORBUI,$G( ORNUM),ORB DFN,$G(ORB PDATA),.OR BSMSG,$G(O RBPMSG),.O RBSDEV,$G( ORBPRIM),$ G(ORBATTD) )
871	"RTN","ORB 3",93,0)
872	I $D(ORBA SPEC)>1 D SPECDUZS ; special re cips
873	"RTN","ORB 3",94,0)
874	I $D(ORBA DUZ)>1 D P KGDUZS ;pk g-supplied recips
875	"RTN","ORB 3",95,0)
876	D TITLE ; provider r ecips
877	"RTN","ORB 3",96,0)
878	S ORBXQAI D=$P(ORBN, U,2)_","_O RBDFN_","_ ORN
879	"RTN","ORB 3",97,0)
880	;
881	"RTN","ORB 3",98,0)
882	I ($D(XQA )>1)!($D(O RBDEV)>1)! ($D(ORBSDE V)>1) D ; recips fou nd
883	"RTN","ORB 3",99,0)
884	.S XQAFLG =$P(ORBN,U ,5)
885	"RTN","ORB 3",100,0)
886	.S XQADFN =ORBDFN
887	"RTN","ORB 3",101,0)
888	.I XQAFLG ="R" S XQA ROU=$P(ORB N,U,6)_U_$ P(ORBN,U,7 )
889	"RTN","ORB 3",102,0)
890	.I $G(ORB PDATA)'="" S XQADATA =ORBPDATA
891	"RTN","ORB 3",103,0)
892	.S ORPTNA M=$E(VADM( 1)_" ",1,9)
893	"RTN","ORB 3",104,0)
894	.I $G(ORN )=27 N CVM RKR,RSLT S RSLT=$$CV EDT^DGCV(D FN) I $P($ G(RSLT),U) &($P($G(RS LT),U,3)) S CVMRKR=" CV "_$$FM TE^XLFDT($ P($G(RSLT) ,U,2),"5DZ ") ;WAT
895	"RTN","ORB 3",105,0)
896	.S XQAMSG =ORPTNAM_" ("_$E(ORP TNAM)_$E(V A("BID"),1 ,4)_")"_$G (CVMRKR)_" : " ;WAT
897	"RTN","ORB 3",106,0)
898	.S XQAMSG =XQAMSG_$S (ORBPMSG'= "":ORBPMSG ,1:$P(ORBN ,U,3))
899	"RTN","ORB 3",107,0)
900	.S XQAARC H=$$GET^XP AR(ORBENT, "ORB ARCHI VE PERIOD" ,ORN,"I")
901	"RTN","ORB 3",108,0)
902	.S XQASUP V=$$GET^XP AR(ORBENT, "ORB FORWA RD SUPERVI SOR",ORN," I")
903	"RTN","ORB 3",109,0)
904	.S XQASUR O=$$GET^XP AR(ORBENT, "ORB FORWA RD SURROGA TES",ORN," I")
905	"RTN","ORB 3",110,0)
906	.S XQAREV UE=$$GET^X PAR(ORBENT ,"ORB FORW ARD BACKUP REVIEWER" ,ORN,"I")
907	"RTN","ORB 3",111,0)
908	.S XQACND EL=$$GET^X PAR(ORBENT ,"ORB REMO VE",ORN,"I ")
909	"RTN","ORB 3",112,0)
910	.S XQACND EL=$S(XQAC NDEL=1:1,1 :"")
911	"RTN","ORB 3",113,0)
912	.I ORN=90 M XQATEXT =ORBPMSG
913	"RTN","ORB 3",114,0)
914	.I $D(ORB DEV)>1 D R EGDEV^ORB3 1(.ORBDEV)
915	"RTN","ORB 3",115,0)
916	.I $D(ORB SDEV)>1 D REGDEV^ORB 31(.ORBSDE V)
917	"RTN","ORB 3",116,0)
918	.I $D(ORB TDEV)>1 D REGDEV^ORB 31(.ORBTDE V)
919	"RTN","ORB 3",117,0)
920	.S XQAID= ORBXQAID
921	"RTN","ORB 3",118,0)
922	.I $D(ORB FLAGS("ONP P")) D COM DUP
923	"RTN","ORB 3",119,0)
924	.I $D(XQA ) D SETUP^ XQALERT ; if no [new ] recips d on't send alert
925	"RTN","ORB 3",120,0)
926	QUIT ;
927	"RTN","ORB 3",121,0)
928	K VA,VA20 0,VADM,VAE RR,VAIN,XQ A,XQADATA, XQAID,XQAF LG,XQAMSG, XQAROU,XQA ARCH,XQASU PV,XQASURO ,XQADFN,XQ ACNDEL,XQA REVUE
929	"RTN","ORB 3",122,0)
930	K ^XTMP(" ORBUSER",$ J)
931	"RTN","ORB 3",123,0)
932	I '$D(ORB U),$D(ORBL OCK) D
933	"RTN","ORB 3",124,0)
934	.I $G(ORB ID)]"" LOC K -^XTMP(" ORBLOCK",O RBDFN,ORN, ORBID)
935	"RTN","ORB 3",125,0)
936	.E LOCK -^XTMP("OR BLOCK",ORB DFN,ORN)
937	"RTN","ORB 3",126,0)
938	Q
939	"RTN","ORB 3",127,0)
940	PKGDUZS ;g et DUZs fr om pkg-pas sed ORBADU Z() array
941	"RTN","ORB 3",128,0)
942	N ORBPDUZ
943	"RTN","ORB 3",129,0)
944	I $D(ORBU ) D
945	"RTN","ORB 3",130,0)
946	.S ORBU(O RBUI)=" ", ORBUI=ORBU I+1
947	"RTN","ORB 3",131,0)
948	.I ORN=68 S ORBU(OR BUI)="Reci pients wit h Lab Thre shold Exce eded:",ORB UI=ORBUI+1
949	"RTN","ORB 3",132,0)
950	.E S ORB U(ORBUI)=" Recipients defined w hen notif was trigge red:",ORBU I=ORBUI+1
951	"RTN","ORB 3",133,0)
952	S ORBPDUZ =""
953	"RTN","ORB 3",134,0)
954	F S ORBP DUZ=$O(ORB ADUZ(ORBPD UZ)) Q:ORB PDUZ="" S ORBDUZ=OR BPDUZ D US ER
955	"RTN","ORB 3",135,0)
956	Q
957	"RTN","ORB 3",136,0)
958	SPECDUZS ; get DUZs r tn by SPEC IAL^ORB3SP EC
959	"RTN","ORB 3",137,0)
960	N ORBSDUZ
961	"RTN","ORB 3",138,0)
962	I $D(ORBU ) D
963	"RTN","ORB 3",139,0)
964	.S ORBU(O RBUI)=" ", ORBUI=ORBU I+1
965	"RTN","ORB 3",140,0)
966	.S ORBU(O RBUI)="Spe cial recip ients asso ciated wit h the noti fication:" ,ORBUI=ORB UI+1
967	"RTN","ORB 3",141,0)
968	S ORBSDUZ =""
969	"RTN","ORB 3",142,0)
970	F S ORBS DUZ=$O(ORB ASPEC(ORBS DUZ)) Q:OR BSDUZ="" S ORBDUZ=O RBSDUZ D U SER
971	"RTN","ORB 3",143,0)
972	Q
973	"RTN","ORB 3",144,0)
974	TITLE ;get provider recips
975	"RTN","ORB 3",145,0)
976	N TITLES
977	"RTN","ORB 3",146,0)
978	I $D(ORBU ) D
979	"RTN","ORB 3",147,0)
980	.S ORBU(O RBUI)=" ", ORBUI=ORBU I+1
981	"RTN","ORB 3",148,0)
982	.S ORBU(O RBUI)="Rec ipients de termined b y Provider Recipient parameter :",ORBUI=O RBUI+1
983	"RTN","ORB 3",149,0)
984	;
985	"RTN","ORB 3",150,0)
986	S TITLES= $$GET^XPAR (ORBENT,"O RB PROVIDE R RECIPIEN TS",ORN,"I ")
987	"RTN","ORB 3",151,0)
988	I TITLES[ "P" D PRIM ARY
989	"RTN","ORB 3",152,0)
990	I TITLES[ "A" D ATTE ND
991	"RTN","ORB 3",153,0)
992	I TITLES[ "T" D TEAM S
993	"RTN","ORB 3",154,0)
994	I TITLES[ "O" D ORDE RER
995	"RTN","ORB 3",155,0)
996	I TITLES[ "E" D ENTE RBY
997	"RTN","ORB 3",156,0)
998	I TITLES[ "R" D PCMM PRIM
999	"RTN","ORB 3",157,0)
1000	I TITLES[ "S" D PCMM ASSC
1001	"RTN","ORB 3",158,0)
1002	I TITLES[ "M" D PCMM TEAM
1003	"RTN","ORB 3",159,0)
1004	I TITLES[ "C" D PCMM MHTC
1005	"RTN","ORB 3",160,0)
1006	Q
1007	"RTN","ORB 3",161,0)
1008	PRIMARY ;
1009	"RTN","ORB 3",162,0)
1010	I $D(ORBU ),ORBADT=0 S ORBU(OR BUI)=" Inp t primary provider:" ,ORBUI=ORB UI+1
1011	"RTN","ORB 3",163,0)
1012	I $D(ORBU ),ORBADT=1 S ORBU(OR BUI)=" Inp t primary provider: option can not determ ine withou t A/D/T ev ent data." ,ORBUI=ORB UI+1
1013	"RTN","ORB 3",164,0)
1014	I +$G(ORB PRIM)>0 S ORBDUZ=ORB PRIM D USE R
1015	"RTN","ORB 3",165,0)
1016	Q
1017	"RTN","ORB 3",166,0)
1018	ATTEND ;
1019	"RTN","ORB 3",167,0)
1020	I $D(ORBU ),ORBADT=0 S ORBU(OR BUI)=" Att ending phy sician:",O RBUI=ORBUI +1
1021	"RTN","ORB 3",168,0)
1022	I $D(ORBU ),ORBADT=1 S ORBU(OR BUI)=" Att ending phy sician: op tion canno t determin e without A/D/T even t data.",O RBUI=ORBUI +1
1023	"RTN","ORB 3",169,0)
1024	I +$G(ORB ATTD)>0 S ORBDUZ=ORB ATTD D USE R
1025	"RTN","ORB 3",170,0)
1026	Q
1027	"RTN","ORB 3",171,0)
1028	TEAMS ;
1029	"RTN","ORB 3",172,0)
1030	I $D(ORBU ) S ORBU(O RBUI)=" Te ams/Person al Lists r elated to patient:", ORBUI=ORBU I+1
1031	"RTN","ORB 3",173,0)
1032	N ORBLST, ORBI,ORBJ, ORBTM,ORBT NAME,ORBTT YPE,ORBTD
1033	"RTN","ORB 3",174,0)
1034	D TMSPT^O RQPTQ1(.OR BLST,ORBDF N)
1035	"RTN","ORB 3",175,0)
1036	Q:+$G(ORB LST(1))<1
1037	"RTN","ORB 3",176,0)
1038	S ORBI="" F S ORBI =$O(ORBLST (ORBI)) Q: ORBI="" D
1039	"RTN","ORB 3",177,0)
1040	.S ORBTM= $P(ORBLST( ORBI),U),O RBTNAME=$P (ORBLST(OR BI),U,2)
1041	"RTN","ORB 3",178,0)
1042	.S ORBTTY PE=$P(ORBL ST(ORBI),U ,3)
1043	"RTN","ORB 3",179,0)
1044	.I $D(ORB U) D
1045	"RTN","ORB 3",180,0)
1046	..S ORBU( ORBUI)=" Patient li st "_ORBTN AME_" ["_O RBTTYPE_"] :",ORBUI=O RBUI+1
1047	"RTN","ORB 3",181,0)
1048	.N ORBLST 2 D TEAMPR OV^ORQPTQ1 (.ORBLST2, ORBTM)
1049	"RTN","ORB 3",182,0)
1050	.Q:+$G(OR BLST2(1))< 1
1051	"RTN","ORB 3",183,0)
1052	.S ORBJ=" " F S ORB J=$O(ORBLS T2(ORBJ)) Q:ORBJ="" D
1053	"RTN","ORB 3",184,0)
1054	..S ORBDU Z=$P(ORBLS T2(ORBJ),U )_U_ORBTM I +$G(ORBD UZ)>0 D US ER
1055	"RTN","ORB 3",185,0)
1056	.;
1057	"RTN","ORB 3",186,0)
1058	.S ORBTD= $P($$TMDEV ^ORB31(ORB TM),U,2) ;Team's de vice
1059	"RTN","ORB 3",187,0)
1060	.I $L(ORB TD) D
1061	"RTN","ORB 3",188,0)
1062	..S ORBTD EV(ORBTD)= ""
1063	"RTN","ORB 3",189,0)
1064	..I $D(OR BU) D
1065	"RTN","ORB 3",190,0)
1066	...S ORBU (ORBUI)=" Team's D evice "_OR BTD_" is a recipient ",ORBUI=OR BUI+1
1067	"RTN","ORB 3",191,0)
1068	Q
1069	"RTN","ORB 3",192,0)
1070	ORDERER ;
1071	"RTN","ORB 3",193,0)
1072	Q:+$G(ORN UM)<1
1073	"RTN","ORB 3",194,0)
1074	I $D(ORBU ) S ORBU(O RBUI)=" Or dering pro vider:",OR BUI=ORBUI+ 1
1075	"RTN","ORB 3",195,0)
1076	N ORBLST, ORBI,ORBTM ,ORBJ,ORBT NAME,ORBPL ST,ORBPI,O RBPTM,ORBT TYPE
1077	"RTN","ORB 3",196,0)
1078	S ORBDUZ= $S(ORN=12: +$$UNSIGNO R^ORQOR2(O RNUM),1:$$ ORDERER^OR QOR2(ORNUM ))
1079	"RTN","ORB 3",197,0)
1080	I +$G(ORB DUZ)>0 D
1081	"RTN","ORB 3",198,0)
1082	.D USER
1083	"RTN","ORB 3",199,0)
1084	.;if noti f = Order Req E/S (# 12) or Ord er Req Co- sign (#37) and
1085	"RTN","ORB 3",200,0)
1086	.;user do esn't have ES author ity, send to fellow team membe rs w/ES:
1087	"RTN","ORB 3",201,0)
1088	.I ((ORN= 12)!(ORN=3 7)),('$D(^ XUSEC("ORE S",ORBDUZ) )) D
1089	"RTN","ORB 3",202,0)
1090	..I $D(OR BU) S ORBU (ORBUI)=" Orderer ca n't elec s ign, getti ng teams o rderer bel ongs to:", ORBUI=ORBU I+1
1091	"RTN","ORB 3",203,0)
1092	..D TEAMP R^ORQPTQ1( .ORBLST,OR BDUZ) ;ge t orderer' s tms
1093	"RTN","ORB 3",204,0)
1094	..Q:+$G(O RBLST(1))< 1
1095	"RTN","ORB 3",205,0)
1096	..D TMSPT ^ORQPTQ1(. ORBPLST,OR BDFN) ;ge t pt's tms
1097	"RTN","ORB 3",206,0)
1098	..Q:+$G(O RBPLST(1)) <1
1099	"RTN","ORB 3",207,0)
1100	..S ORBI= "" F S OR BI=$O(ORBL ST(ORBI)) Q:ORBI="" D
1101	"RTN","ORB 3",208,0)
1102	...S ORBP I="" F S ORBPI=$O(O RBPLST(ORB PI)) Q:ORB PI="" D
1103	"RTN","ORB 3",209,0)
1104	....S ORB TM=$P(ORBL ST(ORBI),U ),ORBPTM=$ P(ORBPLST( ORBPI),U)
1105	"RTN","ORB 3",210,0)
1106	....I ORB TM=ORBPTM D ;if pt is on prov ider's tea m
1107	"RTN","ORB 3",211,0)
1108	.....I +$ G(ORBPTM)> 0 D
1109	"RTN","ORB 3",212,0)
1110	......S O RBTNAME=$P (ORBPLST(O RBPI),U,2)
1111	"RTN","ORB 3",213,0)
1112	......S O RBTTYPE=$P (ORBPLST(O RBPI),U,3)
1113	"RTN","ORB 3",214,0)
1114	......I $ D(ORBU) S ORBU(ORBUI )=" Order er's pt li st "_ORBTN AME_" ["_O RBTTYPE_"] recipient s: ",ORBUI =ORBUI+1
1115	"RTN","ORB 3",215,0)
1116	......N O RBLST2 D T EAMPROV^OR QPTQ1(.ORB LST2,ORBPT M)
1117	"RTN","ORB 3",216,0)
1118	......Q:+ $G(ORBLST2 (1))<1
1119	"RTN","ORB 3",217,0)
1120	......S O RBJ="" F S ORBJ=$O( ORBLST2(OR BJ)) Q:ORB J="" D
1121	"RTN","ORB 3",218,0)
1122	.......S ORBDUZ=$P( ORBLST2(OR BJ),U)_U_O RBPTM I +$ G(ORBDUZ)> 0,($D(^XUS EC("ORES", +ORBDUZ))) D USER
1123	"RTN","ORB 3",219,0)
1124	Q
1125	"RTN","ORB 3",220,0)
1126	ENTERBY ;
1127	"RTN","ORB 3",221,0)
1128	I $D(ORBU ) S ORBU(O RBUI)=" Us er enterin g order's most recen t activity :",ORBUI=O RBUI+1
1129	"RTN","ORB 3",222,0)
1130	Q:+$G(ORN UM)<1
1131	"RTN","ORB 3",223,0)
1132	I $D(^OR( 100,ORNUM, 8,0)) D
1133	"RTN","ORB 3",224,0)
1134	.S ORBDUZ =$P(^OR(10 0,ORNUM,8, $P(^OR(100 ,ORNUM,8,0 ),U,3),0), U,13)
1135	"RTN","ORB 3",225,0)
1136	I +$G(ORB DUZ)>0 D U SER
1137	"RTN","ORB 3",226,0)
1138	Q
1139	"RTN","ORB 3",227,0)
1140	PCMMPRIM ;
1141	"RTN","ORB 3",228,0)
1142	I $D(ORBU ) S ORBU(O RBUI)=" PC MM Primary Care Prac titioner:" ,ORBUI=ORB UI+1
1143	"RTN","ORB 3",229,0)
1144	S ORBDUZ= +$$OUTPTPR ^SDUTL3(OR BDFN,$$NOW ^XLFDT,1) ;DBIA #12 52
1145	"RTN","ORB 3",230,0)
1146	I +$G(ORB DUZ)>0 D U SER
1147	"RTN","ORB 3",231,0)
1148	Q
1149	"RTN","ORB 3",232,0)
1150	PCMMASSC ;
1151	"RTN","ORB 3",233,0)
1152	I $D(ORBU ) S ORBU(O RBUI)=" PC MM Associa te Provide r:",ORBUI= ORBUI+1
1153	"RTN","ORB 3",234,0)
1154	S ORBDUZ= +$$OUTPTAP ^SDUTL3(OR BDFN,$$NOW ^XLFDT) ; DBIA #1252
1155	"RTN","ORB 3",235,0)
1156	I +$G(ORB DUZ)>0 D U SER
1157	"RTN","ORB 3",236,0)
1158	Q
1159	"RTN","ORB 3",237,0)
1160	PCMMTEAM ;
1161	"RTN","ORB 3",238,0)
1162	N ORPCMM, ORPCMMDZ
1163	"RTN","ORB 3",239,0)
1164	I $D(ORBU ) S ORBU(O RBUI)=" PC MM Team Po sition Ass ignments:" ,ORBUI=ORB UI+1
1165	"RTN","ORB 3",240,0)
1166	S ORPCMM= $$PRPT^SCA PMC(ORBDFN ,,,,,,"^TM P(""ORPCMM "",$J)",) ;DBIA #19 16
1167	"RTN","ORB 3",241,0)
1168	S ORPCMMD Z=0
1169	"RTN","ORB 3",242,0)
1170	F S ORPC MMDZ=$O(^T MP("ORPCMM ",$J,"SCPR ",ORPCMMDZ )) Q:'ORPC MMDZ D
1171	"RTN","ORB 3",243,0)
1172	.S ORBDUZ =ORPCMMDZ D USER
1173	"RTN","ORB 3",244,0)
1174	K ^TMP("O RPCMM",$J)
1175	"RTN","ORB 3",245,0)
1176	Q
1177	"RTN","ORB 3",246,0)
1178	PCMMMHTC ;
1179	"RTN","ORB 3",247,0)
1180	I $D(ORBU ) S ORBU(O RBUI)=" PC MM Mental Health Tre atment Coo rdinator:" ,ORBUI=ORB UI+1
1181	"RTN","ORB 3",248,0)
1182	S ORBDUZ= +$$START^S CMCMHTC(OR BDFN) ;DB IA #5697
1183	"RTN","ORB 3",249,0)
1184	I +$G(ORB DUZ)>0 D U SER
1185	"RTN","ORB 3",250,0)
1186	Q
1187	"RTN","ORB 3",251,0)
1188	USER ;shou ld USER (O RBDUZ) be a recip
1189	"RTN","ORB 3",252,0)
1190	; RBD OR* 3.0*453 In tercept Us er (Provid er) to rec eive alert to see if it perman ently rout es to anot her User ( Provider)
1191	"RTN","ORB 3",253,0)
1192	; Then check if that U ser can re ceive Aler ts
1193	"RTN","ORB 3",254,0)
1194	N ORTRDAT ,ORTRNUM,O RTRREC I + $G(ORNUM)> 0 D
1195	"RTN","ORB 3",255,0)
1196	. S ORTRD AT=$O(^OR( 100,ORNUM, 11,"B",$$N OW^XLFDT() ),-1) I +O RTRDAT>0 D
1197	"RTN","ORB 3",256,0)
1198	.. S ORTR NUM=$O(^OR (100,ORNUM ,11,"B",OR TRDAT,""), -1) I +ORT RNUM>0 D
1199	"RTN","ORB 3",257,0)
1200	... S ORT RREC=$G(^O R(100,ORNU M,11,ORTRN UM,0)) I O RTRREC]"" D
1201	"RTN","ORB 3",258,0)
1202	.... I $P (ORTRREC,U ,2)=ORBDUZ ,$P(ORTRRE C,U,3) S O RBDUZ=$P(O RTRREC,U,3 )
1203	"RTN","ORB 3",259,0)
1204	D USER^OR B3USER(.XQ A,ORBDUZ,O RN,.ORBU,. ORBUI,ORBD FN,+$G(ORN UM))
1205	"RTN","ORB 3",260,0)
1206	Q
1207	"RTN","ORB 3",261,0)
1208	COMDUP ; C ombine XQA DATA from existing a lert(s) wi th new ale rt, delete existing alert
1209	"RTN","ORB 3",262,0)
1210	;and then generate the new al ert for th e current individual user
1211	"RTN","ORB 3",263,0)
1212	N ORVAR,O RDUZ,ORAID ,ORODATA
1213	"RTN","ORB 3",264,0)
1214	F ORVAR=" XQA","XQAD ATA","XQAI D","XQAFLG ","XQAMSG" ,"XQAROU", "XQAARCH", "XQASUPV", "XQASURO", "XQADFN"," XQACNDEL", "XQAREVUE" ,"XQAOPT", "XQAEXIT", "XQAUSER", "DUZ" D
1215	"RTN","ORB 3",265,0)
1216	.Q:'$D(@O RVAR)
1217	"RTN","ORB 3",266,0)
1218	.I $D(@OR VAR)<10 S ORVAR(ORVA R)=$G(@ORV AR)
1219	"RTN","ORB 3",267,0)
1220	.I $D(@OR VAR)>9 M O RVAR(ORVAR )=@ORVAR
1221	"RTN","ORB 3",268,0)
1222	.S ORVAR( 0,ORVAR)=" "
1223	"RTN","ORB 3",269,0)
1224	S ORDUZ=0 F S ORDU Z=$O(XQA(O RDUZ)) Q:' +ORDUZ D
1225	"RTN","ORB 3",270,0)
1226	.N ORDATA ,ORGEN
1227	"RTN","ORB 3",271,0)
1228	.K ^TMP($ J,"ORB3DAT A")
1229	"RTN","ORB 3",272,0)
1230	.D USER^X QALERT($NA (^TMP($J," ORB3DATA") ),ORDUZ)
1231	"RTN","ORB 3",273,0)
1232	.S ORAID= 0 F S ORA ID=$O(^TMP ($J,"ORB3D ATA",ORAID )) Q:'+ORA ID D
1233	"RTN","ORB 3",274,0)
1234	..Q:$P($P (^TMP($J," ORB3DATA", ORAID),U,2 ),";")'=($ P(ORBN,U,2 )_","_ORBD FN_","_ORN )
1235	"RTN","ORB 3",275,0)
1236	..I $P(OR BN,U,4)="P KG",$P(^TM P($J,"ORB3 DATA",ORAI D),U)'[ORV AR("XQAMSG ") Q
1237	"RTN","ORB 3",276,0)
1238	..N XQAID ,XQADATA,X QAOPT,XQAR OU,XQAUSER ,DUZ,XQAKI LL
1239	"RTN","ORB 3",277,0)
1240	..N XQADF N,XQAMSG,X QAFLG,XQAD FN,XQAARCH ,XQASUPV,X QASURO,XQA REVUE,XQAC NDEL
1241	"RTN","ORB 3",278,0)
1242	..D ALERT DAT^XQALBU TL($P(^TMP ($J,"ORB3D ATA",ORAID ),U,2),$NA (^TMP($J," ORB3ADATA" )))
1243	"RTN","ORB 3",279,0)
1244	..S XQADA TA=$G(^TMP ($J,"ORB3A DATA"),2)
1245	"RTN","ORB 3",280,0)
1246	..I XQADA TA'="" D
1247	"RTN","ORB 3",281,0)
1248	...I $D(O RBFLAGS("C D")) D
1249	"RTN","ORB 3",282,0)
1250	....N ORO LD,ORNEW,O RSPEC,ORID X
1251	"RTN","ORB 3",283,0)
1252	....S ORO LD=U_$S(XQ ADATA[";": $P(XQADATA ,";",2),1: XQADATA)_U ,ORNEW=U_$ S(ORVAR("X QADATA")[" ;":$P(ORVA R("XQADATA "),";",2), 1:ORVAR("X QADATA"))_ U
1253	"RTN","ORB 3",284,0)
1254	....S ORS PEC(U)=""
1255	"RTN","ORB 3",285,0)
1256	....F ORI DX=2:1:$L( ORNEW,U) I OROLD[(U_ $P(ORNEW,U ,ORIDX)_U) S $P(ORNE W,U,ORIDX) =""
1257	"RTN","ORB 3",286,0)
1258	....S ORN EW=$$REPLA CE^XLFSTR( ORNEW,.ORS PEC)
1259	"RTN","ORB 3",287,0)
1260	....I ORN EW="" K OR VAR("XQA", ORDUZ) Q
1261	"RTN","ORB 3",288,0)
1262	....S ORD ATA=$S(XQA DATA[";":$ P(XQADATA, ";",2),1:X QADATA)_$S ($G(ORDATA )'="":U_OR DATA,1:"")
1263	"RTN","ORB 3",289,0)
1264	....S ORG EN=1
1265	"RTN","ORB 3",290,0)
1266	...I '$D( ORBFLAGS(" CD")),XQAD ATA=ORVAR( "XQADATA") S ORGEN=2
1267	"RTN","ORB 3",291,0)
1268	..K ^TMP( $J,"ORB3AD ATA")
1269	"RTN","ORB 3",292,0)
1270	..Q:'$G(O RGEN)
1271	"RTN","ORB 3",293,0)
1272	..S XQAUS ER=ORDUZ,X QAID=$P(^T MP($J,"ORB 3DATA",ORA ID),U,2),X QAKILL=1
1273	"RTN","ORB 3",294,0)
1274	..D DELET E^XQALERT
1275	"RTN","ORB 3",295,0)
1276	.Q:$G(ORG EN)'=1
1277	"RTN","ORB 3",296,0)
1278	.I $G(XQA DATA)'=""! ($G(ORDATA )'="") S O RODATA=$G( XQADATA)_$ S($G(ORDAT A)'="":U_O RDATA,1:"" )
1279	"RTN","ORB 3",297,0)
1280	.K ORVAR( "XQA",ORDU Z)
1281	"RTN","ORB 3",298,0)
1282	.D XQREST OR
1283	"RTN","ORB 3",299,0)
1284	.N XQA,XQ ADATA
1285	"RTN","ORB 3",300,0)
1286	.S XQA(OR DUZ)="",XQ ADATA=OROD ATA D SETU P^XQALERT
1287	"RTN","ORB 3",301,0)
1288	K ^TMP($J ,"ORB3DATA ")
1289	"RTN","ORB 3",302,0)
1290	D XQRESTO R
1291	"RTN","ORB 3",303,0)
1292	Q
1293	"RTN","ORB 3",304,0)
1294	XQRESTOR ; Restore X QA* variab les saved off in COM DUP
1295	"RTN","ORB 3",305,0)
1296	S ORVAR=" " F S ORV AR=$O(ORVA R(0,ORVAR) ) Q:$G(ORV AR)="" K @ORVAR
1297	"RTN","ORB 3",306,0)
1298	S ORVAR=" ?" F S OR VAR=$O(ORV AR(ORVAR)) Q:$G(ORVA R)="" D
1299	"RTN","ORB 3",307,0)
1300	.I $D(ORV AR(ORVAR)) <10 S @ORV AR=ORVAR(O RVAR)
1301	"RTN","ORB 3",308,0)
1302	.I $D(ORV AR(ORVAR)) >9 M @ORVA R=ORVAR(OR VAR)
1303	"RTN","ORB 3",309,0)
1304	Q
1305	"RTN","ORC SAVE")
1306	0^2^B13445 8750^B1249 71276
1307	"RTN","ORC SAVE",1,0)
1308	ORCSAVE ;S LC/MKB/JDL -Save ;06/ 08/17 20: 43
1309	"RTN","ORC SAVE",2,0)
1310	;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;7 ,56,70,73, 92,94,116, 141,163,18 7,190,195, 243,303,29 3,280,306, 286,269,42 3,421,405, 453;Dec 17, 1997;B uild 4
1311	"RTN","ORC SAVE",3,0)
1312	;Per VHA Directive 2004-038, this routi ne should not be mod ified.
1313	"RTN","ORC SAVE",4,0)
1314	;
1315	"RTN","ORC SAVE",5,0)
1316	; DBIA 10 103 ^XLF DT
1317	"RTN","ORC SAVE",6,0)
1318	;
1319	"RTN","ORC SAVE",7,0)
1320	;
1321	"RTN","ORC SAVE",8,0)
1322	NEW(ORDIAL OG,ORDG,OR PKG,ORCAT, OREVENT,OR DUZ,ORLOG) ; -- New order
1323	"RTN","ORC SAVE",9,0)
1324	; Returns ORIFN = [ new] order number, i f created/ saved
1325	"RTN","ORC SAVE",10,0 )
1326	D EN
1327	"RTN","ORC SAVE",11,0 )
1328	Q
1329	"RTN","ORC SAVE",12,0 )
1330	;
1331	"RTN","ORC SAVE",13,0 )
1332	XX ; -- sa ve new/unr eleased ed ited order into Orde rs file
1333	"RTN","ORC SAVE",14,0 )
1334	; Requ ires: ORDI ALOG() = a rray of di alog value s
1335	"RTN","ORC SAVE",15,0 )
1336	; ORIF N = I FN of orig inal order that was edited
1337	"RTN","ORC SAVE",16,0 )
1338	;
1339	"RTN","ORC SAVE",17,0 )
1340	N OLDIFN S ORIFN=+O RIFN,OLDIF N=0
1341	"RTN","ORC SAVE",18,0 )
1342	I $S($P(^ OR(100,ORI FN,3),U,3) =11:0,$P(^ (3),U,3)'= 10:1,$P(^( 8,1,0),U,4 )=2:0,1:1) S OLDIFN= ORIFN K OR IFN ; crea te new ord er if rele ased or de layed&sign ed
1343	"RTN","ORC SAVE",19,0 )
1344	D EN Q:'O RIFN S:'$ G(ORDA) OR DA=1
1345	"RTN","ORC SAVE",20,0 )
1346	I $G(OLDI FN) D ;sa ve links b etween ord ers
1347	"RTN","ORC SAVE",21,0 )
1348	. S $P(^O R(100,ORIF N,3),U,5)= OLDIFN,$P( ^(3),U,11) =1
1349	"RTN","ORC SAVE",22,0 )
1350	. S $P(^O R(100,OLDI FN,3),U,6) =ORIFN S:$ D(^(5)) ^O R(100,ORIF N,5)=^OR(1 00,OLDIFN, 5)
1351	"RTN","ORC SAVE",23,0 )
1352	I $D(^OR( 100,+OLDIF N,0)) D
1353	"RTN","ORC SAVE",24,0 )
1354	. Q:'$G(O REVTDF)
1355	"RTN","ORC SAVE",25,0 )
1356	. N OLDEV T,OLDSTS,L STACT,PATI D,NOW,WHEN
1357	"RTN","ORC SAVE",26,0 )
1358	. S (OLDE VT,OLDSTS, LSTACT)=0
1359	"RTN","ORC SAVE",27,0 )
1360	. S NOW=$ $NOW^XLFDT
1361	"RTN","ORC SAVE",28,0 )
1362	. S OLDEV T=$P(^OR(1 00,+OLDIFN ,0),U,17), OLDSTS=$P( ^OR(100,+O LDIFN,3),U ,3)
1363	"RTN","ORC SAVE",29,0 )
1364	. ; Activ e status = 6 from #1 00.01
1365	"RTN","ORC SAVE",30,0 )
1366	. I (OLDE VT>0),OLDS TS=6 D
1367	"RTN","ORC SAVE",31,0 )
1368	. . S $P( ^OR(100,+O RIFN,0),U, 17)=OLDEVT
1369	"RTN","ORC SAVE",32,0 )
1370	. . S $P( ^OR(100,+O RIFN,3),U, 3)=11
1371	"RTN","ORC SAVE",33,0 )
1372	. . S LST ACT=$P($G( ^OR(100,+O RIFN,3)),U ,7)
1373	"RTN","ORC SAVE",34,0 )
1374	. . I $D( ^OR(100,+O RIFN,8,LST ACT,0)) D
1375	"RTN","ORC SAVE",35,0 )
1376	. . . S $ P(^OR(100, +ORIFN,8,L STACT,0),U ,15)=11
1377	"RTN","ORC SAVE",36,0 )
1378	. . . S P ATID=$P(^O R(100,+ORI FN,0),U,2)
1379	"RTN","ORC SAVE",37,0 )
1380	. . . S W HEN=$P(^OR (100,+ORIF N,8,LSTACT ,0),U)
1381	"RTN","ORC SAVE",38,0 )
1382	. . . S ^ OR(100,"AC ",PATID,99 99999-WHEN ,+ORIFN,LS TACT)=""
1383	"RTN","ORC SAVE",39,0 )
1384	Q
1385	"RTN","ORC SAVE",40,0 )
1386	;
1387	"RTN","ORC SAVE",41,0 )
1388	RN ; -- sa ve new/unr eleased re newal orde r into Ord ers file
1389	"RTN","ORC SAVE",42,0 )
1390	; Requ ires: ORDI ALOG() = a rray of ne w dialog v alues
1391	"RTN","ORC SAVE",43,0 )
1392	; ORIF N = I FN of orig inal order that was renewed
1393	"RTN","ORC SAVE",44,0 )
1394	;
1395	"RTN","ORC SAVE",45,0 )
1396	N OLDIFN S OLDIFN=+ ORIFN K OR IFN
1397	"RTN","ORC SAVE",46,0 )
1398	D EN Q:'O RIFN S:'$ G(ORDA) OR DA=1
1399	"RTN","ORC SAVE",47,0 )
1400	S $P(^OR( 100,ORIFN, 3),U,5)=OL DIFN,$P(^( 3),U,11)=2
1401	"RTN","ORC SAVE",48,0 )
1402	S $P(^OR( 100,OLDIFN ,3),U,6)=O RIFN S:$D( ^(5)) ^OR( 100,ORIFN, 5)=^OR(100 ,OLDIFN,5)
1403	"RTN","ORC SAVE",49,0 )
1404	Q
1405	"RTN","ORC SAVE",50,0 )
1406	;
1407	"RTN","ORC SAVE",51,0 )
1408	EN ; -- sa ve new/unr eleased or der in ORD IALOG() in to Orders file
1409	"RTN","ORC SAVE",52,0 )
1410	; Requ ires: ORVP , ORNP [an d ORL, ORT S, ORAPPT if availab le]
1411	"RTN","ORC SAVE",53,0 )
1412	; If d efined: OR CAT,ORPKG, ORDG,ORLOG ,ORDUZ,ORE VENT,ORDCN TRL,ORSRC
1413	"RTN","ORC SAVE",54,0 )
1414	; (el se use val ues from O RDIALOG an d current state)
1415	"RTN","ORC SAVE",55,0 )
1416	;
1417	"RTN","ORC SAVE",56,0 )
1418	N PKG,NOW ,NODE,CNT, CDL,I,X,ST S,SIGNREQD ,LOC,TRSPE C,NATR,CAT G,DG,LOG,U SR,TYPE,OR K
1419	"RTN","ORC SAVE",57,0 )
1420	Q:'$G(ORV P) Q:'$G( ORDIALOG) Q:'$D(^OR D(101.41,+ ORDIALOG,0 ))
1421	"RTN","ORC SAVE",58,0 )
1422	S NOW=$$N OW^XLFDT,S IGNREQD=+$ P(^ORD(101 .41,+ORDIA LOG,0),U,6 )
1423	"RTN","ORC SAVE",59,0 )
1424	S CATG=$S ($L($G(ORC AT)):ORCAT ,1:$S($$IN PT^ORCD:"I ",1:"O"))
1425	"RTN","ORC SAVE",60,0 )
1426	S PKG=$S( $G(ORPKG): ORPKG,1:$P (^ORD(101. 41,+ORDIAL OG,0),U,7) )
1427	"RTN","ORC SAVE",61,0 )
1428	S LOG=$S( $G(ORLOG): ORLOG,1:+$ E(NOW,1,12 )),USR=$S( $G(ORDUZ): ORDUZ,1:DU Z)
1429	"RTN","ORC SAVE",62,0 )
1430	I $G(ORIF N),$D(^OR( 100,ORIFN, 0)) S STS= $P(^(3),U, 3) G EN2 ; unrel ord er
1431	"RTN","ORC SAVE",63,0 )
1432	S DG=$S($ G(ORDG):+O RDG,1:$P(^ ORD(101.41 ,+ORDIALOG ,0),U,5))
1433	"RTN","ORC SAVE",64,0 )
1434	I $G(OREV ENT),"^PSO ^RA^"'["^" _$$GET1^DI Q(9.4,+PKG _",",1)_"^ ",'$G(DGPM T) S LOC=" ",TRSPEC=" " ; p286 a dded radio logy packa ge
1435	"RTN","ORC SAVE",65,0 )
1436	E S LOC= $G(ORL),TR SPEC=$G(OR TS)
1437	"RTN","ORC SAVE",66,0 )
1438	S TYPE=$S ("^B^C^X^P ^0^"[(U_$G (ORSRC)_U) :ORSRC,$G( ORDCNTRL)= "SN":"P",1 :0)
1439	"RTN","ORC SAVE",67,0 )
1440	;S LOG=$S ($G(ORLOG) :ORLOG,1:+ $E(NOW,1,1 2)),USR=$S ($G(ORDUZ) :ORDUZ,1:D UZ) moved up before EN2 call
1441	"RTN","ORC SAVE",68,0 )
1442	S NATR=+$ O(^ORD(100 .02,"C","E ",0)) ;ass ume Elec E ntered unt il changed
1443	"RTN","ORC SAVE",69,0 )
1444	S STS=$S( $G(OREVENT ):10,1:11) ,ORIFN=$$N EXTIFN Q:' ORIFN
1445	"RTN","ORC SAVE",70,0 )
1446	EN1 S ^OR( 100,ORIFN, 0)=ORIFN_U _ORVP_U_U_ $G(ORNP)_U _+ORDIALOG _";ORD(101 .41,^"_USR _U_LOG_U_U _U_LOC_U_D G_U_CATG_U _TRSPEC_U_ PKG_U_U_SI GNREQD_U_$ G(OREVENT) _U_$G(ORAP PT)
1447	"RTN","ORC SAVE",71,0 )
1448	S ^OR(100 ,ORIFN,3)= LOG_"^90^" _STS_U_$S( $G(ORIT):O RIT_";ORD( 101.41,",1 :"")_U_$G( ORDIALOG(" PREV"))_"^ ^1^^^^"_TY PE
1449	"RTN","ORC SAVE",72,0 )
1450	S ^OR(100 ,ORIFN,8,0 )="^100.00 8DA^1^1",^ OR(100,ORI FN,8,1,0)= LOG_"^NW^" _$G(ORNP)_ U_$S(SIGNR EQD:2,1:3) _"^^^^^^^^ "_NATR_U_U SR_"^1^"_S TS,^OR(100 ,ORIFN,8," C","NW",1) =""
1451	"RTN","ORC SAVE",73,0 )
1452	S ^OR(100 ,"AF",LOG, ORIFN,1)=" "
1453	"RTN","ORC SAVE",74,0 )
1454	; RBD OR* 3.0*453 Ad d setting of EPRACDT index exp licitly
1455	"RTN","ORC SAVE",75,0 )
1456	I $G(ORNP )]"" S ^OR (100,"EPRA CDT",ORNP, LOG,ORIFN, 1)=""
1457	"RTN","ORC SAVE",76,0 )
1458	S ^OR(100 ,"C",+ORDI ALOG_";ORD (101.41,", ORIFN)=""
1459	"RTN","ORC SAVE",77,0 )
1460	S ^OR(100 ,"D",+ORDI ALOG_";ORD (101.41,", ORIFN)=""
1461	"RTN","ORC SAVE",78,0 )
1462	S ^OR(100 ,"ACT",ORV P,9999999- LOG,+DG,OR IFN,1)=""
1463	"RTN","ORC SAVE",79,0 )
1464	;US10045 - PB - Nov 19, 2015 modificati on to capt ure the or der create date/time with seco nds in HMP (800000 or ders multi ple to tra ck seconds
1465	"RTN","ORC SAVE",80,0 )
1466	D:$P(ORVP ,";",2)="D PT("
1467	"RTN","ORC SAVE",81,0 )
1468	. N RSLT, VALS
1469	"RTN","ORC SAVE",82,0 )
1470	. S VALS( .02)=$$NOW ^XLFDT
1471	"RTN","ORC SAVE",83,0 )
1472	. D ADDOR DR^HMPOR(. RSLT,.VALS ,ORIFN,+OR VP) ;ORVP is variab le pointer
1473	"RTN","ORC SAVE",84,0 )
1474	. Q:RSLT< 0 ; sub-f ile entry not create d
1475	"RTN","ORC SAVE",85,0 )
1476	. D COMP^ ORMBLDOR(+ $G(ORIFN)) ;Nov 12, 2015 - PB - trigger unsolicite d sync act ion when o rder is sa ved
1477	"RTN","ORC SAVE",86,0 )
1478	;
1479	"RTN","ORC SAVE",87,0 )
1480	S:STS'=10 ^OR(100," AC",ORVP,9 999999-LOG ,ORIFN,1)= ""
1481	"RTN","ORC SAVE",88,0 )
1482	S:SIGNREQ D ^OR(100, "AS",ORVP, 9999999-LO G,ORIFN,1) =""
1483	"RTN","ORC SAVE",89,0 )
1484	S:$G(OREV ENT) ^OR(1 00,"AEVNT" ,ORVP,OREV ENT,ORIFN) =""
1485	"RTN","ORC SAVE",90,0 )
1486	;check if OR GTX ST UDY REASON is in ORD IALOG and strip out control ch aracters
1487	"RTN","ORC SAVE",91,0 )
1488	N ORRFSID
1489	"RTN","ORC SAVE",92,0 )
1490	S ORRFSID =$O(^ORD(1 01.41,"B", "OR GTX ST UDY REASON ",""))
1491	"RTN","ORC SAVE",93,0 )
1492	I ORRFSID ,$D(ORDIAL OG(ORRFSID ,1)) D
1493	"RTN","ORC SAVE",94,0 )
1494	.N X,I
1495	"RTN","ORC SAVE",95,0 )
1496	.S X=ORDI ALOG(ORRFS ID,1)
1497	"RTN","ORC SAVE",96,0 )
1498	.F I=1:1: 31 S X=$TR (X,$C(I))
1499	"RTN","ORC SAVE",97,0 )
1500	.S ORDIAL OG(ORRFSID ,1)=X
1501	"RTN","ORC SAVE",98,0 )
1502	EN2 S ORIF N=+ORIFN D RESPONSE ; save res ponses
1503	"RTN","ORC SAVE",99,0 )
1504	I $P(^OR( 100,ORIFN, 0),"^",5) D ;Copy o rders PKI fix
1505	"RTN","ORC SAVE",100, 0)
1506	. N OI,OR PKIU
1507	"RTN","ORC SAVE",101, 0)
1508	. S OI=+$ O(^OR(100, ORIFN,4.5, "ID","ORDE RABLE",0)) ,OI=+$G(^O R(100,ORIF N,4.5,OI,1 )) Q:'OI
1509	"RTN","ORC SAVE",102, 0)
1510	. I PKG'= $O(^DIC(9. 4,"B","OUT PATIENT PH ARMACY",0) ) Q
1511	"RTN","ORC SAVE",103, 0)
1512	. S ORPKI U=0 I $D(^ ORD(100.7, "C",DUZ)) S ORPKIU=1
1513	"RTN","ORC SAVE",104, 0)
1514	. D PKI^O RWDPS1(.OR Y,OI,CATG, +ORVP,ORPK IU)
1515	"RTN","ORC SAVE",105, 0)
1516	. I $E($G (ORY))=2 S ORDEA=ORY
1517	"RTN","ORC SAVE",106, 0)
1518	K ^OR(100 ,ORIFN,8,1 ,.1) D ORD TEXT^ORCSA VE1(ORIFN_ ";1") ; or der text
1519	"RTN","ORC SAVE",107, 0)
1520	S NODE=$G (^OR(100,O RIFN,8,1,0 )) D S ^O R(100,ORIF N,8,1,0)=N ODE
1521	"RTN","ORC SAVE",108, 0)
1522	. S $P(NO DE,U,3)=$G (ORNP)
1523	"RTN","ORC SAVE",109, 0)
1524	. S $P(NO DE,U,13)=U SR
1525	"RTN","ORC SAVE",110, 0)
1526	S NODE=$G (^OR(100,O RIFN,0)) D S ^OR(10 0,ORIFN,0) =NODE
1527	"RTN","ORC SAVE",111, 0)
1528	. S $P(NO DE,U,4)=$G (ORNP) ; C OST?
1529	"RTN","ORC SAVE",112, 0)
1530	. S I=$O( ^OR(100,OR IFN,4.5,"I D","LOCATI ON",0))
1531	"RTN","ORC SAVE",113, 0)
1532	. I I,$P( NODE,U,10) S X=+$G(^ OR(100,ORI FN,4.5,+I, 1)) S:X $P (NODE,U,10 )=X_";SC(" ;reset Lo c if prev value
1533	"RTN","ORC SAVE",114, 0)
1534	. S I=$O( ^OR(100,OR IFN,4.5,"I D","CLASS" ,0))
1535	"RTN","ORC SAVE",115, 0)
1536	. I I S X =$G(^OR(10 0,ORIFN,4. 5,+I,1)) S :"^I^O^"[( U_X_U) $P( NODE,U,12) =X
1537	"RTN","ORC SAVE",116, 0)
1538	S $P(^OR( 100,ORIFN, 3),U)=NOW
1539	"RTN","ORC SAVE",117, 0)
1540	D DELOCC^ OROCAPI1(O RIFN,"ACCE PTANCE_CPR S")
1541	"RTN","ORC SAVE",118, 0)
1542	I $G(ORCH ECK) D ; save order checks
1543	"RTN","ORC SAVE",119, 0)
1544	. S (CNT, CDL)=0 F S CDL=$O(O RCHECK("NE W",CDL)) Q :CDL'>0 S I=0 D
1545	"RTN","ORC SAVE",120, 0)
1546	. . F S I=$O(ORCHE CK("NEW",C DL,I)) Q:I '>0 D
1547	"RTN","ORC SAVE",121, 0)
1548	. . . I $ D(ORCHECK( "NEW",CDL, I,0)) D
1549	"RTN","ORC SAVE",122, 0)
1550	. . . . N J S J=0,O RCHECK("NE W",CDL,I)= ORCHECK("N EW",CDL,I, J) F S J= $O(ORCHECK ("NEW",CDL ,I,J)) Q:' J S ORCHE CK("NEW",C DL,I)=ORCH ECK("NEW", CDL,I)_ORC HECK("NEW" ,CDL,I,J)
1551	"RTN","ORC SAVE",123, 0)
1552	. . . S X =ORCHECK(" NEW",CDL,I )
1553	"RTN","ORC SAVE",124, 0)
1554	. . . S O RK(I,1)=+O RIFN_U_"AC CEPTANCE_C PRS"_U_DUZ _U_$$NOW^X LFDT_U_$P( X,U)_U_CDL
1555	"RTN","ORC SAVE",125, 0)
1556	. . . S O RK(I,2,1)= $P(X,U,3)
1557	"RTN","ORC SAVE",126, 0)
1558	. . . I $ E(ORK(I,2, 1),0,2)="\| \|" D
1559	"RTN","ORC SAVE",127, 0)
1560	. . . . N ORGLOB,OR RULE,ORI,O RLINE
1561	"RTN","ORC SAVE",128, 0)
1562	. . . . S ORGLOB=$P ($P(ORK(I, 2,1),"\|\|", 2),"&"),OR RULE=$P($P (ORK(I,2,1 ),"\|\|",2), "&",2)
1563	"RTN","ORC SAVE",129, 0)
1564	. . . . S ORK(I,2,1 )=ORRULE,O RI=0,ORLIN E=2
1565	"RTN","ORC SAVE",130, 0)
1566	. . . . F S ORI=$O (^TMP($J," ORK XTRA T XT",ORGLOB ,ORRULE,OR I)) Q:'ORI S ORK(I, 2,ORLINE)= ^TMP($J,"O RK XTRA TX T",ORGLOB, ORRULE,ORI ),ORLINE=O RLINE+1
1567	"RTN","ORC SAVE",131, 0)
1568	. . . S O RK(I,3)=$G (ORCHECK(" NEW",CDL,I ,"OVER"))
1569	"RTN","ORC SAVE",132, 0)
1570	. . . S O RK(I,4)=$G (ORCHECK(" NEW",CDL,I ,"REMCOMM" ))
1571	"RTN","ORC SAVE",133, 0)
1572	. I $D(OR K) D
1573	"RTN","ORC SAVE",134, 0)
1574	. . N OCR ET,ORKI
1575	"RTN","ORC SAVE",135, 0)
1576	. . D SAV EOC^OROCAP I1(.ORK,.O CRET)
1577	"RTN","ORC SAVE",136, 0)
1578	. . S ORK I=0 F S O RKI=$O(ORK (ORKI)) Q: 'ORKI D
1579	"RTN","ORC SAVE",137, 0)
1580	. . . N O CINST,OCTX T S OCTXT= $G(ORK(ORK I,2,1))
1581	"RTN","ORC SAVE",138, 0)
1582	. . . S O CINST=$O(O CRET(ORKI, 0))
1583	"RTN","ORC SAVE",139, 0)
1584	. . . N O RMONOI,ORM ONOQ S ORM ONOI=0,ORM ONOQ=0 F Q:ORMONOQ= 1 S ORMON OI=$O(^TMP ($J,"ORMON OGRAPH",OR MONOI)) Q: 'ORMONOI D
1585	"RTN","ORC SAVE",140, 0)
1586	. . . . I OCTXT[$G( ^TMP($J,"O RMONOGRAPH ",ORMONOI, "OC")) D
1587	"RTN","ORC SAVE",141, 0)
1588	. . . . . S ORMONOQ =1
1589	"RTN","ORC SAVE",142, 0)
1590	. . . . . S ^ORD(10 0.05,OCINS T,17)=^TMP ($J,"ORMON OGRAPH",OR MONOI,"INT ")
1591	"RTN","ORC SAVE",143, 0)
1592	. . . . . M ^ORD(10 0.05,OCINS T,16)=^TMP ($J,"ORMON OGRAPH",OR MONOI,"DAT A")
1593	"RTN","ORC SAVE",144, 0)
1594	. . . . . S ^ORD(10 0.05,OCINS T,16,0)="^ ^"_$O(^ORD (100.05,OC INST,16,"" ),-1)_U_$O (^ORD(100. 05,OCINST, 16,""),-1) _U_+$$NOW^ XLFDT_U
1595	"RTN","ORC SAVE",145, 0)
1596	. . K ^TM P($J,"ORMO NOGRAPH")
1597	"RTN","ORC SAVE",146, 0)
1598	. . K ^TM P($J,"ORK XTRA TXT")
1599	"RTN","ORC SAVE",147, 0)
1600	K ORDEA
1601	"RTN","ORC SAVE",148, 0)
1602	ENQ Q
1603	"RTN","ORC SAVE",149, 0)
1604	;
1605	"RTN","ORC SAVE",150, 0)
1606	NEXTIFN() ; -- Retur ns next av ailable OR IFN
1607	"RTN","ORC SAVE",151, 0)
1608	N I,HDR,L AST,TOTAL, DA
1609	"RTN","ORC SAVE",152, 0)
1610	L +^OR(10 0,0):$S($G (DILOCKTM) >0:DILOCKT M,1:5)
1611	"RTN","ORC SAVE",153, 0)
1612	I '$T Q " ^"
1613	"RTN","ORC SAVE",154, 0)
1614	S HDR=$G( ^OR(100,0) ),TOTAL=+$ P(HDR,U,4) ,LAST=$O(^ OR(100,"?" ),-1)
1615	"RTN","ORC SAVE",155, 0)
1616	S I=LAST\ 1 F I=(I+1 ):1 Q:'$D( ^OR(100,I, 0))
1617	"RTN","ORC SAVE",156, 0)
1618	S DA=I,^O R(100,DA,0 )=DA,$P(HD R,U,3,4)=D A_U_(TOTAL +1)
1619	"RTN","ORC SAVE",157, 0)
1620	S ^OR(100 ,0)=HDR L -^OR(100,0 )
1621	"RTN","ORC SAVE",158, 0)
1622	Q DA
1623	"RTN","ORC SAVE",159, 0)
1624	;
1625	"RTN","ORC SAVE",160, 0)
1626	RESPONSE ; -- Save r esponses i n ORDIALOG () into ^O R(100,ORIF N,4.5)
1627	"RTN","ORC SAVE",161, 0)
1628	N PROMPT, CNT,ITM,TY PE,INST,VA LUE,I,STAR T,PAT,X
1629	"RTN","ORC SAVE",162, 0)
1630	S PAT=$P( ^OR(100,OR IFN,0),U,2 ),START=$P (^(0),U,8) K ^(4.5)
1631	"RTN","ORC SAVE",163, 0)
1632	S (PROMPT ,CNT)=0 F S PROMPT= $O(ORDIALO G(PROMPT)) Q:PROMPT' >0 D
1633	"RTN","ORC SAVE",164, 0)
1634	. S ITM=$ G(ORDIALOG (PROMPT)) Q:'ITM
1635	"RTN","ORC SAVE",165, 0)
1636	. S TYPE= $E($G(ORDI ALOG(PROMP T,0))) Q:' $L(TYPE)
1637	"RTN","ORC SAVE",166, 0)
1638	. S INST= 0 F S INS T=$O(ORDIA LOG(PROMPT ,INST)) Q: INST'>0 D
1639	"RTN","ORC SAVE",167, 0)
1640	. . S VAL UE=$G(ORDI ALOG(PROMP T,INST)) Q :VALUE="" S CNT=CNT +1
1641	"RTN","ORC SAVE",168, 0)
1642	. . S ^OR (100,ORIFN ,4.5,CNT,0 )=+ITM_U_P ROMPT_U_IN ST_U_$P(IT M,U,2)
1643	"RTN","ORC SAVE",169, 0)
1644	. . S:$L( $P(ITM,U,2 )) ^OR(100 ,ORIFN,4.5 ,"ID",$P(I TM,U,2),CN T)=""
1645	"RTN","ORC SAVE",170, 0)
1646	. . I VAL UE<1,TYPE= "N" S VALU E=0_+VALUE I VALUE=" 00" S VALU E=0
1647	"RTN","ORC SAVE",171, 0)
1648	. . S:TYP E'="W" ^OR (100,ORIFN ,4.5,CNT,1 )=VALUE
1649	"RTN","ORC SAVE",172, 0)
1650	. . M:TYP E="W" ^OR( 100,ORIFN, 4.5,CNT,2) =@VALUE ; array root
1651	"RTN","ORC SAVE",173, 0)
1652	S ^OR(100 ,ORIFN,4.5 ,0)="^100. 045A^"_CNT _U_CNT
1653	"RTN","ORC SAVE",174, 0)
1654	R1 ; [Rese t] Orderab les
1655	"RTN","ORC SAVE",175, 0)
1656	I $D(^OR( 100,ORIFN, .1)) S I=0 F S I=$O (^OR(100,O RIFN,.1,I) ) Q:I'>0 S X=$G(^(I ,0)) I X,P AT,START K ^OR(100," AOI",X,PAT ,9999999-S TART,ORIFN ) ; kill x ref
1657	"RTN","ORC SAVE",176, 0)
1658	K ^OR(100 ,ORIFN,.1) I $D(^OR( 100,ORIFN, 4.5,"ID"," ORDERABLE" )) D
1659	"RTN","ORC SAVE",177, 0)
1660	. S (I,CN T)=0
1661	"RTN","ORC SAVE",178, 0)
1662	. F S I= $O(^OR(100 ,ORIFN,4.5 ,"ID","ORD ERABLE",I) ) Q:I'>0 D
1663	"RTN","ORC SAVE",179, 0)
1664	. . S X=$ G(^OR(100, ORIFN,4.5, I,1)) Q:'X
1665	"RTN","ORC SAVE",180, 0)
1666	. . S CNT =CNT+1,^OR (100,ORIFN ,.1,CNT,0) =X,^OR(100 ,ORIFN,.1, "B",X,CNT) =""
1667	"RTN","ORC SAVE",181, 0)
1668	. . I PAT ,START S ^ OR(100,"AO I",X,PAT,9 999999-STA RT,ORIFN)= ""
1669	"RTN","ORC SAVE",182, 0)
1670	. S ^OR(1 00,ORIFN,. 1,0)="^100 .001PA^"_C NT_U_CNT
1671	"RTN","ORC SAVE",183, 0)
1672	Q
1673	"RTN","ORC SAVE",184, 0)
1674	;
1675	"RTN","ORC SAVE",185, 0)
1676	RESUME(IFN ) ; -- add Response nodes for RESUME tra y service
1677	"RTN","ORC SAVE",186, 0)
1678	; S ^OR(1 00,+IFN,4. 5,<next>,0 )=DT_"^^^R ESUME",^(1 )=1
1679	"RTN","ORC SAVE",187, 0)
1680	;
1681	"RTN","ORC SAVE",188, 0)
1682	N X,Y,DA, DIC,DLAYGO ,MSG
1683	"RTN","ORC SAVE",189, 0)
1684	D FIELD^D ID(100,4.5 ,"","SPECI FIER","MSG ")
1685	"RTN","ORC SAVE",190, 0)
1686	S DIC="^O R(100,"_+I FN_",4.5," ,DIC(0)="L X",DA(1)=+ IFN,X=DT
1687	"RTN","ORC SAVE",191, 0)
1688	S DIC("DR ")=".04/// RESUME",DI C("P")=$G( MSG("SPECI FIER")),DL AYGO=100
1689	"RTN","ORC SAVE",192, 0)
1690	D ^DIC S: Y ^OR(100, +IFN,4.5,+ Y,1)=1
1691	"RTN","ORC SAVE",193, 0)
1692	Q
1693	"RTN","ORC SAVE",194, 0)
1694	;
1695	"RTN","ORC SAVE",195, 0)
1696	PROVIDER(O RDER,PROV) ; -- Chan ge PROVide r assigned to ORDER
1697	"RTN","ORC SAVE",196, 0)
1698	Q:'$G(ORD ER) Q:'$G (PROV)
1699	"RTN","ORC SAVE",197, 0)
1700	N ORACT S ORACT=+$P (ORDER,";" ,2) S:'ORA CT ORACT=1
1701	"RTN","ORC SAVE",198, 0)
1702	S $P(^OR( 100,+ORDER ,8,ORACT,0 ),U,3)=PRO V
1703	"RTN","ORC SAVE",199, 0)
1704	S:ORACT=1 $P(^OR(10 0,+ORDER,0 ),U,4)=PRO V
1705	"RTN","ORC SAVE",200, 0)
1706	Q
1707	"RTN","ORC SAVE",201, 0)
1708	;
1709	"RTN","ORC SAVE",202, 0)
1710	ACTION(COD E,DA,PROV, REASON,WHE N,WHO) ; - - save new action
1711	"RTN","ORC SAVE",203, 0)
1712	N NEXT,TO TAL,HDR,LA ST,X,PAT,D GRP,SIG,NA TR,TXT S D A=+DA
1713	"RTN","ORC SAVE",204, 0)
1714	Q:'$D(^OR (100,DA,0) ) 0 Q:$G(C ODE)'?2U 0
1715	"RTN","ORC SAVE",205, 0)
1716	S:'$G(WHE N) WHEN=+$ E($$NOW^XL FDT,1,12) S:'$G(WHO) WHO=DUZ
1717	"RTN","ORC SAVE",206, 0)
1718	S NATR=+$ O(^ORD(100 .02,"C","E ",0)) ;ass ume Elec E ntered unt il changed
1719	"RTN","ORC SAVE",207, 0)
1720	S PAT=$P( ^OR(100,DA ,0),U,2),D GRP=$P(^(0 ),U,11),SI G=$P(^(0), U,16),X=+$ P($G(^(3)) ,U,7),HDR= $G(^(8,0))
1721	"RTN","ORC SAVE",208, 0)
1722	S:X'>0 X= 1 S TXT=$P ($G(^OR(10 0,DA,8,X,0 )),U,14) ; current ac tn's txt p tr
1723	"RTN","ORC SAVE",209, 0)
1724	S:HDR="" HDR="^100. 008DA^^" S TOTAL=+$P (HDR,U,4)
1725	"RTN","ORC SAVE",210, 0)
1726	S LAST=$O (^OR(100,D A,8,"C",CO DE,"?"),-1 ) I LAST D
1727	"RTN","ORC SAVE",211, 0)
1728	. S X=$G( ^OR(100,DA ,8,LAST,0) ) Q:$P(X,U ,15)'=11 Q:$P(X,U,4 )'=2
1729	"RTN","ORC SAVE",212, 0)
1730	. S NEXT= LAST I PAT ,$P(X,U) D ; kill o ld xref en tries
1731	"RTN","ORC SAVE",213, 0)
1732	. . K:DGR P ^OR(100, "ACT",PAT, (9999999-$ P(X,U)),DG RP,DA,NEXT )
1733	"RTN","ORC SAVE",214, 0)
1734	. . K ^OR (100,"AC", PAT,(99999 99-$P(X,U) ),DA,NEXT) ,^OR(100," AS",PAT,(9 999999-$P( X,U)),DA,N EXT),^OR(1 00,"AF",$P (X,U),DA,N EXT)
1735	"RTN","ORC SAVE",215, 0)
1736	. . I $P( X,U,3) K ^ OR(100,"EP RACDT",$P( X,U,3),$P( X,U),DA,NE XT) ; RB D OR3.04 53 Handle Kill of EP RACDT inde x as AF in dex is don e
1737	"RTN","ORC SAVE",216, 0)
1738	S:'$G(NEX T) NEXT=$O (^OR(100,D A,8,"?"),- 1)+1,TOTAL =TOTAL+1
1739	"RTN","ORC SAVE",217, 0)
1740	S ^OR(100 ,DA,8,NEXT ,0)=WHEN_U _CODE_U_$G (PROV)_U_$ S(SIG:2,1: 3)_"^^^^^^ ^^"_NATR_U _WHO_U_TXT _"^11",^OR (100,DA,8, "C",CODE,N EXT)=""
1741	"RTN","ORC SAVE",218, 0)
1742	S ^OR(100 ,"AF",WHEN ,DA,NEXT)= "" I $G(PR OV)]"" S ^ OR(100,"EP RACDT",PRO V,WHEN,DA, NEXT)="" ; RBD OR* 3.0*453 Ha ndle Set o f EPRACDT index
1743	"RTN","ORC SAVE",219, 0)
1744	I PAT,DGR P S ^OR(10 0,"ACT",PA T,9999999- WHEN,DGRP, DA,NEXT)=" "
1745	"RTN","ORC SAVE",220, 0)
1746	I PAT S ^ OR(100,"AC ",PAT,9999 999-WHEN,D A,NEXT)=""
1747	"RTN","ORC SAVE",221, 0)
1748	I SIG S ^ OR(100,"AS ",PAT,9999 999-WHEN,D A,NEXT)=""
1749	"RTN","ORC SAVE",222, 0)
1750	S:$L($G(R EASON)) ^O R(100,DA,8 ,NEXT,1)=R EASON
1751	"RTN","ORC SAVE",223, 0)
1752	S $P(HDR, U,3,4)=NEX T_U_TOTAL, ^OR(100,DA ,8,0)=HDR
1753	"RTN","ORC SAVE",224, 0)
1754	D ; DE3 504 - Jan 19, 2016 , US10045 - PB capture the DC of an order not signed in HMP(80 0000)
1755	"RTN","ORC SAVE",225, 0)
1756	. N FLD,H MDFN,HMORI S,JDSNOW,R SLT,SRVRNU M,VALS
1757	"RTN","ORC SAVE",226, 0)
1758	. S ORIFN =DA,HMDFN= +$P(^OR(10 0,+ORIFN,0 ),U,2),SRV RNUM=$$SRV RNO^HMPOR( HMDFN)
1759	"RTN","ORC SAVE",227, 0)
1760	. Q:'SRVR NUM ; pat ient not i n the HMP( 800000 fil e
1761	"RTN","ORC SAVE",228, 0)
1762	. S HMORI S=$$ORDRCH K^HMPOR(+O RIFN,HMDFN ) ; does order exis t? ; Jan 26, 2016 - DE3584
1763	"RTN","ORC SAVE",229, 0)
1764	. S JDSNO W=$$NOW^XL FDT
1765	"RTN","ORC SAVE",230, 0)
1766	. ;^(#.03 )SIGNED BY ^(#.04)SIG NED DATE/T IME^(#.14) ORDER ACTI ON^(#.15)A CTION DATE /TIME
1767	"RTN","ORC SAVE",231, 0)
1768	. S VALS( .03)=$G(WH O),VALS(.1 4)=$G(CODE ),VALS(.15 )=JDSNOW ; SIGNED B Y updated to reflect action us er
1769	"RTN","ORC SAVE",232, 0)
1770	. S:$G(SI G)'=2 VALS (.04)=JDSN OW ; SIG= 2 means NO T SIGNED, don't upda te SIGNED DATE/TIME
1771	"RTN","ORC SAVE",233, 0)
1772	. D:HMORI S UPDTORDR ^HMPOR(.RS LT,.VALS,+ ORIFN,HMDF N) ; orde r exists u pdate it
1773	"RTN","ORC SAVE",234, 0)
1774	. D:'HMOR IS ADDORDR ^HMPOR(.RS LT,.VALS,+ ORIFN,HMDF N) ; crea te new ord er in HMP( 800000)
1775	"RTN","ORC SAVE",235, 0)
1776	. D COMP^ ORMBLDOR(+ $G(ORIFN)) ; send m essage for completed orders
1777	"RTN","ORC SAVE",236, 0)
1778	. ; end D E3584
1779	"RTN","ORC SAVE",237, 0)
1780	Q NEXT
1781	"RTN","ORC SAVE",238, 0)
1782	;
1783	"RTN","ORC SAVE",239, 0)
1784	SET(DLG) ; -- Create new paren t for orde r set ORDI ALOG
1785	"RTN","ORC SAVE",240, 0)
1786	; Returns ORPIFN = ifn of new parent or der for se t
1787	"RTN","ORC SAVE",241, 0)
1788	;
1789	"RTN","ORC SAVE",242, 0)
1790	Q:'$G(ORV P) Q:'$G( DLG) N OR 0,PKG,NOW, CATG,STS,O RLOC,TRSPE C,X
1791	"RTN","ORC SAVE",243, 0)
1792	S OR0=$G( ^ORD(101.4 1,DLG,0)) Q:OR0="" S ORPIFN=$ $NEXTIFN Q :'ORPIFN
1793	"RTN","ORC SAVE",244, 0)
1794	S PKG=$O( ^DIC(9.4," C","OR",0) ),CATG=$S( $$INPT^ORC D:"I",1:"O "),STS=$S( $G(OREVENT ):10,1:11) ,NOW=$S($G (ORSLOG):O RSLOG,1:+$ E($$NOW^XL FDT,1,12))
1795	"RTN","ORC SAVE",245, 0)
1796	I $G(OREV ENT) S ORL OC="",TRSP EC=""
1797	"RTN","ORC SAVE",246, 0)
1798	S ^OR(100 ,ORPIFN,0) =ORPIFN_U_ ORVP_U_U_$ G(ORNP)_U_ DLG_";ORD( 101.41,^"_ DUZ_U_NOW_ U_U_U_ORLO C_U_U_CATG _U_TRSPEC_ U_PKG_"^^^ "_$G(OREVE NT),^(3)=N OW_"^90^"_ STS_U_$S($ G(ORIT):OR IT_"ORD(10 1.41,",1:" ")_"^^^1^^ ^^0^^"_+$P (OR0,U,6)
1799	"RTN","ORC SAVE",247, 0)
1800	S ^OR(100 ,ORPIFN,8, 0)="^100.0 08DA^1^1", ^(1,0)=NOW _"^NW^"_$G (ORNP)_"^^ ^^^^^^^^"_ DUZ_"^^"_S TS,^OR(100 ,ORPIFN,8, "C","NW",1 )="",^OR(1 00,"AF",NO W,ORPIFN,1 )=""
1801	"RTN","ORC SAVE",248, 0)
1802	I $G(ORNP )]"" S ^OR (100,"EPRA CDT",ORNP, NOW,ORPIFN ,1)="" ; RBD OR3. 0453 Set new EPRACD T index ex plicitly a s AF index is done
1803	"RTN","ORC SAVE",249, 0)
1804	S ^OR(100 ,"ACT",ORV P,9999999- NOW,ORPIFN ,1)=""
1805	"RTN","ORC SAVE",250, 0)
1806	S:STS=11 ^OR(100,"A C",ORVP,99 99999-NOW, ORPIFN,1)= ""
1807	"RTN","ORC SAVE",251, 0)
1808	; AEVNT ? ?
1809	"RTN","ORC SAVE",252, 0)
1810	S ^OR(100 ,ORPIFN,1, 0)="^100.0 11^1^1",^( 1,0)=$P(OR 0,U,2) ; O rder text
1811	"RTN","ORC SAVE",253, 0)
1812	Q
1813	"RTN","ORE LR5")
1814	0^3^B27530 747^B25558 758
1815	"RTN","ORE LR5",1,0)
1816	ORELR5 ; s lc/dcm - C heck 69 ag ainst 100 ;06/09/17 08:47
1817	"RTN","ORE LR5",2,0)
1818	;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;4 2,453;De c 17, 1997 ;Build 4
1819	"RTN","ORE LR5",3,0)
1820	EN ;Check file 69 ag ainst 100 for incons istencies
1821	"RTN","ORE LR5",4,0)
1822	N %,UPD,Z TSAVE
1823	"RTN","ORE LR5",5,0)
1824	W !!,"Thi s routine will go th rough the LAB ORDER ENTRY file (69)"
1825	"RTN","ORE LR5",6,0)
1826	W !,"and check for inconsiste ncies betw een Lab fi les and CP RS files."
1827	"RTN","ORE LR5",7,0)
1828	W !,"This process c ould take several ho urs to com plete."
1829	"RTN","ORE LR5",8,0)
1830	W !,"Are you sure y ou want to continue"
1831	"RTN","ORE LR5",9,0)
1832	S %=2 D Y N^DICN
1833	"RTN","ORE LR5",10,0)
1834	I %=0 W ! !,"Answer YES to con tinue" G E N
1835	"RTN","ORE LR5",11,0)
1836	Q:%'=1
1837	"RTN","ORE LR5",12,0)
1838	UPD W !!," You have t he option of just ch ecking the database, or updati ng the dat abase."
1839	"RTN","ORE LR5",13,0)
1840	W !,"Do y ou want to update th e database now"
1841	"RTN","ORE LR5",14,0)
1842	S %=2 D Y N^DICN
1843	"RTN","ORE LR5",15,0)
1844	I %=0 W ! !,"Select YES to upd ate the da tabase" G UPD
1845	"RTN","ORE LR5",16,0)
1846	Q:%=-1
1847	"RTN","ORE LR5",17,0)
1848	S UPD=$S( %=1:1,1:0)
1849	"RTN","ORE LR5",18,0)
1850	S ZTSAVE( "UPD")=""
1851	"RTN","ORE LR5",19,0)
1852	D QUE^ORU TL1("DEQUE ^ORELR5"," Check from 69 to 100 ",.ZTSAVE)
1853	"RTN","ORE LR5",20,0)
1854	Q
1855	"RTN","ORE LR5",21,0)
1856	DEQUE ;Que ued entry point
1857	"RTN","ORE LR5",22,0)
1858	U IO
1859	"RTN","ORE LR5",23,0)
1860	W !,"Inco nsistency report bet ween LAB ( 69) and OE /RR (100) files..."
1861	"RTN","ORE LR5",24,0)
1862	W !,"Date /time Star ted: "_$$D ATETIME^OR U($$NOW^XL FDT())
1863	"RTN","ORE LR5",25,0)
1864	W !,"Now looking fo r data..."
1865	"RTN","ORE LR5",26,0)
1866	N LRDFN,O RAFIX,STCN T,TOTCNT,D CNT,PTCNT, F100CNT,EN TCNT
1867	"RTN","ORE LR5",27,0)
1868	S (ORAFIX ,STCNT,TOT CNT,DCNT,P TCNT,F100C NT,ENTCNT, LRDFN)=0
1869	"RTN","ORE LR5",28,0)
1870	F S LRDF N=$O(^LRO( 69,"D",LRD FN)) Q:LRD FN<1 D LO OP(LRDFN,U PD)
1871	"RTN","ORE LR5",29,0)
1872	W:IOSL-$Y <10 @IOF
1873	"RTN","ORE LR5",30,0)
1874	W !!,"Tot al Inconsi stencies F ound"
1875	"RTN","ORE LR5",31,0)
1876	W !,"Date /time Comp leted: "_$ $DATETIME^ ORU($$NOW^ XLFDT())
1877	"RTN","ORE LR5",32,0)
1878	W !,"---- ---------- ---------- ---------- ---------- -----"
1879	"RTN","ORE LR5",33,0)
1880	I DCNT W !,"Bad ent ry in ^LRO (69,""D""" ,?40,$J(DC NT,7)
1881	"RTN","ORE LR5",34,0)
1882	I F100CNT W !,"Brok en pointer to 100",? 40,$J(F100 CNT,7)
1883	"RTN","ORE LR5",35,0)
1884	I ENTCNT W !,"Incon sistent en try dates" ,?40,$J(EN TCNT,7)
1885	"RTN","ORE LR5",36,0)
1886	I PTCNT W !,"Patien t mismatch "_$S(UPD:" (not fixe d)",1:""), ?40,$J(PTC NT,7)
1887	"RTN","ORE LR5",37,0)
1888	I STCNT W !,"Status update on panel tes t",?40,$J( STCNT,7)
1889	"RTN","ORE LR5",38,0)
1890	W !,"==== ========== ========== ========== ========== ====="
1891	"RTN","ORE LR5",39,0)
1892	W !,"Tota l: ",?40,$ J(TOTCNT,7 )
1893	"RTN","ORE LR5",40,0)
1894	I $D(ZTQU EUED) S ZT REQ="@"
1895	"RTN","ORE LR5",41,0)
1896	Q
1897	"RTN","ORE LR5",42,0)
1898	LOOP(LRDFN ,ORAFIX) ; Loop on pa tient
1899	"RTN","ORE LR5",43,0)
1900	I '$D(^LR (LRDFN,0)) D WRT(,,, "No entry in ^LR("_L RDFN,ORAFI X) S DCNT= DCNT+1,TOT CNT=TOTCNT +1 K:ORAFI X ^LRO(69, "D",LRDFN) Q
1901	"RTN","ORE LR5",44,0)
1902	Q:$P(^LR( LRDFN,0)," ^",2)'=2 ;Not in pa tient file .
1903	"RTN","ORE LR5",45,0)
1904	S DFN=$P( ^LR(LRDFN, 0),"^",3)
1905	"RTN","ORE LR5",46,0)
1906	Q:'$D(^LR O(69,"D",$ G(LRDFN)))
1907	"RTN","ORE LR5",47,0)
1908	N LRODT,L RSN,LRTI,L RTST,LRENT ,X,X0,X3,O RX1,ORX2,O RIFN,X8O
1909	"RTN","ORE LR5",48,0)
1910	S LRODT=0 F S LROD T=$O(^LRO( 69,"D",LRD FN,LRODT)) Q:'LRODT S LRSN=0 F S LRSN= $O(^LRO(69 ,"D",LRDFN ,LRODT,LRS N)) Q:'LRS N D
1911	"RTN","ORE LR5",49,0)
1912	. I '$D(^ LRO(69,LRO DT,1,LRSN, 0)) D WRT( LRODT,LRSN ,,"D X-ref invalid", ORAFIX) S DCNT=DCNT+ 1,TOTCNT=T OTCNT+1 K: ORAFIX ^LR O(69,"D",L RDFN,LRODT ,LRSN) Q
1913	"RTN","ORE LR5",50,0)
1914	. S X=^LR O(69,LRODT ,1,LRSN,0) ,LRENT=$P( X,"^",5)
1915	"RTN","ORE LR5",51,0)
1916	. S LRTI= 0 F S LRT I=$O(^LRO( 69,LRODT,1 ,LRSN,2,LR TI)) Q:LRT I<1 S X0= ^(LRTI,0) D
1917	"RTN","ORE LR5",52,0)
1918	.. S LRTS T=+X0,ORIF N=$P(X0,"^ ",7)
1919	"RTN","ORE LR5",53,0)
1920	.. I ORIF N D
1921	"RTN","ORE LR5",54,0)
1922	... I '$D (^OR(100,O RIFN)) D W RT(LRODT,L RSN,LRTI," Broken poi nter to 10 0:"_ORIFN, ORAFIX) S F100CNT=F1 00CNT+1,TO TCNT=TOTCN T+1 S:ORAF IX $P(^LRO (69,LRODT, 1,LRSN,2,L RTI,0),"^" ,7)="P" Q ;P=purged
1923	"RTN","ORE LR5",55,0)
1924	... S X=^ OR(100,ORI FN,0),X3=$ G(^(3))
1925	"RTN","ORE LR5",56,0)
1926	... I DFN '=+$P(X,"^ ",2) D WRT (LRODT,LRS N,LRTI,"Pa tient mism atch:"_ORI FN_"<"_$P( X3,"^",3)_ ">") S PTC NT=PTCNT+1 ,TOTCNT=TO TCNT+1 Q
1927	"RTN","ORE LR5",57,0)
1928	... D STA TUS(LRODT, LRSN,LRTI, X0,ORAFIX)
1929	"RTN","ORE LR5",58,0)
1930	... I LRE NT,$P(X,"^ ",7)>$S($P ($P(X,"^", 8),".",2): $P(X,"^",8 ),1:$P(X," ^",8)_".23 59") D
1931	"RTN","ORE LR5",59,0)
1932	.... S OR X1=$$FMADD ^XLFDT($P( X,"^",7),, ,30),ORX2= $$FMADD^XL FDT($P(X," ^",7),,,-3 0)
1933	"RTN","ORE LR5",60,0)
1934	.... I LR ENT<ORX2!( LRENT>ORX1 ) S ENTCNT =ENTCNT+1, TOTCNT=TOT CNT+1 I OR AFIX D
1935	"RTN","ORE LR5",61,0)
1936	..... S $ P(^OR(100, ORIFN,0)," ^",7)=LREN T
1937	"RTN","ORE LR5",62,0)
1938	..... I $ P(X,"^",7) =+$G(^OR(1 00,ORIFN,8 ,1,0)) S X 8O=$G(^(0) ) D
1939	"RTN","ORE LR5",63,0)
1940	...... N DI,DIC,DIE ,DA,DR,D0, DQ,DISYS
1941	"RTN","ORE LR5",64,0)
1942	...... I $P(X,"^",1 1) K ^OR(1 00,"ACT",$ P(X,"^",2) ,9999999-+ X8O,$P(X," ^",11),ORI FN,1)
1943	"RTN","ORE LR5",65,0)
1944	...... K ^OR(100,"A C",$P(X,"^ ",2),99999 99-+X8O,OR IFN,1),^OR (100,"AF", +X8O,ORIFN ,1),^OR(10 0,"AS",$P( X,"^",2),9 999999-(+X 8O),ORIFN, 1)
1945	"RTN","ORE LR5",66,0)
1946	...... I $P(X8O,"^" ,3) K ^OR( 100,"EPRAC DT",$P(X8O ,"^",3),+X 8O,ORIFN,1 ) ; RBD OR3.0453 Clean up new EPRACD T index al so
1947	"RTN","ORE LR5",67,0)
1948	...... I $P(X8O,"^" ,16)=+X8O K ^OR(100, "AR",$P(X, "^",2),999 9999-(+X8O ),ORIFN,1) S ^OR(100 ,"AR",$P(X ,"^",2),99 99999-LREN T,ORIFN,1) ="",$P(^OR (100,ORIFN ,8,1,0),"^ ",16)=LREN T
1949	"RTN","ORE LR5",68,0)
1950	...... S $P(^OR(100 ,ORIFN,8,1 ,0),"^")=L RENT,^OR(1 00,"AF",LR ENT,ORIFN, 1)=""
1951	"RTN","ORE LR5",69,0)
1952	...... S ^OR(100,"E PRACDT",$P (X8O,"^",3 ),LRENT,OR IFN,1)="" ; RBD OR 3.0453 R eset EPRAC DT index a lso
1953	"RTN","ORE LR5",70,0)
1954	...... D S1^ORDD100 (ORIFN,1," ",LRENT),S ET^ORDD100 (ORIFN,1), ACT1^ORDD1 00A(ORIFN, 1)
1955	"RTN","ORE LR5",71,0)
1956	Q
1957	"RTN","ORE LR5",72,0)
1958	WRT(LRODT, LRSN,LRTST ,TEXT,FIXE D) ;Write error mess age
1959	"RTN","ORE LR5",73,0)
1960	Q:$E(IOST ,1,2)="P-"
1961	"RTN","ORE LR5",74,0)
1962	W "."
1963	"RTN","ORE LR5",75,0)
1964	;W !,$G(L RODT)_";"_ $G(LRSN)_" ;"_$G(LRTS T)_"=>"_TE XT_$S($G(F IXED):" FI XED",1:"")
1965	"RTN","ORE LR5",76,0)
1966	Q
1967	"RTN","ORE LR5",77,0)
1968	STATUS(I,J ,K,Z,UPDAT E) ;Check status of exploded p anels
1969	"RTN","ORE LR5",78,0)
1970	Q:'$D(^LR O(69,I,1,J ,2,K,0)) S:'$D(Z) Z =^(0)
1971	"RTN","ORE LR5",79,0)
1972	N F,X,X7, Z7,ORSTS,O RIFN
1973	"RTN","ORE LR5",80,0)
1974	K ^TMP("O RCHKLRO",$ J)
1975	"RTN","ORE LR5",81,0)
1976	S F=1,Z7= $P(Z,"^",7 )
1977	"RTN","ORE LR5",82,0)
1978	I $P(Z,"^ ",8) D
1979	"RTN","ORE LR5",83,0)
1980	. N TST,T ,N
1981	"RTN","ORE LR5",84,0)
1982	. S T=0 F S T=$O(^ LAB(60,+Z, 2,T)) Q:'T S TST(+^ (T,0))=""
1983	"RTN","ORE LR5",85,0)
1984	. S T=0 F S T=$O(T ST(T)) Q:' T I $D(^L RO(69,I,1, J,2,"B",T) ) S N=$O(^ (T,0)) I $ D(^LRO(69, I,1,J,2,N, 0)) S X=^ (0),X7=$P( X,"^",7) D
1985	"RTN","ORE LR5",86,0)
1986	.. I X7,Z 7,X7'=Z7,' $D(^TMP("O RCHKLRO",$ J,Z7)) D Q
1987	"RTN","ORE LR5",87,0)
1988	... N X1, X2
1989	"RTN","ORE LR5",88,0)
1990	... S X1= $P($G(^OR( 100,X7,3)) ,"^",3),X2 =$P($G(^OR (100,Z7,3) ),"^",3)
1991	"RTN","ORE LR5",89,0)
1992	... Q:X1= "" Q:X2=" " Q:X1=X2 Q:X2=14 Q:X2=1 Q :X2=2 Q:X 2=13
1993	"RTN","ORE LR5",90,0)
1994	... I F S STCNT=STC NT+1,TOTCN T=TOTCNT+1
1995	"RTN","ORE LR5",91,0)
1996	... S F=0
1997	"RTN","ORE LR5",92,0)
1998	... I $G( UPDATE) D
1999	"RTN","ORE LR5",93,0)
2000	.... I $S (+$G(^DD(1 00,0,"VR") ):+^("VR") ,1:0)<3 S ORSTS=X1,O RIFN=Z7 D ST^ORX
2001	"RTN","ORE LR5",94,0)
2002	.... I $S (+$G(^DD(1 00,0,"VR") ):+^("VR") ,1:0)'<3 D STATUS^OR CSAVE2(Z7, X1)
2003	"RTN","ORE LR5",95,0)
2004	.... S ^T MP("ORCHKL RO",$J,Z7) =""
2005	"RTN","ORE LR5",96,0)
2006	K ^TMP("O RCHKLRO",$ J)
2007	"RTN","ORE LR5",97,0)
2008	Q
2009	"RTN","ORQ 2")
2010	0^4^B94012 922^B60457 146
2011	"RTN","ORQ 2",1,0)
2012	ORQ2 ; SLC /MKB/GSS - Detailed Order Repo rt ;06/08/ 17 20:04
2013	"RTN","ORQ 2",2,0)
2014	;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;1 2,56,75,94 ,141,213,1 95,243,282 ,293,280,3 46,361,405 ,453;Dec 17, 1997; Build 4
2015	"RTN","ORQ 2",3,0)
2016	;
2017	"RTN","ORQ 2",4,0)
2018	;
2019	"RTN","ORQ 2",5,0)
2020	;Referenc e to ^DIC( 45.7 suppo rted by IA #519
2021	"RTN","ORQ 2",6,0)
2022	;Referenc e to OERR^ VADPT supp orted by I A #4325
2023	"RTN","ORQ 2",7,0)
2024	;Referenc e to CODEC S^ICDEX su pported by ICR #5747
2025	"RTN","ORQ 2",8,0)
2026	;
2027	"RTN","ORQ 2",9,0)
2028	DETAIL(ORY ,ORIFN) ; -- Returns details o f order OR IFN in ORY (#)
2029	"RTN","ORQ 2",10,0)
2030	N X,X2,I, CNT,ORDIAL OG,OR0,OR3 ,OR6,SEQ,I TEM,PRMT,M ULT,FIRST, TITLE,INST ,DIWL,DIWR ,DIWF,ACTI ON,VAIN,OR IGVIEW,ORN MSP,ORYT
2031	"RTN","ORQ 2",11,0)
2032	N ORTRANS
2033	"RTN","ORQ 2",12,0)
2034	S CNT=0,O RIFN=+ORIF N,OR0=$G(^ OR(100,ORI FN,0)),OR3 =$G(^(3)), OR6=$G(^(6 ))
2035	"RTN","ORQ 2",13,0)
2036	S ORNMSP= $$NMSP^ORC D($P(OR0,U ,14))
2037	"RTN","ORQ 2",14,0)
2038	K @ORY,OR YT S ORIGV IEW=1 D TE XT^ORQ12(. ORYT,+ORIF N_";"_+$P( OR3,U,7),8 0) ;CurrTx
2039	"RTN","ORQ 2",15,0)
2040	M @ORY=OR YT ;Move t ext to glo bal
2041	"RTN","ORQ 2",16,0)
2042	S I=0 F C NT=1:1 S I =$O(ORYT(I )) Q:I'>0 D:$D(IORV ON) SETVID EO(I,1,$L( ORYT(I)),I ORVON,IORV OFF)
2043	"RTN","ORQ 2",17,0)
2044	S CNT=CNT +1,@ORY@(C NT)=" " ;blank
2045	"RTN","ORQ 2",18,0)
2046	D1 I $O(^O R(100,+ORI FN,2,0)) D
2047	"RTN","ORQ 2",19,0)
2048	. S CNT=C NT+1,@ORY@ (CNT)="Sub Orders:"
2049	"RTN","ORQ 2",20,0)
2050	. D:$D(IO UON) SETVI DEO(CNT,1, 11,IOUON,I OUOFF)
2051	"RTN","ORQ 2",21,0)
2052	. N IFN S IFN=0
2053	"RTN","ORQ 2",22,0)
2054	. F S IF N=+$O(^OR( 100,+ORIFN ,2,IFN)) Q :IFN<1 I $D(^OR(100 ,IFN,0)) D SUB(IFN)
2055	"RTN","ORQ 2",23,0)
2056	. S CNT=C NT+1,@ORY@ (CNT)=" " ;blank
2057	"RTN","ORQ 2",24,0)
2058	I $P(OR3, U,9),$D(^O R(100,+$P( OR3,U,9),0 )) D
2059	"RTN","ORQ 2",25,0)
2060	. S CNT=C NT+1,@ORY@ (CNT)="Par ent Order: "
2061	"RTN","ORQ 2",26,0)
2062	. D:$D(IO UON) SETVI DEO(CNT,1, 12,IOUON,I OUOFF)
2063	"RTN","ORQ 2",27,0)
2064	. D SUB(+ $P(OR3,U,9 ))
2065	"RTN","ORQ 2",28,0)
2066	. S CNT=C NT+1,@ORY@ (CNT)=" " ;blank
2067	"RTN","ORQ 2",29,0)
2068	I $P(OR3, U,11)=1,$P (OR3,U,5) D ;Change d - show p revious or der
2069	"RTN","ORQ 2",30,0)
2070	. S CNT=C NT+1,@ORY@ (CNT)="Pre vious Orde r:"
2071	"RTN","ORQ 2",31,0)
2072	. D:$D(IO UON) SETVI DEO(CNT,1, 15,IOUON,I OUOFF) ;pr ev order o riginal te xt
2073	"RTN","ORQ 2",32,0)
2074	. N ORZ,I ,ORIGVIEW S ORIGVIEW =2 D TEXT^ ORQ12(.ORZ ,+$P(OR3,U ,5),55)
2075	"RTN","ORQ 2",33,0)
2076	. S CNT=C NT+1,@ORY@ (CNT)=" Order Te xt: "_$G(ORZ( 1))
2077	"RTN","ORQ 2",34,0)
2078	. S I=1 F S I=$O(O RZ(I)) Q:I '>0 S CNT =CNT+1,@OR Y@(CNT)=$$ REPEAT^XLF STR(" ",24 )_$G(ORZ(I ))
2079	"RTN","ORQ 2",35,0)
2080	D2 S CNT=C NT+1,@ORY@ (CNT)="Act ivity:"
2081	"RTN","ORQ 2",36,0)
2082	D:$D(IOUO N) SETVIDE O(CNT,1,9, IOUON,IOUO FF)
2083	"RTN","ORQ 2",37,0)
2084	S DIWL=1, DIWR=64,DI WF="C64",O RI=0 K ^UT ILITY($J," W")
2085	"RTN","ORQ 2",38,0)
2086	F S ORI= $O(^OR(100 ,ORIFN,8,O RI)) Q:ORI '>0 S ACT ION=$G(^(O RI,0)) D A CT^ORQ20
2087	"RTN","ORQ 2",39,0)
2088	; RBD OR* 3.0*453 Ad d ORDER TR ANSFERS in formation
2089	"RTN","ORQ 2",40,0)
2090	S ORI=0 F S ORI=$O (^OR(100,O RIFN,11,OR I)) Q:ORI' >0 D
2091	"RTN","ORQ 2",41,0)
2092	. I ORI=1 D
2093	"RTN","ORQ 2",42,0)
2094	.. S CNT= CNT+1,@ORY @(CNT)=" ",CNT=CNT +1,@ORY@(C NT)="Reass ignments ( Transfers) :"
2095	"RTN","ORQ 2",43,0)
2096	. S ORTRA NS=$G(^OR( 100,ORIFN, 11,ORI,0))
2097	"RTN","ORQ 2",44,0)
2098	. S CNT=C NT+1,@ORY@ (CNT)="Tra nsferred f rom "_$$US ER^ORQ20($ P(ORTRANS, U,2))_" to "_$$USER^ ORQ20($P(O RTRANS,U,3 ))
2099	"RTN","ORQ 2",45,0)
2100	. S CNT=C NT+1,@ORY@ (CNT)=" b y "_$$USER ^ORQ20($P( ORTRANS,U, 4))_" Effe ctive From "_$$DATE^ ORQ20($P(O RTRANS,U))
2101	"RTN","ORQ 2",46,0)
2102	I $D(^OR( 100,ORIFN, 11)) S CNT =CNT+1,@OR Y@(CNT)=" "
2103	"RTN","ORQ 2",47,0)
2104	I "^1^12^ 13^"[(U_$P (OR3,U,3)_ U),$L(OR6) ,$P(ACTION ,U,2)'="DC " D DC^ORQ 20
2105	"RTN","ORQ 2",48,0)
2106	I $P(OR3, U,3)=2,$P( OR6,U,6) S CNT=CNT+1 ,@ORY@(CNT )=$$DATE^O RQ20($P(OR 6,U,6))_" Completed "_$S($P(OR 6,U,7):" b y "_$$USER ^ORQ20($P( OR6,U,7)), 1:"")
2107	"RTN","ORQ 2",49,0)
2108	S CNT=CNT +1,@ORY@(C NT)=" " ;blank
2109	"RTN","ORQ 2",50,0)
2110	D3 S CNT=C NT+1,@ORY@ (CNT)="Cur rent Data: "
2111	"RTN","ORQ 2",51,0)
2112	D:$D(IOUO N) SETVIDE O(CNT,1,13 ,IOUON,IOU OFF)
2113	"RTN","ORQ 2",52,0)
2114	D VA I $G (VAIN(2)) S CNT=CNT+ 1,@ORY@(CN T)="Curren t Primary Provider: "_$P(V AIN(2),"^" ,2)
2115	"RTN","ORQ 2",53,0)
2116	I $G(VAIN (11)) S CN T=CNT+1,@O RY@(CNT)=" Current At tending Ph ysician: "_$P(VAIN( 11),"^",2)
2117	"RTN","ORQ 2",54,0)
2118	S CNT=CNT +1,@ORY@(C NT)="Treat ing Specia lty: "_$P( $G(^DIC(45 .7,+$P(OR0 ,U,13),0)) ,U)
2119	"RTN","ORQ 2",55,0)
2120	S CNT=CNT +1,@ORY@(C NT)="Order ing Locati on: "_$P( $G(^SC(+$P (OR0,U,10) ,0)),U)
2121	"RTN","ORQ 2",56,0)
2122	S CNT=CNT +1,@ORY@(C NT)="Start Date/Time : "_$S( $P(OR0,U,8 ):$$DATE^O RQ20($P(OR 0,U,8)),1: "")
2123	"RTN","ORQ 2",57,0)
2124	I $P(OR3, U,5),$P(OR 3,U,11)=2 S X=$$ORIG (ORIFN),@O RY@(CNT)=@ ORY@(CNT)_ " (origina lly "_$$DA TE^ORQ20(X )_")"
2125	"RTN","ORQ 2",58,0)
2126	S CNT=CNT +1,@ORY@(C NT)="Stop Date/Time: "_$S( $P(OR0,U,9 ):$$DATE^O RQ20($P(OR 0,U,9)),1: "")
2127	"RTN","ORQ 2",59,0)
2128	I $P(OR3, U,3)=1,$P( OR6,U,6) S @ORY@(CNT )=@ORY@(CN T)_" (exp ired "_$$D ATE^ORQ20( $P(OR6,U,6 ))_")"
2129	"RTN","ORQ 2",60,0)
2130	S CNT=CNT +1,@ORY@(C NT)="Curre nt Status: "_$S( $D(^ORD(10 0.01,+$P(O R3,U,3),0) ):$P(^(0), "^"),1:"-" )
2131	"RTN","ORQ 2",61,0)
2132	I $$GET^X PAR("ALL", "ORPF SHOW STATUS DE SCRIPTION" ,1,"I"),$P (OR3,U,3), $D(^ORD(10 0.01,$P(OR 3,U,3),0)) N J S J=0 F S J=$O (^ORD(100. 01,$P(OR3, U,3),1,J)) Q:J<1 S CNT=CNT+1, @ORY@(CNT) =" "_^(J, 0)
2133	"RTN","ORQ 2",62,0)
2134	S CNT=CNT +1,@ORY@(C NT)="Order #"_ORIFN
2135	"RTN","ORQ 2",63,0)
2136	S CNT=CNT +1,@ORY@(C NT)=" " ;blank
2137	"RTN","ORQ 2",64,0)
2138	D4 S CNT=C NT+1,@ORY@ (CNT)="Ord er:" D:$D( IOUON) SET VIDEO(CNT, 1,6,IOUON, IOUOFF)
2139	"RTN","ORQ 2",65,0)
2140	I '$O(^OR (100,ORIFN ,4.5,0)),O RNMSP="RA" D RAD^ORQ 21("") Q
2141	"RTN","ORQ 2",66,0)
2142	S ORDIALO G=$P(OR0,U ,5) Q:$P(O RDIALOG,"; ",2)="ORD( 101," ; 2 .5 order
2143	"RTN","ORQ 2",67,0)
2144	D GETDLG^ ORCD(+ORDI ALOG),GETO RDER^ORCD( ORIFN)
2145	"RTN","ORQ 2",68,0)
2146	I ORNMSP= "GMRC" D G MRCXTRA
2147	"RTN","ORQ 2",69,0)
2148	S DIWL=1, DIWR=50,DI WF="C50"
2149	"RTN","ORQ 2",70,0)
2150	S SEQ=0 F S SEQ=$O (^ORD(101. 41,+ORDIAL OG,10,"B", SEQ)) Q:SE Q'>0 S DA =0 F S DA =$O(^ORD(1 01.41,+ORD IALOG,10," B",SEQ,DA) ) Q:'DA D
2151	"RTN","ORQ 2",71,0)
2152	. S ITEM= $G(^ORD(10 1.41,+ORDI ALOG,10,DA ,0)) Q:$P( ITEM,U,11) ; child
2153	"RTN","ORQ 2",72,0)
2154	. S PRMT= $P(ITEM,U, 2),MULT=$P (ITEM,U,7) Q:$P(ITEM ,U,9)["*" ;hide
2155	"RTN","ORQ 2",73,0)
2156	. S FIRST =$O(ORDIAL OG(PRMT,0) ) Q:'FIRST ; no val ues
2157	"RTN","ORQ 2",74,0)
2158	. S TITLE =$S(MULT&$ L($G(ORDIA LOG(PRMT," TTL"))):OR DIALOG(PRM T,"TTL"),1 :ORDIALOG( PRMT,"A"))
2159	"RTN","ORQ 2",75,0)
2160	. S TITLE =TITLE_$$R EPEAT^XLFS TR(" ",30- $L(TITLE))
2161	"RTN","ORQ 2",76,0)
2162	. S INST= 0 F S INS T=$O(ORDIA LOG(PRMT,I NST)) Q:IN ST'>0 D
2163	"RTN","ORQ 2",77,0)
2164	. . I $E( ORDIALOG(P RMT,0))="W " D WP Q
2165	"RTN","ORQ 2",78,0)
2166	. . K ^UT ILITY($J," W") S X=$$ EXT^ORCD(P RMT,INST) I TITLE["I nfusion Ra te"&(X'="" )&(X'["ml/ hr") S TIT LE="Infuse Over Time :",TITLE=T ITLE_$$REP EAT^XLFSTR (" ",30-$L (TITLE))
2167	"RTN","ORQ 2",79,0)
2168	. . D ^DI WP
2169	"RTN","ORQ 2",80,0)
2170	. . D:$D( ^ORD(101.4 1,+ORDIALO G,10,"DAD" ,PRMT)) CH ILDREN(PRM T)
2171	"RTN","ORQ 2",81,0)
2172	. . S I=0 F S I=$O (^UTILITY( $J,"W",DIW L,I)) Q:I' >0 S CNT= CNT+1,@ORY @(CNT)=$S( (INST=FIRS T)&(I=1):T ITLE,1:$$R EPEAT^XLFS TR(" ",30) )_^(I,0)
2173	"RTN","ORQ 2",82,0)
2174	I ORNMSP= "GMRC",$G( ^OR(100,OR IFN,4)) S CNT=CNT+1, @ORY@(CNT) ="Consult No.: "_+^(4)
2175	"RTN","ORQ 2",83,0)
2176	S CNT=CNT +1,@ORY@(C NT)=" " ;blank
2177	"RTN","ORQ 2",84,0)
2178	D RAD^ORQ 21(1):ORNM SP="RA",ME D^ORQ21:OR NMSP="PS" ;add'l dat a
2179	"RTN","ORQ 2",85,0)
2180	D BA^ORQ2 1 ;call fo r CIDC dat a
2181	"RTN","ORQ 2",86,0)
2182	D5 K ^TMP( $J,"OCDATA ") I $$OCA PI^ORCHECK (+ORIFN,"O CDATA") D
2183	"RTN","ORQ 2",87,0)
2184	. N CK,OK ,X0,X,CDL, I,ACK,ALLG YDRG,HDR S HDR=0
2185	"RTN","ORQ 2",88,0)
2186	. D:$D(IO UON) SETVI DEO(CNT,1, 13,IOUON,I OUOFF)
2187	"RTN","ORQ 2",89,0)
2188	. S ACK=0
2189	"RTN","ORQ 2",90,0)
2190	. D ALLER GY ;405
2191	"RTN","ORQ 2",91,0)
2192	. S:$D(OK ) OK="" ;405
2193	"RTN","ORQ 2",92,0)
2194	. S CK=0 F S CK=$O (^TMP($J," OCDATA",CK )) Q:CK'>0 D
2195	"RTN","ORQ 2",93,0)
2196	.. Q:$D(A LLGYDRG(CK )) ;405
2197	"RTN","ORQ 2",94,0)
2198	.. S:HDR= 0 CNT=CNT+ 1,@ORY@(CN T)=" ",CNT =CNT+1,@OR Y@(CNT)="O rder Check s:",HDR=1
2199	"RTN","ORQ 2",95,0)
2200	.. S X0=^ TMP($J,"OC DATA",CK," OC NUMBER" )_U_^TMP($ J,"OCDATA" ,CK,"OC LE VEL")_U_U_ ^TMP($J,"O CDATA",CK, "OR REASON ")_U_^TMP( $J,"OCDATA ",CK,"OR P ROVIDER")_ U_^TMP($J, "OCDATA",C K,"OR DT")
2201	"RTN","ORQ 2",96,0)
2202	.. S X=^T MP($J,"OCD ATA",CK,"O C TEXT",1, 0)
2203	"RTN","ORQ 2",97,0)
2204	.. S CDL= $$CDL($P(X 0,U,2)) I $P(X0,U,6) ,'$D(OK) S OK=$P(X0, U,4,6)
2205	"RTN","ORQ 2",98,0)
2206	.. I $L(X )'>68 S CN T=CNT+1,@O RY@(CNT)=C DL_X D XTR A Q
2207	"RTN","ORQ 2",99,0)
2208	.. S DIWL =1,DIWR=68 ,DIWF="C68 " K ^UTILI TY($J,"W") D ^DIWP
2209	"RTN","ORQ 2",100,0)
2210	.. S I=0 F S I=$O( ^UTILITY($ J,"W",DIWL ,I)) Q:I'> 0 S CNT=C NT+1,@ORY@ (CNT)=CDL_ ^(I,0),CDL =" "
2211	"RTN","ORQ 2",101,0)
2212	.. D XTRA
2213	"RTN","ORQ 2",102,0)
2214	. K ^TMP( $J,"OCDATA ")
2215	"RTN","ORQ 2",103,0)
2216	. Q:(HDR= 0) ;40 5 quit if only aller gy-drug in teractions
2217	"RTN","ORQ 2",104,0)
2218	. Q:'$L($ G(OK)) S CNT=CNT+1, @ORY@(CNT) ="Override : "_$S($ P(OK,U,2): $$USER^ORQ 20($P(OK,U ,2))_" on ",1:"")_$$ DATE^ORQ20 ($P(OK,U,3 ))
2219	"RTN","ORQ 2",105,0)
2220	. I $L($P (OK,U))'>6 8 S CNT=CN T+1,@ORY@( CNT)=" "_ $P(OK,U) Q
2221	"RTN","ORQ 2",106,0)
2222	. S DIWL= 1,DIWR=68, DIWF="C68" ,X=$P(OK,U ) K ^UTILI TY($J,"W") D ^DIWP
2223	"RTN","ORQ 2",107,0)
2224	. S I=0 F S I=$O(^ UTILITY($J ,"W",DIWL, I)) Q:I'>0 S CNT=CN T+1,@ORY@( CNT)=" "_ ^(I,0)
2225	"RTN","ORQ 2",108,0)
2226	K ^TMP("O RWORD",$J) ,^UTILITY( $J,"W"),AL LGYDRG
2227	"RTN","ORQ 2",109,0)
2228	Q
2229	"RTN","ORQ 2",110,0)
2230	;
2231	"RTN","ORQ 2",111,0)
2232	XTRA ;
2233	"RTN","ORQ 2",112,0)
2234	I $O(^TMP ($J,"OCDAT A",CK,"OC TEXT",1)) N ORXT S O RXT=1 F S ORXT=$O(^ TMP($J,"OC DATA",CK," OC TEXT",O RXT)) Q:'O RXT D
2235	"RTN","ORQ 2",113,0)
2236	. S X=^TM P($J,"OCDA TA",CK,"OC TEXT",ORX T,0),CDL=" "
2237	"RTN","ORQ 2",114,0)
2238	. I $L(X) '>68 S CNT =CNT+1,@OR Y@(CNT)=CD L_X Q
2239	"RTN","ORQ 2",115,0)
2240	. S DIWL= 1,DIWR=68, DIWF="C68" K ^UTILIT Y($J,"W") D ^DIWP
2241	"RTN","ORQ 2",116,0)
2242	. S I=0 F S I=$O(^ UTILITY($J ,"W",DIWL, I)) Q:I'>0 S CNT=CN T+1,@ORY@( CNT)=CDL_^ (I,0),CDL= " "
2243	"RTN","ORQ 2",117,0)
2244	I $O(^TMP ($J,"OCDAT A",CK,"OC TEXT",1)) S X="",CNT =CNT+1,@OR Y@(CNT)=" "
2245	"RTN","ORQ 2",118,0)
2246	Q
2247	"RTN","ORQ 2",119,0)
2248	;
2249	"RTN","ORQ 2",120,0)
2250	SUB(IFN) ; -- add su border or parent
2251	"RTN","ORQ 2",121,0)
2252	N ORCY,ST S,STRT,IG, A,STOP,SCH ED D TEXT^ ORQ12(.ORC Y,IFN,58)
2253	"RTN","ORQ 2",122,0)
2254	S STS=$G( ^ORD(100.0 1,+$P($G(^ OR(100,IFN ,3)),U,3), .1))
2255	"RTN","ORQ 2",123,0)
2256	S A=^OR(1 00,IFN,0), STRT=$P(A, U,8),STOP= $P(A,U,9)
2257	"RTN","ORQ 2",124,0)
2258	S SCHED=$ $VALUE^ORX 8(IFN,"SCH EDULE",1," E")
2259	"RTN","ORQ 2",125,0)
2260	S:STRT'=" " STRT=$$D ATE^ORQ20( STRT) I OR NMSP="LR" S:STOP]"" STOP=$$DAT E^ORQ20(ST OP)
2261	"RTN","ORQ 2",126,0)
2262	S IG=0 F S IG=$O(O RCY(IG)) Q :IG<1 S C NT=CNT+1,@ ORY@(CNT)= $J(STS,4)_ " "_ORCY(I G)_" "_STR T,(STS,STR T)=" "
2263	"RTN","ORQ 2",127,0)
2264	I ORNMSP= "LR",STOP] "" S CNT=C NT+1,@ORY@ (CNT)=$J(" How often: ",16)_SCH ED_" Sto ps: "_STO P
2265	"RTN","ORQ 2",128,0)
2266	Q
2267	"RTN","ORQ 2",129,0)
2268	;
2269	"RTN","ORQ 2",130,0)
2270	WP ; -- ad d word-pro cessing
2271	"RTN","ORQ 2",131,0)
2272	N WP,ORI, X M WP=@OR DIALOG(PRM T,INST)
2273	"RTN","ORQ 2",132,0)
2274	S CNT=CNT +1,@ORY@(C NT)=TITLE
2275	"RTN","ORQ 2",133,0)
2276	S ORI=0 F S ORI=$O (WP(ORI)) Q:ORI'>0 S X=WP(ORI ,0) S:X'=" " CNT=CNT+ 1,@ORY@(CN T)=" "_X
2277	"RTN","ORQ 2",134,0)
2278	Q
2279	"RTN","ORQ 2",135,0)
2280	;
2281	"RTN","ORQ 2",136,0)
2282	CHILDREN(P ARENT) ; - - add chil dren
2283	"RTN","ORQ 2",137,0)
2284	N SEQ,DA, ITM,PRMT,T YPE,X
2285	"RTN","ORQ 2",138,0)
2286	S SEQ=0 F S SEQ=$O (^ORD(101. 41,+ORDIAL OG,10,"DAD ",PARENT,S EQ)) Q:SEQ '>0 S DA= $O(^(SEQ,0 )) D
2287	"RTN","ORQ 2",139,0)
2288	. S ITM=$ G(^ORD(101 .41,+ORDIA LOG,10,DA, 0)),PRMT=$ P(ITM,U,2)
2289	"RTN","ORQ 2",140,0)
2290	. Q:$G(OR DIALOG(PRM T,INST))=" " Q:$P(IT M,U,9)["*" ;no valu e or hide
2291	"RTN","ORQ 2",141,0)
2292	. S TYPE= $E(ORDIALO G(PRMT,0)) D:TYPE="W " WP
2293	"RTN","ORQ 2",142,0)
2294	. I TYPE' ="W" D
2295	"RTN","ORQ 2",143,0)
2296	. . S X=$ $EXT^ORCD( PRMT,INST)
2297	"RTN","ORQ 2",144,0)
2298	. . I $L( X,"\|")=2 S X=$$REPLA CE^ORHLESC (X,"\|","\|\| ")
2299	"RTN","ORQ 2",145,0)
2300	. . D ^DI WP
2301	"RTN","ORQ 2",146,0)
2302	Q
2303	"RTN","ORQ 2",147,0)
2304	;
2305	"RTN","ORQ 2",148,0)
2306	SETVIDEO(L INE,COL,WI DTH,ON,OFF ) ; -- set video att ributes
2307	"RTN","ORQ 2",149,0)
2308	S ORY("VI DEO",LINE, COL,WIDTH) =ON
2309	"RTN","ORQ 2",150,0)
2310	S ORY("VI DEO",LINE, COL+WIDTH, 0)=OFF
2311	"RTN","ORQ 2",151,0)
2312	Q
2313	"RTN","ORQ 2",152,0)
2314	;
2315	"RTN","ORQ 2",153,0)
2316	VA ; -- Ca ll VADPT
2317	"RTN","ORQ 2",154,0)
2318	N ORY,DFN ,Y S DFN=+ $P(OR0,"^" ,2) D OERR ^VADPT
2319	"RTN","ORQ 2",155,0)
2320	Q
2321	"RTN","ORQ 2",156,0)
2322	;
2323	"RTN","ORQ 2",157,0)
2324	CDL(X) ; - - Returns Clinical D anger Leve l X
2325	"RTN","ORQ 2",158,0)
2326	N Y S Y=$ S(X=1:"HIG H:",X=2:"M ODERATE:", X=3:"LOW:" ,1:"NONE:" )
2327	"RTN","ORQ 2",159,0)
2328	S Y=$E(Y_ " " ,1,12)
2329	"RTN","ORQ 2",160,0)
2330	Q Y
2331	"RTN","ORQ 2",161,0)
2332	;
2333	"RTN","ORQ 2",162,0)
2334	ORIG(IFN) ; -- Retur n original start dat e of [rene wal] order
2335	"RTN","ORQ 2",163,0)
2336	N I,Y,X3, DONE
2337	"RTN","ORQ 2",164,0)
2338	S I=IFN,Y =$P($G(^OR (100,IFN,0 )),U,8),DO NE=0
2339	"RTN","ORQ 2",165,0)
2340	F S X3=$ G(^OR(100, I,3)) D Q :DONE
2341	"RTN","ORQ 2",166,0)
2342	. I $P(X3 ,U,11)=2,$ P(X3,U,5) S I=$P(X3, U,5) Q ;l oop
2343	"RTN","ORQ 2",167,0)
2344	. S Y=$P( $G(^OR(100 ,I,0)),U,8 ),DONE=1
2345	"RTN","ORQ 2",168,0)
2346	Q Y
2347	"RTN","ORQ 2",169,0)
2348	GMRCXTRA ; expects O RDIALOG to be popula ted and OR IFN to be present
2349	"RTN","ORQ 2",170,0)
2350	N ORGMROU T,ORDGDA,O RGMRICD,OR CODE,ORISC ODE,ORCODS YS
2351	"RTN","ORQ 2",171,0)
2352	I '$G(^OR (100,ORIFN ,4)) D
2353	"RTN","ORQ 2",172,0)
2354	. S ORISC ODE=ORDIAL OG("B","CO DE"),ORISC ODE=$P(ORI SCODE,U,2)
2355	"RTN","ORQ 2",173,0)
2356	. I +$G( ORISCODE)> 0 D
2357	"RTN","ORQ 2",174,0)
2358	.. Q:'$D (ORDIALOG( ORISCODE,1 ))
2359	"RTN","ORQ 2",175,0)
2360	.. S ORC ODE=ORDIAL OG(ORISCOD E,1)
2361	"RTN","ORQ 2",176,0)
2362	.. S ORC ODSYS=$$CO DECS^ICDEX (ORCODE,"8 0")
2363	"RTN","ORQ 2",177,0)
2364	.. S ORG MROUT=$P($ G(ORCODSYS ),U,2)
2365	"RTN","ORQ 2",178,0)
2366	I $G(^OR( 100,ORIFN, 4)) D
2367	"RTN","ORQ 2",179,0)
2368	. S ORGMR OUT="ICD-9 -CM"
2369	"RTN","ORQ 2",180,0)
2370	. Q:'$D(^ GMR(123,+^ OR(100,+OR IFN,4),30. 1))
2371	"RTN","ORQ 2",181,0)
2372	. S ORGMR ICD=^GMR(1 23,+^OR(10 0,+ORIFN,4 ),30.1)
2373	"RTN","ORQ 2",182,0)
2374	. I $P(OR GMRICD,U,3 )="10D" S ORGMROUT=" ICD-10-CM"
2375	"RTN","ORQ 2",183,0)
2376	S ORDGDA= $G(ORDIALO G("B","COD E"))
2377	"RTN","ORQ 2",184,0)
2378	Q:'$P(ORD GDA,U,2)
2379	"RTN","ORQ 2",185,0)
2380	S ORDGDA= $P(ORDGDA, U,2)
2381	"RTN","ORQ 2",186,0)
2382	Q:'$D(ORD IALOG(ORDG DA,1))
2383	"RTN","ORQ 2",187,0)
2384	S ORDIALO G(ORDGDA,1 )="("_ORGM ROUT_" "_O RDIALOG(OR DGDA,1)_") "
2385	"RTN","ORQ 2",188,0)
2386	Q
2387	"RTN","ORQ 2",189,0)
2388	ALLERGY ; separate t he ALLERGY -DRUG INTE RACTION Or der Checks (405)
2389	"RTN","ORQ 2",190,0)
2390	N ORRET,O RINSTAN,OR SAVINS
2391	"RTN","ORQ 2",191,0)
2392	S ORRET=1
2393	"RTN","ORQ 2",192,0)
2394	S (ACK,CK )=0 F S C K=$O(^TMP( $J,"OCDATA ",CK)) Q:C K'>0 D
2395	"RTN","ORQ 2",193,0)
2396	. I $G(^T MP($J,"OCD ATA",CK,"O C NUMBER") )'=3 Q
2397	"RTN","ORQ 2",194,0)
2398	. S ALLGY DRG(CK)=" "
2399	"RTN","ORQ 2",195,0)
2400	. I ACK=0 S CNT=CNT +1,@ORY@(C NT)=" ",CN T=CNT+1,@O RY@(CNT)=" Allergy Or der Checks :",CNT=CNT +1,ACK=1
2401	"RTN","ORQ 2",196,0)
2402	. S X0=^T MP($J,"OCD ATA",CK,"O C NUMBER") _U_^TMP($J ,"OCDATA", CK,"OC LEV EL")_U_U_^ TMP($J,"OC DATA",CK," OR REASON" )_U_^TMP($ J,"OCDATA" ,CK,"OR PR OVIDER")_U _^TMP($J," OCDATA",CK ,"OR DT")
2403	"RTN","ORQ 2",197,0)
2404	. S X=^TM P($J,"OCDA TA",CK,"OC TEXT",1,0 )
2405	"RTN","ORQ 2",198,0)
2406	. S CDL=$ $CDL($P(X0 ,U,2)) I $ P(X0,U,6), '$D(OK) S OK=$P(X0,U ,4,6)
2407	"RTN","ORQ 2",199,0)
2408	. I $L(X) '>68 S CNT =CNT+1,@OR Y@(CNT)=CD L_X D XTRA Q
2409	"RTN","ORQ 2",200,0)
2410	. S DIWL= 1,DIWR=68, DIWF="C68" K ^UTILIT Y($J,"W") D ^DIWP
2411	"RTN","ORQ 2",201,0)
2412	. S I=0 F S I=$O(^ UTILITY($J ,"W",DIWL, I)) Q:I'>0 S CNT=CN T+1,@ORY@( CNT)=CDL_^ UTILITY($J ,"W",DIWL, I,0),CDL=" "
2413	"RTN","ORQ 2",202,0)
2414	. S ORINS TAN=$G(^TM P($J,"OCDA TA",CK,"OC INSTANCE" ))
2415	"RTN","ORQ 2",203,0)
2416	. I ORINS TAN>0 D
2417	"RTN","ORQ 2",204,0)
2418	.. I $$GE T1^DIQ(100 .517,ORRET _","_ORINS TAN_",",11 )'="" D
2419	"RTN","ORQ 2",205,0)
2420	... S:'$D (ORSAVINS) ORSAVINS= ORINSTAN
2421	"RTN","ORQ 2",206,0)
2422	. D XTRA
2423	"RTN","ORQ 2",207,0)
2424	I ACK=1 D
2425	"RTN","ORQ 2",208,0)
2426	. Q:'$L($ G(OK)) S CNT=CNT+1, @ORY@(CNT) ="Override : "_$S($ P(OK,U,2): $$USER^ORQ 20($P(OK,U ,2))_" on ",1:"")_$$ DATE^ORQ20 ($P(OK,U,3 ))
2427	"RTN","ORQ 2",209,0)
2428	. I $L($P (OK,U))'>6 8 S CNT=CN T+1,@ORY@( CNT)=" "_ $P(OK,U),C NT=CNT+1 Q
2429	"RTN","ORQ 2",210,0)
2430	. S DIWL= 1,DIWR=68, DIWF="C68" ,X=$P(OK,U ) K ^UTILI TY($J,"W") D ^DIWP
2431	"RTN","ORQ 2",211,0)
2432	. S I=0 F S I=$O(^ UTILITY($J ,"W",DIWL, I)) Q:I'>0 S CNT=CN T+1,@ORY@( CNT)=" "_ ^UTILITY($ J,"W",DIWL ,I,0)
2433	"RTN","ORQ 2",212,0)
2434	I $D(ORSA VINS) D
2435	"RTN","ORQ 2",213,0)
2436	. S CNT=C NT+1,@ORY@ (CNT)=" "
2437	"RTN","ORQ 2",214,0)
2438	. S CNT=C NT+1,@ORY@ (CNT)="Rem ote Commen t: "_$$GET 1^DIQ(100. 517,ORRET_ ","_ORSAVI NS_",",11)
2439	"RTN","ORQ 2",215,0)
2440	Q
2441	"RTN","ORQ 3")
2442	0^5^B24175 232^n/a
2443	"RTN","ORQ 3",1,0)
2444	ORQ3 ;SLC/ RBD - Prov ider Role Change API s ;06/09/1 7 14:12
2445	"RTN","ORQ 3",2,0)
2446	;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;4 53;Dec 1 7, 1997;Bu ild 4
2447	"RTN","ORQ 3",3,0)
2448	;
2449	"RTN","ORQ 3",4,0)
2450	Q
2451	"RTN","ORQ 3",5,0)
2452	;
2453	"RTN","ORQ 3",6,0)
2454	EN(ORY,ORP RIEN,ORDT1 ,ORDT2) ; Get Qualif ying Order s for Prov ider
2455	"RTN","ORQ 3",7,0)
2456	;
2457	"RTN","ORQ 3",8,0)
2458	; This RP C allows r etrieval o f Patients and Order s for whic h the
2459	"RTN","ORQ 3",9,0)
2460	; Provide r is the O rdering Pr ovider and the Order s are Sign ed
2461	"RTN","ORQ 3",10,0)
2462	;
2463	"RTN","ORQ 3",11,0)
2464	; Input:
2465	"RTN","ORQ 3",12,0)
2466	; ORY i s the name of the re turn array
2467	"RTN","ORQ 3",13,0)
2468	; ORPRI EN identif ies the IE N of the P rovider to retrieve Orders for
2469	"RTN","ORQ 3",14,0)
2470	; ORDT1 identifie s the star t date to start look ing from
2471	"RTN","ORQ 3",15,0)
2472	; ORDT2 identifie s the end date to st op looking once reac hed
2473	"RTN","ORQ 3",16,0)
2474	; Output:
2475	"RTN","ORQ 3",17,0)
2476	; Globa l ^TMP("OR PATRTN",$J ,n) where n represen ts each re cord found
2477	"RTN","ORQ 3",18,0)
2478	; star ting with record "1"
2479	"RTN","ORQ 3",19,0)
2480	; Con tains data for Patie nt Name ^ Patient IE N ^ Order IEN ^
2481	"RTN","ORQ 3",20,0)
2482	; Or der Status ^ Order D ate
2483	"RTN","ORQ 3",21,0)
2484	;
2485	"RTN","ORQ 3",22,0)
2486	N CNT,DFN ,OR0,ORIEN ,OROBJ,ORP RXFRD,ORPT NM,ORSIGNE D,ORTMPDT, ORXFERNM,V ADM
2487	"RTN","ORQ 3",23,0)
2488	S:'$D(U) U="^" K ^T MP("ORPTIN FO",$J),^T MP("ORPATR TN",$J)
2489	"RTN","ORQ 3",24,0)
2490	S ORY=$NA (^TMP("ORP ATRTN",$J) )
2491	"RTN","ORQ 3",25,0)
2492	; Loop th rough Prov iders that are Order ing Provid ers for Or ders that have been Signed
2493	"RTN","ORQ 3",26,0)
2494	S ORTMPDT =ORDT1,ORD T2=ORDT2_" .2359"
2495	"RTN","ORQ 3",27,0)
2496	F S ORDT 1=$O(^OR(1 00,"EPRACD T",ORPRIEN ,ORDT1)) Q :ORDT1>ORD T2 Q:ORDT 1="" D
2497	"RTN","ORQ 3",28,0)
2498	. S ORIEN ="" F S O RIEN=$O(^O R(100,"EPR ACDT",ORPR IEN,ORDT1, ORIEN)) Q: ORIEN="" D
2499	"RTN","ORQ 3",29,0)
2500	.. S OR0= $G(^OR(100 ,ORIEN,0)) Q:ORIEN'[ "" Q:$$OR DERER^ORQO R2(ORIEN)' =ORPRIEN ; skip if not Ord. Prv.
2501	"RTN","ORQ 3",30,0)
2502	.. S ORSI GNED=($P($ G(^OR(100, +ORIEN,8,1 ,0)),U,4)' =2) Q:'ORS IGNED ; skip if Order not Signed
2503	"RTN","ORQ 3",31,0)
2504	.. ; if O ld Provide r already Transferre d, skip
2505	"RTN","ORQ 3",32,0)
2506	.. S ORPR XFRD=0,ORX FERNM=0
2507	"RTN","ORQ 3",33,0)
2508	.. F S O RXFERNM=$O (^OR(100,O RIEN,11,OR XFERNM)) Q :ORXFERNM= "" Q:ORXF ERNM'?1N.N D
2509	"RTN","ORQ 3",34,0)
2510	... I $P( $G(^OR(100 ,ORIEN,11, ORXFERNM,0 )),U,2)=OR PRIEN D
2511	"RTN","ORQ 3",35,0)
2512	.... S OR PRXFRD=1
2513	"RTN","ORQ 3",36,0)
2514	.. Q:ORPR XFRD=1 S OROBJ=$P(O R0,U,2) Q: OROBJ'["DP T("
2515	"RTN","ORQ 3",37,0)
2516	.. S DFN= +OROBJ D O ERR^VADPT S ORPTNM=$ G(VADM(1)) Q:ORPTNM= ""
2517	"RTN","ORQ 3",38,0)
2518	.. S ^TMP ("ORPTINFO ",$J,ORPTN M,DFN,ORIE N)=""
2519	"RTN","ORQ 3",39,0)
2520	; Now ord er through Transferr ed To Prov ider index for situa tion where he/she ha s
2521	"RTN","ORQ 3",40,0)
2522	; to Tran sfer Order to a thir d Provider (or fourt h, etc.) . .. only al low last e ntry
2523	"RTN","ORQ 3",41,0)
2524	; from OR DER TRANSF ERS multip le to be u sed though .
2525	"RTN","ORQ 3",42,0)
2526	S ORDT1=O RTMPDT
2527	"RTN","ORQ 3",43,0)
2528	F S ORDT 1=$O(^OR(1 00,"EPRTRD T",ORPRIEN ,ORDT1)) Q :ORDT1>ORD T2 Q:ORDT 1="" D
2529	"RTN","ORQ 3",44,0)
2530	. S ORIEN ="" F S O RIEN=$O(^O R(100,"EPR TRDT",ORPR IEN,ORDT1, ORIEN)) Q: ORIEN="" D
2531	"RTN","ORQ 3",45,0)
2532	.. S ORXF ERNM=$O(^O R(100,ORIE N,11,"B"), -1) Q:$P($ G(^OR(100, ORIEN,11,O RXFERNM,0) ),U,3)'=OR PRIEN
2533	"RTN","ORQ 3",46,0)
2534	.. S OR0= $G(^OR(100 ,ORIEN,0)) Q:ORIEN'[ ""
2535	"RTN","ORQ 3",47,0)
2536	.. S OROB J=$P(OR0,U ,2) Q:OROB J'["DPT("
2537	"RTN","ORQ 3",48,0)
2538	.. S DFN= +OROBJ D O ERR^VADPT S ORPTNM=$ G(VADM(1)) Q:ORPTNM= ""
2539	"RTN","ORQ 3",49,0)
2540	.. S ^TMP ("ORPTINFO ",$J,ORPTN M,DFN,ORIE N)=""
2541	"RTN","ORQ 3",50,0)
2542	; Put in Patient Na me, Patien t IEN, & O rder IEN o rder to re turn to GU I
2543	"RTN","ORQ 3",51,0)
2544	S CNT=0,O RPTNM="" F S ORPTNM =$O(^TMP(" ORPTINFO", $J,ORPTNM) ) Q:ORPTNM ="" D
2545	"RTN","ORQ 3",52,0)
2546	. S DFN=" " F S DFN =$O(^TMP(" ORPTINFO", $J,ORPTNM, DFN)) Q:DF N="" D
2547	"RTN","ORQ 3",53,0)
2548	.. S ORIE N="" F S ORIEN=$O(^ TMP("ORPTI NFO",$J,OR PTNM,DFN,O RIEN)) Q:O RIEN="" D
2549	"RTN","ORQ 3",54,0)
2550	... S CNT =CNT+1
2551	"RTN","ORQ 3",55,0)
2552	... S ^TM P("ORPATRT N",$J,CNT) =ORPTNM_U_ DFN_U_ORIE N_U_$P($$S TATUS^ORQO R2(ORIEN), U,2)_U_$$F MTE^XLFDT( $P($G(^OR( 100,ORIEN, 0)),U,7))
2553	"RTN","ORQ 3",56,0)
2554	K ^TMP("O RPTINFO",$ J)
2555	"RTN","ORQ 3",57,0)
2556	Q
2557	"RTN","ORQ 3",58,0)
2558	;
2559	"RTN","ORQ 3",59,0)
2560	XFER(RESUL TS,LST) ; Transfer O rders to N ew Provide rs
2561	"RTN","ORQ 3",60,0)
2562	;
2563	"RTN","ORQ 3",61,0)
2564	; This RP C allows t he Transfe rring from one Provi der to ano ther
2565	"RTN","ORQ 3",62,0)
2566	; which w ill create an entry into each order in a List into
2567	"RTN","ORQ 3",63,0)
2568	; the ORD ER TRANSFE RS multipl e
2569	"RTN","ORQ 3",64,0)
2570	;
2571	"RTN","ORQ 3",65,0)
2572	; Input:
2573	"RTN","ORQ 3",66,0)
2574	; LST(1 ..n) where each entr y contains :
2575	"RTN","ORQ 3",67,0)
2576	; ORI EN identif ies the IE N of the O rder to cr eate a
2577	"RTN","ORQ 3",68,0)
2578	; Reassig nment (Tra nsfer) for
2579	"RTN","ORQ 3",69,0)
2580	; ORP RIEN1 iden tifies the Transferr ing From P rovider
2581	"RTN","ORQ 3",70,0)
2582	; ORP RIEN2 iden tifies the Transferr ing To Pro vider
2583	"RTN","ORQ 3",71,0)
2584	; ORU SER identi fies the U ser reques ting the T ransfer
2585	"RTN","ORQ 3",72,0)
2586	; ORD TTM identi fies the T ransfer Da te/Time
2587	"RTN","ORQ 3",73,0)
2588	; Output:
2589	"RTN","ORQ 3",74,0)
2590	; Globa l ^TMP("OR ORDRTN",$J ,n) where n represen ts each re cord
2591	"RTN","ORQ 3",75,0)
2592	; star ting with record "1"
2593	"RTN","ORQ 3",76,0)
2594	; Con tains data for Order IEN ^ Suc cess Flag
2595	"RTN","ORQ 3",77,0)
2596	; ^ Error Mess age if Uns uccessful
2597	"RTN","ORQ 3",78,0)
2598	; Where Succ ess Flag = 0 if Unsu ccessful o r 1 if Suc cessful
2599	"RTN","ORQ 3",79,0)
2600	;
2601	"RTN","ORQ 3",80,0)
2602	N CNT,DA, DIC,DIE,DR ,ORDTTM,OR IEN,ORPRIE N1,ORPRIEN 2,ORUSER,X ,Y
2603	"RTN","ORQ 3",81,0)
2604	S:'$D(U) U="^" K ^T MP("ORORDR TN",$J)
2605	"RTN","ORQ 3",82,0)
2606	S RESULTS =$NA(^TMP( "ORORDRTN" ,$J))
2607	"RTN","ORQ 3",83,0)
2608	S CNT=0 F S CNT=$O (LST(CNT)) Q:CNT="" D
2609	"RTN","ORQ 3",84,0)
2610	. S ORIEN =$P(LST(CN T),U,1),OR PRIEN1=$P( LST(CNT),U ,2)
2611	"RTN","ORQ 3",85,0)
2612	. S ORPRI EN2=$P(LST (CNT),U,3) ,ORUSER=$P (LST(CNT), U,4)
2613	"RTN","ORQ 3",86,0)
2614	. S ORDTT M=$P(LST(C NT),U,5)
2615	"RTN","ORQ 3",87,0)
2616	. I ORIEN ']"" S ^TM P("ORORDRT N",$J,CNT) =ORIEN_U_0 _U_"Order IEN Blank" Q
2617	"RTN","ORQ 3",88,0)
2618	. I '$D(^ OR(100,ORI EN)) D Q
2619	"RTN","ORQ 3",89,0)
2620	.. S ^TMP ("ORORDRTN ",$J,CNT)= ORIEN_U_0_ U_"Invalid Order IEN "
2621	"RTN","ORQ 3",90,0)
2622	. I ORPRI EN1']"" D Q
2623	"RTN","ORQ 3",91,0)
2624	.. S ^TMP ("ORORDRTN ",$J,CNT)= ORIEN_U_0_ U_"From Pr ovider IEN Blank"
2625	"RTN","ORQ 3",92,0)
2626	. I '$D(^ VA(200,ORP RIEN1)) D Q
2627	"RTN","ORQ 3",93,0)
2628	.. S ^TMP ("ORORDRTN ",$J,CNT)= ORIEN_U_0_ U_"From Pr ovider IEN "_ORPRIEN 1_" Invali d"
2629	"RTN","ORQ 3",94,0)
2630	. I ORPRI EN2']"" D Q
2631	"RTN","ORQ 3",95,0)
2632	.. S ^TMP ("ORORDRTN ",$J,CNT)= ORIEN_U_0_ U_"To Prov ider IEN B lank"
2633	"RTN","ORQ 3",96,0)
2634	. I '$D(^ VA(200,ORP RIEN2)) D Q
2635	"RTN","ORQ 3",97,0)
2636	.. S ^TMP ("ORORDRTN ",$J,CNT)= ORIEN_U_0_ U_"To Prov ider IEN " _ORPRIEN2_ " Invalid"
2637	"RTN","ORQ 3",98,0)
2638	. I ORUSE R']"" D Q
2639	"RTN","ORQ 3",99,0)
2640	.. S ^TMP ("ORORDRTN ",$J,CNT)= ORIEN_U_0_ U_"Transfe rring User IEN Blank "
2641	"RTN","ORQ 3",100,0)
2642	. I '$D(^ VA(200,ORU SER)) D Q
2643	"RTN","ORQ 3",101,0)
2644	.. S ^TMP ("ORORDRTN ",$J,CNT)= ORIEN_U_0_ U_"Transfe rring User IEN "_ORU SER_" Inva lid"
2645	"RTN","ORQ 3",102,0)
2646	. I ORDTT M'?7N1"."4 N S ^TMP(" ORORDRTN", $J,CNT)=OR IEN_U_0_U_ "Invalid T ransfer Da te/Time" Q
2647	"RTN","ORQ 3",103,0)
2648	. I ORDTT M<$$NOW^XL FDT() D Q
2649	"RTN","ORQ 3",104,0)
2650	.. S ^TMP ("ORORDRTN ",$J,CNT)= ORIEN_U_0_ U_"Transfe r Date/Tim e Cannot b e in the P ast"
2651	"RTN","ORQ 3",105,0)
2652	. L +^OR( 100,ORIEN) :0 I '$T D Q
2653	"RTN","ORQ 3",106,0)
2654	.. S ^TMP ("ORORDRTN ",$J,CNT)= ORIEN_U_0_ U_"Another user is e diting thi s Order."
2655	"RTN","ORQ 3",107,0)
2656	. S DIC=" ^OR(100,"_ ORIEN_",11 ,",DA(1)=O RIEN,DIC(0 )="L",X=OR DTTM
2657	"RTN","ORQ 3",108,0)
2658	. S DIC(" DR")=".02/ ///"_ORPRI EN1_";.03/ ///"_ORPRI EN2
2659	"RTN","ORQ 3",109,0)
2660	. S DIC(" DR")=DIC(" DR")_";.04 ////"_ORUS ER D FILE^ DICN
2661	"RTN","ORQ 3",110,0)
2662	. I +Y<0 S ^TMP("OR ORDRTN",$J ,CNT)=ORIE N_U_0_U_"S ave Unsucc essful" L -^OR(100,O RIEN) Q
2663	"RTN","ORQ 3",111,0)
2664	. S ^TMP( "ORORDRTN" ,$J,CNT)=O RIEN_U_1 L -^OR(100, ORIEN)
2665	"RTN","ORQ 3",112,0)
2666	Q
2667	"RTN","ORQ 3",113,0)
2668	;
2669	"UP",100,1 00.008,-1)
2670	100^8
2671	"UP",100,1 00.008,0)
2672	100.008
2673	"UP",100,1 00.011,-1)
2674	100^11
2675	"UP",100,1 00.011,0)
2676	100.011
2677	"VER")
2678	8.0^22.2
2679	"^DD",100, 100,.8,0)
2680	ORDER ACTI ONS^100.00 8DA^^8;0
2681	"^DD",100, 100,.8,3)
2682	Enter the order that this orde r relates to.
2683	"^DD",100, 100,.8,21, 0)
2684	^.001^2^2^ 3111213^^^ ^
2685	"^DD",100, 100,.8,21, 1,0)
2686	These are the action s taken on this orde r, includi ng the sig nature and
2687	"^DD",100, 100,.8,21, 2,0)
2688	verificati on require d to relea se to the service.
2689	"^DD",100, 100,.8,"DT ")
2690	2951027
2691	"^DD",100, 100,70,0)
2692	ORDER TRAN SFERS^100. 011D^^11;0
2693	"^DD",100, 100,70,21, 0)
2694	^.001^2^2^ 3170531^^^
2695	"^DD",100, 100,70,21, 1,0)
2696	This is th e list of Order Tran sfers that have occu rred trans ferring to a
2697	"^DD",100, 100,70,21, 2,0)
2698	new Provid er from an old one.
2699	"^DD",100, 100.008,0)
2700	ORDER ACTI ONS SUB-FI ELD^^40^42
2701	"^DD",100, 100.008,0, "NM","ORDE R ACTIONS" )
2702
2703	"^DD",100, 100.008,.0 1,0)
2704	DATE/TIME ORDERED^RD ^^0;1^S %D T="ETXR" D ^%DT S X= Y K:Y<1 X
2705	"^DD",100, 100.008,.0 1,1,0)
2706	^.1
2707	"^DD",100, 100.008,.0 1,1,1,0)
2708	100^ACT3^M UMPS
2709	"^DD",100, 100.008,.0 1,1,1,1)
2710	N ORDA S O RDA=DA(1) D ACT1^ORD D100A(ORDA ,DA)
2711	"^DD",100, 100.008,.0 1,1,1,2)
2712	N ORDA S O RDA=DA(1) D ACT2^ORD D100A(ORDA ,DA)
2713	"^DD",100, 100.008,.0 1,1,1,"%D" ,0)
2714	^^2^2^2971 028^^^^
2715	"^DD",100, 100.008,.0 1,1,1,"%D" ,1,0)
2716	^OR(100,"A CT",ORVP,9 999999-ORL OG,ORDG,OR IFN,DA)
2717	"^DD",100, 100.008,.0 1,1,1,"%D" ,2,0)
2718	Allows ret rieval of orders in reverse-ch ronologica l order.
2719	"^DD",100, 100.008,.0 1,1,1,"DT" )
2720	2961224
2721	"^DD",100, 100.008,.0 1,1,2,0)
2722	100^AC1^MU MPS
2723	"^DD",100, 100.008,.0 1,1,2,1)
2724	N X1,X2 S X1=DA(1),X 2=DA D SET ^ORDD100(X 1,X2)
2725	"^DD",100, 100.008,.0 1,1,2,2)
2726	N X1,X2 S X1=DA(1),X 2=DA D KIL ^ORDD100(X 1,X2)
2727	"^DD",100, 100.008,.0 1,1,2,"%D" ,0)
2728	^^4^4^2971 028^
2729	"^DD",100, 100.008,.0 1,1,2,"%D" ,1,0)
2730	^OR(100,"A C",ORVP,99 99999-ORLO G,ORIFN,DA )
2731	"^DD",100, 100.008,.0 1,1,2,"%D" ,2,0)
2732	Allows ret rieval of "active" o rders; inc ludes orde rs with an y kind of
2733	"^DD",100, 100.008,.0 1,1,2,"%D" ,3,0)
2734	active sta tus, as we ll as thos e that hav e ended w/ in the Act ive Orders
2735	"^DD",100, 100.008,.0 1,1,2,"%D" ,4,0)
2736	Context Ho urs.
2737	"^DD",100, 100.008,.0 1,1,2,"DT" )
2738	2960830
2739	"^DD",100, 100.008,.0 1,1,3,0)
2740	100^AS1^MU MPS
2741	"^DD",100, 100.008,.0 1,1,3,1)
2742	N ORDA S O RDA=DA(1) D S1^ORDD1 00(ORDA,DA ,"",X)
2743	"^DD",100, 100.008,.0 1,1,3,2)
2744	N ORDA S O RDA=DA(1) D S2^ORDD1 00(ORDA,DA ,"",X)
2745	"^DD",100, 100.008,.0 1,1,3,"%D" ,0)
2746	^^2^2^2971 028^^^
2747	"^DD",100, 100.008,.0 1,1,3,"%D" ,1,0)
2748	^OR(100,"A S",ORVP,99 99999-ORLO G,ORIFN,DA )
2749	"^DD",100, 100.008,.0 1,1,3,"%D" ,2,0)
2750	Allows ret rieval of unsigned o rders.
2751	"^DD",100, 100.008,.0 1,1,3,"DT" )
2752	2970107
2753	"^DD",100, 100.008,.0 1,1,4,0)
2754	100^AF
2755	"^DD",100, 100.008,.0 1,1,4,1)
2756	S ^OR(100, "AF",$E(X, 1,30),DA(1 ),DA)=""
2757	"^DD",100, 100.008,.0 1,1,4,2)
2758	K ^OR(100, "AF",$E(X, 1,30),DA(1 ),DA)
2759	"^DD",100, 100.008,.0 1,1,4,"DT" )
2760	2970814
2761	"^DD",100, 100.008,.0 1,3)
2762	Enter the date/time this actio n was orde red.
2763	"^DD",100, 100.008,.0 1,21,0)
2764	^^1^1^2951 027^^
2765	"^DD",100, 100.008,.0 1,21,1,0)
2766	This is th e date/tim e this act ion was or dered.
2767	"^DD",100, 100.008,.0 1,"DT")
2768	3170516
2769	"^DD",100, 100.008,3, 0)
2770	PROVIDER^P 200'^VA(20 0,^0;3^Q
2771	"^DD",100, 100.008,3, 3)
2772	Enter the name of th e requesti ng clinici an for thi s order.
2773	"^DD",100, 100.008,3, 21,0)
2774	^^1^1^2970 310^^
2775	"^DD",100, 100.008,3, 21,1,0)
2776	This is th e requesto r of this order.
2777	"^DD",100, 100.008,3, "DT")
2778	3170516
2779	"^DD",100, 100.011,0)
2780	ORDER TRAN SFERS SUB- FIELD^^.04 ^4
2781	"^DD",100, 100.011,0, "NM","ORDE R TRANSFER S")
2782
2783	"^DD",100, 100.011,.0 1,0)
2784	TRANSFER D ATE/TIME^R D^^0;1^S % DT="ETXR" D ^%DT S X =Y K:Y<1 X
2785	"^DD",100, 100.011,.0 1,1,0)
2786	^.1
2787	"^DD",100, 100.011,.0 1,1,1,0)
2788	100.011^B
2789	"^DD",100, 100.011,.0 1,1,1,1)
2790	S ^OR(100, DA(1),11," B",$E(X,1, 30),DA)=""
2791	"^DD",100, 100.011,.0 1,1,1,2)
2792	K ^OR(100, DA(1),11," B",$E(X,1, 30),DA)
2793	"^DD",100, 100.011,.0 1,3)
2794	Enter the Date/Time of the Ord er Transfe r.
2795	"^DD",100, 100.011,.0 1,21,0)
2796	^.001^1^1^ 3170504^^
2797	"^DD",100, 100.011,.0 1,21,1,0)
2798	This is th e Date/Tim e of the O rder Trans fer.
2799	"^DD",100, 100.011,.0 1,"DT")
2800	3170601
2801	"^DD",100, 100.011,.0 2,0)
2802	TRANSFERRE D FROM^RP2 00'^VA(200 ,^0;2^Q
2803	"^DD",100, 100.011,.0 2,3)
2804	Enter the Provider t hat this O rder is be ing Transf erred From .
2805	"^DD",100, 100.011,.0 2,21,0)
2806	^^1^1^3170 504^
2807	"^DD",100, 100.011,.0 2,21,1,0)
2808	This is th e Provider that this Order is being Tran sferred Fr om.
2809	"^DD",100, 100.011,.0 2,"DT")
2810	3170504
2811	"^DD",100, 100.011,.0 3,0)
2812	TRANSFERRE D TO^RP200 '^VA(200,^ 0;3^Q
2813	"^DD",100, 100.011,.0 3,3)
2814	Enter in t he Provide r that thi s Order is being Tra nsferred T o.
2815	"^DD",100, 100.011,.0 3,21,0)
2816	^^1^1^3170 504^
2817	"^DD",100, 100.011,.0 3,21,1,0)
2818	This is th e Provider to which this Order is being Transferre d.
2819	"^DD",100, 100.011,.0 3,"DT")
2820	3170601
2821	"^DD",100, 100.011,.0 4,0)
2822	TRANSFER U SER^RP200' ^VA(200,^0 ;4^Q
2823	"^DD",100, 100.011,.0 4,3)
2824	Enter in t he User th at perform ed this Or der Transf er.
2825	"^DD",100, 100.011,.0 4,21,0)
2826	^^1^1^3170 504^
2827	"^DD",100, 100.011,.0 4,21,1,0)
2828	This is th e User who performed the Order Transfer.
2829	"^DD",100, 100.011,.0 4,"DT")
2830	3170504
2831	"BLD",1001 8,6)
2832	1^
2833	$END KID O R3.0453