5. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 10/3/2017 11:15:03 AM Central 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.

5.1 Files compared

#	Location	File	Last Modified
1	ehmp.zip\ehmp\ehmp\product\production\hmp\src\kids	HMP_2-0.KID	Mon Jul 10 17:46:22 2017 UTC
2	ehmp.zip\ehmp\ehmp\product\production\hmp\src\kids	HMP_2-0.KID	Mon Oct 2 19:43:46 2017 UTC

5.2 Comparison summary

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

5.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

5.4 Active regular expressions

No regular expressions were active.

5.5 Comparison detail

	1	KIDS Distr ibution sa ved on Feb 23, 2016@ 12:32:11
	2	stamptime fix releas e candidat e
	3	KIDS:H MP 2.0^
	4
	5	INSTALL NAME
	6	HMP 2.0
	7	"BLD",9075 ,0)
	8	HMP 2.0^HE ALTH MANAG EMENT PLAT FORM^0^316 0223^y
	9	"BLD",9075 ,1,0)
	10	^9.61A^3^3 ^3151113^
	11	"BLD",9075 ,1,1,0)
	12	Enterprise Health Ma nagement P latform Pa ckage Rele ase.
	13	"BLD",9075 ,1,2,0)
	14
	15	"BLD",9075 ,1,3,0)
	16	See FORUM patch desc ription fo r details.
	17	"BLD",9075 ,4,0)
	18	^9.64PA^80 0001.2^9
	19	"BLD",9075 ,4,800000, 0)
	20	800000
	21	"BLD",9075 ,4,800000, 222)
	22	y^y^f^^^^n ^^
	23	"BLD",9075 ,4,800000, 224)
	24
	25	"BLD",9075 ,4,800000. 1,0)
	26	800000.1
	27	"BLD",9075 ,4,800000. 1,222)
	28	y^y^f^^^^n ^^
	29	"BLD",9075 ,4,800000. 1,224)
	30
	31	"BLD",9075 ,4,800000. 11,0)
	32	800000.11
	33	"BLD",9075 ,4,800000. 11,222)
	34	y^y^f^^^^y ^m^n
	35	"BLD",9075 ,4,800000. 11,224)
	36
	37	"BLD",9075 ,4,800000. 2,0)
	38	800000.2
	39	"BLD",9075 ,4,800000. 2,222)
	40	y^y^f^^n^^ y^m^n
	41	"BLD",9075 ,4,800000. 2,224)
	42
	43	"BLD",9075 ,4,800000. 21,0)
	44	800000.21
	45	"BLD",9075 ,4,800000. 21,222)
	46	y^y^f^^n^^ y^m^n
	47	"BLD",9075 ,4,800000. 22,0)
	48	800000.22
	49	"BLD",9075 ,4,800000. 22,222)
	50	y^y^f^^n^^ y^m^n
	51	"BLD",9075 ,4,800001, 0)
	52	800001
	53	"BLD",9075 ,4,800001, 222)
	54	y^y^f^^^^n ^^
	55	"BLD",9075 ,4,800001, 224)
	56
	57	"BLD",9075 ,4,800001. 2,0)
	58	800001.2
	59	"BLD",9075 ,4,800001. 2,222)
	60	y^y^f^^^^n ^^
	61	"BLD",9075 ,4,800001. 2,224)
	62
	63	"BLD",9075 ,4,800001. 5,0)
	64	800001.5
	65	"BLD",9075 ,4,800001. 5,222)
	66	y^y^f^^^^n ^^
	67	"BLD",9075 ,4,800001. 5,224)
	68
	69	"BLD",9075 ,4,"B",800 000,800000 )
	70
	71	"BLD",9075 ,4,"B",800 000.1,8000 00.1)
	72
	73	"BLD",9075 ,4,"B",800 000.11,800 000.11)
	74
	75	"BLD",9075 ,4,"B",800 000.2,8000 00.2)
	76
	77	"BLD",9075 ,4,"B",800 000.21,800 000.21)
	78
	79	"BLD",9075 ,4,"B",800 000.22,800 000.22)
	80
	81	"BLD",9075 ,4,"B",800 001,800001 )
	82
	83	"BLD",9075 ,4,"B",800 001.2,8000 01.2)
	84
	85	"BLD",9075 ,4,"B",800 001.5,8000 01.5)
	86
	87	"BLD",9075 ,6.3)
	88	63
	89	"BLD",9075 ,"ABPKG")
	90	n
	91	"BLD",9075 ,"INI")
	92	PRE^HMPP3I
	93	"BLD",9075 ,"INID")
	94	^n^n
	95	"BLD",9075 ,"INIT")
	96	POST^HMPP3 I
	97	"BLD",9075 ,"KRN",0)
	98	^9.67PA^77 9.2^20
	99	"BLD",9075 ,"KRN",.4, 0)
	100	.4
	101	"BLD",9075 ,"KRN",.4, "NM",0)
	102	^9.68A^^
	103	"BLD",9075 ,"KRN",.40 1,0)
	104	.401
	105	"BLD",9075 ,"KRN",.40 1,"NM",0)
	106	^9.68A^^
	107	"BLD",9075 ,"KRN",.40 2,0)
	108	.402
	109	"BLD",9075 ,"KRN",.40 2,"NM",0)
	110	^9.68A^^
	111	"BLD",9075 ,"KRN",.40 3,0)
	112	.403
	113	"BLD",9075 ,"KRN",.40 3,"NM",0)
	114	^9.68A^^
	115	"BLD",9075 ,"KRN",.5, 0)
	116	.5
	117	"BLD",9075 ,"KRN",.5, "NM",0)
	118	^9.68A^^
	119	"BLD",9075 ,"KRN",.84 ,0)
	120	.84
	121	"BLD",9075 ,"KRN",.84 ,"NM",0)
	122	^9.68A^^
	123	"BLD",9075 ,"KRN",3.6 ,0)
	124	3.6
	125	"BLD",9075 ,"KRN",3.6 ,"NM",0)
	126	^9.68A^^
	127	"BLD",9075 ,"KRN",3.8 ,0)
	128	3.8
	129	"BLD",9075 ,"KRN",3.8 ,"NM",0)
	130	^9.68A^1^1
	131	"BLD",9075 ,"KRN",3.8 ,"NM",1,0)
	132	HMP IRM GR OUP^^0
	133	"BLD",9075 ,"KRN",3.8 ,"NM","B", "HMP IRM G ROUP",1)
	134
	135	"BLD",9075 ,"KRN",9.2 ,0)
	136	9.2
	137	"BLD",9075 ,"KRN",9.2 ,"NM",0)
	138	^9.68A^^
	139	"BLD",9075 ,"KRN",9.8 ,0)
	140	9.8
	141	"BLD",9075 ,"KRN",9.8 ,"NM",0)
	142	^9.68A^202 ^147
	143	"BLD",9075 ,"KRN",9.8 ,"NM",1,0)
	144	HMPTOOLS^^ 0^B1138781 8
	145	"BLD",9075 ,"KRN",9.8 ,"NM",2,0)
	146	HMP0311P^^ 0^B1410169 9
	147	"BLD",9075 ,"KRN",9.8 ,"NM",3,0)
	148	HMPACT^^0^ B34386179
	149	"BLD",9075 ,"KRN",9.8 ,"NM",4,0)
	150	HMPAT^^0^B 3595282
	151	"BLD",9075 ,"KRN",9.8 ,"NM",6,0)
	152	HMPCAC^^0^ B97070146
	153	"BLD",9075 ,"KRN",9.8 ,"NM",11,0 )
	154	HMPCORD4^^ 0^B1415933 21
	155	"BLD",9075 ,"KRN",9.8 ,"NM",12,0 )
	156	HMPCORD5^^ 0^B8935096 1
	157	"BLD",9075 ,"KRN",9.8 ,"NM",15,0 )
	158	HMPCPRS^^0 ^B5087431
	159	"BLD",9075 ,"KRN",9.8 ,"NM",16,0 )
	160	HMPCRPC^^0 ^B13274810
	161	"BLD",9075 ,"KRN",9.8 ,"NM",17,0 )
	162	HMPCRPC1^^ 0^B1035672 95
	163	"BLD",9075 ,"KRN",9.8 ,"NM",18,0 )
	164	HMPD^^0^B2 9605922
	165	"BLD",9075 ,"KRN",9.8 ,"NM",19,0 )
	166	HMPDCRC^^0 ^B46986534
	167	"BLD",9075 ,"KRN",9.8 ,"NM",21,0 )
	168	HMPDERRH^^ 0^B2044240
	169	"BLD",9075 ,"KRN",9.8 ,"NM",22,0 )
	170	HMPDGMPL^^ 0^B2817232 7
	171	"BLD",9075 ,"KRN",9.8 ,"NM",23,0 )
	172	HMPDGMRA^^ 0^B2221162 4
	173	"BLD",9075 ,"KRN",9.8 ,"NM",25,0 )
	174	HMPDGMV^^0 ^B43285050
	175	"BLD",9075 ,"KRN",9.8 ,"NM",28,0 )
	176	HMPDJ^^0^B 36572187
	177	"BLD",9075 ,"KRN",9.8 ,"NM",29,0 )
	178	HMPDJ0^^0^ B118417079
	179	"BLD",9075 ,"KRN",9.8 ,"NM",30,0 )
	180	HMPDJ00^^0 ^B15029497 2
	181	"BLD",9075 ,"KRN",9.8 ,"NM",32,0 )
	182	HMPDJ1^^0^ B18644090
	183	"BLD",9075 ,"KRN",9.8 ,"NM",33,0 )
	184	HMPDJ01^^0 ^B49806712
	185	"BLD",9075 ,"KRN",9.8 ,"NM",34,0 )
	186	HMPDJ2^^0^ B21439862
	187	"BLD",9075 ,"KRN",9.8 ,"NM",35,0 )
	188	HMPDJ02^^0 ^B17804340 1
	189	"BLD",9075 ,"KRN",9.8 ,"NM",36,0 )
	190	HMPDJ03^^0 ^B97739485
	191	"BLD",9075 ,"KRN",9.8 ,"NM",37,0 )
	192	HMPDJ04^^0 ^B86219849
	193	"BLD",9075 ,"KRN",9.8 ,"NM",38,0 )
	194	HMPDJ04A^^ 0^B5976899 3
	195	"BLD",9075 ,"KRN",9.8 ,"NM",39,0 )
	196	HMPDJ04E^^ 0^B1807480 6
	197	"BLD",9075 ,"KRN",9.8 ,"NM",40,0 )
	198	HMPDJ05^^0 ^B85682186
	199	"BLD",9075 ,"KRN",9.8 ,"NM",41,0 )
	200	HMPDJ05V^^ 0^B6906574 7
	201	"BLD",9075 ,"KRN",9.8 ,"NM",42,0 )
	202	HMPDJ06^^0 ^B64037338
	203	"BLD",9075 ,"KRN",9.8 ,"NM",43,0 )
	204	HMPDJ07^^0 ^B26955013
	205	"BLD",9075 ,"KRN",9.8 ,"NM",44,0 )
	206	HMPDJ08^^0 ^B73570854
	207	"BLD",9075 ,"KRN",9.8 ,"NM",45,0 )
	208	HMPDJ08A^^ 0^B5035397 8
	209	"BLD",9075 ,"KRN",9.8 ,"NM",46,0 )
	210	HMPDJ09^^0 ^B47251770
	211	"BLD",9075 ,"KRN",9.8 ,"NM",47,0 )
	212	HMPDJ09M^^ 0^B1431693 9
	213	"BLD",9075 ,"KRN",9.8 ,"NM",48,0 )
	214	HMPDJFS^^0 ^B74871558
	215	"BLD",9075 ,"KRN",9.8 ,"NM",49,0 )
	216	HMPDJFSD^^ 0^B6635230
	217	"BLD",9075 ,"KRN",9.8 ,"NM",50,0 )
	218	HMPDJFSG^^ 0^B2163820 35
	219	"BLD",9075 ,"KRN",9.8 ,"NM",51,0 )
	220	HMPDJFSM^^ 0^B9194383 6
	221	"BLD",9075 ,"KRN",9.8 ,"NM",52,0 )
	222	HMPDJFSP^^ 0^B2283476 65
	223	"BLD",9075 ,"KRN",9.8 ,"NM",55,0 )
	224	HMPDJX^^0^ B36089287
	225	"BLD",9075 ,"KRN",9.8 ,"NM",56,0 )
	226	HMPDLR^^0^ B24262347
	227	"BLD",9075 ,"KRN",9.8 ,"NM",57,0 )
	228	HMPDLRA^^0 ^B79686061
	229	"BLD",9075 ,"KRN",9.8 ,"NM",59,0 )
	230	HMPDMC^^0^ B58181283
	231	"BLD",9075 ,"KRN",9.8 ,"NM",60,0 )
	232	HMPDMDC^^0 ^B45041787
	233	"BLD",9075 ,"KRN",9.8 ,"NM",61,0 )
	234	HMPDOR^^0^ B13574723
	235	"BLD",9075 ,"KRN",9.8 ,"NM",66,0 )
	236	HMPDPSOR^^ 0^B2311665
	237	"BLD",9075 ,"KRN",9.8 ,"NM",73,0 )
	238	HMPDRA^^0^ B42792632
	239	"BLD",9075 ,"KRN",9.8 ,"NM",74,0 )
	240	HMPDSDAM^^ 0^B2127506 7
	241	"BLD",9075 ,"KRN",9.8 ,"NM",75,0 )
	242	HMPDSR^^0^ B30022036
	243	"BLD",9075 ,"KRN",9.8 ,"NM",76,0 )
	244	HMPDTIU^^0 ^B83859727
	245	"BLD",9075 ,"KRN",9.8 ,"NM",78,0 )
	246	HMPDVSIT^^ 0^B9349656 8
	247	"BLD",9075 ,"KRN",9.8 ,"NM",79,0 )
	248	HMPEASU^^0 ^B29036042
	249	"BLD",9075 ,"KRN",9.8 ,"NM",80,0 )
	250	HMPEF^^0^B 86254671
	251	"BLD",9075 ,"KRN",9.8 ,"NM",84,0 )
	252	HMPEFX^^0^ B8398930
	253	"BLD",9075 ,"KRN",9.8 ,"NM",85,0 )
	254	HMPEHL7^^0 ^B3570530
	255	"BLD",9075 ,"KRN",9.8 ,"NM",86,0 )
	256	HMPELAB^^0 ^B7483676
	257	"BLD",9075 ,"KRN",9.8 ,"NM",89,0 )
	258	HMPEQ^^0^B 27101202
	259	"BLD",9075 ,"KRN",9.8 ,"NM",90,0 )
	260	HMPEQLM^^0 ^B11367683 7
	261	"BLD",9075 ,"KRN",9.8 ,"NM",91,0 )
	262	HMPEQLM1^^ 0^B7071509
	263	"BLD",9075 ,"KRN",9.8 ,"NM",92,0 )
	264	HMPEQLM2^^ 0^B3277771
	265	"BLD",9075 ,"KRN",9.8 ,"NM",93,0 )
	266	HMPEVNT^^0 ^B12941329 0
	267	"BLD",9075 ,"KRN",9.8 ,"NM",94,0 )
	268	HMPFPTC^^0 ^B15382684
	269	"BLD",9075 ,"KRN",9.8 ,"NM",95,0 )
	270	HMPHTTP^^0 ^B14631122
	271	"BLD",9075 ,"KRN",9.8 ,"NM",96,0 )
	272	HMPIDX^^0^ B2980358
	273	"BLD",9075 ,"KRN",9.8 ,"NM",97,0 )
	274	HMPJSON^^0 ^B11632331
	275	"BLD",9075 ,"KRN",9.8 ,"NM",98,0 )
	276	HMPJSOND^^ 0^B7168838 8
	277	"BLD",9075 ,"KRN",9.8 ,"NM",99,0 )
	278	HMPJSONE^^ 0^B2750671 1
	279	"BLD",9075 ,"KRN",9.8 ,"NM",100, 0)
	280	HMPLIST^^0 ^B62846538
	281	"BLD",9075 ,"KRN",9.8 ,"NM",101, 0)
	282	HMPMDUTL^^ 0^B5338146 5
	283	"BLD",9075 ,"KRN",9.8 ,"NM",102, 0)
	284	HMPMETA^^0 ^B12227934 9
	285	"BLD",9075 ,"KRN",9.8 ,"NM",104, 0)
	286	HMPP3I^^0^ B129333471
	287	"BLD",9075 ,"KRN",9.8 ,"NM",106, 0)
	288	HMPPARAM^^ 0^B1654184 0
	289	"BLD",9075 ,"KRN",9.8 ,"NM",107, 0)
	290	HMPPATS^^0 ^B3116859
	291	"BLD",9075 ,"KRN",9.8 ,"NM",110, 0)
	292	HMPPRXY2^^ 0^B1693380 8
	293	"BLD",9075 ,"KRN",9.8 ,"NM",111, 0)
	294	HMPPTDEM^^ 0^B1266590 8
	295	"BLD",9075 ,"KRN",9.8 ,"NM",113, 0)
	296	HMPPXRM^^0 ^B14531240
	297	"BLD",9075 ,"KRN",9.8 ,"NM",122, 0)
	298	HMPSTMP^^0 ^B70461106
	299	"BLD",9075 ,"KRN",9.8 ,"NM",123, 0)
	300	HMPTFU2^^0 ^B40086168
	301	"BLD",9075 ,"KRN",9.8 ,"NM",126, 0)
	302	HMPUPD^^0^ B25123694
	303	"BLD",9075 ,"KRN",9.8 ,"NM",127, 0)
	304	HMPUTIL1^^ 0^B4276405 8
	305	"BLD",9075 ,"KRN",9.8 ,"NM",128, 0)
	306	HMPUTILS^^ 0^B3905923 4
	307	"BLD",9075 ,"KRN",9.8 ,"NM",133, 0)
	308	HMPYCSO^^0 ^B22000106
	309	"BLD",9075 ,"KRN",9.8 ,"NM",139, 0)
	310	HMPPDL^^0^ B23790480
	311	"BLD",9075 ,"KRN",9.8 ,"NM",140, 0)
	312	HMP0311Q^^ 0^B3902876
	313	"BLD",9075 ,"KRN",9.8 ,"NM",141, 0)
	314	HMPZ0218^^ 0^B5632129
	315	"BLD",9075 ,"KRN",9.8 ,"NM",142, 0)
	316	HMPXGDPT^^ 0^B2019789
	317	"BLD",9075 ,"KRN",9.8 ,"NM",143, 0)
	318	HMPXGLAB^^ 0^B1064430
	319	"BLD",9075 ,"KRN",9.8 ,"NM",144, 0)
	320	HMPXGORD^^ 0^B2568884
	321	"BLD",9075 ,"KRN",9.8 ,"NM",145, 0)
	322	HMPXGNP^^0 ^B1299808
	323	"BLD",9075 ,"KRN",9.8 ,"NM",146, 0)
	324	HMPXGSD^^0 ^B2602100
	325	"BLD",9075 ,"KRN",9.8 ,"NM",147, 0)
	326	HMPEF1^^0^ B36268404
	327	"BLD",9075 ,"KRN",9.8 ,"NM",148, 0)
	328	HMPDJFS1^^ 0^B1887278
	329	"BLD",9075 ,"KRN",9.8 ,"NM",149, 0)
	330	HMPROS8^^0 ^B82143309
	331	"BLD",9075 ,"KRN",9.8 ,"NM",150, 0)
	332	HMPATRG^^1 ^
	333	"BLD",9075 ,"KRN",9.8 ,"NM",151, 0)
	334	HMPCORD^^1 ^
	335	"BLD",9075 ,"KRN",9.8 ,"NM",152, 0)
	336	HMPCORD1^^ 1^
	337	"BLD",9075 ,"KRN",9.8 ,"NM",153, 0)
	338	HMPCORD2^^ 1^
	339	"BLD",9075 ,"KRN",9.8 ,"NM",154, 0)
	340	HMPCORD3^^ 1^
	341	"BLD",9075 ,"KRN",9.8 ,"NM",155, 0)
	342	HMPCPAT^^1 ^
	343	"BLD",9075 ,"KRN",9.8 ,"NM",156, 0)
	344	HMPCPAT1^^ 1^
	345	"BLD",9075 ,"KRN",9.8 ,"NM",157, 0)
	346	HMPDE811^^ 1^
	347	"BLD",9075 ,"KRN",9.8 ,"NM",158, 0)
	348	HMPDGMRC^^ 1^
	349	"BLD",9075 ,"KRN",9.8 ,"NM",159, 0)
	350	HMPDGPF^^1 ^
	351	"BLD",9075 ,"KRN",9.8 ,"NM",160, 0)
	352	HMPDIB^^1^
	353	"BLD",9075 ,"KRN",9.8 ,"NM",161, 0)
	354	HMPDJ00A^^ 1^
	355	"BLD",9075 ,"KRN",9.8 ,"NM",162, 0)
	356	HMPDJFST^^ 1^
	357	"BLD",9075 ,"KRN",9.8 ,"NM",163, 0)
	358	HMPDJT^^1^
	359	"BLD",9075 ,"KRN",9.8 ,"NM",164, 0)
	360	HMPDLRO^^1 ^
	361	"BLD",9075 ,"KRN",9.8 ,"NM",165, 0)
	362	HMPDPROC^^ 1^
	363	"BLD",9075 ,"KRN",9.8 ,"NM",166, 0)
	364	HMPDPT^^1^
	365	"BLD",9075 ,"KRN",9.8 ,"NM",167, 0)
	366	HMPDPXAM^^ 1^
	367	"BLD",9075 ,"KRN",9.8 ,"NM",168, 0)
	368	HMPDPXED^^ 1^
	369	"BLD",9075 ,"KRN",9.8 ,"NM",169, 0)
	370	HMPDPXHF^^ 1^
	371	"BLD",9075 ,"KRN",9.8 ,"NM",170, 0)
	372	HMPDPXIM^^ 1^
	373	"BLD",9075 ,"KRN",9.8 ,"NM",171, 0)
	374	HMPDPXSK^^ 1^
	375	"BLD",9075 ,"KRN",9.8 ,"NM",172, 0)
	376	HMPDTIUX^^ 1^
	377	"BLD",9075 ,"KRN",9.8 ,"NM",173, 0)
	378	HMPEFSG^^1 ^
	379	"BLD",9075 ,"KRN",9.8 ,"NM",174, 0)
	380	HMPEFSP^^1 ^
	381	"BLD",9075 ,"KRN",9.8 ,"NM",175, 0)
	382	HMPEFST^^1 ^
	383	"BLD",9075 ,"KRN",9.8 ,"NM",176, 0)
	384	HMPENSZ^^1 ^
	385	"BLD",9075 ,"KRN",9.8 ,"NM",177, 0)
	386	HMPENSZ1^^ 1^
	387	"BLD",9075 ,"KRN",9.8 ,"NM",178, 0)
	388	HMPP2I^^1^
	389	"BLD",9075 ,"KRN",9.8 ,"NM",179, 0)
	390	HMPPANEL^^ 1^
	391	"BLD",9075 ,"KRN",9.8 ,"NM",180, 0)
	392	HMPPI^^1^
	393	"BLD",9075 ,"KRN",9.8 ,"NM",181, 0)
	394	HMPPRODC^^ 1^
	395	"BLD",9075 ,"KRN",9.8 ,"NM",182, 0)
	396	HMPPXPR1^^ 1^
	397	"BLD",9075 ,"KRN",9.8 ,"NM",183, 0)
	398	HMPROS2^^1 ^
	399	"BLD",9075 ,"KRN",9.8 ,"NM",184, 0)
	400	HMPROS3^^1 ^
	401	"BLD",9075 ,"KRN",9.8 ,"NM",185, 0)
	402	HMPROS4^^1 ^
	403	"BLD",9075 ,"KRN",9.8 ,"NM",186, 0)
	404	HMPROS5^^1 ^
	405	"BLD",9075 ,"KRN",9.8 ,"NM",187, 0)
	406	HMPROS6^^1 ^
	407	"BLD",9075 ,"KRN",9.8 ,"NM",188, 0)
	408	HMPROS7^^1 ^
	409	"BLD",9075 ,"KRN",9.8 ,"NM",189, 0)
	410	HMPSR^^1^
	411	"BLD",9075 ,"KRN",9.8 ,"NM",190, 0)
	412	HMPTRPC^^1 ^
	413	"BLD",9075 ,"KRN",9.8 ,"NM",191, 0)
	414	HMPTRPC1^^ 1^
	415	"BLD",9075 ,"KRN",9.8 ,"NM",192, 0)
	416	HMPWB^^1^
	417	"BLD",9075 ,"KRN",9.8 ,"NM",193, 0)
	418	HMPWB1^^1^
	419	"BLD",9075 ,"KRN",9.8 ,"NM",194, 0)
	420	HMPWB2^^1^
	421	"BLD",9075 ,"KRN",9.8 ,"NM",195, 0)
	422	HMPYCSI^^1 ^
	423	"BLD",9075 ,"KRN",9.8 ,"NM",196, 0)
	424	HMPYFRP^^1 ^
	425	"BLD",9075 ,"KRN",9.8 ,"NM",197, 0)
	426	HMPYFRP1^^ 1^
	427	"BLD",9075 ,"KRN",9.8 ,"NM",198, 0)
	428	HMPYFRP2^^ 1^
	429	"BLD",9075 ,"KRN",9.8 ,"NM",199, 0)
	430	HMPYPAR^^1 ^
	431	"BLD",9075 ,"KRN",9.8 ,"NM",200, 0)
	432	HMPDPS^^1^
	433	"BLD",9075 ,"KRN",9.8 ,"NM",201, 0)
	434	HMPDPSI^^1 ^
	435	"BLD",9075 ,"KRN",9.8 ,"NM",202, 0)
	436	HMPDPSO^^1 ^
	437	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMP0311P" ,2)
	438
	439	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMP0311Q" ,140)
	440
	441	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPACT",3 )
	442
	443	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPAT",4)
	444
	445	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPATRG", 150)
	446
	447	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCAC",6 )
	448
	449	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCORD", 151)
	450
	451	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCORD1" ,152)
	452
	453	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCORD2" ,153)
	454
	455	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCORD3" ,154)
	456
	457	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCORD4" ,11)
	458
	459	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCORD5" ,12)
	460
	461	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCPAT", 155)
	462
	463	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCPAT1" ,156)
	464
	465	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCPRS", 15)
	466
	467	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCRPC", 16)
	468
	469	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPCRPC1" ,17)
	470
	471	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPD",18)
	472
	473	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDCRC", 19)
	474
	475	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDE811" ,157)
	476
	477	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDERRH" ,21)
	478
	479	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDGMPL" ,22)
	480
	481	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDGMRA" ,23)
	482
	483	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDGMRC" ,158)
	484
	485	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDGMV", 25)
	486
	487	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDGPF", 159)
	488
	489	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDIB",1 60)
	490
	491	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ",28 )
	492
	493	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ0",2 9)
	494
	495	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ00", 30)
	496
	497	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ00A" ,161)
	498
	499	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ01", 33)
	500
	501	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ02", 35)
	502
	503	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ03", 36)
	504
	505	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ04", 37)
	506
	507	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ04A" ,38)
	508
	509	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ04E" ,39)
	510
	511	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ05", 40)
	512
	513	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ05V" ,41)
	514
	515	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ06", 42)
	516
	517	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ07", 43)
	518
	519	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ08", 44)
	520
	521	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ08A" ,45)
	522
	523	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ09", 46)
	524
	525	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ09M" ,47)
	526
	527	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ1",3 2)
	528
	529	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJ2",3 4)
	530
	531	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJFS", 48)
	532
	533	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJFS1" ,148)
	534
	535	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJFSD" ,49)
	536
	537	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJFSG" ,50)
	538
	539	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJFSM" ,51)
	540
	541	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJFSP" ,52)
	542
	543	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJFST" ,162)
	544
	545	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJT",1 63)
	546
	547	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDJX",5 5)
	548
	549	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDLR",5 6)
	550
	551	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDLRA", 57)
	552
	553	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDLRO", 164)
	554
	555	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDMC",5 9)
	556
	557	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDMDC", 60)
	558
	559	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDOR",6 1)
	560
	561	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPROC" ,165)
	562
	563	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPS",2 00)
	564
	565	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPSI", 201)
	566
	567	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPSO", 202)
	568
	569	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPSOR" ,66)
	570
	571	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPT",1 66)
	572
	573	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPXAM" ,167)
	574
	575	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPXED" ,168)
	576
	577	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPXHF" ,169)
	578
	579	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPXIM" ,170)
	580
	581	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDPXSK" ,171)
	582
	583	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDRA",7 3)
	584
	585	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDSDAM" ,74)
	586
	587	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDSR",7 5)
	588
	589	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDTIU", 76)
	590
	591	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDTIUX" ,172)
	592
	593	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPDVSIT" ,78)
	594
	595	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEASU", 79)
	596
	597	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEF",80 )
	598
	599	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEF1",1 47)
	600
	601	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEFSG", 173)
	602
	603	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEFSP", 174)
	604
	605	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEFST", 175)
	606
	607	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEFX",8 4)
	608
	609	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEHL7", 85)
	610
	611	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPELAB", 86)
	612
	613	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPENSZ", 176)
	614
	615	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPENSZ1" ,177)
	616
	617	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEQ",89 )
	618
	619	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEQLM", 90)
	620
	621	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEQLM1" ,91)
	622
	623	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEQLM2" ,92)
	624
	625	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPEVNT", 93)
	626
	627	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPFPTC", 94)
	628
	629	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPHTTP", 95)
	630
	631	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPIDX",9 6)
	632
	633	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPJSON", 97)
	634
	635	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPJSOND" ,98)
	636
	637	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPJSONE" ,99)
	638
	639	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPLIST", 100)
	640
	641	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPMDUTL" ,101)
	642
	643	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPMETA", 102)
	644
	645	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPP2I",1 78)
	646
	647	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPP3I",1 04)
	648
	649	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPANEL" ,179)
	650
	651	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPARAM" ,106)
	652
	653	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPATS", 107)
	654
	655	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPDL",1 39)
	656
	657	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPI",18 0)
	658
	659	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPRODC" ,181)
	660
	661	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPRXY2" ,110)
	662
	663	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPTDEM" ,111)
	664
	665	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPXPR1" ,182)
	666
	667	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPPXRM", 113)
	668
	669	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPROS2", 183)
	670
	671	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPROS3", 184)
	672
	673	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPROS4", 185)
	674
	675	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPROS5", 186)
	676
	677	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPROS6", 187)
	678
	679	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPROS7", 188)
	680
	681	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPROS8", 149)
	682
	683	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPSR",18 9)
	684
	685	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPSTMP", 122)
	686
	687	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPTFU2", 123)
	688
	689	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPTOOLS" ,1)
	690
	691	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPTRPC", 190)
	692
	693	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPTRPC1" ,191)
	694
	695	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPUPD",1 26)
	696
	697	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPUTIL1" ,127)
	698
	699	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPUTILS" ,128)
	700
	701	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPWB",19 2)
	702
	703	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPWB1",1 93)
	704
	705	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPWB2",1 94)
	706
	707	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPXGDPT" ,142)
	708
	709	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPXGLAB" ,143)
	710
	711	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPXGNP", 145)
	712
	713	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPXGORD" ,144)
	714
	715	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPXGSD", 146)
	716
	717	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPYCSI", 195)
	718
	719	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPYCSO", 133)
	720
	721	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPYFRP", 196)
	722
	723	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPYFRP1" ,197)
	724
	725	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPYFRP2" ,198)
	726
	727	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPYPAR", 199)
	728
	729	"BLD",9075 ,"KRN",9.8 ,"NM","B", "HMPZ0218" ,141)
	730
	731	"BLD",9075 ,"KRN",19, 0)
	732	19
	733	"BLD",9075 ,"KRN",19, "NM",0)
	734	^9.68A^17^ 16
	735	"BLD",9075 ,"KRN",19, "NM",1,0)
	736	HMP APPLIC ATION PROX Y^^0
	737	"BLD",9075 ,"KRN",19, "NM",2,0)
	738	HMP APPOIN TMENTS^^0
	739	"BLD",9075 ,"KRN",19, "NM",3,0)
	740	HMP PATIEN T ACTIVITY ^^0
	741	"BLD",9075 ,"KRN",19, "NM",4,0)
	742	HMP PATIEN T DATA MON ITOR^^0
	743	"BLD",9075 ,"KRN",19, "NM",5,0)
	744	HMP SYNCHR ONIZATION CONTEXT^^0
	745	"BLD",9075 ,"KRN",19, "NM",6,0)
	746	HMP UI CON TEXT^^0
	747	"BLD",9075 ,"KRN",19, "NM",7,0)
	748	HMP WB PTD EM^^0
	749	"BLD",9075 ,"KRN",19, "NM",8,0)
	750	HMP XU EVE NTS^^0
	751	"BLD",9075 ,"KRN",19, "NM",9,0)
	752	HMPM ADD H MP PATIENT ^^0
	753	"BLD",9075 ,"KRN",19, "NM",10,0)
	754	HMPM ADD H MP USER^^0
	755	"BLD",9075 ,"KRN",19, "NM",11,0)
	756	HMPM EMERG ENCY STOP^ ^0
	757	"BLD",9075 ,"KRN",19, "NM",12,0)
	758	HMPM EXTRA CT MONITOR ^^0
	759	"BLD",9075 ,"KRN",19, "NM",13,0)
	760	HMPM RESTA RT FRESHNE SS^^0
	761	"BLD",9075 ,"KRN",19, "NM",14,0)
	762	HMPMGR^^0
	763	"BLD",9075 ,"KRN",19, "NM",16,0)
	764	HMP WB DOM AINS^^0
	765	"BLD",9075 ,"KRN",19, "NM",17,0)
	766	HMP MONITO R FOR XTMP GLOBAL^^0
	767	"BLD",9075 ,"KRN",19, "NM","B"," HMP APPLIC ATION PROX Y",1)
	768
	769	"BLD",9075 ,"KRN",19, "NM","B"," HMP APPOIN TMENTS",2)
	770
	771	"BLD",9075 ,"KRN",19, "NM","B"," HMP MONITO R FOR XTMP GLOBAL",1 7)
	772
	773	"BLD",9075 ,"KRN",19, "NM","B"," HMP PATIEN T ACTIVITY ",3)
	774
	775	"BLD",9075 ,"KRN",19, "NM","B"," HMP PATIEN T DATA MON ITOR",4)
	776
	777	"BLD",9075 ,"KRN",19, "NM","B"," HMP SYNCHR ONIZATION CONTEXT",5 )
	778
	779	"BLD",9075 ,"KRN",19, "NM","B"," HMP UI CON TEXT",6)
	780
	781	"BLD",9075 ,"KRN",19, "NM","B"," HMP WB DOM AINS",16)
	782
	783	"BLD",9075 ,"KRN",19, "NM","B"," HMP WB PTD EM",7)
	784
	785	"BLD",9075 ,"KRN",19, "NM","B"," HMP XU EVE NTS",8)
	786
	787	"BLD",9075 ,"KRN",19, "NM","B"," HMPM ADD H MP PATIENT ",9)
	788
	789	"BLD",9075 ,"KRN",19, "NM","B"," HMPM ADD H MP USER",1 0)
	790
	791	"BLD",9075 ,"KRN",19, "NM","B"," HMPM EMERG ENCY STOP" ,11)
	792
	793	"BLD",9075 ,"KRN",19, "NM","B"," HMPM EXTRA CT MONITOR ",12)
	794
	795	"BLD",9075 ,"KRN",19, "NM","B"," HMPM RESTA RT FRESHNE SS",13)
	796
	797	"BLD",9075 ,"KRN",19, "NM","B"," HMPMGR",14 )
	798
	799	"BLD",9075 ,"KRN",19. 1,0)
	800	19.1
	801	"BLD",9075 ,"KRN",19. 1,"NM",0)
	802	^9.68A^2^2
	803	"BLD",9075 ,"KRN",19. 1,"NM",1,0 )
	804	HMP ADMIN^ ^0
	805	"BLD",9075 ,"KRN",19. 1,"NM",2,0 )
	806	HMP EXPERI MENTAL^^0
	807	"BLD",9075 ,"KRN",19. 1,"NM","B" ,"HMP ADMI N",1)
	808
	809	"BLD",9075 ,"KRN",19. 1,"NM","B" ,"HMP EXPE RIMENTAL", 2)
	810
	811	"BLD",9075 ,"KRN",101 ,0)
	812	101
	813	"BLD",9075 ,"KRN",101 ,"NM",0)
	814	^9.68A^49^ 48
	815	"BLD",9075 ,"KRN",101 ,"NM",1,0)
	816	HMP ADT-A0 4 CLIENT^^ 0
	817	"BLD",9075 ,"KRN",101 ,"NM",2,0)
	818	HMP ADT-A0 8 CLIENT^^ 0
	819	"BLD",9075 ,"KRN",101 ,"NM",3,0)
	820	HMP APPT E VENTS^^0
	821	"BLD",9075 ,"KRN",101 ,"NM",4,0)
	822	HMP DG UPD ATES^^0
	823	"BLD",9075 ,"KRN",101 ,"NM",5,0)
	824	HMP GMPL E VENT^^0
	825	"BLD",9075 ,"KRN",101 ,"NM",6,0)
	826	HMP GMRA E VENTS^^0
	827	"BLD",9075 ,"KRN",101 ,"NM",7,0)
	828	HMP INPT E VENTS^^0
	829	"BLD",9075 ,"KRN",101 ,"NM",8,0)
	830	HMP MDC EV ENT^^0
	831	"BLD",9075 ,"KRN",101 ,"NM",9,0)
	832	HMP NA EVE NTS^^0
	833	"BLD",9075 ,"KRN",101 ,"NM",11,0 )
	834	HMP PCE EV ENTS^^0
	835	"BLD",9075 ,"KRN",101 ,"NM",12,0 )
	836	HMP PCMM T EAM^^0
	837	"BLD",9075 ,"KRN",101 ,"NM",13,0 )
	838	HMP PCMM T EAM POSITI ON^^0
	839	"BLD",9075 ,"KRN",101 ,"NM",14,0 )
	840	HMP PSB EV ENTS^^0
	841	"BLD",9075 ,"KRN",101 ,"NM",15,0 )
	842	HMP XQOR E VENTS^^0
	843	"BLD",9075 ,"KRN",101 ,"NM",16,0 )
	844	HMPM EVT Q UE CHANGE DOMAIN^^0
	845	"BLD",9075 ,"KRN",101 ,"NM",17,0 )
	846	HMPM EVT Q UE MGR MEN U^^0
	847	"BLD",9075 ,"KRN",101 ,"NM",18,0 )
	848	HMPM EVT Q UE CHANGE MAX LISTED ^^0
	849	"BLD",9075 ,"KRN",101 ,"NM",19,0 )
	850	HMPM EVT Q UE SELECT PATIENT^^0
	851	"BLD",9075 ,"KRN",101 ,"NM",20,0 )
	852	HMPM EVT Q UE SHOW TE MP GLOBALS ^^0
	853	"BLD",9075 ,"KRN",101 ,"NM",21,0 )
	854	HMPM EVT Q UE FILTER^ ^0
	855	"BLD",9075 ,"KRN",101 ,"NM",22,0 )
	856	HMPM EVT Q UE FRESHNE SS REPORT^ ^0
	857	"BLD",9075 ,"KRN",101 ,"NM",23,0 )
	858	HMPM EVT Q UE DISPLAY DETAILS^^ 0
	859	"BLD",9075 ,"KRN",101 ,"NM",24,0 )
	860	HMPM EVT Q UE REFRESH ^^0
	861	"BLD",9075 ,"KRN",101 ,"NM",25,0 )
	862	HMPM EVT Q UE CHANGE SERVER^^0
	863	"BLD",9075 ,"KRN",101 ,"NM",26,0 )
	864	HMP DGPF A SSIGN FLAG ^^0
	865	"BLD",9075 ,"KRN",101 ,"NM",27,0 )
	866	GMPL EVENT ^^2
	867	"BLD",9075 ,"KRN",101 ,"NM",28,0 )
	868	OR EVSEND VPR^^2
	869	"BLD",9075 ,"KRN",101 ,"NM",29,0 )
	870	MDC OBSERV ATION UPDA TE^^2
	871	"BLD",9075 ,"KRN",101 ,"NM",30,0 )
	872	PSB EVSEND VPR^^2
	873	"BLD",9075 ,"KRN",101 ,"NM",31,0 )
	874	GMRC EVSEN D OR^^2
	875	"BLD",9075 ,"KRN",101 ,"NM",32,0 )
	876	OR EVSEND LRCH^^2
	877	"BLD",9075 ,"KRN",101 ,"NM",33,0 )
	878	DGPM MOVEM ENT EVENTS ^^2
	879	"BLD",9075 ,"KRN",101 ,"NM",34,0 )
	880	SDAM APPOI NTMENT EVE NTS^^2
	881	"BLD",9075 ,"KRN",101 ,"NM",35,0 )
	882	RA EVSEND OR^^2
	883	"BLD",9075 ,"KRN",101 ,"NM",36,0 )
	884	PXK VISIT DATA EVENT ^^2
	885	"BLD",9075 ,"KRN",101 ,"NM",37,0 )
	886	GMRA SIGN- OFF ON DAT A^^2
	887	"BLD",9075 ,"KRN",101 ,"NM",38,0 )
	888	GMRA ENTER ED IN ERRO R^^2
	889	"BLD",9075 ,"KRN",101 ,"NM",39,0 )
	890	SCMC PATIE NT TEAM CH ANGES^^2
	891	"BLD",9075 ,"KRN",101 ,"NM",40,0 )
	892	SCMC PATIE NT TEAM PO SITION CHA NGES^^2
	893	"BLD",9075 ,"KRN",101 ,"NM",41,0 )
	894	LR7O CH EV SEND OR^^2
	895	"BLD",9075 ,"KRN",101 ,"NM",42,0 )
	896	PS EVSEND OR^^2
	897	"BLD",9075 ,"KRN",101 ,"NM",43,0 )
	898	FH EVSEND OR^^2
	899	"BLD",9075 ,"KRN",101 ,"NM",44,0 )
	900	OR EVSEND RA^^2
	901	"BLD",9075 ,"KRN",101 ,"NM",45,0 )
	902	OR EVSEND FH^^2
	903	"BLD",9075 ,"KRN",101 ,"NM",46,0 )
	904	OR EVSEND ORG^^2
	905	"BLD",9075 ,"KRN",101 ,"NM",47,0 )
	906	OR EVSEND PS^^2
	907	"BLD",9075 ,"KRN",101 ,"NM",48,0 )
	908	OR EVSEND GMRC^^2
	909	"BLD",9075 ,"KRN",101 ,"NM",49,0 )
	910	DG FIELD M ONITOR^^2
	911	"BLD",9075 ,"KRN",101 ,"NM","B", "DG FIELD MONITOR",4 9)
	912
	913	"BLD",9075 ,"KRN",101 ,"NM","B", "DGPM MOVE MENT EVENT S",33)
	914
	915	"BLD",9075 ,"KRN",101 ,"NM","B", "FH EVSEND OR",43)
	916
	917	"BLD",9075 ,"KRN",101 ,"NM","B", "GMPL EVEN T",27)
	918
	919	"BLD",9075 ,"KRN",101 ,"NM","B", "GMRA ENTE RED IN ERR OR",38)
	920
	921	"BLD",9075 ,"KRN",101 ,"NM","B", "GMRA SIGN -OFF ON DA TA",37)
	922
	923	"BLD",9075 ,"KRN",101 ,"NM","B", "GMRC EVSE ND OR",31)
	924
	925	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP ADT-A 04 CLIENT" ,1)
	926
	927	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP ADT-A 08 CLIENT" ,2)
	928
	929	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP APPT EVENTS",3)
	930
	931	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP DG UP DATES",4)
	932
	933	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP DGPF ASSIGN FLA G",26)
	934
	935	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP GMPL EVENT",5)
	936
	937	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP GMRA EVENTS",6)
	938
	939	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP INPT EVENTS",7)
	940
	941	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP MDC E VENT",8)
	942
	943	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP NA EV ENTS",9)
	944
	945	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP PCE E VENTS",11)
	946
	947	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP PCMM TEAM",12)
	948
	949	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP PCMM TEAM POSIT ION",13)
	950
	951	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP PSB E VENTS",14)
	952
	953	"BLD",9075 ,"KRN",101 ,"NM","B", "HMP XQOR EVENTS",15 )
	954
	955	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE CHANGE DOMAIN",1 6)
	956
	957	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE CHANGE MAX LISTE D",18)
	958
	959	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE CHANGE SERVER",2 5)
	960
	961	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE DISPLA Y DETAILS" ,23)
	962
	963	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE FILTER ",21)
	964
	965	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE FRESHN ESS REPORT ",22)
	966
	967	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE MGR ME NU",17)
	968
	969	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE REFRES H",24)
	970
	971	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE SELECT PATIENT", 19)
	972
	973	"BLD",9075 ,"KRN",101 ,"NM","B", "HMPM EVT QUE SHOW T EMP GLOBAL S",20)
	974
	975	"BLD",9075 ,"KRN",101 ,"NM","B", "LR7O CH E VSEND OR", 41)
	976
	977	"BLD",9075 ,"KRN",101 ,"NM","B", "MDC OBSER VATION UPD ATE",29)
	978
	979	"BLD",9075 ,"KRN",101 ,"NM","B", "OR EVSEND FH",45)
	980
	981	"BLD",9075 ,"KRN",101 ,"NM","B", "OR EVSEND GMRC",48)
	982
	983	"BLD",9075 ,"KRN",101 ,"NM","B", "OR EVSEND LRCH",32)
	984
	985	"BLD",9075 ,"KRN",101 ,"NM","B", "OR EVSEND ORG",46)
	986
	987	"BLD",9075 ,"KRN",101 ,"NM","B", "OR EVSEND PS",47)
	988
	989	"BLD",9075 ,"KRN",101 ,"NM","B", "OR EVSEND RA",44)
	990
	991	"BLD",9075 ,"KRN",101 ,"NM","B", "OR EVSEND VPR",28)
	992
	993	"BLD",9075 ,"KRN",101 ,"NM","B", "PS EVSEND OR",42)
	994
	995	"BLD",9075 ,"KRN",101 ,"NM","B", "PSB EVSEN D VPR",30)
	996
	997	"BLD",9075 ,"KRN",101 ,"NM","B", "PXK VISIT DATA EVEN T",36)
	998
	999	"BLD",9075 ,"KRN",101 ,"NM","B", "RA EVSEND OR",35)
	1000
	1001	"BLD",9075 ,"KRN",101 ,"NM","B", "SCMC PATI ENT TEAM C HANGES",39 )
	1002
	1003	"BLD",9075 ,"KRN",101 ,"NM","B", "SCMC PATI ENT TEAM P OSITION CH ANGES",40)
	1004
	1005	"BLD",9075 ,"KRN",101 ,"NM","B", "SDAM APPO INTMENT EV ENTS",34)
	1006
	1007	"BLD",9075 ,"KRN",409 .61,0)
	1008	409.61
	1009	"BLD",9075 ,"KRN",409 .61,"NM",0 )
	1010	^9.68A^1^1
	1011	"BLD",9075 ,"KRN",409 .61,"NM",1 ,0)
	1012	HMPM EVT Q UE MGR^^0
	1013	"BLD",9075 ,"KRN",409 .61,"NM"," B","HMPM E VT QUE MGR ",1)
	1014
	1015	"BLD",9075 ,"KRN",771 ,0)
	1016	771
	1017	"BLD",9075 ,"KRN",771 ,"NM",0)
	1018	^9.68A^1^1
	1019	"BLD",9075 ,"KRN",771 ,"NM",1,0)
	1020	HMP HL7^^0
	1021	"BLD",9075 ,"KRN",771 ,"NM","B", "HMP HL7", 1)
	1022
	1023	"BLD",9075 ,"KRN",779 .2,0)
	1024	779.2
	1025	"BLD",9075 ,"KRN",870 ,0)
	1026	870
	1027	"BLD",9075 ,"KRN",870 ,"NM",0)
	1028	^9.68A^^
	1029	"BLD",9075 ,"KRN",898 9.51,0)
	1030	8989.51
	1031	"BLD",9075 ,"KRN",898 9.51,"NM", 0)
	1032	^9.68A^12^ 10
	1033	"BLD",9075 ,"KRN",898 9.51,"NM", 1,0)
	1034	HMP CPRS P ATH^^0
	1035	"BLD",9075 ,"KRN",898 9.51,"NM", 2,0)
	1036	HMP JSON S CHEMA^^0
	1037	"BLD",9075 ,"KRN",898 9.51,"NM", 3,0)
	1038	HMP LOCATI ONS^^0
	1039	"BLD",9075 ,"KRN",898 9.51,"NM", 4,0)
	1040	HMP PARAME TERS^^0
	1041	"BLD",9075 ,"KRN",898 9.51,"NM", 7,0)
	1042	HMP SYSTEM NAME^^0
	1043	"BLD",9075 ,"KRN",898 9.51,"NM", 8,0)
	1044	HMP TASK W AIT TIME^^ 0
	1045	"BLD",9075 ,"KRN",898 9.51,"NM", 9,0)
	1046	HMP VERSIO N^^0
	1047	"BLD",9075 ,"KRN",898 9.51,"NM", 10,0)
	1048	HMP DOMAIN SIZES^^0
	1049	"BLD",9075 ,"KRN",898 9.51,"NM", 11,0)
	1050	HMP EXTRAC T DISK SIZ E LIMIT^^0
	1051	"BLD",9075 ,"KRN",898 9.51,"NM", 12,0)
	1052	HMP EXTRAC T TASK REQ UEUE SECS^ ^0
	1053	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP C PRS PATH", 1)
	1054
	1055	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP D OMAIN SIZE S",10)
	1056
	1057	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP E XTRACT DIS K SIZE LIM IT",11)
	1058
	1059	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP E XTRACT TAS K REQUEUE SECS",12)
	1060
	1061	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP J SON SCHEMA ",2)
	1062
	1063	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP L OCATIONS", 3)
	1064
	1065	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP P ARAMETERS" ,4)
	1066
	1067	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP S YSTEM NAME ",7)
	1068
	1069	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP T ASK WAIT T IME",8)
	1070
	1071	"BLD",9075 ,"KRN",898 9.51,"NM", "B","HMP V ERSION",9)
	1072
	1073	"BLD",9075 ,"KRN",898 9.52,0)
	1074	8989.52
	1075	"BLD",9075 ,"KRN",898 9.52,"NM", 0)
	1076	^9.68A^^
	1077	"BLD",9075 ,"KRN",899 4,0)
	1078	8994
	1079	"BLD",9075 ,"KRN",899 4,"NM",0)
	1080	^9.68A^41^ 41
	1081	"BLD",9075 ,"KRN",899 4,"NM",1,0 )
	1082	HMP APPOIN TMENTS^^0
	1083	"BLD",9075 ,"KRN",899 4,"NM",2,0 )
	1084	HMP DATA V ERSION^^0
	1085	"BLD",9075 ,"KRN",899 4,"NM",3,0 )
	1086	HMP DELETE OBJECT^^0
	1087	"BLD",9075 ,"KRN",899 4,"NM",4,0 )
	1088	HMP DELETE ROSTER^^0
	1089	"BLD",9075 ,"KRN",899 4,"NM",5,0 )
	1090	HMP GET CH ECKSUM^^0
	1091	"BLD",9075 ,"KRN",899 4,"NM",6,0 )
	1092	HMP GET OB JECT^^0
	1093	"BLD",9075 ,"KRN",899 4,"NM",7,0 )
	1094	HMP GET OP ERATIONAL DATA^^0
	1095	"BLD",9075 ,"KRN",899 4,"NM",8,0 )
	1096	HMP GET PA TIENT DATA ^^0
	1097	"BLD",9075 ,"KRN",899 4,"NM",9,0 )
	1098	HMP GET PA TIENT DATA JSON^^0
	1099	"BLD",9075 ,"KRN",899 4,"NM",10, 0)
	1100	HMP GET RE FERENCE DA TA^^0
	1101	"BLD",9075 ,"KRN",899 4,"NM",11, 0)
	1102	HMP GET RO STER LIST^ ^0
	1103	"BLD",9075 ,"KRN",899 4,"NM",12, 0)
	1104	HMP GET SO URCE^^0
	1105	"BLD",9075 ,"KRN",899 4,"NM",13, 0)
	1106	HMP INPATI ENTS^^0
	1107	"BLD",9075 ,"KRN",899 4,"NM",14, 0)
	1108	HMP PATIEN T ACTIVITY ^^0
	1109	"BLD",9075 ,"KRN",899 4,"NM",15, 0)
	1110	HMP PREVIE W ROSTER^^ 0
	1111	"BLD",9075 ,"KRN",899 4,"NM",16, 0)
	1112	HMP PUT DE MOGRAPHICS ^^0
	1113	"BLD",9075 ,"KRN",899 4,"NM",17, 0)
	1114	HMP PUT OB JECT^^0
	1115	"BLD",9075 ,"KRN",899 4,"NM",18, 0)
	1116	HMP PUT PA TIENT DATA ^^0
	1117	"BLD",9075 ,"KRN",899 4,"NM",19, 0)
	1118	HMP ROSTER PATIENTS^ ^0
	1119	"BLD",9075 ,"KRN",899 4,"NM",20, 0)
	1120	HMP ROSTER S^^0
	1121	"BLD",9075 ,"KRN",899 4,"NM",21, 0)
	1122	HMP SUBSCR IBE^^0
	1123	"BLD",9075 ,"KRN",899 4,"NM",22, 0)
	1124	HMP SUBSCR IBE ROSTER S^^0
	1125	"BLD",9075 ,"KRN",899 4,"NM",23, 0)
	1126	HMP UPDATE ROSTER^^0
	1127	"BLD",9075 ,"KRN",899 4,"NM",24, 0)
	1128	HMP WRITEB ACK PT DEM ^^0
	1129	"BLD",9075 ,"KRN",899 4,"NM",25, 0)
	1130	HMPCORD RP C^^0
	1131	"BLD",9075 ,"KRN",899 4,"NM",26, 0)
	1132	HMPCPAT RP C^^0
	1133	"BLD",9075 ,"KRN",899 4,"NM",27, 0)
	1134	HMPCPRS RP C^^0
	1135	"BLD",9075 ,"KRN",899 4,"NM",28, 0)
	1136	HMPCRPC RP C^^0
	1137	"BLD",9075 ,"KRN",899 4,"NM",29, 0)
	1138	HMPCRPC RP CCHAIN^^0
	1139	"BLD",9075 ,"KRN",899 4,"NM",30, 0)
	1140	HMPDJFS AP I^^0
	1141	"BLD",9075 ,"KRN",899 4,"NM",31, 0)
	1142	HMPDJFS DE LSUB^^0
	1143	"BLD",9075 ,"KRN",899 4,"NM",32, 0)
	1144	HMPFPTC CH KS^^0
	1145	"BLD",9075 ,"KRN",899 4,"NM",33, 0)
	1146	HMPFPTC LO G^^0
	1147	"BLD",9075 ,"KRN",899 4,"NM",34, 0)
	1148	HMP LOCAL CORRESPOND INGIDS^^0
	1149	"BLD",9075 ,"KRN",899 4,"NM",35, 0)
	1150	HMP LOCAL GETCORRESP ONDINGIDS^ ^0
	1151	"BLD",9075 ,"KRN",899 4,"NM",36, 0)
	1152	HMP PUT OP ERATIONAL DATA^^0
	1153	"BLD",9075 ,"KRN",899 4,"NM",37, 0)
	1154	HMP CHKXTM P^^0
	1155	"BLD",9075 ,"KRN",899 4,"NM",38, 0)
	1156	HMP GLOBAL SIZE^^0
	1157	"BLD",9075 ,"KRN",899 4,"NM",39, 0)
	1158	HMP PATIEN T SCHED SY NC^^0
	1159	"BLD",9075 ,"KRN",899 4,"NM",40, 0)
	1160	HMP PATIEN T ADMIT SY NC^^0
	1161	"BLD",9075 ,"KRN",899 4,"NM",41, 0)
	1162	HMP DEFAUL T PATIENT LIST^^0
	1163	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP APPO INTMENTS", 1)
	1164
	1165	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP CHKX TMP",37)
	1166
	1167	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP DATA VERSION", 2)
	1168
	1169	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP DEFA ULT PATIEN T LIST",41 )
	1170
	1171	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP DELE TE OBJECT" ,3)
	1172
	1173	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP DELE TE ROSTER" ,4)
	1174
	1175	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP GET CHECKSUM", 5)
	1176
	1177	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP GET OBJECT",6)
	1178
	1179	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP GET OPERATIONA L DATA",7)
	1180
	1181	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP GET PATIENT DA TA",8)
	1182
	1183	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP GET PATIENT DA TA JSON",9 )
	1184
	1185	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP GET REFERENCE DATA",10)
	1186
	1187	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP GET ROSTER LIS T",11)
	1188
	1189	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP GET SOURCE",12 )
	1190
	1191	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP GLOB AL SIZE",3 8)
	1192
	1193	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP INPA TIENTS",13 )
	1194
	1195	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP LOCA L CORRESPO NDINGIDS", 34)
	1196
	1197	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP LOCA L GETCORRE SPONDINGID S",35)
	1198
	1199	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP PATI ENT ACTIVI TY",14)
	1200
	1201	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP PATI ENT ADMIT SYNC",40)
	1202
	1203	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP PATI ENT SCHED SYNC",39)
	1204
	1205	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP PREV IEW ROSTER ",15)
	1206
	1207	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP PUT DEMOGRAPHI CS",16)
	1208
	1209	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP PUT OBJECT",17 )
	1210
	1211	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP PUT OPERATIONA L DATA",36 )
	1212
	1213	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP PUT PATIENT DA TA",18)
	1214
	1215	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP ROST ER PATIENT S",19)
	1216
	1217	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP ROST ERS",20)
	1218
	1219	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP SUBS CRIBE",21)
	1220
	1221	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP SUBS CRIBE ROST ERS",22)
	1222
	1223	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP UPDA TE ROSTER" ,23)
	1224
	1225	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMP WRIT EBACK PT D EM",24)
	1226
	1227	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMPCORD RPC",25)
	1228
	1229	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMPCPAT RPC",26)
	1230
	1231	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMPCPRS RPC",27)
	1232
	1233	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMPCRPC RPC",28)
	1234
	1235	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMPCRPC RPCCHAIN", 29)
	1236
	1237	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMPDJFS API",30)
	1238
	1239	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMPDJFS DELSUB",31 )
	1240
	1241	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMPFPTC CHKS",32)
	1242
	1243	"BLD",9075 ,"KRN",899 4,"NM","B" ,"HMPFPTC LOG",33)
	1244
	1245	"BLD",9075 ,"KRN","B" ,.4,.4)
	1246
	1247	"BLD",9075 ,"KRN","B" ,.401,.401 )
	1248
	1249	"BLD",9075 ,"KRN","B" ,.402,.402 )
	1250
	1251	"BLD",9075 ,"KRN","B" ,.403,.403 )
	1252
	1253	"BLD",9075 ,"KRN","B" ,.5,.5)
	1254
	1255	"BLD",9075 ,"KRN","B" ,.84,.84)
	1256
	1257	"BLD",9075 ,"KRN","B" ,3.6,3.6)
	1258
	1259	"BLD",9075 ,"KRN","B" ,3.8,3.8)
	1260
	1261	"BLD",9075 ,"KRN","B" ,9.2,9.2)
	1262
	1263	"BLD",9075 ,"KRN","B" ,9.8,9.8)
	1264
	1265	"BLD",9075 ,"KRN","B" ,19,19)
	1266
	1267	"BLD",9075 ,"KRN","B" ,19.1,19.1 )
	1268
	1269	"BLD",9075 ,"KRN","B" ,101,101)
	1270
	1271	"BLD",9075 ,"KRN","B" ,409.61,40 9.61)
	1272
	1273	"BLD",9075 ,"KRN","B" ,771,771)
	1274
	1275	"BLD",9075 ,"KRN","B" ,779.2,779 .2)
	1276
	1277	"BLD",9075 ,"KRN","B" ,870,870)
	1278
	1279	"BLD",9075 ,"KRN","B" ,8989.51,8 989.51)
	1280
	1281	"BLD",9075 ,"KRN","B" ,8989.52,8 989.52)
	1282
	1283	"BLD",9075 ,"KRN","B" ,8994,8994 )
	1284
	1285	"BLD",9075 ,"QDEF")
	1286	^^^^NO^^^^ YES^^NO
	1287	"BLD",9075 ,"QUES",0)
	1288	^9.62^^
	1289	"BLD",9075 ,"REQB",0)
	1290	^9.611^7^7
	1291	"BLD",9075 ,"REQB",1, 0)
	1292	MD1.038^ 2
	1293	"BLD",9075 ,"REQB",2, 0)
	1294	OR3.0390 ^2
	1295	"BLD",9075 ,"REQB",3, 0)
	1296	PSB3.079 ^2
	1297	"BLD",9075 ,"REQB",4, 0)
	1298	TIU1.010 6^2
	1299	"BLD",9075 ,"REQB",5, 0)
	1300	GMRC3.08 0^2
	1301	"BLD",9075 ,"REQB",6, 0)
	1302	TIU1.029 8^2
	1303	"BLD",9075 ,"REQB",7, 0)
	1304	USR1.037 ^2
	1305	"BLD",9075 ,"REQB","B ","GMRC3. 080",5)
	1306
	1307	"BLD",9075 ,"REQB","B ","MD1.0 38",1)
	1308
	1309	"BLD",9075 ,"REQB","B ","OR3.0 390",2)
	1310
	1311	"BLD",9075 ,"REQB","B ","PSB3.0 79",3)
	1312
	1313	"BLD",9075 ,"REQB","B ","TIU1.0 106",4)
	1314
	1315	"BLD",9075 ,"REQB","B ","TIU1.0 298",6)
	1316
	1317	"BLD",9075 ,"REQB","B ","USR1.0 37",7)
	1318
	1319	"DATA",800 000.21,1,0 )
	1320	ACUITY COD E^ac^acuit yCode
	1321	"DATA",800 000.21,2,0 )
	1322	STATUS COD E^sc^statu sCode
	1323	"DATA",800 000.21,3,0 )
	1324	INTERPRETA TION^int^i nterpretat ion
	1325	"DATA",800 000.21,4,0 )
	1326	RESULT STA TUS^rs^res ultStatus
	1327	"DATA",800 000.21,5,0 )
	1328	INTERPRETA TION CODE^ ic^interpr etationCod e
	1329	"DATA",800 000.21,6,0 )
	1330	PATIENT CL ASS CODE^p cc^patient ClassCode
	1331	"DATA",800 000.21,7,0 )
	1332	CATEGORY C ODE^cc^cat egoryCode
	1333	"DATA",800 000.21,8,0 )
	1334	MEDICATION STATUS^ms ^medStatus
	1335	"DATA",800 000.21,9,0 )
	1336	MEDICATION TYPE^mt^m edType
	1337	"DATA",800 000.21,10, 0)
	1338	INGREDIENT ROLE^ir^i ngredientR ole
	1339	"DATA",800 000.22,1,0 )
	1340	ACUITY COD E^ac^acuit yCode
	1341	"DATA",800 000.22,2,0 )
	1342	STATUS COD E^sc^statu sCode
	1343	"DATA",800 000.22,3,0 )
	1344	INTERPRETA TION^int^i nterpretat ion
	1345	"DATA",800 000.22,4,0 )
	1346	RESULT STA TUS^rs^res ultStatus
	1347	"DATA",800 000.22,5,0 )
	1348	INTERPRETA TION CODE^ ic^interpr etationCod e
	1349	"DATA",800 000.22,6,0 )
	1350	PATIENT CL ASS CODE^p cc^patient ClassCode
	1351	"DATA",800 000.22,7,0 )
	1352	CATEGORY C ODE^cc^cat egoryCode
	1353	"DATA",800 000.22,8,0 )
	1354	MEDICATION STATUS^ms ^medStatus
	1355	"DATA",800 000.22,9,0 )
	1356	MEDICATION TYPE^mt^m edType
	1357	"DATA",800 000.22,10, 0)
	1358	INGREDIENT ROLE^ir^i ngredientR ole
	1359	"FIA",8000 00)
	1360	HMP SUBSCR IPTION
	1361	"FIA",8000 00,0)
	1362	^HMP(80000 0,
	1363	"FIA",8000 00,0,0)
	1364	800000
	1365	"FIA",8000 00,0,1)
	1366	y^y^f^^^^n ^^
	1367	"FIA",8000 00,0,10)
	1368
	1369	"FIA",8000 00,0,11)
	1370
	1371	"FIA",8000 00,0,"RLRO ")
	1372
	1373	"FIA",8000 00,0,"VR")
	1374	2.0^HMP
	1375	"FIA",8000 00,800000)
	1376	0
	1377	"FIA",8000 00,800000. 01)
	1378	0
	1379	"FIA",8000 00,800000. 02)
	1380	0
	1381	"FIA",8000 00,800000. 14)
	1382	0
	1383	"FIA",8000 00,800000. 142)
	1384	0
	1385	"FIA",8000 00.1)
	1386	HMP PATIEN T OBJECT
	1387	"FIA",8000 00.1,0)
	1388	^HMP(80000 0.1,
	1389	"FIA",8000 00.1,0,0)
	1390	800000.1
	1391	"FIA",8000 00.1,0,1)
	1392	y^y^f^^^^n ^^
	1393	"FIA",8000 00.1,0,10)
	1394
	1395	"FIA",8000 00.1,0,11)
	1396
	1397	"FIA",8000 00.1,0,"RL RO")
	1398
	1399	"FIA",8000 00.1,0,"VR ")
	1400	2.0^HMP
	1401	"FIA",8000 00.1,80000 0.1)
	1402	0
	1403	"FIA",8000 00.1,80000 0.101)
	1404	0
	1405	"FIA",8000 00.11)
	1406	HMP OBJECT
	1407	"FIA",8000 00.11,0)
	1408	^HMP(80000 0.11,
	1409	"FIA",8000 00.11,0,0)
	1410	800000.11
	1411	"FIA",8000 00.11,0,1)
	1412	y^y^f^^^^y ^m^n
	1413	"FIA",8000 00.11,0,10 )
	1414
	1415	"FIA",8000 00.11,0,11 )
	1416
	1417	"FIA",8000 00.11,0,"R LRO")
	1418
	1419	"FIA",8000 00.11,0,"V R")
	1420	2.0^HMP
	1421	"FIA",8000 00.11,8000 00.11)
	1422	0
	1423	"FIA",8000 00.11,8000 00.111)
	1424	0
	1425	"FIA",8000 00.2)
	1426	HMP LIST
	1427	"FIA",8000 00.2,0)
	1428	^HMPD(8000 00.2,
	1429	"FIA",8000 00.2,0,0)
	1430	800000.2
	1431	"FIA",8000 00.2,0,1)
	1432	y^y^f^^n^^ y^m^n
	1433	"FIA",8000 00.2,0,10)
	1434
	1435	"FIA",8000 00.2,0,11)
	1436
	1437	"FIA",8000 00.2,0,"RL RO")
	1438
	1439	"FIA",8000 00.2,0,"VR ")
	1440	2.0^HMP
	1441	"FIA",8000 00.2,80000 0.2)
	1442	0
	1443	"FIA",8000 00.2,80000 0.202)
	1444	0
	1445	"FIA",8000 00.2,80000 0.203)
	1446	0
	1447	"FIA",8000 00.2,80000 0.209)
	1448	0
	1449	"FIA",8000 00.21)
	1450	HMP LIST D OMAIN
	1451	"FIA",8000 00.21,0)
	1452	^HMPD(8000 00.21,
	1453	"FIA",8000 00.21,0,0)
	1454	800000.21
	1455	"FIA",8000 00.21,0,1)
	1456	y^y^f^^n^^ y^m^n
	1457	"FIA",8000 00.21,0,10 )
	1458
	1459	"FIA",8000 00.21,0,11 )
	1460
	1461	"FIA",8000 00.21,0,"R LRO")
	1462
	1463	"FIA",8000 00.21,0,"V R")
	1464	2.0^HMP
	1465	"FIA",8000 00.21,8000 00.21)
	1466	0
	1467	"FIA",8000 00.22)
	1468	HMP LIST A TTRIBUTE
	1469	"FIA",8000 00.22,0)
	1470	^HMPD(8000 00.22,
	1471	"FIA",8000 00.22,0,0)
	1472	800000.22
	1473	"FIA",8000 00.22,0,1)
	1474	y^y^f^^n^^ y^m^n
	1475	"FIA",8000 00.22,0,10 )
	1476
	1477	"FIA",8000 00.22,0,11 )
	1478
	1479	"FIA",8000 00.22,0,"R LRO")
	1480
	1481	"FIA",8000 00.22,0,"V R")
	1482	2.0^HMP
	1483	"FIA",8000 00.22,8000 00.22)
	1484	0
	1485	"FIA",8000 01)
	1486	HMP PANEL
	1487	"FIA",8000 01,0)
	1488	^HMPPANEL(
	1489	"FIA",8000 01,0,0)
	1490	800001P
	1491	"FIA",8000 01,0,1)
	1492	y^y^f^^^^n ^^
	1493	"FIA",8000 01,0,10)
	1494
	1495	"FIA",8000 01,0,11)
	1496
	1497	"FIA",8000 01,0,"RLRO ")
	1498
	1499	"FIA",8000 01,0,"VR")
	1500	2.0^HMP
	1501	"FIA",8000 01,800001)
	1502	0
	1503	"FIA",8000 01,800001. 05)
	1504	0
	1505	"FIA",8000 01.2)
	1506	HMP ROSTER
	1507	"FIA",8000 01.2,0)
	1508	^HMPROSTR( 800001.2,
	1509	"FIA",8000 01.2,0,0)
	1510	800001.2
	1511	"FIA",8000 01.2,0,1)
	1512	y^y^f^^^^n ^^
	1513	"FIA",8000 01.2,0,10)
	1514
	1515	"FIA",8000 01.2,0,11)
	1516
	1517	"FIA",8000 01.2,0,"RL RO")
	1518
	1519	"FIA",8000 01.2,0,"VR ")
	1520	2.0^HMP
	1521	"FIA",8000 01.2,80000 1.2)
	1522	0
	1523	"FIA",8000 01.2,80000 1.21)
	1524	0
	1525	"FIA",8000 01.2,80000 1.23)
	1526	0
	1527	"FIA",8000 01.5)
	1528	HMP ACTIVI TY
	1529	"FIA",8000 01.5,0)
	1530	^HMP(80000 1.5,"PTAPP T",
	1531	"FIA",8000 01.5,0,0)
	1532	800001.5P
	1533	"FIA",8000 01.5,0,1)
	1534	y^y^f^^^^n ^^
	1535	"FIA",8000 01.5,0,10)
	1536
	1537	"FIA",8000 01.5,0,11)
	1538
	1539	"FIA",8000 01.5,0,"RL RO")
	1540
	1541	"FIA",8000 01.5,0,"VR ")
	1542	2.0^HMP
	1543	"FIA",8000 01.5,80000 1.5)
	1544	0
	1545	"INI")
	1546	PRE^HMPP3I
	1547	"INIT")
	1548	POST^HMPP3 I
	1549	"IX",80000 0,800000," ADFN",0)
	1550	800000^ADF N^Patients to track in the Dat a Monitor^ MU^^R^IR^W ^800000.01 ^^^^^S
	1551	"IX",80000 0,800000," ADFN",.1,0 )
	1552	^^1^1^3151 203^
	1553	"IX",80000 0,800000," ADFN",.1,1 ,0)
	1554	This index will plac e the entr y in the d ata monito r for this PATIENT.
	1555	"IX",80000 0,800000," ADFN",1)
	1556	D HMPSET^H MPDJFS(.DA ,.X)
	1557	"IX",80000 0,800000," ADFN",1.4)
	1558	S X=0 I +X (1)>0 S X= 1
	1559	"IX",80000 0,800000," ADFN",2)
	1560	D HMPKILL^ HMPDJFS(.D A,.X)
	1561	"IX",80000 0,800000," ADFN",2.4)
	1562	S X=0 I X( 1)'="" S X =1
	1563	"IX",80000 0,800000," ADFN",2.5)
	1564	K ^HMP(800 000,"AITEM ")
	1565	"IX",80000 0,800000," ADFN",11.1 ,0)
	1566	^.114IA^2^ 2
	1567	"IX",80000 0,800000," ADFN",11.1 ,1,0)
	1568	1^F^800000 .01^.01^^1 ^F
	1569	"IX",80000 0,800000," ADFN",11.1 ,2,0)
	1570	2^F^800000 .01^2^^^F
	1571	"IX",80000 0,800000," AITEM",0)
	1572	800000^AIT EM^Index o f operatio nal data b y server^M U^^F^IR^I^ 800000^^^^ ^A
	1573	"IX",80000 0,800000," AITEM",.1, 0)
	1574	^^2^2^3151 204^
	1575	"IX",80000 0,800000," AITEM",.1, 1,0)
	1576	This cross -reference provides the index that is us ed to find operation al
	1577	"IX",80000 0,800000," AITEM",.1, 2,0)
	1578	data for e ach HMP se rver.
	1579	"IX",80000 0,800000," AITEM",1)
	1580	D HMPOSET^ HMPDJFS(DA ,X)
	1581	"IX",80000 0,800000," AITEM",1.4 )
	1582	I X(1)'=""
	1583	"IX",80000 0,800000," AITEM",2)
	1584	D HMPOKILL ^HMPDJFS(D A)
	1585	"IX",80000 0,800000," AITEM",2.4 )
	1586	I X(1)'=""
	1587	"IX",80000 0,800000," AITEM",2.5 )
	1588	K ^HMP(800 000,"AITEM ")
	1589	"IX",80000 0,800000," AITEM",11. 1,0)
	1590	^.114IA^1^ 1
	1591	"IX",80000 0,800000," AITEM",11. 1,1,0)
	1592	1^F^800000 ^.03^^^F
	1593	"IX",80000 0,800000," AROS",0)
	1594	800000^ARO S^Rosters to track i n the Data Monitor^M U^^R^IR^W^ 800000.02^ ^^^^S
	1595	"IX",80000 0,800000," AROS",.1,0 )
	1596	^^1^1^3150 922^
	1597	"IX",80000 0,800000," AROS",.1,1 ,0)
	1598	Cross-refe rence of r osters for groups of patients on wards.
	1599	"IX",80000 0,800000," AROS",1)
	1600	S:X2(2) ^H MP(800000, "AROS",X,D A(1))=""
	1601	"IX",80000 0,800000," AROS",2)
	1602	K:X1(2) ^H MP(800000, "AROS",X,D A(1))
	1603	"IX",80000 0,800000," AROS",2.5)
	1604	K ^HMP(800 000,"AROS" )
	1605	"IX",80000 0,800000," AROS",11.1 ,0)
	1606	^.114IA^2^ 2
	1607	"IX",80000 0,800000," AROS",11.1 ,1,0)
	1608	1^F^800000 .02^.01^^1 ^F
	1609	"IX",80000 0,800000," AROS",11.1 ,2,0)
	1610	2^F^800000 .02^2^^2^
	1611	"IX",80000 0,800000.0 1,"AP",0)
	1612	800000.01^ AP^Subscri bed patien ts by serv er not yet initializ ed.^R^^R^I R^I^800000 .01^^^^^S
	1613	"IX",80000 0,800000.0 1,"AP",.1, 0)
	1614	^^6^6^3140 521^
	1615	"IX",80000 0,800000.0 1,"AP",.1, 1,0)
	1616	This index lists the patients who are no t yet init ialized:
	1617	"IX",80000 0,800000.0 1,"AP",.1, 2,0)
	1618
	1619	"IX",80000 0,800000.0 1,"AP",.1, 3,0)
	1620	SERVER_I EN, "AP", STATUS, ST ATUS TIME, DFN
	1621	"IX",80000 0,800000.0 1,"AP",.1, 4,0)
	1622
	1623	"IX",80000 0,800000.0 1,"AP",.1, 5,0)
	1624	Patients w ith an ini tialized s tatus (STA TUS = 2) d o not appe ar in this
	1625	"IX",80000 0,800000.0 1,"AP",.1, 6,0)
	1626	index.
	1627	"IX",80000 0,800000.0 1,"AP",1)
	1628	S ^HMP(800 000,DA(1), 1,"AP",X(1 ),X(2),DA) =""
	1629	"IX",80000 0,800000.0 1,"AP",1.4 )
	1630	S X=(+X2(1 )<2)
	1631	"IX",80000 0,800000.0 1,"AP",2)
	1632	K ^HMP(800 000,DA(1), 1,"AP",X(1 ),X(2),DA)
	1633	"IX",80000 0,800000.0 1,"AP",2.5 )
	1634	K ^HMP(800 000,DA(1), 1,"AP")
	1635	"IX",80000 0,800000.0 1,"AP",11. 1,0)
	1636	^.114IA^2^ 2
	1637	"IX",80000 0,800000.0 1,"AP",11. 1,1,0)
	1638	1^F^800000 .01^2^^1^F
	1639	"IX",80000 0,800000.0 1,"AP",11. 1,2,0)
	1640	2^F^800000 .01^3^^2^F
	1641	"IX",80000 0.1,800000 .1,"C",0)
	1642	800000.1^C ^Index by patient, c ollection^ R^^R^IR^I^ 800000.1^^ ^^^LS
	1643	"IX",80000 0.1,800000 .1,"C",.1, 0)
	1644	^^1^1^3150 923^
	1645	"IX",80000 0.1,800000 .1,"C",.1, 1,0)
	1646	Index by p atient, co llection.
	1647	"IX",80000 0.1,800000 .1,"C",1)
	1648	S ^HMP(800 000.1,"C", X(1),X(2), DA)=""
	1649	"IX",80000 0.1,800000 .1,"C",2)
	1650	K ^HMP(800 000.1,"C", X(1),X(2), DA)
	1651	"IX",80000 0.1,800000 .1,"C",2.5 )
	1652	K ^HMP(800 000.1,"C")
	1653	"IX",80000 0.1,800000 .1,"C",11. 1,0)
	1654	^.114IA^2^ 2
	1655	"IX",80000 0.1,800000 .1,"C",11. 1,1,0)
	1656	1^F^800000 .1^.02^^1^ F
	1657	"IX",80000 0.1,800000 .1,"C",11. 1,2,0)
	1658	2^F^800000 .1^.03^^2^ F
	1659	"IX",80000 1.2,800001 .21,"AC",0 )
	1660	800001.21^ AC^SORT BY SEQUENCE^ R^^F^IR^I^ 800001.21^ ^^^^S
	1661	"IX",80000 1.2,800001 .21,"AC",1 )
	1662	Q
	1663	"IX",80000 1.2,800001 .21,"AC",2 )
	1664	Q
	1665	"KRN",3.8, 418,-1)
	1666	0^1
	1667	"KRN",3.8, 418,0)
	1668	HMP IRM GR OUP^PU^y^^ ^^
	1669	"KRN",3.8, 418,2,0)
	1670	^3.801^5^5 ^3150624^^ ^
	1671	"KRN",3.8, 418,2,1,0)
	1672	This is th e mail gro up that wi ll receive alerts fr om the eHM P subscrip tion
	1673	"KRN",3.8, 418,2,2,0)
	1674	process if the usage of global ^XTMP rea ches the l imit allow ed and beg ins
	1675	"KRN",3.8, 418,2,3,0)
	1676	to pause s ubscriptio ns until d isk space is availab le. The ma il group a lso
	1677	"KRN",3.8, 418,2,4,0)
	1678	also recei ves notifi cations wh en disk sp ace is ava ilable and subscript ions
	1679	"KRN",3.8, 418,2,5,0)
	1680	are procee ding norma lly again.
	1681	"KRN",3.8, 418,3)
	1682
	1683	"KRN",19,1 4321,-1)
	1684	0^6
	1685	"KRN",19,1 4321,0)
	1686	HMP UI CON TEXT^HMP U I Context Version 0. 7-S62^^B^^ ^^^^^^
	1687	"KRN",19,1 4321,1,0)
	1688	^19.06^1^1 ^3140618^^
	1689	"KRN",19,1 4321,1,1,0 )
	1690	This optio n allows t he HMP UI access to the VistA system.
	1691	"KRN",19,1 4321,99.1)
	1692	62990,2964 7
	1693	"KRN",19,1 4321,"RPC" ,0)
	1694	^19.05P^55 ^55
	1695	"KRN",19,1 4321,"RPC" ,1,0)
	1696	HMPCORD RP C
	1697	"KRN",19,1 4321,"RPC" ,2,0)
	1698	HMPCPAT RP C
	1699	"KRN",19,1 4321,"RPC" ,3,0)
	1700	HMPFPTC CH KS
	1701	"KRN",19,1 4321,"RPC" ,4,0)
	1702	HMPFPTC LO G
	1703	"KRN",19,1 4321,"RPC" ,5,0)
	1704	HMP APPOIN TMENTS
	1705	"KRN",19,1 4321,"RPC" ,6,0)
	1706	HMP DATA V ERSION
	1707	"KRN",19,1 4321,"RPC" ,7,0)
	1708	HMP DELETE ROSTER
	1709	"KRN",19,1 4321,"RPC" ,8,0)
	1710	HMP GET PA TIENT DATA
	1711	"KRN",19,1 4321,"RPC" ,9,0)
	1712	HMP GET SO URCE
	1713	"KRN",19,1 4321,"RPC" ,10,0)
	1714	HMP INPATI ENTS
	1715	"KRN",19,1 4321,"RPC" ,11,0)
	1716	HMP PREVIE W ROSTER
	1717	"KRN",19,1 4321,"RPC" ,12,0)
	1718	HMP ROSTER PATIENTS
	1719	"KRN",19,1 4321,"RPC" ,13,0)
	1720	HMP ROSTER S
	1721	"KRN",19,1 4321,"RPC" ,14,0)
	1722	HMP SUBSCR IBE
	1723	"KRN",19,1 4321,"RPC" ,15,0)
	1724	HMP UPDATE ROSTER
	1725	"KRN",19,1 4321,"RPC" ,16,0)
	1726	HMPCRPC RP C
	1727	"KRN",19,1 4321,"RPC" ,19,0)
	1728	XHD GET PA RAMETER DE F LIST
	1729	"KRN",19,1 4321,"RPC" ,20,0)
	1730	HMP PUT PA TIENT DATA
	1731	"KRN",19,1 4321,"RPC" ,21,0)
	1732	HMP PUT OB JECT
	1733	"KRN",19,1 4321,"RPC" ,22,0)
	1734	HMP DELETE OBJECT
	1735	"KRN",19,1 4321,"RPC" ,23,0)
	1736	HMP GET OB JECT
	1737	"KRN",19,1 4321,"RPC" ,24,0)
	1738	HMP GET RO STER LIST
	1739	"KRN",19,1 4321,"RPC" ,25,0)
	1740	HMPCPRS RP C
	1741	"KRN",19,1 4321,"RPC" ,26,0)
	1742	ORQPT WARD S
	1743	"KRN",19,1 4321,"RPC" ,27,0)
	1744	ORQPT WARD PATIENTS
	1745	"KRN",19,1 4321,"RPC" ,28,0)
	1746	ORQPT SPEC IALTIES
	1747	"KRN",19,1 4321,"RPC" ,29,0)
	1748	ORQPT SPEC IALTY PATI ENTS
	1749	"KRN",19,1 4321,"RPC" ,30,0)
	1750	ORWU CLINL OC
	1751	"KRN",19,1 4321,"RPC" ,31,0)
	1752	ORQPT CLIN IC PATIENT S
	1753	"KRN",19,1 4321,"RPC" ,32,0)
	1754	ORWU NEWPE RS
	1755	"KRN",19,1 4321,"RPC" ,33,0)
	1756	ORQPT PROV IDER PATIE NTS
	1757	"KRN",19,1 4321,"RPC" ,34,0)
	1758	ORWRP COLU MN HEADERS
	1759	"KRN",19,1 4321,"RPC" ,35,0)
	1760	ORWLR CUMU LATIVE REP ORT
	1761	"KRN",19,1 4321,"RPC" ,36,0)
	1762	ORWLRR INT ERIM
	1763	"KRN",19,1 4321,"RPC" ,37,0)
	1764	ORWRP REPO RT TEXT
	1765	"KRN",19,1 4321,"RPC" ,38,0)
	1766	ORWRP3 EXP AND COLUMN S
	1767	"KRN",19,1 4321,"RPC" ,39,0)
	1768	HMP PUT DE MOGRAPHICS
	1769	"KRN",19,1 4321,"RPC" ,40,0)
	1770	HMPCRPC RP CCHAIN
	1771	"KRN",19,1 4321,"RPC" ,41,0)
	1772	ORQPT DEFA ULT PATIEN T LIST
	1773	"KRN",19,1 4321,"RPC" ,42,0)
	1774	ORWU USERI NFO
	1775	"KRN",19,1 4321,"RPC" ,43,0)
	1776	YTQ ALLKEY S
	1777	"KRN",19,1 4321,"RPC" ,44,0)
	1778	ORWPT BYWA RD
	1779	"KRN",19,1 4321,"RPC" ,45,0)
	1780	ORQQPX REM INDERS LIS T
	1781	"KRN",19,1 4321,"RPC" ,46,0)
	1782	ORQQPX REM INDER DETA IL
	1783	"KRN",19,1 4321,"RPC" ,47,0)
	1784	ORQQPL4 LE X
	1785	"KRN",19,1 4321,"RPC" ,48,0)
	1786	ORWRP REPO RT LISTS
	1787	"KRN",19,1 4321,"RPC" ,49,0)
	1788	HMP PATIEN T ADMIT SY NC
	1789	"KRN",19,1 4321,"RPC" ,50,0)
	1790	HMP PATIEN T SCHED SY NC
	1791	"KRN",19,1 4321,"RPC" ,51,0)
	1792	ORWPT LIST ALL
	1793	"KRN",19,1 4321,"RPC" ,52,0)
	1794	ORWPT APPT LST
	1795	"KRN",19,1 4321,"RPC" ,53,0)
	1796	HMP CHKXTM P
	1797	"KRN",19,1 4321,"RPC" ,54,0)
	1798	HMP GLOBAL SIZE
	1799	"KRN",19,1 4321,"RPC" ,55,0)
	1800	HMP DEFAUL T PATIENT LIST
	1801	"KRN",19,1 4321,"U")
	1802	HMP UI CON TEXT VERSI ON 0.7-S62
	1803	"KRN",19,1 4322,-1)
	1804	0^5
	1805	"KRN",19,1 4322,0)
	1806	HMP SYNCHR ONIZATION CONTEXT^Sy nchronize the HMP^^B ^^^^^^^^
	1807	"KRN",19,1 4322,1,0)
	1808	^^2^2^3150 923^
	1809	"KRN",19,1 4322,1,1,0 )
	1810	This optio n manages access to RPCs respo nsible for synchroni zation of eHMP
	1811	"KRN",19,1 4322,1,2,0 )
	1812	data with VistA.
	1813	"KRN",19,1 4322,99.1)
	1814	63904,4085 3
	1815	"KRN",19,1 4322,"RPC" ,0)
	1816	^19.05P^25 ^25
	1817	"KRN",19,1 4322,"RPC" ,2,0)
	1818	HMP DATA V ERSION
	1819	"KRN",19,1 4322,"RPC" ,4,0)
	1820	HMP SUBSCR IBE
	1821	"KRN",19,1 4322,"RPC" ,5,0)
	1822	HMP GET PA TIENT DATA JSON
	1823	"KRN",19,1 4322,"RPC" ,7,0)
	1824	HMP GET OB JECT
	1825	"KRN",19,1 4322,"RPC" ,8,0)
	1826	HMP GET OP ERATIONAL DATA
	1827	"KRN",19,1 4322,"RPC" ,10,0)
	1828	HMP PUT OB JECT
	1829	"KRN",19,1 4322,"RPC" ,19,0)
	1830	HMPDJFS AP I
	1831	"KRN",19,1 4322,"RPC" ,20,0)
	1832	HMPDJFS DE LSUB
	1833	"KRN",19,1 4322,"RPC" ,21,0)
	1834	HMP GET CH ECKSUM
	1835	"KRN",19,1 4322,"RPC" ,22,0)
	1836	HMP PATIEN T ACTIVITY
	1837	"KRN",19,1 4322,"RPC" ,23,0)
	1838	HMP LOCAL GETCORRESP ONDINGIDS
	1839	"KRN",19,1 4322,"RPC" ,24,0)
	1840	ORWU USERI NFO
	1841	"KRN",19,1 4322,"RPC" ,25,0)
	1842	VAFC LOCAL GETCORRES PONDINGIDS
	1843	"KRN",19,1 4322,"U")
	1844	SYNCHRONIZ E THE HMP
	1845	"KRN",19,1 4323,-1)
	1846	0^3
	1847	"KRN",19,1 4323,0)
	1848	HMP PATIEN T ACTIVITY ^Patient A ppointment s^^B^^^^^^ ^^
	1849	"KRN",19,1 4323,1,0)
	1850	^^1^1^3150 923^
	1851	"KRN",19,1 4323,1,1,0 )
	1852	Return app ointments for a subs cribed pat ient.
	1853	"KRN",19,1 4323,25)
	1854	ACT^HMPACT
	1855	"KRN",19,1 4323,"RPC" ,0)
	1856	^19.05P^1^ 1
	1857	"KRN",19,1 4323,"RPC" ,1,0)
	1858	HMP PATIEN T ACTIVITY
	1859	"KRN",19,1 4323,"U")
	1860	PATIENT AP POINTMENTS
	1861	"KRN",19,1 4324,-1)
	1862	0^1
	1863	"KRN",19,1 4324,0)
	1864	HMP APPLIC ATION PROX Y^HMP Appl ication Pr oxy^^B^^^^ ^^^^
	1865	"KRN",19,1 4324,1,0)
	1866	^19.06^1^1 ^3110602^^ ^^
	1867	"KRN",19,1 4324,1,1,0 )
	1868	This optio n allows t he HMP con nector pro xy access to the Vis tA system.
	1869	"KRN",19,1 4324,99.1)
	1870	62971,3386 5
	1871	"KRN",19,1 4324,"RPC" ,0)
	1872	^19.05P^4^ 4
	1873	"KRN",19,1 4324,"RPC" ,2,0)
	1874	HMP GET PA TIENT DATA
	1875	"KRN",19,1 4324,"RPC" ,3,0)
	1876	HMP DATA V ERSION
	1877	"KRN",19,1 4324,"RPC" ,4,0)
	1878	HMP SUBSCR IBE
	1879	"KRN",19,1 4324,"U")
	1880	HMP APPLIC ATION PROX Y
	1881	"KRN",19,1 4325,-1)
	1882	0^2
	1883	"KRN",19,1 4325,0)
	1884	HMP APPOIN TMENTS^Ret urn List o f Tomorrow 's Patient s^^A^^^^^^ ^^^^1
	1885	"KRN",19,1 4325,1,0)
	1886	^19.06^3^3 ^3151124^^
	1887	"KRN",19,1 4325,1,1,0 )
	1888	This optio n is inten ded to be scheduled to run nig htly, to n otify the
	1889	"KRN",19,1 4325,1,2,0 )
	1890	Enterprise Health Ma nagement P latform (H MP) of pat ients that are
	1891	"KRN",19,1 4325,1,3,0 )
	1892	expected t o be seen tomorrow.
	1893	"KRN",19,1 4325,20)
	1894	D APPT^HMP PATS
	1895	"KRN",19,1 4325,200.9 )
	1896	y
	1897	"KRN",19,1 4325,"U")
	1898	RETURN LIS T OF TOMOR ROW'S PATI
	1899	"KRN",19,1 4326,-1)
	1900	0^4
	1901	"KRN",19,1 4326,0)
	1902	HMP PATIEN T DATA MON ITOR^HMP P atient Dat a Monitor^ ^A^^^^^^^^ ^^1
	1903	"KRN",19,1 4326,1,0)
	1904	^^4^4^3151 204^
	1905	"KRN",19,1 4326,1,1,0 )
	1906	This optio n manages the HMP Pa tient Data Monitor b ackground job. It f irst
	1907	"KRN",19,1 4326,1,2,0 )
	1908	checks to see if the job is ru nning, and will prom pt the use r to start it
	1909	"KRN",19,1 4326,1,3,0 )
	1910	if it's st opped. It may also b e used to stop the j ob, but th e eHMP cli ent
	1911	"KRN",19,1 4326,1,4,0 )
	1912	may not di splay up-t o-date dat a until it is starte d again.
	1913	"KRN",19,1 4326,20)
	1914	D EN^HMPHT TP
	1915	"KRN",19,1 4326,"U")
	1916	HMP PATIEN T DATA MON ITOR
	1917	"KRN",19,1 4327,-1)
	1918	0^8
	1919	"KRN",19,1 4327,0)
	1920	HMP XU EVE NTS^New Pe rson Event s for HMP^ ^A^^^^^^^^ ^^1
	1921	"KRN",19,1 4327,1,0)
	1922	^^1^1^3130 116^
	1923	"KRN",19,1 4327,1,1,0 )
	1924	This proto col will t rack New P erson upda tes for HM P.
	1925	"KRN",19,1 4327,20)
	1926	D XU^HMPEV NT(XUIEN," ")
	1927	"KRN",19,1 4327,"U")
	1928	NEW PERSON EVENTS FO R HMP
	1929	"KRN",19,1 4328,-1)
	1930	0^10
	1931	"KRN",19,1 4328,0)
	1932	HMPM ADD H MP USER^Ad d Health M anagement Platform U ser^^A^^^^ ^^^^^^1
	1933	"KRN",19,1 4328,1,0)
	1934	^^4^4^3140 326^
	1935	"KRN",19,1 4328,1,1,0 )
	1936	This optio n allows a user to b e given ac cess to us e the Heal th Managem ent
	1937	"KRN",19,1 4328,1,2,0 )
	1938	Platform. The selec ted user w ill be giv en the HMP UI CONTEX T option.
	1939	"KRN",19,1 4328,1,3,0 )
	1940	Additional ly, their default pa tient list my be set up for au tomatic
	1941	"KRN",19,1 4328,1,4,0 )
	1942	synchroniz ation with the Healt h Manageme nt Platfor m (HMP).
	1943	"KRN",19,1 4328,20)
	1944	D OPTASGN^ HMPCAC
	1945	"KRN",19,1 4328,"U")
	1946	ADD HEALTH MANAGEMEN T PLATFORM
	1947	"KRN",19,1 4329,-1)
	1948	0^12
	1949	"KRN",19,1 4329,0)
	1950	HMPM EXTRA CT MONITOR ^Monitor H MP Server Synchroniz ation^^A^^ ^^^^^^^^1
	1951	"KRN",19,1 4329,1,0)
	1952	^^2^2^3140 402^
	1953	"KRN",19,1 4329,1,1,0 )
	1954	This optio n allow on e to monit or the pol ls from an HMP serve r and any
	1955	"KRN",19,1 4329,1,2,0 )
	1956	currently executing HMP extrac ts.
	1957	"KRN",19,1 4329,20)
	1958	D EN^HMPDJ FSM
	1959	"KRN",19,1 4329,"U")
	1960	MONITOR HM P SERVER S YNCHRONIZA
	1961	"KRN",19,1 4330,-1)
	1962	0^11
	1963	"KRN",19,1 4330,0)
	1964	HMPM EMERG ENCY STOP^ Emergency Stop HMP F reshness U pdates^^A^ ^^^^^^^^^1
	1965	"KRN",19,1 4330,1,0)
	1966	^^5^5^3140 403^
	1967	"KRN",19,1 4330,1,1,0 )
	1968	This optio n should b e used wit h caution. It will stop the f reshness
	1969	"KRN",19,1 4330,1,2,0 )
	1970	events for the ENTER PRISE HEAL TH MANAGEM ENT PLATFO RM (HMP) f rom being called. O nce the
	1971	"KRN",19,1 4330,1,3,0 )
	1972	freshness events are stopped, patient da ta must be re-synchr onized wit h
	1973	"KRN",19,1 4330,1,4,0 )
	1974	the HMP to ensure co mpleteness . Only st op freshne ss updates if there is a
	1975	"KRN",19,1 4330,1,5,0 )
	1976	problem wi th system operation.
	1977	"KRN",19,1 4330,20)
	1978	D EMERSTOP ^HMPDJFSM
	1979	"KRN",19,1 4330,"U")
	1980	EMERGENCY STOP HMP F RESHNESS U
	1981	"KRN",19,1 4331,-1)
	1982	0^9
	1983	"KRN",19,1 4331,0)
	1984	HMPM ADD H MP PATIENT ^Manually Add Patien t to HMP^^ A^^^^^^^^^ ^1
	1985	"KRN",19,1 4331,1,0)
	1986	^^2^2^3151 204^
	1987	"KRN",19,1 4331,1,1,0 )
	1988	Use this o ption to m anually ad d a patien t for sync hronizatio n with the
	1989	"KRN",19,1 4331,1,2,0 )
	1990	Enterprise Health Ma nagement P latform (e HMP).
	1991	"KRN",19,1 4331,20)
	1992	D ADDPT^HM PDJFSM
	1993	"KRN",19,1 4331,"U")
	1994	MANUALLY A DD PATIENT TO HMP
	1995	"KRN",19,1 4332,-1)
	1996	0^14
	1997	"KRN",19,1 4332,0)
	1998	HMPMGR^HMP Technical Managemen t^^M^^^^^^ ^^
	1999	"KRN",19,1 4332,1,0)
	2000	^19.06^1^1 ^3150923^^ ^
	2001	"KRN",19,1 4332,1,1,0 )
	2002	This menu contains v arious opt ions to he lp with th e manageme nt of HMP.
	2003	"KRN",19,1 4332,10,0)
	2004	^19.01IP^1 2^12
	2005	"KRN",19,1 4332,10,1, 0)
	2006	14328
	2007	"KRN",19,1 4332,10,1, "^")
	2008	HMPM ADD H MP USER
	2009	"KRN",19,1 4332,10,2, 0)
	2010	14331
	2011	"KRN",19,1 4332,10,2, "^")
	2012	HMPM ADD H MP PATIENT
	2013	"KRN",19,1 4332,10,3, 0)
	2014	14329
	2015	"KRN",19,1 4332,10,3, "^")
	2016	HMPM EXTRA CT MONITOR
	2017	"KRN",19,1 4332,10,4, 0)
	2018	14336
	2019	"KRN",19,1 4332,10,4, "^")
	2020	HMP MONITO R FOR XTMP GLOBAL
	2021	"KRN",19,1 4332,10,5, 0)
	2022	14325
	2023	"KRN",19,1 4332,10,5, "^")
	2024	HMP APPOIN TMENTS
	2025	"KRN",19,1 4332,10,6, 0)
	2026	14323
	2027	"KRN",19,1 4332,10,6, "^")
	2028	HMP PATIEN T ACTIVITY
	2029	"KRN",19,1 4332,10,7, 0)
	2030	14326
	2031	"KRN",19,1 4332,10,7, "^")
	2032	HMP PATIEN T DATA MON ITOR
	2033	"KRN",19,1 4332,10,8, 0)
	2034	14335
	2035	"KRN",19,1 4332,10,8, "^")
	2036	HMP WB DOM AINS
	2037	"KRN",19,1 4332,10,9, 0)
	2038	14334
	2039	"KRN",19,1 4332,10,9, "^")
	2040	HMP WB PTD EM
	2041	"KRN",19,1 4332,10,10 ,0)
	2042	14327
	2043	"KRN",19,1 4332,10,10 ,"^")
	2044	HMP XU EVE NTS
	2045	"KRN",19,1 4332,10,11 ,0)
	2046	14330
	2047	"KRN",19,1 4332,10,11 ,"^")
	2048	HMPM EMERG ENCY STOP
	2049	"KRN",19,1 4332,10,12 ,0)
	2050	14333
	2051	"KRN",19,1 4332,10,12 ,"^")
	2052	HMPM RESTA RT FRESHNE SS
	2053	"KRN",19,1 4332,99)
	2054	63971,3935 6
	2055	"KRN",19,1 4332,"U")
	2056	HMP TECHNI CAL MANAGE MENT
	2057	"KRN",19,1 4333,-1)
	2058	0^13
	2059	"KRN",19,1 4333,0)
	2060	HMPM RESTA RT FRESHNE SS^Resume Freshness Updates Th at Have Be en Stopped ^^A^^^^^^^ ^^^1
	2061	"KRN",19,1 4333,1,0)
	2062	^19.06^4^4 ^3151208^^ ^
	2063	"KRN",19,1 4333,1,1,0 )
	2064	This optio n will rem ove the fl ags that c ause fresh ness updat es to be
	2065	"KRN",19,1 4333,1,2,0 )
	2066	stopped. It will li kely be ne cessary to re-synchr onized pat ients afte r
	2067	"KRN",19,1 4333,1,3,0 )
	2068	freshness has been s topped, si nce update s will be missing fr om the tim e
	2069	"KRN",19,1 4333,1,4,0 )
	2070	that fresh ness updat es were no t being re ceived.
	2071	"KRN",19,1 4333,20)
	2072	D RSTRTFR^ HMPDJFSM
	2073	"KRN",19,1 4333,"U")
	2074	RESUME FRE SHNESS UPD ATES THAT
	2075	"KRN",19,1 4334,-1)
	2076	0^7
	2077	"KRN",19,1 4334,0)
	2078	HMP WB PTD EM^HMP Wri teback Pat ient Demog rahpics^^B ^^^^^^^^
	2079	"KRN",19,1 4334,1,0)
	2080	1^19.06^1^ 1^3150923^
	2081	"KRN",19,1 4334,1,1,0 )
	2082	This optio n allows e HMP to cha nge patien t phone nu mbers in V istA.
	2083	"KRN",19,1 4334,25)
	2084	FILE^HMPPT DEM
	2085	"KRN",19,1 4334,"RPC" ,0)
	2086	^19.05P^1^ 1
	2087	"KRN",19,1 4334,"RPC" ,1,0)
	2088	HMP WRITEB ACK PT DEM
	2089	"KRN",19,1 4334,"U")
	2090	HMP WRITEB ACK PATIEN T DEMOGRAH
	2091	"KRN",19,1 4335,-1)
	2092	0^16
	2093	"KRN",19,1 4335,0)
	2094	HMP WB DOM AINS^Write back of Do main Data to Vista^^ B^^^^^^^^
	2095	"KRN",19,1 4335,1,0)
	2096	^^1^1^3150 923^
	2097	"KRN",19,1 4335,1,1,0 )
	2098	Writes dom ain data t o VistA.
	2099	"KRN",19,1 4335,25)
	2100	HMPWB
	2101	"KRN",19,1 4335,"RPC" ,0)
	2102	^19.05P^1^ 1
	2103	"KRN",19,1 4335,"RPC" ,1,0)
	2104	HMP PUT OP ERATIONAL DATA
	2105	"KRN",19,1 4335,"U")
	2106	WRITEBACK OF DOMAIN DATA TO VI
	2107	"KRN",19,1 4336,-1)
	2108	0^17
	2109	"KRN",19,1 4336,0)
	2110	HMP MONITO R FOR XTMP GLOBAL^XT MP Global Monitor^^A ^^^^^^^^^^ 1
	2111	"KRN",19,1 4336,1,0)
	2112	^^2^2^3151 204^
	2113	"KRN",19,1 4336,1,1,0 )
	2114	This optio n will mon itor the a mount of s pace in th e ^XTMP gl obal used by
	2115	"KRN",19,1 4336,1,2,0 )
	2116	the eHMP. The amoun t used is very dynam ic.
	2117	"KRN",19,1 4336,20)
	2118	D MON^HMPT OOLS
	2119	"KRN",19,1 4336,"U")
	2120	XTMP GLOBA L MONITOR
	2121	"KRN",19.1 ,693,-1)
	2122	0^2
	2123	"KRN",19.1 ,693,0)
	2124	HMP EXPERI MENTAL^For testing n ew feature s
	2125	"KRN",19.1 ,693,1,0)
	2126	^^1^1^3150 923^
	2127	"KRN",19.1 ,693,1,1,0 )
	2128	This key i s used to isolate ne w features for site testing.
	2129	"KRN",19.1 ,694,-1)
	2130	0^1
	2131	"KRN",19.1 ,694,0)
	2132	HMP ADMIN^ Can manage HMP subsc riptions
	2133	"KRN",19.1 ,694,1,0)
	2134	^^2^2^3150 923^
	2135	"KRN",19.1 ,694,1,1,0 )
	2136	This key i s used to determine which HMP users shou ld be allo wed to
	2137	"KRN",19.1 ,694,1,2,0 )
	2138	manage sub scriptions and the s ubscriptio n queue.
	2139	"KRN",101, 1240,-1)
	2140	2^33
	2141	"KRN",101, 1240,0)
	2142	DGPM MOVEM ENT EVENTS ^MOVEMENT EVENTS v 5 .0^^X^1^^^ ^^^^114
	2143	"KRN",101, 1240,10,0)
	2144	^101.01PA^ 38^38
	2145	"KRN",101, 1240,10,38 ,0)
	2146	6096^^^
	2147	"KRN",101, 1240,10,38 ,"^")
	2148	HMP INPT E VENTS
	2149	"KRN",101, 1302,-1)
	2150	2^34
	2151	"KRN",101, 1302,0)
	2152	SDAM APPOI NTMENT EVE NTS^Appoin tment Even t Driver^^ X^1^^^^^^^ 16
	2153	"KRN",101, 1302,10,0)
	2154	^101.01PA^ 20^20
	2155	"KRN",101, 1302,10,20 ,0)
	2156	6093^^^
	2157	"KRN",101, 1302,10,20 ,"^")
	2158	HMP APPT E VENTS
	2159	"KRN",101, 2690,-1)
	2160	2^35
	2161	"KRN",101, 2690,0)
	2162	RA EVSEND OR^Radiolo gy event s ent to OE/ RR^^X^1^^^ ^^^^31
	2163	"KRN",101, 2690,10,0)
	2164	^101.01PA^ 4^4
	2165	"KRN",101, 2690,10,4, 0)
	2166	6098^^^
	2167	"KRN",101, 2690,10,4, "^")
	2168	HMP XQOR E VENTS
	2169	"KRN",101, 2700,-1)
	2170	2^36
	2171	"KRN",101, 2700,0)
	2172	PXK VISIT DATA EVENT ^VISIT REL ATED DATA^ ^X^1^^^^^^ ^
	2173	"KRN",101, 2700,10,0)
	2174	^101.01PA^ 6^6
	2175	"KRN",101, 2700,10,6, 0)
	2176	6097^^^
	2177	"KRN",101, 2700,10,6, "^")
	2178	HMP PCE EV ENTS
	2179	"KRN",101, 2894,-1)
	2180	2^37
	2181	"KRN",101, 2894,0)
	2182	GMRA SIGN- OFF ON DAT A^Sign-off on Reacti on Data^^X ^1^^^^^^^2 47
	2183	"KRN",101, 2894,10,0)
	2184	^101.01PA^ 2^2
	2185	"KRN",101, 2894,10,2, 0)
	2186	6099^^^
	2187	"KRN",101, 2894,10,2, "^")
	2188	HMP GMRA E VENTS
	2189	"KRN",101, 2896,-1)
	2190	2^38
	2191	"KRN",101, 2896,0)
	2192	GMRA ENTER ED IN ERRO R^Reaction Data Ente red in Err or^^X^1^^^ ^^^^247
	2193	"KRN",101, 2896,10,0)
	2194	^101.01PA^ 2^2
	2195	"KRN",101, 2896,10,2, 0)
	2196	6099^^^
	2197	"KRN",101, 2896,10,2, "^")
	2198	HMP GMRA E VENTS
	2199	"KRN",101, 2905,-1)
	2200	2^39
	2201	"KRN",101, 2905,0)
	2202	SCMC PATIE NT TEAM CH ANGES^PCMM Patient T eam Update Event Dri ver^^X^1^^ ^^^^^16
	2203	"KRN",101, 2905,10,0)
	2204	^101.01PA^ 2^2
	2205	"KRN",101, 2905,10,2, 0)
	2206	6103^^^
	2207	"KRN",101, 2905,10,2, "^")
	2208	HMP PCMM T EAM
	2209	"KRN",101, 2906,-1)
	2210	2^40
	2211	"KRN",101, 2906,0)
	2212	SCMC PATIE NT TEAM PO SITION CHA NGES^PCMM Patient Te am Positio n Update E vent Drive r^^X^1^^^^ ^^^
	2213	"KRN",101, 2906,10,0)
	2214	^101.01PA^ 2^2
	2215	"KRN",101, 2906,10,2, 0)
	2216	6104^^^
	2217	"KRN",101, 2906,10,2, "^")
	2218	HMP PCMM T EAM POSITI ON
	2219	"KRN",101, 3336,-1)
	2220	2^41
	2221	"KRN",101, 3336,0)
	2222	LR7O CH EV SEND OR^LA B => OE/RR ORDER MES SAGE EVENT ^^X^1^^^^^ ^^
	2223	"KRN",101, 3336,10,0)
	2224	^101.01PA^ 4^4
	2225	"KRN",101, 3336,10,4, 0)
	2226	6098^^^
	2227	"KRN",101, 3336,10,4, "^")
	2228	HMP XQOR E VENTS
	2229	"KRN",101, 3373,-1)
	2230	2^42
	2231	"KRN",101, 3373,0)
	2232	PS EVSEND OR^Send Ph armacy ord ers to CPR S.^^X^1^^^ ^^^^18
	2233	"KRN",101, 3373,10,0)
	2234	^101.01PA^ 6^6
	2235	"KRN",101, 3373,10,6, 0)
	2236	6098^^^
	2237	"KRN",101, 3373,10,6, "^")
	2238	HMP XQOR E VENTS
	2239	"KRN",101, 3392,-1)
	2240	2^31
	2241	"KRN",101, 3392,0)
	2242	GMRC EVSEN D OR^Consu lts event sent to OE /RR^^X^1^^ ^^^^^294
	2243	"KRN",101, 3392,10,0)
	2244	^101.01PA^ 6^6
	2245	"KRN",101, 3392,10,6, 0)
	2246	6098^^^
	2247	"KRN",101, 3392,10,6, "^")
	2248	HMP XQOR E VENTS
	2249	"KRN",101, 3411,-1)
	2250	2^43
	2251	"KRN",101, 3411,0)
	2252	FH EVSEND OR^FH --> OR event m essages^^X ^1^^^^^^^
	2253	"KRN",101, 3411,10,0)
	2254	^101.01PA^ 4^4
	2255	"KRN",101, 3411,10,4, 0)
	2256	6098^^^
	2257	"KRN",101, 3411,10,4, "^")
	2258	HMP XQOR E VENTS
	2259	"KRN",101, 3529,-1)
	2260	2^44
	2261	"KRN",101, 3529,0)
	2262	OR EVSEND RA^OE/RR = > RAD/NM M ESSAGE EVE NT^^X^1^^^ ^^^^
	2263	"KRN",101, 3529,10,0)
	2264	^101.01PA^ 4^4
	2265	"KRN",101, 3529,10,4, 0)
	2266	6100^^^
	2267	"KRN",101, 3529,10,4, "^")
	2268	HMP NA EVE NTS
	2269	"KRN",101, 3530,-1)
	2270	2^32
	2271	"KRN",101, 3530,0)
	2272	OR EVSEND LRCH^OE/RR => LAB ME SSAGE EVEN T^^X^1^^^^ ^^^
	2273	"KRN",101, 3530,10,0)
	2274	^101.01PA^ 4^4
	2275	"KRN",101, 3530,10,4, 0)
	2276	6100^^^
	2277	"KRN",101, 3530,10,4, "^")
	2278	HMP NA EVE NTS
	2279	"KRN",101, 3535,-1)
	2280	2^45
	2281	"KRN",101, 3535,0)
	2282	OR EVSEND FH^OE/RR = > DIET MES SAGE EVENT ^^X^1^^^^^ ^^
	2283	"KRN",101, 3535,10,0)
	2284	^101.01PA^ 4^4
	2285	"KRN",101, 3535,10,4, 0)
	2286	6100^^^
	2287	"KRN",101, 3535,10,4, "^")
	2288	HMP NA EVE NTS
	2289	"KRN",101, 3536,-1)
	2290	2^46
	2291	"KRN",101, 3536,0)
	2292	OR EVSEND ORG^OE/RR => GENERIC MESSAGE E VENT^^X^1^ ^^^^^^
	2293	"KRN",101, 3536,10,0)
	2294	^101.01PA^ 4^4
	2295	"KRN",101, 3536,10,4, 0)
	2296	6098^^^
	2297	"KRN",101, 3536,10,4, "^")
	2298	HMP XQOR E VENTS
	2299	"KRN",101, 3537,-1)
	2300	2^47
	2301	"KRN",101, 3537,0)
	2302	OR EVSEND PS^OE/RR = > PHARMACY MESSAGE E VENT^^X^1^ ^^^^^^
	2303	"KRN",101, 3537,10,0)
	2304	^101.01PA^ 4^4
	2305	"KRN",101, 3537,10,4, 0)
	2306	6100^^^
	2307	"KRN",101, 3537,10,4, "^")
	2308	HMP NA EVE NTS
	2309	"KRN",101, 3539,-1)
	2310	2^48
	2311	"KRN",101, 3539,0)
	2312	OR EVSEND GMRC^OE/RR => CONSUL TS MESSAGE EVENT^^X^ 1^^^^^^^
	2313	"KRN",101, 3539,10,0)
	2314	^101.01PA^ 6^6
	2315	"KRN",101, 3539,10,6, 0)
	2316	6100^^^
	2317	"KRN",101, 3539,10,6, "^")
	2318	HMP NA EVE NTS
	2319	"KRN",101, 4717,-1)
	2320	2^49
	2321	"KRN",101, 4717,0)
	2322	DG FIELD M ONITOR^DG Field Moni tor^^X^1^^ ^^^^^114
	2323	"KRN",101, 4717,10,0)
	2324	^101.01PA^ 5^5
	2325	"KRN",101, 4717,10,5, 0)
	2326	6094^^^
	2327	"KRN",101, 4717,10,5, "^")
	2328	HMP DG UPD ATES
	2329	"KRN",101, 6022,-1)
	2330	2^27
	2331	"KRN",101, 6022,0)
	2332	GMPL EVENT ^Problem L ist Update Event^^X^ 1^^^^^^^40 2
	2333	"KRN",101, 6022,10,0)
	2334	^101.01PA^ 1^1
	2335	"KRN",101, 6022,10,1, 0)
	2336	6095^^^
	2337	"KRN",101, 6022,10,1, "^")
	2338	HMP GMPL E VENT
	2339	"KRN",101, 6088,-1)
	2340	2^29
	2341	"KRN",101, 6088,0)
	2342	MDC OBSERV ATION UPDA TE^Observa tion updat e notifica tion^^X^1^ ^^^^^^557
	2343	"KRN",101, 6088,10,0)
	2344	^101.01PA^ 23^1
	2345	"KRN",101, 6088,10,23 ,0)
	2346	6101^^^
	2347	"KRN",101, 6088,10,23 ,"^")
	2348	HMP MDC EV ENT
	2349	"KRN",101, 6088,775,0 )
	2350	^101.0775P A^^
	2351	"KRN",101, 6089,-1)
	2352	2^28
	2353	"KRN",101, 6089,0)
	2354	OR EVSEND VPR^OE/RR => VPR MES SAGE EVENT ^^X^1^^^^^ ^^
	2355	"KRN",101, 6089,10,0)
	2356	^101.01PA^ 20^1
	2357	"KRN",101, 6089,10,20 ,0)
	2358	6098^^^
	2359	"KRN",101, 6089,10,20 ,"^")
	2360	HMP XQOR E VENTS
	2361	"KRN",101, 6090,-1)
	2362	2^30
	2363	"KRN",101, 6090,0)
	2364	PSB EVSEND VPR^MEDIC ATION ADMI NISTRATION EVENTS^^X ^1^^^^^^^
	2365	"KRN",101, 6090,10,0)
	2366	^101.01PA^ 18^1
	2367	"KRN",101, 6090,10,18 ,0)
	2368	6102^^^
	2369	"KRN",101, 6090,10,18 ,"^")
	2370	HMP PSB EV ENTS
	2371	"KRN",101, 6091,-1)
	2372	0^1
	2373	"KRN",101, 6091,0)
	2374	HMP ADT-A0 4 CLIENT^H MP HL7 ADT -A04 Clien t^^S^^^^^^ ^^
	2375	"KRN",101, 6091,1,0)
	2376	^101.06^10 ^10^315111 0^^^^
	2377	"KRN",101, 6091,1,1,0 )
	2378	This clien t protocol is used t o process HL7 ADT/A0 4 messages published by
	2379	"KRN",101, 6091,1,2,0 )
	2380	the VAFC A DT-A04 SER VER protoc ol.
	2381	"KRN",101, 6091,1,3,0 )
	2382
	2383	"KRN",101, 6091,1,4,0 )
	2384	The client causes a HMP 'fresh ness' even t for each new patie nt
	2385	"KRN",101, 6091,1,5,0 )
	2386	registrati on that oc curs. This is especi ally impor tant for n ew patient s,
	2387	"KRN",101, 6091,1,6,0 )
	2388	as it is t he only MA S event me chanism av ailable th at can be used to
	2389	"KRN",101, 6091,1,7,0 )
	2390	discover n ew patient entries.
	2391	"KRN",101, 6091,1,8,0 )
	2392
	2393	"KRN",101, 6091,1,9,0 )
	2394	Note: The ROUTING LO GIC does n ot send an y HL7 mess ages. As m entioned
	2395	"KRN",101, 6091,1,10, 0)
	2396	above, It adds a HMP (Health M anagement Platform) 'freshness ' event.
	2397	"KRN",101, 6091,4)
	2398	^^^HMP ADT -A04 CLIEN T
	2399	"KRN",101, 6091,99)
	2400	63971,3935 6
	2401	"KRN",101, 6091,770)
	2402	^HMP HL7^^ ^^^^^^^ADT
	2403	"KRN",101, 6091,774)
	2404	D ADT^HMPE HL7($G(HLF S),HLNEXT, $G(HLNODE) ,HLQUIT)
	2405	"KRN",101, 6091,775,0 )
	2406	^101.0775P A
	2407	"KRN",101, 6092,-1)
	2408	0^2
	2409	"KRN",101, 6092,0)
	2410	HMP ADT-A0 8 CLIENT^H MP HL7 ADT -A08 Clien t^^S^^^^^^ ^^
	2411	"KRN",101, 6092,1,0)
	2412	^101.06^10 ^10^315111 0^^^
	2413	"KRN",101, 6092,1,1,0 )
	2414	This clien t protocol is used t o process HL7 ADT/A0 8 messages published by
	2415	"KRN",101, 6092,1,2,0 )
	2416	the VAFC A DT-A08 SER VER protoc ol.
	2417	"KRN",101, 6092,1,3,0 )
	2418
	2419	"KRN",101, 6092,1,4,0 )
	2420	The client filters A 08 events. It adds t o the HMP 'freshness ' queue on ly
	2421	"KRN",101, 6092,1,5,0 )
	2422	if the A08 was the r esult of t he patient 's sensiti vity being modified via
	2423	"KRN",101, 6092,1,6,0 )
	2424	the DG SEC URITY EDIT /EDIT opti on. All ot her A08 ev ents are i gnored and
	2425	"KRN",101, 6092,1,7,0 )
	2426	should not add to th e 'freshne ss' queue.
	2427	"KRN",101, 6092,1,8,0 )
	2428
	2429	"KRN",101, 6092,1,9,0 )
	2430	Note: The ROUTING LO GIC does n ot send an y HL7 mess ages. As m entioned
	2431	"KRN",101, 6092,1,10, 0)
	2432	above, It adds a HMP (Health M anagement Platform) 'freshness ' event.
	2433	"KRN",101, 6092,4)
	2434	^^^
	2435	"KRN",101, 6092,99)
	2436	63971,3935 6
	2437	"KRN",101, 6092,770)
	2438	^HMP HL7^^ ^^^^^^^ADT
	2439	"KRN",101, 6092,774)
	2440	D ADT^HMPE HL7($G(HLF S),HLNEXT, $G(HLNODE) ,HLQUIT)
	2441	"KRN",101, 6093,-1)
	2442	0^3
	2443	"KRN",101, 6093,0)
	2444	HMP APPT E VENTS^Appo intment ev ents for H MP^^A^^^^^ ^^^
	2445	"KRN",101, 6093,1,0)
	2446	^101.06^1^ 1^3151028^ ^^^
	2447	"KRN",101, 6093,1,1,0 )
	2448	This proto col will t rack appoi ntments fo r HMP.
	2449	"KRN",101, 6093,4)
	2450	^^^HMP APP T EVENTS
	2451	"KRN",101, 6093,20)
	2452	D SDAM^HMP EVNT(SDATA )
	2453	"KRN",101, 6093,99)
	2454	63971,3935 6
	2455	"KRN",101, 6094,-1)
	2456	0^4
	2457	"KRN",101, 6094,0)
	2458	HMP DG UPD ATES^DG up dates for HMP^^A^^^^ ^^^^
	2459	"KRN",101, 6094,1,0)
	2460	^101.06^1^ 1^3151028^ ^^^
	2461	"KRN",101, 6094,1,1,0 )
	2462	This proto col will t rack Patie nt file ch anges for HMP.
	2463	"KRN",101, 6094,4)
	2464	^^^HMP APP T EVENTS
	2465	"KRN",101, 6094,20)
	2466	D DG^HMPEV NT(DGDA,DG FIELD,DGFI LE)
	2467	"KRN",101, 6094,99)
	2468	63971,3935 6
	2469	"KRN",101, 6095,-1)
	2470	0^5
	2471	"KRN",101, 6095,0)
	2472	HMP GMPL E VENT^Probl em List ev ents for H MP^^A^^^^^ ^^^
	2473	"KRN",101, 6095,1,0)
	2474	^101.06^1^ 1^3110823^ ^^^
	2475	"KRN",101, 6095,1,1,0 )
	2476	This proto col will t rack new a nd updated problems for HMP.
	2477	"KRN",101, 6095,4)
	2478	^^^HMP GMP L EVENT
	2479	"KRN",101, 6095,20)
	2480	D GMPL^HMP EVNT(DFN,G MPIFN)
	2481	"KRN",101, 6095,99)
	2482	63971,3935 6
	2483	"KRN",101, 6096,-1)
	2484	0^7
	2485	"KRN",101, 6096,0)
	2486	HMP INPT E VENTS^Inpa tient Move ment event s for HMP^ ^A^^^^^^^^
	2487	"KRN",101, 6096,1,0)
	2488	^101.06^1^ 1^3151028^ ^^^
	2489	"KRN",101, 6096,1,1,0 )
	2490	This proto col will t rack patie nt admissi ons and di scharges f or HMP.
	2491	"KRN",101, 6096,20)
	2492	D DGPM^HMP EVNT(DGPMA ,DGPMDA,DG PMP,DGPMT)
	2493	"KRN",101, 6096,99)
	2494	63971,3935 6
	2495	"KRN",101, 6097,-1)
	2496	0^11
	2497	"KRN",101, 6097,0)
	2498	HMP PCE EV ENTS^PCE e vents for HMP^^A^^^^ ^^^^
	2499	"KRN",101, 6097,1,0)
	2500	^101.06^1^ 1^3101129^ ^^
	2501	"KRN",101, 6097,1,1,0 )
	2502	This proto col will t rack PCE v isit data for HMP.
	2503	"KRN",101, 6097,20)
	2504	D PCE^HMPE VNT
	2505	"KRN",101, 6097,99)
	2506	63971,3935 6
	2507	"KRN",101, 6098,-1)
	2508	0^15
	2509	"KRN",101, 6098,0)
	2510	HMP XQOR E VENTS^XQOR HL7 event s for HMP^ ^A^^^^^^^^
	2511	"KRN",101, 6098,1,0)
	2512	^101.06^3^ 3^3101129^ ^
	2513	"KRN",101, 6098,1,1,0 )
	2514	This proto col monito rs order e vents for HMP. It i s placed o n the
	2515	"KRN",101, 6098,1,2,0 )
	2516	* EVSEND O R protocol s to check for updat es being s ent from a ncillary
	2517	"KRN",101, 6098,1,3,0 )
	2518	packages t o Order En try; it mo nitors whe n orders a re complet ed.
	2519	"KRN",101, 6098,20)
	2520	D XQOR^HMP EVNT(.XQOR MSG)
	2521	"KRN",101, 6098,99)
	2522	63971,3935 6
	2523	"KRN",101, 6099,-1)
	2524	0^6
	2525	"KRN",101, 6099,0)
	2526	HMP GMRA E VENTS^Alle rgy Events for HMP^^ A^^^^^^^^
	2527	"KRN",101, 6099,1,0)
	2528	^101.06^1^ 1^3120822^ ^
	2529	"KRN",101, 6099,1,1,0 )
	2530	This proto col will t rack Aller gy data up dates for HMP.
	2531	"KRN",101, 6099,20)
	2532	D GMRA^HMP EVNT("")
	2533	"KRN",101, 6099,99)
	2534	63971,3935 6
	2535	"KRN",101, 6100,-1)
	2536	0^9
	2537	"KRN",101, 6100,0)
	2538	HMP NA EVE NTS^XQOR H L7 events for HMP^^A ^^^^^^^^
	2539	"KRN",101, 6100,1,0)
	2540	^101.06^3^ 3^3110818^ ^^
	2541	"KRN",101, 6100,1,1,0 )
	2542	This proto col monito rs order e vents for HMP. It i s placed o n the
	2543	"KRN",101, 6100,1,2,0 )
	2544	OR EVSEND * protocol s to check for order numbers a ssigned to new order s
	2545	"KRN",101, 6100,1,3,0 )
	2546	placed fro m the anci llary pack ages.
	2547	"KRN",101, 6100,20)
	2548	D NA^HMPEV NT(.XQORMS G)
	2549	"KRN",101, 6100,99)
	2550	63971,3935 6
	2551	"KRN",101, 6101,-1)
	2552	0^8
	2553	"KRN",101, 6101,0)
	2554	HMP MDC EV ENT^CLiO e vents for HMP^^A^^^^ ^^^^
	2555	"KRN",101, 6101,1,0)
	2556	^101.06^1^ 1^3120830^ ^^^
	2557	"KRN",101, 6101,1,1,0 )
	2558	This proto col will t rack new a nd updated observati ons for HM P.
	2559	"KRN",101, 6101,20)
	2560	D MDC^HMPE VNT(.MDCOB S)
	2561	"KRN",101, 6101,99)
	2562	63971,3935 6
	2563	"KRN",101, 6102,-1)
	2564	0^14
	2565	"KRN",101, 6102,0)
	2566	HMP PSB EV ENTS^BCMA events for HMP^^A^^^ ^^^^^
	2567	"KRN",101, 6102,1,0)
	2568	^101.06^1^ 1^3151028^ ^^^
	2569	"KRN",101, 6102,1,1,0 )
	2570	This proto col will t rack medic ation admi nistration s for HMP.
	2571	"KRN",101, 6102,20)
	2572	D PSB^HMPE VNT(.PSBIE N)
	2573	"KRN",101, 6102,99)
	2574	63971,3935 6
	2575	"KRN",101, 6103,-1)
	2576	0^12
	2577	"KRN",101, 6103,0)
	2578	HMP PCMM T EAM^PCMM T eam events for HMP^^ A^^^^^^^^
	2579	"KRN",101, 6103,20)
	2580	D PCMMT^HM PEVNT(SCPT TMAF,SCPTT MB4)
	2581	"KRN",101, 6103,99)
	2582	63971,3935 6
	2583	"KRN",101, 6104,-1)
	2584	0^13
	2585	"KRN",101, 6104,0)
	2586	HMP PCMM T EAM POSITI ON^PCMM Te am Positio n events f or HMP^^A^ ^^^^^^^
	2587	"KRN",101, 6104,20)
	2588	D PCMMTP^H MPEVNT(SCP TTPAF,SCPT TPB4)
	2589	"KRN",101, 6104,99)
	2590	63971,3935 6
	2591	"KRN",101, 6105,-1)
	2592	0^17
	2593	"KRN",101, 6105,0)
	2594	HMPM EVT Q UE MGR MEN U^VPR Fres hness Queu e Viewer^^ M^^^^^^^^
	2595	"KRN",101, 6105,1,0)
	2596	^101.06^1^ 1^3151109^ ^^
	2597	"KRN",101, 6105,1,1,0 )
	2598	Main proto col menu u sed by the VPRM EVT QUE MGR Li stMan temp late.
	2599	"KRN",101, 6105,4)
	2600	26^4
	2601	"KRN",101, 6105,10,0)
	2602	^101.01PA^ 9^9
	2603	"KRN",101, 6105,10,1, 0)
	2604	6107^^^
	2605	"KRN",101, 6105,10,1, "^")
	2606	HMPM EVT Q UE FRESHNE SS REPORT
	2607	"KRN",101, 6105,10,2, 0)
	2608	6108^^^
	2609	"KRN",101, 6105,10,2, "^")
	2610	HMPM EVT Q UE CHANGE DOMAIN
	2611	"KRN",101, 6105,10,3, 0)
	2612	6109^^^
	2613	"KRN",101, 6105,10,3, "^")
	2614	HMPM EVT Q UE REFRESH
	2615	"KRN",101, 6105,10,4, 0)
	2616	6110^^^
	2617	"KRN",101, 6105,10,4, "^")
	2618	HMPM EVT Q UE DISPLAY DETAILS
	2619	"KRN",101, 6105,10,5, 0)
	2620	6111^^^
	2621	"KRN",101, 6105,10,5, "^")
	2622	HMPM EVT Q UE FILTER
	2623	"KRN",101, 6105,10,6, 0)
	2624	6112^^^
	2625	"KRN",101, 6105,10,6, "^")
	2626	HMPM EVT Q UE SHOW TE MP GLOBALS
	2627	"KRN",101, 6105,10,7, 0)
	2628	6113^^^
	2629	"KRN",101, 6105,10,7, "^")
	2630	HMPM EVT Q UE SELECT PATIENT
	2631	"KRN",101, 6105,10,8, 0)
	2632	6114^^^
	2633	"KRN",101, 6105,10,8, "^")
	2634	HMPM EVT Q UE CHANGE MAX LISTED
	2635	"KRN",101, 6105,10,9, 0)
	2636	6106^^^
	2637	"KRN",101, 6105,10,9, "^")
	2638	HMPM EVT Q UE CHANGE SERVER
	2639	"KRN",101, 6105,20)
	2640	S XQORM("B ")="Update "
	2641	"KRN",101, 6105,24)
	2642	I 1 X:$D(^ ORD(101,+$ P(^ORD(101 ,DA(1),10, DA,0),"^", 1),24)) ^( 24)
	2643	"KRN",101, 6105,26)
	2644	D SHOW^VAL M
	2645	"KRN",101, 6105,28)
	2646	Select Act ion:
	2647	"KRN",101, 6105,99)
	2648	63971,3935 6
	2649	"KRN",101, 6106,-1)
	2650	0^25
	2651	"KRN",101, 6106,0)
	2652	HMPM EVT Q UE CHANGE SERVER^Cha nge Server ^^A^^^^^^^ ^
	2653	"KRN",101, 6106,1,0)
	2654	^101.06^2^ 2^3151109^ ^
	2655	"KRN",101, 6106,1,1,0 )
	2656	Allows use r to chang e which se rver's fre shness que ue events to display in
	2657	"KRN",101, 6106,1,2,0 )
	2658	the viewer .
	2659	"KRN",101, 6106,10,0)
	2660	^101.01PA^ 1^1
	2661	"KRN",101, 6106,10,1, 0)
	2662	6107^^^
	2663	"KRN",101, 6106,10,1, "^")
	2664	HMPM EVT Q UE FRESHNE SS REPORT
	2665	"KRN",101, 6106,20)
	2666	D CS^HMPEQ LM
	2667	"KRN",101, 6106,99)
	2668	63971,3935 6
	2669	"KRN",101, 6107,-1)
	2670	0^22
	2671	"KRN",101, 6107,0)
	2672	HMPM EVT Q UE FRESHNE SS REPORT^ Freshness Report^^A^ ^^^^^^^
	2673	"KRN",101, 6107,1,0)
	2674	^^1^1^3140 716^
	2675	"KRN",101, 6107,1,1,0 )
	2676	View overv iew freshn ess queue informatio n for all HMP server s.
	2677	"KRN",101, 6107,20)
	2678	D FSHRPT^H MPEQLM
	2679	"KRN",101, 6107,99)
	2680	63971,3935 6
	2681	"KRN",101, 6108,-1)
	2682	0^16
	2683	"KRN",101, 6108,0)
	2684	HMPM EVT Q UE CHANGE DOMAIN^Cha nge Domain ^^A^^^^^^^ ^
	2685	"KRN",101, 6108,1,0)
	2686	^^3^3^3140 716^
	2687	"KRN",101, 6108,1,1,0 )
	2688	Allows use r to indic ate only f reshness e vents for a particul ar domain,
	2689	"KRN",101, 6108,1,2,0 )
	2690	like med, task, visi t, etc., o r all doma ins should be listed in
	2691	"KRN",101, 6108,1,3,0 )
	2692	freshness viewer.
	2693	"KRN",101, 6108,20)
	2694	D CD^HMPEQ LM
	2695	"KRN",101, 6108,99)
	2696	63971,3935 6
	2697	"KRN",101, 6109,-1)
	2698	0^24
	2699	"KRN",101, 6109,0)
	2700	HMPM EVT Q UE REFRESH ^Update^^A ^^^^^^^^
	2701	"KRN",101, 6109,1,0)
	2702	^101.06^2^ 2^3140716^ ^
	2703	"KRN",101, 6109,1,1,0 )
	2704	Refresh/up date the c urrent lis t of fresh ness queue events us ing the
	2705	"KRN",101, 6109,1,2,0 )
	2706	current cr iteria/fil ters speci fied.
	2707	"KRN",101, 6109,20)
	2708	D REFRESH^ HMPEQLM
	2709	"KRN",101, 6109,99)
	2710	63971,3935 6
	2711	"KRN",101, 6110,-1)
	2712	0^23
	2713	"KRN",101, 6110,0)
	2714	HMPM EVT Q UE DISPLAY DETAILS^D isplay Det ails^^A^^^ ^^^^^
	2715	"KRN",101, 6110,1,0)
	2716	^^1^1^3140 716^
	2717	"KRN",101, 6110,1,1,0 )
	2718	Display de tails rela ted to an event list ed in the freshness queue view er.
	2719	"KRN",101, 6110,20)
	2720	D DETAIL^H MPEQLM
	2721	"KRN",101, 6110,99)
	2722	63971,3935 6
	2723	"KRN",101, 6111,-1)
	2724	0^21
	2725	"KRN",101, 6111,0)
	2726	HMPM EVT Q UE FILTER^ Filter Eve nts^^A^^^^ ^^^^
	2727	"KRN",101, 6111,1,0)
	2728	^^3^3^3140 716^
	2729	"KRN",101, 6111,1,1,0 )
	2730	Allows use r to indic ate only f reshness e vents with a state o f
	2731	"KRN",101, 6111,1,2,0 )
	2732	'processed ' or 'wait ing to be processed' or all ev ents shoul d be liste d in
	2733	"KRN",101, 6111,1,3,0 )
	2734	freshness viewer.
	2735	"KRN",101, 6111,20)
	2736	D FILTER^H MPEQLM
	2737	"KRN",101, 6111,99)
	2738	63971,3935 6
	2739	"KRN",101, 6112,-1)
	2740	0^20
	2741	"KRN",101, 6112,0)
	2742	HMPM EVT Q UE SHOW TE MP GLOBALS ^Temp Glob al Usage^^ A^^^^^^^^
	2743	"KRN",101, 6112,1,0)
	2744	^101.06^4^ 4^3140716^ ^
	2745	"KRN",101, 6112,1,1,0 )
	2746	Show VPR t emporary g lobal usag e report.
	2747	"KRN",101, 6112,1,2,0 )
	2748
	2749	"KRN",101, 6112,1,3,0 )
	2750	The report displays summary in formation related to VPR proce ssing use of
	2751	"KRN",101, 6112,1,4,0 )
	2752	^XTMP and ^TMP globa ls.
	2753	"KRN",101, 6112,20)
	2754	D SHOWHMPN ^HMPEQLM
	2755	"KRN",101, 6112,99)
	2756	63971,3935 6
	2757	"KRN",101, 6113,-1)
	2758	0^19
	2759	"KRN",101, 6113,0)
	2760	HMPM EVT Q UE SELECT PATIENT^Se lect Patie nt^^A^^^^^ ^^^
	2761	"KRN",101, 6113,1,0)
	2762	^^2^2^3140 716^
	2763	"KRN",101, 6113,1,1,0 )
	2764	Allows use r to speci fy that on ly the fre shness eve nts for th e selected
	2765	"KRN",101, 6113,1,2,0 )
	2766	patient sh ould be us ed in the freshness queue even t viewer.
	2767	"KRN",101, 6113,20)
	2768	D SELPT^HM PEQLM
	2769	"KRN",101, 6113,99)
	2770	63971,3935 6
	2771	"KRN",101, 6114,-1)
	2772	0^18
	2773	"KRN",101, 6114,0)
	2774	HMPM EVT Q UE CHANGE MAX LISTED ^Change Ma x Limit^^A ^^^^^^^^
	2775	"KRN",101, 6114,1,0)
	2776	^^2^2^3140 716^
	2777	"KRN",101, 6114,1,1,0 )
	2778	Allows use r to selec t the maxi mum events to displa y in the f reshness
	2779	"KRN",101, 6114,1,2,0 )
	2780	queue view er. (10 - 1000)
	2781	"KRN",101, 6114,20)
	2782	D CM^HMPEQ LM
	2783	"KRN",101, 6114,99)
	2784	63971,3935 6
	2785	"KRN",101, 6115,-1)
	2786	0^26
	2787	"KRN",101, 6115,0)
	2788	HMP DGPF A SSIGN FLAG ^^^A^^^^^^ ^^HEALTH M ANAGEMENT PLATFORM
	2789	"KRN",101, 6115,1,0)
	2790	^101.06^2^ 2^3150422^ ^
	2791	"KRN",101, 6115,1,1,0 )
	2792	Used to tr igger a JD S update w hen the DG PF ASSIGN FLAG actio n protocol is used.
	2793	"KRN",101, 6115,1,2,0 )
	2794	A patient must have been selec ted and th e DFN valu e is in DG DFN.
	2795	"KRN",101, 6115,20)
	2796	I $G(DGDFN ),$L($T(PO ST^HMPEVNT )) D POST^ HMPEVNT(DG DFN,"patie nt",DGDFN)
	2797	"KRN",409. 61,801,-1)
	2798	0^1
	2799	"KRN",409. 61,801,0)
	2800	HMPM EVT Q UE MGR^1^^ 80^7^18^1^ 1^Event^HM PM EVT QUE MGR MENU^ HMP Freshn ess Event Viewer^1^^ 1
	2801	"KRN",409. 61,801,1)
	2802	^VALM HIDD EN ACTIONS
	2803	"KRN",409. 61,801,"CO L",0)
	2804	^409.621^4 ^4
	2805	"KRN",409. 61,801,"CO L",1,0)
	2806	ID^2^4^ITE M
	2807	"KRN",409. 61,801,"CO L",2,0)
	2808	SEQ^7^8^SE Q
	2809	"KRN",409. 61,801,"CO L",3,0)
	2810	NODE^19^62 ^Event Nod e
	2811	"KRN",409. 61,801,"CO L",4,0)
	2812	STATE^17^1
	2813	"KRN",409. 61,801,"CO L","B","ID ",1)
	2814
	2815	"KRN",409. 61,801,"CO L","B","NO DE",3)
	2816
	2817	"KRN",409. 61,801,"CO L","B","SE Q",2)
	2818
	2819	"KRN",409. 61,801,"CO L","B","ST ATE",4)
	2820
	2821	"KRN",409. 61,801,"FN L")
	2822	D EXIT^HMP EQLM
	2823	"KRN",409. 61,801,"HD R")
	2824	D HDR^HMPE QLM
	2825	"KRN",409. 61,801,"HL P")
	2826	D HELP^HMP EQLM
	2827	"KRN",409. 61,801,"IN IT")
	2828	D INIT^HMP EQLM
	2829	"KRN",771, 235,-1)
	2830	0^1
	2831	"KRN",771, 235,0)
	2832	HMP HL7^a^ ^^^^USA
	2833	"KRN",8989 .5,15362,0 )
	2834	578;DIC(9. 4,^HMP VER SION^1
	2835	"KRN",8989 .5,15362,1 )
	2836	2.00
	2837	"KRN",8989 .5,15363,0 )
	2838	578;DIC(9. 4,^HMP JSO N SCHEMA^1
	2839	"KRN",8989 .5,15363,1 )
	2840	3.001
	2841	"KRN",8989 .51,844,-1 )
	2842	0^9
	2843	"KRN",8989 .51,844,0)
	2844	HMP VERSIO N^HMP Vers ion^^^Vers ion:
	2845	"KRN",8989 .51,844,1)
	2846	N^1:99:2^E nter the c urrent ver sion numbe r of the H MP data ex tracts.
	2847	"KRN",8989 .51,844,6)
	2848	F
	2849	"KRN",8989 .51,844,20 ,0)
	2850	^8989.512^ 3^3^314101 6^^
	2851	"KRN",8989 .51,844,20 ,1,0)
	2852	This param eter holds the curre nt version number of the eHMP Patient
	2853	"KRN",8989 .51,844,20 ,2,0)
	2854	Record (HM P) data ex tract RPC' s, in the form V.PP where V is the
	2855	"KRN",8989 .51,844,20 ,3,0)
	2856	package ve rsion numb er and PP is the lat est patch number.
	2857	"KRN",8989 .51,844,30 ,0)
	2858	^8989.513I ^1^1
	2859	"KRN",8989 .51,844,30 ,1,0)
	2860	1^9.4
	2861	"KRN",8989 .51,844,30 ,2,0)
	2862	1^200
	2863	"KRN",8989 .51,845,-1 )
	2864	0^7
	2865	"KRN",8989 .51,845,0)
	2866	HMP SYSTEM NAME^Hash ed System Name
	2867	"KRN",8989 .51,845,1)
	2868	F^1:10^Ent er the CRC hashed na me for thi s system.
	2869	"KRN",8989 .51,845,20 ,0)
	2870	^^3^3^3130 905^
	2871	"KRN",8989 .51,845,20 ,1,0)
	2872	This param eter holds the name of this Vi stA system , as a has hed base 1 6
	2873	"KRN",8989 .51,845,20 ,2,0)
	2874	value. It is calcul ated by a HMP patch post-init and stuffe d into the
	2875	"KRN",8989 .51,845,20 ,3,0)
	2876	SYStem lev el value, and should NOT be mo dified.
	2877	"KRN",8989 .51,845,30 ,0)
	2878	^8989.513I ^1^1
	2879	"KRN",8989 .51,845,30 ,1,0)
	2880	1^4.2
	2881	"KRN",8989 .51,846,-1 )
	2882	0^4
	2883	"KRN",8989 .51,846,0)
	2884	HMP PARAME TERS^HMP S YSTEM PARA METERS^1^S ystem Para meters^Sys tem Parame ters Name
	2885	"KRN",8989 .51,846,1)
	2886	W
	2887	"KRN",8989 .51,846,6)
	2888	F
	2889	"KRN",8989 .51,846,20 ,0)
	2890	^8989.512^ 2^2^312012 5^^^
	2891	"KRN",8989 .51,846,20 ,1,0)
	2892	This param eter store s a list o f paramete rs used by the HMP m iddle teir
	2893	"KRN",8989 .51,846,20 ,2,0)
	2894	and the HM P UI.
	2895	"KRN",8989 .51,846,20 ,3,0)
	2896	whenever t he schema changes in a way tha t requires a convers ion or
	2897	"KRN",8989 .51,846,20 ,4,0)
	2898	re-extract ion of obj ects. The fractiona l piece in crements w henever th e
	2899	"KRN",8989 .51,846,20 ,5,0)
	2900	schema is extended.
	2901	"KRN",8989 .51,846,30 ,0)
	2902	^8989.513I ^2^2
	2903	"KRN",8989 .51,846,30 ,1,0)
	2904	6^4.2
	2905	"KRN",8989 .51,846,30 ,2,0)
	2906	1^200
	2907	"KRN",8989 .51,847,-1 )
	2908	0^1
	2909	"KRN",8989 .51,847,0)
	2910	HMP CPRS P ATH^CPRS L ocation^0^ FREE TEXT^ PIV Link M essage aft er success
	2911	"KRN",8989 .51,847,1)
	2912	W
	2913	"KRN",8989 .51,847,6)
	2914	F
	2915	"KRN",8989 .51,847,30 ,0)
	2916	^8989.513I ^2^2
	2917	"KRN",8989 .51,847,30 ,1,0)
	2918	1^200
	2919	"KRN",8989 .51,847,30 ,2,0)
	2920	4^4.2
	2921	"KRN",8989 .51,848,-1 )
	2922	0^2
	2923	"KRN",8989 .51,848,0)
	2924	HMP JSON S CHEMA^HMP JSON Extra ct Schema^ ^^JSON Sch ema Versio n
	2925	"KRN",8989 .51,848,1)
	2926	N^1:999:4^ Enter the version / build numb er for the HMP Schem a
	2927	"KRN",8989 .51,848,20 ,0)
	2928	^^5^5^3141 022^
	2929	"KRN",8989 .51,848,20 ,1,0)
	2930	This conta ins the ve rsion numb er of the HMP schema which des cribes the
	2931	"KRN",8989 .51,848,20 ,2,0)
	2932	JSON objec ts produce d by the H MP extract s. The wh ole number increment s
	2933	"KRN",8989 .51,848,20 ,3,0)
	2934	whenever t he schema changes in a way tha t requires a convers ion or
	2935	"KRN",8989 .51,848,20 ,4,0)
	2936	re-extract ion of obj ects. The fractiona l piece in crements w henever th e
	2937	"KRN",8989 .51,848,20 ,5,0)
	2938	schema is extended.
	2939	"KRN",8989 .51,848,30 ,0)
	2940	^8989.513I ^1^1
	2941	"KRN",8989 .51,848,30 ,1,0)
	2942	1^9.4
	2943	"KRN",8989 .51,849,-1 )
	2944	0^3
	2945	"KRN",8989 .51,849,0)
	2946	HMP LOCATI ONS^HMP Lo cations^1^ Clinic^Syn chronized
	2947	"KRN",8989 .51,849,1)
	2948	Y
	2949	"KRN",8989 .51,849,6)
	2950	P^44^Enter clinic to synch wit h HMP
	2951	"KRN",8989 .51,849,30 ,0)
	2952	^8989.513I ^1^1
	2953	"KRN",8989 .51,849,30 ,1,0)
	2954	5^4
	2955	"KRN",8989 .51,850,-1 )
	2956	0^8
	2957	"KRN",8989 .51,850,0)
	2958	HMP TASK W AIT TIME^H MP TASK WA IT TIME^^^ #SECONDS
	2959	"KRN",8989 .51,850,1)
	2960	N^1:9999^E nter the n umber of s econds to wait befor e the HMP Data Monit or re-queu es
	2961	"KRN",8989 .51,850,4, 0)
	2962	^8989.514^ 1^1
	2963	"KRN",8989 .51,850,4, 1,0)
	2964	HMP
	2965	"KRN",8989 .51,850,4, "B","HMP", 1)
	2966
	2967	"KRN",8989 .51,850,6)
	2968	F
	2969	"KRN",8989 .51,850,20 ,0)
	2970	^^2^2^3141 022^
	2971	"KRN",8989 .51,850,20 ,1,0)
	2972	This is th e number o f seconds that the s ystem will wait befo re re-queu ing
	2973	"KRN",8989 .51,850,20 ,2,0)
	2974	the HMP Da ta Monitor backgroun d job.
	2975	"KRN",8989 .51,850,30 ,0)
	2976	^8989.513I ^2^2
	2977	"KRN",8989 .51,850,30 ,1,0)
	2978	1^9.4
	2979	"KRN",8989 .51,850,30 ,2,0)
	2980	2^4.2
	2981	"KRN",8989 .51,851,-1 )
	2982	0^10
	2983	"KRN",8989 .51,851,0)
	2984	HMP DOMAIN SIZES^HMP Average D omain Size s^1^Domain ^Size (in bytes)
	2985	"KRN",8989 .51,851,1)
	2986	N^0:999999 9999:0^Ent er the ave rage size in bytes f or each do main item.
	2987	"KRN",8989 .51,851,6)
	2988	F^1:30^Ent er the int ernal name for the d omain (3rd UID piece ).
	2989	"KRN",8989 .51,851,20 ,0)
	2990	^^3^3^3150 225^
	2991	"KRN",8989 .51,851,20 ,1,0)
	2992	This para meter cont ains a lis t of VPR e xtract dom ains and t heir avera ge
	2993	"KRN",8989 .51,851,20 ,2,0)
	2994	sizes. T he sizes a re used in computing the appro ximate siz e of an it em
	2995	"KRN",8989 .51,851,20 ,3,0)
	2996	with limi ting the f reshness c alls by si ze.
	2997	"KRN",8989 .51,851,30 ,0)
	2998	^8989.513I ^1^1
	2999	"KRN",8989 .51,851,30 ,1,0)
	3000	10^9.4
	3001	"KRN",8989 .51,852,-1 )
	3002	0^11
	3003	"KRN",8989 .51,852,0)
	3004	HMP EXTRAC T DISK SIZ E LIMIT^Ex tracts Siz e Limit (M Bs)^^^HMP XTMP Megab ytes
	3005	"KRN",8989 .51,852,1)
	3006	N^10:2000: 0^Enter th e # of meg abytes of data that triggers a requeue ( 10-2000)
	3007	"KRN",8989 .51,852,20 ,0)
	3008	^^16^16^31 50225^
	3009	"KRN",8989 .51,852,20 ,1,0)
	3010	Maximum si ze (megaby tes) of al l VPR extr acts in ^X TMP("VPRFX ~*") waiti ng
	3011	"KRN",8989 .51,852,20 ,2,0)
	3012	to be sen t to HMP s ervers as part of ge tPtUpdates .
	3013	"KRN",8989 .51,852,20 ,3,0)
	3014
	3015	"KRN",8989 .51,852,20 ,4,0)
	3016	If maximu m is reach ed, patien t domain e xtract Tas Kman jobs will be
	3017	"KRN",8989 .51,852,20 ,5,0)
	3018	requeued to a futur e time, as specified in the VP R EXTRACT TASK REQUE UE
	3019	"KRN",8989 .51,852,20 ,6,0)
	3020	SECS para meter. At that time, this maxi mum check will be pe rformed ag ain.
	3021	"KRN",8989 .51,852,20 ,7,0)
	3022
	3023	"KRN",8989 .51,852,20 ,8,0)
	3024	Also, thi s maximum check occu rs when an executing extract j ob is abou t to
	3025	"KRN",8989 .51,852,20 ,9,0)
	3026	start ano ther domai n extract. If maximu m size has been reac hed, the j ob
	3027	"KRN",8989 .51,852,20 ,10,0)
	3028	will hang the numbe r of secon ds specifi ed by the VPR EXTRAC T TASK REQ UEUE
	3029	"KRN",8989 .51,852,20 ,11,0)
	3030	SECS para meter. The maximum c heck will occur agai n after th e hang tim e
	3031	"KRN",8989 .51,852,20 ,12,0)
	3032	has expir ed.
	3033	"KRN",8989 .51,852,20 ,13,0)
	3034
	3035	"KRN",8989 .51,852,20 ,14,0)
	3036	This limi t is neede d to insur e the ^XTM P global d oes not ge t too big
	3037	"KRN",8989 .51,852,20 ,15,0)
	3038	during in itial/resy nc domain extract pr ocessing a nd cause d isk full
	3039	"KRN",8989 .51,852,20 ,16,0)
	3040	errors.
	3041	"KRN",8989 .51,852,30 ,0)
	3042	^8989.513I ^1^1
	3043	"KRN",8989 .51,852,30 ,1,0)
	3044	1^4.2
	3045	"KRN",8989 .51,853,-1 )
	3046	0^12
	3047	"KRN",8989 .51,853,0)
	3048	HMP EXTRAC T TASK REQ UEUE SECS^ seconds to requeue t ask or han g job^^^Re queue/Hang seconds
	3049	"KRN",8989 .51,853,1)
	3050	N^5:60:0^E nter 5 to 60 seconds
	3051	"KRN",8989 .51,853,20 ,0)
	3052	^^11^11^31 50225^
	3053	"KRN",8989 .51,853,20 ,1,0)
	3054	When extra ct task ca nnot be ru n because of possibl e ^XTMP di sk concern s,
	3055	"KRN",8989 .51,853,20 ,2,0)
	3056	this para meter is u sed to req ueue the t ask to a f uture date /time or h ang
	3057	"KRN",8989 .51,853,20 ,3,0)
	3058	an extrac t job curr ently exec uting.
	3059	"KRN",8989 .51,853,20 ,4,0)
	3060
	3061	"KRN",8989 .51,853,20 ,5,0)
	3062	^XTMP dis k space fr ees up as other alre ady genera ted extrac ts are sen t to
	3063	"KRN",8989 .51,853,20 ,6,0)
	3064	the vario us HMP ser vers.
	3065	"KRN",8989 .51,853,20 ,7,0)
	3066
	3067	"KRN",8989 .51,853,20 ,8,0)
	3068	Allowed V alues: 5 to 60 (5 seconds to 1 minu te)
	3069	"KRN",8989 .51,853,20 ,9,0)
	3070
	3071	"KRN",8989 .51,853,20 ,10,0)
	3072	De fault: 10 (if parame ter not se t)
	3073	"KRN",8989 .51,853,20 ,11,0)
	3074	Initia lized: 10 (set in po st-init du ring first install)
	3075	"KRN",8989 .51,853,30 ,0)
	3076	^8989.513I ^1^1
	3077	"KRN",8989 .51,853,30 ,1,0)
	3078	1^4.2
	3079	"KRN",8994 ,3434,-1)
	3080	0^14
	3081	"KRN",8994 ,3434,0)
	3082	HMP PATIEN T ACTIVITY ^ACT^HMPAC T^2^S
	3083	"KRN",8994 ,3434,1,0)
	3084	^8994.01^2 ^2^3140903 ^^^
	3085	"KRN",8994 ,3434,1,1, 0)
	3086	This remot e procedur e returns all JSON m essages fo r entries that exist in
	3087	"KRN",8994 ,3434,1,2, 0)
	3088	the cross reference ^HMP(8000 01.5,"PTAP PT,"HMP"
	3089	"KRN",8994 ,3435,-1)
	3090	0^1
	3091	"KRN",8994 ,3435,0)
	3092	HMP APPOIN TMENTS^OUT ^HMPPATS^4 ^S^^^1^^^1
	3093	"KRN",8994 ,3435,1,0)
	3094	^8994.01^2 ^2^3141016 ^^^^
	3095	"KRN",8994 ,3435,1,1, 0)
	3096	This RPC f inds a lis t of patie nts that h ave schedu led appoin tments dur ing
	3097	"KRN",8994 ,3435,1,2, 0)
	3098	the reques ted timefr ame, as XM L in ^TMP( $J,"HMP",n ).
	3099	"KRN",8994 ,3435,2,0)
	3100	^8994.02A^ 2^2
	3101	"KRN",8994 ,3435,2,1, 0)
	3102	START^1^20 ^0^1
	3103	"KRN",8994 ,3435,2,1, 1,0)
	3104	^8994.021^ 2^2^310112 9^^^
	3105	"KRN",8994 ,3435,2,1, 1,1,0)
	3106	The date/t ime from w hich to be gin search ing for ap pointments ; optional ,
	3107	"KRN",8994 ,3435,2,1, 1,2,0)
	3108	will defau lt to tomo rrow if no t defined.
	3109	"KRN",8994 ,3435,2,2, 0)
	3110	STOP^1^20^ 0^2
	3111	"KRN",8994 ,3435,2,2, 1,0)
	3112	^8994.021^ 2^2^314101 6^^^
	3113	"KRN",8994 ,3435,2,2, 1,1,0)
	3114	The date/t ime at whi ch to end searching for appoin tments; op tional,
	3115	"KRN",8994 ,3435,2,2, 1,2,0)
	3116	will defau lt to tomo rrow if no t defined.
	3117	"KRN",8994 ,3435,2,"B ","START", 1)
	3118
	3119	"KRN",8994 ,3435,2,"B ","STOP",2 )
	3120
	3121	"KRN",8994 ,3435,2,"P ARAMSEQ",1 ,1)
	3122
	3123	"KRN",8994 ,3435,2,"P ARAMSEQ",2 ,2)
	3124
	3125	"KRN",8994 ,3435,3,0)
	3126	^8994.03^1 ^1^3141016 ^^^
	3127	"KRN",8994 ,3435,3,1, 0)
	3128	Text array formatted XML
	3129	"KRN",8994 ,3436,-1)
	3130	0^2
	3131	"KRN",8994 ,3436,0)
	3132	HMP DATA V ERSION^VER SION^HMPD^ 1^S^^^^^^1
	3133	"KRN",8994 ,3436,1,0)
	3134	^^2^2^3110 613^
	3135	"KRN",8994 ,3436,1,1, 0)
	3136	This RPC r eturns the current v ersion of the XML re turned by the RPC
	3137	"KRN",8994 ,3436,1,2, 0)
	3138	'HMP GET P ATIENT DAT A.'
	3139	"KRN",8994 ,3436,3,0)
	3140	^^2^2^3110 613^
	3141	"KRN",8994 ,3436,3,1, 0)
	3142	A string i dentifying the versi on of the HMP data e xtracts an d the
	3143	"KRN",8994 ,3436,3,2, 0)
	3144	resulting XML.
	3145	"KRN",8994 ,3437,-1)
	3146	0^3
	3147	"KRN",8994 ,3437,0)
	3148	HMP DELETE OBJECT^DE L^HMPDJ2^1 ^S^^^1^1^^ 1
	3149	"KRN",8994 ,3437,1,0)
	3150	^8994.01^2 ^2^3130103 ^^^^
	3151	"KRN",8994 ,3437,1,1, 0)
	3152	This RPC r eceives a Uid from t he client and delete s the obje ct from th e
	3153	"KRN",8994 ,3437,1,2, 0)
	3154	HMP Object file #800 000.11.
	3155	"KRN",8994 ,3437,2,0)
	3156	^8994.02A^ 2^1
	3157	"KRN",8994 ,3437,2,2, 0)
	3158	UID^1^100^ 1^1
	3159	"KRN",8994 ,3437,2,2, 1,0)
	3160	^8994.021^ 1^1^313010 3^^^^
	3161	"KRN",8994 ,3437,2,2, 1,1,0)
	3162	The Uid of the objec t being de leted.
	3163	"KRN",8994 ,3437,2,"B ","UID",2)
	3164
	3165	"KRN",8994 ,3437,2,"P ARAMSEQ",1 ,2)
	3166
	3167	"KRN",8994 ,3437,3,0)
	3168	^8994.03^1 ^1^3130103 ^^^^
	3169	"KRN",8994 ,3437,3,1, 0)
	3170	Text array formatted as JSON
	3171	"KRN",8994 ,3438,-1)
	3172	0^4
	3173	"KRN",8994 ,3438,0)
	3174	HMP DELETE ROSTER^DE LROS^HMPRO S3^1^S^^^^ 1.2
	3175	"KRN",8994 ,3438,1,0)
	3176	^^1^1^3151 208^
	3177	"KRN",8994 ,3438,1,1, 0)
	3178	Used to de lete an en try in the HMP ROSTE R file (#8 00001.2).
	3179	"KRN",8994 ,3438,2,0)
	3180	^8994.02A^ 1^1
	3181	"KRN",8994 ,3438,2,1, 0)
	3182	HMPIEN^1^1 00^1^1
	3183	"KRN",8994 ,3438,2,1, 1,0)
	3184	^8994.021^ 1^1^315120 8^^^^
	3185	"KRN",8994 ,3438,2,1, 1,1,0)
	3186	Roster IEN .
	3187	"KRN",8994 ,3438,2,"B ","HMPIEN" ,1)
	3188
	3189	"KRN",8994 ,3438,2,"B ","VPRIEN" ,1)
	3190
	3191	"KRN",8994 ,3438,2,"P ARAMSEQ",1 ,1)
	3192
	3193	"KRN",8994 ,3439,-1)
	3194	0^5
	3195	"KRN",8994 ,3439,0)
	3196	HMP GET CH ECKSUM^CHE CK^HMPDCRC ^4^S^^^0^1 ^^1
	3197	"KRN",8994 ,3439,1,0)
	3198	^^1^1^3141 016^
	3199	"KRN",8994 ,3439,1,1, 0)
	3200	This RPC r etrieves t he request ed data fr om VistA a nd returns its check sum.
	3201	"KRN",8994 ,3439,2,0)
	3202	^8994.02A^ 1^1
	3203	"KRN",8994 ,3439,2,1, 0)
	3204	FILTER^2^^ 0^1
	3205	"KRN",8994 ,3439,2,1, 1,0)
	3206	^^1^1^3141 016^
	3207	"KRN",8994 ,3439,2,1, 1,1,0)
	3208	List of na me-value p airs defin ing the se arch.
	3209	"KRN",8994 ,3439,2,"B ","FILTER" ,1)
	3210
	3211	"KRN",8994 ,3439,2,"P ARAMSEQ",1 ,1)
	3212
	3213	"KRN",8994 ,3439,3,0)
	3214	^^1^1^3141 016^
	3215	"KRN",8994 ,3439,3,1, 0)
	3216	The CRC32 checksum v alue of th e data.
	3217	"KRN",8994 ,3440,-1)
	3218	0^6
	3219	"KRN",8994 ,3440,0)
	3220	HMP GET OB JECT^GET^H MPDJ2^4^S^ ^^0^1^^1
	3221	"KRN",8994 ,3440,1,0)
	3222	^8994.01^2 ^2^3121219 ^^^^
	3223	"KRN",8994 ,3440,1,1, 0)
	3224	This RPC r etrieves t he request ed data fr om VistA, and return s it in
	3225	"KRN",8994 ,3440,1,2, 0)
	3226	^TMP("HMP" ,$J,n) as JSON.
	3227	"KRN",8994 ,3440,2,0)
	3228	^8994.02A^ 1^1
	3229	"KRN",8994 ,3440,2,1, 0)
	3230	FILTER^2^^ 0^1
	3231	"KRN",8994 ,3440,2,1, 1,0)
	3232	^8994.021^ 1^1^312121 9^^^^
	3233	"KRN",8994 ,3440,2,1, 1,1,0)
	3234	List of na me-value p airs defin ing the se arch.
	3235	"KRN",8994 ,3440,2,"B ","FILTER" ,1)
	3236
	3237	"KRN",8994 ,3440,2,"P ARAMSEQ",1 ,1)
	3238
	3239	"KRN",8994 ,3440,3,0)
	3240	^8994.03^1 ^1^3121219 ^^^^
	3241	"KRN",8994 ,3440,3,1, 0)
	3242	Text array formatted as JSON
	3243	"KRN",8994 ,3441,-1)
	3244	0^7
	3245	"KRN",8994 ,3441,0)
	3246	HMP GET OP ERATIONAL DATA^GET^H MPEF^4^S^^ ^0^1^^1
	3247	"KRN",8994 ,3441,1,0)
	3248	^8994.01^2 ^2^3140929 ^^^^
	3249	"KRN",8994 ,3441,1,1, 0)
	3250	This RPC r etrieves t he request ed data fr om VistA, and return s it in
	3251	"KRN",8994 ,3441,1,2, 0)
	3252	^TMP("HMP" ,$J,n) as JSON.
	3253	"KRN",8994 ,3441,2,0)
	3254	^8994.02A^ 1^1
	3255	"KRN",8994 ,3441,2,1, 0)
	3256	FILTER^2^^ 0^1
	3257	"KRN",8994 ,3441,2,1, 1,0)
	3258	^8994.021^ 1^1^314092 9^^^^
	3259	"KRN",8994 ,3441,2,1, 1,1,0)
	3260	List of na me-value p airs defin ing the se arch.
	3261	"KRN",8994 ,3441,2,"B ","FILTER" ,1)
	3262
	3263	"KRN",8994 ,3441,2,"P ARAMSEQ",1 ,1)
	3264
	3265	"KRN",8994 ,3441,3,0)
	3266	^8994.03^1 ^1^3140929 ^^^^
	3267	"KRN",8994 ,3441,3,1, 0)
	3268	Text array formatted as JSON
	3269	"KRN",8994 ,3442,-1)
	3270	0^8
	3271	"KRN",8994 ,3442,0)
	3272	HMP GET PA TIENT DATA ^GET^HMPD^ 4^S^^^1^1^ ^1
	3273	"KRN",8994 ,3442,1,0)
	3274	^8994.01^2 ^2^3110606 ^^^^
	3275	"KRN",8994 ,3442,1,1, 0)
	3276	This RPC r etrieves t he request ed data fr om VistA, and return s it in
	3277	"KRN",8994 ,3442,1,2, 0)
	3278	^TMP("HMP" ,$J,n) as XML.
	3279	"KRN",8994 ,3442,2,0)
	3280	^8994.02A^ 7^7
	3281	"KRN",8994 ,3442,2,1, 0)
	3282	DFN^1^20^1 ^1
	3283	"KRN",8994 ,3442,2,1, 1,0)
	3284	^8994.021^ 2^2^310020 3^^
	3285	"KRN",8994 ,3442,2,1, 1,1,0)
	3286	Internal e ntry numbe r from Pat ient file #2
	3287	"KRN",8994 ,3442,2,1, 1,2,0)
	3288	[optionall y DFN;ICN for remote calls]
	3289	"KRN",8994 ,3442,2,2, 0)
	3290	TYPE^1^100 ^0^2
	3291	"KRN",8994 ,3442,2,2, 1,0)
	3292	^8994.021^ 4^4^311060 6^^^
	3293	"KRN",8994 ,3442,2,2, 1,1,0)
	3294	The kind(s ) of data to return, which may include:
	3295	"KRN",8994 ,3442,2,2, 1,2,0)
	3296	demograp hics;react ions;probl ems;vitals ;labs;meds ;
	3297	"KRN",8994 ,3442,2,2, 1,3,0)
	3298	immuniza tions;visi ts;appoint ments;docu ments;
	3299	"KRN",8994 ,3442,2,2, 1,4,0)
	3300	procedur es;consult s
	3301	"KRN",8994 ,3442,2,3, 0)
	3302	START^1^20 ^0^3
	3303	"KRN",8994 ,3442,2,3, 1,0)
	3304	^8994.021^ 1^1^310020 3^^
	3305	"KRN",8994 ,3442,2,3, 1,1,0)
	3306	The date/t ime from w hich to be gin search ing for da ta [option al].
	3307	"KRN",8994 ,3442,2,4, 0)
	3308	STOP^1^20^ 0^4
	3309	"KRN",8994 ,3442,2,4, 1,0)
	3310	^8994.021^ 1^1^310020 3^^
	3311	"KRN",8994 ,3442,2,4, 1,1,0)
	3312	The date/t ime at whi ch to end searching for data [ optional].
	3313	"KRN",8994 ,3442,2,5, 0)
	3314	MAX^1^7^0^ 5
	3315	"KRN",8994 ,3442,2,5, 1,0)
	3316	^8994.021^ 1^1^310020 3^^
	3317	"KRN",8994 ,3442,2,5, 1,1,0)
	3318	The maximu m number o f items to return pe r data typ e [optiona l].
	3319	"KRN",8994 ,3442,2,6, 0)
	3320	ITEM^1^30^ 0^6
	3321	"KRN",8994 ,3442,2,6, 1,0)
	3322	^8994.021^ 2^2^310032 9^^^
	3323	"KRN",8994 ,3442,2,6, 1,1,0)
	3324	The identi fier of a single ite m to retur n [optiona l, but TYP E must
	3325	"KRN",8994 ,3442,2,6, 1,2,0)
	3326	also be de fined when used].
	3327	"KRN",8994 ,3442,2,7, 0)
	3328	FILTER^2^^ 0^7
	3329	"KRN",8994 ,3442,2,7, 1,0)
	3330	^8994.021^ 1^1^311060 6^^^^
	3331	"KRN",8994 ,3442,2,7, 1,1,0)
	3332	List of na me-value p airs, furt her refini ng the sea rch.
	3333	"KRN",8994 ,3442,2,"B ","DFN",1)
	3334
	3335	"KRN",8994 ,3442,2,"B ","FILTER" ,7)
	3336
	3337	"KRN",8994 ,3442,2,"B ","ITEM",6 )
	3338
	3339	"KRN",8994 ,3442,2,"B ","MAX",5)
	3340
	3341	"KRN",8994 ,3442,2,"B ","START", 3)
	3342
	3343	"KRN",8994 ,3442,2,"B ","STOP",4 )
	3344
	3345	"KRN",8994 ,3442,2,"B ","TYPE",2 )
	3346
	3347	"KRN",8994 ,3442,2,"P ARAMSEQ",1 ,1)
	3348
	3349	"KRN",8994 ,3442,2,"P ARAMSEQ",2 ,2)
	3350
	3351	"KRN",8994 ,3442,2,"P ARAMSEQ",3 ,3)
	3352
	3353	"KRN",8994 ,3442,2,"P ARAMSEQ",4 ,4)
	3354
	3355	"KRN",8994 ,3442,2,"P ARAMSEQ",5 ,5)
	3356
	3357	"KRN",8994 ,3442,2,"P ARAMSEQ",6 ,6)
	3358
	3359	"KRN",8994 ,3442,2,"P ARAMSEQ",7 ,7)
	3360
	3361	"KRN",8994 ,3442,3,0)
	3362	^8994.03^1 ^1^3110606 ^^^^
	3363	"KRN",8994 ,3442,3,1, 0)
	3364	Text array formatted as XML
	3365	"KRN",8994 ,3443,-1)
	3366	0^9
	3367	"KRN",8994 ,3443,0)
	3368	HMP GET PA TIENT DATA JSON^GET^ HMPDJ^4^S^ ^^0^1^^1
	3369	"KRN",8994 ,3443,1,0)
	3370	^8994.01^2 ^2^3131209 ^^^^
	3371	"KRN",8994 ,3443,1,1, 0)
	3372	This RPC r etrieves t he request ed data fr om VistA, and return s it in
	3373	"KRN",8994 ,3443,1,2, 0)
	3374	^TMP("HMP" ,$J,n) as JSON.
	3375	"KRN",8994 ,3443,2,0)
	3376	^8994.02A^ 1^1
	3377	"KRN",8994 ,3443,2,1, 0)
	3378	FILTER^2^^ 0^1
	3379	"KRN",8994 ,3443,2,1, 1,0)
	3380	^8994.021^ 1^1^313120 9^^^^
	3381	"KRN",8994 ,3443,2,1, 1,1,0)
	3382	List of na me-value p airs defin ing the se arch.
	3383	"KRN",8994 ,3443,2,"B ","FILTER" ,1)
	3384
	3385	"KRN",8994 ,3443,2,"P ARAMSEQ",1 ,1)
	3386
	3387	"KRN",8994 ,3443,3,0)
	3388	^8994.03^1 ^1^3131209 ^^^^
	3389	"KRN",8994 ,3443,3,1, 0)
	3390	Text array formatted as JSON
	3391	"KRN",8994 ,3444,-1)
	3392	0^10
	3393	"KRN",8994 ,3444,0)
	3394	HMP GET RE FERENCE DA TA^GET^HMP EF^4^S^^^0 ^1^^1
	3395	"KRN",8994 ,3444,1,0)
	3396	^^2^2^3131 105
	3397	"KRN",8994 ,3444,1,1, 0)
	3398	This RPC r etrieves t he request ed data fr om VistA, and return s it in
	3399	"KRN",8994 ,3444,1,2, 0)
	3400	^TMP("HMP" ,$J,n) as JSON.
	3401	"KRN",8994 ,3444,2,0)
	3402	^8994.02A^ 1^1
	3403	"KRN",8994 ,3444,2,1, 0)
	3404	FILTER^2^^ 0^1
	3405	"KRN",8994 ,3444,2,1, 1,0)
	3406	^^1^1^3131 105
	3407	"KRN",8994 ,3444,2,1, 1,1,0)
	3408	List of na me-value p airs defin ing the se arch.
	3409	"KRN",8994 ,3444,2,"B ","FILTER" ,1)
	3410
	3411	"KRN",8994 ,3444,2,"P ARAMSEQ",1 ,1)
	3412
	3413	"KRN",8994 ,3444,3,0)
	3414	^^1^1^3131 105
	3415	"KRN",8994 ,3444,3,1, 0)
	3416	Text array formatted as JSON
	3417	"KRN",8994 ,3445,-1)
	3418	0^11
	3419	"KRN",8994 ,3445,0)
	3420	HMP GET RO STER LIST^ GET^HMPROS 7^4^S^^^^1 ^^1
	3421	"KRN",8994 ,3445,1,0)
	3422	^8994.01^2 ^2^3151208 ^^^^
	3423	"KRN",8994 ,3445,1,1, 0)
	3424	Patient id entificati on data pa ssed in an d roster i dentificat ion return ed.
	3425	"KRN",8994 ,3445,1,2, 0)
	3426	List will contain al l rosters associated with pati ent.
	3427	"KRN",8994 ,3445,2,0)
	3428	^8994.02A^ 2^2
	3429	"KRN",8994 ,3445,2,1, 0)
	3430	HMP^2^3200 ^1^1
	3431	"KRN",8994 ,3445,2,1, 1,0)
	3432	^^1^1^3151 208^
	3433	"KRN",8994 ,3445,2,1, 1,1,0)
	3434	This is th e returned result. It is a li teral valu e.
	3435	"KRN",8994 ,3445,2,2, 0)
	3436	HMPARRAY^2 ^3200^1^1
	3437	"KRN",8994 ,3445,2,2, 1,0)
	3438	^8994.021^ 2^2^315120 8^^
	3439	"KRN",8994 ,3445,2,2, 1,1,0)
	3440	This is th e input ar ray of the roster da ta that wa s entered through th e
	3441	"KRN",8994 ,3445,2,2, 1,2,0)
	3442	GUI.
	3443	"KRN",8994 ,3445,2,"B ","HMP",1)
	3444
	3445	"KRN",8994 ,3445,2,"B ","HMPARRA Y",2)
	3446
	3447	"KRN",8994 ,3445,2,"B ","VPR",1)
	3448
	3449	"KRN",8994 ,3445,2,"B ","VPRARRA Y",2)
	3450
	3451	"KRN",8994 ,3445,2,"P ARAMSEQ",1 ,1)
	3452
	3453	"KRN",8994 ,3445,2,"P ARAMSEQ",1 ,2)
	3454
	3455	"KRN",8994 ,3446,-1)
	3456	0^12
	3457	"KRN",8994 ,3446,0)
	3458	HMP GET SO URCE^GETSR C^HMPROS4^ 4^S^^^1^1^ ^1
	3459	"KRN",8994 ,3446,1,0)
	3460	^8994.01^2 ^2^3150923 ^^^
	3461	"KRN",8994 ,3446,1,1, 0)
	3462	Get all so urce infor mation for requested source. For exampl e, Request is for Cl inics. Tr ansmit all active cl inics
	3463	"KRN",8994 ,3446,1,2, 0)
	3464	include na me and IEN 's.
	3465	"KRN",8994 ,3446,2,0)
	3466	^8994.02A^ 2^2
	3467	"KRN",8994 ,3446,2,1, 0)
	3468	HMPSRC^1^3 0^1^1
	3469	"KRN",8994 ,3446,2,1, 1,0)
	3470	^^1^1^3111 031^
	3471	"KRN",8994 ,3446,2,1, 1,1,0)
	3472	Identifies which sou rce inform ation to s end to the GUI.
	3473	"KRN",8994 ,3446,2,2, 0)
	3474	HMPFILT^1^ 30^0^2
	3475	"KRN",8994 ,3446,2,2, 1,0)
	3476	^8994.021^ 1^1^311110 3^^
	3477	"KRN",8994 ,3446,2,2, 1,1,0)
	3478	Text ident ifying wha t you are looking fo r. Will b e used whe n matching for detai ls.
	3479	"KRN",8994 ,3446,2,"B ","HMPFILT ",2)
	3480
	3481	"KRN",8994 ,3446,2,"B ","HMPSRC" ,1)
	3482
	3483	"KRN",8994 ,3446,2,"B ","VPRFILT ",2)
	3484
	3485	"KRN",8994 ,3446,2,"B ","VPRSRC" ,1)
	3486
	3487	"KRN",8994 ,3446,2,"P ARAMSEQ",1 ,1)
	3488
	3489	"KRN",8994 ,3446,2,"P ARAMSEQ",2 ,2)
	3490
	3491	"KRN",8994 ,3446,3,0)
	3492	^8994.03^1 ^1^3111101 ^^
	3493	"KRN",8994 ,3446,3,1, 0)
	3494	An array c ontaining names and ien's of s ource data .
	3495	"KRN",8994 ,3447,-1)
	3496	0^13
	3497	"KRN",8994 ,3447,0)
	3498	HMP INPATI ENTS^IN^HM PPATS^4^S^ ^^1^^^1
	3499	"KRN",8994 ,3447,1,0)
	3500	^8994.01^2 ^2^3101129 ^^^
	3501	"KRN",8994 ,3447,1,1, 0)
	3502	This RPC f inds a lis t of patie nts that a re current ly admitte d,
	3503	"KRN",8994 ,3447,1,2, 0)
	3504	as XML in ^TMP($J,"H MP",n).
	3505	"KRN",8994 ,3447,3,0)
	3506	^8994.03^1 ^1^3101129 ^^^
	3507	"KRN",8994 ,3447,3,1, 0)
	3508	Text array formatted XML
	3509	"KRN",8994 ,3448,-1)
	3510	0^15
	3511	"KRN",8994 ,3448,0)
	3512	HMP PREVIE W ROSTER^P REVIEW^HMP ROS3^4^S^^ ^1^1^^1
	3513	"KRN",8994 ,3448,1,0)
	3514	^8994.01^1 ^1^3120131 ^^^^
	3515	"KRN",8994 ,3448,1,1, 0)
	3516	Compiles R oster base d on data passed fro m GUI Inte rface.
	3517	"KRN",8994 ,3448,2,0)
	3518	^8994.02A^ 1^1
	3519	"KRN",8994 ,3448,2,1, 0)
	3520	HMPARRAY^2 ^32000^1^1
	3521	"KRN",8994 ,3448,2,1, 1,0)
	3522	^8994.021^ 1^1^311102 2^^^^
	3523	"KRN",8994 ,3448,2,1, 1,1,0)
	3524	Roster dat a from GUI .
	3525	"KRN",8994 ,3448,2,"B ","HMPARRA Y",1)
	3526
	3527	"KRN",8994 ,3448,2,"B ","VPRARRA Y",1)
	3528
	3529	"KRN",8994 ,3448,2,"P ARAMSEQ",1 ,1)
	3530
	3531	"KRN",8994 ,3448,3,0)
	3532	^8994.03^1 ^1^3111022 ^^^^
	3533	"KRN",8994 ,3448,3,1, 0)
	3534	XML format ted Roster .
	3535	"KRN",8994 ,3449,-1)
	3536	0^16
	3537	"KRN",8994 ,3449,0)
	3538	HMP PUT DE MOGRAPHICS ^PUT^HMPUP D^4^S^^^0^ 1^^1
	3539	"KRN",8994 ,3449,1,0)
	3540	^8994.01^2 ^2^3131119 ^^
	3541	"KRN",8994 ,3449,1,1, 0)
	3542	This RPC r eceives up dated phon e numbers from the c lient and calls
	3543	"KRN",8994 ,3449,1,2, 0)
	3544	VAFCPTED t o save the m in the P atient fil e #2.
	3545	"KRN",8994 ,3449,2,0)
	3546	^8994.02A^ 3^3
	3547	"KRN",8994 ,3449,2,1, 0)
	3548	OBJECT^3^^ ^3
	3549	"KRN",8994 ,3449,2,1, 1,0)
	3550	^8994.021^ 1^1^313112 0^^^
	3551	"KRN",8994 ,3449,2,1, 1,1,0)
	3552	The data, as a JSON object
	3553	"KRN",8994 ,3449,2,2, 0)
	3554	COMMAND^1^ ^^2
	3555	"KRN",8994 ,3449,2,2, 1,0)
	3556	^8994.021^ 1^1^313112 0^^
	3557	"KRN",8994 ,3449,2,2, 1,1,0)
	3558	The action to take o n the obje ct in Vist A
	3559	"KRN",8994 ,3449,2,3, 0)
	3560	PATIENT^1^ ^^1
	3561	"KRN",8994 ,3449,2,3, 1,0)
	3562	^^1^1^3131 120^
	3563	"KRN",8994 ,3449,2,3, 1,1,0)
	3564	Patient fi le #2 ien
	3565	"KRN",8994 ,3449,2,"B ","COMMAND ",2)
	3566
	3567	"KRN",8994 ,3449,2,"B ","OBJECT" ,1)
	3568
	3569	"KRN",8994 ,3449,2,"B ","PATIENT ",3)
	3570
	3571	"KRN",8994 ,3449,2,"P ARAMSEQ",1 ,3)
	3572
	3573	"KRN",8994 ,3449,2,"P ARAMSEQ",2 ,2)
	3574
	3575	"KRN",8994 ,3449,2,"P ARAMSEQ",3 ,1)
	3576
	3577	"KRN",8994 ,3449,3,0)
	3578	^8994.03^1 ^1^3131120 ^^^^
	3579	"KRN",8994 ,3449,3,1, 0)
	3580	Text array formatted as JSON
	3581	"KRN",8994 ,3450,-1)
	3582	0^17
	3583	"KRN",8994 ,3450,0)
	3584	HMP PUT OB JECT^PUT^H MPDJ2^1^S^ ^^1^1^^1
	3585	"KRN",8994 ,3450,1,0)
	3586	^8994.01^2 ^2^3131216 ^^^^
	3587	"KRN",8994 ,3450,1,1, 0)
	3588	This RPC r eceives da ta from th e client a nd saves i t in the H MP Object
	3589	"KRN",8994 ,3450,1,2, 0)
	3590	file #8000 00.11 as J SON.
	3591	"KRN",8994 ,3450,2,0)
	3592	^8994.02A^ 3^2
	3593	"KRN",8994 ,3450,2,2, 0)
	3594	TYPE^1^100 ^0^1
	3595	"KRN",8994 ,3450,2,2, 1,0)
	3596	^8994.021^ 1^1^312112 9^^^^
	3597	"KRN",8994 ,3450,2,2, 1,1,0)
	3598	The kind o f data bei ng stored.
	3599	"KRN",8994 ,3450,2,3, 0)
	3600	OBJECT^3^^ 0^2
	3601	"KRN",8994 ,3450,2,3, 1,0)
	3602	^8994.021^ 1^1^312112 9^^^^
	3603	"KRN",8994 ,3450,2,3, 1,1,0)
	3604	The conten t of the o bject, as JSON
	3605	"KRN",8994 ,3450,2,"B ","OBJECT" ,3)
	3606
	3607	"KRN",8994 ,3450,2,"B ","TYPE",2 )
	3608
	3609	"KRN",8994 ,3450,2,"P ARAMSEQ",1 ,2)
	3610
	3611	"KRN",8994 ,3450,2,"P ARAMSEQ",2 ,3)
	3612
	3613	"KRN",8994 ,3450,3,0)
	3614	^8994.03^1 ^1^3121129 ^^^^
	3615	"KRN",8994 ,3450,3,1, 0)
	3616	Text array formatted as JSON
	3617	"KRN",8994 ,3451,-1)
	3618	0^18
	3619	"KRN",8994 ,3451,0)
	3620	HMP PUT PA TIENT DATA ^PUT^HMPDJ 1^1^S^^^1^ 1^^1
	3621	"KRN",8994 ,3451,1,0)
	3622	^8994.01^2 ^2^3121129 ^^^^
	3623	"KRN",8994 ,3451,1,1, 0)
	3624	This RPC r eceives da ta from th e client a nd saves i t in the H MP Patient
	3625	"KRN",8994 ,3451,1,2, 0)
	3626	Object fil e #800000. 1 as JSON.
	3627	"KRN",8994 ,3451,2,0)
	3628	^8994.02A^ 3^3
	3629	"KRN",8994 ,3451,2,1, 0)
	3630	DFN^1^20^1 ^1
	3631	"KRN",8994 ,3451,2,1, 1,0)
	3632	^8994.021^ 2^2^312101 0^^^
	3633	"KRN",8994 ,3451,2,1, 1,1,0)
	3634	Internal e ntry numbe r from Pat ient file #2
	3635	"KRN",8994 ,3451,2,1, 1,2,0)
	3636	[optionall y DFN;ICN for remote calls]
	3637	"KRN",8994 ,3451,2,2, 0)
	3638	TYPE^1^100 ^0^2
	3639	"KRN",8994 ,3451,2,2, 1,0)
	3640	^8994.021^ 1^1^312101 0^^^^
	3641	"KRN",8994 ,3451,2,2, 1,1,0)
	3642	The kind o f data bei ng stored.
	3643	"KRN",8994 ,3451,2,3, 0)
	3644	OBJECT^3^^ 0^3
	3645	"KRN",8994 ,3451,2,3, 1,0)
	3646	^8994.021^ 1^1^312112 9^^^^
	3647	"KRN",8994 ,3451,2,3, 1,1,0)
	3648	The conten t of the o bject, as JSON
	3649	"KRN",8994 ,3451,2,"B ","DFN",1)
	3650
	3651	"KRN",8994 ,3451,2,"B ","OBJECT" ,3)
	3652
	3653	"KRN",8994 ,3451,2,"B ","TYPE",2 )
	3654
	3655	"KRN",8994 ,3451,2,"P ARAMSEQ",1 ,1)
	3656
	3657	"KRN",8994 ,3451,2,"P ARAMSEQ",2 ,2)
	3658
	3659	"KRN",8994 ,3451,2,"P ARAMSEQ",3 ,3)
	3660
	3661	"KRN",8994 ,3451,3,0)
	3662	^8994.03^1 ^1^3121129 ^^^^
	3663	"KRN",8994 ,3451,3,1, 0)
	3664	Text array formatted as JSON
	3665	"KRN",8994 ,3452,-1)
	3666	0^19
	3667	"KRN",8994 ,3452,0)
	3668	HMP ROSTER PATIENTS^ COMPILE^HM PROS2^4^S^ ^^1^1^^1
	3669	"KRN",8994 ,3452,1,0)
	3670	^8994.01^1 ^1^3150923 ^^^^
	3671	"KRN",8994 ,3452,1,1, 0)
	3672	Provides p atients as sociated w ith reques ted Roster .
	3673	"KRN",8994 ,3452,2,0)
	3674	^8994.02A^ 2^2
	3675	"KRN",8994 ,3452,2,1, 0)
	3676	ROSTER^1^1 5^0^1
	3677	"KRN",8994 ,3452,2,1, 1,0)
	3678	^8994.021^ 1^1^312010 5^^^^
	3679	"KRN",8994 ,3452,2,1, 1,1,0)
	3680	IEN of Ros ter you ar e requesti ng patient s for.
	3681	"KRN",8994 ,3452,2,2, 0)
	3682	OWNER^1^15 ^0^2
	3683	"KRN",8994 ,3452,2,2, 1,0)
	3684	^8994.021^ 1^1^315092 3^^^^
	3685	"KRN",8994 ,3452,2,2, 1,1,0)
	3686	Compile al l rosters for this o wner.
	3687	"KRN",8994 ,3452,2,"B ","OWNER", 2)
	3688
	3689	"KRN",8994 ,3452,2,"B ","ROSTER" ,1)
	3690
	3691	"KRN",8994 ,3452,2,"P ARAMSEQ",1 ,1)
	3692
	3693	"KRN",8994 ,3452,2,"P ARAMSEQ",2 ,2)
	3694
	3695	"KRN",8994 ,3452,3,0)
	3696	^8994.03^1 ^1^3150923 ^^^^
	3697	"KRN",8994 ,3452,3,1, 0)
	3698	Text array formatted XML.
	3699	"KRN",8994 ,3453,-1)
	3700	0^20
	3701	"KRN",8994 ,3453,0)
	3702	HMP ROSTER S^GETROS^H MPROS2^4^S ^^^1^1^^1
	3703	"KRN",8994 ,3453,1,0)
	3704	^8994.01^1 ^1^3111110 ^^^^
	3705	"KRN",8994 ,3453,1,1, 0)
	3706	Creates XM L list of all Roster s.
	3707	"KRN",8994 ,3453,2,0)
	3708	^8994.02A^ 1^1
	3709	"KRN",8994 ,3453,2,1, 0)
	3710	HMPFILT^1^ 30^0^1
	3711	"KRN",8994 ,3453,2,1, 1,0)
	3712	^8994.021^ 1^1^311111 0^^
	3713	"KRN",8994 ,3453,2,1, 1,1,0)
	3714	Filter ros ters if fi lter not n ull.
	3715	"KRN",8994 ,3453,2,"B ","HMPFILT ",1)
	3716
	3717	"KRN",8994 ,3453,2,"B ","VPRFILT ",1)
	3718
	3719	"KRN",8994 ,3453,2,"P ARAMSEQ",1 ,1)
	3720
	3721	"KRN",8994 ,3453,3,0)
	3722	^8994.03^1 ^1^3111110 ^^^^
	3723	"KRN",8994 ,3453,3,1, 0)
	3724	Text array formatted in XML.
	3725	"KRN",8994 ,3454,-1)
	3726	0^21
	3727	"KRN",8994 ,3454,0)
	3728	HMP SUBSCR IBE^SUBS^H MPPATS^4^S ^^^1^^^1
	3729	"KRN",8994 ,3454,1,0)
	3730	^8994.01^3 ^3^3141006 ^^^^
	3731	"KRN",8994 ,3454,1,1, 0)
	3732	This RPC w ill mainta in a list of patient s & events to monito r for new data.
	3733	"KRN",8994 ,3454,1,2, 0)
	3734	The LIST o f patients passed in to this RP C is retur ned in ^TM P($J,"HMP" ,n)
	3735	"KRN",8994 ,3454,1,3, 0)
	3736	as XML, wi th a subsc ription st atus of 'o n', 'off', or 'error '.
	3737	"KRN",8994 ,3454,2,0)
	3738	^8994.02A^ 3^3
	3739	"KRN",8994 ,3454,2,1, 0)
	3740	SYS^1^^0^1
	3741	"KRN",8994 ,3454,2,1, 1,0)
	3742	^8994.021^ 3^3^313041 7^^^^
	3743	"KRN",8994 ,3454,2,1, 1,1,0)
	3744	This is th e name of the system calling t he RPC; it is used t o create
	3745	"KRN",8994 ,3454,2,1, 1,2,0)
	3746	an entry i n the HMP SUBSCRIPTI ON file, a nd link a system to a list of
	3747	"KRN",8994 ,3454,2,1, 1,3,0)
	3748	patients a nd/or even ts.
	3749	"KRN",8994 ,3454,2,2, 0)
	3750	LIST^2^^0^ 3
	3751	"KRN",8994 ,3454,2,2, 1,0)
	3752	^8994.021^ 2^2^311031 0^^^
	3753	"KRN",8994 ,3454,2,2, 1,1,0)
	3754	This is th e list of patient id entifiers, in the fo rm 'dfn;ic n', that
	3755	"KRN",8994 ,3454,2,2, 1,2,0)
	3756	are to be either add ed to or r emoved fro m the moni tor.
	3757	"KRN",8994 ,3454,2,3, 0)
	3758	STS^1^^0^2
	3759	"KRN",8994 ,3454,2,3, 1,0)
	3760	^^2^2^3110 310^
	3761	"KRN",8994 ,3454,2,3, 1,1,0)
	3762	This is a boolean va lue, 1 or 0, indicat ing if the patient s hould be
	3763	"KRN",8994 ,3454,2,3, 1,2,0)
	3764	added to o r removed from the d ata monito r.
	3765	"KRN",8994 ,3454,2,"B ","LIST",2 )
	3766
	3767	"KRN",8994 ,3454,2,"B ","STS",3)
	3768
	3769	"KRN",8994 ,3454,2,"B ","SYS",1)
	3770
	3771	"KRN",8994 ,3454,2,"P ARAMSEQ",1 ,1)
	3772
	3773	"KRN",8994 ,3454,2,"P ARAMSEQ",2 ,3)
	3774
	3775	"KRN",8994 ,3454,2,"P ARAMSEQ",3 ,2)
	3776
	3777	"KRN",8994 ,3454,3,0)
	3778	^8994.03^1 ^1^3141006 ^^^^
	3779	"KRN",8994 ,3454,3,1, 0)
	3780	Text array formatted as XML.
	3781	"KRN",8994 ,3455,-1)
	3782	0^22
	3783	"KRN",8994 ,3455,0)
	3784	HMP SUBSCR IBE ROSTER S^SUBS^HMP ROS7^4^S^^ ^1^^^1
	3785	"KRN",8994 ,3455,1,0)
	3786	^8994.01^3 ^3^3130417 ^^^^
	3787	"KRN",8994 ,3455,1,1, 0)
	3788	This RPC w ill mainta in a list of rosters to monito r for new patients.
	3789	"KRN",8994 ,3455,1,2, 0)
	3790	The LIST o f rosters passed int o this RPC is return ed in ^TMP ($J,"HMP", n)
	3791	"KRN",8994 ,3455,1,3, 0)
	3792	as XML, wi th a subsc ription st atus of 'o n', 'off', or 'error '.
	3793	"KRN",8994 ,3455,2,0)
	3794	^8994.02A^ 3^3
	3795	"KRN",8994 ,3455,2,1, 0)
	3796	SYS^1^^0^1
	3797	"KRN",8994 ,3455,2,1, 1,0)
	3798	^8994.021^ 3^3^313041 7^^^^
	3799	"KRN",8994 ,3455,2,1, 1,1,0)
	3800	This is th e name of the system calling t he RPC; it is used t o create
	3801	"KRN",8994 ,3455,2,1, 1,2,0)
	3802	an entry i n the HMP SUBSCRIPTI ON file, a nd link a system to a list of
	3803	"KRN",8994 ,3455,2,1, 1,3,0)
	3804	rosters.
	3805	"KRN",8994 ,3455,2,2, 0)
	3806	LIST^2^^0^ 3
	3807	"KRN",8994 ,3455,2,2, 1,0)
	3808	^8994.021^ 2^2^313041 7^^^^
	3809	"KRN",8994 ,3455,2,2, 1,1,0)
	3810	This is th e list of roster ide ntifiers t hat are to be either added to or
	3811	"KRN",8994 ,3455,2,2, 1,2,0)
	3812	removed fr om the mon itor.
	3813	"KRN",8994 ,3455,2,3, 0)
	3814	STS^1^^0^2
	3815	"KRN",8994 ,3455,2,3, 1,0)
	3816	^8994.021^ 2^2^313041 7^^
	3817	"KRN",8994 ,3455,2,3, 1,1,0)
	3818	This is a boolean va lue, 1 or 0, indicat ing if the roster sh ould be
	3819	"KRN",8994 ,3455,2,3, 1,2,0)
	3820	added to o r removed from the d ata monito r.
	3821	"KRN",8994 ,3455,2,"B ","LIST",2 )
	3822
	3823	"KRN",8994 ,3455,2,"B ","STS",3)
	3824
	3825	"KRN",8994 ,3455,2,"B ","SYS",1)
	3826
	3827	"KRN",8994 ,3455,2,"P ARAMSEQ",1 ,1)
	3828
	3829	"KRN",8994 ,3455,2,"P ARAMSEQ",2 ,3)
	3830
	3831	"KRN",8994 ,3455,2,"P ARAMSEQ",3 ,2)
	3832
	3833	"KRN",8994 ,3455,3,0)
	3834	^8994.03^1 ^1^3130417 ^^^^
	3835	"KRN",8994 ,3455,3,1, 0)
	3836	Text array formatted as XML.
	3837	"KRN",8994 ,3456,-1)
	3838	0^23
	3839	"KRN",8994 ,3456,0)
	3840	HMP UPDATE ROSTER^UP DATE^HMPRO S3^4^S^^^1 ^1^^1
	3841	"KRN",8994 ,3456,1,0)
	3842	^8994.01^1 ^1^3151208 ^^^^
	3843	"KRN",8994 ,3456,1,1, 0)
	3844	Updates ro ster data edited by GUI into V istA.
	3845	"KRN",8994 ,3456,2,0)
	3846	^8994.02A^ 1^1
	3847	"KRN",8994 ,3456,2,1, 0)
	3848	HMPARRAY^2 ^32000^1^1
	3849	"KRN",8994 ,3456,2,1, 1,0)
	3850	^^3^3^3151 208^
	3851	"KRN",8994 ,3456,2,1, 1,1,0)
	3852	This is th e array of input dat a used to update the roster en try in the
	3853	"KRN",8994 ,3456,2,1, 1,2,0)
	3854	HMP ROSTER file (#80 0001.2).
	3855	"KRN",8994 ,3456,2,1, 1,3,0)
	3856	It's forma lly struct ured and i s required .
	3857	"KRN",8994 ,3456,2,"B ","HMPARRA Y",1)
	3858
	3859	"KRN",8994 ,3456,2,"B ","VPRARRA Y",1)
	3860
	3861	"KRN",8994 ,3456,2,"P ARAMSEQ",1 ,1)
	3862
	3863	"KRN",8994 ,3457,-1)
	3864	0^24
	3865	"KRN",8994 ,3457,0)
	3866	HMP WRITEB ACK PT DEM ^FILE^HMPP TDEM^2^S^^ ^0^1^^1
	3867	"KRN",8994 ,3457,1,0)
	3868	^8994.01^1 ^1^3141015 ^^
	3869	"KRN",8994 ,3457,1,1, 0)
	3870	This RPC t akes demog raphic dat a from an outside sy stem and f iles it in to the Pa tient File (#2)
	3871	"KRN",8994 ,3457,2,0)
	3872	^8994.02A^ 1^1
	3873	"KRN",8994 ,3457,2,1, 0)
	3874	FIL^1^3200 0^1^1
	3875	"KRN",8994 ,3457,2,1, 1,0)
	3876	^8994.021^ 1^1^314101 5^^
	3877	"KRN",8994 ,3457,2,1, 1,1,0)
	3878	"^" delimi ted set of data to b e filed in to the Pa tient File
	3879	"KRN",8994 ,3457,2,"B ","FIL",1)
	3880
	3881	"KRN",8994 ,3457,2,"P ARAMSEQ",1 ,1)
	3882
	3883	"KRN",8994 ,3457,3,0)
	3884	^8994.03^1 ^1^3141015 ^^
	3885	"KRN",8994 ,3457,3,1, 0)
	3886	Error or S uccess mes sage
	3887	"KRN",8994 ,3458,-1)
	3888	0^25
	3889	"KRN",8994 ,3458,0)
	3890	HMPCORD RP C^RPC^HMPC ORD^3^S^^^ 0
	3891	"KRN",8994 ,3458,1,0)
	3892	^8994.01^1 ^1^3151208 ^^
	3893	"KRN",8994 ,3458,1,1, 0)
	3894	USED TO RE TURN ORDER S INFORMAT ION
	3895	"KRN",8994 ,3458,2,0)
	3896	^8994.02A^ 1^1
	3897	"KRN",8994 ,3458,2,1, 0)
	3898	PARAMS^2^^ 1^1
	3899	"KRN",8994 ,3458,2,1, 1,0)
	3900	^^1^1^3151 208^
	3901	"KRN",8994 ,3458,2,1, 1,1,0)
	3902	This param eter is no longer us ed. It is kept for backwards compatibil ity.
	3903	"KRN",8994 ,3458,2,"B ","PARAMS" ,1)
	3904
	3905	"KRN",8994 ,3458,2,"P ARAMSEQ",1 ,1)
	3906
	3907	"KRN",8994 ,3459,-1)
	3908	0^26
	3909	"KRN",8994 ,3459,0)
	3910	HMPCPAT RP C^RPC^HMPC PAT^4^S
	3911	"KRN",8994 ,3459,1,0)
	3912	^8994.01^1 ^1^3151208 ^^^
	3913	"KRN",8994 ,3459,1,1, 0)
	3914	USED TO RE TURN PATIE NT INFORMA TION
	3915	"KRN",8994 ,3459,2,0)
	3916	^8994.02A^ 1^1
	3917	"KRN",8994 ,3459,2,1, 0)
	3918	PARAMS^2^^ 1^1
	3919	"KRN",8994 ,3459,2,1, 1,0)
	3920	^^1^1^3151 208^
	3921	"KRN",8994 ,3459,2,1, 1,1,0)
	3922	This value is no lon ger is use d. It rem ains for b ackwards c ompatibili ty.
	3923	"KRN",8994 ,3459,2,"B ","PARAMS" ,1)
	3924
	3925	"KRN",8994 ,3459,2,"P ARAMSEQ",1 ,1)
	3926
	3927	"KRN",8994 ,3460,-1)
	3928	0^27
	3929	"KRN",8994 ,3460,0)
	3930	HMPCPRS RP C^RPC^HMPC PRS^3^S^^^ 0
	3931	"KRN",8994 ,3460,1,0)
	3932	^^1^1^3150 812^
	3933	"KRN",8994 ,3460,1,1, 0)
	3934	USED TO RE TURN HEADE R INFORMAT ION TO MIM IC CPRS HE ADERS IN E HMP GUI
	3935	"KRN",8994 ,3460,2,0)
	3936	^8994.02A^ 1^1
	3937	"KRN",8994 ,3460,2,1, 0)
	3938	PARAMS^2^^ 1^1
	3939	"KRN",8994 ,3460,2,"B ","PARAMS" ,1)
	3940
	3941	"KRN",8994 ,3460,2,"P ARAMSEQ",1 ,1)
	3942
	3943	"KRN",8994 ,3461,-1)
	3944	0^28
	3945	"KRN",8994 ,3461,0)
	3946	HMPCRPC RP C^RPC^HMPC RPC^3^S^^^ 0
	3947	"KRN",8994 ,3461,1,0)
	3948	^8994.01^2 ^2^3151208 ^^^^
	3949	"KRN",8994 ,3461,1,1, 0)
	3950	This RPC i s used to save and g et data fr om all the HMP PARAM ETERS in a ll the
	3951	"KRN",8994 ,3461,1,2, 0)
	3952	all the HM P paramete r files.
	3953	"KRN",8994 ,3461,2,0)
	3954	^8994.02A^ 1^1
	3955	"KRN",8994 ,3461,2,1, 0)
	3956	PARAMS^2^^ 1^1
	3957	"KRN",8994 ,3461,2,1, 1,0)
	3958	^^1^1^3151 208^
	3959	"KRN",8994 ,3461,2,1, 1,1,0)
	3960	This conta ins the li st of RPCs that are to be call ed.
	3961	"KRN",8994 ,3461,2,"B ","PARAMS" ,1)
	3962
	3963	"KRN",8994 ,3461,2,"P ARAMSEQ",1 ,1)
	3964
	3965	"KRN",8994 ,3462,-1)
	3966	0^29
	3967	"KRN",8994 ,3462,0)
	3968	HMPCRPC RP CCHAIN^CHA INRPC^HMPC RPC^3^S^0^ ^0^1^^1
	3969	"KRN",8994 ,3462,1,0)
	3970	^8994.01^2 ^2^3150923 ^^
	3971	"KRN",8994 ,3462,1,1, 0)
	3972	Used to ch ain multip le HMP RPC 's togethe r. Flexibl e framewor k for invo king
	3973	"KRN",8994 ,3462,1,2, 0)
	3974	a RPC chai n
	3975	"KRN",8994 ,3462,2,0)
	3976	^8994.02A^ 1^1
	3977	"KRN",8994 ,3462,2,1, 0)
	3978	PARAMS^2^3 2000^1^1
	3979	"KRN",8994 ,3462,2,"B ","PARAMS" ,1)
	3980
	3981	"KRN",8994 ,3462,2,"P ARAMSEQ",1 ,1)
	3982
	3983	"KRN",8994 ,3463,-1)
	3984	0^30
	3985	"KRN",8994 ,3463,0)
	3986	HMPDJFS AP I^API^HMPD JFS^4^S^^^ 0
	3987	"KRN",8994 ,3463,1,0)
	3988	^8994.01^2 ^2^3151208 ^^
	3989	"KRN",8994 ,3463,1,1, 0)
	3990	This is th e primary entry poin t RPC for all the VX -Sync API. All sync related ca lls
	3991	"KRN",8994 ,3463,1,2, 0)
	3992	come throu gh this en try point
	3993	"KRN",8994 ,3463,2,0)
	3994	^8994.02A^ 2^2
	3995	"KRN",8994 ,3463,2,1, 0)
	3996	RESPONSE^1 ^^^1
	3997	"KRN",8994 ,3463,2,2, 0)
	3998	ARGS^2^^1^ 1
	3999	"KRN",8994 ,3463,2,2, 1,0)
	4000	^^1^1^3151 208^
	4001	"KRN",8994 ,3463,2,2, 1,1,0)
	4002	The ARGS a rray conta ins all th e required data to c all the ap propriate API.
	4003	"KRN",8994 ,3463,2,"B ","ARGS",2 )
	4004
	4005	"KRN",8994 ,3463,2,"B ","RESPONS E",1)
	4006
	4007	"KRN",8994 ,3463,2,"P ARAMSEQ",1 ,1)
	4008
	4009	"KRN",8994 ,3463,2,"P ARAMSEQ",1 ,2)
	4010
	4011	"KRN",8994 ,3464,-1)
	4012	0^31
	4013	"KRN",8994 ,3464,0)
	4014	HMPDJFS DE LSUB^DELSU B^HMPDJFS^ 1^P^0
	4015	"KRN",8994 ,3464,1,0)
	4016	^^1^1^3150 812^
	4017	"KRN",8994 ,3464,1,1, 0)
	4018	RPC used t o delete e HMP subscr iptions fr om file 80 0000
	4019	"KRN",8994 ,3465,-1)
	4020	0^32
	4021	"KRN",8994 ,3465,0)
	4022	HMPFPTC CH KS^CHKS^HM PFPTC^3^S^ ^^0
	4023	"KRN",8994 ,3465,1,0)
	4024	^8994.01^2 ^2^3150812 ^^^^
	4025	"KRN",8994 ,3465,1,1, 0)
	4026	This RPC r eturns the patient s election c hecks for a sensitiv e patient,
	4027	"KRN",8994 ,3465,1,2, 0)
	4028	deceased, and PRF.
	4029	"KRN",8994 ,3465,2,0)
	4030	^8994.02A^ 1^1
	4031	"KRN",8994 ,3465,2,1, 0)
	4032	ICN^1^^1^1
	4033	"KRN",8994 ,3465,2,1, 1,0)
	4034	^8994.021^ 1^1^312062 9^^
	4035	"KRN",8994 ,3465,2,1, 1,1,0)
	4036	This is th e patient ICN
	4037	"KRN",8994 ,3465,2,"B ","ICN",1)
	4038
	4039	"KRN",8994 ,3465,2,"P ARAMSEQ",1 ,1)
	4040
	4041	"KRN",8994 ,3466,-1)
	4042	0^33
	4043	"KRN",8994 ,3466,0)
	4044	HMPFPTC LO G^LOG^HMPF PTC^3^S^^^ 0
	4045	"KRN",8994 ,3466,1,0)
	4046	^8994.01^2 ^2^3120124 ^
	4047	"KRN",8994 ,3466,1,1, 0)
	4048	This RPC i s used to log a pati ent when a provider is accessi ng a
	4049	"KRN",8994 ,3466,1,2, 0)
	4050	sensitive record.
	4051	"KRN",8994 ,3466,2,0)
	4052	^8994.02A^ 1^1
	4053	"KRN",8994 ,3466,2,1, 0)
	4054	ICN^1^^1^1
	4055	"KRN",8994 ,3466,2,1, 1,0)
	4056	^^1^1^3151 208^
	4057	"KRN",8994 ,3466,2,1, 1,1,0)
	4058	The patien t's Intega rtion Cont rol Number (ICN).
	4059	"KRN",8994 ,3466,2,"B ","ICN",1)
	4060
	4061	"KRN",8994 ,3466,2,"P ARAMSEQ",1 ,1)
	4062
	4063	"KRN",8994 ,3467,-1)
	4064	0^35
	4065	"KRN",8994 ,3467,0)
	4066	HMP LOCAL GETCORRESP ONDINGIDS^ TFL^HMPTFU 2^3^S^^^1^ 1
	4067	"KRN",8994 ,3467,1,0)
	4068	^8994.01^2 ^2^3150205 ^^^^
	4069	"KRN",8994 ,3467,1,1, 0)
	4070	Given a pa tient DFN, ICN, or E DIPI, this Remote Pr ocedure Ca ll returns a list of Treating Facilities , includin g SOURCE
	4071	"KRN",8994 ,3467,1,2, 0)
	4072	ID, station nu mber, and IDENTIFIE R STATUS. INPUT PARA METER: Pat ient Ident ifier
	4073	"KRN",8994 ,3467,2,0)
	4074	^8994.02A^ 1^1
	4075	"KRN",8994 ,3467,2,1, 0)
	4076	Patient Id entifier^3 ^255^1^1
	4077	"KRN",8994 ,3467,2,1, 1,0)
	4078	^8994.021^ 11^11^3150 205^^^^
	4079	"KRN",8994 ,3467,2,1, 1,1,0)
	4080	The patie nt identif ier will e ither be t he PATIENT file (#2) IEN (aka
	4081	"KRN",8994 ,3467,2,1, 1,2,0)
	4082	DFN), Int egration C ontrol Num ber (aka I CN) or the DOD Ident ifier (aka
	4083	"KRN",8994 ,3467,2,1, 1,3,0)
	4084	EDIPI). Following this forma t:
	4085	"KRN",8994 ,3467,2,1, 1,4,0)
	4086
	4087	"KRN",8994 ,3467,2,1, 1,5,0)
	4088	Id^IdType ^Assigning Authority^ AssigningF acility
	4089	"KRN",8994 ,3467,2,1, 1,6,0)
	4090
	4091	"KRN",8994 ,3467,2,1, 1,7,0)
	4092	Examples:
	4093	"KRN",8994 ,3467,2,1, 1,8,0)
	4094
	4095	"KRN",8994 ,3467,2,1, 1,9,0)
	4096	ICN examp le: 1008 520438V882 204^NI^USV HA^200M
	4097	"KRN",8994 ,3467,2,1, 1,10,0)
	4098	DFN exampl e: 10000 0511^PI^US VHA^500
	4099	"KRN",8994 ,3467,2,1, 1,11,0)
	4100	EDIPI exa mple: 8520 43888^NI^U SDOD^200DO D
	4101	"KRN",8994 ,3467,2,"B ","Patient Identifie r",1)
	4102
	4103	"KRN",8994 ,3467,2,"P ARAMSEQ",1 ,1)
	4104
	4105	"KRN",8994 ,3467,3,0)
	4106	^8994.03^1 4^14^31502 05^^^^
	4107	"KRN",8994 ,3467,3,1, 0)
	4108	This will return a list of tr eating fac ilities in the follo wing forma t:
	4109	"KRN",8994 ,3467,3,2, 0)
	4110
	4111	"KRN",8994 ,3467,3,3, 0)
	4112	ID^IDTYPE ^Assigning Facility^A ssigningAu thority^ID Status
	4113	"KRN",8994 ,3467,3,4, 0)
	4114
	4115	"KRN",8994 ,3467,3,5, 0)
	4116	AssigningF acility is a hashed value base d on facil ity domain ,
	4117	"KRN",8994 ,3467,3,6, 0)
	4118	using $$BA SE^XLFUTL( $$CRC16^XL FCRC("DOMA IN URL "),10,16)
	4119	"KRN",8994 ,3467,3,7, 0)
	4120
	4121	"KRN",8994 ,3467,3,8, 0)
	4122	Examples:
	4123	"KRN",8994 ,3467,3,9, 0)
	4124
	4125	"KRN",8994 ,3467,3,10 ,0)
	4126	RETURN(1) ="27^PI^D1 7^USVHA^H"
	4127	"KRN",8994 ,3467,3,11 ,0)
	4128	RETURN(2) ="7169806^ PI^D17^USV HA^A"
	4129	"KRN",8994 ,3467,3,12 ,0)
	4130	RETURN(3) ="^PI^200P S^USVHA"
	4131	"KRN",8994 ,3467,3,13 ,0)
	4132	RETURN(4) ="1^NI^200 DOD^USDOD^ A"
	4133	"KRN",8994 ,3467,3,14 ,0)
	4134	RETURN(5) ="2^NI^200 DOD^USDOD^ H"
	4135	"KRN",8994 ,3468,-1)
	4136	0^34
	4137	"KRN",8994 ,3468,0)
	4138	HMP LOCAL CORRESPOND INGIDS^TFL ^HMPTFU2^3 ^S^^^1^1
	4139	"KRN",8994 ,3468,1,0)
	4140	^8994.01^1 ^1^3150219 ^^^^
	4141	"KRN",8994 ,3468,1,1, 0)
	4142	Give a pat ient DFN, ICN, or ED IPI, this Remote Pro cedure Cal l returns a list of Treating F acilities, including SOURCE ID , SITE HAS H, and IDE NTIFIER ST ATUS.
	4143	"KRN",8994 ,3468,2,0)
	4144	^8994.02A^ 1^1
	4145	"KRN",8994 ,3468,2,1, 0)
	4146	Patient Id entifier^3 ^255^1^1
	4147	"KRN",8994 ,3468,2,1, 1,0)
	4148	^8994.021^ 7^7^315021 9^^^^
	4149	"KRN",8994 ,3468,2,1, 1,1,0)
	4150	The patien t identifi er will ei ther be th e PATIENT (#2) IEN ( aka DFN), Integratio n Control Number (ak a ICN), or the DOD I dentifier (aka EDIPI ). Followi ng this fo rmat:
	4151	"KRN",8994 ,3468,2,1, 1,2,0)
	4152	Id^IdType^ AssigningA uthority^A ssigningFa cility
	4153	"KRN",8994 ,3468,2,1, 1,3,0)
	4154
	4155	"KRN",8994 ,3468,2,1, 1,4,0)
	4156	Examples:
	4157	"KRN",8994 ,3468,2,1, 1,5,0)
	4158	ICN examp le: 10085 20438V8822 04^NI^USVH A^200M
	4159	"KRN",8994 ,3468,2,1, 1,6,0)
	4160	DFN examp le: 10000 0511^PI^US HVA^500
	4161	"KRN",8994 ,3468,2,1, 1,7,0)
	4162	EDIPI exam ple: 85204 3888^NI^US DOD^200DOD
	4163	"KRN",8994 ,3468,2,"B ","Patient Identifie r",1)
	4164
	4165	"KRN",8994 ,3468,2,"P ARAMSEQ",1 ,1)
	4166
	4167	"KRN",8994 ,3468,3,0)
	4168	^8994.03^8 ^8^3150219 ^^^
	4169	"KRN",8994 ,3468,3,1, 0)
	4170	This will return a l ist of tre ating faci lities in the follow ing format :
	4171	"KRN",8994 ,3468,3,2, 0)
	4172
	4173	"KRN",8994 ,3468,3,3, 0)
	4174	ID^IDTYPE ^SiteHash^ AssigningA uthority^I DSTatus
	4175	"KRN",8994 ,3468,3,4, 0)
	4176
	4177	"KRN",8994 ,3468,3,5, 0)
	4178	Examples:
	4179	"KRN",8994 ,3468,3,6, 0)
	4180	RETURN(1) =27^PI^D17 ^USVHA^H"
	4181	"KRN",8994 ,3468,3,7, 0)
	4182	RETURN(2) =7169806^P I^D17^USHV A^A"
	4183	"KRN",8994 ,3468,3,8, 0)
	4184	RETURN(3) =1^NI^200D OD^USDOD^A "
	4185	"KRN",8994 ,3469,-1)
	4186	0^36
	4187	"KRN",8994 ,3469,0)
	4188	HMP PUT OP ERATIONAL DATA^API^H MPWB^1^S^^ ^^^^1
	4189	"KRN",8994 ,3469,1,0)
	4190	^8994.01^1 ^1^3151208 ^^^
	4191	"KRN",8994 ,3469,1,1, 0)
	4192	This RPC a ccepts wri teback dat a from JDS and retur ns a JSON formatted acknowledg ement mess age.
	4193	"KRN",8994 ,3469,2,0)
	4194	^8994.02A^ 3^3
	4195	"KRN",8994 ,3469,2,1, 0)
	4196	IEN^1^^1^1
	4197	"KRN",8994 ,3469,2,1, 1,0)
	4198	^^2^2^3151 208^
	4199	"KRN",8994 ,3469,2,1, 1,1,0)
	4200	This is th e INTERNAL ENTRY NUM BER in the target fi le for wri te backs.
	4201	"KRN",8994 ,3469,2,1, 1,2,0)
	4202	The file i s determin ed by the value pass ed in DATA ("domain") .
	4203	"KRN",8994 ,3469,2,2, 0)
	4204	DFN^1^^1^2
	4205	"KRN",8994 ,3469,2,2, 1,0)
	4206	^^1^1^3151 208^
	4207	"KRN",8994 ,3469,2,2, 1,1,0)
	4208	The IEN of the patie nt in the PATIENT fi le (#2).
	4209	"KRN",8994 ,3469,2,3, 0)
	4210	DATA^2^^1^ 3
	4211	"KRN",8994 ,3469,2,3, 1,0)
	4212	^^4^4^3151 208^
	4213	"KRN",8994 ,3469,2,3, 1,1,0)
	4214	An array p assed-by-r eference.
	4215	"KRN",8994 ,3469,2,3, 1,2,0)
	4216
	4217	"KRN",8994 ,3469,2,3, 1,3,0)
	4218	DATA("doma in") deter mines the data domai n for whic h the desi red write
	4219	"KRN",8994 ,3469,2,3, 1,4,0)
	4220	back will occur. An invalid d omain will result in data bein g returned .
	4221	"KRN",8994 ,3469,2,"B ","DATA",3 )
	4222
	4223	"KRN",8994 ,3469,2,"B ","DFN",2)
	4224
	4225	"KRN",8994 ,3469,2,"B ","IEN",1)
	4226
	4227	"KRN",8994 ,3469,2,"P ARAMSEQ",1 ,1)
	4228
	4229	"KRN",8994 ,3469,2,"P ARAMSEQ",2 ,2)
	4230
	4231	"KRN",8994 ,3469,2,"P ARAMSEQ",3 ,3)
	4232
	4233	"KRN",8994 ,3470,-1)
	4234	0^39
	4235	"KRN",8994 ,3470,0)
	4236	HMP PATIEN T SCHED SY NC^APPT^HM PACT^4^P^^ ^1^1
	4237	"KRN",8994 ,3470,1,0)
	4238	^^5^5^3150 416^
	4239	"KRN",8994 ,3470,1,1, 0)
	4240	This RPC l ooks up pa tient appo intments b y date and location and return s
	4241	"KRN",8994 ,3470,1,2, 0)
	4242	the follow ing in a g lobal arra y for pati ents that are not fo und in the
	4243	"KRN",8994 ,3470,1,3, 0)
	4244	HMP SUBSCR IPTION fil e (#800000 ):
	4245	"KRN",8994 ,3470,1,4, 0)
	4246
	4247	"KRN",8994 ,3470,1,5, 0)
	4248	DFN^Ap pointment Date^Locat ion Name^L ocation IE N
	4249	"KRN",8994 ,3470,2,0)
	4250	^8994.02A^ 3^3
	4251	"KRN",8994 ,3470,2,1, 0)
	4252	STARTDT^1^ 20^1^1
	4253	"KRN",8994 ,3470,2,1, 1,0)
	4254	^^1^1^3150 416^
	4255	"KRN",8994 ,3470,2,1, 1,1,0)
	4256	Start Date for appoi ntment sea rch in VA format. T his is a r equired fi eld.
	4257	"KRN",8994 ,3470,2,2, 0)
	4258	ENDDATE^1^ 20^0^2
	4259	"KRN",8994 ,3470,2,2, 1,0)
	4260	^^2^2^3150 416^
	4261	"KRN",8994 ,3470,2,2, 1,1,0)
	4262	The ending date for the appoin tment sear ch in VA f ormat. Th is field i s
	4263	"KRN",8994 ,3470,2,2, 1,2,0)
	4264	optional a nd will de fault to t he current date if n ot entered .
	4265	"KRN",8994 ,3470,2,3, 0)
	4266	LOCIEN^1^2 0^0^3
	4267	"KRN",8994 ,3470,2,3, 1,0)
	4268	^^3^3^3150 416^
	4269	"KRN",8994 ,3470,2,3, 1,1,0)
	4270	The IEN fo r the clin ic locatio n in the H OSPITAL LO CATION Fil e (#44).
	4271	"KRN",8994 ,3470,2,3, 1,2,0)
	4272	This is an optional field. Ap pointments for all l ocations w ill be
	4273	"KRN",8994 ,3470,2,3, 1,3,0)
	4274	evaluated if not ent ered.
	4275	"KRN",8994 ,3470,2,"B ","ENDDATE ",2)
	4276
	4277	"KRN",8994 ,3470,2,"B ","LOCIEN" ,3)
	4278
	4279	"KRN",8994 ,3470,2,"B ","STARTDT ",1)
	4280
	4281	"KRN",8994 ,3470,2,"P ARAMSEQ",1 ,1)
	4282
	4283	"KRN",8994 ,3470,2,"P ARAMSEQ",2 ,2)
	4284
	4285	"KRN",8994 ,3470,2,"P ARAMSEQ",3 ,3)
	4286
	4287	"KRN",8994 ,3470,3,0)
	4288	^^3^3^3150 416^
	4289	"KRN",8994 ,3470,3,1, 0)
	4290	An array o f the foll owing pati ent appoin tment data :
	4291	"KRN",8994 ,3470,3,2, 0)
	4292
	4293	"KRN",8994 ,3470,3,3, 0)
	4294	DFN^Ap pointment Date^Locat ion Name^L ocation IE N
	4295	"KRN",8994 ,3471,-1)
	4296	0^40
	4297	"KRN",8994 ,3471,0)
	4298	HMP PATIEN T ADMIT SY NC^ADMIT^H MPACT^4^A^ ^^1^1
	4299	"KRN",8994 ,3471,1,0)
	4300	^8994.01^6 ^6^3151208 ^^^
	4301	"KRN",8994 ,3471,1,1, 0)
	4302	This RPC l ooks up pa tient admi ssions by location a nd returns the
	4303	"KRN",8994 ,3471,1,2, 0)
	4304	following in a globa l array fo r patients that are not found in the HMP
	4305	"KRN",8994 ,3471,1,3, 0)
	4306	SUBSCRIPTI ON file (# 800000):
	4307	"KRN",8994 ,3471,1,4, 0)
	4308
	4309	"KRN",8994 ,3471,1,5, 0)
	4310	DFN^Ad mission Da te^Locatio n Name^Roo m-Bed^Loca tion IEN
	4311	"KRN",8994 ,3471,1,6, 0)
	4312	The Room-Bed m ay not be populated for all lo cations.
	4313	"KRN",8994 ,3471,2,0)
	4314	^8994.02A^ 1^1
	4315	"KRN",8994 ,3471,2,1, 0)
	4316	LOCIEN^1^2 0^0^1
	4317	"KRN",8994 ,3471,2,1, 1,0)
	4318	^8994.021^ 3^3^315120 8^^
	4319	"KRN",8994 ,3471,2,1, 1,1,0)
	4320	The IEN fo r the ward location in the WAR D LOCATION file (#42 ).
	4321	"KRN",8994 ,3471,2,1, 1,2,0)
	4322	This is an optional field. Ad missions f or all war d location s will be
	4323	"KRN",8994 ,3471,2,1, 1,3,0)
	4324	evaluated if not ent ered.
	4325	"KRN",8994 ,3471,2,"B ","LOCIEN" ,1)
	4326
	4327	"KRN",8994 ,3471,2,"P ARAMSEQ",1 ,1)
	4328
	4329	"KRN",8994 ,3471,3,0)
	4330	^^3^3^3150 416^
	4331	"KRN",8994 ,3471,3,1, 0)
	4332	An array o f the foll owing pati ent admiss ion data:
	4333	"KRN",8994 ,3471,3,2, 0)
	4334
	4335	"KRN",8994 ,3471,3,3, 0)
	4336	DFN^Ad mission Da te^Locatio n Name^Roo m-Bed^Loca tion IEN
	4337	"KRN",8994 ,3472,-1)
	4338	0^37
	4339	"KRN",8994 ,3472,0)
	4340	HMP CHKXTM P^CHKXTMP^ HMPTOOLS^2 ^S
	4341	"KRN",8994 ,3472,1,0)
	4342	^8994.01^1 ^1^3150923 ^^
	4343	"KRN",8994 ,3472,1,1, 0)
	4344	Returns th e status o f the entr ies in ^XT MP (comple te, stagin g).
	4345	"KRN",8994 ,3473,-1)
	4346	0^38
	4347	"KRN",8994 ,3473,0)
	4348	HMP GLOBAL SIZE^SIZE ^HMPTOOLS^ 2^S
	4349	"KRN",8994 ,3473,1,0)
	4350	^8994.01^1 ^1^3150923 ^^
	4351	"KRN",8994 ,3473,1,1, 0)
	4352	Accepts a global nam e (without the '^') and return s the size of that g lobal
	4353	"KRN",8994 ,3474,-1)
	4354	0^41
	4355	"KRN",8994 ,3474,0)
	4356	HMP DEFAUL T PATIENT LIST^DEFLI ST^HMPPDL^ 2^^^^^1^^1
	4357	"KRN",8994 ,3474,1,0)
	4358	^^3^3^3150 731^
	4359	"KRN",8994 ,3474,1,1, 0)
	4360	This RPC w ill return the defau lt patient list for a specific provider.
	4361	"KRN",8994 ,3474,1,2, 0)
	4362	Input para meter is t he provide r's DUZ. O ut put is an array w ith the
	4363	"KRN",8994 ,3474,1,3, 0)
	4364	patient's DFN^Patien t Name^Pat ient Locat ion.
	4365	"KRN",8994 ,3474,2,0)
	4366	^8994.02A^ 1^1
	4367	"KRN",8994 ,3474,2,1, 0)
	4368	DUZ^1^200^ 1^1
	4369	"KRN",8994 ,3474,2,1, 1,0)
	4370	^^1^1^3150 731^
	4371	"KRN",8994 ,3474,2,1, 1,1,0)
	4372	This is th e DUZ for the provid er.
	4373	"KRN",8994 ,3474,2,"B ","DUZ",1)
	4374
	4375	"KRN",8994 ,3474,2,"P ARAMSEQ",1 ,1)
	4376
	4377	"KRN",8994 ,3474,3,0)
	4378	^^4^4^3150 731^
	4379	"KRN",8994 ,3474,3,1, 0)
	4380	Returns an array con taining th e default list of pa tients for the
	4381	"KRN",8994 ,3474,3,2, 0)
	4382	requested provider. Array is i n the form at:
	4383	"KRN",8994 ,3474,3,3, 0)
	4384
	4385	"KRN",8994 ,3474,3,4, 0)
	4386	DFN^Patien t Name^Pat ient Locat ion
	4387	"MBREQ")
	4388	0
	4389	"ORD",0,9. 8)
	4390	9.8;;1;RTN F^XPDTA;RT NE^XPDTA
	4391	"ORD",0,9. 8,0)
	4392	ROUTINE
	4393	"ORD",3,19 .1)
	4394	19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1
	4395	"ORD",3,19 .1,0)
	4396	SECURITY K EY
	4397	"ORD",11,3 .8)
	4398	3.8;11;;;M AILG^XPDTA 1;MAILGF1^ XPDIA1;MAI LGE1^XPDIA 1;MAILGF2^ XPDIA1;;MA ILGDEL^XPD IA1(%)
	4399	"ORD",11,3 .8,0)
	4400	MAIL GROUP
	4401	"ORD",14,7 71)
	4402	771;14;;;H LAP^XPDTA1 ;HLAPF1^XP DIA1;HLAPE 1^XPDIA1;H LAPF2^XPDI A1;;HLAPDE L^XPDIA1(% )
	4403	"ORD",14,7 71,0)
	4404	HL7 APPLIC ATION PARA METER
	4405	"ORD",15,1 01)
	4406	101;15;;;P RO^XPDTA;P ROF1^XPDIA ;PROE1^XPD IA;PROF2^X PDIA;;PROD EL^XPDIA
	4407	"ORD",15,1 01,0)
	4408	PROTOCOL
	4409	"ORD",16,8 994)
	4410	8994;16;1; ;;;;;;RPCD EL^XPDIA1
	4411	"ORD",16,8 994,0)
	4412	REMOTE PRO CEDURE
	4413	"ORD",17,4 09.61)
	4414	409.61;17; 1;;;;LME1^ XPDIA1;;;L MDEL^XPDIA 1
	4415	"ORD",17,4 09.61,0)
	4416	LIST TEMPL ATE
	4417	"ORD",18,1 9)
	4418	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	4419	"ORD",18,1 9,0)
	4420	OPTION
	4421	"ORD",20,8 989.51)
	4422	8989.51;20 ;;;PAR1E1^ XPDTA2;PAR 1F1^XPDIA3 ;PAR1E1^XP DIA3;PAR1F 2^XPDIA3;; PAR1DEL^XP DIA3(%)
	4423	"ORD",20,8 989.51,0)
	4424	PARAMETER DEFINITION
	4425	"PKG",578, -1)
	4426	1^1
	4427	"PKG",578, 0)
	4428	HEALTH MAN AGEMENT PL ATFORM^HMP ^Access pa tient medi cal record s from all VistA's
	4429	"PKG",578, 20,0)
	4430	^9.402P^^
	4431	"PKG",578, 22,0)
	4432	^9.49I^1^1
	4433	"PKG",578, 22,1,0)
	4434	2.0^316022 3^3160223^ 1
	4435	"PKG",578, 22,1,1,0)
	4436	^^3^3^3160 223
	4437	"PKG",578, 22,1,1,1,0 )
	4438	Enterprise Health Ma nagement P latform Pa ckage Rele ase.
	4439	"PKG",578, 22,1,1,2,0 )
	4440
	4441	"PKG",578, 22,1,1,3,0 )
	4442	See FORUM patch desc ription fo r details.
	4443	"PKG",578, 22,1,"PAH" ,0)
	4444	^9.4901^3^ 3
	4445	"PKG",578, 22,1,"PAH" ,1,0)
	4446	650223^315 0414.06271 1^1
	4447	"PKG",578, 22,1,"PAH" ,1,1,0)
	4448	^^1^1^3150 414
	4449	"PKG",578, 22,1,"PAH" ,1,1,1,0)
	4450	Add proxy user for e HMP
	4451	"PKG",578, 22,1,"PAH" ,2,0)
	4452	650218^315 0414.06271 2^1
	4453	"PKG",578, 22,1,"PAH" ,2,1,0)
	4454	^^1^1^3150 414
	4455	"PKG",578, 22,1,"PAH" ,2,1,1,0)
	4456	Routine HM PTFU2, con verted fro m VAFCTFU2 .
	4457	"PKG",578, 22,1,"PAH" ,3,0)
	4458	150618^316 0210.17481 8^1
	4459	"PKG",578, 22,1,"PAH" ,3,1,0)
	4460	^^1^1^3160 210
	4461	"PKG",578, 22,1,"PAH" ,3,1,1,0)
	4462	Merge S68 changes in to eHMP.
	4463	"PKG",578, 22,1,"PAH" ,"B",15061 8,3)
	4464
	4465	"PKG",578, 22,1,"PAH" ,"B",65021 8,2)
	4466
	4467	"PKG",578, 22,1,"PAH" ,"B",65022 3,1)
	4468
	4469	"PKG",578, "VERSION")
	4470	2.0
	4471	"QUES","XP F1",0)
	4472	Y
	4473	"QUES","XP F1","??")
	4474	^D REP^XPD H
	4475	"QUES","XP F1","A")
	4476	Shall I wr ite over y our \|FLAG\| File
	4477	"QUES","XP F1","B")
	4478	YES
	4479	"QUES","XP F1","M")
	4480	D XPF1^XPD IQ
	4481	"QUES","XP F2",0)
	4482	Y
	4483	"QUES","XP F2","??")
	4484	^D DTA^XPD H
	4485	"QUES","XP F2","A")
	4486	Want my da ta \|FLAG\| yours
	4487	"QUES","XP F2","B")
	4488	YES
	4489	"QUES","XP F2","M")
	4490	D XPF2^XPD IQ
	4491	"QUES","XP I1",0)
	4492	YO
	4493	"QUES","XP I1","??")
	4494	^D INHIBIT ^XPDH
	4495	"QUES","XP I1","A")
	4496	Want KIDS to INHIBIT LOGONs du ring the i nstall
	4497	"QUES","XP I1","B")
	4498	NO
	4499	"QUES","XP I1","M")
	4500	D XPI1^XPD IQ
	4501	"QUES","XP M1",0)
	4502	PO^VA(200, :EM
	4503	"QUES","XP M1","??")
	4504	^D MG^XPDH
	4505	"QUES","XP M1","A")
	4506	Enter the Coordinato r for Mail Group '\|F LAG\|'
	4507	"QUES","XP M1","B")
	4508
	4509	"QUES","XP M1","M")
	4510	D XPM1^XPD IQ
	4511	"QUES","XP O1",0)
	4512	Y
	4513	"QUES","XP O1","??")
	4514	^D MENU^XP DH
	4515	"QUES","XP O1","A")
	4516	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	4517	"QUES","XP O1","B")
	4518	YES
	4519	"QUES","XP O1","M")
	4520	D XPO1^XPD IQ
	4521	"QUES","XP Z1",0)
	4522	Y
	4523	"QUES","XP Z1","??")
	4524	^D OPT^XPD H
	4525	"QUES","XP Z1","A")
	4526	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	4527	"QUES","XP Z1","B")
	4528	NO
	4529	"QUES","XP Z1","M")
	4530	D XPZ1^XPD IQ
	4531	"QUES","XP Z2",0)
	4532	Y
	4533	"QUES","XP Z2","??")
	4534	^D RTN^XPD H
	4535	"QUES","XP Z2","A")
	4536	Want to MO VE routine s to other CPUs
	4537	"QUES","XP Z2","B")
	4538	NO
	4539	"QUES","XP Z2","M")
	4540	D XPZ2^XPD IQ
	4541	"RTN")
	4542	147
	4543	"RTN","HMP 0311P")
	4544	0^2^B14101 699
	4545	"RTN","HMP 0311P",1,0 )
	4546	HMP0311P ; ASMR/hrubo vcak - HMP DGPF ASSI GN FLAG Pr otocol to ITEM;Mar 2 0, 2015@14 :34:08
	4547	"RTN","HMP 0311P",2,0 )
	4548	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;No vember 30, 2015;Build 63
	4549	"RTN","HMP 0311P",3,0 )
	4550	;Per VA D irective 6 402, this routine sh ould not b e modified .
	4551	"RTN","HMP 0311P",4,0 )
	4552	;
	4553	"RTN","HMP 0311P",5,0 )
	4554	Q
	4555	"RTN","HMP 0311P",6,0 )
	4556	; Post-in it logic
	4557	"RTN","HMP 0311P",7,0 )
	4558	POST ; mak e HMP DGPF ASSIGN FL AG protoco l an ITEM
	4559	"RTN","HMP 0311P",8,0 )
	4560	;
	4561	"RTN","HMP 0311P",9,0 )
	4562	N HMPDGIE N,HMPERR,H MPEXIT,HMP FDA,HMPIEN ,HMPRTCL,J ,PRTCLITM, V,X,Y
	4563	"RTN","HMP 0311P",10, 0)
	4564	;
	4565	"RTN","HMP 0311P",11, 0)
	4566	D MES^XPD UTL($T(+0) _" post-in it routine started " _$$HTE^XLF DT($H))
	4567	"RTN","HMP 0311P",12, 0)
	4568	S V=$$SVD ATA D MES^ XPDUTL("Ol d data sav ed in "_V)
	4569	"RTN","HMP 0311P",13, 0)
	4570	S HMPRTCL ="HMP DGPF ASSIGN FL AG",HMPIEN =$O(^ORD(1 01,"B",HMP RTCL,0))
	4571	"RTN","HMP 0311P",14, 0)
	4572	; protoco l missing, write mes sage and e xit
	4573	"RTN","HMP 0311P",15, 0)
	4574	I '(HMPIE N>0) D MES ^XPDUTL(HM PRTCL_" pr otocol not found. It must be i nstalled t o proceed. ") Q
	4575	"RTN","HMP 0311P",16, 0)
	4576	;
	4577	"RTN","HMP 0311P",17, 0)
	4578	S Y="DGPF ASSIGN FL AG",HMPDGI EN=$O(^ORD (101,"B",Y ,0))
	4579	"RTN","HMP 0311P",18, 0)
	4580	; protoco l missing, write mes sage and e xit
	4581	"RTN","HMP 0311P",19, 0)
	4582	I '(HMPDG IEN>0) D M ES^XPDUTL( Y_" protoc ol not fou nd. No IT EM update performed. ") Q
	4583	"RTN","HMP 0311P",20, 0)
	4584	; make DG PF ASSIGN FLAG an ex tended act ion
	4585	"RTN","HMP 0311P",21, 0)
	4586	S HMPFDA( 101,HMPDGI EN_",",4)= "X"
	4587	"RTN","HMP 0311P",22, 0)
	4588	D UPDATE^ DIE("","HM PFDA",""," HMPERR")
	4589	"RTN","HMP 0311P",23, 0)
	4590	I $D(HMPE RR) D Q ; somethin g went wro ng
	4591	"RTN","HMP 0311P",24, 0)
	4592	.D MES^XP DUTL("File Man error when editi ng DGPF AS SIGN FLAG protocol")
	4593	"RTN","HMP 0311P",25, 0)
	4594	.N V S V= "HMPERR" F S V=$Q(@ V) Q:V="" D MES^XPD UTL(V_" = "_@V)
	4595	"RTN","HMP 0311P",26, 0)
	4596	;
	4597	"RTN","HMP 0311P",27, 0)
	4598	; is prot ocol alrea dy an item ?
	4599	"RTN","HMP 0311P",28, 0)
	4600	S HMPEXIT =$O(^ORD(1 01,HMPDGIE N,10,"B",H MPIEN,0))
	4601	"RTN","HMP 0311P",29, 0)
	4602	I HMPEXIT D MES^XPD UTL(HMPRTC L_" alread y an ITEM in "_Y_". No update needed.") Q
	4603	"RTN","HMP 0311P",30, 0)
	4604	;
	4605	"RTN","HMP 0311P",31, 0)
	4606	; add pro tocol as I TEM
	4607	"RTN","HMP 0311P",32, 0)
	4608	K HMPFDA, HMPERR
	4609	"RTN","HMP 0311P",33, 0)
	4610	S HMPFDA( 101.01,"+1 ,"_HMPDGIE N_",",.01) =HMPIEN
	4611	"RTN","HMP 0311P",34, 0)
	4612	D UPDATE^ DIE("","HM PFDA","PRT CLITM","HM PERR")
	4613	"RTN","HMP 0311P",35, 0)
	4614	I $D(HMPE RR) D Q ; somethin g went wro ng
	4615	"RTN","HMP 0311P",36, 0)
	4616	.D MES^XP DUTL("File Man error when addin g ITEM to DGPF ASSIG N FLAG pro tocol")
	4617	"RTN","HMP 0311P",37, 0)
	4618	.N V S V= "HMPERR" F S V=$Q(@ V) Q:V="" D MES^XPD UTL(V_" = "_@V)
	4619	"RTN","HMP 0311P",38, 0)
	4620	; new ITE M sub-file IEN will be in PRTC LITM(1)
	4621	"RTN","HMP 0311P",39, 0)
	4622	D MES^XPD UTL(HMPRTC L_" protoc ol update finished " _$$HTE^XLF DT($H))
	4623	"RTN","HMP 0311P",40, 0)
	4624	;
	4625	"RTN","HMP 0311P",41, 0)
	4626	Q
	4627	"RTN","HMP 0311P",42, 0)
	4628	;
	4629	"RTN","HMP 0311P",43, 0)
	4630	SVDATA() ; extrinsic variable, save orig inal FileM an data, r eturns sto rage node
	4631	"RTN","HMP 0311P",44, 0)
	4632	;
	4633	"RTN","HMP 0311P",45, 0)
	4634	D DT^DICR W
	4635	"RTN","HMP 0311P",46, 0)
	4636	N FMERRCN T,HMPXTMP, HMPIEN,LN, NTRY,TXT,V ,X,Y
	4637	"RTN","HMP 0311P",47, 0)
	4638	S Y=$$NOW ^XLFDT,HMP XTMP=$NA(^ XTMP("HMP INSTALL LO G",Y)) ; XTMP stora ge locatio n
	4639	"RTN","HMP 0311P",48, 0)
	4640	; ^XTMP l og data ex pires in 9 0 days
	4641	"RTN","HMP 0311P",49, 0)
	4642	S X=$G(@H MPXTMP@(0) ) S:X="" @ HMPXTMP@(0 )=$$FMADD^ XLFDT(DT,9 0)_U_Y_"^H MP install ation "_$$ FMTE^XLFDT (Y)
	4643	"RTN","HMP 0311P",50, 0)
	4644	;
	4645	"RTN","HMP 0311P",51, 0)
	4646	S FMERRCN T=0 ; Fil eMan error counter
	4647	"RTN","HMP 0311P",52, 0)
	4648	; save en tries in F ileMan ite ms list
	4649	"RTN","HMP 0311P",53, 0)
	4650	F LN=1:1 S TXT=$P($ T(FMITMS+L N),";;",2, 99) Q:TXT= "" D
	4651	"RTN","HMP 0311P",54, 0)
	4652	.N FLNO,F MARRY,FMER R ; file #, FileMan returned value and error mess age arrays
	4653	"RTN","HMP 0311P",55, 0)
	4654	.S FLNO=+ $P(TXT,U), X=$P(TXT,U ,2,99) ; file numbe r and targ et entry
	4655	"RTN","HMP 0311P",56, 0)
	4656	.Q:'(FLNO >1)!(X="") ; file a nd entry r equired
	4657	"RTN","HMP 0311P",57, 0)
	4658	.S HMPIEN =$$FIND1^D IC(FLNO,"" ,"",X,""," ","FMERR") ; lookup value in X is exter nal format
	4659	"RTN","HMP 0311P",58, 0)
	4660	.I $D(FME RR) D Q ; log erro r message and quit
	4661	"RTN","HMP 0311P",59, 0)
	4662	..S V="FM ERR",FMERR CNT=FMERRC NT+1 F S V=$Q(@V) Q :V="" S @ HMPXTMP@(" FM LOOKUP ERROR",FME RRCNT,V)=@ V
	4663	"RTN","HMP 0311P",60, 0)
	4664	.;
	4665	"RTN","HMP 0311P",61, 0)
	4666	.S:'(HMPI EN>0) FMER RCNT=FMERR CNT+1,@HMP XTMP@("FM ENTRY NOT FOUND",FME RRCNT)=TXT ; entry
	4667	"RTN","HMP 0311P",62, 0)
	4668	.S:HMPIEN >0 @HMPXTM P@("ENTRY" ,FLNO,HMPI EN)="entry found"
	4669	"RTN","HMP 0311P",63, 0)
	4670	.K FMERR ; just in case
	4671	"RTN","HMP 0311P",64, 0)
	4672	.D GETS^D IQ(FLNO,HM PIEN_","," **","EN"," FMARRY","F MERR") ; data inclu ding sub-f iles, igno re null va lues
	4673	"RTN","HMP 0311P",65, 0)
	4674	.I $D(FME RR) D ; l og error m essage
	4675	"RTN","HMP 0311P",66, 0)
	4676	..S V="FM ERR",FMERR CNT=FMERRC NT+1 F S V=$Q(@V) Q :V="" S @ HMPXTMP@(" FM DATA ER ROR",FMERR CNT,V)=@V
	4677	"RTN","HMP 0311P",67, 0)
	4678	.; save t he data
	4679	"RTN","HMP 0311P",68, 0)
	4680	.M @HMPXT MP@("ENTRY ")=FMARRY
	4681	"RTN","HMP 0311P",69, 0)
	4682	;
	4683	"RTN","HMP 0311P",70, 0)
	4684	Q HMPXTMP ; return ^XTMP sto rage locat ion
	4685	"RTN","HMP 0311P",71, 0)
	4686	;
	4687	"RTN","HMP 0311P",72, 0)
	4688	FMITMS ; l ist of Fil eMan entri es: "file # ^ .01 fi eld value"
	4689	"RTN","HMP 0311P",73, 0)
	4690	;;101^DGP F ASSIGN F LAG
	4691	"RTN","HMP 0311P",74, 0)
	4692	;
	4693	"RTN","HMP 0311Q")
	4694	0^140^B390 2876
	4695	"RTN","HMP 0311Q",1,0 )
	4696	HMP0311Q ; ASMR/MAT - HMP Subsc ribe Clien t Protocol s to VAFC; 10/1/2015 12:49pm
	4697	"RTN","HMP 0311Q",2,0 )
	4698	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;No vember 30, 2015;Build 63
	4699	"RTN","HMP 0311Q",3,0 )
	4700	;Per VA D irective 6 402, this routine sh ould not b e modified .
	4701	"RTN","HMP 0311Q",4,0 )
	4702	;
	4703	"RTN","HMP 0311Q",5,0 )
	4704	; DE2393 - MAT - Su bscribe HM P ADT-A0# CLIENT Pro tocol to V AFC ADT-A0 # SERVER
	4705	"RTN","HMP 0311Q",6,0 )
	4706	;
	4707	"RTN","HMP 0311Q",7,0 )
	4708	; Called from POST^ HMPP3I.
	4709	"RTN","HMP 0311Q",8,0 )
	4710	Q
	4711	"RTN","HMP 0311Q",9,0 )
	4712	;
	4713	"RTN","HMP 0311Q",10, 0)
	4714	POST ;
	4715	"RTN","HMP 0311Q",11, 0)
	4716	D MES^XPD UTL($T(+0) _" post-in it routine started " _$$HTE^XLF DT($H))
	4717	"RTN","HMP 0311Q",12, 0)
	4718	D MES^XPD UTL($$HMPA 04())
	4719	"RTN","HMP 0311Q",13, 0)
	4720	D MES^XPD UTL($$HMPA 08())
	4721	"RTN","HMP 0311Q",14, 0)
	4722	D MES^XPD UTL("HMP A DT-A0# CLI ENT protoc ols subscr ibed "_$$H TE^XLFDT($ H))
	4723	"RTN","HMP 0311Q",15, 0)
	4724	Q
	4725	"RTN","HMP 0311Q",16, 0)
	4726	;
	4727	"RTN","HMP 0311Q",17, 0)
	4728	HMPA04() ;
	4729	"RTN","HMP 0311Q",18, 0)
	4730	N HMPSUBS
	4731	"RTN","HMP 0311Q",19, 0)
	4732	S HMPSUBS =$$PROTSUB S("HMP ADT -A04 CLIEN T","VAFC A DT-A04 SER VER")
	4733	"RTN","HMP 0311Q",20, 0)
	4734	Q HMPSUBS
	4735	"RTN","HMP 0311Q",21, 0)
	4736	;
	4737	"RTN","HMP 0311Q",22, 0)
	4738	HMPA08() ;
	4739	"RTN","HMP 0311Q",23, 0)
	4740	N HMPSUBS
	4741	"RTN","HMP 0311Q",24, 0)
	4742	S HMPSUBS =$$PROTSUB S("HMP ADT -A08 CLIEN T","VAFC A DT-A08 SER VER")
	4743	"RTN","HMP 0311Q",25, 0)
	4744	Q HMPSUBS
	4745	"RTN","HMP 0311Q",26, 0)
	4746	;
	4747	"RTN","HMP 0311Q",27, 0)
	4748	;=== Subs cribe PROT SRC to PRO TARG.
	4749	"RTN","HMP 0311Q",28, 0)
	4750	;
	4751	"RTN","HMP 0311Q",29, 0)
	4752	PROTSUBS(P ROTSRC,PRO TARG) ;
	4753	"RTN","HMP 0311Q",30, 0)
	4754	;
	4755	"RTN","HMP 0311Q",31, 0)
	4756	;--- Vali date SOURC E and TARG ET exist.
	4757	"RTN","HMP 0311Q",32, 0)
	4758	N IENPSRC S IENPSRC =$$YNPROTO (PROTSRC)
	4759	"RTN","HMP 0311Q",33, 0)
	4760	Q:IENPSRC =-1 "SOURC E PROTOCOL "_PROTSRC _" NOT FOU ND."
	4761	"RTN","HMP 0311Q",34, 0)
	4762	;
	4763	"RTN","HMP 0311Q",35, 0)
	4764	N IENPTRG S IENPTRG =$$YNPROTO (PROTARG)
	4765	"RTN","HMP 0311Q",36, 0)
	4766	Q:IENPTRG =-1 "TARGE T PROTOCOL "_PROTARG _" NOT FOU ND."
	4767	"RTN","HMP 0311Q",37, 0)
	4768	;
	4769	"RTN","HMP 0311Q",38, 0)
	4770	;--- Vali date SOURC E is not a subscribe r of TARGE T.
	4771	"RTN","HMP 0311Q",39, 0)
	4772	N IENPSUB S IENPSUB =$$YNSUBSC R(PROTSRC, IENPTRG)
	4773	"RTN","HMP 0311Q",40, 0)
	4774	Q:IENPSUB >0 "PROTOC OL "_PROTS RC_" ALREA DY SUBSCRI BED TO "_P ROTARG_"."
	4775	"RTN","HMP 0311Q",41, 0)
	4776	;
	4777	"RTN","HMP 0311Q",42, 0)
	4778	;--- Subs cribe SOUR CE to TARG ET.
	4779	"RTN","HMP 0311Q",43, 0)
	4780	N FDA S F DA(1,101.0 775,"+1,"_ IENPTRG_", ",.01)=PRO TSRC
	4781	"RTN","HMP 0311Q",44, 0)
	4782	D UPDATE^ DIE("E","F DA(1)")
	4783	"RTN","HMP 0311Q",45, 0)
	4784	Q "PROTOC OL "_PROTS RC_" IS NO W SUBSCRIB ED TO "_PR OTARG_"."
	4785	"RTN","HMP 0311Q",46, 0)
	4786	;
	4787	"RTN","HMP 0311Q",47, 0)
	4788	;=== Retu rn the PRO TOCOL File IEN or -1 if not ex ist.
	4789	"RTN","HMP 0311Q",48, 0)
	4790	;
	4791	"RTN","HMP 0311Q",49, 0)
	4792	YNPROTO(PR OTO) ;
	4793	"RTN","HMP 0311Q",50, 0)
	4794	N DIC,X,Y S X=PROTO ,DIC="^ORD (101," D ^ DIC
	4795	"RTN","HMP 0311Q",51, 0)
	4796	Q +Y
	4797	"RTN","HMP 0311Q",52, 0)
	4798	;
	4799	"RTN","HMP 0311Q",53, 0)
	4800	;=== Retu rn the SUB SCRIBER Su b-File IEN or -1 if not exist.
	4801	"RTN","HMP 0311Q",54, 0)
	4802	;
	4803	"RTN","HMP 0311Q",55, 0)
	4804	YNSUBSCR(P ROTSRC,IEN PTRG) ;
	4805	"RTN","HMP 0311Q",56, 0)
	4806	N DIC,X,Y S X=PROTS RC,DIC="^O RD(101,"_I ENPTRG_",7 75," D ^DI C
	4807	"RTN","HMP 0311Q",57, 0)
	4808	Q +Y
	4809	"RTN","HMP 0311Q",58, 0)
	4810	;
	4811	"RTN","HMP 0311Q",59, 0)
	4812	; HMP0311 Q
	4813	"RTN","HMP ACT")
	4814	0^3^B34386 179
	4815	"RTN","HMP ACT",1,0)
	4816	HMPACT ;AS MR/EJK - P atient App ointment B roker Call ;8/4/14 1 5:29
	4817	"RTN","HMP ACT",2,0)
	4818	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Oc t 10, 2014 ;Build 63
	4819	"RTN","HMP ACT",3,0)
	4820	;Per VA D irective 6 402, this routine sh ould not b e modified .
	4821	"RTN","HMP ACT",4,0)
	4822	;
	4823	"RTN","HMP ACT",5,0)
	4824	Q
	4825	"RTN","HMP ACT",6,0)
	4826	ACT(ROOT,D FN,ID,ALPH A,OMEGA,DT RANGE,REMO TE,MAX,ORF HIE) ;
	4827	"RTN","HMP ACT",7,0)
	4828	N ERR,ERR MSG,DFN,IE N,DIE,HMST OP
	4829	"RTN","HMP ACT",8,0)
	4830	S ERR=0,E RRMSG="",D FN="",IEN= "",HMSTOP= 0
	4831	"RTN","HMP ACT",9,0)
	4832	S ROOT="X WBY"
	4833	"RTN","HMP ACT",10,0)
	4834	K ^TMP("O RDATA",$J)
	4835	"RTN","HMP ACT",11,0)
	4836	Q:'$D(^HM P(800001.5 ,"PTAPPT", "HMP"))
	4837	"RTN","HMP ACT",12,0)
	4838	S DIE="^H MP(800001. 5,""PTAPPT "","
	4839	"RTN","HMP ACT",13,0)
	4840	D FETCH
	4841	"RTN","HMP ACT",14,0)
	4842	D CLEAN
	4843	"RTN","HMP ACT",15,0)
	4844	Q
	4845	"RTN","HMP ACT",16,0)
	4846	;
	4847	"RTN","HMP ACT",17,0)
	4848	FETCH ;GET PENDING J SON MESSAG ES AND UPD ATE DATE R ECORD RETR IEVED
	4849	"RTN","HMP ACT",18,0)
	4850	S X="[" D SETITEM(. ROOT,X)
	4851	"RTN","HMP ACT",19,0)
	4852	F S IEN= $O(^HMP(80 0001.5,"PT APPT","HMP ",IEN)) Q: IEN=""!(HM STOP) D
	4853	"RTN","HMP ACT",20,0)
	4854	. S X=$G( ^HMP(80000 1.5,"PTAPP T",IEN,"JS ON"))
	4855	"RTN","HMP ACT",21,0)
	4856	. I $O(^H MP(800001. 5,"PTAPPT" ,"HMP",IEN ))="" S $E (X,$L(X))= "",HMSTOP= 1
	4857	"RTN","HMP ACT",22,0)
	4858	. D SETIT EM(.ROOT,X )
	4859	"RTN","HMP ACT",23,0)
	4860	. S DA=IE N,DR="6/// 1" D ^DIE
	4861	"RTN","HMP ACT",24,0)
	4862	. Q
	4863	"RTN","HMP ACT",25,0)
	4864	S X="]" D SETITEM(. ROOT,X)
	4865	"RTN","HMP ACT",26,0)
	4866	Q
	4867	"RTN","HMP ACT",27,0)
	4868	;
	4869	"RTN","HMP ACT",28,0)
	4870	CLEAN ;CLE AN UP STRA Y VARIABLE S
	4871	"RTN","HMP ACT",29,0)
	4872	K DA,DR,X
	4873	"RTN","HMP ACT",30,0)
	4874	Q
	4875	"RTN","HMP ACT",31,0)
	4876	;
	4877	"RTN","HMP ACT",32,0)
	4878	SETITEM(RO OT,X) ; -- set item in list - RRB US5872
	4879	"RTN","HMP ACT",33,0)
	4880	S @ROOT@( $O(@ROOT@( 9999),-1)+ 1)=X
	4881	"RTN","HMP ACT",34,0)
	4882	Q
	4883	"RTN","HMP ACT",35,0)
	4884	;
	4885	"RTN","HMP ACT",36,0)
	4886	APPT(HMPOU T,BEG,END, LOCIEN) ; Lookup app ointments by date an d location
	4887	"RTN","HMP ACT",37,0)
	4888	;
	4889	"RTN","HMP ACT",38,0)
	4890	;Associat ed ICRs:
	4891	"RTN","HMP ACT",39,0)
	4892	; ICR#
	4893	"RTN","HMP ACT",40,0)
	4894	; 20 51: Datab ase Server API: Look up Utiliti es
	4895	"RTN","HMP ACT",41,0)
	4896	; FIND1 ^DIC
	4897	"RTN","HMP ACT",42,0)
	4898	; 10 103: XLFDT Date func tions
	4899	"RTN","HMP ACT",43,0)
	4900	; HTFM^ XLFDT
	4901	"RTN","HMP ACT",44,0)
	4902	; SUPPOR TED: VADPT
	4903	"RTN","HMP ACT",45,0)
	4904	; SDA^V ADPT
	4905	"RTN","HMP ACT",46,0)
	4906	; KVA^V ADPT
	4907	"RTN","HMP ACT",47,0)
	4908	; KVAR^ VADPT
	4909	"RTN","HMP ACT",48,0)
	4910	;
	4911	"RTN","HMP ACT",49,0)
	4912	N DFN,LOC ,OVER,PAT, REQ,SD,SCX
	4913	"RTN","HMP ACT",50,0)
	4914	I '$G(BEG ) S BEG=$$ HTFM^XLFDT (+$H) ; D efault cur rent day
	4915	"RTN","HMP ACT",51,0)
	4916	S BEG=$P( BEG,".",1)
	4917	"RTN","HMP ACT",52,0)
	4918	I BEG'?7N Q -1
	4919	"RTN","HMP ACT",53,0)
	4920	I '$G(END ) S END=$$ HTFM^XLFDT (+$H) ; D efault cur rent day
	4921	"RTN","HMP ACT",54,0)
	4922	S END=$P( END,".",1)
	4923	"RTN","HMP ACT",55,0)
	4924	I END'?7N Q -1
	4925	"RTN","HMP ACT",56,0)
	4926	I END<BEG Q -1
	4927	"RTN","HMP ACT",57,0)
	4928	K ^TMP("H MPAPPT",$J )
	4929	"RTN","HMP ACT",58,0)
	4930	S HMPOUT= $NA(^TMP(" HMPAPPT",$ J))
	4931	"RTN","HMP ACT",59,0)
	4932	I $G(LOCI EN) D SCHE D(LOCIEN,B EG,END) G ENDAPPT
	4933	"RTN","HMP ACT",60,0)
	4934	K LOC
	4935	"RTN","HMP ACT",61,0)
	4936	;DE2818, changed lo cation che ck routine to HMPXGS D
	4937	"RTN","HMP ACT",62,0)
	4938	D CLINLOC ^HMPXGSD(. LOC,"",1) ; Lookup VistA Clin ic Locatio ns
	4939	"RTN","HMP ACT",63,0)
	4940	;
	4941	"RTN","HMP ACT",64,0)
	4942	; The cli nic locati ons will b e returned in the HM POUT array :
	4943	"RTN","HMP ACT",65,0)
	4944	; LOC (D1)=LOCIE N^LOCNAME
	4945	"RTN","HMP ACT",66,0)
	4946	;
	4947	"RTN","HMP ACT",67,0)
	4948	LOCLKUP ;
	4949	"RTN","HMP ACT",68,0)
	4950	N LOCNAME
	4951	"RTN","HMP ACT",69,0)
	4952	S SCX=""
	4953	"RTN","HMP ACT",70,0)
	4954	F S SCX= $O(LOC(SCX )) Q:SCX=" " D
	4955	"RTN","HMP ACT",71,0)
	4956	. S LOCIE N=$P(LOC(S CX),U,1),L OCNAME=$P( LOC(SCX),U ,2)
	4957	"RTN","HMP ACT",72,0)
	4958	. D SCHED (LOCIEN,BE G,END)
	4959	"RTN","HMP ACT",73,0)
	4960	G ENDAPPT
	4961	"RTN","HMP ACT",74,0)
	4962	;
	4963	"RTN","HMP ACT",75,0)
	4964	SCHED(LOCI EN,BEG,END ) ;
	4965	"RTN","HMP ACT",76,0)
	4966	; Get lis t of patie nts and ap pointment dates from the
	4967	"RTN","HMP ACT",77,0)
	4968	; using $ $SDAPI^SDA MA301 api.
	4969	"RTN","HMP ACT",78,0)
	4970	; Inputs are SDARRA Y(1)=BEG;E ND - Begin ning and e nding date s for the search.
	4971	"RTN","HMP ACT",79,0)
	4972	; BEG mus t be defin ed.
	4973	"RTN","HMP ACT",80,0)
	4974	; END end ing date f or the sea rch. If EN D is undef ined, the API return s all appo intments s tarting wi th the BEG date.
	4975	"RTN","HMP ACT",81,0)
	4976	; BEG and END are F ileMan Dat e/Time. Bo th BEG and END are v alidated i n the call ing lineta g APPT^HMP ACT
	4977	"RTN","HMP ACT",82,0)
	4978	; LOCIEN = IEN for the locati on in the Hospital L ocation fi le (#44). LOCIEN is validated in the cal ling linet ag APPT^HM PACT
	4979	"RTN","HMP ACT",83,0)
	4980	;
	4981	"RTN","HMP ACT",84,0)
	4982	;S SD=BEG
	4983	"RTN","HMP ACT",85,0)
	4984	;F S SD= $O(^SC(LOC IEN,"S",SD )) Q:SD="" !(SD>END) D ; Quit if null o r date > E ND
	4985	"RTN","HMP ACT",86,0)
	4986	;. S PAT= 0
	4987	"RTN","HMP ACT",87,0)
	4988	;. F S P AT=$O(^SC( LOCIEN,"S" ,SD,1,PAT) ) Q:PAT="" D
	4989	"RTN","HMP ACT",88,0)
	4990	;.. Q:'$D (^SC(LOCIE N,"S",SD,1 ,1))
	4991	"RTN","HMP ACT",89,0)
	4992	;..S DFN= $P(^SC(LOC IEN,"S",SD ,1,PAT,0), U,1)
	4993	"RTN","HMP ACT",90,0)
	4994	;.. I DFN =$P($G(^HM P(800000,1 ,1,DFN,0)) ,U,1) Q ; Check for subscript ion and sk ip if subs cribed
	4995	"RTN","HMP ACT",91,0)
	4996	;.. ; Use supported SDA^VADPT call to g et the app t data fro m the Pati ent File ( #2)
	4997	"RTN","HMP ACT",92,0)
	4998	;.. ; VAS D("F")= "F rom" Appoi ntment Dat e without timestamp.
	4999	"RTN","HMP ACT",93,0)
	5000	;.. ; VAS D("T")= "T o" Appoint ment Date without ti mestamp. This is se t to the " From" date so only
	5001	"RTN","HMP ACT",94,0)
	5002	;.. ; on e day is e valuated s ince we're examining each date entry in ^SC(LOCIEN ,"S",SD)
	5003	"RTN","HMP ACT",95,0)
	5004	;.. ; VAS D("C")= Ar ray of cli nic locati on IENs. T his is set to the cu rrent loca tion only.
	5005	"RTN","HMP ACT",96,0)
	5006	;.. ;
	5007	"RTN","HMP ACT",97,0)
	5008	;.. S VAS D("F")=$P( SD,".",1), VASD("T")= VASD("F"), VASD("C",L OCIEN)=""
	5009	"RTN","HMP ACT",98,0)
	5010	;.. D SDA ^VADPT
	5011	"RTN","HMP ACT",99,0)
	5012	;.. Q:'$D (^UTILITY( "VASD",$J, 1))
	5013	"RTN","HMP ACT",100,0 )
	5014	;.. ; ^UT ILITY("VAS D",$J) is killed by VADPT0
	5015	"RTN","HMP ACT",101,0 )
	5016	K ^TMP($J ,"SDAMA301 ") ; kill the TMP g lobal that stores th e return d ata from t he $$SDAPI ^SDAMA301 call
	5017	"RTN","HMP ACT",102,0 )
	5018	K SDARRAY ,SDCNT ; kill the S DARRAY tha t stores t he input v ariables t o the $$SD API^SDAMA3 01 call, S DCNT flag for data r eturned, i f SDCNT > 0 data is returned i n the ^TMP ($J,"SDAMA 301" temp global
	5019	"RTN","HMP ACT",103,0 )
	5020	S SDARRAY (1)=BEG_"; "_$G(END), SDARRAY(2) =$G(LOCIEN ),SDARRAY( "FLDS")="1 ;2;4" ;in put variab les for $$ SDAPI^SDAM A301
	5021	"RTN","HMP ACT",104,0 )
	5022	S SDCNT=$ $SDAPI^SDA MA301 I $G (SDCNT)>0 K XDFN,APT DATE F S XDFN=$O(^T MP($J,"SDA MA301",LOC IEN,XDFN)) Q:XDFN'>0 S APTDAT E=0 F S A PTDATE=$O( ^TMP($J,"S DAMA301",X DFN,APTDAT E)) Q:APTD ATE'>0 D
	5023	"RTN","HMP ACT",105,0 )
	5024	. I XDFN= $P($G(^HMP (800000,1, 1,XDFN,0)) ,U,1) Q ; Check for subscript ion and sk ip if subs cribed
	5025	"RTN","HMP ACT",106,0 )
	5026	. S LOCNA ME=$P(^TMP ($J,"SDAMA 301",XDFN, APTDATE)," ;",2)
	5027	"RTN","HMP ACT",107,0 )
	5028	. S ^TMP( "HMPAPPT", $J,XDFN,AP TDATE,LOCI EN)=XDFN_U _APTDATE_U _LOCNAME_U _LOCIEN ; ^TMP("HMPA PPT" is ki lled in AP PT^HMPACT before cal ling this linetag (S CHED)
	5029	"RTN","HMP ACT",108,0 )
	5030	K SDFN,AP TDATE,LOCN AME,SDCNT, SDARRAY,^T MP($J,"SDA MA301") ; clean up variables
	5031	"RTN","HMP ACT",109,0 )
	5032	Q
	5033	"RTN","HMP ACT",110,0 )
	5034	;
	5035	"RTN","HMP ACT",111,0 )
	5036	ENDAPPT ;
	5037	"RTN","HMP ACT",112,0 )
	5038	;
	5039	"RTN","HMP ACT",113,0 )
	5040	M @HMPOUT =^TMP("HMP APPT",$J)
	5041	"RTN","HMP ACT",114,0 )
	5042	K @HMPOUT @(0)
	5043	"RTN","HMP ACT",115,0 )
	5044	Q
	5045	"RTN","HMP ACT",116,0 )
	5046	;
	5047	"RTN","HMP ACT",117,0 )
	5048	ADMIT(HMPO UT,LOCIEN) ; Lookup admissions by locati on
	5049	"RTN","HMP ACT",118,0 )
	5050	;
	5051	"RTN","HMP ACT",119,0 )
	5052	;Associat ed ICRs:
	5053	"RTN","HMP ACT",120,0 )
	5054	; ICR#
	5055	"RTN","HMP ACT",121,0 )
	5056	; 20 51: Datab ase Server API: Look up Utiliti es
	5057	"RTN","HMP ACT",122,0 )
	5058	; FIND1 ^DIC
	5059	"RTN","HMP ACT",123,0 )
	5060	; LIST^ DIC
	5061	"RTN","HMP ACT",124,0 )
	5062	; 10 103: XLFDT Date func tions
	5063	"RTN","HMP ACT",125,0 )
	5064	; HTFM^ XLFDT
	5065	"RTN","HMP ACT",126,0 )
	5066	; SUPPOR TED: VADPT
	5067	"RTN","HMP ACT",127,0 )
	5068	; INP^V ADPT
	5069	"RTN","HMP ACT",128,0 )
	5070	; KVA^V ADPT
	5071	"RTN","HMP ACT",129,0 )
	5072	; KVAR^ VADPT
	5073	"RTN","HMP ACT",130,0 )
	5074	;
	5075	"RTN","HMP ACT",131,0 )
	5076	N DFROM,D IEN,DOUT,D PART,DRID, FILE,FLDS, FLG,MAX,PI DX,SCRN,SU BSCRP,WARD ,XREF
	5077	"RTN","HMP ACT",132,0 )
	5078	K ^TMP("H MPADMIT",$ J)
	5079	"RTN","HMP ACT",133,0 )
	5080	S HMPOUT= $NA(^TMP(" HMPADMIT", $J))
	5081	"RTN","HMP ACT",134,0 )
	5082	; Get Pat ient list by Ward
	5083	"RTN","HMP ACT",135,0 )
	5084	S FILE=2, DIEN="",FL DS="@;.1", FLG="P",MA X="",DFROM ="",DPART= "",XREF="A CN"
	5085	"RTN","HMP ACT",136,0 )
	5086	S SCRN="I $P($G(^DP T(+Y,.102) ),""^"")>0 ",DRID="", DOUT=""
	5087	"RTN","HMP ACT",137,0 )
	5088	; The SCR N paramete r is set t o insure t he patient record ha s a curren t movement file entr y.
	5089	"RTN","HMP ACT",138,0 )
	5090	K ^TMP("D ILIST",$J)
	5091	"RTN","HMP ACT",139,0 )
	5092	D LIST^DI C(FILE,DIE N,FLDS,FLG ,MAX,.DFRO M,DPART,XR EF,SCRN,DR ID,DOUT) ; ICR #205 1
	5093	"RTN","HMP ACT",140,0 )
	5094	; The lis t of patie nts and as sociated w ards are r eturned vi a the ^TMP ("DILIST", $J,PIDX,0) global in the follo wing forma t:
	5095	"RTN","HMP ACT",141,0 )
	5096	; ^T MP("DILIST ",$J,PIDX, 0)=DFN^WAR D
	5097	"RTN","HMP ACT",142,0 )
	5098	; No te: The W ARD is the ward name , not an i nternal (I EN) entry
	5099	"RTN","HMP ACT",143,0 )
	5100	S PIDX=0
	5101	"RTN","HMP ACT",144,0 )
	5102	F S PIDX =$O(^TMP(" DILIST",$J ,PIDX)) Q: PIDX="" D
	5103	"RTN","HMP ACT",145,0 )
	5104	. S DFN=$ P(^TMP("DI LIST",$J,P IDX,0),U,1 ),WARD=$P( ^TMP("DILI ST",$J,PID X,0),U,2)
	5105	"RTN","HMP ACT",146,0 )
	5106	. ; If th e calling applicatio n passes a ward LOCI EN, Use th e WARD LOC ATION File (#42) to lookup
	5107	"RTN","HMP ACT",147,0 )
	5108	. ; the w ard (locat ion) IEN f or compari son to the requested LOCIEN to screen ou t any entr ies that d on't match the reque st.
	5109	"RTN","HMP ACT",148,0 )
	5110	. ;
	5111	"RTN","HMP ACT",149,0 )
	5112	. I LOCIE N'="",LOCI EN'=$$FIND 1^DIC(42," ","BX",WAR D,"B",""," ") Q
	5113	"RTN","HMP ACT",150,0 )
	5114	. ; Check patients for HMP su bscription , File (#8 00000) and setup pat ient data
	5115	"RTN","HMP ACT",151,0 )
	5116	. I DFN=$ P($G(^HMP( 800000,1,1 ,DFN,0)),U ,1) Q ; C heck for s ubscriptio n and skip if subscr ibed
	5117	"RTN","HMP ACT",152,0 )
	5118	. D GETAD MIT(DFN)
	5119	"RTN","HMP ACT",153,0 )
	5120	;
	5121	"RTN","HMP ACT",154,0 )
	5122	ENDADMIT ;
	5123	"RTN","HMP ACT",155,0 )
	5124	;
	5125	"RTN","HMP ACT",156,0 )
	5126	M @HMPOUT =^TMP("HMP ADMIT",$J)
	5127	"RTN","HMP ACT",157,0 )
	5128	K @HMPOUT @(0)
	5129	"RTN","HMP ACT",158,0 )
	5130	Q
	5131	"RTN","HMP ACT",159,0 )
	5132	;
	5133	"RTN","HMP ACT",160,0 )
	5134	GETADMIT(D FN) ;
	5135	"RTN","HMP ACT",161,0 )
	5136	N ADMIT,P DATA,LOC,L OCNAME,LRM BD,VAERR,V AIN
	5137	"RTN","HMP ACT",162,0 )
	5138	; Lookup patient ad missions d ata
	5139	"RTN","HMP ACT",163,0 )
	5140	; Use sup ported INP ^VADPT cal l to get t he admissi ons data f rom the Pa tient File (#2)
	5141	"RTN","HMP ACT",164,0 )
	5142	D INP^VAD PT
	5143	"RTN","HMP ACT",165,0 )
	5144	; LOC = W ard (Locat ion) IEN, LOCNAME = Ward (Loca tion) Name , LRMBD = Room-Bed N ame (Optio nal depend ing upon i npatient
	5145	"RTN","HMP ACT",166,0 )
	5146	; locatio n setup), ADMIT = Ad mission da te.time in VA format
	5147	"RTN","HMP ACT",167,0 )
	5148	S LOC=$P( VAIN(4),U) ,LOCNAME=$ P(VAIN(4), U,2),LRMBD =VAIN(5),A DMIT=$P(VA IN(7),U)
	5149	"RTN","HMP ACT",168,0 )
	5150	K PDATA
	5151	"RTN","HMP ACT",169,0 )
	5152	S PDATA=D FN_U_ADMIT _U_LOCNAME _U_LRMBD_U _LOC
	5153	"RTN","HMP ACT",170,0 )
	5154	S ^TMP("H MPADMIT",$ J,DFN,LOC) =PDATA
	5155	"RTN","HMP ACT",171,0 )
	5156	; Support ed calls t o Kill VAD PT variabl es
	5157	"RTN","HMP ACT",172,0 )
	5158	D KVAR^VA DPT,KVA^VA DPT
	5159	"RTN","HMP ACT",173,0 )
	5160	;
	5161	"RTN","HMP ACT",174,0 )
	5162	Q
	5163	"RTN","HMP ACT",175,0 )
	5164	;
	5165	"RTN","HMP AT")
	5166	0^4^B35952 82
	5167	"RTN","HMP AT",1,0)
	5168	HMPAT ;ASM R/EJK,ASF - ASU/TIU Trigger to HMP Activ ity File;3 /31/15 15 :29
	5169	"RTN","HMP AT",2,0)
	5170	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;No vember 30, 2015;Build 63
	5171	"RTN","HMP AT",3,0)
	5172	;Per VA D irective 6 402, this routine sh ould not b e modified .
	5173	"RTN","HMP AT",4,0)
	5174	;
	5175	"RTN","HMP AT",5,0)
	5176	; DE2818 - SQA find ings. Newe d HMPRSLT in ECLASS+ 10. RRB - 10/27/201 5
	5177	"RTN","HMP AT",6,0)
	5178	Q
	5179	"RTN","HMP AT",7,0)
	5180	ECLASS(HMP IEN) ; cal led from E DIT^USRCLA SS,ADD^USR RULA
	5181	"RTN","HMP AT",8,0)
	5182	N HMPSYS, TYPE,HMPMA X,HMPI,HMP ID,HMPERR, HMPRSLT,HM PTN,HMPLAS T,HMPCNT,H MPFINI,HMP FRSP,HMPAR GS
	5183	"RTN","HMP AT",9,0)
	5184	N $ES,$ET ,ERRMSG
	5185	"RTN","HMP AT",10,0)
	5186	S HMPID=$ P($G(USRDA TA),U,2)
	5187	"RTN","HMP AT",11,0)
	5188	S HMP=$NA (^TMP("HMP ",$J)),HMP I=0 K @HMP
	5189	"RTN","HMP AT",12,0)
	5190	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	5191	"RTN","HMP AT",13,0)
	5192	S (HMPMAX ,HMPLAST,H MPID)="",H MPCNT=0
	5193	"RTN","HMP AT",14,0)
	5194	S HMPARGS ("server") =$O(^HMP(8 00000,"B", ""))
	5195	"RTN","HMP AT",15,0)
	5196	S HMPARGS ("command" )="startOp erationalD ataExtract "
	5197	"RTN","HMP AT",16,0)
	5198	S HMPARGS ("domains" )="asu-cla ss"
	5199	"RTN","HMP AT",17,0)
	5200	D API^HMP DJFS(.HMPR SLT,.HMPAR GS)
	5201	"RTN","HMP AT",18,0)
	5202	Q
	5203	"RTN","HMP AT",19,0)
	5204	;
	5205	"RTN","HMP AT",20,0)
	5206	ERULE ; ca lled from EDIT1^USRR ULA
	5207	"RTN","HMP AT",21,0)
	5208	N HMPSYS, TYPE,HMPMA X,HMPI,HMP ID,HMPERR, HMPTN,HMPL AST,HMPCNT ,HMPFINI,H MPFRSP,HMP ARGS
	5209	"RTN","HMP AT",22,0)
	5210	N $ES,$ET ,ERRMSG
	5211	"RTN","HMP AT",23,0)
	5212	S HMP=$NA (^TMP("HMP ",$J)),HMP I=0 K @HMP
	5213	"RTN","HMP AT",24,0)
	5214	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	5215	"RTN","HMP AT",25,0)
	5216	S (HMPMAX ,HMPLAST,H MPID)="",H MPCNT=0
	5217	"RTN","HMP AT",26,0)
	5218	S HMPARGS ("server") =$O(^HMP(8 00000,"B", ""))
	5219	"RTN","HMP AT",27,0)
	5220	S HMPARGS ("command" )="startOp erationalD ataExtract "
	5221	"RTN","HMP AT",28,0)
	5222	S HMPARGS ("domains" )="asu-rul e"
	5223	"RTN","HMP AT",29,0)
	5224	D API^HMP DJFS(.HMPR SLT,.HMPAR GS)
	5225	"RTN","HMP AT",30,0)
	5226	Q
	5227	"RTN","HMP AT",31,0)
	5228	;
	5229	"RTN","HMP AT",32,0)
	5230	EDEF ; cal led from o ption TIU DOCUMENT D EFINITION EDIT
	5231	"RTN","HMP AT",33,0)
	5232	N HMPDA
	5233	"RTN","HMP AT",34,0)
	5234	S HMPDA=$ P(XQLOK,", ",2),HMPDA =$TR(HMPDA ,")","")
	5235	"RTN","HMP AT",35,0)
	5236	; DE2818 begin chan ge ASF 11/ 9/15
	5237	"RTN","HMP AT",36,0)
	5238	;I HMPDA? 1N.N,$D(^T IU(8925.1, HMPDA)) D POSTX^HMPE VNT("doc-d ef",HMPDA)
	5239	"RTN","HMP AT",37,0)
	5240	;I HMPDA? 1N.N,'$D(^ TIU(8925.1 ,HMPDA)) D POSTX^HMP EVNT("doc- def",HMPDA ,"@")
	5241	"RTN","HMP AT",38,0)
	5242	N DA,DIC, DIQ,DR,R ; FileMan variables
	5243	"RTN","HMP AT",39,0)
	5244	S DIC=892 5.1,DR=.01 ,DA=HMPDA, DIQ="R" D EN^DIQ1
	5245	"RTN","HMP AT",40,0)
	5246	D:$D(R(89 25.1,DA,.0 1)) POSTX^ HMPEVNT("d oc-def",HM PDA)
	5247	"RTN","HMP AT",41,0)
	5248	D:'$D(R(8 925.1,DA,. 01)) POSTX ^HMPEVNT(" doc-def",H MPDA,"@")
	5249	"RTN","HMP AT",42,0)
	5250	; DE2818 end change
	5251	"RTN","HMP AT",43,0)
	5252	Q
	5253	"RTN","HMP ATRG")
	5254	1^150
	5255	"RTN","HMP CAC")
	5256	0^6^B97070 146
	5257	"RTN","HMP CAC",1,0)
	5258	HMPCAC ;SL C/AGP,ASMR /RRB - HMP CAC Tools ;Nov 24, 2 015 20:05: 06
	5259	"RTN","HMP CAC",2,0)
	5260	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Fe b 06, 2014 ;Build 63
	5261	"RTN","HMP CAC",3,0)
	5262	;Per VA D irective 6 402, this routine sh ould not b e modified .
	5263	"RTN","HMP CAC",4,0)
	5264	;
	5265	"RTN","HMP CAC",5,0)
	5266	Q
	5267	"RTN","HMP CAC",6,0)
	5268	;
	5269	"RTN","HMP CAC",7,0)
	5270	ASK(YESNO, PROMPT) ;
	5271	"RTN","HMP CAC",8,0)
	5272	N X,Y,TEX T
	5273	"RTN","HMP CAC",9,0)
	5274	K DIROUT, DIRUT,DTOU T,DUOUT
	5275	"RTN","HMP CAC",10,0)
	5276	S DIR(0)= "YA0"
	5277	"RTN","HMP CAC",11,0)
	5278	S DIR("A" )=PROMPT
	5279	"RTN","HMP CAC",12,0)
	5280	S DIR("B" )="N"
	5281	"RTN","HMP CAC",13,0)
	5282	S DIR("?" )="Enter Y or N. For detailed help type ??"
	5283	"RTN","HMP CAC",14,0)
	5284	W !
	5285	"RTN","HMP CAC",15,0)
	5286	D ^DIR K DIR
	5287	"RTN","HMP CAC",16,0)
	5288	I $D(DIRO UT) S DTOU T=1
	5289	"RTN","HMP CAC",17,0)
	5290	I $D(DTOU T)!($D(DUO UT)) Q
	5291	"RTN","HMP CAC",18,0)
	5292	S YESNO=$ E(Y(0))
	5293	"RTN","HMP CAC",19,0)
	5294	Q
	5295	"RTN","HMP CAC",20,0)
	5296	;
	5297	"RTN","HMP CAC",21,0)
	5298	ADDSVR() ;
	5299	"RTN","HMP CAC",22,0)
	5300	N DEF,DIC ,DLAYGO,SI TE,SYS,Y
	5301	"RTN","HMP CAC",23,0)
	5302	S SITE=$$ SITE^VASIT E()
	5303	"RTN","HMP CAC",24,0)
	5304	S SYS=$$S YS^HMPUTIL S()
	5305	"RTN","HMP CAC",25,0)
	5306	W !,"Stat ion Number : "_$P(SIT E,U,3)
	5307	"RTN","HMP CAC",26,0)
	5308	W !,"HMP System Ide ntifier: " _SYS
	5309	"RTN","HMP CAC",27,0)
	5310	S DEF=$S( $P($G(^HMP (800000,0) ),U,4)=1:$ P($G(^HMP( 800000,1,0 )),U),1:"" ) I DEF'=" " S DIC("B ")=DEF
	5311	"RTN","HMP CAC",28,0)
	5312	S DIC="^H MP(800000, ",DIC(0)=" AEMQL",DIC ("A")="Sel ect HMP se rver insta nce: ",DLA YGO=800000
	5313	"RTN","HMP CAC",29,0)
	5314	D ^DIC
	5315	"RTN","HMP CAC",30,0)
	5316	Q Y
	5317	"RTN","HMP CAC",31,0)
	5318	;
	5319	"RTN","HMP CAC",32,0)
	5320	;DE2818, documented code belo w
	5321	"RTN","HMP CAC",33,0)
	5322	OPTASGN() ; called b y Option: Add Health Managemen t Platform User [HMP M ADD HMP USER]
	5323	"RTN","HMP CAC",34,0)
	5324	N ARGS,DI C,DLAYGO,F DA,HASOPT, HMPERR,HMP OPT,IEN,LI ST,MSG,OPT NAME,PAT,R ESULT,SVR, Y,YESNO
	5325	"RTN","HMP CAC",35,0)
	5326	S OPTNAME ="HMP UI C ONTEXT"
	5327	"RTN","HMP CAC",36,0)
	5328	S HMPOPT= $$FIND1^DI C(19,"","B ",OPTNAME, ,,"MSG") I HMPOPT'>0 W !,"Erro r: Could n ot find 'H MP UI CONT EXT' optio n." Q
	5329	"RTN","HMP CAC",37,0)
	5330	;
	5331	"RTN","HMP CAC",38,0)
	5332	S Y=$$ADD SVR() I Y< 0 Q
	5333	"RTN","HMP CAC",39,0)
	5334	S SVR=$P( $G(^HMP(80 0000,+Y,0) ),U)
	5335	"RTN","HMP CAC",40,0)
	5336	;
	5337	"RTN","HMP CAC",41,0)
	5338	K DLAYGO
	5339	"RTN","HMP CAC",42,0)
	5340	S DIC="^V A(200,",DI C(0)="AEMQ ",DIC("A") ="Select u ser to pro vide acces s to HMP: "
	5341	"RTN","HMP CAC",43,0)
	5342	D ^DIC
	5343	"RTN","HMP CAC",44,0)
	5344	I Y<0 Q
	5345	"RTN","HMP CAC",45,0)
	5346	S IEN=+Y
	5347	"RTN","HMP CAC",46,0)
	5348	;
	5349	"RTN","HMP CAC",47,0)
	5350	S HASOPT= $$ACCESS^X QCHK(IEN,H MPOPT)
	5351	"RTN","HMP CAC",48,0)
	5352	I +HASOPT >0 D Q
	5353	"RTN","HMP CAC",49,0)
	5354	.W !,"Use r has 'HMP UI CONTEX T' already assigned. " D ASK(.Y ESNO,"Sync user defa ult CPRS p atient lis t: ") I YE SNO'="Y" Q
	5355	"RTN","HMP CAC",50,0)
	5356	.I $G(YES NO)="Y" D GETPATS(.R ESULT,IEN, SVR)
	5357	"RTN","HMP CAC",51,0)
	5358	;
	5359	"RTN","HMP CAC",52,0)
	5360	K YESNO
	5361	"RTN","HMP CAC",53,0)
	5362	D ASK(.YE SNO,"Assig n 'HMP UI CONTEXT': ")
	5363	"RTN","HMP CAC",54,0)
	5364	I YESNO'= "Y" Q
	5365	"RTN","HMP CAC",55,0)
	5366	S FDA(200 .03,"+2,"_ IEN_",",.0 1)=HMPOPT
	5367	"RTN","HMP CAC",56,0)
	5368	D UPDATE^ DIE("","FD A","","HMP ERR")
	5369	"RTN","HMP CAC",57,0)
	5370	I $D(HMPE RR) D Q
	5371	"RTN","HMP CAC",58,0)
	5372	.D EN^DDI OL("Update failed, U PDATE^DIE returned t he followi ng error m essage.")
	5373	"RTN","HMP CAC",59,0)
	5374	.S IC="HM PERR"
	5375	"RTN","HMP CAC",60,0)
	5376	.F S IC= $Q(@IC) Q: IC="" W ! ,IC,"=",@I C
	5377	"RTN","HMP CAC",61,0)
	5378	D GETPATS (.RESULT,I EN,SVR)
	5379	"RTN","HMP CAC",62,0)
	5380	Q
	5381	"RTN","HMP CAC",63,0)
	5382	;
	5383	"RTN","HMP CAC",64,0)
	5384	GETPATS(RE SULT,IEN,S RV) ;
	5385	"RTN","HMP CAC",65,0)
	5386	N ARGS,LI ST,PAT
	5387	"RTN","HMP CAC",66,0)
	5388	D GETDFLS T(.LIST,IE N)
	5389	"RTN","HMP CAC",67,0)
	5390	I '$D(LIS T) W !,"No default p atient lis t found." Q
	5391	"RTN","HMP CAC",68,0)
	5392	S ARGS("c ommand")=" putPtSubsc ription"
	5393	"RTN","HMP CAC",69,0)
	5394	S ARGS("s erver")=SR V
	5395	"RTN","HMP CAC",70,0)
	5396	S PAT=0 F S PAT=$O (LIST(PAT) ) Q:PAT'>0 D
	5397	"RTN","HMP CAC",71,0)
	5398	.;check t o see if p atient is already sy nc for the server.
	5399	"RTN","HMP CAC",72,0)
	5400	.I $G(^HM P(800000," AITEM",PAT ,SRV))>0 W !,"Patien t "_PAT_" already sy nced." Q
	5401	"RTN","HMP CAC",73,0)
	5402	.S ARGS(" localId")= PAT
	5403	"RTN","HMP CAC",74,0)
	5404	.W !,"Sta rting sync on patien t: "_PAT
	5405	"RTN","HMP CAC",75,0)
	5406	.D API^HM PDJFS(.RES ULT,.ARGS)
	5407	"RTN","HMP CAC",76,0)
	5408	Q
	5409	"RTN","HMP CAC",77,0)
	5410	;
	5411	"RTN","HMP CAC",78,0)
	5412	;
	5413	"RTN","HMP CAC",79,0)
	5414	BLDLIST(LI ST,HMPY) ;
	5415	"RTN","HMP CAC",80,0)
	5416	N I,CNT,N ODE
	5417	"RTN","HMP CAC",81,0)
	5418	S I=0 F S I=$O(HMP Y(I)) Q:I' >0 D
	5419	"RTN","HMP CAC",82,0)
	5420	.S NODE=$ G(HMPY(I)) I +NODE'> 0 Q
	5421	"RTN","HMP CAC",83,0)
	5422	.;S CNT=$ O(HMPY(I), -1)+1
	5423	"RTN","HMP CAC",84,0)
	5424	.S LIST(+ $P(NODE,U) )=""
	5425	"RTN","HMP CAC",85,0)
	5426	Q
	5427	"RTN","HMP CAC",86,0)
	5428	;
	5429	"RTN","HMP CAC",87,0)
	5430	;
	5431	"RTN","HMP CAC",88,0)
	5432	;The appo intment li st date ra nge is des igned to q uery for f ull dates,
	5433	"RTN","HMP CAC",89,0)
	5434	;so when the search result ex ceeds 200 appointmen ts,
	5435	"RTN","HMP CAC",90,0)
	5436	;the disp lay will e nd with th e last app ointment o f the last day befor e the maxi mum was re ached.
	5437	"RTN","HMP CAC",91,0)
	5438	CLINPTS2(Y ,USER,CLIN ,BDATE,EDA TE) ; WRAP PER FUNCTI ON FOR USE BY RPC CA LL ORQPT C LINIC PATI ENTS
	5439	"RTN","HMP CAC",92,0)
	5440	N MAXAPPT S,APPTBGN, APPTEND,NU MAPPTS
	5441	"RTN","HMP CAC",93,0)
	5442	S MAXAPPT S=200 I BD ATE=EDATE S MAXAPPTS =0 ; if w e only wan t one day, don't lim it answer.
	5443	"RTN","HMP CAC",94,0)
	5444	D CLINPTS (.Y,USER,C LIN,BDATE, EDATE,MAXA PPTS,.APPT BGN,.APPTE ND)
	5445	"RTN","HMP CAC",95,0)
	5446	S NUMAPPT S=$O(Y("") ,-1)
	5447	"RTN","HMP CAC",96,0)
	5448	I MAXAPPT S,NUMAPPTS '<MAXAPPTS D
	5449	"RTN","HMP CAC",97,0)
	5450	. N ORI
	5451	"RTN","HMP CAC",98,0)
	5452	. S ORI=0 S APPTEND =$P(APPTEN D,".")
	5453	"RTN","HMP CAC",99,0)
	5454	. F S OR I=$O(Y(ORI )) Q:'ORI D ;erase last day' s appts si nce we ass ume it to be partial
	5455	"RTN","HMP CAC",100,0 )
	5456	.. I APPT END<$P(Y(O RI),U,4) K Y(ORI) S NUMAPPTS=N UMAPPTS-1 ;erase an appointmen t
	5457	"RTN","HMP CAC",101,0 )
	5458	. S Y(MAX APPTS+1)=" ^ * UNAB LE TO SHOW ALL APPOI NTMENTS *"
	5459	"RTN","HMP CAC",102,0 )
	5460	. S Y(MAX APPTS+2)=" ^ Showing the first "_NUMAPPTS _" appoint ments from "_$$FMTE^ XLFDT(APPT BGN,"D")_" to "_$$FM TE^XLFDT(A PPTEND-1," D")
	5461	"RTN","HMP CAC",103,0 )
	5462	. S Y(MAX APPTS+3)=" ^"_$C(160) _" Modify the appoin tment list date rang e to start on "_$$FM TE^XLFDT(A PPTEND,"D" )_" to see additiona l appointm ents." ;ad d blank li ne
	5463	"RTN","HMP CAC",104,0 )
	5464	. S Y(MAX APPTS+4)=" ^"_$C(160) _$C(160) ; add blank line
	5465	"RTN","HMP CAC",105,0 )
	5466	;
	5467	"RTN","HMP CAC",106,0 )
	5468	Q ; DE28 18, added QUIT here to prevent code fall ing throug h
	5469	"RTN","HMP CAC",107,0 )
	5470	;
	5471	"RTN","HMP CAC",108,0 )
	5472	CLINPTS(Y, USER,CLIN, BDATE,EDAT E,MAXAPPTS ,APPTBGN,A PPTEND) ; RETURN LIS T OF PTS W /CLINIC AP PT W/IN BE GINNING AN D END DATE S
	5473	"RTN","HMP CAC",109,0 )
	5474	; PKS-8/2 003: Modif ied for ne w scheduli ng pkg API s.
	5475	"RTN","HMP CAC",110,0 )
	5476	I $G(CLIN )<1 S Y(1) ="^No clin ic identif ied" Q
	5477	"RTN","HMP CAC",111,0 )
	5478	I $$ACTLO C^ORWU(CLI N)'=1 S Y( 1)="^Clini c is inact ive or Occ asion Of S ervice" Q
	5479	"RTN","HMP CAC",112,0 )
	5480	N ORSRV,O RRESULT,OR ERR,ORI,OR PT,ORPTSTA T,ORAPPT,O RCLIN,SDAR RAY,NODE
	5481	"RTN","HMP CAC",113,0 )
	5482	I $L($G(M AXAPPTS))= 0 S MAXAPP TS=200
	5483	"RTN","HMP CAC",114,0 )
	5484	S ORSRV=$ G(^VA(200, USER,5)) I +ORSRV>0 S ORSRV=$P (ORSRV,U)
	5485	"RTN","HMP CAC",115,0 )
	5486	I BDATE=" " S BDATE= $$UP^XLFST R($$GET^XP AR("USR^SR V.`"_+$G(O RSRV)_"^DI V^SYS^PKG" ,"ORLP DEF AULT CLINI C START DA TE",1,"E") )
	5487	"RTN","HMP CAC",116,0 )
	5488	I EDATE=" " S EDATE= $$UP^XLFST R($$GET^XP AR("USR^SR V.`"_+$G(O RSRV)_"^DI V^SYS^PKG" ,"ORLP DEF AULT CLINI C STOP DAT E",1,"E"))
	5489	"RTN","HMP CAC",117,0 )
	5490	;
	5491	"RTN","HMP CAC",118,0 )
	5492	; Convert BDATE, ED ATE to FM Date/Time:
	5493	"RTN","HMP CAC",119,0 )
	5494	D DT^DILF ("T",BDATE ,.BDATE,"" ,"")
	5495	"RTN","HMP CAC",120,0 )
	5496	D DT^DILF ("T",EDATE ,.EDATE,"" ,"")
	5497	"RTN","HMP CAC",121,0 )
	5498	I (BDATE= -1)!(EDATE =-1) S Y(1 )="^Error in date ra nge." Q
	5499	"RTN","HMP CAC",122,0 )
	5500	S EDATE=$ P(EDATE,". ")_.5 ; Ad d 1/2 day to end dat e.
	5501	"RTN","HMP CAC",123,0 )
	5502	;
	5503	"RTN","HMP CAC",124,0 )
	5504	K ^TMP($J ,"SDAMA301 ") ; clear residual data
	5505	"RTN","HMP CAC",125,0 )
	5506	S ORRESUL T=""
	5507	"RTN","HMP CAC",126,0 )
	5508	S ORCLIN= +CLIN
	5509	"RTN","HMP CAC",127,0 )
	5510	S SDARRAY (1)=BDATE_ ";"_EDATE
	5511	"RTN","HMP CAC",128,0 )
	5512	S SDARRAY (2)=+CLIN
	5513	"RTN","HMP CAC",129,0 )
	5514	S SDARRAY (3)="R;I;N T"
	5515	"RTN","HMP CAC",130,0 )
	5516	S SDARRAY ("SORT")=" P" ;no cli nic index
	5517	"RTN","HMP CAC",131,0 )
	5518	S SDARRAY ("FLDS")=" 3;4" ;App tStatus^IE N;PtName
	5519	"RTN","HMP CAC",132,0 )
	5520	I MAXAPPT S S SDARRA Y("MAX")=M AXAPPTS
	5521	"RTN","HMP CAC",133,0 )
	5522	;
	5523	"RTN","HMP CAC",134,0 )
	5524	S ORRESUL T=$$SDAPI^ SDAMA301(. SDARRAY) ; DBIA 4433
	5525	"RTN","HMP CAC",135,0 )
	5526	;
	5527	"RTN","HMP CAC",136,0 )
	5528	; Deal wi th server errors:
	5529	"RTN","HMP CAC",137,0 )
	5530	I ORRESUL T<0 D S Y (1)=U_ORER R Q
	5531	"RTN","HMP CAC",138,0 )
	5532	.S ORERR= ""
	5533	"RTN","HMP CAC",139,0 )
	5534	.N IDXERR S IDXERR= $O(^TMP($J ,"SDAMA301 ","")) Q:I DXERR'>0
	5535	"RTN","HMP CAC",140,0 )
	5536	.S ORERR= ^TMP($J,"S DAMA301",I DXERR)
	5537	"RTN","HMP CAC",141,0 )
	5538	;
	5539	"RTN","HMP CAC",142,0 )
	5540	; add ^TM P results to local a rray
	5541	"RTN","HMP CAC",143,0 )
	5542	S (ORPT,O RI)=0
	5543	"RTN","HMP CAC",144,0 )
	5544	I ORRESUL T'>0 S Y(1 )="^No app ointments. " Q
	5545	"RTN","HMP CAC",145,0 )
	5546	F S ORPT =$O(^TMP($ J,"SDAMA30 1",ORPT)) Q:ORPT="" D
	5547	"RTN","HMP CAC",146,0 )
	5548	.S ORAPPT =""
	5549	"RTN","HMP CAC",147,0 )
	5550	.F S ORA PPT=$O(^TM P($J,"SDAM A301",ORPT ,ORAPPT)) Q:ORAPPT=" " D
	5551	"RTN","HMP CAC",148,0 )
	5552	..S ORI=O RI+1
	5553	"RTN","HMP CAC",149,0 )
	5554	..S NODE= ^TMP($J,"S DAMA301",O RPT,ORAPPT )
	5555	"RTN","HMP CAC",150,0 )
	5556	..S Y(ORI )=$TR($P(N ODE,U,4)," ;","^") ; IEN^Name.
	5557	"RTN","HMP CAC",151,0 )
	5558	..S Y(ORI )=Y(ORI)_U _ORCLIN ; ^Clinic IE N.
	5559	"RTN","HMP CAC",152,0 )
	5560	..S Y(ORI )=Y(ORI)_U _ORAPPT ; App't.
	5561	"RTN","HMP CAC",153,0 )
	5562	..I $L($G (APPTEND)) =0 S APPTE ND=ORAPPT, APPTBGN=OR APPT
	5563	"RTN","HMP CAC",154,0 )
	5564	..I ORAPP T>APPTEND S APPTEND= ORAPPT
	5565	"RTN","HMP CAC",155,0 )
	5566	..I ORAPP T<APPTBGN S APPTBGN= ORAPPT
	5567	"RTN","HMP CAC",156,0 )
	5568	..S ORPTS TAT=$P($P( NODE,U,3), ";",1) ;ap pt status, will be t ransformed to pt sta tus.
	5569	"RTN","HMP CAC",157,0 )
	5570	..S ORPTS TAT=$S(ORP TSTAT="I": "IPT",ORPT STAT="R":" OPT",ORPTS TAT="NT":" OPT",1:"") ; Pt Stat us.
	5571	"RTN","HMP CAC",158,0 )
	5572	..S Y(ORI )=Y(ORI)_U _U_U_U_U_O RPTSTAT ; Pt I or O status (or "NT").
	5573	"RTN","HMP CAC",159,0 )
	5574	K ^TMP($J ,"SDAMA301 ") ; Clean house aft er finishi ng.
	5575	"RTN","HMP CAC",160,0 )
	5576	;
	5577	"RTN","HMP CAC",161,0 )
	5578	Q
	5579	"RTN","HMP CAC",162,0 )
	5580	;
	5581	"RTN","HMP CAC",163,0 )
	5582	COMBPTS(LI ST,USER,PT R,BDATE,ED ATE) ;
	5583	"RTN","HMP CAC",164,0 )
	5584	N FILE,MA XAPPTS,MSG ,PTR,RTN,S RC,TXT,HMP ERR,HMPY
	5585	"RTN","HMP CAC",165,0 )
	5586	;
	5587	"RTN","HMP CAC",166,0 )
	5588	; Do prel iminary se ttings, cl eanup, loo k for an e xisting us er record:
	5589	"RTN","HMP CAC",167,0 )
	5590	S MSG="" ; Default.
	5591	"RTN","HMP CAC",168,0 )
	5592	S MAXAPPT S=$S(BDATE =EDATE:0,1 :200) ; If d ate range is only on e day then no max, o therwise 2 00
	5593	"RTN","HMP CAC",169,0 )
	5594	S RTN=$$F IND1^DIC(1 00.24,""," QX",USER," ","","HMPE RR")
	5595	"RTN","HMP CAC",170,0 )
	5596	K HMPERR
	5597	"RTN","HMP CAC",171,0 )
	5598	D CLEAN^D ILF ; Clea n up after DB call.
	5599	"RTN","HMP CAC",172,0 )
	5600	;
	5601	"RTN","HMP CAC",173,0 )
	5602	; If no c ombination record, t hen punt:
	5603	"RTN","HMP CAC",174,0 )
	5604	I +RTN<1 S MSG="No combinatio n entry." Q
	5605	"RTN","HMP CAC",175,0 )
	5606	;
	5607	"RTN","HMP CAC",176,0 )
	5608	;
	5609	"RTN","HMP CAC",177,0 )
	5610	; Order t hrough the user's co mbination source ent ries:
	5611	"RTN","HMP CAC",178,0 )
	5612	S SORT="A " ; Requir ed variabl e for PTSC OMBO^ORQPT Q5.
	5613	"RTN","HMP CAC",179,0 )
	5614	S SRC=0
	5615	"RTN","HMP CAC",180,0 )
	5616	;DE2818, ^OR(100.24 ) - ICR 62 83
	5617	"RTN","HMP CAC",181,0 )
	5618	F S SRC= $O(^OR(100 .24,RTN,.0 1,SRC)) Q: 'SRC D
	5619	"RTN","HMP CAC",182,0 )
	5620	.K ORY ; Clean up each time.
	5621	"RTN","HMP CAC",183,0 )
	5622	.S TXT=$G (^OR(100.2 4,RTN,.01, SRC,0)) ; Get recor d's value.
	5623	"RTN","HMP CAC",184,0 )
	5624	.;
	5625	"RTN","HMP CAC",185,0 )
	5626	.; In cas e of error , punt:
	5627	"RTN","HMP CAC",186,0 )
	5628	.I TXT="" S MSG="Co mbination source ent ry error." Q
	5629	"RTN","HMP CAC",187,0 )
	5630	.S PTR=$P (TXT,";") ; Get po inter.
	5631	"RTN","HMP CAC",188,0 )
	5632	.S FILE=" ^"_$P(TXT, ";",2) ; Get fi le.
	5633	"RTN","HMP CAC",189,0 )
	5634	.;
	5635	"RTN","HMP CAC",190,0 )
	5636	.; Get in fo for eac h source e ntry and b uild HMPY array acco rdingly.
	5637	"RTN","HMP CAC",191,0 )
	5638	.I FILE=" ^DIC(42," D Q ; Wa rds
	5639	"RTN","HMP CAC",192,0 )
	5640	..D WARDP TS^ORQPTQ2 (.HMPY,PTR )
	5641	"RTN","HMP CAC",193,0 )
	5642	..I $D(HM PY) D BLDL IST(.LIST, .HMPY)
	5643	"RTN","HMP CAC",194,0 )
	5644	.I FILE=" ^VA(200," D Q ; Pr oviders
	5645	"RTN","HMP CAC",195,0 )
	5646	..D PROVP TS^ORQPTQ2 (.HMPY,PTR )
	5647	"RTN","HMP CAC",196,0 )
	5648	..I $D(HM PY) D BLDL IST(.LIST, .HMPY)
	5649	"RTN","HMP CAC",197,0 )
	5650	.I FILE=" ^DIC(45.7, " D Q ; Specialtie s
	5651	"RTN","HMP CAC",198,0 )
	5652	..D SPECP TS^ORQPTQ2 (.HMPY,PTR )
	5653	"RTN","HMP CAC",199,0 )
	5654	..I $D(HM PY) D BLDL IST(.LIST, .HMPY)
	5655	"RTN","HMP CAC",200,0 )
	5656	.I FILE=" ^OR(100.21 ," D Q ; Team List s
	5657	"RTN","HMP CAC",201,0 )
	5658	..D TEAMP TS^ORQPTQ1 (.HMPY,PTR )
	5659	"RTN","HMP CAC",202,0 )
	5660	..I $D(HM PY) D BLDL IST(.LIST, .HMPY)
	5661	"RTN","HMP CAC",203,0 )
	5662	.I FILE=" ^SC(" D Q ; Clinic s
	5663	"RTN","HMP CAC",204,0 )
	5664	..N APPTB GN,APPTEND S (APPTBG N,APPTEND) =""
	5665	"RTN","HMP CAC",205,0 )
	5666	..D CLINP TS^ORQPTQ2 (.HMPY,PTR ,BDATE,EDA TE,MAXAPPT S,.APPTBGN ,.APPTEND)
	5667	"RTN","HMP CAC",206,0 )
	5668	..I $D(HM PY) D BLDL IST(.LIST, .HMPY)
	5669	"RTN","HMP CAC",207,0 )
	5670	;
	5671	"RTN","HMP CAC",208,0 )
	5672	Q
	5673	"RTN","HMP CAC",209,0 )
	5674	;
	5675	"RTN","HMP CAC",210,0 )
	5676	GETDFLST(L IST,USER) ;
	5677	"RTN","HMP CAC",211,0 )
	5678	N API,BEG ,END,IEN,S RC,SRV,HMP SRC,HMPY,X
	5679	"RTN","HMP CAC",212,0 )
	5680	S SRV=$G( ^VA(200,US ER,5)) I + SRV>0 S SR V=$P(SRV,U )
	5681	"RTN","HMP CAC",213,0 )
	5682	S SRC=$$G ET^XPAR("U SR.`"_USER _"^SRV.`"_ +$G(SRV)," ORLP DEFAU LT LIST SO URCE",1,"Q ")
	5683	"RTN","HMP CAC",214,0 )
	5684	;
	5685	"RTN","HMP CAC",215,0 )
	5686	I SRC="T" S IEN=$$G ET^XPAR("U SR.`"_USER _"^SRV.`"_ +$G(SRV)," ORLP DEFAU LT TEAM",1 ,"Q") D:+$ G(IEN)>0 T EAMPTS^ORQ PTQ1(.HMPY ,IEN)
	5687	"RTN","HMP CAC",216,0 )
	5688	I SRC="W" S IEN=$$G ET^XPAR("U SR.`"_USER _"^SRV.`"_ +$G(SRV)," ORLP DEFAU LT WARD",1 ,"Q") D:+$ G(IEN)>0 B YWARD^ORWP T(.HMPY,IE N)
	5689	"RTN","HMP CAC",217,0 )
	5690	I SRC="P" S IEN=$$G ET^XPAR("U SR.`"_USER _"^SRV.`"_ +$G(SRV)," ORLP DEFAU LT PROVIDE R",1,"Q") D:+$G(IEN) >0 PROVPTS ^ORQPTQ2(. HMPY,IEN)
	5691	"RTN","HMP CAC",218,0 )
	5692	I SRC="S" S IEN=$$G ET^XPAR("U SR.`"_USER _"^SRV.`"_ +$G(SRV)," ORLP DEFAU LT SPECIAL TY",1,"Q") D:+$G(IEN )>0 SPECPT S^ORQPTQ2( .HMPY,IEN)
	5693	"RTN","HMP CAC",219,0 )
	5694	I SRC'="C ",SRC'="M" D BLDLIST (.LIST,.HM PY) Q
	5695	"RTN","HMP CAC",220,0 )
	5696	;
	5697	"RTN","HMP CAC",221,0 )
	5698	I SRC="C" D Q
	5699	"RTN","HMP CAC",222,0 )
	5700	.F X="Mon day","Tues day","Wedn esday","Th ursday","F riday","Sa turday","S unday" D
	5701	"RTN","HMP CAC",223,0 )
	5702	..S API=" ORLP DEFAU LT CLINIC "_$$UP^XLF STR(X),IEN =$$GET^XPA R("USR.`"_ USER_"^SRV .`"_+$G(SR V),API,1," Q") I +$G( IEN)>0 D
	5703	"RTN","HMP CAC",224,0 )
	5704	...S BEG= $$UP^XLFST R($$GET^XP AR("USR.`" _USER_"^SR V.`"_+$G(S RV)_"^DIV^ SYS^PKG"," ORLP DEFAU LT CLINIC START DATE ",1,"E"))
	5705	"RTN","HMP CAC",225,0 )
	5706	...I BEG= "T+0" S BE G=$$FMTE^X LFDT(DT,BE G)
	5707	"RTN","HMP CAC",226,0 )
	5708	...S END= $$UP^XLFST R($$GET^XP AR("USR.`" _USER_"^SR V.`"_+$G(S RV)_"^DIV^ SYS^PKG"," ORLP DEFAU LT CLINIC STOP DATE" ,1,"E"))
	5709	"RTN","HMP CAC",227,0 )
	5710	...I END= "T+0" S EN D=$$FMTE^X LFDT(DT,EN D)
	5711	"RTN","HMP CAC",228,0 )
	5712	...D CLIN PTS2(.HMPY ,USER,+$G( IEN),BEG,E ND)
	5713	"RTN","HMP CAC",229,0 )
	5714	...D BLDL IST(.LIST, .HMPY)
	5715	"RTN","HMP CAC",230,0 )
	5716	I SRC="M" D Q ;DE 2818, ^OR( 100.24) - ICR 6283
	5717	"RTN","HMP CAC",231,0 )
	5718	.S IEN=$D (^OR(100.2 4,USER,0)) I +$G(IEN )>0 S IEN= USER D
	5719	"RTN","HMP CAC",232,0 )
	5720	..S BEG=$ $UP^XLFSTR ($$GET^XPA R("USR.`"_ USER_"^SRV .`"_+$G(SR V)_"^DIV^S YS^PKG","O RLP DEFAUL T CLINIC S TART DATE" ,1,"E"))
	5721	"RTN","HMP CAC",233,0 )
	5722	..I BEG=" T+0" S BEG =$$FMTE^XL FDT(DT,BEG )
	5723	"RTN","HMP CAC",234,0 )
	5724	..S END=$ $UP^XLFSTR ($$GET^XPA R("USR.`"_ USER_"^SRV .`"_+$G(SR V)_"^DIV^S YS^PKG","O RLP DEFAUL T CLINIC S TOP DATE", 1,"E"))
	5725	"RTN","HMP CAC",235,0 )
	5726	..I END=" T+0" S END =$$FMTE^XL FDT(DT,END )
	5727	"RTN","HMP CAC",236,0 )
	5728	..D COMBP TS(.LIST,U SER,+$G(IE N),BEG,END ) ; "0"= G UI RPC cal l.
	5729	"RTN","HMP CAC",237,0 )
	5730	Q
	5731	"RTN","HMP CAC",238,0 )
	5732	;
	5733	"RTN","HMP CAC",239,0 )
	5734	;
	5735	"RTN","HMP CAC",240,0 )
	5736	;REMOPT(I EN,OPT) ;
	5737	"RTN","HMP CAC",241,0 )
	5738	;Q
	5739	"RTN","HMP CAC",242,0 )
	5740	;
	5741	"RTN","HMP CORD")
	5742	1^151
	5743	"RTN","HMP CORD1")
	5744	1^152
	5745	"RTN","HMP CORD2")
	5746	1^153
	5747	"RTN","HMP CORD3")
	5748	1^154
	5749	"RTN","HMP CORD4")
	5750	0^11^B1415 93321
	5751	"RTN","HMP CORD4",1,0 )
	5752	HMPCORD4 ; SLC/AGP,AS MR/RRB -Re trieved Or derable It ems;Nov 04 , 2015 12: 13:23
	5753	"RTN","HMP CORD4",2,0 )
	5754	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	5755	"RTN","HMP CORD4",3,0 )
	5756	;Per VA D irective 6 402, this routine sh ould not b e modified .
	5757	"RTN","HMP CORD4",4,0 )
	5758	;
	5759	"RTN","HMP CORD4",5,0 )
	5760	Q
	5761	"RTN","HMP CORD4",6,0 )
	5762	;
	5763	"RTN","HMP CORD4",7,0 )
	5764	ADDODG ; c alled by H MPEF
	5765	"RTN","HMP CORD4",8,0 )
	5766	N CNT,IEN ,NUM,NODE, PTR,RESULT ,TEMP
	5767	"RTN","HMP CORD4",9,0 )
	5768	N ERRMSG S ERRMSG=" A mumps er ror occurr ed while e xtracting display gr oups"
	5769	"RTN","HMP CORD4",10, 0)
	5770	S IEN=0 F S IEN=$O (^ORD(100. 98,IEN)) Q :IEN'>0 D
	5771	"RTN","HMP CORD4",11, 0)
	5772	.N $ES,$E T
	5773	"RTN","HMP CORD4",12, 0)
	5774	.S $ET="D ERRHDLR^H MPDERRH"
	5775	"RTN","HMP CORD4",13, 0)
	5776	.I '$D(^O RD(100.98, IEN,1)) D Q
	5777	"RTN","HMP CORD4",14, 0)
	5778	..S NODE= $G(^ORD(10 0.98,IEN,0 )) D SODGN ODE(.RESUL T,NODE)
	5779	"RTN","HMP CORD4",15, 0)
	5780	..S RESUL T("uid")=$ $SETUID^HM PUTILS("di splayGroup ","",IEN), RESULT("in ternal")=I EN
	5781	"RTN","HMP CORD4",16, 0)
	5782	..D ADD^H MPEF("RESU LT") S HMP CNT=+$G(HM PCNT)+1,HM PLAST=IEN
	5783	"RTN","HMP CORD4",17, 0)
	5784	.D ADDODG 1(IEN,.TEM P)
	5785	"RTN","HMP CORD4",18, 0)
	5786	.M RESULT =TEMP
	5787	"RTN","HMP CORD4",19, 0)
	5788	.D ADD^HM PEF("RESUL T") S HMPC NT=+$G(HMP CNT)+1,HMP LAST=IEN
	5789	"RTN","HMP CORD4",20, 0)
	5790	I IEN'>0 S HMPFINI= 1
	5791	"RTN","HMP CORD4",21, 0)
	5792	Q
	5793	"RTN","HMP CORD4",22, 0)
	5794	;
	5795	"RTN","HMP CORD4",23, 0)
	5796	ADDODG1(IE N,TEMP) ;
	5797	"RTN","HMP CORD4",24, 0)
	5798	N CNT,NOD E,NUM,PTR
	5799	"RTN","HMP CORD4",25, 0)
	5800	S NODE=$G (^ORD(100. 98,IEN,0)) D SODGNOD E(.TEMP,NO DE)
	5801	"RTN","HMP CORD4",26, 0)
	5802	S TEMP("u id")=$$SET UID^HMPUTI LS("displa yGroup","" ,IEN),TEMP ("internal ")=IEN
	5803	"RTN","HMP CORD4",27, 0)
	5804	I '$D(^OR D(100.98,I EN,1)) Q
	5805	"RTN","HMP CORD4",28, 0)
	5806	S NUM=0,C NT=0 F S NUM=$O(^OR D(100.98,I EN,1,NUM)) Q:NUM'>0 D
	5807	"RTN","HMP CORD4",29, 0)
	5808	.N ARRAY
	5809	"RTN","HMP CORD4",30, 0)
	5810	.S PTR=$G (^ORD(100. 98,IEN,1,N UM,0)) Q:P TR'>0
	5811	"RTN","HMP CORD4",31, 0)
	5812	.D ADDODG 1(PTR,.ARR AY) I '$D( ARRAY) Q
	5813	"RTN","HMP CORD4",32, 0)
	5814	.S CNT=CN T+1 M TEMP ("children ",CNT,"ite m")=ARRAY
	5815	"RTN","HMP CORD4",33, 0)
	5816	Q
	5817	"RTN","HMP CORD4",34, 0)
	5818	;
	5819	"RTN","HMP CORD4",35, 0)
	5820	SODGNODE(R ESULT,NODE ) ;
	5821	"RTN","HMP CORD4",36, 0)
	5822	N NAME,TE MP,X
	5823	"RTN","HMP CORD4",37, 0)
	5824	F X=1:1:4 D
	5825	"RTN","HMP CORD4",38, 0)
	5826	.S TEMP=$ P(NODE,U,X ) I X<4,$L (TEMP)>1 S RESULT($S (X=1:"name ",X=2:"dis playName", X=3:"abbre viation")) =TEMP
	5827	"RTN","HMP CORD4",39, 0)
	5828	.I X=4,+T EMP>0 S NA ME=$P($G(^ ORD(101.41 ,TEMP,0)), U) S RESUL T("default DialogUid" )=$$SETUID ^HMPUTILS( "orderDial og","",TEM P),RESULT( "defaultDi alogName") =NAME
	5829	"RTN","HMP CORD4",40, 0)
	5830	Q
	5831	"RTN","HMP CORD4",41, 0)
	5832	;
	5833	"RTN","HMP CORD4",42, 0)
	5834	ADDROUTE ;
	5835	"RTN","HMP CORD4",43, 0)
	5836	N CNT,IEN ,NAME,RESU LT,ROUTES, X,UID,VALU E
	5837	"RTN","HMP CORD4",44, 0)
	5838	N ERRMSG
	5839	"RTN","HMP CORD4",45, 0)
	5840	S ERRMSG= "A mumps e rror occur red while extracting routes."
	5841	"RTN","HMP CORD4",46, 0)
	5842	S CNT=1,I EN=0
	5843	"RTN","HMP CORD4",47, 0)
	5844	I +$G(HMP LAST)>0 S IEN=HMPLAS T
	5845	"RTN","HMP CORD4",48, 0)
	5846	F S IEN= $O(^PS(51. 2,IEN)) Q: IEN'>0 D
	5847	"RTN","HMP CORD4",49, 0)
	5848	.N $ES,$E T
	5849	"RTN","HMP CORD4",50, 0)
	5850	.S $ET="D ERRHDLR^H MPDERRH"
	5851	"RTN","HMP CORD4",51, 0)
	5852	.S NODE=$ P($G(^PS(5 1.2,IEN,0) ),U,1,6)
	5853	"RTN","HMP CORD4",52, 0)
	5854	.I $P(NOD E,U,5)>0 Q
	5855	"RTN","HMP CORD4",53, 0)
	5856	.S UID=$$ SETUID^HMP UTILS("rou te","",IEN )
	5857	"RTN","HMP CORD4",54, 0)
	5858	.S RESULT ("uid")=UI D,RESULT(" internal") =IEN
	5859	"RTN","HMP CORD4",55, 0)
	5860	.F X=1,2, 3,6 D
	5861	"RTN","HMP CORD4",56, 0)
	5862	..S VALUE =$P(NODE,U ,X) Q:VALU E=""
	5863	"RTN","HMP CORD4",57, 0)
	5864	..S NAME= $S(X=1:"na me",X=2:"e xternalNam e",X=3:"ab breviation ",X=6:"use InIV",1:"" )
	5865	"RTN","HMP CORD4",58, 0)
	5866	..I NAME= "" Q
	5867	"RTN","HMP CORD4",59, 0)
	5868	..I X=6 S VALUE=$S( VALUE=1:"t rue",1:"fa lse")
	5869	"RTN","HMP CORD4",60, 0)
	5870	..S RESUL T(NAME)=VA LUE
	5871	"RTN","HMP CORD4",61, 0)
	5872	.D ADD^HM PEF("RESUL T") S HMPC NT=+$G(HMP CNT)+1,HMP LAST=IEN
	5873	"RTN","HMP CORD4",62, 0)
	5874	.;S CNT=C NT+1
	5875	"RTN","HMP CORD4",63, 0)
	5876	.K RESULT
	5877	"RTN","HMP CORD4",64, 0)
	5878	I IEN'>0 S HMPFINI= 1
	5879	"RTN","HMP CORD4",65, 0)
	5880	Q
	5881	"RTN","HMP CORD4",66, 0)
	5882	;
	5883	"RTN","HMP CORD4",67, 0)
	5884	ADDSCH ;
	5885	"RTN","HMP CORD4",68, 0)
	5886	N CNT,IEN ,NAME,NODE ,NUM,RESUL T,UID,HMPS CH
	5887	"RTN","HMP CORD4",69, 0)
	5888	;D SCHALL ^ORWDPS1(. HMPSCH,0,0 )
	5889	"RTN","HMP CORD4",70, 0)
	5890	D SCHED^P SS51P1(0,. HMPSCH)
	5891	"RTN","HMP CORD4",71, 0)
	5892	N ERRMSG
	5893	"RTN","HMP CORD4",72, 0)
	5894	S ERRMSG= "A mumps e rror occur red while extracting schedules ."
	5895	"RTN","HMP CORD4",73, 0)
	5896	S CNT=0 F S CNT=$O (HMPSCH(CN T)) Q:CNT' >0 D
	5897	"RTN","HMP CORD4",74, 0)
	5898	.N $ES,$E T
	5899	"RTN","HMP CORD4",75, 0)
	5900	.S $ET="D ERRHDLR^H MPDERRH"
	5901	"RTN","HMP CORD4",76, 0)
	5902	.S NODE=$ G(HMPSCH(C NT))
	5903	"RTN","HMP CORD4",77, 0)
	5904	.S NAME=$ P(NODE,U,2 )
	5905	"RTN","HMP CORD4",78, 0)
	5906	.S IEN=$P (NODE,U)
	5907	"RTN","HMP CORD4",79, 0)
	5908	.;S IEN=$ O(^PS(51.1 ,"B",NAME, "")) I IEN '>0 Q
	5909	"RTN","HMP CORD4",80, 0)
	5910	.S UID=$$ SETUID^HMP UTILS("sch edule","", IEN)
	5911	"RTN","HMP CORD4",81, 0)
	5912	.S RESULT ("uid")=UI D,RESULT(" internal") =IEN
	5913	"RTN","HMP CORD4",82, 0)
	5914	.S RESULT ("name")=N AME
	5915	"RTN","HMP CORD4",83, 0)
	5916	.I $P(NOD E,U,3)'="" S RESULT( "externalV alue")=$P( NODE,U,3)
	5917	"RTN","HMP CORD4",84, 0)
	5918	.I $P(NOD E,U,4)'="" S RESULT( "scheduleT ype")=$P(N ODE,U,4)
	5919	"RTN","HMP CORD4",85, 0)
	5920	.D ADD^HM PEF("RESUL T") S HMPC NT=+$G(HMP CNT)+1,HMP LAST=IEN
	5921	"RTN","HMP CORD4",86, 0)
	5922	.K RESULT
	5923	"RTN","HMP CORD4",87, 0)
	5924	I CNT'>0 S HMPFINI= 1
	5925	"RTN","HMP CORD4",88, 0)
	5926	Q
	5927	"RTN","HMP CORD4",89, 0)
	5928	;
	5929	"RTN","HMP CORD4",90, 0)
	5930	LAB(RESULT ,OI) ;
	5931	"RTN","HMP CORD4",91, 0)
	5932	N CNT,I,I EN,NODE,SY N,TEMP,HMP LST
	5933	"RTN","HMP CORD4",92, 0)
	5934	S RESULT( "dialogAdd itionalInf ormation", "sendPatie ntTimes",1 ,"internal ")="LT",RE SULT("dial ogAddition alInformat ion","send PatientTim es",1,"nam e")="Today "
	5935	"RTN","HMP CORD4",93, 0)
	5936	S RESULT( "dialogAdd itionalInf ormation", "sendPatie ntTimes",2 ,"internal ")="LT+1", RESULT("di alogAdditi onalInform ation","se ndPatientT imes",2,"n ame")="Tom orrow"
	5937	"RTN","HMP CORD4",94, 0)
	5938	;
	5939	"RTN","HMP CORD4",95, 0)
	5940	D GETLST^ XPAR(.HMPL ST,"ALL"," ORWD COMMO N LAB INPT ") ;DBIA 2263
	5941	"RTN","HMP CORD4",96, 0)
	5942	S I=0 F S I=$O(HMP LST(I)) Q: 'I D
	5943	"RTN","HMP CORD4",97, 0)
	5944	. S IEN=$ P(HMPLST(I ),U,2)
	5945	"RTN","HMP CORD4",98, 0)
	5946	. K P1
	5947	"RTN","HMP CORD4",99, 0)
	5948	. S P1="d ialogAddit ionalInfor mation"
	5949	"RTN","HMP CORD4",100 ,0)
	5950	. S RESUL T("dialogA dditionalI nformation ","common" ,I,"uid")= $$SETUID^H MPUTILS("o rderable", "",IEN)
	5951	"RTN","HMP CORD4",101 ,0)
	5952	. S RESUL T("dialogA dditionalI nformation ","common" ,I,"intern al")=IEN
	5953	"RTN","HMP CORD4",102 ,0)
	5954	. S RESUL T("dialogA dditionalI nformation ","common" ,I,"name") =$P(^ORD(1 01.43,IEN, 0),U,1)
	5955	"RTN","HMP CORD4",103 ,0)
	5956	;
	5957	"RTN","HMP CORD4",104 ,0)
	5958	S NODE=$G (^ORD(101. 43,OI,"LR" ))
	5959	"RTN","HMP CORD4",105 ,0)
	5960	S RESULT( "labDetail s","specim an")=$P(NO DE,U),RESU LT("labDet ails","lab Collect")= $S($P(NODE ,U,2)=1:"t rue",1:"fa lse"),RESU LT("labDet ails","seq uence")=$P (NODE,U,3)
	5961	"RTN","HMP CORD4",106 ,0)
	5962	S RESULT( "labDetail s","maxOrd erFrequenc y")=$P(NOD E,U,4),RES ULT("labDe tails","da ilyOrderMa x")=$P(NOD E,U,5)
	5963	"RTN","HMP CORD4",107 ,0)
	5964	;
	5965	"RTN","HMP CORD4",108 ,0)
	5966	S TEMP=$P (NODE,U,6)
	5967	"RTN","HMP CORD4",109 ,0)
	5968	S RESULT( "types",1, "abb")=TEM P,RESULT(" types",1," uid")=$$SE TUID^HMPUT ILS("labTy pe","",TEM P),RESULT( "types",1, "internal" )=TEMP,RES ULT("types ",1,"type" )=$$LABTYP E(TEMP)
	5969	"RTN","HMP CORD4",110 ,0)
	5970	S TEMP=$P (NODE,U,7)
	5971	"RTN","HMP CORD4",111 ,0)
	5972	I TEMP'=" " S RESULT ("labDetai ls","labTy peInternal ")=TEMP,RE SULT("labD etails","l abTypeName ")=$S(TEMP ="I":"Inpu t",TEMP="O ":"Output" ,TEMP="B": "Both",TEM P="N":"Nei ther")
	5973	"RTN","HMP CORD4",112 ,0)
	5974	I '$D(^OR D(101.43,O I,2)) Q
	5975	"RTN","HMP CORD4",113 ,0)
	5976	S CNT=0
	5977	"RTN","HMP CORD4",114 ,0)
	5978	S I=0 F S I=$O(^OR D(101.43,O I,2,I)) Q: I'>0 D
	5979	"RTN","HMP CORD4",115 ,0)
	5980	.S SYN=$G (^ORD(101. 43,OI,2,I, 0)) Q:SYN= ""
	5981	"RTN","HMP CORD4",116 ,0)
	5982	.S CNT=CN T+1,RESULT ("synonym" ,CNT,"name ")=SYN
	5983	"RTN","HMP CORD4",117 ,0)
	5984	Q
	5985	"RTN","HMP CORD4",118 ,0)
	5986	;
	5987	"RTN","HMP CORD4",119 ,0)
	5988	LABTYPE(L) ;
	5989	"RTN","HMP CORD4",120 ,0)
	5990	I L="CH" Q "Chemist ry"
	5991	"RTN","HMP CORD4",121 ,0)
	5992	I L="MI" Q "MICROBI OLOGY"
	5993	"RTN","HMP CORD4",122 ,0)
	5994	I L="BB" Q "Blood B ank"
	5995	"RTN","HMP CORD4",123 ,0)
	5996	I L="EM" Q "Electro n Microsco py"
	5997	"RTN","HMP CORD4",124 ,0)
	5998	I L="SP" Q "Surgica l Patholog y"
	5999	"RTN","HMP CORD4",125 ,0)
	6000	I L="AU" Q "Autopsy "
	6001	"RTN","HMP CORD4",126 ,0)
	6002	I L="CY" Q "Cytolog y"
	6003	"RTN","HMP CORD4",127 ,0)
	6004	Q ""
	6005	"RTN","HMP CORD4",128 ,0)
	6006	;
	6007	"RTN","HMP CORD4",129 ,0)
	6008	OI(OITYPE) ; called by HMPEF
	6009	"RTN","HMP CORD4",130 ,0)
	6010	N CNT,ERR OR,IEN,NAM E,LINK,LIN KTYPE,NODE ,RADDET,RA DTYPE,RESU LT,TCNT,TY PE,UID,HMP TEMP
	6011	"RTN","HMP CORD4",131 ,0)
	6012	N ERRMSG
	6013	"RTN","HMP CORD4",132 ,0)
	6014	S ERRMSG= "A mumps e rror occur red while extracting orderable items."
	6015	"RTN","HMP CORD4",133 ,0)
	6016	S CNT=1,I EN=0
	6017	"RTN","HMP CORD4",134 ,0)
	6018	;
	6019	"RTN","HMP CORD4",135 ,0)
	6020	D RADTYPE (.RADTYPE, .RADDET)
	6021	"RTN","HMP CORD4",136 ,0)
	6022	I +$G(HMP LAST)>0 S IEN=HMPLAS T
	6023	"RTN","HMP CORD4",137 ,0)
	6024	I +$G(HMP ID)>0 S IE N=HMPID
	6025	"RTN","HMP CORD4",138 ,0)
	6026	F S IEN= $O(^ORD(10 1.43,IEN)) Q:IEN'>0 D I HMPM AX>0,HMPI' <HMPMAX Q
	6027	"RTN","HMP CORD4",139 ,0)
	6028	.N $ES,$E T
	6029	"RTN","HMP CORD4",140 ,0)
	6030	.S $ET="D ERRHDLR^H MPDERRH"
	6031	"RTN","HMP CORD4",141 ,0)
	6032	.K RESULT
	6033	"RTN","HMP CORD4",142 ,0)
	6034	.S TYPE=$ $VALIDOI(O ITYPE,IEN)
	6035	"RTN","HMP CORD4",143 ,0)
	6036	.I TYPE=" " Q
	6037	"RTN","HMP CORD4",144 ,0)
	6038	.S NAME=$ P(^ORD(101 .43,IEN,0) ,U),LINK=$ P($P(^ORD( 101.43,IEN ,0),U,2)," ;99",1),LI NKTYPE=$P( $P(^ORD(10 1.43,IEN,0 ),U,2),";9 9",2)
	6039	"RTN","HMP CORD4",145 ,0)
	6040	.S UID=$$ SETUID^HMP UTILS("ord erable","" ,IEN)
	6041	"RTN","HMP CORD4",146 ,0)
	6042	.S RESULT ("uid")=UI D,RESULT(" internal") =IEN
	6043	"RTN","HMP CORD4",147 ,0)
	6044	.S RESULT ("name")=N AME
	6045	"RTN","HMP CORD4",148 ,0)
	6046	.S RESULT ("link")=L INK
	6047	"RTN","HMP CORD4",149 ,0)
	6048	.S RESULT ("linktype ")=LINKTYP E
	6049	"RTN","HMP CORD4",150 ,0)
	6050	.I TYPE[" PS" D PS(. RESULT,IEN ,CNT)
	6051	"RTN","HMP CORD4",151 ,0)
	6052	.I TYPE[" RA" D RA(. RESULT,IEN ,CNT,.RADT YPE,.RADDE T)
	6053	"RTN","HMP CORD4",152 ,0)
	6054	.I TYPE[" LR" D LAB( .RESULT,IE N)
	6055	"RTN","HMP CORD4",153 ,0)
	6056	.D ADD^HM PEF("RESUL T") S HMPC NT=+$G(HMP CNT)+1,HMP LAST=IEN
	6057	"RTN","HMP CORD4",154 ,0)
	6058	.S CNT=CN T+1
	6059	"RTN","HMP CORD4",155 ,0)
	6060	I IEN'>0 S HMPFINI= 1
	6061	"RTN","HMP CORD4",156 ,0)
	6062	Q
	6063	"RTN","HMP CORD4",157 ,0)
	6064	;
	6065	"RTN","HMP CORD4",158 ,0)
	6066	PS(RESULT, IEN,PLACE) ;
	6067	"RTN","HMP CORD4",159 ,0)
	6068	N CNT,COS T,DOSE,DOS ES,DRUG,ME DS,NAME,NO DE,NUM,PSO I,SIZE,TYP E,UID,HMPD OSE
	6069	"RTN","HMP CORD4",160 ,0)
	6070	S CNT=0
	6071	"RTN","HMP CORD4",161 ,0)
	6072	I $D(^ORD (101.43,IE N,9,"B","N V RX")) S CNT=CNT+1 S RESULT(" types",CNT ,"type")=" NON-VA MED S" S MEDS( "NV RX")=" "
	6073	"RTN","HMP CORD4",162 ,0)
	6074	I $D(^ORD (101.43,IE N,9,"B","O RX")) S C NT=CNT+1 S RESULT("t ypes",CNT, "type")="O UTPATIENT MEDS" S ME DS("O RX") =""
	6075	"RTN","HMP CORD4",163 ,0)
	6076	I $D(^ORD (101.43,IE N,9,"B","R X")) S CNT =CNT+1 S R ESULT("typ es",CNT,"t ype")="MED S" S MEDS( "RX")=""
	6077	"RTN","HMP CORD4",164 ,0)
	6078	I $D(^ORD (101.43,IE N,9,"B","U D RX")) S CNT=CNT+1 S RESULT(" types",CNT ,"type")=" INPATIENT MEDS" S ME DS("UD RX" )=""
	6079	"RTN","HMP CORD4",165 ,0)
	6080	;
	6081	"RTN","HMP CORD4",166 ,0)
	6082	K DOSES
	6083	"RTN","HMP CORD4",167 ,0)
	6084	S PSOI=+$ P(^ORD(101 .43,IEN,0) ,U,2)
	6085	"RTN","HMP CORD4",168 ,0)
	6086	S TYPE="" F S TYPE =$O(MEDS(T YPE)) Q:TY PE="" D
	6087	"RTN","HMP CORD4",169 ,0)
	6088	.D DOSE^P SSOPKI1(.H MPDOSE,PSO I,TYPE,0)
	6089	"RTN","HMP CORD4",170 ,0)
	6090	.S CNT=0 F S CNT=$ O(HMPDOSE( CNT)) Q:CN T'>0 D
	6091	"RTN","HMP CORD4",171 ,0)
	6092	..S NODE= $G(HMPDOSE (CNT)),SIZ E="",UID=0 ,DRUG="",C OST=""
	6093	"RTN","HMP CORD4",172 ,0)
	6094	..S DOSE= $P(NODE,U, 5)
	6095	"RTN","HMP CORD4",173 ,0)
	6096	..I $D(DO SES(DOSE)) Q
	6097	"RTN","HMP CORD4",174 ,0)
	6098	..I $P(NO DE,U,3)'=" ",$P(NODE, U,4)'="" S SIZE=$P(N ODE,U,3)_" "_$P(NODE ,U,4)
	6099	"RTN","HMP CORD4",175 ,0)
	6100	..S DRUG= $P(NODE,U, 6),COST=$P (NODE,U,7)
	6101	"RTN","HMP CORD4",176 ,0)
	6102	..S DOSES (DOSE)=$G( SIZE)_U_DR UG_U_COST
	6103	"RTN","HMP CORD4",177 ,0)
	6104	;
	6105	"RTN","HMP CORD4",178 ,0)
	6106	S DOSE="" ,CNT=1 F S DOSE=$O( DOSES(DOSE )) Q:DOSE= "" D
	6107	"RTN","HMP CORD4",179 ,0)
	6108	.S NODE=D OSES(DOSE)
	6109	"RTN","HMP CORD4",180 ,0)
	6110	.S RESULT ("possible Dosages",C NT,"dose") =DOSE
	6111	"RTN","HMP CORD4",181 ,0)
	6112	.I $P(NOD E,U)'="" S RESULT("p ossibleDos ages",CNT, "size")=$P (NODE,U)
	6113	"RTN","HMP CORD4",182 ,0)
	6114	.I $P(NOD E,U,2)>0 D
	6115	"RTN","HMP CORD4",183 ,0)
	6116	..S NAME= $P($G(^PSD RUG($P(NOD E,U,2),0)) ,U)
	6117	"RTN","HMP CORD4",184 ,0)
	6118	..S RESUL T("possibl eDosages", CNT,"drugU id")=$$SET UID^HMPUTI LS("drug", "",$P(NODE ,U,2))
	6119	"RTN","HMP CORD4",185 ,0)
	6120	..S RESUL T("possibl eDosages", CNT,"drugI nternal")= $P(NODE,U, 2)
	6121	"RTN","HMP CORD4",186 ,0)
	6122	..S RESUL T("possibl eDosages", CNT,"drugN ame")=NAME
	6123	"RTN","HMP CORD4",187 ,0)
	6124	.;I $P(NO DE,U,3)'=" " S RESULT ("possible Dosages",C NT,"cost") =$P(NODE,U ,3)
	6125	"RTN","HMP CORD4",188 ,0)
	6126	.S CNT=CN T+1
	6127	"RTN","HMP CORD4",189 ,0)
	6128	Q
	6129	"RTN","HMP CORD4",190 ,0)
	6130	;
	6131	"RTN","HMP CORD4",191 ,0)
	6132	RA(RESULT, IEN,PLACE, RADTYPE,RA DDET) ;
	6133	"RTN","HMP CORD4",192 ,0)
	6134	N CNT,NOD E,TEMP
	6135	"RTN","HMP CORD4",193 ,0)
	6136	S CNT=0
	6137	"RTN","HMP CORD4",194 ,0)
	6138	S NODE=$G (^ORD(101. 43,IEN,0))
	6139	"RTN","HMP CORD4",195 ,0)
	6140	Q:$P(NODE ,U,3)="" ;BL;DE801 NULL SUBSC RIPT FOUND AT TEST S ITES
	6141	"RTN","HMP CORD4",196 ,0)
	6142	I $P(NODE ,U,3)'="", $P(NODE,U, 4)'="" S R ESULT("cod e")=$$SETU ID^HMPUTIL S($$LOW^XL FSTR($P(NO DE,U,4))," ",$P(NODE, U,3))
	6143	"RTN","HMP CORD4",197 ,0)
	6144	S NODE=$G (^ORD(101. 43,IEN,"RA "))
	6145	"RTN","HMP CORD4",198 ,0)
	6146	S RESULT( "imagingDe tails","co ntractMedi a")=$P(NOD E,U)
	6147	"RTN","HMP CORD4",199 ,0)
	6148	I $P(NODE ,U,2)'="" S TEMP=$P( NODE,U,2), RESULT("im agingDetai ls","proce dureType") =$S(TEMP=" B":"Board" ,TEMP="D": "Detailed" ,TEMP="S": "Series",T EMP="P":"P arent")
	6149	"RTN","HMP CORD4",200 ,0)
	6150	I $P(NODE ,U,3)'="", $D(RADTYPE ($P(NODE,U ,3))) D
	6151	"RTN","HMP CORD4",201 ,0)
	6152	.S TEMP=$ G(RADTYPE( $P(NODE,U, 3))),RESUL T("types", 1,"type")= $P(TEMP,U, 2),RESULT( "types",1, "uid")=$$S ETUID^HMPU TILS("radT ype","",$P (TEMP,U)), RESULT("in ternal")=$ P(TEMP,U), RESULT("ty pes",1,"ab b")=$P(NOD E,U,3)
	6153	"RTN","HMP CORD4",202 ,0)
	6154	.S RESULT ("imagingD etails","c ommonProce dure")=$S( $P(NODE,U, 4)=1:"true ",1:"false ")
	6155	"RTN","HMP CORD4",203 ,0)
	6156	.I $D(RAD TYPE($P(NO DE,U,3))) M RESULT(" dialogAddi tionalInfo rmation")= RADDET($P( NODE,U,3))
	6157	"RTN","HMP CORD4",204 ,0)
	6158	Q
	6159	"RTN","HMP CORD4",205 ,0)
	6160	;
	6161	"RTN","HMP CORD4",206 ,0)
	6162	RADTYPE(RA DTYPE,RADD ET) ;
	6163	"RTN","HMP CORD4",207 ,0)
	6164	;build ra diology ty pe array f or reused to load im aging type s
	6165	"RTN","HMP CORD4",208 ,0)
	6166	N ABB,CNT ,IMGTYP,SU BMIT,TCNT, URG,VALUES ,HMPTEMP,H MPX
	6167	"RTN","HMP CORD4",209 ,0)
	6168	D IMTYPSE L^ORWDRA32 (.HMPTEMP, "")
	6169	"RTN","HMP CORD4",210 ,0)
	6170	D CAT(.VA LUES),TRAN S(.VALUES) ,URGENCY(. VALUES)
	6171	"RTN","HMP CORD4",211 ,0)
	6172	S TCNT=""
	6173	"RTN","HMP CORD4",212 ,0)
	6174	F S TCNT =$O(HMPTEM P(TCNT)) Q :TCNT="" D
	6175	"RTN","HMP CORD4",213 ,0)
	6176	.S NODE=H MPTEMP(TCN T)
	6177	"RTN","HMP CORD4",214 ,0)
	6178	.S IMGTYP =$P(NODE,U ),ABB=$P(N ODE,U,3)
	6179	"RTN","HMP CORD4",215 ,0)
	6180	.D SUBMIT (.VALUES,A BB)
	6181	"RTN","HMP CORD4",216 ,0)
	6182	.S RADTYP E(ABB)=IMG TYP_U_$P(N ODE,U,2)_U _$P(NODE,U ,4)
	6183	"RTN","HMP CORD4",217 ,0)
	6184	.I $D(VAL UES) M RAD DET(ABB)=V ALUES
	6185	"RTN","HMP CORD4",218 ,0)
	6186	.;Radiolo gy Modifie r
	6187	"RTN","HMP CORD4",219 ,0)
	6188	.S I=$O(^ RA(79.2,"C ",ABB,0)) Q:'I
	6189	"RTN","HMP CORD4",220 ,0)
	6190	.S HMPX=0 ,CNT=0 F S HMPX=$O( ^RAMIS(71. 2,"AB",I,H MPX)) Q:'H MPX D
	6191	"RTN","HMP CORD4",221 ,0)
	6192	..S CNT=C NT+1
	6193	"RTN","HMP CORD4",222 ,0)
	6194	..S RADDE T(ABB,"mod ifier",CNT ,"uid")=$$ SETUID^HMP UTILS("mod ifier","", HMPX),RADD ET(ABB,"mo difier",CN T,"interna l")=HMPX
	6195	"RTN","HMP CORD4",223 ,0)
	6196	..S RADDE T(ABB,"mod ifier",CNT ,"name")=$ P(^RAMIS(7 1.2,HMPX,0 ),U)
	6197	"RTN","HMP CORD4",224 ,0)
	6198	Q
	6199	"RTN","HMP CORD4",225 ,0)
	6200	;
	6201	"RTN","HMP CORD4",226 ,0)
	6202	;Transpor t values
	6203	"RTN","HMP CORD4",227 ,0)
	6204	TRANS(RADD ET) ;
	6205	"RTN","HMP CORD4",228 ,0)
	6206	N CNT,HMP X
	6207	"RTN","HMP CORD4",229 ,0)
	6208	S CNT=0
	6209	"RTN","HMP CORD4",230 ,0)
	6210	F HMPX="A ^AMBULATOR Y","P^PORT ABLE","S^S TRETCHER", "W^WHEELCH AIR" D
	6211	"RTN","HMP CORD4",231 ,0)
	6212	.S CNT=CN T+1,RADDET ("transpor t",CNT,"ui d")=$$SETU ID^HMPUTIL S("transpo rt","",$P( HMPX,U)),R ADDET("tra nsport",CN T,"name")= $P(HMPX,U, 2),RADDET( "transport ",CNT,"int ernal")=$P (HMPX,U)
	6213	"RTN","HMP CORD4",232 ,0)
	6214	Q
	6215	"RTN","HMP CORD4",233 ,0)
	6216	;
	6217	"RTN","HMP CORD4",234 ,0)
	6218	CAT(RADDET ) ;categor y values
	6219	"RTN","HMP CORD4",235 ,0)
	6220	N CNT,HMP X
	6221	"RTN","HMP CORD4",236 ,0)
	6222	S CNT=0
	6223	"RTN","HMP CORD4",237 ,0)
	6224	F HMPX="I ^INPATIENT ","O^OUTPA TIENT","E^ EMPLOYEE", "C^CONTRAC T","S^SHAR ING","R^RE SEARCH" D
	6225	"RTN","HMP CORD4",238 ,0)
	6226	.S CNT=CN T+1,RADDET ("category ",CNT,"uid ")=$$SETUI D^HMPUTILS ("transpor t","",$P(H MPX,U)),RA DDET("cate gory",CNT, "name")=$P (HMPX,U,2) ,RADDET("c ategory",C NT,"intern al")=$P(HM PX,U)
	6227	"RTN","HMP CORD4",239 ,0)
	6228	Q
	6229	"RTN","HMP CORD4",240 ,0)
	6230	;
	6231	"RTN","HMP CORD4",241 ,0)
	6232	URGENCY(UR G) ; Get t he allowab le urgenci es and def ault
	6233	"RTN","HMP CORD4",242 ,0)
	6234	N CNT,I,H MPX
	6235	"RTN","HMP CORD4",243 ,0)
	6236	S HMPX="" ,I=0,CNT=0
	6237	"RTN","HMP CORD4",244 ,0)
	6238	F S ORX= $O(^ORD(10 1.42,"S.RA ",HMPX)) Q :HMPX="" D
	6239	"RTN","HMP CORD4",245 ,0)
	6240	. S I=$O( ^ORD(101.4 2,"S.RA",H MPX,0))
	6241	"RTN","HMP CORD4",246 ,0)
	6242	. S URG(" urgency",C NT,"uid")= $$SETUID^H MPUTILS("u rgency","" ,I),URG("u rgency",CN T,"interna l")=I
	6243	"RTN","HMP CORD4",247 ,0)
	6244	. S URG(" urgency",C NT,"name") =HMPX
	6245	"RTN","HMP CORD4",248 ,0)
	6246	. S URG(" urgency",C NT,"defaul t")="false "
	6247	"RTN","HMP CORD4",249 ,0)
	6248	. S CNT=C NT+1
	6249	"RTN","HMP CORD4",250 ,0)
	6250	S I=$O(^O RD(101.42, "B","ROUTI NE",0)) I +I=0 Q
	6251	"RTN","HMP CORD4",251 ,0)
	6252	S CNT=CNT +1
	6253	"RTN","HMP CORD4",252 ,0)
	6254	S URG("ur gency",CNT ,"uid")=$$ SETUID^HMP UTILS("urg ency","",I ),URG("urg ency",CNT, "internal" )=I
	6255	"RTN","HMP CORD4",253 ,0)
	6256	S URG("ur gency",CNT ,"name")=" Routine"
	6257	"RTN","HMP CORD4",254 ,0)
	6258	S URG("ur gency",CNT ,"default" )="true"
	6259	"RTN","HMP CORD4",255 ,0)
	6260	Q
	6261	"RTN","HMP CORD4",256 ,0)
	6262	;
	6263	"RTN","HMP CORD4",257 ,0)
	6264	SUBMIT(SUB MIT,IMGTYP ) ; Get th e location s to which the reque st may be submitted
	6265	"RTN","HMP CORD4",258 ,0)
	6266	N CNT,FIR ST,TMPLST, ASK,HMPX
	6267	"RTN","HMP CORD4",259 ,0)
	6268	S CNT=0
	6269	"RTN","HMP CORD4",260 ,0)
	6270	D EN4^RAO 7PC1(IMGTY P,"TMPLST" )
	6271	"RTN","HMP CORD4",261 ,0)
	6272	S FIRST=1
	6273	"RTN","HMP CORD4",262 ,0)
	6274	S I=0 F S I=$O(TMP LST(I)) Q: 'I D
	6275	"RTN","HMP CORD4",263 ,0)
	6276	. S CNT=C NT+1,HMPX= $P(TMPLST( I),U,1,2), SUBMIT("su bmit",CNT, "name")=$P (HMPX,U,2)
	6277	"RTN","HMP CORD4",264 ,0)
	6278	. S SUBMI T("submit" ,CNT,"defa ult")=$S(F IRST=1:"tr ue",1:"fal se")
	6279	"RTN","HMP CORD4",265 ,0)
	6280	. S SUBMI T("submit" ,CNT,"uid" )=$$SETUID ^HMPUTILS( "imagingLo cation","" ,$P(HMPX,U )),SUBMIT( "submit",C NT,"intern al")=$P(HM PX,U),FIRS T=0
	6281	"RTN","HMP CORD4",266 ,0)
	6282	S HMPX=$$ GET^XPAR(" ALL","RA S UBMIT PROM PT",1,"Q")
	6283	"RTN","HMP CORD4",267 ,0)
	6284	S ASK=$S( $L(HMPX):H MPX,1:1)
	6285	"RTN","HMP CORD4",268 ,0)
	6286	S SUBMIT( "askSubmit ")=$S(ASK= 1:"true",A SK=0:"fals e",1:"true ")
	6287	"RTN","HMP CORD4",269 ,0)
	6288	Q
	6289	"RTN","HMP CORD4",270 ,0)
	6290	;
	6291	"RTN","HMP CORD4",271 ,0)
	6292	QO ;
	6293	"RTN","HMP CORD4",272 ,0)
	6294	N IEN,NAM E,NODE,RES ULT
	6295	"RTN","HMP CORD4",273 ,0)
	6296	N ERRMSG S ERRMSG=" A mumps er ror occurr ed while e xtracting orderable items."
	6297	"RTN","HMP CORD4",274 ,0)
	6298	S IEN=0 F S IEN=$O (^ORD(101. 41,IEN)) Q :IEN'>0 D
	6299	"RTN","HMP CORD4",275 ,0)
	6300	.N $ES,$E T
	6301	"RTN","HMP CORD4",276 ,0)
	6302	.S $ET="D ERRHDLR^H MPDERRH"
	6303	"RTN","HMP CORD4",277 ,0)
	6304	.S NODE=$ G(^ORD(101 .41,IEN,0) ) I $P(NOD E,U,4)'="Q " Q
	6305	"RTN","HMP CORD4",278 ,0)
	6306	.S NAME=$ S($P(NODE, U,2)'="":$ P(NODE,U,2 ),1:$P(NOD E,U))
	6307	"RTN","HMP CORD4",279 ,0)
	6308	.S RESULT ("name")=N AME
	6309	"RTN","HMP CORD4",280 ,0)
	6310	.S RESULT ("uid")=$$ SETUID^HMP UTILS("qo" ,"",IEN),R ESULT("int ernal")=IE N
	6311	"RTN","HMP CORD4",281 ,0)
	6312	.S HMPCNT =HMPCNT+1 D ADD^HMPE F("RESULT" )
	6313	"RTN","HMP CORD4",282 ,0)
	6314	I IEN'>0 S HMPFINI= 1
	6315	"RTN","HMP CORD4",283 ,0)
	6316	Q
	6317	"RTN","HMP CORD4",284 ,0)
	6318	;
	6319	"RTN","HMP CORD4",285 ,0)
	6320	VALIDOI(OI TYPE,IEN) ;
	6321	"RTN","HMP CORD4",286 ,0)
	6322	N TEMP,TY PE
	6323	"RTN","HMP CORD4",287 ,0)
	6324	I $G(^ORD (101.43,IE N,0))'=""
	6325	"RTN","HMP CORD4",288 ,0)
	6326	S TEMP=$P (^ORD(101. 43,IEN,0), U,2)
	6327	"RTN","HMP CORD4",289 ,0)
	6328	S TYPE=$P (TEMP,";", 2)
	6329	"RTN","HMP CORD4",290 ,0)
	6330	S TYPE=$E (TYPE,3,$L (TYPE))
	6331	"RTN","HMP CORD4",291 ,0)
	6332	I OITYPE= "" Q TYPE
	6333	"RTN","HMP CORD4",292 ,0)
	6334	I TYPE["P S" Q TYPE
	6335	"RTN","HMP CORD4",293 ,0)
	6336	I OITYPE[ TYPE Q TYP E
	6337	"RTN","HMP CORD4",294 ,0)
	6338	Q ""
	6339	"RTN","HMP CORD4",295 ,0)
	6340	;
	6341	"RTN","HMP CORD5")
	6342	0^12^B8935 0961
	6343	"RTN","HMP CORD5",1,0 )
	6344	HMPCORD5 ; SLC/AGP,AS MR/EJK,RRB - Retriev ed Orderab le Items;N ov 04, 201 5 12:13:23
	6345	"RTN","HMP CORD5",2,0 )
	6346	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	6347	"RTN","HMP CORD5",3,0 )
	6348	;Per VA D irective 6 402, this routine sh ould not b e modified .
	6349	"RTN","HMP CORD5",4,0 )
	6350	;
	6351	"RTN","HMP CORD5",5,0 )
	6352	; DE2497/ RRB - Remo ved unused variable, HMP777
	6353	"RTN","HMP CORD5",6,0 )
	6354	Q
	6355	"RTN","HMP CORD5",7,0 )
	6356	;
	6357	"RTN","HMP CORD5",8,0 )
	6358	IMMTYPE ;
	6359	"RTN","HMP CORD5",9,0 )
	6360	N ORWLST, ORDT,HMPIM M
	6361	"RTN","HMP CORD5",10, 0)
	6362	S (ORWLST ,ORDT)=""
	6363	"RTN","HMP CORD5",11, 0)
	6364	S (HMPCNT ,HMPLAST,H MPI)=0
	6365	"RTN","HMP CORD5",12, 0)
	6366	N IMM
	6367	"RTN","HMP CORD5",13, 0)
	6368	;D IMMTYP E^ORWPCE2( .ORWLST,OR DT) ;use existing broker cal l ORWPCE G ET IMMUNIZ ATION TYPE
	6369	"RTN","HMP CORD5",14, 0)
	6370	N IEN,CNT ,BINDEX S (IEN,CNT)= 0
	6371	"RTN","HMP CORD5",15, 0)
	6372	S:'$G(ORD T) ORDT=DT
	6373	"RTN","HMP CORD5",16, 0)
	6374	; ^AUTTIM M - IMMUNI ZATION fil e #9999999 .14, *DB IA2454 sub scription needed*
	6375	"RTN","HMP CORD5",17, 0)
	6376	F S IEN= $O(^AUTTIM M(IEN)) Q: IEN=""!(IE N'?1N.N) D
	6377	"RTN","HMP CORD5",18, 0)
	6378	. I $D(^A UTTIMM(IEN ,0))#2,+$P (^(0),"^", 7)=0 S CNT =CNT+1,ORW LST(CNT)=I EN_"^"_$G( ^(0))
	6379	"RTN","HMP CORD5",19, 0)
	6380	. Q
	6381	"RTN","HMP CORD5",20, 0)
	6382	S IMM="", HMPIMM=""
	6383	"RTN","HMP CORD5",21, 0)
	6384	F S IMM= $O(ORWLST( IMM)) Q:IM M="" D
	6385	"RTN","HMP CORD5",22, 0)
	6386	. S HMPIM M("localId ")=$P(ORWL ST(IMM),"^ ",1) ;get the ien f or each it em found
	6387	"RTN","HMP CORD5",23, 0)
	6388	. S HMPIM M("name")= $P(ORWLST( IMM),"^",2 ) ;get the name for each item found
	6389	"RTN","HMP CORD5",24, 0)
	6390	. S HMPIM M("mnemoni c")=$P(ORW LST(IMM)," ^",3) ;ge t the mnem onic for e ach entry
	6391	"RTN","HMP CORD5",25, 0)
	6392	. S HMPIM M("uid")=$ $SETUID^HM PUTILS("im munization ",,HMPIMM( "localId") ) ;set th e uid stri ng
	6393	"RTN","HMP CORD5",26, 0)
	6394	. S HMPCN T=HMPCNT+1
	6395	"RTN","HMP CORD5",27, 0)
	6396	. D ADD^H MPEF("HMPI MM") S HMP LAST=HMPCN T ;add it to the JS ON results array
	6397	"RTN","HMP CORD5",28, 0)
	6398	. Q
	6399	"RTN","HMP CORD5",29, 0)
	6400	S HMPFINI =1
	6401	"RTN","HMP CORD5",30, 0)
	6402	Q
	6403	"RTN","HMP CORD5",31, 0)
	6404	;
	6405	"RTN","HMP CORD5",32, 0)
	6406	SIGNS ;
	6407	"RTN","HMP CORD5",33, 0)
	6408	N IEN,NAM E,HMPSS
	6409	"RTN","HMP CORD5",34, 0)
	6410	S IEN=0,H MPCNT=0,HM PI=0
	6411	"RTN","HMP CORD5",35, 0)
	6412	F S IEN= $O(^GMRD(1 20.83,IEN) ) Q:IEN="" !(IEN'?1N. N) D
	6413	"RTN","HMP CORD5",36, 0)
	6414	. S NAME= $P($G(^GMR D(120.83,I EN,0)),"^" ,1)
	6415	"RTN","HMP CORD5",37, 0)
	6416	. Q:NAME' ]""
	6417	"RTN","HMP CORD5",38, 0)
	6418	. S HMPSS ("localId" )=IEN
	6419	"RTN","HMP CORD5",39, 0)
	6420	. S HMPSS ("name")=N AME
	6421	"RTN","HMP CORD5",40, 0)
	6422	. S HMPSS ("uid")=$$ SETUID^HMP UTILS("sig n-symptom" ,,HMPSS("l ocalId"))
	6423	"RTN","HMP CORD5",41, 0)
	6424	. S HMPCN T=HMPCNT+1
	6425	"RTN","HMP CORD5",42, 0)
	6426	. D ADD^H MPEF("HMPS S") S HMPL AST=HMPCNT
	6427	"RTN","HMP CORD5",43, 0)
	6428	. Q
	6429	"RTN","HMP CORD5",44, 0)
	6430	S HMPFINI =1
	6431	"RTN","HMP CORD5",45, 0)
	6432	Q
	6433	"RTN","HMP CORD5",46, 0)
	6434	;
	6435	"RTN","HMP CORD5",47, 0)
	6436	ALLTYPE ; deprecated
	6437	"RTN","HMP CORD5",48, 0)
	6438	;N ORX,RO OT,XP,CNT, ORFILE,ORS RC,ORIEN,O RREAX,ALLC NT,ALLLAST ,ALLITEM
	6439	"RTN","HMP CORD5",49, 0)
	6440	;S ORIEN= 0,CNT=0,OR SRC=0,ORFI LE="",ALLC NT=0,ALLLA ST=0
	6441	"RTN","HMP CORD5",50, 0)
	6442	;S X=""
	6443	"RTN","HMP CORD5",51, 0)
	6444	;F ROOT=" ^GMRD(120. 82)","^PSN DF(50.6)", "^PSNDF(50 .67)","^PS DRUG(""B"" )","^PS(50 .416)","^P S(50.605)" D
	6445	"RTN","HMP CORD5",52, 0)
	6446	;F ROOT=" ^GMRD(120. 82,""B"")" ,"^GMRD(12 0.82,""D"" )","^PSDRU G(""C"")", "^PS(50.41 6,""P"")", "^PS(50.60 5,""C"")", $$B^PSNAPI S,$$T^PSNA PIS,"^PSDR UG(""B"")" D
	6447	"RTN","HMP CORD5",53, 0)
	6448	;F ROOT=" ^GMRD(120. 82,""B"")" ,"^PSDRUG( ""C"")","^ PS(50.416, ""P"")","^ PS(50.605, ""C"")",$$ B^PSNAPIS, $$T^PSNAPI S,"^PSDRUG (""B"")" D
	6449	"RTN","HMP CORD5",54, 0)
	6450	;. S ORSR C=$G(ORSRC )+1,ORFILE =$P(ROOT," ,",1)_")", ORSRC(ORSR C)=$P($T(F ILENAME+OR SRC),";;", 2)
	6451	"RTN","HMP CORD5",55, 0)
	6452	;. I (ORS RC'=2),(OR SRC'=6) S: '$D(Y(ORIE N_";"_ROOT )) CNT=CNT +1,Y(ORIEN _";"_ROOT) =ORSRC_U_O RSRC(ORSRC )_U_U_U_"T OP"_U_"+"
	6453	"RTN","HMP CORD5",56, 0)
	6454	;. I ORSR C=1!(ORSRC =2) D
	6455	"RTN","HMP CORD5",57, 0)
	6456	;.. F S X=$O(@ROOT @(X)) Q:X= "" D
	6457	"RTN","HMP CORD5",58, 0)
	6458	;... I OR SRC=1,X="O THER ALLER GY/ADVERSE REACTION" Q ;don't send this entry
	6459	"RTN","HMP CORD5",59, 0)
	6460	;... S OR IEN=$O(@RO OT@(X,0))
	6461	"RTN","HMP CORD5",60, 0)
	6462	;... I $L ($T(SCREEN ^XTID)) I $$SCREEN^X TID(120.82 ,.01,ORIEN _",") Q ; 233 Is ter m active?
	6463	"RTN","HMP CORD5",61, 0)
	6464	;... I OR SRC=2 S:'$ D(Y(ORIEN_ ";"_ROOT)) CNT=CNT+1 ,Y(ORIEN_" ;"_ROOT)=O RIEN_U_$P( $G(^GMRD(1 20.82,+ORI EN,0)),U,1 )_" <"_X_" >"_ROOT
	6465	"RTN","HMP CORD5",62, 0)
	6466	;... I OR SRC'=2 S: '$D(Y(ORIE N_";"_ROOT )) CNT=CNT +1,Y(ORIEN _";"_ROOT) =ORIEN_U_X _ROOT
	6467	"RTN","HMP CORD5",63, 0)
	6468	;... S Y( ORIEN_";"_ ROOT)=Y(OR IEN_";"_RO OT)_U_$P($ G(^GMRD(12 0.82,+ORIE N,0)),U,2) _U_$S(ORSR C=2:1,1:OR SRC)
	6469	"RTN","HMP CORD5",64, 0)
	6470	;.. S XP= X F S XP= $O(@ROOT@( XP)) Q:XP= "" Q:$E(X P,1,$L(X)) '=X D
	6471	"RTN","HMP CORD5",65, 0)
	6472	;... I OR SRC=1,XP=" OTHER ALLE RGY/ADVERS E REACTION " Q ;don' t send thi s entry
	6473	"RTN","HMP CORD5",66, 0)
	6474	;... S OR IEN=$O(@RO OT@(XP,0))
	6475	"RTN","HMP CORD5",67, 0)
	6476	;... I $L ($T(SCREEN ^XTID)) I $$SCREEN^X TID(120.82 ,.01,ORIEN _",") Q ; 233 Is ter m active?
	6477	"RTN","HMP CORD5",68, 0)
	6478	;... I OR SRC=2 S:'$ D(Y(ORIEN_ ";"_ROOT)) CNT=CNT+1 ,Y(ORIEN_" ;"_ROOT)=O RIEN_U_$P( $G(^GMRD(1 20.82,+ORI EN,0)),U,1 )_" <"_XP_ ">"_ROOT ; partial m atches
	6479	"RTN","HMP CORD5",69, 0)
	6480	;... I OR SRC'=2 S: '$D(Y(ORIE N_";"_ROOT )) CNT=CNT +1,Y(ORIEN _";"_ROOT) =ORIEN_U_X P_ROOT
	6481	"RTN","HMP CORD5",70, 0)
	6482	;... S:'$ D(Y(ORIEN_ ";"_ROOT)) Y(ORIEN_" ;"_ROOT)=Y (ORIEN_";" _ROOT)_U_$ P($G(^GMRD (120.82,+O RIEN,0)),U ,2)_U_$S(O RSRC=2:1,1 :ORSRC)
	6483	"RTN","HMP CORD5",71, 0)
	6484	;.. I (OR SRC>2),(OR SRC'=4),(O RSRC'=5),( ORSRC'=6) D
	6485	"RTN","HMP CORD5",72, 0)
	6486	;.. N COD E,LIST,VAL ,NAME
	6487	"RTN","HMP CORD5",73, 0)
	6488	;.. S COD E=$S(ORSRC =3:"S VAL= $$TGTOG2^P SNAPIS(X,. LIST)",ORS RC=4:"D TR DNAME(X,.L IST)",ORSR C=7:"D ING SRCH(X,.LI ST)",ORSRC =8:"D CLAS RCH(X,.LIS T)",1:"") Q:'$L(CODE )
	6489	"RTN","HMP CORD5",74, 0)
	6490	;.. X COD E I $D(LIS T) S ORIEN =0 F S OR IEN=$O(LIS T(ORIEN)) Q:'ORIEN D
	6491	"RTN","HMP CORD5",75, 0)
	6492	;... S NA ME=$P(LIST (ORIEN),U, 2)
	6493	"RTN","HMP CORD5",76, 0)
	6494	;... Q:$E ($P(LIST(O RIEN),U,2) ,1,$L(X))' =X
	6495	"RTN","HMP CORD5",77, 0)
	6496	;... I $L ($T(SCREEN ^XTID)) I $$SCREEN^X TID($S(ORS RC=3:50.6, (ORSRC=4): 50.6,ORSRC =7:50.416, ORSRC=8:50 .605,1:0), .01,ORIEN_ ",") Q
	6497	"RTN","HMP CORD5",78, 0)
	6498	;... S:'$ D(Y(ORIEN_ ";"_ROOT)) CNT=CNT+1 ,Y(ORIEN_" ;"_ROOT)=O RIEN_U_NAM E_ROOT_U_" D"_U_ORSRC
	6499	"RTN","HMP CORD5",79, 0)
	6500	;.. I ORS RC=4 D
	6501	"RTN","HMP CORD5",80, 0)
	6502	;.. N COD E,LIST,VAL ,NAME
	6503	"RTN","HMP CORD5",81, 0)
	6504	;.. S COD E="D TRDNA ME(X,.LIST )"
	6505	"RTN","HMP CORD5",82, 0)
	6506	;.. X COD E I $D(LIS T) S ORIEN =0 F S OR IEN=$O(LIS T(ORIEN)) Q:'ORIEN D
	6507	"RTN","HMP CORD5",83, 0)
	6508	;... S NA ME=$P(LIST (ORIEN),U, 2)
	6509	"RTN","HMP CORD5",84, 0)
	6510	;... Q:$E ($P(LIST(O RIEN),U,2) ,1,$L(X))' =X
	6511	"RTN","HMP CORD5",85, 0)
	6512	;... I $L ($T(SCREEN ^XTID)) I $$SCREEN^X TID(50.6,. 01,+LIST(O RIEN)_",") Q
	6513	"RTN","HMP CORD5",86, 0)
	6514	;... S:'$ D(Y(ORIEN_ ";"_ROOT)) CNT=CNT+1 ,Y(ORIEN_" ;"_ROOT)=+ LIST(ORIEN )_U_NAME_R OOT_U_"D"_ U_ORSRC
	6515	"RTN","HMP CORD5",87, 0)
	6516	;S CNT=""
	6517	"RTN","HMP CORD5",88, 0)
	6518	;F S CNT =$O(Y(CNT) ) Q:CNT="" D
	6519	"RTN","HMP CORD5",89, 0)
	6520	;. K ALLE RGY
	6521	"RTN","HMP CORD5",90, 0)
	6522	;. S ALLI TEM=$G(Y(C NT))
	6523	"RTN","HMP CORD5",91, 0)
	6524	;. I Y(CN T)["^TOP^+ " Q
	6525	"RTN","HMP CORD5",92, 0)
	6526	;. I Y(CN T)'["^TOP^ +" D
	6527	"RTN","HMP CORD5",93, 0)
	6528	;.. S ALL ERGY("loca lId")=$P(A LLITEM,"^" ,1)
	6529	"RTN","HMP CORD5",94, 0)
	6530	;.. S ALL ERGY("name ")=$P(ALLI TEM,"^",2)
	6531	"RTN","HMP CORD5",95, 0)
	6532	;.. S ALL ERGY("root ")=$P(ALLI TEM,"^",3)
	6533	"RTN","HMP CORD5",96, 0)
	6534	;.. S ALL ERGY("uid" )=$$SETUID ^HMPUTILS( "allergy-l ist",,ALLE RGY("local Id")_";"_$ TR(ALLERGY ("root")," ""","")) ;set the u id string
	6535	"RTN","HMP CORD5",97, 0)
	6536	;.. S HMP CNT=$G(HMP CNT)+1 D A DD^HMPEF(" ALLERGY") S HMPLAST= HMPCNT
	6537	"RTN","HMP CORD5",98, 0)
	6538	;.. Q
	6539	"RTN","HMP CORD5",99, 0)
	6540	;. Q
	6541	"RTN","HMP CORD5",100 ,0)
	6542	;S HMPFIN I=1
	6543	"RTN","HMP CORD5",101 ,0)
	6544	;K X,Y
	6545	"RTN","HMP CORD5",102 ,0)
	6546	Q
	6547	"RTN","HMP CORD5",103 ,0)
	6548	;
	6549	"RTN","HMP CORD5",104 ,0)
	6550	VTYPE ; ;V ITALS TYPE
	6551	"RTN","HMP CORD5",105 ,0)
	6552	N IEN
	6553	"RTN","HMP CORD5",106 ,0)
	6554	S (HMPCNT ,HMPI,HMPL AST,IEN)=0
	6555	"RTN","HMP CORD5",107 ,0)
	6556	F S IEN= $O(^GMRD(1 20.51,IEN) ) Q:IEN="" !(IEN'?1N. N) D
	6557	"RTN","HMP CORD5",108 ,0)
	6558	. S VTYPE ("localId" )=IEN
	6559	"RTN","HMP CORD5",109 ,0)
	6560	. S VTYPE ("name")=$ P(^GMRD(12 0.51,IEN,0 ),"^",1)
	6561	"RTN","HMP CORD5",110 ,0)
	6562	. S VTYPE ("abbrevia tion")=$P( ^GMRD(120. 51,IEN,0), "^",2)
	6563	"RTN","HMP CORD5",111 ,0)
	6564	. S VTYPE ("rate")=$ P(^GMRD(12 0.51,IEN,0 ),"^",4)
	6565	"RTN","HMP CORD5",112 ,0)
	6566	. I VTYPE ("rate")]" " S VTYPE( "rate")=$S (VTYPE("ra te")=1:"YE S",1:"NO")
	6567	"RTN","HMP CORD5",113 ,0)
	6568	. S VTYPE ("pce")=$P (^GMRD(120 .51,IEN,0) ,"^",7)
	6569	"RTN","HMP CORD5",114 ,0)
	6570	. S VTYPE ("vuid")=" urn:va:vui d:"_$P($G( ^GMRD(120. 51,IEN,"VU ID")),"^", 1)
	6571	"RTN","HMP CORD5",115 ,0)
	6572	. S VTYPE ("masterVu id")=$P($G (^GMRD(120 .51,IEN,"V UID")),"^" ,2)
	6573	"RTN","HMP CORD5",116 ,0)
	6574	. I VTYPE ("masterVu id")]"" S VTYPE("mas terVuid")= $S(VTYPE(" masterVuid ")=1:"YES" ,1:"NO")
	6575	"RTN","HMP CORD5",117 ,0)
	6576	. S VTYPE ("effectiv e")=$P($G( ^GMRD(120. 51,IEN,"TE RMSTATUS", 1,0)),"^", 1)
	6577	"RTN","HMP CORD5",118 ,0)
	6578	. I VTYPE ("effectiv e")]"" S V TYPE("effe ctive")=$$ JSONDT^HMP UTILS(VTYP E("effecti ve"))
	6579	"RTN","HMP CORD5",119 ,0)
	6580	. S VTYPE ("status") =$P($G(^GM RD(120.51, IEN,"TERMS TATUS",1,0 )),"^",2)
	6581	"RTN","HMP CORD5",120 ,0)
	6582	. I VTYPE ("status") ]"" S VTYP E("status" )=$S(VTYPE ("status") =1:"ACTIVE ",1:"INACT IVE")
	6583	"RTN","HMP CORD5",121 ,0)
	6584	. S VTYPE ("uid")=$$ SETUID^HMP UTILS("vit al-type",, VTYPE("loc alId"))
	6585	"RTN","HMP CORD5",122 ,0)
	6586	. S HMPCN T=HMPCNT+1 D ADD^HMP EF("VTYPE" ) S HMPLAS T=HMPCNT
	6587	"RTN","HMP CORD5",123 ,0)
	6588	S HMPFINI =1
	6589	"RTN","HMP CORD5",124 ,0)
	6590	K VTYPE
	6591	"RTN","HMP CORD5",125 ,0)
	6592	Q
	6593	"RTN","HMP CORD5",126 ,0)
	6594	;
	6595	"RTN","HMP CORD5",127 ,0)
	6596	VQUAL ; VI TALS QUALI FIER
	6597	"RTN","HMP CORD5",128 ,0)
	6598	N IEN,I
	6599	"RTN","HMP CORD5",129 ,0)
	6600	S (HMPCNT ,HMPI,HMPL AST,IEN)=0
	6601	"RTN","HMP CORD5",130 ,0)
	6602	F S IEN= $O(^GMRD(1 20.52,IEN) ) Q:IEN="" !(IEN'?1N. N) D
	6603	"RTN","HMP CORD5",131 ,0)
	6604	. S VQUAL ("localId" )=IEN
	6605	"RTN","HMP CORD5",132 ,0)
	6606	. S VQUAL ("synonym" )=$P(^GMRD (120.52,IE N,0),"^",2 )
	6607	"RTN","HMP CORD5",133 ,0)
	6608	. S I=0
	6609	"RTN","HMP CORD5",134 ,0)
	6610	. K VQUAL ("vtype") ;ejk - sto p bleed ov er from pr evious ext racts.
	6611	"RTN","HMP CORD5",135 ,0)
	6612	. F S I= $O(^GMRD(1 20.52,IEN, 1,I)) Q:I= ""!(I'?1N. N) D
	6613	"RTN","HMP CORD5",136 ,0)
	6614	.. S VQUA L("vtype", I,"vitalTy pe")=$P($G (^GMRD(120 .52,IEN,1, I,0)),"^", 1)
	6615	"RTN","HMP CORD5",137 ,0)
	6616	.. S VQUA L("vtype", I,"categor y")=$P($G( ^GMRD(120. 52,IEN,1,I ,0)),"^",2 )
	6617	"RTN","HMP CORD5",138 ,0)
	6618	.. ;ejk D E294 - vit al type an d vital ca tegory nee d to be pr esented as urn entri es and not the name
	6619	"RTN","HMP CORD5",139 ,0)
	6620	.. ;I VQU AL("vtype" ,I,"vitalT ype")]"" S VQUAL("vt ype",I,"vi talType")= $P($G(^GMR D(120.51,I ,0)),"^",1 )
	6621	"RTN","HMP CORD5",140 ,0)
	6622	.. ;I VQU AL("vtype" ,I,"catego ry")]"" S VQUAL("vty pe",I,"cat egory")=$P ($G(^GMRD( 120.53,I,0 )),"^",1)
	6623	"RTN","HMP CORD5",141 ,0)
	6624	.. I VQUA L("vtype", I,"vitalTy pe")]"" S VQUAL("vty pe",I,"vit alType")=$ $SETUID^HM PUTILS("vi tal-type", ,VQUAL("vt ype",I,"vi talType"))
	6625	"RTN","HMP CORD5",142 ,0)
	6626	.. I VQUA L("vtype", I,"categor y")]"" S V QUAL("vtyp e",I,"cate gory")=$$S ETUID^HMPU TILS("vita l-category ",,VQUAL(" vtype",I," category") )
	6627	"RTN","HMP CORD5",143 ,0)
	6628	.. Q
	6629	"RTN","HMP CORD5",144 ,0)
	6630	. S VQUAL ("vuid")=" urn:va:vui d:"_$P($G( ^GMRD(120. 52,IEN,"VU ID")),"^", 1)
	6631	"RTN","HMP CORD5",145 ,0)
	6632	. S VQUAL ("masterVu id")=$P($G (^GMRD(120 .52,IEN,"V UID")),"^" ,2)
	6633	"RTN","HMP CORD5",146 ,0)
	6634	. I VQUAL ("masterVu id")]"" S VQUAL("mas terVuid")= $S(VQUAL(" masterVuid ")=1:"YES" ,1:"NO")
	6635	"RTN","HMP CORD5",147 ,0)
	6636	. S VQUAL ("effectiv eDate")=$P ($G(^GMRD( 120.52,IEN ,"TERMSTAT US",1,0)), "^",1)
	6637	"RTN","HMP CORD5",148 ,0)
	6638	. I VQUAL ("effectiv eDate")]"" S VQUAL(" effectiveD ate")=$$JS ONDT^HMPUT ILS(VQUAL( "effective Date"))
	6639	"RTN","HMP CORD5",149 ,0)
	6640	. S VQUAL ("status") =$P($G(^GM RD(120.52, IEN,"TERMS TATUS",1,0 )),"^",2)
	6641	"RTN","HMP CORD5",150 ,0)
	6642	. I VQUAL ("status") ]"" S VQUA L("status" )=$S(VQUAL ("status") =1:"ACTIVE ",1:"INACT IVE")
	6643	"RTN","HMP CORD5",151 ,0)
	6644	. S VQUAL ("uid")=$$ SETUID^HMP UTILS("vit al-qualifi er",,VQUAL ("localId" ))
	6645	"RTN","HMP CORD5",152 ,0)
	6646	. S VQUAL ("qualifie r")=$$SETU ID^HMPUTIL S("vital-q ualifier", ,VQUAL("lo calId"))
	6647	"RTN","HMP CORD5",153 ,0)
	6648	. ;ejk DE 295 do not include q ualifier i f it is th e same val ue as the uid
	6649	"RTN","HMP CORD5",154 ,0)
	6650	. I VQUAL ("uid")=VQ UAL("quali fier") K V QUAL("qual ifier")
	6651	"RTN","HMP CORD5",155 ,0)
	6652	. S HMPCN T=HMPCNT+1 D ADD^HMP EF("VQUAL" ) S HMPLAS T=HMPCNT
	6653	"RTN","HMP CORD5",156 ,0)
	6654	S HMPFINI =1
	6655	"RTN","HMP CORD5",157 ,0)
	6656	K VQUAL
	6657	"RTN","HMP CORD5",158 ,0)
	6658	Q
	6659	"RTN","HMP CORD5",159 ,0)
	6660	;
	6661	"RTN","HMP CORD5",160 ,0)
	6662	VCAT ;VITA LS CATAGOR Y
	6663	"RTN","HMP CORD5",161 ,0)
	6664	N IEN,I
	6665	"RTN","HMP CORD5",162 ,0)
	6666	S (HMPCNT ,HMPI,HMPL AST,IEN)=0
	6667	"RTN","HMP CORD5",163 ,0)
	6668	F S IEN= $O(^GMRD(1 20.53,IEN) ) Q:IEN="" !(IEN'?1N. N) D
	6669	"RTN","HMP CORD5",164 ,0)
	6670	. S VCAT( "localId") =IEN
	6671	"RTN","HMP CORD5",165 ,0)
	6672	. I $P($G (^GMRD(120 .53,IEN,0) ),"^",1)]" " S VCAT(" category") =$P(^GMRD( 120.53,IEN ,0),"^",1)
	6673	"RTN","HMP CORD5",166 ,0)
	6674	. I $P($G (^GMRD(120 .53,IEN,0) ),"^",2)]" " S VCAT(" synonym")= $P(^GMRD(1 20.53,IEN, 0),"^",2)
	6675	"RTN","HMP CORD5",167 ,0)
	6676	. I $G(VC AT("synony m"))="" K VCAT("syno nym")
	6677	"RTN","HMP CORD5",168 ,0)
	6678	. S I=0
	6679	"RTN","HMP CORD5",169 ,0)
	6680	. ;EJK - kill off v type array to stop i nheriting values fro m previous extracts
	6681	"RTN","HMP CORD5",170 ,0)
	6682	. K VCAT( "vtype")
	6683	"RTN","HMP CORD5",171 ,0)
	6684	. F S I= $O(^GMRD(1 20.53,IEN, 1,I)) Q:I= ""!(I'?1N. N) D
	6685	"RTN","HMP CORD5",172 ,0)
	6686	.. ;ejk D E298 do no t send nul l values.
	6687	"RTN","HMP CORD5",173 ,0)
	6688	.. I $P($ G(^GMRD(12 0.53,IEN,1 ,I,0)),"^" ,1)]"" S V CAT("vtype ",I,"vital Type")=$P( $G(^GMRD(1 20.53,IEN, 1,I,0)),"^ ",1)
	6689	"RTN","HMP CORD5",174 ,0)
	6690	.. I VCAT ("vtype",I ,"vitalTyp e")]"" S V CAT("vtype ",I,"vital Type")=$$S ETUID^HMPU TILS("vita l-type",,V CAT("vtype ",I,"vital Type"))
	6691	"RTN","HMP CORD5",175 ,0)
	6692	.. I $P($ G(^GMRD(12 0.53,IEN,1 ,I,0)),"^" ,3)]"" S V CAT("vtype ",I,"maxEn tries")=$P ($G(^GMRD( 120.53,IEN ,1,I,0))," ^",3)
	6693	"RTN","HMP CORD5",176 ,0)
	6694	.. I $P($ G(^GMRD(12 0.53,IEN,1 ,I,0)),"^" ,5)]"" S V CAT("vtype ",I,"print Order")=$P ($G(^GMRD( 120.53,IEN ,1,I,0))," ^",5)
	6695	"RTN","HMP CORD5",177 ,0)
	6696	.. I $P($ G(^GMRD(12 0.53,IEN,1 ,I,0)),"^" ,6)]"" S V CAT("vtype ",I,"editO rder")=$P( $G(^GMRD(1 20.53,IEN, 1,I,0)),"^ ",6)
	6697	"RTN","HMP CORD5",178 ,0)
	6698	.. I $P($ G(^GMRD(12 0.53,IEN,1 ,I,0)),"^" ,7)]"" S V CAT("vtype ",I,"defau ltQualifie r")=$P($G( ^GMRD(120. 53,IEN,1,I ,0)),"^",7 ),VCAT("vt ype",I,"de faultQuali fier")=$$S ETUID^HMPU TILS("vita l-qualifie r",,VCAT(" vtype",I," defaultQua lifier"))
	6699	"RTN","HMP CORD5",179 ,0)
	6700	.. Q
	6701	"RTN","HMP CORD5",180 ,0)
	6702	. S VCAT( "vuid")="u rn:va:vuid :"_$P($G(^ GMRD(120.5 3,IEN,"VUI D")),"^",1 )
	6703	"RTN","HMP CORD5",181 ,0)
	6704	. S VCAT( "masterVui d")=$P($G( ^GMRD(120. 53,IEN,"VU ID")),"^", 2)
	6705	"RTN","HMP CORD5",182 ,0)
	6706	. I VCAT( "masterVui d")]"" S V CAT("maste rVuid")=$S (VCAT("mas terVuid")= 1:"YES",1: "NO")
	6707	"RTN","HMP CORD5",183 ,0)
	6708	. S VCAT( "effective Date")=$P( $G(^GMRD(1 20.53,IEN, "TERMSTATU S",1,0))," ^",1)
	6709	"RTN","HMP CORD5",184 ,0)
	6710	. I VCAT( "effective Date")]"" S VCAT("ef fectiveDat e")=$$JSON DT^HMPUTIL S(VCAT("ef fectiveDat e"))
	6711	"RTN","HMP CORD5",185 ,0)
	6712	. S VCAT( "status")= $P($G(^GMR D(120.53,I EN,"TERMST ATUS",1,0) ),"^",2)
	6713	"RTN","HMP CORD5",186 ,0)
	6714	. I VCAT( "status")] "" S VCAT( "status")= $S(VCAT("s tatus")=1: "ACTIVE",1 :"INACTIVE ")
	6715	"RTN","HMP CORD5",187 ,0)
	6716	. S VCAT( "uid")=$$S ETUID^HMPU TILS("vita l-category ",,VCAT("l ocalId"))
	6717	"RTN","HMP CORD5",188 ,0)
	6718	. S HMPCN T=HMPCNT+1 D ADD^HMP EF("VCAT") S HMPLAST =HMPCNT
	6719	"RTN","HMP CORD5",189 ,0)
	6720	. Q
	6721	"RTN","HMP CORD5",190 ,0)
	6722	S HMPFINI =1
	6723	"RTN","HMP CORD5",191 ,0)
	6724	K VCAT
	6725	"RTN","HMP CORD5",192 ,0)
	6726	Q
	6727	"RTN","HMP CORD5",193 ,0)
	6728	;
	6729	"RTN","HMP CORD5",194 ,0)
	6730	INGSRCH(NA ME,LIST) ;
	6731	"RTN","HMP CORD5",195 ,0)
	6732	K ^TMP($J ,"ORWDAL32 ")
	6733	"RTN","HMP CORD5",196 ,0)
	6734	D NAME^PS N50P41(NAM E,"ORWDAL3 2")
	6735	"RTN","HMP CORD5",197 ,0)
	6736	I $D(^TMP ($J,"ORWDA L32","P")) D
	6737	"RTN","HMP CORD5",198 ,0)
	6738	. N I S I ="" F S I =$O(^TMP($ J,"ORWDAL3 2","P",I)) Q:I="" D
	6739	"RTN","HMP CORD5",199 ,0)
	6740	.. N J S J=0 F S J =$O(^TMP($ J,"ORWDAL3 2","P",I,J )) Q:'J S LIST(J)=J _U_I
	6741	"RTN","HMP CORD5",200 ,0)
	6742	K ^TMP($J ,"ORWDAL32 ")
	6743	"RTN","HMP CORD5",201 ,0)
	6744	Q
	6745	"RTN","HMP CORD5",202 ,0)
	6746	CLASRCH(NA ME,LIST) ;
	6747	"RTN","HMP CORD5",203 ,0)
	6748	K ^TMP($J ,"ORWDAL32 ")
	6749	"RTN","HMP CORD5",204 ,0)
	6750	D C^PSN50 P65(,NAME, "ORWDAL32" )
	6751	"RTN","HMP CORD5",205 ,0)
	6752	I $D(^TMP ($J,"ORWDA L32","C")) D
	6753	"RTN","HMP CORD5",206 ,0)
	6754	. N I S I ="" F S I =$O(^TMP($ J,"ORWDAL3 2","C",I)) Q:I="" D
	6755	"RTN","HMP CORD5",207 ,0)
	6756	.. N J S J=0 F S J =$O(^TMP($ J,"ORWDAL3 2","C",I,J )) Q:'J S LIST(J)=J _U_$G(^TMP ($J,"ORWDA L32",J,1))
	6757	"RTN","HMP CORD5",208 ,0)
	6758	K ^TMP($J ,"ORWDAL32 ")
	6759	"RTN","HMP CORD5",209 ,0)
	6760	Q
	6761	"RTN","HMP CORD5",210 ,0)
	6762	TRDNAME(NA ME,LIST) ;
	6763	"RTN","HMP CORD5",211 ,0)
	6764	K ^TMP($J ,"ORWDAL32 ")
	6765	"RTN","HMP CORD5",212 ,0)
	6766	D ALL^PSN 5067(,NAME ,,"ORWDAL3 2")
	6767	"RTN","HMP CORD5",213 ,0)
	6768	I $D(^TMP ($J,"ORWDA L32","B")) D
	6769	"RTN","HMP CORD5",214 ,0)
	6770	. N I S I ="" F S I =$O(^TMP($ J,"ORWDAL3 2","B",I)) Q:I="" D
	6771	"RTN","HMP CORD5",215 ,0)
	6772	.. N J,K S J=$O(^TM P($J,"ORWD AL32","B", I,0)) Q:'J S K=$$TG TOG^PSNAPI S(I),LIST( J)=K_U_$G( ^TMP($J,"O RWDAL32",J ,4))
	6773	"RTN","HMP CORD5",216 ,0)
	6774	K ^TMP($J ,"ORWDAL32 ")
	6775	"RTN","HMP CORD5",217 ,0)
	6776	Q
	6777	"RTN","HMP CORD5",218 ,0)
	6778	FILENAME ; Display t ext of fil enames for search tr eeview
	6779	"RTN","HMP CORD5",219 ,0)
	6780	;;VA Alle rgies File
	6781	"RTN","HMP CORD5",220 ,0)
	6782	;;VA Alle rgies File (Synonyms ) SPACER ONLY - NOT DISPLAYED
	6783	"RTN","HMP CORD5",221 ,0)
	6784	;;Nationa l Drug Fil e - Generi c Drug Nam e
	6785	"RTN","HMP CORD5",222 ,0)
	6786	;;Nationa l Drug fil e - Trade Name
	6787	"RTN","HMP CORD5",223 ,0)
	6788	;;Local D rug File
	6789	"RTN","HMP CORD5",224 ,0)
	6790	;;Local D rug File ( Synonyms) SPACER ON LY - NOT D ISPLAYED
	6791	"RTN","HMP CORD5",225 ,0)
	6792	;;Drug In gredients File
	6793	"RTN","HMP CORD5",226 ,0)
	6794	;;VA Drug Class Fil e
	6795	"RTN","HMP CORD5",227 ,0)
	6796	;;
	6797	"RTN","HMP CPAT")
	6798	1^155
	6799	"RTN","HMP CPAT1")
	6800	1^156
	6801	"RTN","HMP CPRS")
	6802	0^15^B5087 431
	6803	"RTN","HMP CPRS",1,0)
	6804	HMPCPRS ;S LC/AGP,ASM R/RRB - CP RS RPC for ;9/21/12 5 :57pm
	6805	"RTN","HMP CPRS",2,0)
	6806	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	6807	"RTN","HMP CPRS",3,0)
	6808	;Per VA D irective 6 402, this routine sh ould not b e modified .
	6809	"RTN","HMP CPRS",4,0)
	6810	;
	6811	"RTN","HMP CPRS",5,0)
	6812	Q
	6813	"RTN","HMP CPRS",6,0)
	6814	;
	6815	"RTN","HMP CPRS",7,0)
	6816	RPC(HMPOUT ,PARAMS) ; Process r equest via RPC inste ad of CSP
	6817	"RTN","HMP CPRS",8,0)
	6818	N X,REQ,H MPCNT,HMPS ITE,HMPUSE R,HMPDBUG, HMPSTA
	6819	"RTN","HMP CPRS",9,0)
	6820	S HMPCNT= 0
	6821	"RTN","HMP CPRS",10,0 )
	6822	S HMPUSER =DUZ,HMPSI TE=DUZ(2), HMPSTA=$$S TA^XUAF4(D UZ(2))
	6823	"RTN","HMP CPRS",11,0 )
	6824	S X="" F S X=$O(PA RAMS(X)) Q :X="" S R EQ(X,1)=PA RAMS(X)
	6825	"RTN","HMP CPRS",12,0 )
	6826	;
	6827	"RTN","HMP CPRS",13,0 )
	6828	COMMON ; C ome here f or both CS P and RPC Mode
	6829	"RTN","HMP CPRS",14,0 )
	6830	;
	6831	"RTN","HMP CPRS",15,0 )
	6832	N CMD
	6833	"RTN","HMP CPRS",16,0 )
	6834	S CMD=$G( REQ("comma nd",1))
	6835	"RTN","HMP CPRS",17,0 )
	6836	;
	6837	"RTN","HMP CPRS",18,0 )
	6838	; returns an order structure for change orders
	6839	"RTN","HMP CPRS",19,0 )
	6840	; or plac es an orde r if auto- accept QO
	6841	"RTN","HMP CPRS",20,0 )
	6842	I CMD="al erts" D G OUT
	6843	"RTN","HMP CPRS",21,0 )
	6844	. D ALERT S(.HMPOUT)
	6845	"RTN","HMP CPRS",22,0 )
	6846	;
	6847	"RTN","HMP CPRS",23,0 )
	6848	I CMD="re minders" D G OUT
	6849	"RTN","HMP CPRS",24,0 )
	6850	.D EVALLI ST^HMPPXRM (.HMPOUT,$ $VAL("pati entId"),$$ VAL("userI d"),$$VAL( "location" ))
	6851	"RTN","HMP CPRS",25,0 )
	6852	;
	6853	"RTN","HMP CPRS",26,0 )
	6854	OUT ;
	6855	"RTN","HMP CPRS",27,0 )
	6856	END ;
	6857	"RTN","HMP CPRS",28,0 )
	6858	;
	6859	"RTN","HMP CPRS",29,0 )
	6860	BLDINFO(IN FO) ;
	6861	"RTN","HMP CPRS",30,0 )
	6862	N X
	6863	"RTN","HMP CPRS",31,0 )
	6864	S X="" F S X=$O(RE Q(X)) Q:X= "" D
	6865	"RTN","HMP CPRS",32,0 )
	6866	.S INFO(X )=REQ(X,1)
	6867	"RTN","HMP CPRS",33,0 )
	6868	Q
	6869	"RTN","HMP CPRS",34,0 )
	6870	;
	6871	"RTN","HMP CPRS",35,0 )
	6872	VAL(X) ; r eturn valu e from req uest
	6873	"RTN","HMP CPRS",36,0 )
	6874	Q $G(REQ( X,1))
	6875	"RTN","HMP CPRS",37,0 )
	6876	;
	6877	"RTN","HMP CPRS",38,0 )
	6878	ALERTS(HMP OUT) ;
	6879	"RTN","HMP CPRS",39,0 )
	6880	N ALERT,C NT,ERROR,N ODE,NUM,RE SULT,HMPOR Y
	6881	"RTN","HMP CPRS",40,0 )
	6882	K ^TMP("H MPALERTS", $J),^TMP(" HMPOUT",$J )
	6883	"RTN","HMP CPRS",41,0 )
	6884	;S HMPOUT =$NA(^TMP( "HMPOUT",$ J))
	6885	"RTN","HMP CPRS",42,0 )
	6886	D FASTUSE R^ORWORB(. HMPORY)
	6887	"RTN","HMP CPRS",43,0 )
	6888	;ZW HMPOR Y
	6889	"RTN","HMP CPRS",44,0 )
	6890	S CNT=0,N UM=1 F S CNT=$O(@HM PORY@(CNT) ) Q:CNT'>0 D
	6891	"RTN","HMP CPRS",45,0 )
	6892	.S NODE=$ G(@HMPORY@ (CNT))
	6893	"RTN","HMP CPRS",46,0 )
	6894	.K ALERT
	6895	"RTN","HMP CPRS",47,0 )
	6896	.I $P(NOD E,U)="I" S ALERT("in foOnly")=" I"
	6897	"RTN","HMP CPRS",48,0 )
	6898	.S ALERT( "patient") =$P(NODE,U ,2),ALERT( "urgency") =$P(NODE,U ,4),ALERT( "dateTime" )=$P(NODE, U,5)
	6899	"RTN","HMP CPRS",49,0 )
	6900	.I $P(NOD E,U,3)'="" S ALERT(" location") =$P(NODE,U ,3)
	6901	"RTN","HMP CPRS",50,0 )
	6902	.S ALERT( "message") =$P(NODE,U ,6)
	6903	"RTN","HMP CPRS",51,0 )
	6904	.I $P(NOD E,U,8)'="" S ALERT(" action")=$ P(NODE,U,8 )
	6905	"RTN","HMP CPRS",52,0 )
	6906	.S ALERT( "mustBePro cess")=$S( $P(NODE,U, 9)="yes":" false",1:" true")
	6907	"RTN","HMP CPRS",53,0 )
	6908	.I $P(NOD E,U,10)'=" " S ALERT( "forwardBy ")="true"
	6909	"RTN","HMP CPRS",54,0 )
	6910	.M ^TMP(" HMPALERTS" ,$J,"data" ,"alerts", NUM,"alert ")=ALERT S NUM=NUM+1
	6911	"RTN","HMP CPRS",55,0 )
	6912	D ENCODE^ HMPJSON($N A(^TMP("HM PALERTS",$ J)),"HMPOU T","ERROR" )
	6913	"RTN","HMP CPRS",56,0 )
	6914	Q
	6915	"RTN","HMP CPRS",57,0 )
	6916	;
	6917	"RTN","HMP CRPC")
	6918	0^16^B1327 4810
	6919	"RTN","HMP CRPC",1,0)
	6920	HMPCRPC ;S LC/AGP,ASM R/RRB - Ge neric RPC controller for HMP;1 1/7/12 5:4 2pm
	6921	"RTN","HMP CRPC",2,0)
	6922	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	6923	"RTN","HMP CRPC",3,0)
	6924	;Per VA D irective 6 402, this routine sh ould not b e modified .
	6925	"RTN","HMP CRPC",4,0)
	6926	;
	6927	"RTN","HMP CRPC",5,0)
	6928	Q
	6929	"RTN","HMP CRPC",6,0)
	6930	;
	6931	"RTN","HMP CRPC",7,0)
	6932	CHAINRPC(H MPRES,PARA MS) ; Chai n multiple rpcs into one call
	6933	"RTN","HMP CRPC",8,0)
	6934	N CITER,R SP,PID
	6935	"RTN","HMP CRPC",9,0)
	6936	S CITER=" " F S CIT ER=$O(PARA MS("comman dList",CIT ER)) Q:CIT ER="" D
	6937	"RTN","HMP CRPC",10,0 )
	6938	. N SUBCM D,SUBRSP,X
	6939	"RTN","HMP CRPC",11,0 )
	6940	. S X=""
	6941	"RTN","HMP CRPC",12,0 )
	6942	. F S X= $O(PARAMS( "commandLi st",CITER, X)) Q:X="" M SUBCMD (X)=PARAMS ("commandL ist",CITER ,X)
	6943	"RTN","HMP CRPC",13,0 )
	6944	. D CHAIN CMD(.SUBCM D,.SUBRSP)
	6945	"RTN","HMP CRPC",14,0 )
	6946	. I $D(SU BRSP) D DE CODE^HMPJS ON("SUBRSP ","RSP(SUB CMD(""comm and""))"," ^JMCERR") I 1
	6947	"RTN","HMP CRPC",15,0 )
	6948	. I '$TES T S RSP(SU BCMD("comm and"))=""
	6949	"RTN","HMP CRPC",16,0 )
	6950	D ENCODE^ HMPJSON("R SP","HMPRE S","^JMCER R")
	6951	"RTN","HMP CRPC",17,0 )
	6952	Q
	6953	"RTN","HMP CRPC",18,0 )
	6954	RPC(HMPRES ,PARAMS) ; Process r equest via RPC inste ad of CSP
	6955	"RTN","HMP CRPC",19,0 )
	6956	N X,REQ,H MPVAL,HMPC NT,HMPSITE ,HMPUSER,H MPDBUG,HMP STA
	6957	"RTN","HMP CRPC",20,0 )
	6958	;S HMPXML =$NA(^TMP( $J,"HMP RE SULTS")) K @HMPXML
	6959	"RTN","HMP CRPC",21,0 )
	6960	S HMPCNT= 0
	6961	"RTN","HMP CRPC",22,0 )
	6962	;S HMPUSE R=DUZ,HMPS ITE=DUZ(2) ,HMPSTA=$$ STA^XUAF4( DUZ(2))
	6963	"RTN","HMP CRPC",23,0 )
	6964	S X="" F S X=$O(PA RAMS(X)) Q :X="" I X '="value" S REQ(X,1) =PARAMS(X)
	6965	"RTN","HMP CRPC",24,0 )
	6966	I $D(PARA MS("value" )) M HMPVA L=PARAMS(" value")
	6967	"RTN","HMP CRPC",25,0 )
	6968	;
	6969	"RTN","HMP CRPC",26,0 )
	6970	COMMON ; C ome here f or both CS P and RPC Mode
	6971	"RTN","HMP CRPC",27,0 )
	6972	;
	6973	"RTN","HMP CRPC",28,0 )
	6974	N CMD
	6975	"RTN","HMP CRPC",29,0 )
	6976	S CMD=$G( REQ("comma nd",1))
	6977	"RTN","HMP CRPC",30,0 )
	6978	;
	6979	"RTN","HMP CRPC",31,0 )
	6980	I CMD="sa veParam" D G OUT
	6981	"RTN","HMP CRPC",32,0 )
	6982	. D PUTPA RAM^HMPPAR AM(.HMPRES ,.HMPVAL," ")
	6983	"RTN","HMP CRPC",33,0 )
	6984	;
	6985	"RTN","HMP CRPC",34,0 )
	6986	I CMD="sa veParamByU id" D G O UT
	6987	"RTN","HMP CRPC",35,0 )
	6988	. D PUTBY UID^HMPPAR AM(.HMPRES ,$$VAL("ui d"),.HMPVA L)
	6989	"RTN","HMP CRPC",36,0 )
	6990	;
	6991	"RTN","HMP CRPC",37,0 )
	6992	I CMD="ge tParam" D G OUT
	6993	"RTN","HMP CRPC",38,0 )
	6994	. D GETBY UID^HMPPAR AM(.HMPRES ,$$VAL("ui d"))
	6995	"RTN","HMP CRPC",39,0 )
	6996	;
	6997	"RTN","HMP CRPC",40,0 )
	6998	I CMD="cl earParam" D G OUT
	6999	"RTN","HMP CRPC",41,0 )
	7000	. D DELPA RAM^HMPPAR AM(.HMPRES ,$$VAL("ui d"))
	7001	"RTN","HMP CRPC",42,0 )
	7002	;
	7003	"RTN","HMP CRPC",43,0 )
	7004	I CMD="ge tAllParam" D G OUT
	7005	"RTN","HMP CRPC",44,0 )
	7006	.D GETALP AR^HMPPARA M(.HMPRES, $$VAL("ent ity"),$$VA L("entityI d"),$$VAL( "getValues "))
	7007	"RTN","HMP CRPC",45,0 )
	7008	;
	7009	"RTN","HMP CRPC",46,0 )
	7010	I CMD="ge tUserInfo" D G OUT
	7011	"RTN","HMP CRPC",47,0 )
	7012	.D GETUSE RI^HMPCRPC 1(.HMPRES, $$VAL("use rId"))
	7013	"RTN","HMP CRPC",48,0 )
	7014	;
	7015	"RTN","HMP CRPC",49,0 )
	7016	I CMD="ge tPatientIn fo" D G O UT
	7017	"RTN","HMP CRPC",50,0 )
	7018	.D GETPAT I^HMPCRPC1 (.HMPRES,$ $VAL("pati entId"))
	7019	"RTN","HMP CRPC",51,0 )
	7020	;
	7021	"RTN","HMP CRPC",52,0 )
	7022	I CMD="ge tPatientCh ecks" D G OUT
	7023	"RTN","HMP CRPC",53,0 )
	7024	.D CHKS^H MPFPTC(.HM PRES,$$VAL ("patientI d"))
	7025	"RTN","HMP CRPC",54,0 )
	7026	;
	7027	"RTN","HMP CRPC",55,0 )
	7028	I CMD="lo gPatientAc cess" D G OUT
	7029	"RTN","HMP CRPC",56,0 )
	7030	.D LOG^HM PFPTC(.HMP RES,$$VAL( "patientId "))
	7031	"RTN","HMP CRPC",57,0 )
	7032	;
	7033	"RTN","HMP CRPC",58,0 )
	7034	I CMD="ad dTask" D G OUT
	7035	"RTN","HMP CRPC",59,0 )
	7036	.D PUT^HM PDJ1(.HMPR ES,$$VAL(" patientId" ),$$VAL("t ype"),.HMP VAL)
	7037	"RTN","HMP CRPC",60,0 )
	7038	;
	7039	"RTN","HMP CRPC",61,0 )
	7040	I CMD="ge tReminderL ist" D G OUT
	7041	"RTN","HMP CRPC",62,0 )
	7042	.D REMLIS T^HMPPXRM( .HMPRES,$$ VAL("user" ),$$VAL("l ocation"))
	7043	"RTN","HMP CRPC",63,0 )
	7044	;
	7045	"RTN","HMP CRPC",64,0 )
	7046	I CMD="ev aluateRemi nder" D G OUT
	7047	"RTN","HMP CRPC",65,0 )
	7048	.D EVALRE M^HMPPXRM( .HMPRES,$$ VAL("patie ntId"),$$V AL("uid"))
	7049	"RTN","HMP CRPC",66,0 )
	7050	;
	7051	"RTN","HMP CRPC",67,0 )
	7052	I CMD="ge tDefaultPa tientList" D G OUT
	7053	"RTN","HMP CRPC",68,0 )
	7054	.D GETDLI ST^HMPROS8 (.HMPRES,$ $VAL("serv er"))
	7055	"RTN","HMP CRPC",69,0 )
	7056	;
	7057	"RTN","HMP CRPC",70,0 )
	7058	I CMD="ge tWardList" D G OUT
	7059	"RTN","HMP CRPC",71,0 )
	7060	.D GETWLI ST^HMPROS8 (.HMPRES,$ $VAL("serv er"),$$VAL ("id"))
	7061	"RTN","HMP CRPC",72,0 )
	7062	;
	7063	"RTN","HMP CRPC",73,0 )
	7064	I CMD="ge tClinicLis t" D G OU T
	7065	"RTN","HMP CRPC",74,0 )
	7066	.D GETCLI ST^HMPROS8 (.HMPRES,$ $VAL("serv er"),$$VAL ("id"),$$V AL("start" ),$$VAL("e nd"))
	7067	"RTN","HMP CRPC",75,0 )
	7068	;
	7069	"RTN","HMP CRPC",76,0 )
	7070	OUT ; outp ut the XML
	7071	"RTN","HMP CRPC",77,0 )
	7072	;S HMPRES =$G(RESULT )
	7073	"RTN","HMP CRPC",78,0 )
	7074	I '$D(HMP RES) S HMP RES="{}"
	7075	"RTN","HMP CRPC",79,0 )
	7076	END Q
	7077	"RTN","HMP CRPC",80,0 )
	7078	;
	7079	"RTN","HMP CRPC",81,0 )
	7080	VAL(X) ; r eturn valu e from req uest
	7081	"RTN","HMP CRPC",82,0 )
	7082	Q $G(REQ( X,1))
	7083	"RTN","HMP CRPC",83,0 )
	7084	;
	7085	"RTN","HMP CRPC",84,0 )
	7086	CHAINCMD(H MPCMD,HMPR SP) ; Do o ne command in chain
	7087	"RTN","HMP CRPC",85,0 )
	7088	;
	7089	"RTN","HMP CRPC",86,0 )
	7090	N CMD
	7091	"RTN","HMP CRPC",87,0 )
	7092	S CMD=$G( HMPCMD("co mmand"))
	7093	"RTN","HMP CRPC",88,0 )
	7094	I CMD="ge tParam" D GETBYUID^H MPPARAM(.H MPRSP,$G(H MPCMD("uid ")))
	7095	"RTN","HMP CRPC",89,0 )
	7096	I CMD="ge tPatientIn fo" D GETP ATI^HMPCRP C1(.HMPRSP ,$G(HMPCMD ("patientI d")))
	7097	"RTN","HMP CRPC",90,0 )
	7098	I CMD="ge tPatientCh ecks" D CH KS^HMPFPTC (.HMPRSP,$ G(HMPCMD(" patientId" )))
	7099	"RTN","HMP CRPC",91,0 )
	7100	I CMD="sa veParam" D PUTPARAM^ HMPPARAM(. HMPRSP,$G( HMPCMD("va lue")),"")
	7101	"RTN","HMP CRPC",92,0 )
	7102	I CMD="sa veParamByU id" D PUTB YUID^HMPPA RAM(.HMPRS P,$G(HMPCM D("uid")), $G(HMPCMD( "value")))
	7103	"RTN","HMP CRPC",93,0 )
	7104	Q
	7105	"RTN","HMP CRPC1")
	7106	0^17^B1035 67295
	7107	"RTN","HMP CRPC1",1,0 )
	7108	HMPCRPC1 ; SLC/AGP,AS MR/RRB - P atient and User rout ine;05/01/ 14
	7109	"RTN","HMP CRPC1",2,0 )
	7110	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	7111	"RTN","HMP CRPC1",3,0 )
	7112	;Per VA D irective 6 402, this routine sh ould not b e modified .
	7113	"RTN","HMP CRPC1",4,0 )
	7114	;
	7115	"RTN","HMP CRPC1",5,0 )
	7116	Q
	7117	"RTN","HMP CRPC1",6,0 )
	7118	;
	7119	"RTN","HMP CRPC1",7,0 )
	7120	GETADD(VAL UES,DFN) ;
	7121	"RTN","HMP CRPC1",8,0 )
	7122	D ADD^VAD PT
	7123	"RTN","HMP CRPC1",9,0 )
	7124	N INC,NUM ,TEMP
	7125	"RTN","HMP CRPC1",10, 0)
	7126	I VAPA(12 )=1 D
	7127	"RTN","HMP CRPC1",11, 0)
	7128	.I $L(VAP A(13))>0 S VALUES("c onfidentIa lAddress", "street",0 )=VAPA(13)
	7129	"RTN","HMP CRPC1",12, 0)
	7130	.I $L(VAP A(14))>0 S VALUES("c onfidentIa lAddress", "street",1 )=VAPA(14)
	7131	"RTN","HMP CRPC1",13, 0)
	7132	.I $L(VAP A(15))>0 S VALUES("c onfidentIa lAddress", "street",2 )=VAPA(15)
	7133	"RTN","HMP CRPC1",14, 0)
	7134	.I $L(VAP A(16))>0 S VALUES("c onfidentIa lAddress", "city")=VA PA(16)
	7135	"RTN","HMP CRPC1",15, 0)
	7136	.I $L(VAP A(17))>0 S VALUES("c onfidentIa lAddress", "state")=$ P(VAPA(17) ,U,2)
	7137	"RTN","HMP CRPC1",16, 0)
	7138	.I $L(VAP A(18))>0 S VALUES("c onfidentIa lAddress", "zip")=VAP A(18)
	7139	"RTN","HMP CRPC1",17, 0)
	7140	.I $L(VAP A(20))>0 S VALUES("c onfidentIa lAddress", "startDate ")=$P(VAPA (20),U,2)
	7141	"RTN","HMP CRPC1",18, 0)
	7142	.I $L(VAP A(21))>0 S VALUES("c onfidentIa lAddress", "stopDate" )=$P(VAPA( 21),U,2)
	7143	"RTN","HMP CRPC1",19, 0)
	7144	.S INC=0, NUM=0 F S INC=$O(VA PA(22,INC) ) Q:INC="" D
	7145	"RTN","HMP CRPC1",20, 0)
	7146	..S NUM=N UM+1,VALUE S("confide ntIalAddre ss","catgo ries",NUM, "category" )=$P(VAPA( 22,INC),U, 2)
	7147	"RTN","HMP CRPC1",21, 0)
	7148	..S VALUE S("confide ntIalAddre ss","catgo ries",NUM, "status")= $S($P(VAPA (22,INC),U ,3)="Y":"t rue",1:"fa lse")
	7149	"RTN","HMP CRPC1",22, 0)
	7150	;
	7151	"RTN","HMP CRPC1",23, 0)
	7152	;I $L(VAP A(1))>0 S VALUES("ad dress","st reet",0)=V APA(1)
	7153	"RTN","HMP CRPC1",24, 0)
	7154	;I $L(VAP A(2))>0 S VALUES("ad dress","st reet",1)=V APA(2)
	7155	"RTN","HMP CRPC1",25, 0)
	7156	;I $L(VAP A(3))>0 S VALUES("ad dress","st reet",2)=V APA(3)
	7157	"RTN","HMP CRPC1",26, 0)
	7158	;I $L(VAP A(4))>0 S VALUES("ad dress","ci ty")=VAPA( 4)
	7159	"RTN","HMP CRPC1",27, 0)
	7160	;I $L(VAP A(5))>0 S VALUES("ad dress","st ate")=$P(V APA(5),U,2 )
	7161	"RTN","HMP CRPC1",28, 0)
	7162	;I $L(VAP A(6))>0 S VALUES("ad dress","zi p")=VAPA(6 )
	7163	"RTN","HMP CRPC1",29, 0)
	7164	I VAPA(9) ]"" S VALU ES("tempor aryAddress ","startDa te")=$P(VA PA(9),U,2)
	7165	"RTN","HMP CRPC1",30, 0)
	7166	I VAPA(10 )]"" S VAL UES("tempo raryAddres s","stopDa te")=$P(VA PA(10),U,2 )
	7167	"RTN","HMP CRPC1",31, 0)
	7168	ADDX ;
	7169	"RTN","HMP CRPC1",32, 0)
	7170	;I $L(VAP A(8))>0 S VALUES("ad dress","ph one")=VAPA (8)
	7171	"RTN","HMP CRPC1",33, 0)
	7172	I $P($G(^ DPT(DFN,.1 3)),U,3)'= "" S VALUE S("email") =$P($G(^DP T(DFN,.13) ),U,3)
	7173	"RTN","HMP CRPC1",34, 0)
	7174	I +$P($G( ^DPT(DFN,. 11)),U,16) >0 S VALUE S("badAddr ess")=$$GE T1^DIQ(2,D FN_",",.12 1)
	7175	"RTN","HMP CRPC1",35, 0)
	7176	D KVAR^VA DPT
	7177	"RTN","HMP CRPC1",36, 0)
	7178	Q
	7179	"RTN","HMP CRPC1",37, 0)
	7180	;
	7181	"RTN","HMP CRPC1",38, 0)
	7182	GETBSA(DFN ) ;
	7183	"RTN","HMP CRPC1",39, 0)
	7184	N DATE,DA TA,NFOUND, TEST,TEXT
	7185	"RTN","HMP CRPC1",40, 0)
	7186	S TEST=""
	7187	"RTN","HMP CRPC1",41, 0)
	7188	D BSA^PXR MBMI(DFN,1 ,0,DT,.NFO UND,.TEST, .DATE,.DAT A,.TEXT)
	7189	"RTN","HMP CRPC1",42, 0)
	7190	Q +$G(DAT A(1,"BSA") )
	7191	"RTN","HMP CRPC1",43, 0)
	7192	;
	7193	"RTN","HMP CRPC1",44, 0)
	7194	GETBMI(DFN ) ;
	7195	"RTN","HMP CRPC1",45, 0)
	7196	; BMI(DF N,NGET,BDT ,EDT,NFOUN D,TEST,DAT E,DATA,TEX T)
	7197	"RTN","HMP CRPC1",46, 0)
	7198	N DATE,DA TA,NFOUND, TEST,TEXT
	7199	"RTN","HMP CRPC1",47, 0)
	7200	D BMI^PXR MBMI(DFN,1 ,0,DT,.NFO UND,.TEST, .DATE,.DAT A,.TEXT)
	7201	"RTN","HMP CRPC1",48, 0)
	7202	Q +$G(DAT A(1,"BMI") )
	7203	"RTN","HMP CRPC1",49, 0)
	7204	;
	7205	"RTN","HMP CRPC1",50, 0)
	7206	GETDEM(VAL UES,DFN) ;
	7207	"RTN","HMP CRPC1",51, 0)
	7208	D DEM^VAD PT
	7209	"RTN","HMP CRPC1",52, 0)
	7210	S VALUES( "name")=VA DM(1)
	7211	"RTN","HMP CRPC1",53, 0)
	7212	I VADM(2) ]"" S VALU ES("ssn")= $P(VADM(2) ,U,2)
	7213	"RTN","HMP CRPC1",54, 0)
	7214	I VADM(3) ]"" S VALU ES("dob")= $P(VADM(3) ,U,2)
	7215	"RTN","HMP CRPC1",55, 0)
	7216	I VADM(4) ]"" S VALU ES("age")= VADM(4)
	7217	"RTN","HMP CRPC1",56, 0)
	7218	I VADM(5) ]"" S VALU ES("gender ")=$P(VADM (5),U,2)
	7219	"RTN","HMP CRPC1",57, 0)
	7220	I VADM(6) ]"" S VALU ES("dateDe ath")=$P(V ADM(6),U,2 )
	7221	"RTN","HMP CRPC1",58, 0)
	7222	I VADM(7) ]"" S VALU ES("remark s")=VADM(7 )
	7223	"RTN","HMP CRPC1",59, 0)
	7224	I VADM(8) ]"" S VALU ES("race") =$P(VADM(8 ),U,2)
	7225	"RTN","HMP CRPC1",60, 0)
	7226	D KVAR^VA DPT
	7227	"RTN","HMP CRPC1",61, 0)
	7228	Q
	7229	"RTN","HMP CRPC1",62, 0)
	7230	;
	7231	"RTN","HMP CRPC1",63, 0)
	7232	GETKEYS(VA LUES,USER) ;
	7233	"RTN","HMP CRPC1",64, 0)
	7234	N NAME,HM PERR,HMPLI ST,CNT
	7235	"RTN","HMP CRPC1",65, 0)
	7236	D LIST^DI C(200.051, ","_USER_" ,",".01",, ,,,,,,"HMP LIST","HMP ERR")
	7237	"RTN","HMP CRPC1",66, 0)
	7238	S CNT=0 F S CNT=$O (HMPLIST(" DILIST",1, CNT)) Q:CN T'>0 D
	7239	"RTN","HMP CRPC1",67, 0)
	7240	. S NAME= $G(HMPLIST ("DILIST", 1,CNT)) Q: NAME=""
	7241	"RTN","HMP CRPC1",68, 0)
	7242	. S VALUE S("vistaKe ys",NAME)= "TRUE"
	7243	"RTN","HMP CRPC1",69, 0)
	7244	Q
	7245	"RTN","HMP CRPC1",70, 0)
	7246	;
	7247	"RTN","HMP CRPC1",71, 0)
	7248	GETNOK(VAL UES,DFN,TY PE) ;
	7249	"RTN","HMP CRPC1",72, 0)
	7250	S VAOA("A ")=TYPE
	7251	"RTN","HMP CRPC1",73, 0)
	7252	N CNT,CON TACT
	7253	"RTN","HMP CRPC1",74, 0)
	7254	S CONTACT =$S(TYPE=3 :"secondar y",1:"prim ary")
	7255	"RTN","HMP CRPC1",75, 0)
	7256	S CNT=$S( TYPE=3:2,1 :1)
	7257	"RTN","HMP CRPC1",76, 0)
	7258	D OAD^VAD PT
	7259	"RTN","HMP CRPC1",77, 0)
	7260	;
	7261	"RTN","HMP CRPC1",78, 0)
	7262	I VAOA(9) ]"" S VALU ES("nok",C NT,"name") =VAOA(9)
	7263	"RTN","HMP CRPC1",79, 0)
	7264	I VAOA(10 )]"" S VAL UES("nok", CNT,"relat ionship")= VAOA(10)
	7265	"RTN","HMP CRPC1",80, 0)
	7266	I VAOA(1) ]"" S VALU ES("nok",C NT,"addres s","street ",1)=VAOA( 1)
	7267	"RTN","HMP CRPC1",81, 0)
	7268	I VAOA(2) ]"" S VALU ES("nok",C NT,"addres s","street ",2)=VAOA( 2)
	7269	"RTN","HMP CRPC1",82, 0)
	7270	I VAOA(3) ]"" S VALU ES("nok",C NT,"addres s","street ",3)=VAOA( 3)
	7271	"RTN","HMP CRPC1",83, 0)
	7272	I VAOA(4) ]"" S VALU ES("nok",C NT,"addres s","city") =VAOA(4)
	7273	"RTN","HMP CRPC1",84, 0)
	7274	I VAOA(5) ]"" S VALU ES("nok",C NT,"addres s","state" )=$P(VAOA( 5),U,2)
	7275	"RTN","HMP CRPC1",85, 0)
	7276	I VAOA(6) ]"" S VALU ES("nok",C NT,"addres s","zip")= VAOA(6)
	7277	"RTN","HMP CRPC1",86, 0)
	7278	I VAOA(8) ]"" S VALU ES("nok",C NT,"addres s","phone" )=VAOA(8)
	7279	"RTN","HMP CRPC1",87, 0)
	7280	D KVAR^VA DPT
	7281	"RTN","HMP CRPC1",88, 0)
	7282	Q
	7283	"RTN","HMP CRPC1",89, 0)
	7284	;
	7285	"RTN","HMP CRPC1",90, 0)
	7286	GETMEANS(V ALUES,DFN) ;
	7287	"RTN","HMP CRPC1",91, 0)
	7288	D ELIG^VA DPT
	7289	"RTN","HMP CRPC1",92, 0)
	7290	I VAEL(9) ]"" S VALU ES("meanSt atus")=$P( VAEL(9),U, 2)
	7291	"RTN","HMP CRPC1",93, 0)
	7292	D KVAR^VA DPT
	7293	"RTN","HMP CRPC1",94, 0)
	7294	Q
	7295	"RTN","HMP CRPC1",95, 0)
	7296	;
	7297	"RTN","HMP CRPC1",96, 0)
	7298	GETPATI(RE SULT,DFN) ;
	7299	"RTN","HMP CRPC1",97, 0)
	7300	N TYPE,VA LUES,HMPER R,Y,HMPODE M,HMPSYS
	7301	"RTN","HMP CRPC1",98, 0)
	7302	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	7303	"RTN","HMP CRPC1",99, 0)
	7304	D DPT1OD^ HMPDJ00(.V ALUES)
	7305	"RTN","HMP CRPC1",100 ,0)
	7306	G GPQ
	7307	"RTN","HMP CRPC1",101 ,0)
	7308	S VALUES( "pid")=$$P ID^HMPDJFS (DFN)
	7309	"RTN","HMP CRPC1",102 ,0)
	7310	;D BUILDU ID^HMPPARA M(.VALUES, "patient", DFN)
	7311	"RTN","HMP CRPC1",103 ,0)
	7312	;D GETDEM (.VALUES,D FN)
	7313	"RTN","HMP CRPC1",104 ,0)
	7314	D GETADD( .VALUES,DF N)
	7315	"RTN","HMP CRPC1",105 ,0)
	7316	;F TYPE=1 ,3 D GETNO K(.VALUES, DFN,TYPE)
	7317	"RTN","HMP CRPC1",106 ,0)
	7318	D GETPATT M(.VALUES, DFN)
	7319	"RTN","HMP CRPC1",107 ,0)
	7320	;D GETPAT VI(.VALUES ,DFN)
	7321	"RTN","HMP CRPC1",108 ,0)
	7322	D GETPATI P(.VALUES, DFN)
	7323	"RTN","HMP CRPC1",109 ,0)
	7324	D GETMEAN S(.VALUES, DFN)
	7325	"RTN","HMP CRPC1",110 ,0)
	7326	D PRF^HMP FPTC(DFN,. VALUES)
	7327	"RTN","HMP CRPC1",111 ,0)
	7328	S Y=$$CWA D^ORQPT2(D FN)
	7329	"RTN","HMP CRPC1",112 ,0)
	7330	I Y]"" S VALUES("cw ad")=Y
	7331	"RTN","HMP CRPC1",113 ,0)
	7332	I $D(VALU ES("patien tRecordFla gs")) S VA LUES("cwad ")=$G(VALU ES("cwad") )_"F"
	7333	"RTN","HMP CRPC1",114 ,0)
	7334	;D PTINQ^ ORWPT(.DEM ,DFN)
	7335	"RTN","HMP CRPC1",115 ,0)
	7336	;S NUM=5, STR=""
	7337	"RTN","HMP CRPC1",116 ,0)
	7338	;F S NUM =$O(@DEM@( NUM)) Q:NU M'>0 D
	7339	"RTN","HMP CRPC1",117 ,0)
	7340	;.S VALUE S("patDemD etails","t ext","\",N UM)=@DEM@( NUM)_$C(13 ,10)
	7341	"RTN","HMP CRPC1",118 ,0)
	7342	S VALUES( "success") ="true"
	7343	"RTN","HMP CRPC1",119 ,0)
	7344	GPQ D ENCO DE^HMPJSON ("VALUES", "RESULT"," HMPERR")
	7345	"RTN","HMP CRPC1",120 ,0)
	7346	I $D(HMPE RR) D
	7347	"RTN","HMP CRPC1",121 ,0)
	7348	.K RESULT N TEMP,TX T
	7349	"RTN","HMP CRPC1",122 ,0)
	7350	.S TXT(1) ="Problem encoding j son output ."
	7351	"RTN","HMP CRPC1",123 ,0)
	7352	.D SETERR OR^HMPUTIL S(.TEMP,.H MPERR,.TXT ,.VALUES)
	7353	"RTN","HMP CRPC1",124 ,0)
	7354	.K HMPERR D ENCODE^ HMPJSON("T EMP","RESU LT","HMPER R")
	7355	"RTN","HMP CRPC1",125 ,0)
	7356	Q
	7357	"RTN","HMP CRPC1",126 ,0)
	7358	;
	7359	"RTN","HMP CRPC1",127 ,0)
	7360	GETPATIP(V ALUES,DFN) ;
	7361	"RTN","HMP CRPC1",128 ,0)
	7362	N HMPDATA
	7363	"RTN","HMP CRPC1",129 ,0)
	7364	D INPLOC^ ORWPT(.HMP DATA,DFN)
	7365	"RTN","HMP CRPC1",130 ,0)
	7366	I +HMPDAT A D
	7367	"RTN","HMP CRPC1",131 ,0)
	7368	. S VALUE S("shortIn patientLoc ation")=$P ($G(^SC(+H MPDATA,0)) ,U,2)
	7369	"RTN","HMP CRPC1",132 ,0)
	7370	. S VALUE S("inpatie ntLocation ")=$P(HMPD ATA,U,2)
	7371	"RTN","HMP CRPC1",133 ,0)
	7372	I $P($G(^ DPT(DFN,.1 01)),U)'=" " S VALUES ("roomBed" )=$P($G(^D PT(DFN,.10 1)),U)
	7373	"RTN","HMP CRPC1",134 ,0)
	7374	Q
	7375	"RTN","HMP CRPC1",135 ,0)
	7376	;
	7377	"RTN","HMP CRPC1",136 ,0)
	7378	GETPATVI(V ALUES,DFN) ; DE2818 - PB - Co de comment ed out dur ing SQA re view/modif ications
	7379	"RTN","HMP CRPC1",137 ,0)
	7380	;N BMI,DA S,HT,LDATE ,HMPTEMP,W T,BSA
	7381	"RTN","HMP CRPC1",138 ,0)
	7382	;;get wei ght
	7383	"RTN","HMP CRPC1",139 ,0)
	7384	;S LDATE= $O(^PXRMIN DX(120.5," PI",DFN,9, ""),-1)
	7385	"RTN","HMP CRPC1",140 ,0)
	7386	;I LDATE> 0 D
	7387	"RTN","HMP CRPC1",141 ,0)
	7388	;.S DAS=$ O(^PXRMIND X(120.5,"P I",DFN,9,L DATE,""))
	7389	"RTN","HMP CRPC1",142 ,0)
	7390	;.I DAS'] "" Q
	7391	"RTN","HMP CRPC1",143 ,0)
	7392	;.D GETDA TA^PXRMVIT L(DAS,.HMP TEMP)
	7393	"RTN","HMP CRPC1",144 ,0)
	7394	;.S WT=HM PTEMP("VAL UE")
	7395	"RTN","HMP CRPC1",145 ,0)
	7396	;.S VALUE S("lastVit als","weig ht","value ")=WT
	7397	"RTN","HMP CRPC1",146 ,0)
	7398	;.S VALUE S("lastVit als","weig ht","lastD one")=$$FM TE^XLFDT(L DATE,"D")
	7399	"RTN","HMP CRPC1",147 ,0)
	7400	;;get hei ght
	7401	"RTN","HMP CRPC1",148 ,0)
	7402	;K LDATE, DAS
	7403	"RTN","HMP CRPC1",149 ,0)
	7404	;S LDATE= $O(^PXRMIN DX(120.5," PI",DFN,8, ""),-1)
	7405	"RTN","HMP CRPC1",150 ,0)
	7406	;I LDATE> 0 D
	7407	"RTN","HMP CRPC1",151 ,0)
	7408	;.S DAS=$ O(^PXRMIND X(120.5,"P I",DFN,8,L DATE,""))
	7409	"RTN","HMP CRPC1",152 ,0)
	7410	;.I DAS'] "" Q
	7411	"RTN","HMP CRPC1",153 ,0)
	7412	;.D GETDA TA^PXRMVIT L(DAS,.HMP TEMP)
	7413	"RTN","HMP CRPC1",154 ,0)
	7414	;.S HT=HM PTEMP("VAL UE")
	7415	"RTN","HMP CRPC1",155 ,0)
	7416	;.S VALUE S("lastVit als","heig ht","value ")=HT
	7417	"RTN","HMP CRPC1",156 ,0)
	7418	;.S VALUE S("lastVit als","heig ht","lastD one")=$$FM TE^XLFDT(L DATE,"D")
	7419	"RTN","HMP CRPC1",157 ,0)
	7420	;S BMI=$$ GETBMI(DFN )
	7421	"RTN","HMP CRPC1",158 ,0)
	7422	;I BMI>0 S VALUES(" lastVitals ","bmi")=B MI
	7423	"RTN","HMP CRPC1",159 ,0)
	7424	;S BSA=$$ GETBSA(DFN )
	7425	"RTN","HMP CRPC1",160 ,0)
	7426	;I BSA>0 S VALUES(" lastVitals ","bsa")=B SA
	7427	"RTN","HMP CRPC1",161 ,0)
	7428	;Q
	7429	"RTN","HMP CRPC1",162 ,0)
	7430	;
	7431	"RTN","HMP CRPC1",163 ,0)
	7432	GETPATTM(V ALUES,DFN) ; -- retu rns treati ng team in fo
	7433	"RTN","HMP CRPC1",164 ,0)
	7434	N CNT,PRO V,TEAM,MH, HMPTEAM,MH TEAM
	7435	"RTN","HMP CRPC1",165 ,0)
	7436	S PROV=$$ OUTPTPR^SD UTL3(DFN) D NP(+PROV ,"primaryP rovider")
	7437	"RTN","HMP CRPC1",166 ,0)
	7438	S PROV=$$ OUTPTAP^SD UTL3(DFN) D NP(+PROV ,"associat eProvider" )
	7439	"RTN","HMP CRPC1",167 ,0)
	7440	S PROV=$G (^DPT(DFN, .1041)) D NP(+PROV," attendingP rovider")
	7441	"RTN","HMP CRPC1",168 ,0)
	7442	S PROV=$G (^DPT(DFN, .104)) D N P(+PROV,"i npatientPr ovider")
	7443	"RTN","HMP CRPC1",169 ,0)
	7444	;
	7445	"RTN","HMP CRPC1",170 ,0)
	7446	S TEAM=$$ OUTPTTM^SD UTL3(DFN) I TEAM D
	7447	"RTN","HMP CRPC1",171 ,0)
	7448	. S VALUE S("teamInf o","team", "uid")=$$S ETUID^HMPU TILS("team ",,+TEAM)
	7449	"RTN","HMP CRPC1",172 ,0)
	7450	. S VALUE S("teamInf o","team", "name")=$P (TEAM,U,2)
	7451	"RTN","HMP CRPC1",173 ,0)
	7452	. S VALUE S("teamInf o","team", "phone")=$ P($G(^SCTM (404.51,+T EAM,0)),U, 2)
	7453	"RTN","HMP CRPC1",174 ,0)
	7454	I 'TEAM S VALUES("t eamInfo"," team","nam e")="unass igned"
	7455	"RTN","HMP CRPC1",175 ,0)
	7456	;
	7457	"RTN","HMP CRPC1",176 ,0)
	7458	S MH=$$ST ART^SCMCMH TC(DFN) D NP(+MH,"mh Coordinato r")
	7459	"RTN","HMP CRPC1",177 ,0)
	7460	S VALUES( "teamInfo" ,"mhCoordi nator","mh Position") =$S(MH:$P( MH,U,3),1: "unassigne d")
	7461	"RTN","HMP CRPC1",178 ,0)
	7462	S VALUES( "teamInfo" ,"mhCoordi nator","mh Team")=$S( MH:$P(MH,U ,5),1:"una ssigned")
	7463	"RTN","HMP CRPC1",179 ,0)
	7464	;US5234 - Add Menta l Health T eam Office Phone - T W
	7465	"RTN","HMP CRPC1",180 ,0)
	7466	I $P($G(M H),U,5)'=" " D
	7467	"RTN","HMP CRPC1",181 ,0)
	7468	. S MHTEA M=$O(^SCTM (404.51,"B ",$P(MH,U, 5),""))
	7469	"RTN","HMP CRPC1",182 ,0)
	7470	. S VALUE S("teamInf o","mhCoor dinator"," mhTeamOffi cePhone")= $$GET1^DIQ (404.51,MH TEAM_",",. 02)
	7471	"RTN","HMP CRPC1",183 ,0)
	7472	;
	7473	"RTN","HMP CRPC1",184 ,0)
	7474	D PCDETAI L^ORWPT1(. HMPTEAM,DF N)
	7475	"RTN","HMP CRPC1",185 ,0)
	7476	S CNT=0 F S CNT=$O (HMPTEAM(C NT)) Q:CNT '>0 D
	7477	"RTN","HMP CRPC1",186 ,0)
	7478	. S VALUE S("teamInf o","text", "\",CNT)=H MPTEAM(CNT )_$C(13,10 )
	7479	"RTN","HMP CRPC1",187 ,0)
	7480	Q
	7481	"RTN","HMP CRPC1",188 ,0)
	7482	NP(X,TYPE) ; -- add New Person data to t eamInfo ar ray
	7483	"RTN","HMP CRPC1",189 ,0)
	7484	Q:$G(TYPE )=""
	7485	"RTN","HMP CRPC1",190 ,0)
	7486	I $G(X)'> 0 S VALUES ("teamInfo ",TYPE,"na me")="unas signed" Q
	7487	"RTN","HMP CRPC1",191 ,0)
	7488	S VALUES( "teamInfo" ,TYPE,"uid ")=$$SETUI D^HMPUTILS ("user",,+ X)
	7489	"RTN","HMP CRPC1",192 ,0)
	7490	S VALUES( "teamInfo" ,TYPE,"nam e")=$P($G( ^VA(200,+X ,0)),U)
	7491	"RTN","HMP CRPC1",193 ,0)
	7492	S VALUES( "teamInfo" ,TYPE,"ana logPager") =$P($G(^VA (200,+X,.1 3)),U,7)
	7493	"RTN","HMP CRPC1",194 ,0)
	7494	S VALUES( "teamInfo" ,TYPE,"dig italPager" )=$P($G(^V A(200,+X,. 13)),U,8)
	7495	"RTN","HMP CRPC1",195 ,0)
	7496	S VALUES( "teamInfo" ,TYPE,"off icePhone") =$P($G(^VA (200,+X,.1 3)),U,2)
	7497	"RTN","HMP CRPC1",196 ,0)
	7498	Q
	7499	"RTN","HMP CRPC1",197 ,0)
	7500	;
	7501	"RTN","HMP CRPC1",198 ,0)
	7502	GETPOS(VAL UES,USER) ;
	7503	"RTN","HMP CRPC1",199 ,0)
	7504	; this re turns the list of po sition for an user
	7505	"RTN","HMP CRPC1",200 ,0)
	7506	N CNT,NOD E,NUM,ROLE IEN,ROLE,T EAM,TEAMIE N,TEAMPHN, HMPLIST,HM PERR
	7507	"RTN","HMP CRPC1",201 ,0)
	7508	;$$TPPR^S CAPMC(DUZ, SCDATES,SC PURPA,SCRO LEA,"LIST" ,HMPERR)
	7509	"RTN","HMP CRPC1",202 ,0)
	7510	S NUM=$$T PPR^SCAPMC (USER,""," ","","",.H MPERR)
	7511	"RTN","HMP CRPC1",203 ,0)
	7512	F CNT=1:1 :NUM D
	7513	"RTN","HMP CRPC1",204 ,0)
	7514	.S NODE=$ G(^TMP("SC TMP LIST" ,$J,CNT))
	7515	"RTN","HMP CRPC1",205 ,0)
	7516	.S VALUES ("vistaPos itions",CN T,"positio n")=$P(NOD E,U,2)
	7517	"RTN","HMP CRPC1",206 ,0)
	7518	.S VALUES ("vistaPos itions",CN T,"effecti veDate")=$ P(NODE,U,5 )
	7519	"RTN","HMP CRPC1",207 ,0)
	7520	.S VALUES ("vistaPos itions",CN T,"inactiv eDate")=$P (NODE,U,6)
	7521	"RTN","HMP CRPC1",208 ,0)
	7522	.S TEAMIE N=$P(NODE, U,3)
	7523	"RTN","HMP CRPC1",209 ,0)
	7524	.S TEAM=$ $GET1^DIQ( 404.51,(+T EAMIEN_"," ),.01)
	7525	"RTN","HMP CRPC1",210 ,0)
	7526	.S TEAMPH N=$$GET1^D IQ(404.51, (+TEAMIEN_ ","),.02)
	7527	"RTN","HMP CRPC1",211 ,0)
	7528	.S VALUES ("vistaPos itions",CN T,"teamNam e")=TEAM
	7529	"RTN","HMP CRPC1",212 ,0)
	7530	.S VALUES ("vistaPos itions",CN T,"teamPho ne")=TEAMP HN
	7531	"RTN","HMP CRPC1",213 ,0)
	7532	.I $P(NOD E,U,9)>0 D
	7533	"RTN","HMP CRPC1",214 ,0)
	7534	.S VALUES ("vistaPos itions",CN T,"role")= $$GET1^DIQ (8930,($P( NODE,U,9)_ ","),.01)
	7535	"RTN","HMP CRPC1",215 ,0)
	7536	Q
	7537	"RTN","HMP CRPC1",216 ,0)
	7538	;
	7539	"RTN","HMP CRPC1",217 ,0)
	7540	GETUSERC(V ALUES,USER ) ;
	7541	"RTN","HMP CRPC1",218 ,0)
	7542	N ARRAY,C NT,EFFDATE ,EXPDATE,I D,IND,LIST ,NODE
	7543	"RTN","HMP CRPC1",219 ,0)
	7544	D WHATIS^ USRLM(USER ,"LIST",1)
	7545	"RTN","HMP CRPC1",220 ,0)
	7546	;LIST(Upp ername_ind icator)=Us erClassIEN ^Membershi pIEN^name^ EffectDt^E xpireDt
	7547	"RTN","HMP CRPC1",221 ,0)
	7548	S IND=0,C NT=0 F S IND=$O(LIS T(IND)) Q: IND="" D
	7549	"RTN","HMP CRPC1",222 ,0)
	7550	.S NODE=L IST(IND)
	7551	"RTN","HMP CRPC1",223 ,0)
	7552	.S EFFDAT E=$P(NODE, U,4),EXPDA TE=$P(NODE ,U,5)
	7553	"RTN","HMP CRPC1",224 ,0)
	7554	.I EFFDAT E>0,EFFDAT E>DT Q
	7555	"RTN","HMP CRPC1",225 ,0)
	7556	.I EXPDAT E>0,EXPDAT E<DT Q
	7557	"RTN","HMP CRPC1",226 ,0)
	7558	.S CNT=CN T+1
	7559	"RTN","HMP CRPC1",227 ,0)
	7560	.S ID=$P( NODE,U)
	7561	"RTN","HMP CRPC1",228 ,0)
	7562	.S ARRAY( ID)=""
	7563	"RTN","HMP CRPC1",229 ,0)
	7564	.S VALUES ("vistaUse rClass",CN T,"role")= $P(NODE,U, 3)
	7565	"RTN","HMP CRPC1",230 ,0)
	7566	.S VALUES ("vistaUse rClass",CN T,"uid")=$ $SETUID^HM PUTILS("as u-class"," ",ID,"")
	7567	"RTN","HMP CRPC1",231 ,0)
	7568	.S VALUES ("vistaUse rClass",CN T,"effecti veDate")=E FFDATE
	7569	"RTN","HMP CRPC1",232 ,0)
	7570	.S VALUES ("vistaUse rClass",CN T,"expirat ionDate")= EXPDATE
	7571	"RTN","HMP CRPC1",233 ,0)
	7572	.I $D(^US R(8930,"AD ",ID)) D G ETUCPAR(.V ALUES,ID,. CNT,.ARRAY )
	7573	"RTN","HMP CRPC1",234 ,0)
	7574	I CNT=0 D
	7575	"RTN","HMP CRPC1",235 ,0)
	7576	.S ID=$O( ^USR(8930, "B","USER" ,"")) I +I D'>0 Q
	7577	"RTN","HMP CRPC1",236 ,0)
	7578	.S CNT=CN T+1
	7579	"RTN","HMP CRPC1",237 ,0)
	7580	.S VALUES ("vistaUse rClass",CN T,"role")= $P($G(^USR (8930,ID,0 )),U)
	7581	"RTN","HMP CRPC1",238 ,0)
	7582	.S VALUES ("vistaUse rClass",CN T,"uid")=$ $SETUID^HM PUTILS("as u-class"," ",ID,"")
	7583	"RTN","HMP CRPC1",239 ,0)
	7584	Q
	7585	"RTN","HMP CRPC1",240 ,0)
	7586	GETUCPAR(V ALUES,ID,C NT,ARRAY) ;
	7587	"RTN","HMP CRPC1",241 ,0)
	7588	N IEN,ROL E
	7589	"RTN","HMP CRPC1",242 ,0)
	7590	S IEN=0 F S IEN=$O (^USR(8930 ,"AD",ID,I EN)) Q:IEN '>0 D
	7591	"RTN","HMP CRPC1",243 ,0)
	7592	.I $D(ARR AY(IEN)) Q
	7593	"RTN","HMP CRPC1",244 ,0)
	7594	.S ARRAY( IEN)=""
	7595	"RTN","HMP CRPC1",245 ,0)
	7596	.S ROLE=$ P($G(^USR( 8930,IEN,0 )),U)
	7597	"RTN","HMP CRPC1",246 ,0)
	7598	.S CNT=CN T+1
	7599	"RTN","HMP CRPC1",247 ,0)
	7600	.S VALUES ("vistaUse rClass",CN T,"role")= ROLE
	7601	"RTN","HMP CRPC1",248 ,0)
	7602	.S VALUES ("vistaUse rClass",CN T,"uid")=$ $SETUID^HM PUTILS("as u-class"," ",IEN,"")
	7603	"RTN","HMP CRPC1",249 ,0)
	7604	.I $D(^US R(8930,"AD ",ID)) D G ETUCPAR(.V ALUES,IEN, .CNT,.ARRA Y)
	7605	"RTN","HMP CRPC1",250 ,0)
	7606	Q
	7607	"RTN","HMP CRPC1",251 ,0)
	7608	;
	7609	"RTN","HMP CRPC1",252 ,0)
	7610	GETUSERI(R ESULT,USER ) ;
	7611	"RTN","HMP CRPC1",253 ,0)
	7612	N RPCOPT, VALUES,HMP ERR,HMPLIS T,CPRSPATH
	7613	"RTN","HMP CRPC1",254 ,0)
	7614	D BUILDUI D^HMPPARAM (.VALUES," user",USER )
	7615	"RTN","HMP CRPC1",255 ,0)
	7616	S VALUES( "timeout") =$$GET^XPA R("USR^SYS ","ORWOR T IMEOUT CHA RT",1,"I")
	7617	"RTN","HMP CRPC1",256 ,0)
	7618	S VALUES( "timeoutCo unter")=$$ GET^XPAR(" USR^SYS^PK G","ORWOR TIMEOUT CO UNTDOWN",1 ,"I")
	7619	"RTN","HMP CRPC1",257 ,0)
	7620	S CPRSPAT H=$$GET^XP AR("USR^SY S","HMP CP RS PATH",1 ,"I")
	7621	"RTN","HMP CRPC1",258 ,0)
	7622	S VALUES( "cprsPath" )=$S($L($G (CPRSPATH) )>0:CPRSPA TH,1:"")
	7623	"RTN","HMP CRPC1",259 ,0)
	7624	D FIND^DI C(19,"",1, "X","HMP U I CONTEXT" ,1,,,,"HMP LIST")
	7625	"RTN","HMP CRPC1",260 ,0)
	7626	S RPCOPT= $S($D(^HMP LIST("DILI ST",0)):-1 ,1:$P(HMPL IST("DILIS T","ID",1, 1),"versio n ",2))
	7627	"RTN","HMP CRPC1",261 ,0)
	7628	;S VALUES ("signingP riv")=$S($ D(^XUSEC(" ORES",DUZ) ):3,$D(^XU SEC("ORELS E",DUZ)):2 ,$D(^XUSEC ("OREMAS", DUZ)):1,1: 0)
	7629	"RTN","HMP CRPC1",262 ,0)
	7630	S VALUES( "orderingR ole")=$$OR DROLE(USER )
	7631	"RTN","HMP CRPC1",263 ,0)
	7632	S VALUES( "hmpVersio n")=RPCOPT
	7633	"RTN","HMP CRPC1",264 ,0)
	7634	S VALUES( "domain")= $$KSP^XUPA RAM("WHERE ") ; doma in
	7635	"RTN","HMP CRPC1",265 ,0)
	7636	S VALUES( "service") =+$G(^VA(2 00,USER,5) ) ; se rvice/sect ion
	7637	"RTN","HMP CRPC1",266 ,0)
	7638	D GETUSER C(.VALUES, USER)
	7639	"RTN","HMP CRPC1",267 ,0)
	7640	D GETPOS( .VALUES,US ER)
	7641	"RTN","HMP CRPC1",268 ,0)
	7642	D GETKEYS (.VALUES,U SER)
	7643	"RTN","HMP CRPC1",269 ,0)
	7644	S VALUES( "productio nAccount") =$S($$PROD ^XUPROD=1: "true",1:" false")
	7645	"RTN","HMP CRPC1",270 ,0)
	7646	;S RESULT =$$ENCODE^ HMPJSON("V ALUES","HM PERR")
	7647	"RTN","HMP CRPC1",271 ,0)
	7648	D ENCODE^ HMPJSON("V ALUES","RE SULT","HMP ERR")
	7649	"RTN","HMP CRPC1",272 ,0)
	7650	Q
	7651	"RTN","HMP CRPC1",273 ,0)
	7652	;
	7653	"RTN","HMP CRPC1",274 ,0)
	7654	ORDROLE(US ER) ; retu rns the ro le a perso n takes in ordering
	7655	"RTN","HMP CRPC1",275 ,0)
	7656	; VAL: 0= nokey, 1=c lerk, 2=nu rse, 3=phy sician, 4= student, 5 =bad keys
	7657	"RTN","HMP CRPC1",276 ,0)
	7658	;I '$G(OR WCLVER) Q 0 ; versi on of clie nt is to o ld for ord ering
	7659	"RTN","HMP CRPC1",277 ,0)
	7660	I ($D(^XU SEC("OREMA S",USER))+ $D(^XUSEC( "ORELSE",U SER))+$D(^ XUSEC("ORE S",USER))) >1 Q 5
	7661	"RTN","HMP CRPC1",278 ,0)
	7662	I $D(^XUS EC("OREMAS ",USER)) Q 1 ; clerk
	7663	"RTN","HMP CRPC1",279 ,0)
	7664	I $D(^XUS EC("ORELSE ",USER)) Q 2 ; nurse
	7665	"RTN","HMP CRPC1",280 ,0)
	7666	I $D(^XUS EC("ORES", USER)),$D( ^XUSEC("PR OVIDER",US ER)) Q 3 ; doctor
	7667	"RTN","HMP CRPC1",281 ,0)
	7668	I $D(^XUS EC("PROVID ER",USER)) Q 4 ; student
	7669	"RTN","HMP CRPC1",282 ,0)
	7670	Q 0
	7671	"RTN","HMP CRPC1",283 ,0)
	7672	;
	7673	"RTN","HMP D")
	7674	0^18^B2960 5922
	7675	"RTN","HMP D",1,0)
	7676	HMPD ;SLC/ MKB,ASMR/R RB - Serve VistA dat a as XML v ia RPC ;8/ 2/11 15:2 9
	7677	"RTN","HMP D",2,0)
	7678	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	7679	"RTN","HMP D",3,0)
	7680	;Per VA D irective 6 402, this routine sh ould not b e modified .
	7681	"RTN","HMP D",4,0)
	7682	;
	7683	"RTN","HMP D",5,0)
	7684	; Externa l Referenc es DBIA#
	7685	"RTN","HMP D",6,0)
	7686	; ------- ---------- -- -----
	7687	"RTN","HMP D",7,0)
	7688	; ^DPT 10035
	7689	"RTN","HMP D",8,0)
	7690	; ^SC 10040
	7691	"RTN","HMP D",9,0)
	7692	; DIQ 2056
	7693	"RTN","HMP D",10,0)
	7694	; MPIF001 2701
	7695	"RTN","HMP D",11,0)
	7696	; VASITE 10112
	7697	"RTN","HMP D",12,0)
	7698	; XLFDT 10103
	7699	"RTN","HMP D",13,0)
	7700	; XLFSTR 10104
	7701	"RTN","HMP D",14,0)
	7702	; XUAF4 2171
	7703	"RTN","HMP D",15,0)
	7704	;
	7705	"RTN","HMP D",16,0)
	7706	Q
	7707	"RTN","HMP D",17,0)
	7708	;
	7709	"RTN","HMP D",18,0)
	7710	GET(HMP,DF N,TYPE,STA RT,STOP,MA X,ID,FILTE R) ; -- Re turn searc h results as XML in @HMP@(n)
	7711	"RTN","HMP D",19,0)
	7712	; RPC = H MP GET PAT IENT DATA
	7713	"RTN","HMP D",20,0)
	7714	N ICN,HMP I,HMPTOTL, HMPTEXT
	7715	"RTN","HMP D",21,0)
	7716	S HMP=$NA (^TMP("HMP ",$J)) K @ HMP
	7717	"RTN","HMP D",22,0)
	7718	S HMPTEXT =+$G(FILTE R("text")) ;include report/doc ument text ?
	7719	"RTN","HMP D",23,0)
	7720	;
	7721	"RTN","HMP D",24,0)
	7722	; parse & validate input para meters
	7723	"RTN","HMP D",25,0)
	7724	S ICN=+$P ($G(DFN)," ;",2),DFN= +$G(DFN),I D=$G(ID)
	7725	"RTN","HMP D",26,0)
	7726	I DFN<1,I CN S DFN=+ $$GETDFN^M PIF001(ICN )
	7727	"RTN","HMP D",27,0)
	7728	S TYPE=$$ LOW^XLFSTR ($G(TYPE)) I TYPE="" S TYPE=$$ ALL
	7729	"RTN","HMP D",28,0)
	7730	I TYPE'=" new",DFN<1 !'$D(^DPT( DFN)) D ER R(1,DFN) G GTQ ;ICR 10035 ASF 11/2/15 DE 2818
	7731	"RTN","HMP D",29,0)
	7732	S:'$G(STA RT) START= 1410102 S: '$G(STOP) STOP=41410 15 S:'$G(M AX) MAX=99 99
	7733	"RTN","HMP D",30,0)
	7734	I START,S TOP,STOP<S TART N X S X=START,S TART=STOP, STOP=X ;s witch
	7735	"RTN","HMP D",31,0)
	7736	I STOP,$L (STOP,".") <2 S STOP= STOP_".24"
	7737	"RTN","HMP D",32,0)
	7738	I ID="",$ D(FILTER(" id")) S ID =FILTER("i d")
	7739	"RTN","HMP D",33,0)
	7740	;
	7741	"RTN","HMP D",34,0)
	7742	; extract data
	7743	"RTN","HMP D",35,0)
	7744	N HMPTYPE ,HMPP,HMPH DR,HMPTAG, HMPTN
	7745	"RTN","HMP D",36,0)
	7746	S HMPTYPE =TYPE D AD D("<result s version= '1.1' time Zone='"_$$ TZ^XLFDT_" ' >")
	7747	"RTN","HMP D",37,0)
	7748	F HMPP=1: 1:$L(HMPTY PE,";") S HMPTAG=$P( HMPTYPE,"; ",HMPP) I $L(HMPTAG) D
	7749	"RTN","HMP D",38,0)
	7750	. S HMPTN ="EN^"_$$R TN(.HMPTAG ) Q:'$L($T (@HMPTN)) ;D ERR(2) Q
	7751	"RTN","HMP D",39,0)
	7752	. D ADD(" <"_HMPTAG) S HMPHDR= HMPI,HMPTO TL=0
	7753	"RTN","HMP D",40,0)
	7754	. D @(HMP TN_"(DFN,S TART,STOP, MAX,ID)")
	7755	"RTN","HMP D",41,0)
	7756	. S @HMP@ (HMPHDR)=@ HMP@(HMPHD R)_" total ='"_+$G(HM PTOTL)_"' >" D ADD(" </"_HMPTAG _">")
	7757	"RTN","HMP D",42,0)
	7758	D ADD("</ results>")
	7759	"RTN","HMP D",43,0)
	7760	;
	7761	"RTN","HMP D",44,0)
	7762	GTQ ; end
	7763	"RTN","HMP D",45,0)
	7764	Q
	7765	"RTN","HMP D",46,0)
	7766	;
	7767	"RTN","HMP D",47,0)
	7768	RTN(X) ; - - Return n ame of HMP Dxxxx rout ine for cl inical dom ain X
	7769	"RTN","HMP D",48,0)
	7770	; X is a lso enforc ed as expe cted group tag name, if passed by ref
	7771	"RTN","HMP D",49,0)
	7772	N Y S Y=" HMPD",X=$G (X) I X="" Q Y
	7773	"RTN","HMP D",50,0)
	7774	I X["acce ssion" S Y="HMPDL RA",X="acc essions"
	7775	"RTN","HMP D",51,0)
	7776	I X["alle rg" S Y="HMPDG MRA",X="re actions"
	7777	"RTN","HMP D",52,0)
	7778	I X["appo intment" S Y="HMPDS DAM",X="ap pointments "
	7779	"RTN","HMP D",53,0)
	7780	I X["clin icalProc" S Y="HMPDM C",X="clin icalProced ures"
	7781	"RTN","HMP D",54,0)
	7782	I X["cons ult" S Y="HMPDG MRC",X="co nsults"
	7783	"RTN","HMP D",55,0)
	7784	I X["demo graph" S Y="HMPDP T",X="demo graphics"
	7785	"RTN","HMP D",56,0)
	7786	I X["docu ment" S Y="HMPDT IU",X="doc uments"
	7787	"RTN","HMP D",57,0)
	7788	I X["fact or" S Y="HMPDP XHF",X="he althFactor s"
	7789	"RTN","HMP D",58,0)
	7790	I X["flag " S Y="HMPDG PF",X="fla gs"
	7791	"RTN","HMP D",59,0)
	7792	I X["immu nization" S Y="HMPDP XIM",X="im munization s"
	7793	"RTN","HMP D",60,0)
	7794	I X["skin " S Y="HMPDP XSK",X="sk inTests"
	7795	"RTN","HMP D",61,0)
	7796	I X?1"exa m".E S Y="HMPDP XAM",X="ex ams"
	7797	"RTN","HMP D",62,0)
	7798	I X["educ at" S Y="HMPDP XED",X="ed ucationTop ics"
	7799	"RTN","HMP D",63,0)
	7800	I X["insu r" S Y="HMPDI B",X="insu rancePolic ies"
	7801	"RTN","HMP D",64,0)
	7802	I X["poli c" S Y="HMPDI B",X="insu rancePolic ies"
	7803	"RTN","HMP D",65,0)
	7804	I X["lab" S Y="HMPDL R",X="labs "
	7805	"RTN","HMP D",66,0)
	7806	I X["pane l" S Y="HMPDL RO",X="pan els"
	7807	"RTN","HMP D",67,0)
	7808	I X["med" S Y="HMPDP S",X="meds "
	7809	"RTN","HMP D",68,0)
	7810	I X["phar m" S Y="HMPDP SOR",X="me ds"
	7811	"RTN","HMP D",69,0)
	7812	I X["obse rv" S Y="HMPDM DC",X="obs ervations"
	7813	"RTN","HMP D",70,0)
	7814	I X["orde r" S Y="HMPDO R",X="orde rs"
	7815	"RTN","HMP D",71,0)
	7816	I X["pati ent" S Y="HMPDP T",X="demo graphics"
	7817	"RTN","HMP D",72,0)
	7818	I X["prob lem" S Y="HMPDG MPL",X="pr oblems"
	7819	"RTN","HMP D",73,0)
	7820	I X["proc edure" S Y="HMPDP ROC",X="pr ocedures"
	7821	"RTN","HMP D",74,0)
	7822	I X["reac tion" S Y="HMPDG MRA",X="re actions"
	7823	"RTN","HMP D",75,0)
	7824	I X["surg " S Y="HMPDS R",X="surg eries"
	7825	"RTN","HMP D",76,0)
	7826	I X["visi t" S Y="HMPDV SIT",X="vi sits"
	7827	"RTN","HMP D",77,0)
	7828	I X["vita l" S Y="HMPDG MV",X="vit als"
	7829	"RTN","HMP D",78,0)
	7830	I X["rad" S Y="HMPDR A",X="radi ologyExams "
	7831	"RTN","HMP D",79,0)
	7832	I X["xray " S Y="HMPDR A",X="radi ologyExams "
	7833	"RTN","HMP D",80,0)
	7834	I X["new" S Y="HMPDX ",X="patie nts"
	7835	"RTN","HMP D",81,0)
	7836	Q Y
	7837	"RTN","HMP D",82,0)
	7838	;
	7839	"RTN","HMP D",83,0)
	7840	TAG(X) ; - - return p lural name for group tags
	7841	"RTN","HMP D",84,0)
	7842	N Y S:X'? 1.L X=$$LO W^XLFSTR(X )
	7843	"RTN","HMP D",85,0)
	7844	I $E(X,$L (X))="s" S Y=X
	7845	"RTN","HMP D",86,0)
	7846	I $E(X,$L (X))="y" S Y=$E(X,1, $L(X)-1)_" ies"
	7847	"RTN","HMP D",87,0)
	7848	E S Y=X_ "s"
	7849	"RTN","HMP D",88,0)
	7850	Q Y
	7851	"RTN","HMP D",89,0)
	7852	;
	7853	"RTN","HMP D",90,0)
	7854	ALL() ; -- return st ring for a ll types o f data
	7855	"RTN","HMP D",91,0)
	7856	Q "demogr aphics;rea ctions;pro blems;vita ls;labs;me ds;immuniz ations;obs ervation;v isits;appo intments;d ocuments;p rocedures; consults;f lags;facto rs;skinTes ts;exams;e ducation;i nsurance"
	7857	"RTN","HMP D",92,0)
	7858	;
	7859	"RTN","HMP D",93,0)
	7860	ERR(X,VAL) ; -- retu rn error m essage
	7861	"RTN","HMP D",94,0)
	7862	N MSG S MSG="Error "
	7863	"RTN","HMP D",95,0)
	7864	I X=1 S MSG="Patie nt with df n '"_$G(VA L)_"' not found"
	7865	"RTN","HMP D",96,0)
	7866	I X=2 S MSG="Reque sted domai n type '"_ $G(VAL)_"' not recog nized"
	7867	"RTN","HMP D",97,0)
	7868	I X=99 S MSG="Unkno wn request "
	7869	"RTN","HMP D",98,0)
	7870	;
	7871	"RTN","HMP D",99,0)
	7872	D ADD("<e rror>")
	7873	"RTN","HMP D",100,0)
	7874	D ADD("<m essage>"_M SG_"</mess age>")
	7875	"RTN","HMP D",101,0)
	7876	D ADD("</ error>")
	7877	"RTN","HMP D",102,0)
	7878	Q
	7879	"RTN","HMP D",103,0)
	7880	;
	7881	"RTN","HMP D",104,0)
	7882	ESC(X) ; - - escape o utgoing XM L
	7883	"RTN","HMP D",105,0)
	7884	; Q $ZCON VERT(X,"O" ,"HTML") ; uncommen t for fast est perfor mance on C ache
	7885	"RTN","HMP D",106,0)
	7886	;
	7887	"RTN","HMP D",107,0)
	7888	N I,Y,QOT S QOT=""" "
	7889	"RTN","HMP D",108,0)
	7890	S Y=$P(X, "&") F I=2 :1:$L(X,"& ") S Y=Y_" &"_$P( X,"&",I)
	7891	"RTN","HMP D",109,0)
	7892	S X=Y,Y=$ P(X,"<") F I=2:1:$L( X,"<") S Y =Y_"<"_ $P(X,"<",I )
	7893	"RTN","HMP D",110,0)
	7894	S X=Y,Y=$ P(X,">") F I=2:1:$L( X,">") S Y =Y_">"_ $P(X,">",I )
	7895	"RTN","HMP D",111,0)
	7896	S X=Y,Y=$ P(X,"'") F I=2:1:$L( X,"'") S Y =Y_"' "_$P(X,"'" ,I)
	7897	"RTN","HMP D",112,0)
	7898	S X=Y,Y=$ P(X,QOT) F I=2:1:$L( X,QOT) S Y =Y_"" "_$P(X,QOT ,I)
	7899	"RTN","HMP D",113,0)
	7900	Q Y
	7901	"RTN","HMP D",114,0)
	7902	;
	7903	"RTN","HMP D",115,0)
	7904	ADD(X) ; A dd a line @HMP@(n)=X
	7905	"RTN","HMP D",116,0)
	7906	S HMPI=$G (HMPI)+1
	7907	"RTN","HMP D",117,0)
	7908	S @HMP@(H MPI)=X
	7909	"RTN","HMP D",118,0)
	7910	Q
	7911	"RTN","HMP D",119,0)
	7912	;
	7913	"RTN","HMP D",120,0)
	7914	STRING(ARR AY) ; -- R eturn text in ARRAY( n) or ARRA Y(n,0) as a string
	7915	"RTN","HMP D",121,0)
	7916	N I,X,Y S Y=""
	7917	"RTN","HMP D",122,0)
	7918	S I=+$O(A RRAY("")) I I=0 S I= +$O(ARRAY( 0))
	7919	"RTN","HMP D",123,0)
	7920	S Y=$S($D (ARRAY(I,0 )):ARRAY(I ,0),1:$G(A RRAY(I)))
	7921	"RTN","HMP D",124,0)
	7922	F S I=$O (ARRAY(I)) Q:I<1 D
	7923	"RTN","HMP D",125,0)
	7924	. S X=$S( $D(ARRAY(I ,0)):ARRAY (I,0),1:AR RAY(I))
	7925	"RTN","HMP D",126,0)
	7926	. I $E(X) =" " S Y=Y _$C(13,10) _X Q
	7927	"RTN","HMP D",127,0)
	7928	. S Y=Y_$ S($E(Y,$L( Y))=" ":"" ,1:" ")_X
	7929	"RTN","HMP D",128,0)
	7930	Q Y
	7931	"RTN","HMP D",129,0)
	7932	;
	7933	"RTN","HMP D",130,0)
	7934	FAC(X) ; - - return I nstitution file stat ion# for l ocation X
	7935	"RTN","HMP D",131,0)
	7936	N HLOC,FA C,Y0,Y S Y =""
	7937	"RTN","HMP D",132,0)
	7938	S HLOC=$G (^SC(+$G(X ),0)),FAC= $P(HLOC,U, 4) ;ICR 10 040 DE2818 ASF 11/5/ 15
	7939	"RTN","HMP D",133,0)
	7940	; Get P:4 via Med C tr Div, if not direc tly linked
	7941	"RTN","HMP D",134,0)
	7942	I 'FAC,$P (HLOC,U,15 ) S FAC=$$ GET1^DIQ(4 4,+$G(X)_" ,","3.5:.0 7","I")
	7943	"RTN","HMP D",135,0)
	7944	S Y0=$S(F AC:$$NS^XU AF4(FAC),1 :$P($$SITE ^VASITE,U, 2,3)) ;nam e^stn#
	7945	"RTN","HMP D",136,0)
	7946	S:$L(Y0) Y=$P(Y0,U, 2)_U_$P(Y0 ,U) ;switc h to stn#^ name
	7947	"RTN","HMP D",137,0)
	7948	I $L(Y),' Y S $P(Y,U )=FAC
	7949	"RTN","HMP D",138,0)
	7950	Q Y
	7951	"RTN","HMP D",139,0)
	7952	;
	7953	"RTN","HMP D",140,0)
	7954	VUID(IEN,F ILE) ; -- Return VUI D for item
	7955	"RTN","HMP D",141,0)
	7956	Q $$GET1^ DIQ(FILE,I EN_",",99. 99)
	7957	"RTN","HMP D",142,0)
	7958	;
	7959	"RTN","HMP D",143,0)
	7960	VERSION(RE T) ; -- Re turn curre nt version of data e xtracts
	7961	"RTN","HMP D",144,0)
	7962	S RET="1. 01"
	7963	"RTN","HMP D",145,0)
	7964	Q
	7965	"RTN","HMP DCRC")
	7966	0^19^B4698 6534
	7967	"RTN","HMP DCRC",1,0)
	7968	HMPDCRC ;S LC/MKB,AGP ,ASMR/RRB - Compute CRC32 for VistA data ;7/26/13 1 1:09am
	7969	"RTN","HMP DCRC",2,0)
	7970	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	7971	"RTN","HMP DCRC",3,0)
	7972	;Per VA D irective 6 402, this routine sh ould not b e modified .
	7973	"RTN","HMP DCRC",4,0)
	7974	;
	7975	"RTN","HMP DCRC",5,0)
	7976	; Externa l Referenc es DBIA#
	7977	"RTN","HMP DCRC",6,0)
	7978	; ------- ---------- -- -----
	7979	"RTN","HMP DCRC",7,0)
	7980	; ^DPT 10035
	7981	"RTN","HMP DCRC",8,0)
	7982	; %ZTLOAD 10063
	7983	"RTN","HMP DCRC",9,0)
	7984	; MPIF001 2701
	7985	"RTN","HMP DCRC",10,0 )
	7986	; XLFCRC 3156
	7987	"RTN","HMP DCRC",11,0 )
	7988	; XLFDT 10103
	7989	"RTN","HMP DCRC",12,0 )
	7990	Q
	7991	"RTN","HMP DCRC",13,0 )
	7992	;
	7993	"RTN","HMP DCRC",14,0 )
	7994	CHECK(HMPC RC,FILTER) ; -- Retu rn CRC32 c hecksums o f VistA da ta
	7995	"RTN","HMP DCRC",15,0 )
	7996	; RPC = H MP GET CHE CKSUM
	7997	"RTN","HMP DCRC",16,0 )
	7998	; where F ILTER("sys tem") = name of c alling/cli ent system
	7999	"RTN","HMP DCRC",17,0 )
	8000	; F ILTER("pat ientId") = DFN or DF N;ICN
	8001	"RTN","HMP DCRC",18,0 )
	8002	; F ILTER("dom ain") = name of d esired dat a type (se e HMPDJ0)
	8003	"RTN","HMP DCRC",19,0 )
	8004	; F ILTER("uid ") = single it em id to r eturn [op t]
	8005	"RTN","HMP DCRC",20,0 )
	8006	; F ILTER("sta rt") = start dat e.time of search [op t]
	8007	"RTN","HMP DCRC",21,0 )
	8008	; F ILTER("sto p") = stop date .time of s earch [op t]
	8009	"RTN","HMP DCRC",22,0 )
	8010	; F ILTER("que ued") = true or f alse
	8011	"RTN","HMP DCRC",23,0 )
	8012	;
	8013	"RTN","HMP DCRC",24,0 )
	8014	; HMPCRC returns th e name of the ^TMP a rray conta ining the results
	8015	"RTN","HMP DCRC",25,0 )
	8016	;
	8017	"RTN","HMP DCRC",26,0 )
	8018	N DFN,NOD E,QUEUED,S YS,HMPSYS
	8019	"RTN","HMP DCRC",27,0 )
	8020	K ^TMP("H MPDCRC",$J ),HMPCRC
	8021	"RTN","HMP DCRC",28,0 )
	8022	S SYS=$G( FILTER("sy stem")) I SYS="" Q
	8023	"RTN","HMP DCRC",29,0 )
	8024	S DFN=$G( FILTER("pa tientId")) I DFN="" Q
	8025	"RTN","HMP DCRC",30,0 )
	8026	S QUEUED= $G(FILTER( "queued"))
	8027	"RTN","HMP DCRC",31,0 )
	8028	S NODE="H MPDCRC "_S YS_"-"_"-" _DFN
	8029	"RTN","HMP DCRC",32,0 )
	8030	S FILTER( "node")=NO DE
	8031	"RTN","HMP DCRC",33,0 )
	8032	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	8033	"RTN","HMP DCRC",34,0 )
	8034	;
	8035	"RTN","HMP DCRC",35,0 )
	8036	; - if no t queued, generate c hecksums a nd exit w/ values in ^TMP
	8037	"RTN","HMP DCRC",36,0 )
	8038	I QUEUED' ="true" D Q
	8039	"RTN","HMP DCRC",37,0 )
	8040	. S ^XTMP (NODE,0)=$ $FMADD^XLF DT(DT,1)_U _DT_U_"Che cksum for Server "_S YS_" patie nt "_DFN
	8041	"RTN","HMP DCRC",38,0 )
	8042	. D EN(.F ILTER)
	8043	"RTN","HMP DCRC",39,0 )
	8044	. M ^TMP( "HMPDCRC", $J)=^XTMP( NODE,"data ")
	8045	"RTN","HMP DCRC",40,0 )
	8046	. S HMPCR C=$NA(^TMP ("HMPDCRC" ,$J))
	8047	"RTN","HMP DCRC",41,0 )
	8048	. K ^XTMP (NODE)
	8049	"RTN","HMP DCRC",42,0 )
	8050	;
	8051	"RTN","HMP DCRC",43,0 )
	8052	; - Queue job if no t started, else retu rn data if done
	8053	"RTN","HMP DCRC",44,0 )
	8054	I +$G(^XT MP(NODE,"s tart"))=0 D QUEUED(. FILTER,NOD E,SYS,DFN) Q
	8055	"RTN","HMP DCRC",45,0 )
	8056	I +$G(^XT MP(NODE,"s top"))>0 D K ^XTMP( NODE)
	8057	"RTN","HMP DCRC",46,0 )
	8058	. I $G(^X TMP(NODE," error"))'= "" S HMPC RC=^XTMP(N ODE,"error ") Q
	8059	"RTN","HMP DCRC",47,0 )
	8060	. S HMPCR C=$NA(^TMP ("HMPDCRC" ,$J))
	8061	"RTN","HMP DCRC",48,0 )
	8062	. M ^TMP( "HMPDCRC", $J)=^XTMP( NODE,"data ")
	8063	"RTN","HMP DCRC",49,0 )
	8064	Q
	8065	"RTN","HMP DCRC",50,0 )
	8066	;
	8067	"RTN","HMP DCRC",51,0 )
	8068	QUEUED(FIL TER,NODE,S YS,DFN) ; -- start j ob to gene rate check sums
	8069	"RTN","HMP DCRC",52,0 )
	8070	N ZTDESC, ZTIO,ZTRTN ,ZTSAVE,ZT DTH,ZTSK
	8071	"RTN","HMP DCRC",53,0 )
	8072	S ^XTMP(N ODE,0)=$$F MADD^XLFDT (DT,1)_U_D T_U_"Check sum for Se rver "_SYS _" patient "_DFN
	8073	"RTN","HMP DCRC",54,0 )
	8074	S ZTRTN=" EN1^HMPDCR C",ZTDESC= "Patient C hecksum Ex tract for "_DFN
	8075	"RTN","HMP DCRC",55,0 )
	8076	S ZTDTH=$ $NOW^XLFDT (),ZTIO="" ,ZTSAVE("F ILTER(")=" "
	8077	"RTN","HMP DCRC",56,0 )
	8078	S ^XTMP(N ODE,"start ")=$$NOW^X LFDT()
	8079	"RTN","HMP DCRC",57,0 )
	8080	D ^%ZTLOA D I +$G(ZT SK)>0 S ^ XTMP(NODE, "task")=+$ G(ZTSK) Q ;succes s
	8081	"RTN","HMP DCRC",58,0 )
	8082	S ^XTMP(N ODE,"error ")="Cannot start a t ask job"
	8083	"RTN","HMP DCRC",59,0 )
	8084	S ^XTMP(N ODE,"stop" )=$$NOW^XL FDT()
	8085	"RTN","HMP DCRC",60,0 )
	8086	S ^XTMP(N ODE,"task" )=ZTSK
	8087	"RTN","HMP DCRC",61,0 )
	8088	Q
	8089	"RTN","HMP DCRC",62,0 )
	8090	;
	8091	"RTN","HMP DCRC",63,0 )
	8092	EN(FILTER) ; -- Retu rn CRC val ues of req uested dat a in ^XTMP (node,"dat a") as JSO N
	8093	"RTN","HMP DCRC",64,0 )
	8094	EN1 ; [ent ry point f or queued job]
	8095	"RTN","HMP DCRC",65,0 )
	8096	;
	8097	"RTN","HMP DCRC",66,0 )
	8098	N ICN,DFN ,NODE,UID, HMPP,TYPE, HMPTN,CRC
	8099	"RTN","HMP DCRC",67,0 )
	8100	N HMPCRC, HMPSTART,H MPSTOP,HMP MAX,HMPI,H MPID,HMPTY PE ;for HM PDJ0
	8101	"RTN","HMP DCRC",68,0 )
	8102	K ^TMP("H MPCRC",$J) ,^TMP("HMP CRCF",$J)
	8103	"RTN","HMP DCRC",69,0 )
	8104	;
	8105	"RTN","HMP DCRC",70,0 )
	8106	; parse & validate input para meters
	8107	"RTN","HMP DCRC",71,0 )
	8108	S DFN=$G( FILTER("pa tientId")) ,HMPCRC=""
	8109	"RTN","HMP DCRC",72,0 )
	8110	S ICN=+$P ($G(DFN)," ;",2),DFN= +$G(DFN)
	8111	"RTN","HMP DCRC",73,0 )
	8112	I DFN<1,I CN S DFN=+ $$GETDFN^M PIF001(ICN )
	8113	"RTN","HMP DCRC",74,0 )
	8114	Q:DFN<1!' $D(^DPT(DF N)) ;ICR 10035 DE 2 818 ASF 11 /2/15
	8115	"RTN","HMP DCRC",75,0 )
	8116	S NODE=$G (FILTER("n ode")) I N ODE="" S N ODE="HMPDC RC"
	8117	"RTN","HMP DCRC",76,0 )
	8118	;
	8119	"RTN","HMP DCRC",77,0 )
	8120	S HMPMAX= 9999,HMPI= 0 ;for HM PDJ0
	8121	"RTN","HMP DCRC",78,0 )
	8122	S HMPSTAR T=+$G(FILT ER("start" ),1410102)
	8123	"RTN","HMP DCRC",79,0 )
	8124	S HMPSTOP =+$G(FILTE R("stop"), 4141015)
	8125	"RTN","HMP DCRC",80,0 )
	8126	S UID=$G( FILTER("ui d")),HMPTY PE=$G(FILT ER("domain "))
	8127	"RTN","HMP DCRC",81,0 )
	8128	I $L(UID) S HMPTYPE =$P(UID,": ",3),HMPID =$P(UID,": ",6)
	8129	"RTN","HMP DCRC",82,0 )
	8130	E S:HMPT YPE="" HMP TYPE=$$ALL
	8131	"RTN","HMP DCRC",83,0 )
	8132	;
	8133	"RTN","HMP DCRC",84,0 )
	8134	F HMPP=1: 1:$L(HMPTY PE,";") S TYPE=$P(HM PTYPE,";", HMPP) I $L (TYPE) D
	8135	"RTN","HMP DCRC",85,0 )
	8136	. S HMPTN =$$TAG^HMP DJ(TYPE)_" ^HMPDJ0" Q :'$L($T(@H MPTN))
	8137	"RTN","HMP DCRC",86,0 )
	8138	. D @HMPT N
	8139	"RTN","HMP DCRC",87,0 )
	8140	;
	8141	"RTN","HMP DCRC",88,0 )
	8142	I $L(UID) D G ENQ ;single it em
	8143	"RTN","HMP DCRC",89,0 )
	8144	. S CRC=$ G(^TMP("HM PCRC",$J,H MPTYPE,UID ))
	8145	"RTN","HMP DCRC",90,0 )
	8146	. S ^XTMP (NODE,"dat a",1)=CRC, ^XTMP(NODE ,"stop")=$ $NOW^XLFDT ()
	8147	"RTN","HMP DCRC",91,0 )
	8148	; generat e checksum for each domain req uested
	8149	"RTN","HMP DCRC",92,0 )
	8150	S TYPE="" F S TYPE =$O(^TMP(" HMPCRC",$J ,TYPE)) Q: TYPE="" D
	8151	"RTN","HMP DCRC",93,0 )
	8152	. S CRC=" " D GET($N A(^TMP("HM PCRC",$J,T YPE)),.CRC )
	8153	"RTN","HMP DCRC",94,0 )
	8154	. S ^TMP( "HMPCRC",$ J,TYPE)=CR C
	8155	"RTN","HMP DCRC",95,0 )
	8156	I $L(HMPT YPE,";")>1 D ;get w hole-chart checksum
	8157	"RTN","HMP DCRC",96,0 )
	8158	. S CRC=" " D GET($N A(^TMP("HM PCRC",$J)) ,.CRC)
	8159	"RTN","HMP DCRC",97,0 )
	8160	. S ^TMP( "HMPCRC",$ J,"patient ")=CRC
	8161	"RTN","HMP DCRC",98,0 )
	8162	;
	8163	"RTN","HMP DCRC",99,0 )
	8164	ENCODE ; - - return l ist(s) of checksums as JSON
	8165	"RTN","HMP DCRC",100, 0)
	8166	D PREP
	8167	"RTN","HMP DCRC",101, 0)
	8168	D ENCODE^ HMPJSON($N A(^TMP("HM PCRCF",$J) ),$NA(^XTM P(NODE,"da ta")),"ERR OR")
	8169	"RTN","HMP DCRC",102, 0)
	8170	S ^XTMP(N ODE,"stop" )=$$NOW^XL FDT()
	8171	"RTN","HMP DCRC",103, 0)
	8172	;
	8173	"RTN","HMP DCRC",104, 0)
	8174	ENQ K ^TMP ("HMPCRC", $J),^TMP(" HMPCRCF",$ J)
	8175	"RTN","HMP DCRC",105, 0)
	8176	Q
	8177	"RTN","HMP DCRC",106, 0)
	8178	;
	8179	"RTN","HMP DCRC",107, 0)
	8180	PREP ; -- reformat ^ TMP("HMPCR C",$J) for JSON util ity -> ^TM P("HMPCRCF ",$J)
	8181	"RTN","HMP DCRC",108, 0)
	8182	N DCNT,DO MAIN,UID,U CNT
	8183	"RTN","HMP DCRC",109, 0)
	8184	S DOMAIN= "",DCNT=0
	8185	"RTN","HMP DCRC",110, 0)
	8186	F S DOMA IN=$O(^TMP ("HMPCRC", $J,DOMAIN) ) Q:DOMAIN ="" D
	8187	"RTN","HMP DCRC",111, 0)
	8188	. S ^TMP( "HMPCRCF", $J,DOMAIN, "crc")=^TM P("HMPCRC" ,$J,DOMAIN )
	8189	"RTN","HMP DCRC",112, 0)
	8190	. S UCNT= 0,UID="" F S UID=$O (^TMP("HMP CRC",$J,DO MAIN,UID)) Q:UID="" D
	8191	"RTN","HMP DCRC",113, 0)
	8192	.. S UCNT =UCNT+1,^T MP("HMPCRC F",$J,DOMA IN,"uids", UCNT,UID)= ^TMP("HMPC RC",$J,DOM AIN,UID)
	8193	"RTN","HMP DCRC",114, 0)
	8194	Q
	8195	"RTN","HMP DCRC",115, 0)
	8196	;
	8197	"RTN","HMP DCRC",116, 0)
	8198	GET(LIST,C RC) ; -- c ompute CRC 32 value f or LIST of strings
	8199	"RTN","HMP DCRC",117, 0)
	8200	N I S CRC =$G(CRC),I =""
	8201	"RTN","HMP DCRC",118, 0)
	8202	F S I=$O (@LIST@(I) ) Q:I="" I $G(@LIST @(I))'="" S CRC=$$CR C32^XLFCRC (I_":"_@LI ST@(I),CRC )
	8203	"RTN","HMP DCRC",119, 0)
	8204	Q
	8205	"RTN","HMP DCRC",120, 0)
	8206	;
	8207	"RTN","HMP DCRC",121, 0)
	8208	ONE(ARRAY, COLL) ; -- process o ne data it em [save r esult in ^ TMP]
	8209	"RTN","HMP DCRC",122, 0)
	8210	N LIST,UI D,ATTR,CRC
	8211	"RTN","HMP DCRC",123, 0)
	8212	S LIST=$$ ATTR(COLL) ,UID=$G(@A RRAY@("uid ")) Q:UID= ""
	8213	"RTN","HMP DCRC",124, 0)
	8214	S ATTR="" F S ATTR =$O(@ARRAY @(ATTR)) Q :ATTR="" I LIST'[(U _ATTR_U) K @ARRAY@(A TTR)
	8215	"RTN","HMP DCRC",125, 0)
	8216	D GET(ARR AY,.CRC)
	8217	"RTN","HMP DCRC",126, 0)
	8218	S ^TMP("H MPCRC",$J, COLL,UID)= CRC
	8219	"RTN","HMP DCRC",127, 0)
	8220	S HMPI=HM PI+1
	8221	"RTN","HMP DCRC",128, 0)
	8222	Q
	8223	"RTN","HMP DCRC",129, 0)
	8224	;
	8225	"RTN","HMP DCRC",130, 0)
	8226	GET1(ARRAY ,COLL) ; - - process one data i tem [retur n result]
	8227	"RTN","HMP DCRC",131, 0)
	8228	N LIST,AT TR,ITEM,CR C
	8229	"RTN","HMP DCRC",132, 0)
	8230	S LIST=$$ ATTR(COLL)
	8231	"RTN","HMP DCRC",133, 0)
	8232	S ATTR="" F S ATTR =$O(@ARRAY @(ATTR)) Q :ATTR="" I LIST[(U_ ATTR_U) S ITEM(ATTR) =@ARRAY@(A TTR)
	8233	"RTN","HMP DCRC",134, 0)
	8234	D GET(ITE M,.CRC)
	8235	"RTN","HMP DCRC",135, 0)
	8236	Q CRC
	8237	"RTN","HMP DCRC",136, 0)
	8238	;
	8239	"RTN","HMP DCRC",137, 0)
	8240	ALL() ; -- return st ring for a ll types o f data
	8241	"RTN","HMP DCRC",138, 0)
	8242	Q "proble m;allergy; consult;vi tal;lab;pr ocedure;ob s;order;tr eatment;me d;ptf;fact or;immuniz ation;exam ;cpt;educa tion;pov;s kin;image; appointmen t;surgery; document;v isit;mh"
	8243	"RTN","HMP DCRC",139, 0)
	8244	;
	8245	"RTN","HMP DCRC",140, 0)
	8246	ATTR(X) ; -- return list of at tributes n eeded for collection X
	8247	"RTN","HMP DCRC",141, 0)
	8248	N Y S Y=" "
	8249	"RTN","HMP DCRC",142, 0)
	8250	I X="vita l" S Y="^obse rved^typeN ame^result ^"
	8251	"RTN","HMP DCRC",143, 0)
	8252	I X="prob lem" S Y="^onse t^problemT ext^status Name^"
	8253	"RTN","HMP DCRC",144, 0)
	8254	I X="alle rgy" S Y="^ente red^summar y^"
	8255	"RTN","HMP DCRC",145, 0)
	8256	I X="orde r" S Y="^star t^name^sta tusName^"
	8257	"RTN","HMP DCRC",146, 0)
	8258	I X="trea tment" S Y="^star t^name^sta tusName^"
	8259	"RTN","HMP DCRC",147, 0)
	8260	I X="med" S Y="^over allstart^n ame^vaStat us^"
	8261	"RTN","HMP DCRC",148, 0)
	8262	I X="cons ult" S Y="^star tDate^type Name^statu sName^"
	8263	"RTN","HMP DCRC",149, 0)
	8264	I X="proc edure" S Y="^date Time^name^ statusName ^"
	8265	"RTN","HMP DCRC",150, 0)
	8266	I X="obs" S Y="^obse rved^typeN ame^result ^"
	8267	"RTN","HMP DCRC",151, 0)
	8268	I X="lab" S Y="^obse rved^typeN ame^"
	8269	"RTN","HMP DCRC",152, 0)
	8270	I X="imag e" S Y="^date Time^name^ statusName ^"
	8271	"RTN","HMP DCRC",153, 0)
	8272	I X="surg ery" S Y="^date Time^typeN ame^status Name^"
	8273	"RTN","HMP DCRC",154, 0)
	8274	I X="docu ment" S Y="^refe renceDateT ime^localT itle^statu sName^"
	8275	"RTN","HMP DCRC",155, 0)
	8276	I X="mh" S Y="^admi nisteredDa teTime^nam e^"
	8277	"RTN","HMP DCRC",156, 0)
	8278	I X="immu nization" S Y="^admi nisteredDa teTime^nam e^"
	8279	"RTN","HMP DCRC",157, 0)
	8280	I X="pov" S Y="^ente red^name^"
	8281	"RTN","HMP DCRC",158, 0)
	8282	I X="skin " S Y="^ente red^name^r esult^"
	8283	"RTN","HMP DCRC",159, 0)
	8284	I X="exam " S Y="^ente red^name^r esult^"
	8285	"RTN","HMP DCRC",160, 0)
	8286	I X="cpt" S Y="^ente red^name^"
	8287	"RTN","HMP DCRC",161, 0)
	8288	I X="educ ation" S Y="^ente red^name^r esult^"
	8289	"RTN","HMP DCRC",162, 0)
	8290	I X="fact or" S Y="^ente red^name^"
	8291	"RTN","HMP DCRC",163, 0)
	8292	I X="appo intment" S Y="^date Time^typeN ame^appoin tmentStatu s^"
	8293	"RTN","HMP DCRC",164, 0)
	8294	I X="visi t" S Y="^date Time^typeN ame^"
	8295	"RTN","HMP DCRC",165, 0)
	8296	I X="ptf" S Y="^arri valDateTim e^icdCode^ "
	8297	"RTN","HMP DCRC",166, 0)
	8298	Q Y
	8299	"RTN","HMP DCRC",167, 0)
	8300	;
	8301	"RTN","HMP DCRC",168, 0)
	8302	;
	8303	"RTN","HMP DCRC",169, 0)
	8304	TEST(FILTE R) ;
	8305	"RTN","HMP DCRC",170, 0)
	8306	N DONE,OU T
	8307	"RTN","HMP DCRC",171, 0)
	8308	S DONE=0
	8309	"RTN","HMP DCRC",172, 0)
	8310	F D Q:D ONE=1
	8311	"RTN","HMP DCRC",173, 0)
	8312	.D CHECK( .OUT,.FILT ER)
	8313	"RTN","HMP DCRC",174, 0)
	8314	.H 1 W !, $D(OUT)
	8315	"RTN","HMP DCRC",175, 0)
	8316	.I $D(OUT )>0 S DONE =1
	8317	"RTN","HMP DCRC",176, 0)
	8318	Q
	8319	"RTN","HMP DE811")
	8320	1^157
	8321	"RTN","HMP DERRH")
	8322	0^21^B2044 240
	8323	"RTN","HMP DERRH",1,0 )
	8324	HMPDERRH ; SLC/AGP,AS MR/RRB - H MP Error H andler;3/2 1/12 5:44p m
	8325	"RTN","HMP DERRH",2,0 )
	8326	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	8327	"RTN","HMP DERRH",3,0 )
	8328	;Per VA D irective 6 402, this routine sh ould not b e modified .
	8329	"RTN","HMP DERRH",4,0 )
	8330	;
	8331	"RTN","HMP DERRH",5,0 )
	8332	Q
	8333	"RTN","HMP DERRH",6,0 )
	8334	;
	8335	"RTN","HMP DERRH",7,0 )
	8336	ERRHDLR ; -- save er rors to re turn in JS ON [Expect s ERRPAT, ERRMSG]
	8337	"RTN","HMP DERRH",8,0 )
	8338	N ERROR S ERROR=$$E C^%ZOSV
	8339	"RTN","HMP DERRH",9,0 )
	8340	;
	8341	"RTN","HMP DERRH",10, 0)
	8342	;Ignore t he "errors " the unwi nder creat es.
	8343	"RTN","HMP DERRH",11, 0)
	8344	I ERROR[" ZTER" D UN WIND^%ZTER
	8345	"RTN","HMP DERRH",12, 0)
	8346	;
	8347	"RTN","HMP DERRH",13, 0)
	8348	;Make sur e we don't loop if t here is an error dur ing proces sing of
	8349	"RTN","HMP DERRH",14, 0)
	8350	;the erro r handler.
	8351	"RTN","HMP DERRH",15, 0)
	8352	N $ET S $ ET="D ^%ZT ER,UNWIND^ %ZTER"
	8353	"RTN","HMP DERRH",16, 0)
	8354	;
	8355	"RTN","HMP DERRH",17, 0)
	8356	;Save the error the n put it i n the erro r trap, th is saves t he correct
	8357	"RTN","HMP DERRH",18, 0)
	8358	;last glo bal refere nce.
	8359	"RTN","HMP DERRH",19, 0)
	8360	D ^%ZTER
	8361	"RTN","HMP DERRH",20, 0)
	8362	;
	8363	"RTN","HMP DERRH",21, 0)
	8364	N CNT,MSG CNT
	8365	"RTN","HMP DERRH",22, 0)
	8366	S CNT=+$G (^TMP($J," HMP ERROR" ,"# of Err ors"))
	8367	"RTN","HMP DERRH",23, 0)
	8368	S CNT=CNT +1,^TMP($J ,"HMP ERRO R","# of E rrors")=CN T
	8369	"RTN","HMP DERRH",24, 0)
	8370	S MSGCNT= +$O(^TMP($ J,"HMP ERR OR","ERROR MESSAGE", ""))
	8371	"RTN","HMP DERRH",25, 0)
	8372	I $G(ERRP AT)>0,MSGC NT=0 S MSG CNT=MSGCNT +1,^TMP($J ,"HMP ERRO R","ERROR MESSAGE",M SGCNT)="An error occ urred on p atient: "_ $G(ERRPAT)
	8373	"RTN","HMP DERRH",26, 0)
	8374	I $L($G(E RRMSG))>0 S MSGCNT=M SGCNT+1,^T MP($J,"HMP ERROR","E RROR MESSA GE",MSGCNT )=ERRMSG
	8375	"RTN","HMP DERRH",27, 0)
	8376	;I $D(ERR ARRY) D
	8377	"RTN","HMP DERRH",28, 0)
	8378	;.S DOMCN T=$O(^TMP( $J,"HMP ER ROR",ERRPA T,ERRDOM," DATA","")) +1
	8379	"RTN","HMP DERRH",29, 0)
	8380	;.I $D(ER RARRY)>0 M ^TMP($J," HMP ERROR" ,ERRPAT,ER RDOM,"DATA ",DOMCNT)= ERRARRY
	8381	"RTN","HMP DERRH",30, 0)
	8382	;if unwin d I lose t he entire process, w hich retur ns incompl ete data t o the extr act return value.
	8383	"RTN","HMP DERRH",31, 0)
	8384	;D GTQ^HM PDJ
	8385	"RTN","HMP DERRH",32, 0)
	8386	D UNWIND^ %ZTER
	8387	"RTN","HMP DERRH",33, 0)
	8388	Q
	8389	"RTN","HMP DGMPL")
	8390	0^22^B2817 2327
	8391	"RTN","HMP DGMPL",1,0 )
	8392	HMPDGMPL ; SLC/MKB,AS MR/RRB - P roblem ext ract;8/2/1 1 15:29
	8393	"RTN","HMP DGMPL",2,0 )
	8394	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	8395	"RTN","HMP DGMPL",3,0 )
	8396	;Per VA D irective 6 402, this routine sh ould not b e modified .
	8397	"RTN","HMP DGMPL",4,0 )
	8398	;
	8399	"RTN","HMP DGMPL",5,0 )
	8400	; Externa l Referenc es DBIA#
	8401	"RTN","HMP DGMPL",6,0 )
	8402	; ------- ---------- -- -----
	8403	"RTN","HMP DGMPL",7,0 )
	8404	; ^AUPNPR OB 5703
	8405	"RTN","HMP DGMPL",8,0 )
	8406	; ^DPT 10035
	8407	"RTN","HMP DGMPL",9,0 )
	8408	; ^VA(200 10060
	8409	"RTN","HMP DGMPL",10, 0)
	8410	; ^WV(790 .05 5772
	8411	"RTN","HMP DGMPL",11, 0)
	8412	; %DT 10003
	8413	"RTN","HMP DGMPL",12, 0)
	8414	; DIQ 2056
	8415	"RTN","HMP DGMPL",13, 0)
	8416	; GMPLUTL 2 2741
	8417	"RTN","HMP DGMPL",14, 0)
	8418	; SDUTL3 1252
	8419	"RTN","HMP DGMPL",15, 0)
	8420	; XLFDT 10103
	8421	"RTN","HMP DGMPL",16, 0)
	8422	; XUAF4 2171
	8423	"RTN","HMP DGMPL",17, 0)
	8424	Q
	8425	"RTN","HMP DGMPL",18, 0)
	8426	; ------- ----- Get problems f rom VistA ---------- --
	8427	"RTN","HMP DGMPL",19, 0)
	8428	;
	8429	"RTN","HMP DGMPL",20, 0)
	8430	EN(DFN,BEG ,END,MAX,I FN) ; -- f ind patien t's proble ms
	8431	"RTN","HMP DGMPL",21, 0)
	8432	N HMPSTS, HMPPROB,HM PN,HMPITM, HMPCNT,X
	8433	"RTN","HMP DGMPL",22, 0)
	8434	;
	8435	"RTN","HMP DGMPL",23, 0)
	8436	; get one problem
	8437	"RTN","HMP DGMPL",24, 0)
	8438	I $G(IFN) ="WV" D WV (.HMPITM,1 ),XML(.HMP ITM):$D(HM PITM) Q
	8439	"RTN","HMP DGMPL",25, 0)
	8440	I $G(IFN) D EN1(IFN ,.HMPITM), XML(.HMPIT M) Q
	8441	"RTN","HMP DGMPL",26, 0)
	8442	;
	8443	"RTN","HMP DGMPL",27, 0)
	8444	; get all patient p roblems
	8445	"RTN","HMP DGMPL",28, 0)
	8446	S DFN=+$G (DFN) Q:DF N<1
	8447	"RTN","HMP DGMPL",29, 0)
	8448	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999), HMPCNT=0
	8449	"RTN","HMP DGMPL",30, 0)
	8450	S HMPSTS= $G(FILTER( "status")) ;default = all prob lems
	8451	"RTN","HMP DGMPL",31, 0)
	8452	D LIST^GM PLUTL2(.HM PPROB,DFN, HMPSTS)
	8453	"RTN","HMP DGMPL",32, 0)
	8454	S HMPN=0 F S HMPN= $O(HMPPROB (HMPN)) Q: (HMPN<1)!( HMPCNT'<MA X) D
	8455	"RTN","HMP DGMPL",33, 0)
	8456	. S X=$P( HMPPROB(HM PN),U,5) I X,(X<BEG) !(X>END) Q ;onset
	8457	"RTN","HMP DGMPL",34, 0)
	8458	. S X=+HM PPROB(HMPN ) K HMPITM ;ien
	8459	"RTN","HMP DGMPL",35, 0)
	8460	. D EN1(X ,.HMPITM), XML(.HMPIT M)
	8461	"RTN","HMP DGMPL",36, 0)
	8462	. S HMPCN T=HMPCNT+1
	8463	"RTN","HMP DGMPL",37, 0)
	8464	I $P($G(^ DPT(DFN,0) ),U,2)="F" D WV(.HMP ITM),XML(. HMPITM):$D (HMPITM) ; ICR 10035 DE2818 ASF 11/2/15
	8465	"RTN","HMP DGMPL",38, 0)
	8466	Q
	8467	"RTN","HMP DGMPL",39, 0)
	8468	;
	8469	"RTN","HMP DGMPL",40, 0)
	8470	EN1(ID,PRO B) ; -- re turn a pro blem in PR OB("attrib ute")=valu e
	8471	"RTN","HMP DGMPL",41, 0)
	8472	N HMPL,X, I,J K PROB
	8473	"RTN","HMP DGMPL",42, 0)
	8474	S ID=+$G( ID) Q:ID<1 ;invalid ien
	8475	"RTN","HMP DGMPL",43, 0)
	8476	D DETAIL^ GMPLUTL2(I D,.HMPL) Q :'$D(HMPL) ;doesn't exist
	8477	"RTN","HMP DGMPL",44, 0)
	8478	S PROB("i d")=ID ;,P ROB("lexic onID")=+X1 ;SNOMED?
	8479	"RTN","HMP DGMPL",45, 0)
	8480	S PROB("n ame")=$G(H MPL("NARRA TIVE"))
	8481	"RTN","HMP DGMPL",46, 0)
	8482	S X=$G(HM PL("MODIFI ED")) S:$L (X) PROB(" updated")= $$DATE(X)
	8483	"RTN","HMP DGMPL",47, 0)
	8484	S PROB("i cd")=$G(HM PL("DIAGNO SIS"))
	8485	"RTN","HMP DGMPL",48, 0)
	8486	S X=$G(HM PL("STATUS ")) S:$L(X ) PROB("st atus")=$E( X)_U_X
	8487	"RTN","HMP DGMPL",49, 0)
	8488	S X=$G(HM PL("HISTOR Y")) S:$L (X) PROB(" history")= $E(X)_U_X
	8489	"RTN","HMP DGMPL",50, 0)
	8490	S X=$G(HM PL("PRIORI TY")) S:$L (X) PROB(" acuity")=$ E(X)_U_X
	8491	"RTN","HMP DGMPL",51, 0)
	8492	S X=$G(HM PL("ONSET" )) S:$L(X) PROB("ons et")=$$DAT E(X)
	8493	"RTN","HMP DGMPL",52, 0)
	8494	S X=$$GET 1^DIQ(9000 011,ID_"," ,1.07,"I") S:X PROB( "resolved" )=X
	8495	"RTN","HMP DGMPL",53, 0)
	8496	S X=$P($G (HMPL("ENT ERED")),U) S:$L(X) PROB("ente red")=$$DA TE(X)
	8497	"RTN","HMP DGMPL",54, 0)
	8498	S X=$$GET 1^DIQ(9000 011,ID_"," ,1.02,"I")
	8499	"RTN","HMP DGMPL",55, 0)
	8500	S:X="P" P ROB("unver ified")=0, PROB("remo ved")=0
	8501	"RTN","HMP DGMPL",56, 0)
	8502	S:X="T" P ROB("unver ified")=1, PROB("remo ved")=0
	8503	"RTN","HMP DGMPL",57, 0)
	8504	S:X="H" P ROB("unver ified")=0, PROB("remo ved")=1
	8505	"RTN","HMP DGMPL",58, 0)
	8506	S X=$G(HM PL("SC")), X=$S(X="YE S":1,X="NO ":0,1:"")
	8507	"RTN","HMP DGMPL",59, 0)
	8508	S:$L(X) P ROB("sc")= X I $G(HMP L("EXPOSUR E")) D ; ao^rad^pgu lf^hnc^mst ^cv
	8509	"RTN","HMP DGMPL",60, 0)
	8510	. S I=0 F S I=$O(H MPL("EXPOS URE",I)) Q :I<1 D
	8511	"RTN","HMP DGMPL",61, 0)
	8512	.. S X=$G (HMPL("EXP OSURE",I))
	8513	"RTN","HMP DGMPL",62, 0)
	8514	.. S PROB ("exposure ",I)=$$EXP (X)
	8515	"RTN","HMP DGMPL",63, 0)
	8516	S X=$G(HM PL("PROVID ER")) S:$L (X) PROB(" provider") =$$GET1^DI Q(9000011, ID_",",1.0 5,"I")_U_X
	8517	"RTN","HMP DGMPL",64, 0)
	8518	S X=$$GET 1^DIQ(9000 011,ID_"," ,1.06) S:$ L(X) PROB( "service") =X
	8519	"RTN","HMP DGMPL",65, 0)
	8520	S X=$G(HM PL("CLINIC ")) S:$L(X ) PROB("lo cation")=X
	8521	"RTN","HMP DGMPL",66, 0)
	8522	S X=+$$GE T1^DIQ(900 0011,ID_", ",.06,"I")
	8523	"RTN","HMP DGMPL",67, 0)
	8524	S:X PROB( "facility" )=$$STA^XU AF4(X)_U_$ P($$NS^XUA F4(X),U)
	8525	"RTN","HMP DGMPL",68, 0)
	8526	I 'X S PR OB("facili ty")=$$FAC ^HMPD ;loc al stn#^na me
	8527	"RTN","HMP DGMPL",69, 0)
	8528	CMT ; comm ents
	8529	"RTN","HMP DGMPL",70, 0)
	8530	Q:'$G(HMP L("COMMENT "))
	8531	"RTN","HMP DGMPL",71, 0)
	8532	S I=0 F S I=$O(HMP L("COMMENT ",I)) Q:I< 1 D
	8533	"RTN","HMP DGMPL",72, 0)
	8534	. S X=$G( HMPL("COMM ENT",I))
	8535	"RTN","HMP DGMPL",73, 0)
	8536	. S PROB( "comment", I)=$$DATE( $P(X,U))_U _$P(X,U,2, 3)
	8537	"RTN","HMP DGMPL",74, 0)
	8538	. ; = dat e ^ name o f author ^ text
	8539	"RTN","HMP DGMPL",75, 0)
	8540	Q
	8541	"RTN","HMP DGMPL",76, 0)
	8542	;
	8543	"RTN","HMP DGMPL",77, 0)
	8544	WV(PROB,UP D) ; -- re turn a pre gnancy log entry in PROB("attr ibute")=va lue
	8545	"RTN","HMP DGMPL",78, 0)
	8546	N I,X0,Y K PROB
	8547	"RTN","HMP DGMPL",79, 0)
	8548	S I=$O(^W V(790.05," C",DFN,"") ,-1) Q:'I ;last e ntry ICR 5 772 DE2818 ASF 11/23 /15
	8549	"RTN","HMP DGMPL",80, 0)
	8550	S X0=$G(^ WV(790.05, I,0)),Y=0
	8551	"RTN","HMP DGMPL",81, 0)
	8552	; status= YES, futur e due date (allow pa st 14 days )
	8553	"RTN","HMP DGMPL",82, 0)
	8554	I $P(X0,U ,3),$P(X0, U,4)'<$$FM ADD^XLFDT( DT,-14) S Y=1
	8555	"RTN","HMP DGMPL",83, 0)
	8556	I 'Y,'$G( UPD) Q
	8557	"RTN","HMP DGMPL",84, 0)
	8558	; continu e if pregn ant, or up date reque sted
	8559	"RTN","HMP DGMPL",85, 0)
	8560	S PROB("i d")="WV",P ROB("enter ed")=+X0
	8561	"RTN","HMP DGMPL",86, 0)
	8562	S PROB("n ame")="Pre gnancy",PR OB("icd")= "V22.2"
	8563	"RTN","HMP DGMPL",87, 0)
	8564	; PROB("p roblemType ")=6457200 1 ;HITSP/ Condition
	8565	"RTN","HMP DGMPL",88, 0)
	8566	S PROB("s tatus")=$S (Y:"A^ACTI VE",1:"I^I NACTIVE")
	8567	"RTN","HMP DGMPL",89, 0)
	8568	S PROB("r esolved")= $P(X0,U,4) ;due da te
	8569	"RTN","HMP DGMPL",90, 0)
	8570	S PROB("p rovider")= $$OUTPTPR^ SDUTL3(DFN ) ;primar y care
	8571	"RTN","HMP DGMPL",91, 0)
	8572	S PROB("f acility")= $$FAC^HMPD
	8573	"RTN","HMP DGMPL",92, 0)
	8574	Q
	8575	"RTN","HMP DGMPL",93, 0)
	8576	;
	8577	"RTN","HMP DGMPL",94, 0)
	8578	DATE(X) ; -- Return internal f orm of dat e X
	8579	"RTN","HMP DGMPL",95, 0)
	8580	N %DT,Y
	8581	"RTN","HMP DGMPL",96, 0)
	8582	S %DT="" D ^%DT S:Y <1 Y=X
	8583	"RTN","HMP DGMPL",97, 0)
	8584	Q Y
	8585	"RTN","HMP DGMPL",98, 0)
	8586	;
	8587	"RTN","HMP DGMPL",99, 0)
	8588	VA200(X) ; -- Return ien of Ne w Person X
	8589	"RTN","HMP DGMPL",100 ,0)
	8590	N Y S Y=$ S($L($G(X) ):+$O(^VA( 200,"B",X, 0)),1:"") ;ICR 10060 DE2818 AS F 11/23/15
	8591	"RTN","HMP DGMPL",101 ,0)
	8592	Q Y
	8593	"RTN","HMP DGMPL",102 ,0)
	8594	;
	8595	"RTN","HMP DGMPL",103 ,0)
	8596	EXP(X) ; - - Return c ode for ex posure nam e X
	8597	"RTN","HMP DGMPL",104 ,0)
	8598	N Y S Y=" ",X=$E($G( X))
	8599	"RTN","HMP DGMPL",105 ,0)
	8600	I X="A" S Y="AO" ; agent oran ge
	8601	"RTN","HMP DGMPL",106 ,0)
	8602	I X="R" S Y="IR" ; ionizing r adiation
	8603	"RTN","HMP DGMPL",107 ,0)
	8604	I X="E" S Y="PG" ; persian gu lf
	8605	"RTN","HMP DGMPL",108 ,0)
	8606	I X="H" S Y="HNC" ; head/neck cancer
	8607	"RTN","HMP DGMPL",109 ,0)
	8608	I X="M" S Y="MST" ; military s exual trau ma
	8609	"RTN","HMP DGMPL",110 ,0)
	8610	I X="C" S Y="CV" ; combat vet
	8611	"RTN","HMP DGMPL",111 ,0)
	8612	I X="S" S Y="SHAD"
	8613	"RTN","HMP DGMPL",112 ,0)
	8614	Q Y
	8615	"RTN","HMP DGMPL",113 ,0)
	8616	;
	8617	"RTN","HMP DGMPL",114 ,0)
	8618	; ------- ----- Retu rn data to middle ti er ------- -----
	8619	"RTN","HMP DGMPL",115 ,0)
	8620	;
	8621	"RTN","HMP DGMPL",116 ,0)
	8622	XML(PROB) ; -- Retur n patient problem as XML in @H MP@(I)
	8623	"RTN","HMP DGMPL",117 ,0)
	8624	N ATT,I,X ,Y,P,TAG
	8625	"RTN","HMP DGMPL",118 ,0)
	8626	D ADD("<p roblem>") S HMPTOTL= $G(HMPTOTL )+1
	8627	"RTN","HMP DGMPL",119 ,0)
	8628	S ATT="" F S ATT=$ O(PROB(ATT )) Q:ATT=" " D D:$L (Y) ADD(Y)
	8629	"RTN","HMP DGMPL",120 ,0)
	8630	. I ATT=" exposure" D S Y="" Q
	8631	"RTN","HMP DGMPL",121 ,0)
	8632	.. S Y="< exposures> " D ADD(Y)
	8633	"RTN","HMP DGMPL",122 ,0)
	8634	.. S I=0 F S I=$O( PROB(ATT,I )) Q:I<1 S X=$G(PRO B(ATT,I)) S:$L(X) Y= "<exposure value='"_ X_"' />" D ADD(Y)
	8635	"RTN","HMP DGMPL",123 ,0)
	8636	.. D ADD( "</exposur es>")
	8637	"RTN","HMP DGMPL",124 ,0)
	8638	. I ATT=" comment" D S Y="" Q
	8639	"RTN","HMP DGMPL",125 ,0)
	8640	.. D ADD( "<comments >")
	8641	"RTN","HMP DGMPL",126 ,0)
	8642	.. S I=0 F S I=$O( PROB(ATT,I )) Q:I<1 S X=$G(PRO B(ATT,I)) D
	8643	"RTN","HMP DGMPL",127 ,0)
	8644	... S Y=" <comment i d='"_I
	8645	"RTN","HMP DGMPL",128 ,0)
	8646	... S:$L( $P(X,U,1)) Y=Y_"' en tered='"_$ P(X,U)
	8647	"RTN","HMP DGMPL",129 ,0)
	8648	... S:$L( $P(X,U,2)) Y=Y_"' en teredBy='" _$$ESC^HMP D($P(X,U,2 ))
	8649	"RTN","HMP DGMPL",130 ,0)
	8650	... S:$L( $P(X,U,3)) Y=Y_"' co mmentText= '"_$$ESC^H MPD($P(X,U ,3))
	8651	"RTN","HMP DGMPL",131 ,0)
	8652	... S Y=Y _"' />" D ADD(Y)
	8653	"RTN","HMP DGMPL",132 ,0)
	8654	.. D ADD( "</comment s>")
	8655	"RTN","HMP DGMPL",133 ,0)
	8656	. S X=$G( PROB(ATT)) ,Y="" Q:'$ L(X)
	8657	"RTN","HMP DGMPL",134 ,0)
	8658	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	8659	"RTN","HMP DGMPL",135 ,0)
	8660	. I $L(X) >1 D S Y= ""
	8661	"RTN","HMP DGMPL",136 ,0)
	8662	.. S Y="< "_ATT_" "
	8663	"RTN","HMP DGMPL",137 ,0)
	8664	.. F P=1: 1 S TAG=$P ("code^nam e^Z",U,P) Q:TAG="Z" I $L($P(X ,U,P)) S Y =Y_TAG_"=' "_$$ESC^HM PD($P(X,U, P))_"' "
	8665	"RTN","HMP DGMPL",138 ,0)
	8666	.. S Y=Y_ "/>" D ADD (Y)
	8667	"RTN","HMP DGMPL",139 ,0)
	8668	D ADD("</ problem>")
	8669	"RTN","HMP DGMPL",140 ,0)
	8670	Q
	8671	"RTN","HMP DGMPL",141 ,0)
	8672	;
	8673	"RTN","HMP DGMPL",142 ,0)
	8674	ADD(X) ; A dd a line @HMP@(n)=X
	8675	"RTN","HMP DGMPL",143 ,0)
	8676	S HMPI=$G (HMPI)+1
	8677	"RTN","HMP DGMPL",144 ,0)
	8678	S @HMP@(H MPI)=X
	8679	"RTN","HMP DGMPL",145 ,0)
	8680	Q
	8681	"RTN","HMP DGMRA")
	8682	0^23^B2221 1624
	8683	"RTN","HMP DGMRA",1,0 )
	8684	HMPDGMRA ; SLC/MKB,AS MR/RRB - A llergy/Rea ction extr act;Nov 02 , 2015 19: 24:08
	8685	"RTN","HMP DGMRA",2,0 )
	8686	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	8687	"RTN","HMP DGMRA",3,0 )
	8688	;Per VA D irective 6 402, this routine sh ould not b e modified .
	8689	"RTN","HMP DGMRA",4,0 )
	8690	;
	8691	"RTN","HMP DGMRA",5,0 )
	8692	; Externa l Referenc es DBIA#
	8693	"RTN","HMP DGMRA",6,0 )
	8694	; ------- ---------- -- -----
	8695	"RTN","HMP DGMRA",7,0 )
	8696	; ^VA(200 10060
	8697	"RTN","HMP DGMRA",8,0 )
	8698	; %DT 10003
	8699	"RTN","HMP DGMRA",9,0 )
	8700	; GMRADPT 10099
	8701	"RTN","HMP DGMRA",10, 0)
	8702	; EN1^GMR AOR2 2422
	8703	"RTN","HMP DGMRA",11, 0)
	8704	; PSN50P4 1 4531
	8705	"RTN","HMP DGMRA",12, 0)
	8706	; PSN50P6 5 4543
	8707	"RTN","HMP DGMRA",13, 0)
	8708	Q
	8709	"RTN","HMP DGMRA",14, 0)
	8710	; ------- ----- Get reactions from VistA --------- ---
	8711	"RTN","HMP DGMRA",15, 0)
	8712	;
	8713	"RTN","HMP DGMRA",16, 0)
	8714	EN(DFN,BEG ,END,MAX,I FN) ; -- f ind patien t's allerg ies/reacti ons
	8715	"RTN","HMP DGMRA",17, 0)
	8716	N GMRA,GM RAL,HMPN,H MPITM,HMPC NT
	8717	"RTN","HMP DGMRA",18, 0)
	8718	S DFN=+$G (DFN) Q:DF N<1
	8719	"RTN","HMP DGMRA",19, 0)
	8720	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999), HMPCNT=0
	8721	"RTN","HMP DGMRA",20, 0)
	8722	D EN1^GMR ADPT
	8723	"RTN","HMP DGMRA",21, 0)
	8724	;
	8725	"RTN","HMP DGMRA",22, 0)
	8726	; get one reaction
	8727	"RTN","HMP DGMRA",23, 0)
	8728	I $G(IFN) D EN1(IFN ,.HMPITM), XML(.HMPIT M) Q
	8729	"RTN","HMP DGMRA",24, 0)
	8730	;
	8731	"RTN","HMP DGMRA",25, 0)
	8732	; get all reactions
	8733	"RTN","HMP DGMRA",26, 0)
	8734	I 'GMRAL D Q
	8735	"RTN","HMP DGMRA",27, 0)
	8736	. S HMPIT M("assessm ent")=$S(G MRAL=0:"nk a",1:"not done")
	8737	"RTN","HMP DGMRA",28, 0)
	8738	. S HMPIT M("facilit y")=$$FAC^ HMPD ;loca l stn#^nam e
	8739	"RTN","HMP DGMRA",29, 0)
	8740	. D XML(. HMPITM)
	8741	"RTN","HMP DGMRA",30, 0)
	8742	S HMPN=0 F S HMPN= +$O(GMRAL( HMPN)) Q:H MPN<1 D Q:HMPCNT'< MAX
	8743	"RTN","HMP DGMRA",31, 0)
	8744	. K HMPIT M D EN1(HM PN,.HMPITM ) Q:'$D(HM PITM)
	8745	"RTN","HMP DGMRA",32, 0)
	8746	. D XML(. HMPITM) S HMPCNT=HMP CNT+1
	8747	"RTN","HMP DGMRA",33, 0)
	8748	Q
	8749	"RTN","HMP DGMRA",34, 0)
	8750	;
	8751	"RTN","HMP DGMRA",35, 0)
	8752	EN1(ID,REA C) ; -- re turn a rea ction in R EAC("attri bute")=val ue
	8753	"RTN","HMP DGMRA",36, 0)
	8754	; from EN: expects G MRAL(ID)
	8755	"RTN","HMP DGMRA",37, 0)
	8756	N HMPY,GM RA,I,J,X,Y ,SEV,TXT,S EV K REAC
	8757	"RTN","HMP DGMRA",38, 0)
	8758	S GMRA=$G (GMRAL(ID) ) D EN1^GM RAOR2(ID," HMPY")
	8759	"RTN","HMP DGMRA",39, 0)
	8760	S X=$P(HM PY,U,10) I $L(X) S X =$$DATE(X) Q:X<BEG Q:X>END S REAC("ent ered")=X
	8761	"RTN","HMP DGMRA",40, 0)
	8762	S REAC("f acility")= $$FAC^HMPD ;local st n#^name
	8763	"RTN","HMP DGMRA",41, 0)
	8764	S REAC("i d")=ID,REA C("name")= $P(HMPY,U) I $P(GMRA ,U,9) D
	8765	"RTN","HMP DGMRA",42, 0)
	8766	. S X=$P( GMRA,U,9), Y=+$P(X,"( ",2) I 'Y, X["PSDRUG" S Y=50
	8767	"RTN","HMP DGMRA",43, 0)
	8768	. S REAC( "localCode ")=X,REAC( "vuid")=$$ VUID^HMPD( +X,Y)
	8769	"RTN","HMP DGMRA",44, 0)
	8770	S X=$P(HM PY,U,6) S: $L(X) REAC ("mechanis m")=X
	8771	"RTN","HMP DGMRA",45, 0)
	8772	S X=$P(HM PY,U,5),RE AC("source ")=$E(X)
	8773	"RTN","HMP DGMRA",46, 0)
	8774	S REAC("t ype")=$S($ L(GMRA):$P (GMRA,U,7) ,1:$$DFO($ P(HMPY,U,7 )))_U_$P(H MPY,U,7)
	8775	"RTN","HMP DGMRA",47, 0)
	8776	I $P(HMPY ,U,4)="VER IFIED",$P( HMPY,U,9) S REAC("ve rified")=$ P(HMPY,U,9 )
	8777	"RTN","HMP DGMRA",48, 0)
	8778	S I=0,SEV ="" F S I =$O(HMPY(" O",I)) Q:I <1 S X=$P (HMPY("O", I),U,2) S: X]SEV SEV= X ;find hi ghest seve rity
	8779	"RTN","HMP DGMRA",49, 0)
	8780	S:$L(SEV) REAC("sev erity")=SE V
	8781	"RTN","HMP DGMRA",50, 0)
	8782	; reactio ns
	8783	"RTN","HMP DGMRA",51, 0)
	8784	S I=0 F S I=$O(GMR AL(ID,"S", I)) Q:I<1 D
	8785	"RTN","HMP DGMRA",52, 0)
	8786	. S X=$G( GMRAL(ID," S",I)),Y=+ $P(X,";",2 )
	8787	"RTN","HMP DGMRA",53, 0)
	8788	. S REAC( "reaction" ,I)=$P(X," ;")_U_$$VU ID^HMPD(Y, 120.83)
	8789	"RTN","HMP DGMRA",54, 0)
	8790	; comment s
	8791	"RTN","HMP DGMRA",55, 0)
	8792	S I=0 F S I=$O(HMP Y("C",I)) Q:I<1 D
	8793	"RTN","HMP DGMRA",56, 0)
	8794	. S X=$G( HMPY("C",I )) K TXT
	8795	"RTN","HMP DGMRA",57, 0)
	8796	. S Y=$$V A200($P(X, U,3))_U_$P (X,U)
	8797	"RTN","HMP DGMRA",58, 0)
	8798	. S Y=Y_U _$S($L($P( X,U,2)):$E ($P(X,U,2) ),1:"E")
	8799	"RTN","HMP DGMRA",59, 0)
	8800	. S J=0 F S J=$O(H MPY("C",I, J)) Q:J<1 S X=$G(HM PY("C",I,J ,0)),TXT(J )=X
	8801	"RTN","HMP DGMRA",60, 0)
	8802	. K X S X =$$STRING^ HMPD(.TXT)
	8803	"RTN","HMP DGMRA",61, 0)
	8804	. S REAC( "comment", I)=Y_U_X ; ien^name^d ate^type^t ext
	8805	"RTN","HMP DGMRA",62, 0)
	8806	; drug in fo
	8807	"RTN","HMP DGMRA",63, 0)
	8808	I $D(HMPY ("I")) D
	8809	"RTN","HMP DGMRA",64, 0)
	8810	. N ROOT S ROOT=$$B ^PSN50P41
	8811	"RTN","HMP DGMRA",65, 0)
	8812	. S I=0 F S I=$O(H MPY("I",I) ) Q:I<1 S X=$G(HMPY ("I",I)) D
	8813	"RTN","HMP DGMRA",66, 0)
	8814	.. N IEN S IEN=$O(@ ROOT@(X,0) )
	8815	"RTN","HMP DGMRA",67, 0)
	8816	.. S REAC ("drugIngr edient",I) =X_U_$$VUI D^HMPD(IEN ,50.416)
	8817	"RTN","HMP DGMRA",68, 0)
	8818	I $D(HMPY ("V")) D
	8819	"RTN","HMP DGMRA",69, 0)
	8820	. S I=0 F S I=$O(H MPY("V",I) ) Q:I<1 S X=$G(HMPY ("V",I)) D
	8821	"RTN","HMP DGMRA",70, 0)
	8822	.. D C^PS N50P65("", $P(X,U,2), "PSN")
	8823	"RTN","HMP DGMRA",71, 0)
	8824	.. N IEN S IEN=+$O( ^TMP($J,"P SN","C",$P (X,U),0))
	8825	"RTN","HMP DGMRA",72, 0)
	8826	.. S REAC ("drugClas s",I)=$P(X ,U,2)_U_$$ VUID^HMPD( IEN,50.605 )
	8827	"RTN","HMP DGMRA",73, 0)
	8828	I GMRA="" S REAC("r emoved")=1 ;entered in error
	8829	"RTN","HMP DGMRA",74, 0)
	8830	Q
	8831	"RTN","HMP DGMRA",75, 0)
	8832	;
	8833	"RTN","HMP DGMRA",76, 0)
	8834	VA200(NAME ) ; -- Ret urn ien^na me from #2 00
	8835	"RTN","HMP DGMRA",77, 0)
	8836	N Y S NAM E=$G(NAME) ,Y="^"
	8837	"RTN","HMP DGMRA",78, 0)
	8838	I $L(NAME ) S Y=+$O( ^VA(200,"B ",NAME,0)) _U_NAME ; IA 10060, DE2818
	8839	"RTN","HMP DGMRA",79, 0)
	8840	Q Y
	8841	"RTN","HMP DGMRA",80, 0)
	8842	;
	8843	"RTN","HMP DGMRA",81, 0)
	8844	DATE(X) ; -- Return internal f orm of dat e X
	8845	"RTN","HMP DGMRA",82, 0)
	8846	N %DT,Y
	8847	"RTN","HMP DGMRA",83, 0)
	8848	S %DT="TX " D ^%DT
	8849	"RTN","HMP DGMRA",84, 0)
	8850	Q Y
	8851	"RTN","HMP DGMRA",85, 0)
	8852	;
	8853	"RTN","HMP DGMRA",86, 0)
	8854	DFO(X) ; - - Return ' DFO' strin g for mech anism name (s)
	8855	"RTN","HMP DGMRA",87, 0)
	8856	N I,P,Y S Y=""
	8857	"RTN","HMP DGMRA",88, 0)
	8858	F I=1:1:$ L(X,",") S P=$P(X,", ",I),Y=Y_$ S($E(P)=" ":$E(P,2), 1:$E(P))
	8859	"RTN","HMP DGMRA",89, 0)
	8860	S:Y="" Y= $G(X)
	8861	"RTN","HMP DGMRA",90, 0)
	8862	Q Y
	8863	"RTN","HMP DGMRA",91, 0)
	8864	;
	8865	"RTN","HMP DGMRA",92, 0)
	8866	; ------- ----- Retu rn data to middle ti er ------- -----
	8867	"RTN","HMP DGMRA",93, 0)
	8868	;
	8869	"RTN","HMP DGMRA",94, 0)
	8870	XML(REAC) ; -- Retur n patient reaction a s XML
	8871	"RTN","HMP DGMRA",95, 0)
	8872	; as <el ement code ='123' dis playName=' ABC' />
	8873	"RTN","HMP DGMRA",96, 0)
	8874	N ATT,X,Y ,I,P,NM,TA G
	8875	"RTN","HMP DGMRA",97, 0)
	8876	D ADD("<a llergy>") S HMPTOTL= $G(HMPTOTL )+1
	8877	"RTN","HMP DGMRA",98, 0)
	8878	S ATT="" F S ATT=$ O(REAC(ATT )) Q:ATT=" " D D:$L (Y) ADD(Y)
	8879	"RTN","HMP DGMRA",99, 0)
	8880	. I ATT=" comment" D S Y="" Q
	8881	"RTN","HMP DGMRA",100 ,0)
	8882	.. S I=0, Y="<commen ts>" D ADD (Y)
	8883	"RTN","HMP DGMRA",101 ,0)
	8884	.. F S I =$O(REAC(A TT,I)) Q:I <1 S X=$G (REAC(ATT, I)) D
	8885	"RTN","HMP DGMRA",102 ,0)
	8886	... S Y=" <comment i d='"_I
	8887	"RTN","HMP DGMRA",103 ,0)
	8888	... S:$L( $P(X,U,3)) Y=Y_"' en tered='"_$ P(X,U,3)
	8889	"RTN","HMP DGMRA",104 ,0)
	8890	... S:$L( $P(X,U,2)) Y=Y_"' en teredBy='" _$$ESC^HMP D($P(X,U,2 ))
	8891	"RTN","HMP DGMRA",105 ,0)
	8892	... S:$L( $P(X,U,4)) Y=Y_"' co mmentType= '"_$P(X,U, 4)
	8893	"RTN","HMP DGMRA",106 ,0)
	8894	... S:$L( $P(X,U,5)) Y=Y_"' co mmentText= '"_$$ESC^H MPD($P(X,U ,5))
	8895	"RTN","HMP DGMRA",107 ,0)
	8896	... S Y=Y _"' />" D ADD(Y)
	8897	"RTN","HMP DGMRA",108 ,0)
	8898	.. D ADD( "</comment s>")
	8899	"RTN","HMP DGMRA",109 ,0)
	8900	. I $O(RE AC(ATT,0)) D S Y="" Q
	8901	"RTN","HMP DGMRA",110 ,0)
	8902	.. S NM=A TT_$S($E(A TT,$L(ATT) )="s":"es" ,1:"s") D ADD("<"_NM _">")
	8903	"RTN","HMP DGMRA",111 ,0)
	8904	.. S I=0 F S I=$O( REAC(ATT,I )) Q:I<1 D
	8905	"RTN","HMP DGMRA",112 ,0)
	8906	... S X=$ G(REAC(ATT ,I)),Y="<" _ATT_" "
	8907	"RTN","HMP DGMRA",113 ,0)
	8908	... F P=1 :1 S TAG=$ P("name^vu id^severit y^Z",U,P) Q:TAG="Z" I $L($P(X ,U,P)) S Y =Y_TAG_"=' "_$$ESC^HM PD($P(X,U, P))_"' "
	8909	"RTN","HMP DGMRA",114 ,0)
	8910	... S Y=Y _"/>" D AD D(Y)
	8911	"RTN","HMP DGMRA",115 ,0)
	8912	.. D ADD( "</"_NM_"> ")
	8913	"RTN","HMP DGMRA",116 ,0)
	8914	. S X=$G( REAC(ATT)) ,Y="" Q:'$ L(X)
	8915	"RTN","HMP DGMRA",117 ,0)
	8916	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	8917	"RTN","HMP DGMRA",118 ,0)
	8918	. I $L(X) >1 D S Y= ""
	8919	"RTN","HMP DGMRA",119 ,0)
	8920	.. S Y="< "_ATT_" "
	8921	"RTN","HMP DGMRA",120 ,0)
	8922	.. F P=1: 1 S TAG=$P ("code^nam e^Z",U,P) Q:TAG="Z" I $L($P(X ,U,P)) S Y =Y_TAG_"=' "_$$ESC^HM PD($P(X,U, P))_"' "
	8923	"RTN","HMP DGMRA",121 ,0)
	8924	.. S Y=Y_ "/>" D ADD (Y)
	8925	"RTN","HMP DGMRA",122 ,0)
	8926	D ADD("</ allergy>")
	8927	"RTN","HMP DGMRA",123 ,0)
	8928	Q
	8929	"RTN","HMP DGMRA",124 ,0)
	8930	;
	8931	"RTN","HMP DGMRA",125 ,0)
	8932	ADD(X) ; A dd a line @HMP@(n)=X
	8933	"RTN","HMP DGMRA",126 ,0)
	8934	S HMPI=$G (HMPI)+1
	8935	"RTN","HMP DGMRA",127 ,0)
	8936	S @HMP@(H MPI)=X
	8937	"RTN","HMP DGMRA",128 ,0)
	8938	Q
	8939	"RTN","HMP DGMRC")
	8940	1^158
	8941	"RTN","HMP DGMV")
	8942	0^25^B4328 5050
	8943	"RTN","HMP DGMV",1,0)
	8944	HMPDGMV ;S LC/MKB,ASM R/RRB,ASMR /ASF - Vit als extrac t;8/2/11 15:29
	8945	"RTN","HMP DGMV",2,0)
	8946	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	8947	"RTN","HMP DGMV",3,0)
	8948	;Per VA D irective 6 402, this routine sh ould not b e modified .
	8949	"RTN","HMP DGMV",4,0)
	8950	;
	8951	"RTN","HMP DGMV",5,0)
	8952	; Externa l Referenc es DBIA#
	8953	"RTN","HMP DGMV",6,0)
	8954	; ------- ---------- -- -----
	8955	"RTN","HMP DGMV",7,0)
	8956	; ^SC 10040
	8957	"RTN","HMP DGMV",8,0)
	8958	; ^VA(200 10060
	8959	"RTN","HMP DGMV",9,0)
	8960	; DILFD 2055
	8961	"RTN","HMP DGMV",10,0 )
	8962	; GMRVUT0 ,^UTILITY( $J,"GMRVD" ) 1446
	8963	"RTN","HMP DGMV",11,0 )
	8964	; GMVGETQ L 5048
	8965	"RTN","HMP DGMV",12,0 )
	8966	; GMVGETV T 5047
	8967	"RTN","HMP DGMV",13,0 )
	8968	; GMVRPCM 5702
	8969	"RTN","HMP DGMV",14,0 )
	8970	; GMVUTL 5046
	8971	"RTN","HMP DGMV",15,0 )
	8972	Q
	8973	"RTN","HMP DGMV",16,0 )
	8974	; ------- ----- Get vitals fro m VistA -- ----------
	8975	"RTN","HMP DGMV",17,0 )
	8976	;
	8977	"RTN","HMP DGMV",18,0 )
	8978	EN(DFN,BEG ,END,MAX,I FN) ; -- f ind patien t's vitals
	8979	"RTN","HMP DGMV",19,0 )
	8980	N HMPITM, HMPPARAM,G MRVSTR,IDT ,TYPE,VIT, CNT,X0,X,Y ,I,N
	8981	"RTN","HMP DGMV",20,0 )
	8982	S DFN=+$G (DFN) Q:DF N<1
	8983	"RTN","HMP DGMV",21,0 )
	8984	;
	8985	"RTN","HMP DGMV",22,0 )
	8986	; get one measureme nt
	8987	"RTN","HMP DGMV",23,0 )
	8988	I $G(IFN) ,IFN?7N1". "1.6N S (B EG,END)=IF N K IFN
	8989	"RTN","HMP DGMV",24,0 )
	8990	I $G(IFN) D EN1(IFN ,.HMPITM), XML(.HMPIT M) Q
	8991	"RTN","HMP DGMV",25,0 )
	8992	;
	8993	"RTN","HMP DGMV",26,0 )
	8994	; get all measureme nts
	8995	"RTN","HMP DGMV",27,0 )
	8996	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	8997	"RTN","HMP DGMV",28,0 )
	8998	S GMRVSTR ="BP;T;R;P ;HT;WT;CVP ;CG;PO2;PN ",GMRVSTR( 0)=BEG_U_E ND_U_MAX_" ^1"
	8999	"RTN","HMP DGMV",29,0 )
	9000	K ^UTILIT Y($J,"GMRV D") D EN1^ GMRVUT0
	9001	"RTN","HMP DGMV",30,0 )
	9002	S (IDT,CN T)=0 F S IDT=$O(^UT ILITY($J," GMRVD",IDT )) Q:IDT<1 D Q:CNT '<MAX
	9003	"RTN","HMP DGMV",31,0 )
	9004	. K VIT S VIT("take n")=999999 9-IDT,CNT= CNT+1,N=0
	9005	"RTN","HMP DGMV",32,0 )
	9006	. S TYPE= "" F S TY PE=$O(^UTI LITY($J,"G MRVD",IDT, TYPE)) Q:T YPE="" D
	9007	"RTN","HMP DGMV",33,0 )
	9008	.. N NAME ,VUID,RESU LT,UNIT,MR ES,MUNT,HI GH,LOW,QUA L
	9009	"RTN","HMP DGMV",34,0 )
	9010	.. S IFN= +$O(^UTILI TY($J,"GMR VD",IDT,TY PE,0)),X0= $G(^(IFN))
	9011	"RTN","HMP DGMV",35,0 )
	9012	.. S X=+$ P(X0,U,3), NAME=$$FIE LD^GMVGETV T(X,1)
	9013	"RTN","HMP DGMV",36,0 )
	9014	.. S VUID =$$FIELD^G MVGETVT(X, 4),RESULT= $P(X0,U,8) ,UNIT=$$UN IT(TYPE)
	9015	"RTN","HMP DGMV",37,0 )
	9016	.. S (MRE S,MUNT)="" I $L($P(X 0,U,13)) D
	9017	"RTN","HMP DGMV",38,0 )
	9018	... S X=$ S(TYPE="T" :"C",TYPE= "HT":"cm", TYPE="WT": "kg",TYPE= "CG":"cm", 1:"")
	9019	"RTN","HMP DGMV",39,0 )
	9020	... S MRE S=$P(X0,U, 13) S:$L(X ) MUNT=X
	9021	"RTN","HMP DGMV",40,0 )
	9022	.. S X=$$ RANGE(TYPE ),(HIGH,LO W)="" I $L (X) S HIGH =$P(X,U),L OW=$P(X,U, 2)
	9023	"RTN","HMP DGMV",41,0 )
	9024	.. S N=N+ 1,VIT("mea surement", N)=IFN_U_V UID_U_NAME _U_RESULT_ U_UNIT_U_M RES_U_MUNT _U_HIGH_U_ LOW
	9025	"RTN","HMP DGMV",42,0 )
	9026	.. S QUAL =$P(X0,U,1 7) I $L(QU AL) F I=1: 1:$L(QUAL, ";") D
	9027	"RTN","HMP DGMV",43,0 )
	9028	... S X=$ P(QUAL,";" ,I),Y=$$GE TIEN^GMVGE TQL(X,1)
	9029	"RTN","HMP DGMV",44,0 )
	9030	... I Y S VIT("meas urement",N ,"qualifie r",I)=X_U_ $$FIELD^GM VGETQL(Y,3 )
	9031	"RTN","HMP DGMV",45,0 )
	9032	. S VIT(" entered")= $P($G(X0), U,4) ;use last one
	9033	"RTN","HMP DGMV",46,0 )
	9034	. S X=+$P ($G(X0),U, 5) S:X VIT ("location ")=$$LOC(X )
	9035	"RTN","HMP DGMV",47,0 )
	9036	. S VIT(" facility") =$$FAC^HMP D(X)
	9037	"RTN","HMP DGMV",48,0 )
	9038	. D XML(. VIT)
	9039	"RTN","HMP DGMV",49,0 )
	9040	K ^UTILIT Y($J,"GMRV D")
	9041	"RTN","HMP DGMV",50,0 )
	9042	Q
	9043	"RTN","HMP DGMV",51,0 )
	9044	;
	9045	"RTN","HMP DGMV",52,0 )
	9046	EN1(ID,VIT ) ; -- ret urn a vita l/measurem ent in VIT ("attribut e")
	9047	"RTN","HMP DGMV",53,0 )
	9048	K VIT S I D=+$G(ID) Q:ID<1 ;i nvalid ien
	9049	"RTN","HMP DGMV",54,0 )
	9050	N HMPY,X0 ,DFN,TYPE, X,Y,NAME,V UID,RESULT ,UNIT,MRES ,MUNT,HIGH ,LOW,I
	9051	"RTN","HMP DGMV",55,0 )
	9052	D GETREC^ GMVUTL(.HM PY,ID,1) S X0=$G(HMP Y(0))
	9053	"RTN","HMP DGMV",56,0 )
	9054	S DFN=+$P (X0,U,2) Q :DFN<1
	9055	"RTN","HMP DGMV",57,0 )
	9056	S TYPE=$$ FIELD^GMVG ETVT(+$P(X 0,U,3),2)
	9057	"RTN","HMP DGMV",58,0 )
	9058	S X=+$P(X 0,U,5),VIT ("location ")=$$LOC(X )
	9059	"RTN","HMP DGMV",59,0 )
	9060	S VIT("fa cility")=$ $FAC^HMPD( X)
	9061	"RTN","HMP DGMV",60,0 )
	9062	S NAME=$$ FIELD^GMVG ETVT($P(X0 ,U,3),1),V UID=$$FIEL D^GMVGETVT ($P(X0,U,3 ),4)
	9063	"RTN","HMP DGMV",61,0 )
	9064	S X=$P(X0 ,U,8),RESU LT=X,UNIT= $$UNIT(TYP E),(MRES,M UNT)=""
	9065	"RTN","HMP DGMV",62,0 )
	9066	I TYPE="T " S MUNT= "C",MRES=$ J(X-32*5/9 ,0,1) ;EN1 ^GMRVUTL
	9067	"RTN","HMP DGMV",63,0 )
	9068	I TYPE="H T" S MUNT= "cm",MRES= $J(2.54*X, 0,2) ;EN2 ^GMRVUTL
	9069	"RTN","HMP DGMV",64,0 )
	9070	I TYPE="W T" S MUNT= "kg",MRES= $J(X/2.2,0 ,2) ;EN3 ^GMRVUTL
	9071	"RTN","HMP DGMV",65,0 )
	9072	I TYPE="C G" S MUNT= "cm",MRES= $J(2.54*X, 0,2)
	9073	"RTN","HMP DGMV",66,0 )
	9074	S VIT("ta ken")=+X0, VIT("enter ed")=+$P(X 0,U,4),(HI GH,LOW)=""
	9075	"RTN","HMP DGMV",67,0 )
	9076	S X=$$RAN GE(TYPE) I $L(X) S H IGH=$P(X,U ),LOW=$P(X ,U,2)
	9077	"RTN","HMP DGMV",68,0 )
	9078	S VIT("me asurement" ,1)=ID_U_V UID_U_NAME _U_RESULT_ U_UNIT_U_M RES_U_MUNT _U_HIGH_U_ LOW
	9079	"RTN","HMP DGMV",69,0 )
	9080	F I=1:1:$ L(HMPY(5), U) S X=$P( HMPY(5),U, I),VIT("me asurement" ,1,"qualif ier",I)=$$ FIELD^GMVG ETQL(X,1)_ U_$$FIELD^ GMVGETQL(X ,3) ;name^ VUID
	9081	"RTN","HMP DGMV",70,0 )
	9082	I $G(HMPY (2)) D ;e ntered in error/reas ons
	9083	"RTN","HMP DGMV",71,0 )
	9084	. S X=$P( HMPY(2),U, 3)
	9085	"RTN","HMP DGMV",72,0 )
	9086	. F I=1:1 :$L(X,"~") S VIT("re moved",I)= $$EXTERNAL ^DILFD(120 .506,.01,, $P(X,"~",I ))
	9087	"RTN","HMP DGMV",73,0 )
	9088	Q
	9089	"RTN","HMP DGMV",74,0 )
	9090	;
	9091	"RTN","HMP DGMV",75,0 )
	9092	UNIT(X) ; -- Return unit for v ital type X
	9093	"RTN","HMP DGMV",76,0 )
	9094	N Y S Y=" "
	9095	"RTN","HMP DGMV",77,0 )
	9096	I TYPE="B P" S Y="m m[Hg]"
	9097	"RTN","HMP DGMV",78,0 )
	9098	I TYPE="T " S Y="F "
	9099	"RTN","HMP DGMV",79,0 )
	9100	I TYPE="R " S Y="/ min"
	9101	"RTN","HMP DGMV",80,0 )
	9102	I TYPE="P " S Y="/ min"
	9103	"RTN","HMP DGMV",81,0 )
	9104	I TYPE="H T" S Y="i n"
	9105	"RTN","HMP DGMV",82,0 )
	9106	I TYPE="W T" S Y="l b"
	9107	"RTN","HMP DGMV",83,0 )
	9108	I TYPE="C VP" S Y="c mH2O"
	9109	"RTN","HMP DGMV",84,0 )
	9110	I TYPE="C G" S Y="i n"
	9111	"RTN","HMP DGMV",85,0 )
	9112	I TYPE="P O2" S Y="% "
	9113	"RTN","HMP DGMV",86,0 )
	9114	Q Y
	9115	"RTN","HMP DGMV",87,0 )
	9116	;
	9117	"RTN","HMP DGMV",88,0 )
	9118	USER(X) ; -- Return ien^name f or person# X
	9119	"RTN","HMP DGMV",89,0 )
	9120	N Y S X=+ $G(X)
	9121	"RTN","HMP DGMV",90,0 )
	9122	S Y=$S(X: X_U_$P($G( ^VA(200,X, 0)),U),1:" ^") ; IA 1 0060, DE28 18 ASF 11/ 4/15
	9123	"RTN","HMP DGMV",91,0 )
	9124	Q Y
	9125	"RTN","HMP DGMV",92,0 )
	9126	;
	9127	"RTN","HMP DGMV",93,0 )
	9128	LOC(X) ; - - Return i en^name fo r hospital location X
	9129	"RTN","HMP DGMV",94,0 )
	9130	N Y S X=+ $G(X)
	9131	"RTN","HMP DGMV",95,0 )
	9132	; DE2818 begin chan ge ASF 11/ 4/15
	9133	"RTN","HMP DGMV",96,0 )
	9134	;S Y=$S(X :X_U_$P($G (^SC(X,0)) ,U),1:"^")
	9135	"RTN","HMP DGMV",97,0 )
	9136	N DA,DIC, DIQ,DR,R ; FileMan variables
	9137	"RTN","HMP DGMV",98,0 )
	9138	S DIC=44, DR=.01,DA= X,DIQ="R"
	9139	"RTN","HMP DGMV",99,0 )
	9140	D EN^DIQ1
	9141	"RTN","HMP DGMV",100, 0)
	9142	S Y="^"
	9143	"RTN","HMP DGMV",101, 0)
	9144	S:$D(R(44 ,DA,.01)) Y=DA_U_R(4 4,DA,.01)
	9145	"RTN","HMP DGMV",102, 0)
	9146	; DE2818 end change
	9147	"RTN","HMP DGMV",103, 0)
	9148	Q Y
	9149	"RTN","HMP DGMV",104, 0)
	9150	;
	9151	"RTN","HMP DGMV",105, 0)
	9152	RANGE(TYPE ) ; -- ret urn high^l ow range o f values f or TYPE
	9153	"RTN","HMP DGMV",106, 0)
	9154	N Y I '$D (HMPPARAM( TYPE)) D ;get param eter value s
	9155	"RTN","HMP DGMV",107, 0)
	9156	. N HMPFL DS,HMPI,HM PY,HMPN,HM PX,X
	9157	"RTN","HMP DGMV",108, 0)
	9158	. S HMPFL DS=$S(TYPE ="T":"5.1^ 5.2",TYPE= "P":"5.3^5 .4",TYPE=" R":"5.5^5. 6",TYPE="C VP":"6.1^6 .2",TYPE=" PO2":6.3,T YPE="BP":" 5.7^5.71^5 .8^5.81",1 :"") Q:HMP FLDS=""
	9159	"RTN","HMP DGMV",109, 0)
	9160	. F HMPI= 1:1:$L(HMP FLDS,U) S HMPN=$P(HM PFLDS,U,HM PI) D RPC^ GMVRPCM(.H MPY,"GETHI LO",HMPN) S HMPX(HMP N)=$G(@HMP Y@(0))
	9161	"RTN","HMP DGMV",110, 0)
	9162	. I TYPE= "T" S HMPP ARAM(TYPE) =$G(HMPX(5 .1))_U_$G( HMPX(5.2))
	9163	"RTN","HMP DGMV",111, 0)
	9164	. I TYPE= "P" S HMPP ARAM(TYPE) =$G(HMPX(5 .3))_U_$G( HMPX(5.4))
	9165	"RTN","HMP DGMV",112, 0)
	9166	. I TYPE= "R" S HMPP ARAM(TYPE) =$G(HMPX(5 .5))_U_$G( HMPX(5.6))
	9167	"RTN","HMP DGMV",113, 0)
	9168	. I TYPE= "CVP" S HM PPARAM(TYP E)=$G(HMPX (6.1))_U_$ G(HMPX(6.2 ))
	9169	"RTN","HMP DGMV",114, 0)
	9170	. I TYPE= "PO2" S HM PPARAM(TYP E)="100^"_ $G(HMPX(6. 3))
	9171	"RTN","HMP DGMV",115, 0)
	9172	. I TYPE= "BP" S HMP PARAM(TYPE )=$G(HMPX( 5.7))_"/"_ $G(HMPX(5. 71))_U_$G( HMPX(5.8)) _"/"_$G(HM PX(5.81))
	9173	"RTN","HMP DGMV",116, 0)
	9174	S Y=$G(HM PPARAM(TYP E))
	9175	"RTN","HMP DGMV",117, 0)
	9176	Q Y
	9177	"RTN","HMP DGMV",118, 0)
	9178	;
	9179	"RTN","HMP DGMV",119, 0)
	9180	; ------- ----- Retu rn data to middle ti er ------- -----
	9181	"RTN","HMP DGMV",120, 0)
	9182	;
	9183	"RTN","HMP DGMV",121, 0)
	9184	NAME(X) ; -- Return name of me asurement type X for XML eleme nt
	9185	"RTN","HMP DGMV",122, 0)
	9186	N Y S X=$ G(X),Y=""
	9187	"RTN","HMP DGMV",123, 0)
	9188	S Y=$S(X= "BP":"bloo dPressure" ,X="T":"te mperature" ,X="R":"re spiration" ,X="P":"pu lse",X="HT ":"height" ,X="WT":"w eight",X=" CVP":"cent ralVenousP ressure",X ="CG":"cir cumference Girth",X=" PO2":"puls eOximetry" ,X="PN":"p ain",1:"")
	9189	"RTN","HMP DGMV",124, 0)
	9190	Q Y
	9191	"RTN","HMP DGMV",125, 0)
	9192	;
	9193	"RTN","HMP DGMV",126, 0)
	9194	XML(VIT) ; -- Return vital mea surement a s XML in @ HMP@(#)
	9195	"RTN","HMP DGMV",127, 0)
	9196	N ATT,X,Y ,I,J,P,NAM ES,TAG
	9197	"RTN","HMP DGMV",128, 0)
	9198	D ADD("<v ital>") S HMPTOTL=$G (HMPTOTL)+ 1
	9199	"RTN","HMP DGMV",129, 0)
	9200	S ATT="" F S ATT=$ O(VIT(ATT) ) Q:ATT="" D
	9201	"RTN","HMP DGMV",130, 0)
	9202	. I ATT=" measuremen t" D Q
	9203	"RTN","HMP DGMV",131, 0)
	9204	.. D ADD( "<measurem ents>")
	9205	"RTN","HMP DGMV",132, 0)
	9206	.. S NAME S="id^vuid ^name^valu e^units^me tricValue^ metricUnit s^high^low ^Z"
	9207	"RTN","HMP DGMV",133, 0)
	9208	.. S I=0 F S I=$O( VIT(ATT,I) ) Q:I<1 D
	9209	"RTN","HMP DGMV",134, 0)
	9210	... S X=$ G(VIT(ATT, I)),Y="<"_ ATT_" "
	9211	"RTN","HMP DGMV",135, 0)
	9212	... F P=1 :1 S TAG=$ P(NAMES,U, P) Q:TAG=" Z" I $L($ P(X,U,P)) S Y=Y_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	9213	"RTN","HMP DGMV",136, 0)
	9214	... I '$D (VIT(ATT,I ,"qualifie r")) S Y=Y _"/>" D AD D(Y) Q
	9215	"RTN","HMP DGMV",137, 0)
	9216	... S Y=Y _">" D ADD (Y),ADD("< qualifiers >")
	9217	"RTN","HMP DGMV",138, 0)
	9218	... S J=0 F S J=$O (VIT(ATT,I ,"qualifie r",J)) Q:J <1 D
	9219	"RTN","HMP DGMV",139, 0)
	9220	.... S Y= "<qualifie r ",X=$G(V IT(ATT,I," qualifier" ,J))
	9221	"RTN","HMP DGMV",140, 0)
	9222	.... F P= 1:1 S TAG= $P("name^v uid^Z",U,P ) Q:TAG="Z " I $L($P (X,U,P)) S Y=Y_TAG_" ='"_$$ESC^ HMPD($P(X, U,P))_"' "
	9223	"RTN","HMP DGMV",141, 0)
	9224	.... S Y= Y_"/>" D A DD(Y)
	9225	"RTN","HMP DGMV",142, 0)
	9226	... D ADD ("</qualif iers>"),AD D("</measu rement>")
	9227	"RTN","HMP DGMV",143, 0)
	9228	.. D ADD( "</measure ments>")
	9229	"RTN","HMP DGMV",144, 0)
	9230	. I ATT=" removed" D Q
	9231	"RTN","HMP DGMV",145, 0)
	9232	.. D ADD( "<removed> ")
	9233	"RTN","HMP DGMV",146, 0)
	9234	.. S I=0 F S I=$O( VIT(ATT,I) ) Q:I<1 S Y="<reaso n value='" _$G(VIT(AT T,I))_"' / >" D ADD(Y )
	9235	"RTN","HMP DGMV",147, 0)
	9236	.. D ADD( "</removed >")
	9237	"RTN","HMP DGMV",148, 0)
	9238	. S X=$G( VIT(ATT)), Y="" Q:'$L (X)
	9239	"RTN","HMP DGMV",149, 0)
	9240	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" D AD D(Y) Q
	9241	"RTN","HMP DGMV",150, 0)
	9242	. I $L(X) >1 D
	9243	"RTN","HMP DGMV",151, 0)
	9244	.. S Y="< "_ATT_" "
	9245	"RTN","HMP DGMV",152, 0)
	9246	.. F P=1: 1 S TAG=$P ("code^nam e^Z",U,P) Q:TAG="Z" I $L($P(X ,U,P)) S Y =Y_TAG_"=' "_$$ESC^HM PD($P(X,U, P))_"' "
	9247	"RTN","HMP DGMV",153, 0)
	9248	.. S Y=Y_ "/>" D ADD (Y)
	9249	"RTN","HMP DGMV",154, 0)
	9250	D ADD("</ vital>")
	9251	"RTN","HMP DGMV",155, 0)
	9252	Q
	9253	"RTN","HMP DGMV",156, 0)
	9254	;
	9255	"RTN","HMP DGMV",157, 0)
	9256	ADD(X) ; A dd a line @HMP@(n)=X
	9257	"RTN","HMP DGMV",158, 0)
	9258	S HMPI=$G (HMPI)+1
	9259	"RTN","HMP DGMV",159, 0)
	9260	S @HMP@(H MPI)=X
	9261	"RTN","HMP DGMV",160, 0)
	9262	Q
	9263	"RTN","HMP DGPF")
	9264	1^159
	9265	"RTN","HMP DIB")
	9266	1^160
	9267	"RTN","HMP DJ")
	9268	0^28^B3657 2187
	9269	"RTN","HMP DJ",1,0)
	9270	HMPDJ ;SLC /MKB,ASMR/ RRB -- Ser ve VistA d ata as JSO N via RPC; Oct 15, 20 15 18:39:5 1
	9271	"RTN","HMP DJ",2,0)
	9272	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	9273	"RTN","HMP DJ",3,0)
	9274	;Per VA D irective 6 402, this routine sh ould not b e modified .
	9275	"RTN","HMP DJ",4,0)
	9276	;
	9277	"RTN","HMP DJ",5,0)
	9278	; Externa l Referenc es DBIA#
	9279	"RTN","HMP DJ",6,0)
	9280	; ------- ---------- -- -----
	9281	"RTN","HMP DJ",7,0)
	9282	; ^DPT 10035
	9283	"RTN","HMP DJ",8,0)
	9284	; MPIF001 2701
	9285	"RTN","HMP DJ",9,0)
	9286	; XLFDT 10103
	9287	"RTN","HMP DJ",10,0)
	9288	; XLFSTR 10104
	9289	"RTN","HMP DJ",11,0)
	9290	; XUPARAM 2541
	9291	"RTN","HMP DJ",12,0)
	9292	;
	9293	"RTN","HMP DJ",13,0)
	9294	; DE2818/ RRB - SQA findings 1 st 3 lines of code.
	9295	"RTN","HMP DJ",14,0)
	9296	;
	9297	"RTN","HMP DJ",15,0)
	9298	Q
	9299	"RTN","HMP DJ",16,0)
	9300	GET(HMP,FI LTER) ; -- Return se arch resul ts as JSON in @HMP@( n)
	9301	"RTN","HMP DJ",17,0)
	9302	; RPC = H MP GET PAT IENT DATA JSON
	9303	"RTN","HMP DJ",18,0)
	9304	; where F ILTER("pat ientId") = DFN or DF N;ICN
	9305	"RTN","HMP DJ",19,0)
	9306	; F ILTER("dom ain") = name of d esired dat a type (s ee HMPDJ0)
	9307	"RTN","HMP DJ",20,0)
	9308	; F ILTER("tex t") = boolean, to include document text [opt]
	9309	"RTN","HMP DJ",21,0)
	9310	; F ILTER("sta rt") = start dat e.time of search [opt]
	9311	"RTN","HMP DJ",22,0)
	9312	; F ILTER("sto p") = stop date .time of s earch [opt]
	9313	"RTN","HMP DJ",23,0)
	9314	; F ILTER("max ") = maximum n umber of i tems to re turn [opt]
	9315	"RTN","HMP DJ",24,0)
	9316	; F ILTER("id" ) = single it em id to r eturn [opt]
	9317	"RTN","HMP DJ",25,0)
	9318	; F ILTER("uid ") = single re cord uid t o return [opt]
	9319	"RTN","HMP DJ",26,0)
	9320	; F ILTER("noH ead") = flag, to omit heade r and comm as [opt]
	9321	"RTN","HMP DJ",27,0)
	9322	;
	9323	"RTN","HMP DJ",28,0)
	9324	N ICN,DFN ,HMPI,HMPS YS,HMPTYPE ,HMPSTART, HMPSTOP,HM PMAX,HMPID ,HMPTEXT,H MPP,TYPE,H MPTN,HMPER R
	9325	"RTN","HMP DJ",29,0)
	9326	S HMP=$NA (^TMP("HMP ",$J)),HMP I=0 K @HMP
	9327	"RTN","HMP DJ",30,0)
	9328	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	9329	"RTN","HMP DJ",31,0)
	9330	S DT=$$DT ^XLFDT ; for crossi ng midnigh t boundary
	9331	"RTN","HMP DJ",32,0)
	9332	;
	9333	"RTN","HMP DJ",33,0)
	9334	; parse & validate input para meters
	9335	"RTN","HMP DJ",34,0)
	9336	I $G(FILT ER("uid")) '="" D SEP UID(.FILTE R)
	9337	"RTN","HMP DJ",35,0)
	9338	;
	9339	"RTN","HMP DJ",36,0)
	9340	S DFN=$G( FILTER("pa tientId"))
	9341	"RTN","HMP DJ",37,0)
	9342	;
	9343	"RTN","HMP DJ",38,0)
	9344	S ICN=+$P ($G(DFN)," ;",2),DFN= +$G(DFN)
	9345	"RTN","HMP DJ",39,0)
	9346	I DFN<1,I CN S DFN=+ $$GETDFN^M PIF001(ICN )
	9347	"RTN","HMP DJ",40,0)
	9348	;
	9349	"RTN","HMP DJ",41,0)
	9350	S HMPTYPE =$G(FILTER ("domain") ) S:HMPTYP E="" HMPTY PE=$$ALL
	9351	"RTN","HMP DJ",42,0)
	9352	I $D(ZTQU EUED) S HM P=$NA(^XTM P(HMPBATCH ,HMPFZTSK, HMPTYPE)) K @HMP
	9353	"RTN","HMP DJ",43,0)
	9354	I HMPTYPE '="new",DF N<1!'$D(^D PT(DFN)) S HMPERR=$$ ERR(1,DFN) G GTQ ;IC R 10035 DE 2818 ASF 1 1/2/15
	9355	"RTN","HMP DJ",44,0)
	9356	;
	9357	"RTN","HMP DJ",45,0)
	9358	; -- init ialize chu nking if f rom DOMPT^ HMPDJFSP ; i.e. HMPC HNK define d S68-JCH
	9359	"RTN","HMP DJ",46,0)
	9360	D CHNKINI T^HMPDJFSP (.HMP,.HMP I) ; S68- JCH
	9361	"RTN","HMP DJ",47,0)
	9362	;
	9363	"RTN","HMP DJ",48,0)
	9364	S HMPSTAR T=+$G(FILT ER("start" ),1410102)
	9365	"RTN","HMP DJ",49,0)
	9366	S HMPSTOP =+$G(FILTE R("stop"), 4141015)
	9367	"RTN","HMP DJ",50,0)
	9368	S HMPMAX= +$G(FILTER ("max"),99 9999)
	9369	"RTN","HMP DJ",51,0)
	9370	I HMPSTAR T,HMPSTOP, HMPSTOP<HM PSTART D
	9371	"RTN","HMP DJ",52,0)
	9372	. N X S X =HMPSTART, HMPSTART=H MPSTOP,HMP STOP=X
	9373	"RTN","HMP DJ",53,0)
	9374	I HMPSTOP ,$L(HMPSTO P,".")<2 S HMPSTOP=H MPSTOP_".2 4"
	9375	"RTN","HMP DJ",54,0)
	9376	;
	9377	"RTN","HMP DJ",55,0)
	9378	S HMPID=$ G(FILTER(" id"))
	9379	"RTN","HMP DJ",56,0)
	9380	S HMPTEXT =+$G(FILTE R("text"), 1) ;defaul t = true/t ext
	9381	"RTN","HMP DJ",57,0)
	9382	;
	9383	"RTN","HMP DJ",58,0)
	9384	;set erro r trap
	9385	"RTN","HMP DJ",59,0)
	9386	K ^TMP($J ,"HMP ERRO R")
	9387	"RTN","HMP DJ",60,0)
	9388	;
	9389	"RTN","HMP DJ",61,0)
	9390	; extract data
	9391	"RTN","HMP DJ",62,0)
	9392	I HMPTYPE ="new",$L( $T(EN^HMPD JX)),'$G(^ XTMP("HMP- off","GET" )) D EN^HM PDJX(HMPID ,HMPMAX) Q ;data up dates
	9393	"RTN","HMP DJ",63,0)
	9394	F HMPP=1: 1:$L(HMPTY PE,";") S TYPE=$P(HM PTYPE,";", HMPP) I $L (TYPE) D
	9395	"RTN","HMP DJ",64,0)
	9396	. S HMPTN =$$TAG(TYP E)_"^HMPDJ 0" Q:'$L($ T(@HMPTN)) ;D ERR(2 ) Q
	9397	"RTN","HMP DJ",65,0)
	9398	. N $ES,$ ET,ERRPAT, ERRMSG
	9399	"RTN","HMP DJ",66,0)
	9400	. S $ET=" D ERRHDLR^ HMPDERRH", ERRMSG="A problem oc curred whe n trying t o load pat ient data from an AP I."
	9401	"RTN","HMP DJ",67,0)
	9402	. D @HMPT N
	9403	"RTN","HMP DJ",68,0)
	9404	;
	9405	"RTN","HMP DJ",69,0)
	9406	GTQ ; add item count and termi nating cha racters
	9407	"RTN","HMP DJ",70,0)
	9408	N ERROR I $D(^TMP($ J,"HMP ERR OR"))>0 D BUILDERR(. ERROR)
	9409	"RTN","HMP DJ",71,0)
	9410	I +$G(FIL TER("noHea d"))=1 D Q
	9411	"RTN","HMP DJ",72,0)
	9412	.S @HMP@( "total")=+ $G(HMPI)
	9413	"RTN","HMP DJ",73,0)
	9414	.I $L($G( ERROR(1))) >1 S @HMP@ ("error")= ERROR(1)
	9415	"RTN","HMP DJ",74,0)
	9416	S @HMP@(. 5)="{""api Version"": ""1.01""," "params"": {"_$$SYS_" },"
	9417	"RTN","HMP DJ",75,0)
	9418	I $D(HMPE RR) S @HMP @(1)="""er ror"":{""m essage"":" ""_HMPERR_ """}}" Q
	9419	"RTN","HMP DJ",76,0)
	9420	I '$D(@HM P)!'$G(HMP I) D Q
	9421	"RTN","HMP DJ",77,0)
	9422	. I '$D(E RROR) S @H MP@(1)=""" data"":{"" totalItems "":0,""ite ms"":[]}}" Q
	9423	"RTN","HMP DJ",78,0)
	9424	. S @HMP@ (1)="""dat a"":{""tot alItems"": 0,""items" ":[]},"
	9425	"RTN","HMP DJ",79,0)
	9426	. S @HMP@ (2,1)=ERRO R(1)_"}"
	9427	"RTN","HMP DJ",80,0)
	9428	;
	9429	"RTN","HMP DJ",81,0)
	9430	S @HMP@(. 6)="""data "":{""upda ted"":"""_ $$HL7NOW_" "",""total Items"":"_ HMPI_",""i tems"":["
	9431	"RTN","HMP DJ",82,0)
	9432	S HMPI=HM PI+1,@HMP@ (HMPI)=$S( $D(ERROR): "]}",1:"]} }")
	9433	"RTN","HMP DJ",83,0)
	9434	I $D(ERRO R)>0 S HMP I=HMPI+1,@ HMP@(HMPI, .3)=",",@H MP@(HMPI,1 )=ERROR(1) _"}"
	9435	"RTN","HMP DJ",84,0)
	9436	K ^TMP($J ,"HMP ERRO R"),^TMP(" HMPTEXT",$ J)
	9437	"RTN","HMP DJ",85,0)
	9438	Q
	9439	"RTN","HMP DJ",86,0)
	9440	;
	9441	"RTN","HMP DJ",87,0)
	9442	SEPUID(FIL TER) ; -- separate u id into FI LTER piece s
	9443	"RTN","HMP DJ",88,0)
	9444	N UID
	9445	"RTN","HMP DJ",89,0)
	9446	S UID=$G( FILTER("ui d")) K FIL TER("uid") Q:UID=""
	9447	"RTN","HMP DJ",90,0)
	9448	I $P(UID, ":",4)'=HM PSYS Q
	9449	"RTN","HMP DJ",91,0)
	9450	S FILTER( "patientId ")=$P(UID, ":",5)
	9451	"RTN","HMP DJ",92,0)
	9452	S FILTER( "domain")= $P(UID,":" ,3)
	9453	"RTN","HMP DJ",93,0)
	9454	S FILTER( "id")=$P(U ID,":",6)
	9455	"RTN","HMP DJ",94,0)
	9456	Q
	9457	"RTN","HMP DJ",95,0)
	9458	;
	9459	"RTN","HMP DJ",96,0)
	9460	SYS() ; -- return sy stem info for JSON h eader
	9461	"RTN","HMP DJ",97,0)
	9462	Q """doma in"":"""_$ $KSP^XUPAR AM("WHERE" )_""",""sy stemId"":" ""_HMPSYS_ """"
	9463	"RTN","HMP DJ",98,0)
	9464	;
	9465	"RTN","HMP DJ",99,0)
	9466	BUILDERR(R ESULT,DFN) ; -- buil d error ar ray
	9467	"RTN","HMP DJ",100,0)
	9468	N COUNT,M ESSAGE,MSG CNT
	9469	"RTN","HMP DJ",101,0)
	9470	S COUNT=$ G(^TMP($J, "HMP ERROR ","# of Er rors"))
	9471	"RTN","HMP DJ",102,0)
	9472	S MESSAGE ="A mumps error occu rred when extracting patient d ata. A tot al of "_CO UNT_" occu rred.\n\r"
	9473	"RTN","HMP DJ",103,0)
	9474	S MSGCNT= 0 F S MSG CNT=$O(^TM P($J,"HMP ERROR","ER ROR MESSAG E",MSGCNT) ) Q:MSGCNT '>0 D
	9475	"RTN","HMP DJ",104,0)
	9476	. S MESSA GE=MESSAGE _$G(^TMP($ J,"HMP ERR OR","ERROR MESSAGE", MSGCNT))_" \n\r"
	9477	"RTN","HMP DJ",105,0)
	9478	S RESULT( 1)="""erro r"":{""mes sage"":""" _MESSAGE_" ""}"
	9479	"RTN","HMP DJ",106,0)
	9480	Q
	9481	"RTN","HMP DJ",107,0)
	9482	;
	9483	"RTN","HMP DJ",108,0)
	9484	TAG(X) ; - - Return l inetag in HMPDJ0 rou tine for c linical do main X
	9485	"RTN","HMP DJ",109,0)
	9486	N Y S X=$ G(X,"Z")
	9487	"RTN","HMP DJ",110,0)
	9488	S Y=$E($$ UP^XLFSTR( X),1,8)
	9489	"RTN","HMP DJ",111,0)
	9490	S:'$L($T( @(Y_"^HMPD J0"))) Y=" HMP"
	9491	"RTN","HMP DJ",112,0)
	9492	Q Y
	9493	"RTN","HMP DJ",113,0)
	9494	;
	9495	"RTN","HMP DJ",114,0)
	9496	ALL() ; -- return st ring for a ll types o f data
	9497	"RTN","HMP DJ",115,0)
	9498	Q "patien t;problem; allergy;co nsult;vita l;lab;proc edure;obs; order;trea tment;med; ptf;factor ;immunizat ion;exam;c pt;educati on;pov;ski n;image;ap pointment; surgery;do cument;vis it;mh"
	9499	"RTN","HMP DJ",116,0)
	9500	;
	9501	"RTN","HMP DJ",117,0)
	9502	ERR(X,VAL) ; -- retu rn error m essage
	9503	"RTN","HMP DJ",118,0)
	9504	N MSG S MSG="Error "
	9505	"RTN","HMP DJ",119,0)
	9506	I X=1 S MSG="Patie nt with df n '"_$G(VA L)_"' not found"
	9507	"RTN","HMP DJ",120,0)
	9508	I X=2 S MSG="Domai n type '"_ $G(VAL)_"' not recog nized"
	9509	"RTN","HMP DJ",121,0)
	9510	I X=3 S MSG="UID ' "_$G(VAL)_ "' not fou nd"
	9511	"RTN","HMP DJ",122,0)
	9512	I X=4 S MSG="Unabl e to creat e new obje ct"
	9513	"RTN","HMP DJ",123,0)
	9514	I X=99 S MSG="Unkno wn request "
	9515	"RTN","HMP DJ",124,0)
	9516	Q MSG
	9517	"RTN","HMP DJ",125,0)
	9518	;
	9519	"RTN","HMP DJ",126,0)
	9520	HL7NOW() ; -- Return current t ime in HL7 format
	9521	"RTN","HMP DJ",127,0)
	9522	Q $P($$FM THL7^XLFDT ($$NOW^XLF DT),"-")
	9523	"RTN","HMP DJ",128,0)
	9524	;
	9525	"RTN","HMP DJ",129,0)
	9526	ADD(ITEM,C OLL) ; -- add ITEM t o results
	9527	"RTN","HMP DJ",130,0)
	9528	I $D(HMPC RC),$D(COL L) D ONE^H MPDCRC(ITE M,COLL) Q ;checksum
	9529	"RTN","HMP DJ",131,0)
	9530	; -- add ITEM to @H MP@(HMPI) to return JSON
	9531	"RTN","HMP DJ",132,0)
	9532	N HMPY,HM PERR
	9533	"RTN","HMP DJ",133,0)
	9534	D ENCODE^ HMPJSON(IT EM,"HMPY", "HMPERR")
	9535	"RTN","HMP DJ",134,0)
	9536	I $D(HMPE RR) D ;re turn ERRor instead o f ITEM
	9537	"RTN","HMP DJ",135,0)
	9538	. N HMPTM P,HMPTXT,H MPITM
	9539	"RTN","HMP DJ",136,0)
	9540	. M HMPIT M=@ITEM K HMPY
	9541	"RTN","HMP DJ",137,0)
	9542	. S HMPTX T(1)="Prob lem encodi ng json ou tput."
	9543	"RTN","HMP DJ",138,0)
	9544	. D SETER ROR^HMPUTI LS(.HMPTMP ,.HMPERR,. HMPTXT,.HM PITM)
	9545	"RTN","HMP DJ",139,0)
	9546	. K HMPER R D ENCODE ^HMPJSON(" HMPTMP","H MPY","HMPE RR")
	9547	"RTN","HMP DJ",140,0)
	9548	I $D(HMPY ) D
	9549	"RTN","HMP DJ",141,0)
	9550	. S HMPI= HMPI+1
	9551	"RTN","HMP DJ",142,0)
	9552	. I HMPI> 1 S @HMP@( HMPI,.3)=" ,"
	9553	"RTN","HMP DJ",143,0)
	9554	. M @HMP@ (HMPI)=HMP Y
	9555	"RTN","HMP DJ",144,0)
	9556	. ;
	9557	"RTN","HMP DJ",145,0)
	9558	. ; -- ch unk data i f from DOM PT^HMPDJFS P ; i.e. H MPCHNK def ined ; S6 8-JCH
	9559	"RTN","HMP DJ",146,0)
	9560	. D CHNKC HK^HMPDJFS P(.HMP,.HM PI) ; S68 -JCH
	9561	"RTN","HMP DJ",147,0)
	9562	Q
	9563	"RTN","HMP DJ",148,0)
	9564	;
	9565	"RTN","HMP DJ",149,0)
	9566	TEST(DFN,T YPE,ID,TEX T,IN) ; -- test GET, write res ults to sc reen
	9567	"RTN","HMP DJ",150,0)
	9568	N OUT,IDX S U="^"
	9569	"RTN","HMP DJ",151,0)
	9570	S:'$D(IN( "systemID" )) IN("sys temID")=$$ GET^XPAR(" SYS","HMP SYSTEM NAM E")
	9571	"RTN","HMP DJ",152,0)
	9572	S IN("pat ientId")=+ $G(DFN)
	9573	"RTN","HMP DJ",153,0)
	9574	S IN("dom ain")=$G(T YPE)
	9575	"RTN","HMP DJ",154,0)
	9576	S:$D(ID) IN("id")=I D
	9577	"RTN","HMP DJ",155,0)
	9578	S:$D(TEXT ) IN("text ")=TEXT
	9579	"RTN","HMP DJ",156,0)
	9580	D GET(.OU T,.IN)
	9581	"RTN","HMP DJ",157,0)
	9582	;
	9583	"RTN","HMP DJ",158,0)
	9584	S IDX=OUT
	9585	"RTN","HMP DJ",159,0)
	9586	F S IDX= $Q(@IDX) Q :IDX'?1"^T MP(""HMP"" ,"1.N.E Q :+$P(IDX," ,",2)'=$J W !,@IDX
	9587	"RTN","HMP DJ",160,0)
	9588	Q
	9589	"RTN","HMP DJ",161,0)
	9590	;
	9591	"RTN","HMP DJ0")
	9592	0^29^B1184 17079
	9593	"RTN","HMP DJ0",1,0)
	9594	HMPDJ0 ;SL C/MKB,ASMR /RRB - Ser ve VistA d ata as JSO N cont;Nov 18, 2015 14:10:42
	9595	"RTN","HMP DJ0",2,0)
	9596	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	9597	"RTN","HMP DJ0",3,0)
	9598	;Per VA D irective 6 402, this routine sh ould not b e modified .
	9599	"RTN","HMP DJ0",4,0)
	9600	;
	9601	"RTN","HMP DJ0",5,0)
	9602	; Externa l Referenc es DBIA#
	9603	"RTN","HMP DJ0",6,0)
	9604	; ------- ---------- -- -----
	9605	"RTN","HMP DJ0",7,0)
	9606	; ^DPT 10035 < see HMPDJ0 * for othe rs>
	9607	"RTN","HMP DJ0",8,0)
	9608	;
	9609	"RTN","HMP DJ0",9,0)
	9610	; All tag s expect D FN, HMPSTA RT, HMPSTO P, HMPMAX, HMPID, HM PTEXT
	9611	"RTN","HMP DJ0",10,0)
	9612	Q
	9613	"RTN","HMP DJ0",11,0)
	9614	;
	9615	"RTN","HMP DJ0",12,0)
	9616	PATIENT ; -- Patient Registrat ion
	9617	"RTN","HMP DJ0",13,0)
	9618	D DPT1^HM PDJ00
	9619	"RTN","HMP DJ0",14,0)
	9620	Q
	9621	"RTN","HMP DJ0",15,0)
	9622	;
	9623	"RTN","HMP DJ0",16,0)
	9624	PROBLEM ; -- Problem List
	9625	"RTN","HMP DJ0",17,0)
	9626	I $G(HMPI D) D GMPL1 ^HMPDJ02(H MPID) Q
	9627	"RTN","HMP DJ0",18,0)
	9628	N ID,HMPS TS,HMPPROB ,HMPN,X,PO VLST
	9629	"RTN","HMP DJ0",19,0)
	9630	S HMPSTS= $G(FILTER( "status")) ;default = all prob lems
	9631	"RTN","HMP DJ0",20,0)
	9632	D LIST^GM PLUTL2(.HM PPROB,DFN, HMPSTS)
	9633	"RTN","HMP DJ0",21,0)
	9634	D DIAGLIS T^HMPDJ02( .POVLST,DF N)
	9635	"RTN","HMP DJ0",22,0)
	9636	S HMPN=0 F S HMPN= $O(HMPPROB (HMPN)) Q: (HMPN<1)!( HMPI'<HMPM AX) D
	9637	"RTN","HMP DJ0",23,0)
	9638	. S X=$P( HMPPROB(HM PN),U,6) I X,(X<HMPS TART)!(X>H MPSTOP) Q ;last upd ated
	9639	"RTN","HMP DJ0",24,0)
	9640	. S ID=+H MPPROB(HMP N) D GMPL1 ^HMPDJ02(I D,.POVLST)
	9641	"RTN","HMP DJ0",25,0)
	9642	Q
	9643	"RTN","HMP DJ0",26,0)
	9644	;
	9645	"RTN","HMP DJ0",27,0)
	9646	ALLERGY ; -- Allergi es/Adverse Reactions
	9647	"RTN","HMP DJ0",28,0)
	9648	N GMRAL,I D D EN1^GM RADPT
	9649	"RTN","HMP DJ0",29,0)
	9650	; This IF statement was disab led to pre vent getti ng "delete s" in the
	9651	"RTN","HMP DJ0",30,0)
	9652	; JSON du ring a fet ch if ALL allergies for a give n patient have been marked
	9653	"RTN","HMP DJ0",31,0)
	9654	; as "ent ered in er ror". US60 21
	9655	"RTN","HMP DJ0",32,0)
	9656	;I 'GMRAL Q ;D NKA ^HMPDJ02 Q
	9657	"RTN","HMP DJ0",33,0)
	9658	I $G(HMPI D) D GMRA1 ^HMPDJ02(H MPID) Q
	9659	"RTN","HMP DJ0",34,0)
	9660	S ID=0 F S ID=+$O( GMRAL(ID)) Q:ID<1 D GMRA1^HMP DJ02(ID) Q :HMPI'<HMP MAX
	9661	"RTN","HMP DJ0",35,0)
	9662	Q
	9663	"RTN","HMP DJ0",36,0)
	9664	;
	9665	"RTN","HMP DJ0",37,0)
	9666	CONSULT ; -- Consult /Request T racking
	9667	"RTN","HMP DJ0",38,0)
	9668	N HMPN,HM PX,ID
	9669	"RTN","HMP DJ0",39,0)
	9670	D OER^GMR CSLM1(DFN, "",HMPSTAR T,HMPSTOP, "")
	9671	"RTN","HMP DJ0",40,0)
	9672	S HMPN=0 F S HMPN= $O(^TMP("G MRCR",$J," CS",HMPN)) Q:HMPN<1! (HMPN>HMPM AX) S HMP X=$G(^(HMP N,0)) Q:$E (HMPX)="<" D
	9673	"RTN","HMP DJ0",41,0)
	9674	. I $G(HM PID),HMPID '=+HMPX Q
	9675	"RTN","HMP DJ0",42,0)
	9676	. D GMRC1 ^HMPDJ03(+ HMPX)
	9677	"RTN","HMP DJ0",43,0)
	9678	K ^TMP("G MRCR",$J," CS")
	9679	"RTN","HMP DJ0",44,0)
	9680	Q
	9681	"RTN","HMP DJ0",45,0)
	9682	;
	9683	"RTN","HMP DJ0",46,0)
	9684	VITAL ; -- GMR Vital Measureme nts
	9685	"RTN","HMP DJ0",47,0)
	9686	I $L($G(H MPID)) D G MV1^HMPDJ0 2(HMPID) Q
	9687	"RTN","HMP DJ0",48,0)
	9688	N GMRVSTR ,HMPIDT,HM PTYP,ID
	9689	"RTN","HMP DJ0",49,0)
	9690	S GMRVSTR ="BP;T;R;P ;HT;WT;CVP ;CG;PO2;PN "
	9691	"RTN","HMP DJ0",50,0)
	9692	S GMRVSTR (0)=HMPSTA RT_U_HMPST OP_U_HMPMA X_"^1"
	9693	"RTN","HMP DJ0",51,0)
	9694	D EN1^GMR VUT0
	9695	"RTN","HMP DJ0",52,0)
	9696	S HMPIDT= 0 F S HMP IDT=$O(^UT ILITY($J," GMRVD",HMP IDT)) Q:HM PIDT<1 D Q:HMPI'<H MPMAX
	9697	"RTN","HMP DJ0",53,0)
	9698	. S HMPTY P="" F S HMPTYP=$O( ^UTILITY($ J,"GMRVD", HMPIDT,HMP TYP)) Q:HM PTYP="" D
	9699	"RTN","HMP DJ0",54,0)
	9700	.. S ID=$ O(^UTILITY ($J,"GMRVD ",HMPIDT,H MPTYP,0)) D GMV1^HMP DJ02(ID)
	9701	"RTN","HMP DJ0",55,0)
	9702	K ^UTILIT Y($J,"GMRV D")
	9703	"RTN","HMP DJ0",56,0)
	9704	Q
	9705	"RTN","HMP DJ0",57,0)
	9706	;
	9707	"RTN","HMP DJ0",58,0)
	9708	LAB ; -- L ab Results
	9709	"RTN","HMP DJ0",59,0)
	9710	N LRDFN,L RID,HMPSUB ,HMPIDT,HM PN,HMPP,HM PACC,BEG,E ND,SUB,ORP K,ID,X
	9711	"RTN","HMP DJ0",60,0)
	9712	S LRDFN=$ $LRDFN^HMP XGLAB(DFN) ,HMPSUB=$G (FILTER("c ategory")) ;DE2818, (#63) LAB ORATORY RE FERENCE
	9713	"RTN","HMP DJ0",61,0)
	9714	S BEG=HMP START,END= HMPSTOP,LR ID=$G(HMPI D),ORPK=""
	9715	"RTN","HMP DJ0",62,0)
	9716	I $L(LRID ) D ;rese t for LR7O R1
	9717	"RTN","HMP DJ0",63,0)
	9718	. I LRID S ORPK=LRI D,LRID=$P( LRID,";",4 ,99) Q:LRI D="" ;ord er
	9719	"RTN","HMP DJ0",64,0)
	9720	. S HMPSU B=$P(LRID, ";"),HMPID T=+$P(LRID ,";",2)
	9721	"RTN","HMP DJ0",65,0)
	9722	. S:HMPID T (BEG,END )=9999999- HMPIDT
	9723	"RTN","HMP DJ0",66,0)
	9724	S SUB=HMP SUB I $L(S UB),"CH^MI "'[SUB S S UB="AP"
	9725	"RTN","HMP DJ0",67,0)
	9726	D RR^LR7O R1(DFN,ORP K,BEG,END, SUB,,,HMPM AX) ; ICR 2503, DE2 818
	9727	"RTN","HMP DJ0",68,0)
	9728	S HMPSUB= "" F S HM PSUB=$O(^T MP("LRRR", $J,DFN,HMP SUB)) Q:HM PSUB="" D
	9729	"RTN","HMP DJ0",69,0)
	9730	. S HMPID T=0 F S H MPIDT=$O(^ TMP("LRRR" ,$J,DFN,HM PSUB,HMPID T)) Q:HMPI DT<1 I $O (^(HMPIDT, 0)) D Q:H MPI'<HMPMA X
	9731	"RTN","HMP DJ0",70,0)
	9732	.. I HMPS UB="MI" S ID=HMPSUB _";"_HMPID T D MI^HMP DJ06 Q
	9733	"RTN","HMP DJ0",71,0)
	9734	.. I HMPS UB'="CH" S ID=HMPSUB _";"_HMPID T D AP^HMP DJ06 Q
	9735	"RTN","HMP DJ0",72,0)
	9736	.. D ACC^ HMPDJ06 ;g et chem ac cession da ta
	9737	"RTN","HMP DJ0",73,0)
	9738	.. S HMPP =0 F S HM PP=$O(^TMP ("LRRR",$J ,DFN,HMPSU B,HMPIDT,H MPP)) Q:HM PP<1 S X= +$G(^(HMPP )) D
	9739	"RTN","HMP DJ0",74,0)
	9740	... S HMP N=$$LRDN^L RPXAPIU(X) I $L(LRID ,";")>2,HM PN'=$P(LRI D,";",3) Q
	9741	"RTN","HMP DJ0",75,0)
	9742	... S ID= HMPSUB_";" _HMPIDT_"; "_HMPN D C H1^HMPDJ06
	9743	"RTN","HMP DJ0",76,0)
	9744	K ^TMP("L RRR",$J),^ TMP("LRX", $J)
	9745	"RTN","HMP DJ0",77,0)
	9746	Q
	9747	"RTN","HMP DJ0",78,0)
	9748	;
	9749	"RTN","HMP DJ0",79,0)
	9750	PROCEDUR ; -- Clinic al Procedu res
	9751	"RTN","HMP DJ0",80,0)
	9752	N HMPN,HM PX,BEG,END ,ID
	9753	"RTN","HMP DJ0",81,0)
	9754	S BEG=HMP START,END= HMPSTOP
	9755	"RTN","HMP DJ0",82,0)
	9756	I $G(HMPI D) D ;res et dates f or HMPID o nly
	9757	"RTN","HMP DJ0",83,0)
	9758	. N HMPMC ,IEN,FILE, X
	9759	"RTN","HMP DJ0",84,0)
	9760	. S IEN=+ HMPID,FILE =+$P(HMPID ,"(",2) Q :FILE=702 Q:'FILE
	9761	"RTN","HMP DJ0",85,0)
	9762	. D MEDLK UP^MCARUTL 3(.HMPMC,F ILE,IEN)
	9763	"RTN","HMP DJ0",86,0)
	9764	. S X=$P( HMPMC,U,6) S:X (BEG, END)=X
	9765	"RTN","HMP DJ0",87,0)
	9766	D MDPS1^H MPDJ03(DFN ,BEG,END,H MPMAX) ;gets ^TMP ("MDHSP",$ J)
	9767	"RTN","HMP DJ0",88,0)
	9768	S HMPN=0 F S HMPN= $O(^TMP("M DHSP",$J,H MPN)) Q:HM PN<1 S HM PX=$G(^(HM PN)) D
	9769	"RTN","HMP DJ0",89,0)
	9770	. I $G(HM PID),+HMPI D'=+$P(HMP X,U,2) Q ;update 1 procedure
	9771	"RTN","HMP DJ0",90,0)
	9772	. D MC1^H MPDJ03($G( HMPID)) ;uses HMPX
	9773	"RTN","HMP DJ0",91,0)
	9774	K ^TMP("M DHSP",$J)
	9775	"RTN","HMP DJ0",92,0)
	9776	Q
	9777	"RTN","HMP DJ0",93,0)
	9778	;
	9779	"RTN","HMP DJ0",94,0)
	9780	OBS ; -- C linical Ob servations (CLiO)
	9781	"RTN","HMP DJ0",95,0)
	9782	N HMPCLIO ,HMPN,ID,X
	9783	"RTN","HMP DJ0",96,0)
	9784	I $L($G(H MPID)) D M DC1^HMPDJ0 3(HMPID) Q
	9785	"RTN","HMP DJ0",97,0)
	9786	D QRYPT^H MPDMDC("HM PCLIO",DFN ,HMPSTART, HMPSTOP) ; all [verif ied] obser vations
	9787	"RTN","HMP DJ0",98,0)
	9788	S HMPN=0 F S HMPN= $O(HMPCLIO (HMPN)) Q: (HMPN<1)!( HMPI'<HMPM AX) D
	9789	"RTN","HMP DJ0",99,0)
	9790	. S ID=$G (HMPCLIO(H MPN)) ;GUI D
	9791	"RTN","HMP DJ0",100,0 )
	9792	. D MDC1^ HMPDJ03(ID )
	9793	"RTN","HMP DJ0",101,0 )
	9794	Q
	9795	"RTN","HMP DJ0",102,0 )
	9796	;
	9797	"RTN","HMP DJ0",103,0 )
	9798	ORDER ; -- Order Ent ry
	9799	"RTN","HMP DJ0",104,0 )
	9800	N DAD,HMP N,HMPORDR, ID,ORLIST, X ; DE281 8, added H MPORDR, re moved X3,X 4
	9801	"RTN","HMP DJ0",105,0 )
	9802	I $G(HMPI D) S ORLIS T=$H D OR1 ^HMPDJ01(H MPID) G OR Q
	9803	"RTN","HMP DJ0",106,0 )
	9804	D EN^ORQ1 (DFN_";DPT (",,6,,HMP START,HMPS TOP,,,,1)
	9805	"RTN","HMP DJ0",107,0 )
	9806	S HMPN=0 F S HMPN= $O(^TMP("O RR",$J,ORL IST,HMPN)) Q:HMPN<1 S ID=$G(^ (HMPN)) D Q:HMPI'<H MPMAX
	9807	"RTN","HMP DJ0",108,0 )
	9808	. Q:$D(^T MP("ORGOTI T",$J,+ID) ) Q:$P(ID ,";",2)>1 S ID=+ID ;action s
	9809	"RTN","HMP DJ0",109,0 )
	9810	. ;DE2818 , begin lo gic change
	9811	"RTN","HMP DJ0",110,0 )
	9812	. K HMPOR DR D ORDIN FO(.HMPORD R,ID) ; k ill it for each iter ation
	9813	"RTN","HMP DJ0",111,0 )
	9814	. ;(#33) PACKAGE RE FERENCE,(# 5) STATUS: 13=CANCEL LED, 12=DI SCONTINUED /EDIT, 1=D ISCONTINUE D
	9815	"RTN","HMP DJ0",112,0 )
	9816	. Q:$G(HM PORDR(100, ID,5,"I")) =13 I $G( HMPORDR(10 0,ID,33,"I "))["P",($ G(HMPORDR( 100,ID,5," I"))=12)!( $G(HMPORDR (100,ID,5, "I"))=1) Q
	9817	"RTN","HMP DJ0",113,0 )
	9818	. S DAD=$ G(HMPORDR( 100,ID,36, "I")) ;(# 36) PARENT
	9819	"RTN","HMP DJ0",114,0 )
	9820	. I DAD D :'$D(^TMP( "ORGOTIT", $J,DAD)) O R1^HMPDJ01 (DAD) Q
	9821	"RTN","HMP DJ0",115,0 )
	9822	. ;DE2818 , end logi c change
	9823	"RTN","HMP DJ0",116,0 )
	9824	. D OR1^H MPDJ01(ID)
	9825	"RTN","HMP DJ0",117,0 )
	9826	ORQ ; end
	9827	"RTN","HMP DJ0",118,0 )
	9828	K ^TMP("O RR",$J),^T MP("ORGOTI T",$J)
	9829	"RTN","HMP DJ0",119,0 )
	9830	Q
	9831	"RTN","HMP DJ0",120,0 )
	9832	;
	9833	"RTN","HMP DJ0",121,0 )
	9834	TREATMEN ; -- Nursin g Treatmen ts (orders )
	9835	"RTN","HMP DJ0",122,0 )
	9836	N HMPN,HM PORDR,ID,O RDG,ORLIST ,X ;DE281 8, added H MPORDR, re moved X3,X 4
	9837	"RTN","HMP DJ0",123,0 )
	9838	I $G(HMPI D) S ORLIS T=$H D NTX 1^HMPDJ01( HMPID) G T XQ
	9839	"RTN","HMP DJ0",124,0 )
	9840	;DE2818, *replace ment for ^ ORD refere nce needed below*
	9841	"RTN","HMP DJ0",125,0 )
	9842	S ORDG=+$ O(^ORD(100 .98,"B","N TX",0))
	9843	"RTN","HMP DJ0",126,0 )
	9844	D EN^ORQ1 (DFN_";DPT (",ORDG,6, ,HMPSTART, HMPSTOP,,, ,1)
	9845	"RTN","HMP DJ0",127,0 )
	9846	S HMPN=0 F S HMPN= $O(^TMP("O RR",$J,ORL IST,HMPN)) Q:HMPN<1 S ID=$G(^ (HMPN)) D Q:HMPI'<H MPMAX
	9847	"RTN","HMP DJ0",128,0 )
	9848	. Q:$D(^T MP("ORGOTI T",$J,+ID) ) Q:$P(ID ,";",2)>1 S ID=+ID ;actions
	9849	"RTN","HMP DJ0",129,0 )
	9850	. ;DE2818 , begin lo gic change
	9851	"RTN","HMP DJ0",130,0 )
	9852	. K HMPOR DR D ORDIN FO(.HMPORD R,ID) ; k ill it for each iter ation
	9853	"RTN","HMP DJ0",131,0 )
	9854	. ;(#33) PACKAGE RE FERENCE,(# 5) STATUS: 13=CANCEL LED, 12=DI SCONTINUED /EDIT, 1=D ISCONTINUE D
	9855	"RTN","HMP DJ0",132,0 )
	9856	. Q:$G(HM PORDR(100, ID,5,"I")) =13 I $G( HMPORDR(10 0,ID,33,"I "))["P",($ G(HMPORDR( 100,ID,5," I"))=12)!( $G(HMPORDR (100,ID,5, "I"))=1) Q
	9857	"RTN","HMP DJ0",133,0 )
	9858	. ;DE2818 , end logi c change
	9859	"RTN","HMP DJ0",134,0 )
	9860	. D NTX1^ HMPDJ01(ID )
	9861	"RTN","HMP DJ0",135,0 )
	9862	TXQ ; end
	9863	"RTN","HMP DJ0",136,0 )
	9864	K ^TMP("O RR",$J),^T MP("ORGOTI T",$J)
	9865	"RTN","HMP DJ0",137,0 )
	9866	Q
	9867	"RTN","HMP DJ0",138,0 )
	9868	;
	9869	"RTN","HMP DJ0",139,0 )
	9870	MED ; -- P harmacy
	9871	"RTN","HMP DJ0",140,0 )
	9872	;DE2818, removed re ference to ^OR(100,H MPID) belo w
	9873	"RTN","HMP DJ0",141,0 )
	9874	N ORDIALO G I $G(HMP ID),$$GET1 ^DIQ(100,H MPID_",",. 01)]"" D P S1^HMPDJ05 (HMPID) Q ;get 1 or der
	9875	"RTN","HMP DJ0",142,0 )
	9876	N DAD,HMP N,HMPORDR, ID,ORDG,OR LIST,ORVP, TYPE ;DE2 818, added HMPORDR, removed ex tra ORLIST and X3,X4
	9877	"RTN","HMP DJ0",143,0 )
	9878	S TYPE=$G (FILTER("v aType")) S :$L(TYPE) TYPE=$S(TY PE="N":"NV ",TYPE="V" :"IV",1:TY PE)_" "
	9879	"RTN","HMP DJ0",144,0 )
	9880	;DE2818, *replace ment for ^ ORD refere nce needed below*
	9881	"RTN","HMP DJ0",145,0 )
	9882	S ORDG=$O (^ORD(100. 98,"B",TYP E_"RX",0)) ,ORVP=DFN_ ";DPT(" ;C PC removed + 10/30/1 5 DE2434
	9883	"RTN","HMP DJ0",146,0 )
	9884	;If RX gr oup not fo und, and n ot overrid den by spe cific type then try PHARMACY C PC 10/30/1 5 DE2434
	9885	"RTN","HMP DJ0",147,0 )
	9886	I ORDG="" S ORDG=0 I TYPE="" S ORDG=+$O (^ORD(100. 98,"B","PH ARMACY",0) ) ;CPC 10/ 30/15 DE24 34
	9887	"RTN","HMP DJ0",148,0 )
	9888	D EN^ORQ1 (ORVP,ORDG ,6,,HMPSTA RT,HMPSTOP )
	9889	"RTN","HMP DJ0",149,0 )
	9890	K ^TMP("H MPOR",$J) S HMPN=0
	9891	"RTN","HMP DJ0",150,0 )
	9892	F S HMPN =$O(^TMP(" ORR",$J,OR LIST,HMPN) ) Q:HMPN<1 S ID=$G( ^(HMPN)) D Q:HMPI'< HMPMAX
	9893	"RTN","HMP DJ0",151,0 )
	9894	. Q:$D(^T MP("HMPOR" ,$J,+ID)) Q:$P(ID," ;",2)>1 S ID=+ID
	9895	"RTN","HMP DJ0",152,0 )
	9896	. ;DE2818 , begin lo gic change
	9897	"RTN","HMP DJ0",153,0 )
	9898	. K HMPOR DR D ORDIN FO(.HMPORD R,ID) ; k ill it for each iter ation
	9899	"RTN","HMP DJ0",154,0 )
	9900	. ;(#33) PACKAGE RE FERENCE,(# 5) STATUS: 13=CANCEL LED, 12=DI SCONTINUED /EDIT, 1=D ISCONTINUE D
	9901	"RTN","HMP DJ0",155,0 )
	9902	. Q:$G(HM PORDR(100, ID,5,"I")) =13 I $G( HMPORDR(10 0,ID,33,"I "))["P",($ G(HMPORDR( 100,ID,5," I"))=12)!( $G(HMPORDR (100,ID,5, "I"))=1) Q
	9903	"RTN","HMP DJ0",156,0 )
	9904	. S DAD=$ G(HMPORDR( 100,ID,36, "I")) ;(# 36) PARENT
	9905	"RTN","HMP DJ0",157,0 )
	9906	. I DAD Q :$D(^TMP(" HMPOR",$J, DAD)) S I D=DAD
	9907	"RTN","HMP DJ0",158,0 )
	9908	. ;DE2818 , end logi c change
	9909	"RTN","HMP DJ0",159,0 )
	9910	. D PS1^H MPDJ05(ID) S ^TMP("H MPOR",$J,I D)=""
	9911	"RTN","HMP DJ0",160,0 )
	9912	K ^TMP("H MPOR",$J), ^TMP("ORR" ,$J),^TMP( "ORGOTIT", $J),^TMP($ J,"PSOI")
	9913	"RTN","HMP DJ0",161,0 )
	9914	Q
	9915	"RTN","HMP DJ0",162,0 )
	9916	;
	9917	"RTN","HMP DJ0",163,0 )
	9918	PTF ; -- P atient Tre atment Fil e
	9919	"RTN","HMP DJ0",164,0 )
	9920	;Purpose - Main Pat ient Treat ment File (PTF) RPC
	9921	"RTN","HMP DJ0",165,0 )
	9922	;
	9923	"RTN","HMP DJ0",166,0 )
	9924	;Called b y - PTF RP C
	9925	"RTN","HMP DJ0",167,0 )
	9926	;
	9927	"RTN","HMP DJ0",168,0 )
	9928	;Assumpti ons - Expe cts variab les DFN, H MPSTART, H MPSTOP, HM PMAX
	9929	"RTN","HMP DJ0",169,0 )
	9930	;
	9931	"RTN","HMP DJ0",170,0 )
	9932	;Modifica tion Histo ry -
	9933	"RTN","HMP DJ0",171,0 )
	9934	;US5630 ( TW) - Name spaced var iables and enhanced newing
	9935	"RTN","HMP DJ0",172,0 )
	9936	;
	9937	"RTN","HMP DJ0",173,0 )
	9938	N HMPRDT, HMPX,HMPAP I,HMPLID
	9939	"RTN","HMP DJ0",174,0 )
	9940	K ^TMP("H MPPX",$J)
	9941	"RTN","HMP DJ0",175,0 )
	9942	;
	9943	"RTN","HMP DJ0",176,0 )
	9944	I $G(HMPI D),HMPID'= +HMPID D P TFA^HMPDJ0 4A(HMPID) Q ; If HM PID and dx type, pro cess and q uit
	9945	"RTN","HMP DJ0",177,0 )
	9946	;
	9947	"RTN","HMP DJ0",178,0 )
	9948	I $G(HMPI D) D Q:'$ D(^TMP("HM PPX",$J)) ; If HMPI D only, se t one ^TMP ("HMPPX") entry
	9949	"RTN","HMP DJ0",179,0 )
	9950	. S HMPRD T=9999999
	9951	"RTN","HMP DJ0",180,0 )
	9952	. D RPC^D GPTFAPI(.H MPAPI,HMPI D)
	9953	"RTN","HMP DJ0",181,0 )
	9954	. S HMPX= $P($G(HMPA PI(1)),U,3 )
	9955	"RTN","HMP DJ0",182,0 )
	9956	. I $L(HM PX) S ^TMP ("HMPPX",$ J,HMPRDT,H MPID_";70; DXLS")=HMP X_U
	9957	"RTN","HMP DJ0",183,0 )
	9958	. F HMPAP I=1:1:9 S HMPX=$P($G (HMPY(2)), U,HMPAPI) I $L(HMPX) S ^TMP("H MPPX",$J,H MPRDT,HMPI D_";70;D S D"_HMPAPI) =HMPX_U_$G (DISDAT)
	9959	"RTN","HMP DJ0",184,0 )
	9960	;
	9961	"RTN","HMP DJ0",185,0 )
	9962	I '$G(HMP ID) D PTF^ HMPDJ09 ; If no HMP ID, set up ^TMP("HMP PX") for a ll dx
	9963	"RTN","HMP DJ0",186,0 )
	9964	;
	9965	"RTN","HMP DJ0",187,0 )
	9966	;Loop thr ough ^TMP( "HMPPX",$J ) and do P TF1^HMPDJ0 4A to set PTF array, ^TMP
	9967	"RTN","HMP DJ0",188,0 )
	9968	S HMPRDT= "" F S HM PRDT=$O(^T MP("HMPPX" ,$J,HMPRDT )) Q:HMPRD T="" D
	9969	"RTN","HMP DJ0",189,0 )
	9970	. S HMPLI D="" F S HMPLID=$O( ^TMP("HMPP X",$J,HMPR DT,HMPLID) ) Q:HMPLID =""!(HMPI' <HMPMAX) D
	9971	"RTN","HMP DJ0",190,0 )
	9972	.. D PTF1 ^HMPDJ04A
	9973	"RTN","HMP DJ0",191,0 )
	9974	K ^TMP("H MPPX",$J)
	9975	"RTN","HMP DJ0",192,0 )
	9976	Q
	9977	"RTN","HMP DJ0",193,0 )
	9978	;
	9979	"RTN","HMP DJ0",194,0 )
	9980	FACTOR D PX^HMPDJ0 9(9000010. 23) Q ; -- PCE Hea lth Factor s
	9981	"RTN","HMP DJ0",195,0 )
	9982	IMMUNIZA D PX^HMPDJ0 9(9000010. 11) Q ; -- PCE Imm unizations
	9983	"RTN","HMP DJ0",196,0 )
	9984	EXAM D PX^HMPDJ0 9(9000010. 13) Q ; -- PCE Exa ms
	9985	"RTN","HMP DJ0",197,0 )
	9986	CPT D PX^HMPDJ0 9(9000010. 18) Q ; -- PCE CPT
	9987	"RTN","HMP DJ0",198,0 )
	9988	EDUCATIO D PX^HMPDJ0 9(9000010. 16) Q ; -- PCE Pat ient Educa tion
	9989	"RTN","HMP DJ0",199,0 )
	9990	POV D PX^HMPDJ0 9(9000010. 07) Q ; -- PCE Pur pose of Vi sit (POV)
	9991	"RTN","HMP DJ0",200,0 )
	9992	SKIN D PX^HMPDJ0 9(9000010. 12) Q ; -- PCE Ski n Tests
	9993	"RTN","HMP DJ0",201,0 )
	9994	;
	9995	"RTN","HMP DJ0",202,0 )
	9996	IMAGE ; -- Radiology /Nuclear M edicine
	9997	"RTN","HMP DJ0",203,0 )
	9998	D EN1^RAO 7PC1(DFN,H MPSTART,HM PSTOP,HMPM AX_"P")
	9999	"RTN","HMP DJ0",204,0 )
	10000	I $G(HMPI D) D RA1^H MPDJ07(HMP ID) G IMQ
	10001	"RTN","HMP DJ0",205,0 )
	10002	N ID S ID =""
	10003	"RTN","HMP DJ0",206,0 )
	10004	F S ID=$ O(^TMP($J, "RAE1",DFN ,ID)) Q:ID ="" D RA1 ^HMPDJ07(I D) Q:HMPI '<+HMPMAX
	10005	"RTN","HMP DJ0",207,0 )
	10006	IMQ ; end
	10007	"RTN","HMP DJ0",208,0 )
	10008	K ^TMP($J ,"RAE1")
	10009	"RTN","HMP DJ0",209,0 )
	10010	Q
	10011	"RTN","HMP DJ0",210,0 )
	10012	;
	10013	"RTN","HMP DJ0",211,0 )
	10014	APPOINTM ; -- Schedu ling/Appoi ntment Mgt
	10015	"RTN","HMP DJ0",212,0 )
	10016	N HMPX,HM PNUM,HMPDT ,X,HMPA,ID
	10017	"RTN","HMP DJ0",213,0 )
	10018	S HMPX(1) =HMPSTART_ ";"_HMPSTO P,HMPX(4)= DFN,ID=$G( HMPID)
	10019	"RTN","HMP DJ0",214,0 )
	10020	S HMPX("F LDS")="1;2 ;3;6;9;10; 11;13",HMP X("SORT")= "P"
	10021	"RTN","HMP DJ0",215,0 )
	10022	I $L(ID) G:$E(ID)=" H" DGS^HMP DJ04 D Q
	10023	"RTN","HMP DJ0",216,0 )
	10024	. S HMPDT =$P(ID,";" ,2),HMPX(1 )=$P(ID,"; ",2)_";"_$ P(ID,";",2 )
	10025	"RTN","HMP DJ0",217,0 )
	10026	. S HMPX( 2)=$P(ID," ;",3)
	10027	"RTN","HMP DJ0",218,0 )
	10028	. S HMPNU M=$$SDAPI^ SDAMA301(. HMPX)
	10029	"RTN","HMP DJ0",219,0 )
	10030	. D:HMPNU M>0 SDAM1^ HMPDJ04
	10031	"RTN","HMP DJ0",220,0 )
	10032	. K ^TMP( $J,"SDAMA3 01",DFN)
	10033	"RTN","HMP DJ0",221,0 )
	10034	; appoint ments
	10035	"RTN","HMP DJ0",222,0 )
	10036	S HMPX(3) ="R;I;NS;N SR;NT" ;no cancelled appt's
	10037	"RTN","HMP DJ0",223,0 )
	10038	S HMPNUM= $$SDAPI^SD AMA301(.HM PX),HMPDT= 0
	10039	"RTN","HMP DJ0",224,0 )
	10040	F S HMPD T=$O(^TMP( $J,"SDAMA3 01",DFN,HM PDT)) Q:HM PDT<1 D Q:HMPI'<HM PMAX
	10041	"RTN","HMP DJ0",225,0 )
	10042	. S X=$P( $G(^TMP($J ,"SDAMA301 ",DFN,HMPD T)),U,3)
	10043	"RTN","HMP DJ0",226,0 )
	10044	. ;I HMPD T<DT,$P(X, ";")'["NS" Q ;no p rior kept appt's
	10045	"RTN","HMP DJ0",227,0 )
	10046	. D SDAM1 ^HMPDJ04
	10047	"RTN","HMP DJ0",228,0 )
	10048	K ^TMP($J ,"SDAMA301 ",DFN)
	10049	"RTN","HMP DJ0",229,0 )
	10050	Q
	10051	"RTN","HMP DJ0",230,0 )
	10052	;
	10053	"RTN","HMP DJ0",231,0 )
	10054	SURGERY ; -- Surgery
	10055	"RTN","HMP DJ0",232,0 )
	10056	I $G(HMPI D) D SR1^H MPDJ07(HMP ID) Q
	10057	"RTN","HMP DJ0",233,0 )
	10058	Q:'$L($T( LIST^SROES TV))
	10059	"RTN","HMP DJ0",234,0 )
	10060	N SHOWADD S SHOWADD =1 ;to omi t leading '+' with n ote titles
	10061	"RTN","HMP DJ0",235,0 )
	10062	N HMPN,HM PY,ID D LI ST^SROESTV (.HMPY,DFN ,HMPSTART, HMPSTOP,HM PMAX,1)
	10063	"RTN","HMP DJ0",236,0 )
	10064	S HMPN=0 F S HMPN= $O(@HMPY@( HMPN)) Q:H MPN<1 D
	10065	"RTN","HMP DJ0",237,0 )
	10066	. S ID=+$ G(@HMPY@(H MPN)) D:ID SR1^HMPDJ 07(ID)
	10067	"RTN","HMP DJ0",238,0 )
	10068	K @HMPY
	10069	"RTN","HMP DJ0",239,0 )
	10070	Q
	10071	"RTN","HMP DJ0",240,0 )
	10072	;
	10073	"RTN","HMP DJ0",241,0 )
	10074	DOCUMENT ; -- Text I ntegration Utilities
	10075	"RTN","HMP DJ0",242,0 )
	10076	N HMPC,CL S,HMPS,CTX T,HMPY,HMP N,HMPX,ID
	10077	"RTN","HMP DJ0",243,0 )
	10078	I $L($G(H MPID)) D T IU1^HMPDJ0 8(HMPID) Q
	10079	"RTN","HMP DJ0",244,0 )
	10080	N CLASS,S UBCLASS,ST ATUS
	10081	"RTN","HMP DJ0",245,0 )
	10082	D SETUP^H MPDJ08 ;de fine searc h criteria
	10083	"RTN","HMP DJ0",246,0 )
	10084	F HMPC=1: 1:$L(CLASS ,U) S CLS= $P(CLASS,U ,HMPC) D Q:HMPI'<HM PMAX
	10085	"RTN","HMP DJ0",247,0 )
	10086	. I CLS=" CP" D CP^H MPDJ08A(DF N,HMPSTART ,HMPSTOP,H MPMAX) Q
	10087	"RTN","HMP DJ0",248,0 )
	10088	. I CLS=" RA" D RA^H MPDJ08A(DF N,HMPSTART ,HMPSTOP,H MPMAX) Q
	10089	"RTN","HMP DJ0",249,0 )
	10090	. I CLS=" LR" D LR^H MPDJ08A(DF N,HMPSTART ,HMPSTOP,H MPMAX) Q
	10091	"RTN","HMP DJ0",250,0 )
	10092	. ; TIU d ocument cl asses, by sig status
	10093	"RTN","HMP DJ0",251,0 )
	10094	. F HMPS= 1:1:$L(STA TUS,U) S C TXT=$P(STA TUS,U,HMPS ) D Q:HMP I'<HMPMAX
	10095	"RTN","HMP DJ0",252,0 )
	10096	.. ;I $L( $G(HMPBATC H)) D GET^ TIUHMP(.HM PY,DFN,CLS ,HMPSTART, HMPSTOP) I 1 ; <<<< 12.3
	10097	"RTN","HMP DJ0",253,0 )
	10098	.. I $L($ G(HMPBATCH )) D GET^T IUVPR(.HMP Y,DFN,CLS, HMPSTART,H MPSTOP) I 1 ; <<<< 12.3
	10099	"RTN","HMP DJ0",254,0 )
	10100	.. E D C ONTEXT^TIU SRVLO(.HMP Y,CLS,CTXT ,DFN,HMPST ART,HMPSTO P,,HMPMAX, ,1)
	10101	"RTN","HMP DJ0",255,0 )
	10102	.. S HMPN =0 F S HM PN=$O(@HMP Y@(HMPN)) Q:HMPN<1 D Q:HMPI' <HMPMAX
	10103	"RTN","HMP DJ0",256,0 )
	10104	... S HMP X=$G(@HMPY @(HMPN)) ; Q:'$$MATCH ^HMPDJ08(H MPX,CTXT)
	10105	"RTN","HMP DJ0",257,0 )
	10106	... Q:$D( ^TMP("HMPD ",$J,+HMPX )) ;alrea dy include d
	10107	"RTN","HMP DJ0",258,0 )
	10108	... D EN1 ^HMPDJ08(H MPX,CLS)
	10109	"RTN","HMP DJ0",259,0 )
	10110	.. K @HMP Y
	10111	"RTN","HMP DJ0",260,0 )
	10112	Q
	10113	"RTN","HMP DJ0",261,0 )
	10114	;
	10115	"RTN","HMP DJ0",262,0 )
	10116	VISIT ; -- Visits
	10117	"RTN","HMP DJ0",263,0 )
	10118	I $L($G(H MPID)) D V SIT1^HMPDJ 04(HMPID) Q
	10119	"RTN","HMP DJ0",264,0 )
	10120	N BEG,END ,HMPADMIT, HMPDEMOG,H MPIDT,ID ;DE2818, a dded HMPDE MOG
	10121	"RTN","HMP DJ0",265,0 )
	10122	D TOP^HMP XGDPT("HMP DEMOG",DFN ,.105,"I") ;DE2818, (.105) CU RRENT ADMI SSION
	10123	"RTN","HMP DJ0",266,0 )
	10124	S HMPADMI T=+$G(HMPD EMOG(2,DFN ,.105,"I") ) ;DE2818
	10125	"RTN","HMP DJ0",267,0 )
	10126	S BEG=HMP START,END= HMPSTOP D IDT^HMPDVS IT ;invert dates
	10127	"RTN","HMP DJ0",268,0 )
	10128	;DE2818 * ICR 2028 needed fo r ^AUPNVSI T referenc es below *
	10129	"RTN","HMP DJ0",269,0 )
	10130	S HMPIDT= BEG F S H MPIDT=$O(^ AUPNVSIT(" AA",DFN,HM PIDT)) Q:H MPIDT<1!(H MPIDT>END) D Q:HMP I'<HMPMAX
	10131	"RTN","HMP DJ0",270,0 )
	10132	. S ID=0 F S ID=$O (^AUPNVSIT ("AA",DFN, HMPIDT,ID) ) Q:ID<1 D VSIT1^HM PDJ04(ID)
	10133	"RTN","HMP DJ0",271,0 )
	10134	; kill HM PADMIT in VSIT1 if a dm is incl uded, but add unless filtered
	10135	"RTN","HMP DJ0",272,0 )
	10136	I $G(HMPA DMIT),HMPM AX'<9999,H MPSTART'>1 410102 D V SIT1^HMPDJ 04("H"_HMP ADMIT)
	10137	"RTN","HMP DJ0",273,0 )
	10138	Q
	10139	"RTN","HMP DJ0",274,0 )
	10140	;I HMPSTO P,HMPSTOP' ["." S END =HMPSTOP_" .24" ;assu me end of day
	10141	"RTN","HMP DJ0",275,0 )
	10142	;S HMPDT= END F S H MPDT=$O(^A UPNVSIT("A ET",DFN,HM PDT),-1) Q:HMPDT<HM PSTART D Q:HMPI'<H MPMAX
	10143	"RTN","HMP DJ0",276,0 )
	10144	;. S HMPL OC=0 F S HMPLOC=$O( ^AUPNVSIT( "AET",DFN, HMPDT,HMPL OC)) Q:HMP LOC<1 D
	10145	"RTN","HMP DJ0",277,0 )
	10146	;.. S ID= 0 F S ID= $O(^AUPNVS IT("AET",D FN,HMPDT,H MPLOC,"P", ID)) Q:ID< 1 D VSIT1 ^HMPDJ04(I D)
	10147	"RTN","HMP DJ0",278,0 )
	10148	;
	10149	"RTN","HMP DJ0",279,0 )
	10150	HMP ; -- H MP Patient Objects
	10151	"RTN","HMP DJ0",280,0 )
	10152	D HMP^HMP DJ02($G(TY PE))
	10153	"RTN","HMP DJ0",281,0 )
	10154	Q
	10155	"RTN","HMP DJ0",282,0 )
	10156	;
	10157	"RTN","HMP DJ0",283,0 )
	10158	MH ; -- Me ntal Healt h
	10159	"RTN","HMP DJ0",284,0 )
	10160	I $L($T(M H^HMPDJ09M )) D MH^HM PDJ09M
	10161	"RTN","HMP DJ0",285,0 )
	10162	Q
	10163	"RTN","HMP DJ0",286,0 )
	10164	;
	10165	"RTN","HMP DJ0",287,0 )
	10166	ERRQ ; -- Quit for e rror handl ing
	10167	"RTN","HMP DJ0",288,0 )
	10168	Q
	10169	"RTN","HMP DJ0",289,0 )
	10170	;
	10171	"RTN","HMP DJ0",290,0 )
	10172	;new subr outine for DE2818
	10173	"RTN","HMP DJ0",291,0 )
	10174	ORDINFO(OR RSLT,ORIEN ) ; ORDER file (#100 ), ORRSLT passed by reference
	10175	"RTN","HMP DJ0",292,0 )
	10176	; all dat a returned in intern al format
	10177	"RTN","HMP DJ0",293,0 )
	10178	;
	10179	"RTN","HMP DJ0",294,0 )
	10180	; field s on ^OR(1 00,D0,0)
	10181	"RTN","HMP DJ0",295,0 )
	10182	;(#.01) O RDER #
	10183	"RTN","HMP DJ0",296,0 )
	10184	;(#.02) O BJECT OF O RDER
	10185	"RTN","HMP DJ0",297,0 )
	10186	;
	10187	"RTN","HMP DJ0",298,0 )
	10188	; field s on ^OR(1 00,D0,3)
	10189	"RTN","HMP DJ0",299,0 )
	10190	;(#5) STA TUS
	10191	"RTN","HMP DJ0",300,0 )
	10192	;(#7) ITE M ORDERED
	10193	"RTN","HMP DJ0",301,0 )
	10194	;(#8) VEI LED
	10195	"RTN","HMP DJ0",302,0 )
	10196	;(#8.1) T YPE
	10197	"RTN","HMP DJ0",303,0 )
	10198	;(#9) REP LACED ORDE R
	10199	"RTN","HMP DJ0",304,0 )
	10200	;(#9.1) R EPLACEMENT ORDER
	10201	"RTN","HMP DJ0",305,0 )
	10202	;(#30) CU RRENT ACTI ON
	10203	"RTN","HMP DJ0",306,0 )
	10204	;(#31) DA TE OF LAST ACTIVITY
	10205	"RTN","HMP DJ0",307,0 )
	10206	;(#32) GR ACE DAYS B EFORE PURG E
	10207	"RTN","HMP DJ0",308,0 )
	10208	;(#36) PA RENT
	10209	"RTN","HMP DJ0",309,0 )
	10210	;(#35) AL ERT ON RES ULTS
	10211	"RTN","HMP DJ0",310,0 )
	10212	;
	10213	"RTN","HMP DJ0",311,0 )
	10214	; field on ^OR(10 0,D0,4)
	10215	"RTN","HMP DJ0",312,0 )
	10216	;(#33) PA CKAGE REFE RENCE
	10217	"RTN","HMP DJ0",313,0 )
	10218	;
	10219	"RTN","HMP DJ0",314,0 )
	10220	Q:'($G(OR IEN)>0) ; IEN requi red
	10221	"RTN","HMP DJ0",315,0 )
	10222	D TOP^HMP XGORD("ORR SLT",ORIEN ,".01;.02; 5;7;8;8.1; 9;9.1;30;3 1;32;33;35 ;36","I")
	10223	"RTN","HMP DJ0",316,0 )
	10224	;
	10225	"RTN","HMP DJ0",317,0 )
	10226	Q
	10227	"RTN","HMP DJ0",318,0 )
	10228	;end DE28 18
	10229	"RTN","HMP DJ0",319,0 )
	10230	;
	10231	"RTN","HMP DJ00")
	10232	0^30^B1502 94972
	10233	"RTN","HMP DJ00",1,0)
	10234	HMPDJ00 ;S LC/MKB,ASM R/RRB - Pa tient demo graphics;8 /11/11 15 :29
	10235	"RTN","HMP DJ00",2,0)
	10236	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	10237	"RTN","HMP DJ00",3,0)
	10238	;Per VA D irective 6 402, this routine sh ould not b e modified .
	10239	"RTN","HMP DJ00",4,0)
	10240	;
	10241	"RTN","HMP DJ00",5,0)
	10242	; Externa l Referenc es DBIA#
	10243	"RTN","HMP DJ00",6,0)
	10244	; ------- ---------- -- -----
	10245	"RTN","HMP DJ00",7,0)
	10246	; ^AUPNVS IT 2028
	10247	"RTN","HMP DJ00",8,0)
	10248	; ^DPT 10035
	10249	"RTN","HMP DJ00",9,0)
	10250	; DGACT 2248
	10251	"RTN","HMP DJ00",10,0 )
	10252	; DGCV 4156
	10253	"RTN","HMP DJ00",11,0 )
	10254	; DGMSTAP I 2716
	10255	"RTN","HMP DJ00",12,0 )
	10256	; DGNTAPI 3457
	10257	"RTN","HMP DJ00",13,0 )
	10258	; DGPFAPI 3860
	10259	"RTN","HMP DJ00",14,0 )
	10260	; DGRPDB 4807
	10261	"RTN","HMP DJ00",15,0 )
	10262	; DIQ 2056
	10263	"RTN","HMP DJ00",16,0 )
	10264	; IBBAPI 4419
	10265	"RTN","HMP DJ00",17,0 )
	10266	; MPIF001 2701
	10267	"RTN","HMP DJ00",18,0 )
	10268	; SDUTL3 1252
	10269	"RTN","HMP DJ00",19,0 )
	10270	; VADPT 10061
	10271	"RTN","HMP DJ00",20,0 )
	10272	; VAFCTFU 1 2990
	10273	"RTN","HMP DJ00",21,0 )
	10274	; VASITE 10112
	10275	"RTN","HMP DJ00",22,0 )
	10276	; XUAF4 2171
	10277	"RTN","HMP DJ00",23,0 )
	10278	; SECURIT Y/SENSITIV E RECORD A CC 3027
	10279	"RTN","HMP DJ00",24,0 )
	10280	;
	10281	"RTN","HMP DJ00",25,0 )
	10282	; All tag s expect D FN
	10283	"RTN","HMP DJ00",26,0 )
	10284	; [HMPID, HMPSTART, HMPSTOP, HMPMAX, HM PTEXT not currently used here]
	10285	"RTN","HMP DJ00",27,0 )
	10286	Q
	10287	"RTN","HMP DJ00",28,0 )
	10288	;
	10289	"RTN","HMP DJ00",29,0 )
	10290	DPT1 ; -- Demographi cs
	10291	"RTN","HMP DJ00",30,0 )
	10292	N PAT D D PT1OD(.PAT )
	10293	"RTN","HMP DJ00",31,0 )
	10294	I $D(PAT) >9 D ADD^H MPDJ("PAT" )
	10295	"RTN","HMP DJ00",32,0 )
	10296	Q
	10297	"RTN","HMP DJ00",33,0 )
	10298	;
	10299	"RTN","HMP DJ00",34,0 )
	10300	DPT1OD(PAT ) ; -- Dem ographics (data arra y only)
	10301	"RTN","HMP DJ00",35,0 )
	10302	N SYS S S YS=$$SITE^ VASITE
	10303	"RTN","HMP DJ00",36,0 )
	10304	N $ES,$ET ,ERRPAT,ER RMSG
	10305	"RTN","HMP DJ00",37,0 )
	10306	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	10307	"RTN","HMP DJ00",38,0 )
	10308	S ERRMSG= "A problem occurred building t he patient "_DFN_" d emographic extract."
	10309	"RTN","HMP DJ00",39,0 )
	10310	D DEM,SVC ,PRF,ATC,S UPP,ALIAS, FAC,PC,INP T,INS
	10311	"RTN","HMP DJ00",40,0 )
	10312	D KVAR^VA DPT
	10313	"RTN","HMP DJ00",41,0 )
	10314	S PAT("st ampTime")= $S($G(HMPS TMP)]"":HM PSTMP,1:$$ EN^HMPSTMP ("NOW")) ; US6734
	10315	"RTN","HMP DJ00",42,0 )
	10316	S PAT("la stUpdateTi me")=PAT(" stampTime" )
	10317	"RTN","HMP DJ00",43,0 )
	10318	;US6734 - pre-compi le metasta mp
	10319	"RTN","HMP DJ00",44,0 )
	10320	I $G(HMPM ETA) D ADD ^HMPMETA(" patient",P AT("uid"), PAT("stamp Time")) Q: HMPMETA=1 ;US6734,U S11019
	10321	"RTN","HMP DJ00",45,0 )
	10322	Q
	10323	"RTN","HMP DJ00",46,0 )
	10324	;
	10325	"RTN","HMP DJ00",47,0 )
	10326	LKUP ; pat ient looku p data
	10327	"RTN","HMP DJ00",48,0 )
	10328	; expects HMPSYS,DF N
	10329	"RTN","HMP DJ00",49,0 )
	10330	N X,X0
	10331	"RTN","HMP DJ00",50,0 )
	10332	S X0=^DPT (DFN,0),X= $P(X0,U)
	10333	"RTN","HMP DJ00",51,0 )
	10334	S PAT("fu llName")=X
	10335	"RTN","HMP DJ00",52,0 )
	10336	S PAT("fa milyName") =$P(X,",")
	10337	"RTN","HMP DJ00",53,0 )
	10338	S PAT("gi venNames") =$P(X,",", 2,99)
	10339	"RTN","HMP DJ00",54,0 )
	10340	S X=$P(X0 ,U,2)
	10341	"RTN","HMP DJ00",55,0 )
	10342	S PAT("ge nderCode") ="urn:va:p at-gender: "_X
	10343	"RTN","HMP DJ00",56,0 )
	10344	S PAT("ge nderName") =$$NAME(X, "gender")
	10345	"RTN","HMP DJ00",57,0 )
	10346	S PAT("lo calId")=DF N
	10347	"RTN","HMP DJ00",58,0 )
	10348	S PAT("pi d")=HMPSYS _";"_DFN
	10349	"RTN","HMP DJ00",59,0 )
	10350	S PAT("ui d")=$$SETU ID^HMPUTIL S("pt-sele ct",DFN,DF N)
	10351	"RTN","HMP DJ00",60,0 )
	10352	S X=$$GET ICN^MPIF00 1(DFN)
	10353	"RTN","HMP DJ00",61,0 )
	10354	S:X>0 PAT ("icn")=X
	10355	"RTN","HMP DJ00",62,0 )
	10356	S PAT("ss n")=$P(X0, U,9)
	10357	"RTN","HMP DJ00",63,0 )
	10358	S PAT("bi rthDate")= $$JSONDT^H MPUTILS($P (X0,U,3))
	10359	"RTN","HMP DJ00",64,0 )
	10360	S X=$P($G (^DPT(DFN, .35)),U)
	10361	"RTN","HMP DJ00",65,0 )
	10362	S:X PAT(" deceased") =$$JSONDT^ HMPUTILS(X )
	10363	"RTN","HMP DJ00",66,0 )
	10364	D PTSEC^D GSEC4(.LST ,DFN) ; D BIA 3027 D E2818 - PB 30 Oct 20 15 changed to use a global ref erence cov ered by an active IC R
	10365	"RTN","HMP DJ00",67,0 )
	10366	S PAT("se nsitive")= $$BOOL(LST (1))
	10367	"RTN","HMP DJ00",68,0 )
	10368	;US6734 - pre-compi le metasta mp for OPD
	10369	"RTN","HMP DJ00",69,0 )
	10370	I $G(HMPM ETA),$P($G (HMPFADOM) ,"#")="pt- select" D ADD^HMPMET A("pt-sele ct",PAT("u id"),$G(HM PSTMP)) Q: HMPMETA=1 ;US6734,U S11019
	10371	"RTN","HMP DJ00",70,0 )
	10372	I $G(HMPS TMP)]"" S PAT("stamp Time")=HMP STMP ; US6 734 - set stamptime as time of subscript ion
	10373	"RTN","HMP DJ00",71,0 )
	10374	E S PAT( "stampTime ")=$$EN^HM PSTMP("NOW ") ; DE261 6 - must a dd stampTi me to rece ive OPD fr eshness up date from ADHOC^HMPU TIL1
	10375	"RTN","HMP DJ00",72,0 )
	10376	I $D(PAT) >9 D ADD^H MPDJ("PAT" )
	10377	"RTN","HMP DJ00",73,0 )
	10378	Q
	10379	"RTN","HMP DJ00",74,0 )
	10380	;
	10381	"RTN","HMP DJ00",75,0 )
	10382	DEM ;-demo graphic da ta
	10383	"RTN","HMP DJ00",76,0 )
	10384	N VADM,VA ,VAERR,X,I
	10385	"RTN","HMP DJ00",77,0 )
	10386	S PAT("pi d")=$$PID^ HMPDJFS(DF N)
	10387	"RTN","HMP DJ00",78,0 )
	10388	S X=$$GET ICN^MPIF00 1(DFN) S:X >1 PAT("ic n")=X
	10389	"RTN","HMP DJ00",79,0 )
	10390	D DEM^VAD PT S X=VAD M(1),PAT(" fullName") =X
	10391	"RTN","HMP DJ00",80,0 )
	10392	S PAT("fa milyName") =$P(X,",") ,PAT("give nNames")=$ P(X,",",2, 99)
	10393	"RTN","HMP DJ00",81,0 )
	10394	S PAT("ss n")=$P(VAD M(2),U),PA T("localId ")=DFN
	10395	"RTN","HMP DJ00",82,0 )
	10396	S PAT("ui d")=$$SETU ID^HMPUTIL S("patient ",DFN,DFN)
	10397	"RTN","HMP DJ00",83,0 )
	10398	S:$D(VA(" BID")) PAT ("briefId" )=$E(X)_VA ("BID")
	10399	"RTN","HMP DJ00",84,0 )
	10400	S X=+$P($ P(VADM(3), U),"."),PA T("birthDa te")=$$JSO NDT^HMPUTI LS(X)
	10401	"RTN","HMP DJ00",85,0 )
	10402	S X=$P(VA DM(5),U) S :X="" X="U NK"
	10403	"RTN","HMP DJ00",86,0 )
	10404	S PAT("ge nderCode") ="urn:va:p at-gender: "_X,PAT("g enderName" )=$$NAME(X ,"gender")
	10405	"RTN","HMP DJ00",87,0 )
	10406	S X=+$P($ P(VADM(6), U),".") S: X PAT("dec eased")=$$ JSONDT^HMP UTILS(X)
	10407	"RTN","HMP DJ00",88,0 )
	10408	D PTSEC^D GSEC4(.LST ,DFN) ; D BIA 3027 D E2818 - PB 30 Oct 20 15 changed to use a global ref erence cov ered by an active IC R
	10409	"RTN","HMP DJ00",89,0 )
	10410	S PAT("se nsitive")= $$BOOL(LST (1))
	10411	"RTN","HMP DJ00",90,0 )
	10412	S X=+VADM (9) S:X PA T("religio nCode")="u rn:va:pat- religion:" _X,PAT("re ligionName ")=$$NAME( X,"religio n")
	10413	"RTN","HMP DJ00",91,0 )
	10414	S X=$P(VA DM(10),U,2 ) I $L(X) D
	10415	"RTN","HMP DJ00",92,0 )
	10416	. S X=$E( X),X=$S(X= "S":"L",X= "N":"S",1: X)
	10417	"RTN","HMP DJ00",93,0 )
	10418	. S PAT(" maritalSta tusCode")= "urn:va:pa t-maritalS tatus:"_X
	10419	"RTN","HMP DJ00",94,0 )
	10420	. S PAT(" maritalSta tusName")= $$NAME(X," maritalSta tus")
	10421	"RTN","HMP DJ00",95,0 )
	10422	I VADM(11 ) S I=0 F S I=$O(VA DM(11,I)) Q:I<1 D
	10423	"RTN","HMP DJ00",96,0 )
	10424	. S X=+VA DM(11,I)
	10425	"RTN","HMP DJ00",97,0 )
	10426	. S PAT(" ethnicity" ,X,"code") =$$GET1^DI Q(2.06,X_" ,"_DFN_"," ,".01:3")
	10427	"RTN","HMP DJ00",98,0 )
	10428	I VADM(12 ) S I=0 F S I=$O(VA DM(12,I)) Q:I<1 D
	10429	"RTN","HMP DJ00",99,0 )
	10430	. S X=+VA DM(12,I)
	10431	"RTN","HMP DJ00",100, 0)
	10432	. S PAT(" race",X,"c ode")=$$GE T1^DIQ(2.0 2,X_","_DF N_",",".01 :3")
	10433	"RTN","HMP DJ00",101, 0)
	10434	Q
	10435	"RTN","HMP DJ00",102, 0)
	10436	;
	10437	"RTN","HMP DJ00",103, 0)
	10438	SVC ;-serv ice data
	10439	"RTN","HMP DJ00",104, 0)
	10440	N VAEL,VA SV,VAERR,X ,Y,I,P,AO, IR,PGF,HNC ,MST,CV,HM PSC
	10441	"RTN","HMP DJ00",105, 0)
	10442	D 7^VADPT
	10443	"RTN","HMP DJ00",106, 0)
	10444	S PAT("ve teran")=$$ BOOL(VAEL( 4))
	10445	"RTN","HMP DJ00",107, 0)
	10446	S PAT("se rviceConne cted")=$$B OOL(+VAEL( 3)) I VAEL (3) D
	10447	"RTN","HMP DJ00",108, 0)
	10448	. S PAT(" scPercent" )=+$P(VAEL (3),U,2)
	10449	"RTN","HMP DJ00",109, 0)
	10450	. D GETS^ DIQ(2,DFN_ ",",".3731 *",,"HMPSC ")
	10451	"RTN","HMP DJ00",110, 0)
	10452	. S I="" F S I=$O( HMPSC(2.05 ,I)) Q:I=" " D
	10453	"RTN","HMP DJ00",111, 0)
	10454	.. S PAT( "scConditi on",+I,"na me")=HMPSC (2.05,I,.0 1)
	10455	"RTN","HMP DJ00",112, 0)
	10456	.. S PAT( "scConditi on",+I,"sc Percent")= HMPSC(2.05 ,I,.02)
	10457	"RTN","HMP DJ00",113, 0)
	10458	S X=+$G(^ DPT(DFN,"L R")) S:X P AT("lrdfn" )=X
	10459	"RTN","HMP DJ00",114, 0)
	10460	I VAEL(9) ]"" S PAT( "meanStatu s")=$P(VAE L(9),U,2)
	10461	"RTN","HMP DJ00",115, 0)
	10462	;
	10463	"RTN","HMP DJ00",116, 0)
	10464	; exposur es
	10465	"RTN","HMP DJ00",117, 0)
	10466	S AO=VASV (2),IR=VAS V(3)
	10467	"RTN","HMP DJ00",118, 0)
	10468	S PGF=VAS V(11)!VASV (12)!VASV( 13) ;OIF/O EF
	10469	"RTN","HMP DJ00",119, 0)
	10470	S X=$$GET CUR^DGNTAP I(DFN,"HNC "),X=+($G( HNC("STAT" )))
	10471	"RTN","HMP DJ00",120, 0)
	10472	S HNC=$S( X=4:1,X=5: 1,X=1:0,X= 6:0,1:"")
	10473	"RTN","HMP DJ00",121, 0)
	10474	S X=$P($$ GETSTAT^DG MSTAPI(DFN ),U,2),MST =$S(X="Y": 1,X="N":0, 1:"")
	10475	"RTN","HMP DJ00",122, 0)
	10476	S X=$$CVE DT^DGCV(DF N),CV=$S(+ X<0:"",+X= 0:0,$P(X,U ,3):1,1:0)
	10477	"RTN","HMP DJ00",123, 0)
	10478	S X=AO_U_ IR_U_PGF_U _HNC_U_MST _U_CV
	10479	"RTN","HMP DJ00",124, 0)
	10480	F P=1:1:6 S I=$P(X, U,P),$P(X, U,P)=$S(I: "Yes",I=0: "No",1:"Un known")
	10481	"RTN","HMP DJ00",125, 0)
	10482	S NM="age nt-orange^ ionizing-r adiation^s w-asia^hea d-neck-can cer^mst^co mbat-vet"
	10483	"RTN","HMP DJ00",126, 0)
	10484	F P=1:1:6 S PAT("ex posure",P, "uid")="ur n:va:"_$P( NM,U,P)_": "_$E($P(X, U,P)),PAT( "exposure" ,P,"name") =$P(X,U,P)
	10485	"RTN","HMP DJ00",127, 0)
	10486	;
	10487	"RTN","HMP DJ00",128, 0)
	10488	; rated d isabilitie s [DGRPDB]
	10489	"RTN","HMP DJ00",129, 0)
	10490	N HMPDIS, DIS,NM,DX
	10491	"RTN","HMP DJ00",130, 0)
	10492	D RDIS^DG RPDB(DFN,. HMPDIS)
	10493	"RTN","HMP DJ00",131, 0)
	10494	S I=0 F S I=$O(HMP DIS(I)) Q: I<1 D
	10495	"RTN","HMP DJ00",132, 0)
	10496	. S DIS=H MPDIS(I)
	10497	"RTN","HMP DJ00",133, 0)
	10498	. S NM=$$ GET1^DIQ(3 1,+DIS_"," ,.01),DX=$ $GET1^DIQ( 31,+DIS_", ",2)
	10499	"RTN","HMP DJ00",134, 0)
	10500	. S PAT(" disability ",+DX,"nam e")=NM
	10501	"RTN","HMP DJ00",135, 0)
	10502	. S PAT(" disability ",+DX,"dis Percent")= $P(DIS,U,2 )
	10503	"RTN","HMP DJ00",136, 0)
	10504	. S PAT(" disability ",+DX,"ser viceConnec ted")=$$BO OL($P(DIS, U,3))
	10505	"RTN","HMP DJ00",137, 0)
	10506	Q
	10507	"RTN","HMP DJ00",138, 0)
	10508	;
	10509	"RTN","HMP DJ00",139, 0)
	10510	PRF ;-pati ent record flags
	10511	"RTN","HMP DJ00",140, 0)
	10512	N HMPF,I, N,X
	10513	"RTN","HMP DJ00",141, 0)
	10514	S X=$$GET ACT^DGPFAP I(DFN,"HMP F")
	10515	"RTN","HMP DJ00",142, 0)
	10516	S I=0 F S I=$O(HMP F(I)) Q:I< 1 D
	10517	"RTN","HMP DJ00",143, 0)
	10518	. S PAT(" patientRec ordFlag",I ,"assignme ntStatus") ="Active"
	10519	"RTN","HMP DJ00",144, 0)
	10520	. S PAT(" patientRec ordFlag",I ,"assignTS ")=$$JSOND T^HMPUTILS ($P($G(HMP F(I,"ASSIG NDT")),U))
	10521	"RTN","HMP DJ00",145, 0)
	10522	. S PAT(" patientRec ordFlag",I ,"approved ")=$P($G(H MPF(I,"APP RVBY")),U, 2)
	10523	"RTN","HMP DJ00",146, 0)
	10524	. S PAT(" patientRec ordFlag",I ,"nextRevi ewDT")=$$J SONDT^HMPU TILS($P($G (HMPF(I,"R EVIEWDT")) ,U))
	10525	"RTN","HMP DJ00",147, 0)
	10526	. S PAT(" patientRec ordFlag",I ,"name")=$ P($G(HMPF( I,"FLAG")) ,U,2)
	10527	"RTN","HMP DJ00",148, 0)
	10528	. S PAT(" patientRec ordFlag",I ,"type")=$ P($G(HMPF( I,"FLAGTYP E")),U,2)
	10529	"RTN","HMP DJ00",149, 0)
	10530	. S PAT(" patientRec ordFlag",I ,"category ")=$P($G(H MPF(I,"CAT EGORY")),U ,2)
	10531	"RTN","HMP DJ00",150, 0)
	10532	. S PAT(" patientRec ordFlag",I ,"ownerSit e")=$P($G( HMPF(I,"OW NER")),U,2 )
	10533	"RTN","HMP DJ00",151, 0)
	10534	. S PAT(" patientRec ordFlag",I ,"originat ingSite")= $P($G(HMPF (I,"ORIGSI TE")),U,2)
	10535	"RTN","HMP DJ00",152, 0)
	10536	. S N=1,X =$G(HMPF(I ,"NARR",1, 0))
	10537	"RTN","HMP DJ00",153, 0)
	10538	. F S N= $O(HMPF(I, "NARR",N)) Q:N<1 S X=X_$C(13, 10)_$G(HMP F(I,"NARR" ,N,0))
	10539	"RTN","HMP DJ00",154, 0)
	10540	. S PAT(" patientRec ordFlag",I ,"text")=X
	10541	"RTN","HMP DJ00",155, 0)
	10542	S X=$$CWA D^ORQPT2(D FN)
	10543	"RTN","HMP DJ00",156, 0)
	10544	I X]"" S PAT("cwadf ")=X
	10545	"RTN","HMP DJ00",157, 0)
	10546	I $D(PAT( "patientRe cordFlag") ) S PAT("c wadf")=$G( PAT("cwadf "))_"F"
	10547	"RTN","HMP DJ00",158, 0)
	10548	Q
	10549	"RTN","HMP DJ00",159, 0)
	10550	;
	10551	"RTN","HMP DJ00",160, 0)
	10552	ATC ;-addr ess & tele com
	10553	"RTN","HMP DJ00",161, 0)
	10554	N VAPA,CN T,X,I,P,NM
	10555	"RTN","HMP DJ00",162, 0)
	10556	; VAPA("P ")="" ;per manent add ress
	10557	"RTN","HMP DJ00",163, 0)
	10558	D ADD^VAD PT S CNT=0 I $$VAPA( 1,5) D
	10559	"RTN","HMP DJ00",164, 0)
	10560	. S CNT=C NT+1
	10561	"RTN","HMP DJ00",165, 0)
	10562	. D ADD(1 ,2,3,4,5,1 1,9,10)
	10563	"RTN","HMP DJ00",166, 0)
	10564	. S PAT(" address",C NT,"use")= $S($L(VAPA (9)):"TMP" ,1:"H")
	10565	"RTN","HMP DJ00",167, 0)
	10566	I VAPA(12 ) D ;con fidential address
	10567	"RTN","HMP DJ00",168, 0)
	10568	. S CNT=C NT+1
	10569	"RTN","HMP DJ00",169, 0)
	10570	. D ADD(1 3,14,15,16 ,17,18,20, 21)
	10571	"RTN","HMP DJ00",170, 0)
	10572	. S PAT(" address",C NT,"use")= "CONF"
	10573	"RTN","HMP DJ00",171, 0)
	10574	. S I=0 F S I=$O(V APA(22,I)) Q:I="" S X=VAPA(22 ,I) D
	10575	"RTN","HMP DJ00",172, 0)
	10576	.. S PAT( "address", CNT,"categ ory",I,"na me")=$P(X, U,2)
	10577	"RTN","HMP DJ00",173, 0)
	10578	.. S PAT( "address", CNT,"categ ory",I,"st atus")=$$B OOL($P(X,U ,3))
	10579	"RTN","HMP DJ00",174, 0)
	10580	;
	10581	"RTN","HMP DJ00",175, 0)
	10582	; X=home^ cell^work phones
	10583	"RTN","HMP DJ00",176, 0)
	10584	S X=$$FOR MAT(VAPA(8 ))_U_$$FOR MAT($$GET1 ^DIQ(2,DFN _",",.134) )_U_$$FORM AT($$GET1^ DIQ(2,DFN_ ",",.132))
	10585	"RTN","HMP DJ00",177, 0)
	10586	S NM="H^M C^WP" F P= 1:1:3 I $L ($P(X,U,P) ) D
	10587	"RTN","HMP DJ00",178, 0)
	10588	. S I=$P( NM,U,P),PA T("telecom ",P,"use") =I
	10589	"RTN","HMP DJ00",179, 0)
	10590	. S PAT(" telecom",P ,"value")= $P(X,U,P)
	10591	"RTN","HMP DJ00",180, 0)
	10592	S X=$P($G (^DPT(DFN, .13)),U,3) S:X'="" P AT("email" )=X
	10593	"RTN","HMP DJ00",181, 0)
	10594	I +$P($G( ^DPT(DFN,. 11)),U,16) >0 S PAT(" badAddress ")=$$GET1^ DIQ(2,DFN_ ",",.121)
	10595	"RTN","HMP DJ00",182, 0)
	10596	Q
	10597	"RTN","HMP DJ00",183, 0)
	10598	;
	10599	"RTN","HMP DJ00",184, 0)
	10600	ADD(LINE1, LINE2,LINE 3,CITY,STA TE,ZIP,STA RT,STOP) ; -- addres s set
	10601	"RTN","HMP DJ00",185, 0)
	10602	S:$L(VAPA (LINE1)) P AT("addres s",CNT,"li ne1")=VAPA (LINE1)
	10603	"RTN","HMP DJ00",186, 0)
	10604	S:$L(VAPA (LINE2)) P AT("addres s",CNT,"li ne2")=VAPA (LINE2)
	10605	"RTN","HMP DJ00",187, 0)
	10606	S:$L(VAPA (LINE3)) P AT("addres s",CNT,"li ne3")=VAPA (LINE3)
	10607	"RTN","HMP DJ00",188, 0)
	10608	S:$L(VAPA (CITY)) PA T("address ",CNT,"cit y")=VAPA(C ITY)
	10609	"RTN","HMP DJ00",189, 0)
	10610	S X=$P(VA PA(STATE), U) S:X PAT ("address" ,CNT,"stat e")=$$GET1 ^DIQ(5,+X_ ",",1)
	10611	"RTN","HMP DJ00",190, 0)
	10612	S X=$P(VA PA(ZIP),U, 2) S:$L(X) PAT("addr ess",CNT," zip")=X
	10613	"RTN","HMP DJ00",191, 0)
	10614	S X=+VAPA (START) S: X PAT("add ress",CNT, "start")=$ $JSONDT^HM PUTILS(X)
	10615	"RTN","HMP DJ00",192, 0)
	10616	S X=+VAPA (STOP) S:X PAT("addr ess",CNT," end")=$$JS ONDT^HMPUT ILS(X)
	10617	"RTN","HMP DJ00",193, 0)
	10618	Q
	10619	"RTN","HMP DJ00",194, 0)
	10620	;
	10621	"RTN","HMP DJ00",195, 0)
	10622	VAPA(BEG,E ND) ; -- V APA nodes have data?
	10623	"RTN","HMP DJ00",196, 0)
	10624	N I,Y S Y =0
	10625	"RTN","HMP DJ00",197, 0)
	10626	F I=BEG:1 :END I $L( $G(VAPA(I) )) S Y=1 Q
	10627	"RTN","HMP DJ00",198, 0)
	10628	Q Y
	10629	"RTN","HMP DJ00",199, 0)
	10630	;
	10631	"RTN","HMP DJ00",200, 0)
	10632	SUPP ;-sup port conta cts
	10633	"RTN","HMP DJ00",201, 0)
	10634	N VAOA,A, I,X,TYPE,S
	10635	"RTN","HMP DJ00",202, 0)
	10636	S S=0 F A ="",1 K VA OA D
	10637	"RTN","HMP DJ00",203, 0)
	10638	. S:A VAO A("A")=A D OAD^VADPT Q:'$L($G( VAOA(9)))
	10639	"RTN","HMP DJ00",204, 0)
	10640	. S S=S+1 ,TYPE=$S(A =1:"ECON^E mergency C ontact",1: "NOK^Next of Kin")
	10641	"RTN","HMP DJ00",205, 0)
	10642	. S PAT(" contact",S ,"typeCode ")="urn:va :pat-conta ct:"_$P(TY PE,U)
	10643	"RTN","HMP DJ00",206, 0)
	10644	. S PAT(" contact",S ,"typeName ")=$P(TYPE ,U,2)
	10645	"RTN","HMP DJ00",207, 0)
	10646	. S:$L(VA OA(9)) PAT ("contact" ,S,"name") =VAOA(9)
	10647	"RTN","HMP DJ00",208, 0)
	10648	. S:$L(VA OA(10)) PA T("contact ",S,"relat ionship")= VAOA(10)
	10649	"RTN","HMP DJ00",209, 0)
	10650	. S:$L(VA OA(1)) PAT ("contact" ,S,"addres s",1,"line 1")=VAOA(1 )
	10651	"RTN","HMP DJ00",210, 0)
	10652	. S:$L(VA OA(2)) PAT ("contact" ,S,"addres s",1,"line 2")=VAOA(2 )
	10653	"RTN","HMP DJ00",211, 0)
	10654	. S:$L(VA OA(3)) PAT ("contact" ,S,"addres s",1,"line 3")=VAOA(3 )
	10655	"RTN","HMP DJ00",212, 0)
	10656	. S:$L(VA OA(4)) PAT ("contact" ,S,"addres s",1,"city ")=VAOA(4)
	10657	"RTN","HMP DJ00",213, 0)
	10658	. S X=$P( VAOA(5),U) S:X PAT(" contact",S ,"address" ,1,"state" )=$$GET1^D IQ(5,+X_", ",1)
	10659	"RTN","HMP DJ00",214, 0)
	10660	. S X=$P( VAOA(11),U ,2) S:$L(X ) PAT("con tact",S,"a ddress",1, "zip")=X
	10661	"RTN","HMP DJ00",215, 0)
	10662	. S I=$S( A=1:.33011 ,1:.21011) ,X=$$FORMA T(VAOA(8)) _U_U_$$FOR MAT($$GET1 ^DIQ(2,DFN _",",I))
	10663	"RTN","HMP DJ00",216, 0)
	10664	. ; X=hom e^cell^wor k phones
	10665	"RTN","HMP DJ00",217, 0)
	10666	. S NM="H ^MC^WP" F P=1:1:3 I $L($P(X,U, P)) D
	10667	"RTN","HMP DJ00",218, 0)
	10668	.. S I=$P (NM,U,P),P AT("contac t",S,"tele com",P,"us e")=I
	10669	"RTN","HMP DJ00",219, 0)
	10670	.. S PAT( "contact", S,"telecom ",P,"value ")=$P(X,U, P)
	10671	"RTN","HMP DJ00",220, 0)
	10672	Q
	10673	"RTN","HMP DJ00",221, 0)
	10674	;
	10675	"RTN","HMP DJ00",222, 0)
	10676	ALIAS ;-ot her names used
	10677	"RTN","HMP DJ00",223, 0)
	10678	N I,X
	10679	"RTN","HMP DJ00",224, 0)
	10680	S I=0 F S I=$O(^DP T(DFN,.01, I)) Q:I<1 S X=$G(^( I,0)) D
	10681	"RTN","HMP DJ00",225, 0)
	10682	. S PAT(" alias",I," fullName") =$P(X,U)
	10683	"RTN","HMP DJ00",226, 0)
	10684	Q
	10685	"RTN","HMP DJ00",227, 0)
	10686	;
	10687	"RTN","HMP DJ00",228, 0)
	10688	FAC ;-trea ting facil ities [see FACLIST^O RWCIRN]
	10689	"RTN","HMP DJ00",229, 0)
	10690	N IFN S D FN=+$G(DFN ) Q:DFN<1
	10691	"RTN","HMP DJ00",230, 0)
	10692	N HMPY,HO ME,LAST,I, X,IEN,VASI TE
	10693	"RTN","HMP DJ00",231, 0)
	10694	S X=$$ALL ^VASITE ;V ASITE(stn# )=stn# for all local
	10695	"RTN","HMP DJ00",232, 0)
	10696	I $L($T(T FL^VAFCTFU 1)) D TFL^ VAFCTFU1(. HMPY,DFN)
	10697	"RTN","HMP DJ00",233, 0)
	10698	S HOME=+$ P($G(^DPT( DFN,"MPI") ),U,3) ;ho me facilit y
	10699	"RTN","HMP DJ00",234, 0)
	10700	I $P($G(H MPY(1)),U) <0 D ;not setup
	10701	"RTN","HMP DJ00",235, 0)
	10702	. S X=$O( ^AUPNVSIT( "AA",DFN,0 )),LAST=$S (X:9999999 -$P(X,".") ,1:"")
	10703	"RTN","HMP DJ00",236, 0)
	10704	. S X=$$S ITE^VASITE
	10705	"RTN","HMP DJ00",237, 0)
	10706	. S HMPY( 1)=$P(X,U, 3)_U_$P(X, U,2)_U_LAS T_U_$$GET1 ^DIQ(4,+X_ ",",60)
	10707	"RTN","HMP DJ00",238, 0)
	10708	S I=0 F S I=$O(HMP Y(I)) Q:I< 1 D
	10709	"RTN","HMP DJ00",239, 0)
	10710	. S X=HMP Y(I) Q:$P( X,U)="" ; unknown
	10711	"RTN","HMP DJ00",240, 0)
	10712	. S IEN=+ $$IEN^XUAF 4($P(X,U))
	10713	"RTN","HMP DJ00",241, 0)
	10714	. I +X=77 6!(+X=200) S $P(X,U, 2)="DEPT. OF DEFENSE "
	10715	"RTN","HMP DJ00",242, 0)
	10716	. S PAT(" facility", I,"code")= $P(X,U) ;stn#
	10717	"RTN","HMP DJ00",243, 0)
	10718	. S PAT(" facility", I,"name")= $P(X,U,2) ;name
	10719	"RTN","HMP DJ00",244, 0)
	10720	. S:IEN=H OME PAT("f acility",I ,"homeSite ")="true"
	10721	"RTN","HMP DJ00",245, 0)
	10722	. S:$L($P (X,U,3)) P AT("facili ty",I,"lat estDate")= $$JSONDT^H MPUTILS($P ($P(X,U,3) ,"."))
	10723	"RTN","HMP DJ00",246, 0)
	10724	. I $D(VA SITE(+X)) D
	10725	"RTN","HMP DJ00",247, 0)
	10726	.. S PAT( "facility" ,I,"localP atientId") =DFN
	10727	"RTN","HMP DJ00",248, 0)
	10728	.. S PAT( "facility" ,I,"system Id")=HMPSY S
	10729	"RTN","HMP DJ00",249, 0)
	10730	Q
	10731	"RTN","HMP DJ00",250, 0)
	10732	;
	10733	"RTN","HMP DJ00",251, 0)
	10734	PC ;-prima ry care as signments
	10735	"RTN","HMP DJ00",252, 0)
	10736	D GETPATT M^HMPCRPC1 (.PAT,DFN)
	10737	"RTN","HMP DJ00",253, 0)
	10738	Q
	10739	"RTN","HMP DJ00",254, 0)
	10740	N X S X=$ $OUTPTPR^S DUTL3(DFN) I X D
	10741	"RTN","HMP DJ00",255, 0)
	10742	. S PAT(" pcProvider Uid")=$$SE TUID^HMPUT ILS("user" ,,+X)
	10743	"RTN","HMP DJ00",256, 0)
	10744	. S PAT(" pcProvider Name")=$P( X,U,2)
	10745	"RTN","HMP DJ00",257, 0)
	10746	S X=$$OUT PTTM^SDUTL 3(DFN) I X D
	10747	"RTN","HMP DJ00",258, 0)
	10748	. S PAT(" pcTeamUid" )=$$SETUID ^HMPUTILS( "team",,+X )
	10749	"RTN","HMP DJ00",259, 0)
	10750	. S PAT(" pcTeamName ")=$P(X,U, 2)
	10751	"RTN","HMP DJ00",260, 0)
	10752	Q
	10753	"RTN","HMP DJ00",261, 0)
	10754	;
	10755	"RTN","HMP DJ00",262, 0)
	10756	INPT ;-inp atient inf ormation
	10757	"RTN","HMP DJ00",263, 0)
	10758	N ADM,X,Y ,Z,I,HL,TS
	10759	"RTN","HMP DJ00",264, 0)
	10760	S ADM=+$G (^DPT(DFN, .105)) Q:A DM<1 ;cur rent admis sion mvt
	10761	"RTN","HMP DJ00",265, 0)
	10762	S PAT("ad missionUid ")=$$SETUI D^HMPUTILS ("visit",D FN,"H"_ADM )
	10763	"RTN","HMP DJ00",266, 0)
	10764	S X=$P($G (^DPT(DFN, .101)),U) S:X]"" PAT ("roomBed" )=X
	10765	"RTN","HMP DJ00",267, 0)
	10766	S X=$P($G (^DPT(DFN, .1)),U) I X]"" D
	10767	"RTN","HMP DJ00",268, 0)
	10768	. S PAT(" inpatientL ocation")= X
	10769	"RTN","HMP DJ00",269, 0)
	10770	. S I=+$O (^DIC(42," B",X,0)),H L=+$G(^DIC (42,I,44)) Q:HL<1
	10771	"RTN","HMP DJ00",270, 0)
	10772	. S X=$P( $G(^SC(HL, 0)),U,2) S :X]"" PAT( "shortInpa tientLocat ion")=X
	10773	"RTN","HMP DJ00",271, 0)
	10774	;
	10775	"RTN","HMP DJ00",272, 0)
	10776	S TS=$G(^ DPT(DFN,.1 03)) I TS D ;treati ng special ty
	10777	"RTN","HMP DJ00",273, 0)
	10778	. S X=$$T SDATA^DGAC T(45.7,+TS ,.Y) Q:X<1
	10779	"RTN","HMP DJ00",274, 0)
	10780	. S PAT(" specialty" )=$G(Y(1)) ,X=""
	10781	"RTN","HMP DJ00",275, 0)
	10782	. I +$G(Y (2))>0 S X =$$TSDATA^ DGACT(42.4 ,+Y(2),.Z)
	10783	"RTN","HMP DJ00",276, 0)
	10784	. I X>0,$ G(Z(3))]"" S PAT("sp ecialtySer vice")=$P( Z(3),U)
	10785	"RTN","HMP DJ00",277, 0)
	10786	Q
	10787	"RTN","HMP DJ00",278, 0)
	10788	;
	10789	"RTN","HMP DJ00",279, 0)
	10790	INS ;-insu rance info rmation
	10791	"RTN","HMP DJ00",280, 0)
	10792	N X,I,HMP X,HMPINS
	10793	"RTN","HMP DJ00",281, 0)
	10794	S X=$$INS UR^IBBAPI( DFN,,,.HMP X,"*") Q:X <1
	10795	"RTN","HMP DJ00",282, 0)
	10796	S I=0 F S I=$O(HMP X("IBBAPI" ,"INSUR",I )) Q:I<1 D
	10797	"RTN","HMP DJ00",283, 0)
	10798	. K HMPIN S M HMPINS =HMPX("IBB API","INSU R",I)
	10799	"RTN","HMP DJ00",284, 0)
	10800	. S PAT(" insurance" ,I,"id")=D FN_";"_+$G (HMPINS(1) )_";"_+$G( HMPINS(8))
	10801	"RTN","HMP DJ00",285, 0)
	10802	. ; = DFN ;COMPANY;P OLICY
	10803	"RTN","HMP DJ00",286, 0)
	10804	. S PAT(" insurance" ,I,"compan yName")=$P (HMPINS(1) ,U,2)
	10805	"RTN","HMP DJ00",287, 0)
	10806	. ;DE942 - Convert effective and expira tion dates to JSON f ormat - TW
	10807	"RTN","HMP DJ00",288, 0)
	10808	. S:$G(HM PINS(10))] "" PAT("in surance",I ,"effectiv eDate")=$$ JSONDT^HMP UTILS(HMPI NS(10))
	10809	"RTN","HMP DJ00",289, 0)
	10810	. S:$G(HM PINS(11))] "" PAT("in surance",I ,"expirati onDate")=$ $JSONDT^HM PUTILS(HMP INS(11))
	10811	"RTN","HMP DJ00",290, 0)
	10812	. S:$G(HM PINS(18))] "" PAT("in surance",I ,"groupNum ber")=HMPI NS(18)
	10813	"RTN","HMP DJ00",291, 0)
	10814	. S:$G(HM PINS(21))] "" PAT("in surance",I ,"policyTy pe")=$P(HM PINS(21),U ,2)
	10815	"RTN","HMP DJ00",292, 0)
	10816	. S X=$P( $G(HMPINS( 12)),U,2) S:X="PATIE NT" X="SEL F"
	10817	"RTN","HMP DJ00",293, 0)
	10818	. S:X]"" PAT("insur ance",I,"p olicyHolde r")=X
	10819	"RTN","HMP DJ00",294, 0)
	10820	Q
	10821	"RTN","HMP DJ00",295, 0)
	10822	;
	10823	"RTN","HMP DJ00",296, 0)
	10824	FORMAT(X) ; -- enfor ce (xxx)xx x-xxxx pho ne format
	10825	"RTN","HMP DJ00",297, 0)
	10826	S X=$G(X) I X?1"("3 N1")"3N1"- "4N.E Q X
	10827	"RTN","HMP DJ00",298, 0)
	10828	N P,N,I,Y S P=""
	10829	"RTN","HMP DJ00",299, 0)
	10830	F I=1:1:$ L(X) S N=$ E(X,I) I N =+N S P=P_ N
	10831	"RTN","HMP DJ00",300, 0)
	10832	S:$L(P)<1 0 P=$E("00 00000000", 1,10-$L(P) )_P
	10833	"RTN","HMP DJ00",301, 0)
	10834	S Y=$S(P: "("_$E(P,1 ,3)_")"_$E (P,4,6)_"- "_$E(P,7,1 0),1:"")
	10835	"RTN","HMP DJ00",302, 0)
	10836	Q Y
	10837	"RTN","HMP DJ00",303, 0)
	10838	;
	10839	"RTN","HMP DJ00",304, 0)
	10840	NAME(CODE, SET) ; -- Return exp anded name for code set
	10841	"RTN","HMP DJ00",305, 0)
	10842	N Y S Y=" ",CODE=$G( CODE)
	10843	"RTN","HMP DJ00",306, 0)
	10844	I $G(SET) ="gender" S Y=$S(COD E="F":"Fem ale",CODE= "M":"Male" ,1:"Unknow n")
	10845	"RTN","HMP DJ00",307, 0)
	10846	I $G(SET) ="maritalS tatus" S Y =$S(CODE=" D":"Divorc ed",CODE=" M":"Marrie d",CODE="W ":"Widowed ",CODE="L" :"Legally Separated" ,CODE="S": "Never Mar ried",1:"U nknown")
	10847	"RTN","HMP DJ00",308, 0)
	10848	I $G(SET) ="religion " S Y=$$GE T1^DIQ(13, CODE_",",. 01)
	10849	"RTN","HMP DJ00",309, 0)
	10850	Q Y
	10851	"RTN","HMP DJ00",310, 0)
	10852	;
	10853	"RTN","HMP DJ00",311, 0)
	10854	BOOL(X) ;
	10855	"RTN","HMP DJ00",312, 0)
	10856	I X>0 Q " true"
	10857	"RTN","HMP DJ00",313, 0)
	10858	S X=$E(X) I X="Y"!( X="y") Q " true"
	10859	"RTN","HMP DJ00",314, 0)
	10860	Q "false"
	10861	"RTN","HMP DJ00A")
	10862	1^161
	10863	"RTN","HMP DJ01")
	10864	0^33^B4980 6712
	10865	"RTN","HMP DJ01",1,0)
	10866	HMPDJ01 ;S LC/MKB,ASM R/RRB - Or ders;Nov 1 2, 2015 14 :33:52
	10867	"RTN","HMP DJ01",2,0)
	10868	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	10869	"RTN","HMP DJ01",3,0)
	10870	;Per VA D irective 6 402, this routine sh ould not b e modified .
	10871	"RTN","HMP DJ01",4,0)
	10872	;
	10873	"RTN","HMP DJ01",5,0)
	10874	; Externa l Referenc es ICR
	10875	"RTN","HMP DJ01",6,0)
	10876	; ------- ---------- -- -----
	10877	"RTN","HMP DJ01",7,0)
	10878	; ^OR(100 5771
	10879	"RTN","HMP DJ01",8,0)
	10880	; ^ORA(10 2.4 5769
	10881	"RTN","HMP DJ01",9,0)
	10882	; ^ORD(10 0.98 873
	10883	"RTN","HMP DJ01",10,0 )
	10884	; ^PXRMIN DX 4290
	10885	"RTN","HMP DJ01",11,0 )
	10886	; ^RADPT 2480
	10887	"RTN","HMP DJ01",12,0 )
	10888	; ^SC 10040
	10889	"RTN","HMP DJ01",13,0 )
	10890	; ^VA(200 10060
	10891	"RTN","HMP DJ01",14,0 )
	10892	; DIC 2051
	10893	"RTN","HMP DJ01",15,0 )
	10894	; DIQ 2056
	10895	"RTN","HMP DJ01",16,0 )
	10896	; GMRCGUI B 2980
	10897	"RTN","HMP DJ01",17,0 )
	10898	; LR7OU1 2955
	10899	"RTN","HMP DJ01",18,0 )
	10900	; ORQ1,^T MP("ORR" 3154
	10901	"RTN","HMP DJ01",19,0 )
	10902	; ORQ12,^ TMP("ORR" 5704
	10903	"RTN","HMP DJ01",20,0 )
	10904	; ORX8 2467
	10905	"RTN","HMP DJ01",21,0 )
	10906	; PSS51P1 4546
	10907	"RTN","HMP DJ01",22,0 )
	10908	;
	10909	"RTN","HMP DJ01",23,0 )
	10910	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	10911	"RTN","HMP DJ01",24,0 )
	10912	Q
	10913	"RTN","HMP DJ01",25,0 )
	10914	;
	10915	"RTN","HMP DJ01",26,0 )
	10916	OR1(ID) ; -- order I D >> ^TMP( "ORR",$J,O RLIST,HMPN )
	10917	"RTN","HMP DJ01",27,0 )
	10918	N ORDER,C HILD,HMPC
	10919	"RTN","HMP DJ01",28,0 )
	10920	D ORX(ID, .ORDER)
	10921	"RTN","HMP DJ01",29,0 )
	10922	;DE2818, ^OR(100) - ICR 5771
	10923	"RTN","HMP DJ01",30,0 )
	10924	S HMPC=0 F S HMPC= $O(^OR(100 ,ID,2,HMPC )) Q:HMPC< 1 D
	10925	"RTN","HMP DJ01",31,0 )
	10926	. K CHILD D ORX(HMP C,.CHILD)
	10927	"RTN","HMP DJ01",32,0 )
	10928	. M ORDER ("children ",HMPC)=CH ILD
	10929	"RTN","HMP DJ01",33,0 )
	10930	S ORDER(" lastUpdate Time")=$$E N^HMPSTMP( "order") ; RHL 201412 31
	10931	"RTN","HMP DJ01",34,0 )
	10932	S ORDER(" stampTime" )=ORDER("l astUpdateT ime") ; RH L 20141231
	10933	"RTN","HMP DJ01",35,0 )
	10934	;US6734 - pre-compi le metasta mp
	10935	"RTN","HMP DJ01",36,0 )
	10936	I $G(HMPM ETA) D ADD ^HMPMETA(" order",ORD ER("uid"), ORDER("sta mpTime")) Q:HMPMETA= 1 ;US6734 ,US11019
	10937	"RTN","HMP DJ01",37,0 )
	10938	D ADD^HMP DJ("ORDER" ,"order")
	10939	"RTN","HMP DJ01",38,0 )
	10940	Q
	10941	"RTN","HMP DJ01",39,0 )
	10942	ORX(IFN,OR D) ; -- ex tract orde r IFN into ORD("attr ibute")
	10943	"RTN","HMP DJ01",40,0 )
	10944	N ORLIST, ORLST,X0,X 8,LOC,X,I, DA
	10945	"RTN","HMP DJ01",41,0 )
	10946	S ORLST=$ S(+$G(HMPN ):HMPN-1,1 :0) S:'$D( ORLIST) OR LIST=$H
	10947	"RTN","HMP DJ01",42,0 )
	10948	D GET^ORQ 12(IFN,ORL IST,1)
	10949	"RTN","HMP DJ01",43,0 )
	10950	S X0=$G(^ TMP("ORR", $J,ORLIST, ORLST))
	10951	"RTN","HMP DJ01",44,0 )
	10952	N $ES,$ET ,ERRPAT,ER RMSG
	10953	"RTN","HMP DJ01",45,0 )
	10954	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	10955	"RTN","HMP DJ01",46,0 )
	10956	S ERRMSG= "A problem occurred converting record "_ IFN_" for the orders domain"
	10957	"RTN","HMP DJ01",47,0 )
	10958	;
	10959	"RTN","HMP DJ01",48,0 )
	10960	S ORD("lo calId")=IF N,ORD("uid ")=$$SETUI D^HMPUTILS ("order",D FN,IFN)
	10961	"RTN","HMP DJ01",49,0 )
	10962	S X=$$OI^ ORX8(+X0) I $L(X) D
	10963	"RTN","HMP DJ01",50,0 )
	10964	. N ARRAY ,NAME
	10965	"RTN","HMP DJ01",51,0 )
	10966	. S ARRAY ("Code")=1 _U_"oi",AR RAY("Name" )=2,ARRAY( "PackageRe f")=3
	10967	"RTN","HMP DJ01",52,0 )
	10968	. D SPLIT VAL^HMPUTI LS(X,.ARRA Y) S ORD(" name")=ARR AY("Name")
	10969	"RTN","HMP DJ01",53,0 )
	10970	. S NAME= "" F S NA ME=$O(ARRA Y(NAME)) Q :NAME="" S ORD("oi" _NAME)=$G( ARRAY(NAME ))
	10971	"RTN","HMP DJ01",54,0 )
	10972	S ORD("di splayGroup ")=$P(X0,U ,2)
	10973	"RTN","HMP DJ01",55,0 )
	10974	S ORD("en tered")=$$ JSONDT^HMP UTILS($P(X 0,U,3))
	10975	"RTN","HMP DJ01",56,0 )
	10976	S ORD("st art")=$$TM ($P(X0,U,4 )),ORD("st op")=$$TM( $P(X0,U,5) )
	10977	"RTN","HMP DJ01",57,0 )
	10978	S ORD("st atusCode") ="urn:va:o rder-statu s:"_$P(X0, U,7)
	10979	"RTN","HMP DJ01",58,0 )
	10980	S ORD("st atusName") =$P(X0,U,6 )
	10981	"RTN","HMP DJ01",59,0 )
	10982	S ORD("st atusVuid") ="urn:va:v uid:"_$$ST S^HMPDOR($ P(X0,U,7))
	10983	"RTN","HMP DJ01",60,0 )
	10984	D SETTEXT ^HMPUTILS( $NA(^TMP(" ORR",$J,OR LIST,ORLST ,"TX")),$N A(^TMP("HM PTEXT",$J, IFN)))
	10985	"RTN","HMP DJ01",61,0 )
	10986	M ORD("co ntent","\" )=^TMP("HM PTEXT",$J, IFN)
	10987	"RTN","HMP DJ01",62,0 )
	10988	S X=$$GET 1^DIQ(100, IFN_",",1, "I") I X D
	10989	"RTN","HMP DJ01",63,0 )
	10990	. S ORD(" providerUi d")=$$SETU ID^HMPUTIL S("user",, +X)
	10991	"RTN","HMP DJ01",64,0 )
	10992	. S ORD(" providerNa me")=$$GET 1^DIQ(200, X_",",.01) ;DE2818, ICR 10060
	10993	"RTN","HMP DJ01",65,0 )
	10994	S LOC=+$$ GET1^DIQ(1 00,IFN_"," ,6,"I"),FA C=$$FAC^HM PD(LOC) I LOC D
	10995	"RTN","HMP DJ01",66,0 )
	10996	. S ORD(" locationNa me")=$$GET 1^DIQ(44,L OC_",",.01 ) ;DE2818 , ICR 1004 0
	10997	"RTN","HMP DJ01",67,0 )
	10998	. S ORD(" locationUi d")=$$SETU ID^HMPUTIL S("locatio n",,LOC)
	10999	"RTN","HMP DJ01",68,0 )
	11000	D FACILIT Y^HMPUTILS (FAC,"ORD" )
	11001	"RTN","HMP DJ01",69,0 )
	11002	S ORD("se rvice")=$$ GET1^DIQ(1 00,IFN_"," ,"12:1")
	11003	"RTN","HMP DJ01",70,0 )
	11004	S X=$$GET 1^DIQ(100, IFN_",",9, "I") S:X O RD("predec essor")=$$ SETUID^HMP UTILS("ord er",DFN,+X )
	11005	"RTN","HMP DJ01",71,0 )
	11006	S X=$$GET 1^DIQ(100, IFN_",",9. 1,"I") S:X ORD("succ essor")=$$ SETUID^HMP UTILS("ord er",DFN,+X )
	11007	"RTN","HMP DJ01",72,0 )
	11008	D RESULTS
	11009	"RTN","HMP DJ01",73,0 )
	11010	;DE2818, ICR 5771 f or ^OR(100 )
	11011	"RTN","HMP DJ01",74,0 )
	11012	; sign/ve rify
	11013	"RTN","HMP DJ01",75,0 )
	11014	S X8=$G(^ OR(100,IFN ,8,1,0)),I =0 I $P(X8 ,U,6) D ;(#6) DATE/TIME SIGNED
	11015	"RTN","HMP DJ01",76,0 )
	11016	. N PROV S PROV=$P( X8,U,5) S: PROV<1 PRO V=$P(X8,U, 3) ;(#5) SIGNED BY or (#3) PR OVIDER, if on chart,
	11017	"RTN","HMP DJ01",77,0 )
	11018	. D USER( .I,"S",PRO V,$P(X8,U, 6)) ; us e provider
	11019	"RTN","HMP DJ01",78,0 )
	11020	I $P(X8,U ,9) D USE R(.I,"N",$ P(X8,U,8), $P(X8,U,9) ) ;(#8) VERIFYING NURSE, (#9 ) DATE/TIM E NURSE VE RIFIED
	11021	"RTN","HMP DJ01",79,0 )
	11022	I $P(X8,U ,11) D USE R(.I,"C",$ P(X8,U,10) ,$P(X8,U,1 1)) ;(#10) VERIFYING CLERK ,(# 11) DATE/T IME CLERK VERIFIED
	11023	"RTN","HMP DJ01",80,0 )
	11024	I $P(X8,U ,19) D USE R(.I,"R",$ P(X8,U,18) ,$P(X8,U,1 9)) ;(#18) CHART REV IEWED BY, (#19) DATE /TIME CHAR T REVIEWED
	11025	"RTN","HMP DJ01",81,0 )
	11026	Q
	11027	"RTN","HMP DJ01",82,0 )
	11028	; acknowl edgements, DE2818,^O RA(102.4) - ICR 5769
	11029	"RTN","HMP DJ01",83,0 )
	11030	S DA=0 F S DA=$O(^ ORA(102.4, "B",+IFN,D A)) Q:DA<1 D
	11031	"RTN","HMP DJ01",84,0 )
	11032	. S X0=$G (^ORA(102. 4,DA,0)) Q :'$P(X0,U, 3) ;stub - not ack' d
	11033	"RTN","HMP DJ01",85,0 )
	11034	. S X=+$P (X0,U,2),X =$S(X:X_U_ $$GET1^DIQ (200,X_"," ,.01),1:U) ;DE2818, ICR 10060
	11035	"RTN","HMP DJ01",86,0 )
	11036	. S ORD(" acknowledg ement",DA) =X_U_$P(X0 ,U,3)
	11037	"RTN","HMP DJ01",87,0 )
	11038	Q
	11039	"RTN","HMP DJ01",88,0 )
	11040	;
	11041	"RTN","HMP DJ01",89,0 )
	11042	RESULTS ; -- add ORD ("results" ,n,"uid") list
	11043	"RTN","HMP DJ01",90,0 )
	11044	N ORPK,OR PKG,ORDG
	11045	"RTN","HMP DJ01",91,0 )
	11046	;DE2818, ^OR(100) - ICR 5771
	11047	"RTN","HMP DJ01",92,0 )
	11048	S ORPK=$G (^OR(100,I FN,4)),ORP KG=ORD("se rvice"),OR DG=ORD("di splayGroup ")
	11049	"RTN","HMP DJ01",93,0 )
	11050	I ORPKG=" GMRC" D Q
	11051	"RTN","HMP DJ01",94,0 )
	11052	. N HMPD, I,N,X D DO CLIST^GMRC GUIB(.HMPD ,+ORPK)
	11053	"RTN","HMP DJ01",95,0 )
	11054	. S N=1,O RD("result s",N,"uid" )=$$SETUID ^HMPUTILS( "consult", DFN,+ORPK)
	11055	"RTN","HMP DJ01",96,0 )
	11056	. S I=0 F S I=$O(H MPD(50,I)) Q:I<1 S X=$G(HMPD( 50,I)) D
	11057	"RTN","HMP DJ01",97,0 )
	11058	.. Q:'$D( @(U_$P(X," ;",2)_+X_" )")) ;tex t deleted
	11059	"RTN","HMP DJ01",98,0 )
	11060	.. S N=N+ 1,ORD("res ults",N,"u id")=$$SET UID^HMPUTI LS("docume nt",DFN,+X )
	11061	"RTN","HMP DJ01",99,0 )
	11062	. Q:ORDG' ="PROC"
	11063	"RTN","HMP DJ01",100, 0)
	11064	. N HMPC D FIND^DIC (702,,"@", "Q",+ORPK, ,"ACON",,, "HMPC") ;C P
	11065	"RTN","HMP DJ01",101, 0)
	11066	. S I=0 F S I=$O(H MPC("DILIS T",2,I)) Q :I<1 D
	11067	"RTN","HMP DJ01",102, 0)
	11068	.. S X=+$ G(HMPC("DI LIST",2,I) )_";MDD(70 2,"
	11069	"RTN","HMP DJ01",103, 0)
	11070	.. S N=N+ 1,ORD("res ults",N,"u id")=$$SET UID^HMPUTI LS("proced ure",DFN,X )
	11071	"RTN","HMP DJ01",104, 0)
	11072	I ORPKG=" LR" D Q
	11073	"RTN","HMP DJ01",105, 0)
	11074	. Q:$L(OR PK,";")'>3 ;no resu lts yet, o r parent o rder
	11075	"RTN","HMP DJ01",106, 0)
	11076	. N SUB,I DT,CDT,ITM ,HMPT,ID,T ,N,LRDFN,I DX
	11077	"RTN","HMP DJ01",107, 0)
	11078	. S SUB=$ P(ORPK,";" ,4),IDT=$P (ORPK,";", 5),CDT=999 9999-IDT
	11079	"RTN","HMP DJ01",108, 0)
	11080	. I SUB=" CH" D Q
	11081	"RTN","HMP DJ01",109, 0)
	11082	.. S ITM= +$G(ORD("o iPackageRe f")) D EXP AND^LR7OU1 (ITM,.HMPT )
	11083	"RTN","HMP DJ01",110, 0)
	11084	.. S (T,N )=0 F S T =$O(HMPT(T )) Q:T<1 S ID=$O(^P XRMINDX(63 ,"PI",DFN, T,CDT,"")) I $L(ID) S N=N+1,OR D("results ",N,"uid") =$$SETUID^ HMPUTILS(" lab",DFN,$ P(ID,";",2 ,9))
	11085	"RTN","HMP DJ01",111, 0)
	11086	. I SUB=" MI" D Q
	11087	"RTN","HMP DJ01",112, 0)
	11088	.. S ITM= "M;A;",N=0 ,LRDFN=$$L RDFN^HMPXG LAB(DFN) ;DE2818
	11089	"RTN","HMP DJ01",113, 0)
	11090	.. F S I TM=$O(^PXR MINDX(63," PI",DFN,IT M)) Q:$E(I TM,1,4)'=" M;A;" I $ D(^(ITM,CD T)) D
	11091	"RTN","HMP DJ01",114, 0)
	11092	... S IDX =LRDFN_";M I;"_IDT
	11093	"RTN","HMP DJ01",115, 0)
	11094	... F S IDX=$O(^PX RMINDX(63, "PI",DFN,I TM,CDT,IDX )) Q:IDX=" " S ID=$P (IDX,";",2 ,99),N=N+1 ,ORD("resu lts",N,"ui d")=$$SETU ID^HMPUTIL S("lab",DF N,ID)
	11095	"RTN","HMP DJ01",116, 0)
	11096	.. S N=N+ 1,ORD("res ults",N,"u id")=$$SET UID^HMPUTI LS("docume nt",DFN,SU B_";"_IDT)
	11097	"RTN","HMP DJ01",117, 0)
	11098	. ; SUB:" AP" [AU,CY ,EM,SP]
	11099	"RTN","HMP DJ01",118, 0)
	11100	. S ORD(" results",1 ,"uid")=$$ SETUID^HMP UTILS("lab ",DFN,SUB_ ";"_IDT)
	11101	"RTN","HMP DJ01",119, 0)
	11102	. S ORD(" results",2 ,"uid")=$$ SETUID^HMP UTILS("doc ument",DFN ,SUB_";"_I DT)
	11103	"RTN","HMP DJ01",120, 0)
	11104	I ORPKG[" PS" D Q
	11105	"RTN","HMP DJ01",121, 0)
	11106	. S:ORPK ORD("resul ts",1,"uid ")=$$SETUI D^HMPUTILS ("med",DFN ,IFN)
	11107	"RTN","HMP DJ01",122, 0)
	11108	;DE2818, ^RADPT - I CR 2480
	11109	"RTN","HMP DJ01",123, 0)
	11110	I ORPKG=" RA" D Q
	11111	"RTN","HMP DJ01",124, 0)
	11112	. N IDT,C N S IDT=+$ O(^RADPT(" AO",+ORPK, DFN,0)) Q: 'IDT
	11113	"RTN","HMP DJ01",125, 0)
	11114	. S CN=0 F S CN=$O (^RADPT("A O",+ORPK,D FN,IDT,CN) ) Q:CN<1 S ORD("res ults",CN," uid")=$$SE TUID^HMPUT ILS("image ",DFN,IDT_ "-"_CN)
	11115	"RTN","HMP DJ01",126, 0)
	11116	; rest sh ould be ge neric (OR) orders
	11117	"RTN","HMP DJ01",127, 0)
	11118	I ORDG="N TX" S ORD( "results", 1,"uid")=$ $SETUID^HM PUTILS("tr eatment",D FN,IFN) Q
	11119	"RTN","HMP DJ01",128, 0)
	11120	I ORDG="V /M" Q ;no link
	11121	"RTN","HMP DJ01",129, 0)
	11122	Q
	11123	"RTN","HMP DJ01",130, 0)
	11124	;
	11125	"RTN","HMP DJ01",131, 0)
	11126	NTX1(IFN) ; -- extra ct nursing treatment order IFN into NTX( "attribute ")
	11127	"RTN","HMP DJ01",132, 0)
	11128	N NTX,X
	11129	"RTN","HMP DJ01",133, 0)
	11130	D ORX(IFN ,.NTX) ;ge t basic or der info
	11131	"RTN","HMP DJ01",134, 0)
	11132	S NTX("or derUid")=N TX("uid")
	11133	"RTN","HMP DJ01",135, 0)
	11134	S NTX("ui d")=$$SETU ID^HMPUTIL S("treatme nt",DFN,IF N)
	11135	"RTN","HMP DJ01",136, 0)
	11136	S X=$$VAL UE^ORX8(IF N,"COMMENT ") S:$L(X) NTX("inst ructions") =X
	11137	"RTN","HMP DJ01",137, 0)
	11138	S X=$$VAL UE^ORX8(IF N,"SCHEDUL E") I X D
	11139	"RTN","HMP DJ01",138, 0)
	11140	. D ZERO^ PSS51P1(X, ,,,"HMPS")
	11141	"RTN","HMP DJ01",139, 0)
	11142	. S NTX(" scheduleNa me")=$G(^T MP($J,"HMP S",X,.01))
	11143	"RTN","HMP DJ01",140, 0)
	11144	. S NTX(" adminTimes ")=$G(^TMP ($J,"HMPS" ,X,1))
	11145	"RTN","HMP DJ01",141, 0)
	11146	. K ^TMP( $J,"HMPS")
	11147	"RTN","HMP DJ01",142, 0)
	11148	S NTX("la stUpdateTi me")=$$EN^ HMPSTMP("t reatment") ;RHL 2014 1231
	11149	"RTN","HMP DJ01",143, 0)
	11150	S NTX("st ampTime")= NTX("lastU pdateTime" ) ; RHL 20 141231
	11151	"RTN","HMP DJ01",144, 0)
	11152	;US6734 - pre-compi le metasta mp
	11153	"RTN","HMP DJ01",145, 0)
	11154	I $G(HMPM ETA) D ADD ^HMPMETA(" treatment" ,NTX("uid" ),NTX("sta mpTime")) Q:HMPMETA= 1 ;US6734 ,US11019
	11155	"RTN","HMP DJ01",146, 0)
	11156	D ADD^HMP DJ("NTX"," treatment" )
	11157	"RTN","HMP DJ01",147, 0)
	11158	Q
	11159	"RTN","HMP DJ01",148, 0)
	11160	;
	11161	"RTN","HMP DJ01",149, 0)
	11162	USER(N,ROL E,IEN,DATE ) ; -- add signature /verificat ion data
	11163	"RTN","HMP DJ01",150, 0)
	11164	S N=+$G(N )+1
	11165	"RTN","HMP DJ01",151, 0)
	11166	S ORD("cl inicians", N,"signedD ateTime")= $$JSONDT^H MPUTILS(DA TE)
	11167	"RTN","HMP DJ01",152, 0)
	11168	S ORD("cl inicians", N,"role")= $G(ROLE)
	11169	"RTN","HMP DJ01",153, 0)
	11170	Q:+$G(IEN )<1
	11171	"RTN","HMP DJ01",154, 0)
	11172	S ORD("cl inicians", N,"uid")=$ $SETUID^HM PUTILS("us er",,IEN)
	11173	"RTN","HMP DJ01",155, 0)
	11174	S ORD("cl inicians", N,"name")= $$GET1^DIQ (200,IEN_" ,",.01) ; DE2818, IC R 10060
	11175	"RTN","HMP DJ01",156, 0)
	11176	Q
	11177	"RTN","HMP DJ01",157, 0)
	11178	;
	11179	"RTN","HMP DJ01",158, 0)
	11180	TM(X) ; -- strip sec onds off a FM time
	11181	"RTN","HMP DJ01",159, 0)
	11182	N D,T,Y S D=$P(X,". "),T=$P(X, ".",2)
	11183	"RTN","HMP DJ01",160, 0)
	11184	S Y=D_$S( T:"."_$E(T ,1,4),1:"" )
	11185	"RTN","HMP DJ01",161, 0)
	11186	S Y=$$JSO NDT^HMPUTI LS(Y)
	11187	"RTN","HMP DJ01",162, 0)
	11188	Q Y
	11189	"RTN","HMP DJ01",163, 0)
	11190	;
	11191	"RTN","HMP DJ02")
	11192	0^35^B1780 43401
	11193	"RTN","HMP DJ02",1,0)
	11194	HMPDJ02 ;S LC/MKB,ASM R/RRB - Pr oblems,All ergies,Vit als;Nov 12 , 2015 14: 52:13
	11195	"RTN","HMP DJ02",2,0)
	11196	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	11197	"RTN","HMP DJ02",3,0)
	11198	;Per VA D irective 6 402, this routine sh ould not b e modified .
	11199	"RTN","HMP DJ02",4,0)
	11200	;
	11201	"RTN","HMP DJ02",5,0)
	11202	; Externa l Referenc es DBIA#
	11203	"RTN","HMP DJ02",6,0)
	11204	; ------- ---------- -- -----
	11205	"RTN","HMP DJ02",7,0)
	11206	; ^PXRMIN DX 4290
	11207	"RTN","HMP DJ02",8,0)
	11208	; DIC 2051
	11209	"RTN","HMP DJ02",9,0)
	11210	; DIQ 2056
	11211	"RTN","HMP DJ02",10,0 )
	11212	; GMPLUTL 2 2741
	11213	"RTN","HMP DJ02",11,0 )
	11214	; GMRADPT 10099
	11215	"RTN","HMP DJ02",12,0 )
	11216	; GMRAOR2 2422
	11217	"RTN","HMP DJ02",13,0 )
	11218	; GMRVUT0 ,^UTILITY( $J 1446
	11219	"RTN","HMP DJ02",14,0 )
	11220	; GMVGETQ L 5048
	11221	"RTN","HMP DJ02",15,0 )
	11222	; GMVGETV T 5047
	11223	"RTN","HMP DJ02",16,0 )
	11224	; GMVUTL 5046
	11225	"RTN","HMP DJ02",17,0 )
	11226	; ICDCODE 3990
	11227	"RTN","HMP DJ02",18,0 )
	11228	; XLFSTR 10104
	11229	"RTN","HMP DJ02",19,0 )
	11230	; XUAF4 2171
	11231	"RTN","HMP DJ02",20,0 )
	11232	;
	11233	"RTN","HMP DJ02",21,0 )
	11234	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	11235	"RTN","HMP DJ02",22,0 )
	11236	;
	11237	"RTN","HMP DJ02",23,0 )
	11238	Q
	11239	"RTN","HMP DJ02",24,0 )
	11240	;
	11241	"RTN","HMP DJ02",25,0 )
	11242	GMPL1(ID,P OVLST) ; - - problem
	11243	"RTN","HMP DJ02",26,0 )
	11244	N HMPL,PR OB,X,I,DAT E,USER,FAC
	11245	"RTN","HMP DJ02",27,0 )
	11246	D DETAIL^ GMPLUTL2(I D,.HMPL) Q :'$D(HMPL) ;doesn't exist
	11247	"RTN","HMP DJ02",28,0 )
	11248	N $ES,$ET ,ERRPAT,ER RMSG
	11249	"RTN","HMP DJ02",29,0 )
	11250	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	11251	"RTN","HMP DJ02",30,0 )
	11252	S ERRMSG= "A problem occurred converting record "_ ID_" for t he problem domain"
	11253	"RTN","HMP DJ02",31,0 )
	11254	;
	11255	"RTN","HMP DJ02",32,0 )
	11256	S PROB("u id")=$$SET UID^HMPUTI LS("proble m",DFN,ID) ,PROB("loc alId")=ID
	11257	"RTN","HMP DJ02",33,0 )
	11258	S PROB("p roblemText ")=$G(HMPL ("NARRATIV E"))
	11259	"RTN","HMP DJ02",34,0 )
	11260	S DATE=$P ($G(HMPL(" ENTERED")) ,U)
	11261	"RTN","HMP DJ02",35,0 )
	11262	S:$L(DATE ) DATE=$$D ATE^HMPDGM PL(DATE),P ROB("enter ed")=$$JSO NDT^HMPUTI LS(DATE)
	11263	"RTN","HMP DJ02",36,0 )
	11264	S X=$G(HM PL("DIAGNO SIS")) I $ L(X) D
	11265	"RTN","HMP DJ02",37,0 )
	11266	. N ICD9Z N,DIAG
	11267	"RTN","HMP DJ02",38,0 )
	11268	. I DATE' >0 S DATE= DT
	11269	"RTN","HMP DJ02",39,0 )
	11270	. S ICD9Z N=$$ICDDX^ ICDCODE(X, DATE),DIAG =$S($P($G( ICD9ZN),U, 4)'="":$P( ICD9ZN,U,4 ),1:X)
	11271	"RTN","HMP DJ02",40,0 )
	11272	. ; BEGIN MOD ASF 0 9/8/15 US 9239 DE 20 82
	11273	"RTN","HMP DJ02",41,0 )
	11274	. ; Only set icdCod e and icdN ame if it is ICD9 (I CD10 is on ly availab le in code s array)
	11275	"RTN","HMP DJ02",42,0 )
	11276	. I HMPL( "CSYS")="I CD" S PROB ("icdCode" )=$$SETNCS ^HMPUTILS( "icd",HMPL ("DIAGNOSI S")),PROB( "icdName") =DIAG
	11277	"RTN","HMP DJ02",43,0 )
	11278	. ; Creat e codes ar ray for bo th ICD9 or ICD10
	11279	"RTN","HMP DJ02",44,0 )
	11280	. S PROB( "codes",1, "code")=HM PL("DIAGNO SIS")
	11281	"RTN","HMP DJ02",45,0 )
	11282	. S PROB( "codes",1, "display") =$S(HMPL(" CSYS")="IC D":DIAG,HM PL("CSYS") ="10D":HMP L("ICDD"))
	11283	"RTN","HMP DJ02",46,0 )
	11284	. S PROB( "codes",1, "system")= $S(HMPL("C SYS")="ICD ":"urn:oid :2.16.840. 1.113883.6 .42",HMPL( "CSYS")="1 0D":"urn:o id:2.16.84 0.1.113883 .6.3",1:"c odesystem error")
	11285	"RTN","HMP DJ02",47,0 )
	11286	. ;SNOMED CT codes
	11287	"RTN","HMP DJ02",48,0 )
	11288	. S SCTCO DE=$$GET1^ DIQ(900001 1,ID_",",8 0001) ;900 0011,80001 SNOMED CT CONCEPT C ODE
	11289	"RTN","HMP DJ02",49,0 )
	11290	. D:SCTCO DE EN^LEXC ODE(SCTCOD E) ; ICR 1 614
	11291	"RTN","HMP DJ02",50,0 )
	11292	. I $D(LE XS("SCT",1 )) D
	11293	"RTN","HMP DJ02",51,0 )
	11294	. . S PRO B("codes", 2,"code")= SCTCODE
	11295	"RTN","HMP DJ02",52,0 )
	11296	. . S PRO B("codes", 2,"code"," \s")="" ; Ensure cod e is sent as a strin g
	11297	"RTN","HMP DJ02",53,0 )
	11298	. . S PRO B("codes", 2,"display ")=$P(LEXS ("SCT",1), U,2)
	11299	"RTN","HMP DJ02",54,0 )
	11300	. . S PRO B("codes", 2,"system" )="http:// snomed.inf o/sct"
	11301	"RTN","HMP DJ02",55,0 )
	11302	. ; END M OD ASF US 9239 DE 20 82
	11303	"RTN","HMP DJ02",56,0 )
	11304	S X=$G(HM PL("ONSET" )) S:$L(X) X=$$DATE^ HMPDGMPL(X ),PROB("on set")=$$JS ONDT^HMPUT ILS(X)
	11305	"RTN","HMP DJ02",57,0 )
	11306	S X=$G(HM PL("MODIFI ED")) S:$L (X) X=$$DA TE^HMPDGMP L(X),PROB( "updated") =$$JSONDT^ HMPUTILS(X )
	11307	"RTN","HMP DJ02",58,0 )
	11308	S X=$G(HM PL("STATUS ")) I $L(X ) D
	11309	"RTN","HMP DJ02",59,0 )
	11310	. S PROB( "statusNam e")=X,X=$E (X)
	11311	"RTN","HMP DJ02",60,0 )
	11312	. S X=$S( X="A":5556 1003,X="I" :73425007, 1:"")
	11313	"RTN","HMP DJ02",61,0 )
	11314	. S PROB( "statusCod e")=$$SETN CS^HMPUTIL S("sct",X)
	11315	"RTN","HMP DJ02",62,0 )
	11316	S X=$G(HM PL("PRIORI TY")) I X] "" D
	11317	"RTN","HMP DJ02",63,0 )
	11318	. S X=$$L OW^XLFSTR( X),PROB("a cuityName" )=X
	11319	"RTN","HMP DJ02",64,0 )
	11320	. S PROB( "acuityCod e")=$$SETV URN^HMPUTI LS("prob-a cuity",$E( X))
	11321	"RTN","HMP DJ02",65,0 )
	11322	S X=$$GET 1^DIQ(9000 011,ID_"," ,1.07,"I") S:X PROB( "resolved" )=$$JSONDT ^HMPUTILS( X)
	11323	"RTN","HMP DJ02",66,0 )
	11324	S X=$$GET 1^DIQ(9000 011,ID_"," ,1.02,"I")
	11325	"RTN","HMP DJ02",67,0 )
	11326	S:X="P" P ROB("unver ified")="f alse",PROB ("removed" )="false"
	11327	"RTN","HMP DJ02",68,0 )
	11328	S:X="T" P ROB("unver ified")="t rue",PROB( "removed") ="false"
	11329	"RTN","HMP DJ02",69,0 )
	11330	S:X="H" P ROB("unver ified")="f alse",PROB ("removed" )="true"
	11331	"RTN","HMP DJ02",70,0 )
	11332	S X=$G(HM PL("SC")), X=$S(X="YE S":"",X="N O":"false" ,1:"")
	11333	"RTN","HMP DJ02",71,0 )
	11334	S:$L(X) P ROB("servi ceConnecte d")=X
	11335	"RTN","HMP DJ02",72,0 )
	11336	S X=$G(HM PL("PROVID ER")) I $L (X) D
	11337	"RTN","HMP DJ02",73,0 )
	11338	. S PROB( "providerN ame")=X,X= $$GET1^DIQ (9000011,I D_",",1.05 ,"I")
	11339	"RTN","HMP DJ02",74,0 )
	11340	. S PROB( "providerU id")=$$SET UID^HMPUTI LS("user", ,+X)
	11341	"RTN","HMP DJ02",75,0 )
	11342	S X=$$GET 1^DIQ(9000 011,ID_"," ,1.06) S:$ L(X) PROB( "service") =X
	11343	"RTN","HMP DJ02",76,0 )
	11344	S X=$G(HM PL("CLINIC ")) I $L(X ) D
	11345	"RTN","HMP DJ02",77,0 )
	11346	. S PROB( "locationN ame")=X
	11347	"RTN","HMP DJ02",78,0 )
	11348	. N LOC S LOC=+$$FI ND1^DIC(44 ,,"QX",X)
	11349	"RTN","HMP DJ02",79,0 )
	11350	. S:LOC P ROB("locat ionUid")=$ $SETUID^HM PUTILS("lo cation",,L OC)
	11351	"RTN","HMP DJ02",80,0 )
	11352	S X=+$$GE T1^DIQ(900 0011,ID_", ",.06,"I")
	11353	"RTN","HMP DJ02",81,0 )
	11354	S:X FAC=$ $STA^XUAF4 (X)_U_$P($ $NS^XUAF4( X),U)
	11355	"RTN","HMP DJ02",82,0 )
	11356	I 'X S FA C=$$FAC^HM PD ;local stn#^name
	11357	"RTN","HMP DJ02",83,0 )
	11358	D FACILIT Y^HMPUTILS (FAC,"PROB ")
	11359	"RTN","HMP DJ02",84,0 )
	11360	S I=0 F S I=$O(HMP L("COMMENT ",I)) Q:I< 1 D
	11361	"RTN","HMP DJ02",85,0 )
	11362	. S X=$G( HMPL("COMM ENT",I))
	11363	"RTN","HMP DJ02",86,0 )
	11364	. S USER= $$VA200^HM PDGMPL($P( X,U,2)),DA TE=$$DATE^ HMPDGMPL($ P(X,U))
	11365	"RTN","HMP DJ02",87,0 )
	11366	. S PROB( "comments" ,I,"entere dByCode")= $$SETUID^H MPUTILS("u ser",,+USE R)
	11367	"RTN","HMP DJ02",88,0 )
	11368	. S PROB( "comments" ,I,"entere dByName")= $P(X,U,2)
	11369	"RTN","HMP DJ02",89,0 )
	11370	. S PROB( "comments" ,I,"entere d")=$$JSON DT^HMPUTIL S(DATE)
	11371	"RTN","HMP DJ02",90,0 )
	11372	. S PROB( "comments" ,I,"commen t")=$P(X,U ,3)
	11373	"RTN","HMP DJ02",91,0 )
	11374	I $D(POVL ST) D GMPL VST(ID,"PR OB",.POVLS T) ;JL;ad d encounte r informat ion.
	11375	"RTN","HMP DJ02",92,0 )
	11376	S PROB("l astUpdateT ime")=$$EN ^HMPSTMP(" problem")
	11377	"RTN","HMP DJ02",93,0 )
	11378	S PROB("s tampTime") =PROB("las tUpdateTim e") ; RHL 20141231
	11379	"RTN","HMP DJ02",94,0 )
	11380	;US6734 - pre-compi le metasta mp
	11381	"RTN","HMP DJ02",95,0 )
	11382	I $G(HMPM ETA) D ADD ^HMPMETA(" problem",P ROB("uid") ,PROB("sta mpTime")) Q:HMPMETA= 1 ;US6734 ,US11019
	11383	"RTN","HMP DJ02",96,0 )
	11384	D ADD^HMP DJ("PROB", "problem")
	11385	"RTN","HMP DJ02",97,0 )
	11386	Q
	11387	"RTN","HMP DJ02",98,0 )
	11388	;
	11389	"RTN","HMP DJ02",99,0 )
	11390	GMPLVST(ID ,Y,POVLST) ; --- JL ;associate problem w ith visit and notes
	11391	"RTN","HMP DJ02",100, 0)
	11392	; DE2818, ^AUPNPROB ( - ICR 12 53
	11393	"RTN","HMP DJ02",101, 0)
	11394	Q:'$G(ID) !'$G(^AUPN PROB(ID,0) )!'$D(POVL ST) ;inva lid id or no data
	11395	"RTN","HMP DJ02",102, 0)
	11396	N ICDCODE
	11397	"RTN","HMP DJ02",103, 0)
	11398	S ICDCODE =$$CODEC^I CDCODE($P( ^AUPNPROB( ID,0),U,1) ) Q:ICDCOD E=-1 ;inv alid icdco de
	11399	"RTN","HMP DJ02",104, 0)
	11400	Q:$D(POVL ST(ICDCODE ))=0
	11401	"RTN","HMP DJ02",105, 0)
	11402	N IDX,VCN T,NCNT,DIE N,VIEN,FAC ,STCODE
	11403	"RTN","HMP DJ02",106, 0)
	11404	S IDX="", VCNT=0,NCN T=0 F S I DX=$O(POVL ST(ICDCODE ,IDX)) Q:I DX="" D
	11405	"RTN","HMP DJ02",107, 0)
	11406	. S VCNT= VCNT+1
	11407	"RTN","HMP DJ02",108, 0)
	11408	. S VIEN= +$G(POVLST (ICDCODE,I DX)),FAC=$ $FAC^HMPDJ 04(VIEN),S TCODE=$$ST CODE^HMPDJ 04(VIEN)
	11409	"RTN","HMP DJ02",109, 0)
	11410	. I FAC D FACILITY^ HMPUTILS(F AC,Y_"(""e ncounters" ","_VCNT_" )") ; fac ility info
	11411	"RTN","HMP DJ02",110, 0)
	11412	. I STCOD E D STOPCO DE^HMPDJ04 (STCODE,Y_ "(""encoun ters"","_V CNT_")") ; stop code
	11413	"RTN","HMP DJ02",111, 0)
	11414	. S @Y@(" encounters ",VCNT,"da teTime")=$ $JSONDT^HM PUTILS($$D ATE^HMPDGM PL(+IDX))
	11415	"RTN","HMP DJ02",112, 0)
	11416	. S @Y@(" encounters ",VCNT,"vi sitUid")=$ $SETUID^HM PUTILS("vi sit",DFN,V IEN)
	11417	"RTN","HMP DJ02",113, 0)
	11418	. N ENINF O S ENINFO =$G(POVLST (ICDCODE,I DX))
	11419	"RTN","HMP DJ02",114, 0)
	11420	. S DIEN= +$P(ENINFO ,U,2)
	11421	"RTN","HMP DJ02",115, 0)
	11422	. ;W "DIE N is "_DIE N,!
	11423	"RTN","HMP DJ02",116, 0)
	11424	. I DIEN D
	11425	"RTN","HMP DJ02",117, 0)
	11426	. . S NCN T=NCNT+1
	11427	"RTN","HMP DJ02",118, 0)
	11428	. . ; ext ract the e xtra data from the d ocument
	11429	"RTN","HMP DJ02",119, 0)
	11430	. . N DOC INFO S DOC INFO=$E(EN INFO,$F($G (ENINFO),U ),$L(ENINF O))
	11431	"RTN","HMP DJ02",120, 0)
	11432	. . N OUT PUT S OUTP UT="" D EN 1^HMPDJ08( DOCINFO,3, .OUTPUT)
	11433	"RTN","HMP DJ02",121, 0)
	11434	. . N NAM E F NAME=" documentTy peName","e ntered","s ummary","f acilityNam e","author DisplayNam e" D
	11435	"RTN","HMP DJ02",122, 0)
	11436	. . . S:$ D(OUTPUT(N AME)) @Y@( "documents ",NCNT,NAM E)=$G(OUTP UT(NAME))
	11437	"RTN","HMP DJ02",123, 0)
	11438	. . S @Y@ ("document s",NCNT,"d ocumentUid ")=$$SETUI D^HMPUTILS ("document ",DFN,DIEN )
	11439	"RTN","HMP DJ02",124, 0)
	11440	Q
	11441	"RTN","HMP DJ02",125, 0)
	11442	;
	11443	"RTN","HMP DJ02",126, 0)
	11444	GMPLPOV(DF NN,POVLST, DONTKILL) ; -- JL;Al l problem of visit r elated to the patien t from V P OV file
	11445	"RTN","HMP DJ02",127, 0)
	11446	;INPUT: P atient's D FN
	11447	"RTN","HMP DJ02",128, 0)
	11448	;OUTPUT: Patient's VISIT list in the fo rmat of
	11449	"RTN","HMP DJ02",129, 0)
	11450	; OUTPUT(DIA GNOSIS,DAT ATIME)="VI SITIEN"
	11451	"RTN","HMP DJ02",130, 0)
	11452	;
	11453	"RTN","HMP DJ02",131, 0)
	11454	Q:'$G(DFN N)
	11455	"RTN","HMP DJ02",132, 0)
	11456	N INVVST
	11457	"RTN","HMP DJ02",133, 0)
	11458	K:'DONTKI LL POVLST ; clear th e output
	11459	"RTN","HMP DJ02",134, 0)
	11460	;DE2818, ^AUPNVPOV( - ICR 309 4, ^AUPNVS IT( - ICR 2028
	11461	"RTN","HMP DJ02",135, 0)
	11462	; Query V POV(^AUPN VPOV() by using "AA" Cross Ref erence.
	11463	"RTN","HMP DJ02",136, 0)
	11464	S INVVST= "",CURVST= "" F S IN VVST=$O(^A UPNVPOV("A A",DFNN,IN VVST)) Q:I NVVST="" D
	11465	"RTN","HMP DJ02",137, 0)
	11466	. N CURVS T,DIEN
	11467	"RTN","HMP DJ02",138, 0)
	11468	. S CURVS T=INVVST,D IEN="" F S DIEN=$O( ^AUPNVPOV( "AA",DFNN, CURVST,DIE N)) Q:DIEN ="" D
	11469	"RTN","HMP DJ02",139, 0)
	11470	. . N ICD IEN,PVISIT
	11471	"RTN","HMP DJ02",140, 0)
	11472	. . S ICD IEN=+$P(^A UPNVPOV(DI EN,0),U,1) ,PVISIT=$P (^AUPNVPOV (DIEN,0),U ,3)
	11473	"RTN","HMP DJ02",141, 0)
	11474	. . N VIS ITDT
	11475	"RTN","HMP DJ02",142, 0)
	11476	. . S VIS ITDT=+$G(^ AUPNVSIT(P VISIT,0)) Q:'$L(VISI TDT) ;qui t if no vi sit is fou nd, bad da ta entry.
	11477	"RTN","HMP DJ02",143, 0)
	11478	. . N ICD CODE,VIEN
	11479	"RTN","HMP DJ02",144, 0)
	11480	. . S ICD CODE=$$COD EC^ICDCODE (ICDIEN) Q :ICDCODE=- 1 ;conver t to ICD c ode, quit if not val id
	11481	"RTN","HMP DJ02",145, 0)
	11482	. . I $D( POVLST(ICD CODE,VISIT DT))'=0 D Q
	11483	"RTN","HMP DJ02",146, 0)
	11484	. . . S V IEN=$$GETV IEN(DFNN,V ISITDT)
	11485	"RTN","HMP DJ02",147, 0)
	11486	. . . ; W :VIEN=-1 " Can not fi nd VISIT I EN for "_V ISITDT,!
	11487	"RTN","HMP DJ02",148, 0)
	11488	. . . S:V IEN'=-1 PO VLST(ICDCO DE,VISITDT )=VIEN
	11489	"RTN","HMP DJ02",149, 0)
	11490	Q
	11491	"RTN","HMP DJ02",150, 0)
	11492	;
	11493	"RTN","HMP DJ02",151, 0)
	11494	GETVIEN(DF NN,VISITDT ) ;JL; ge t the Visi t IEN from VISIT fil e based on patient I D and Date time
	11495	"RTN","HMP DJ02",152, 0)
	11496	Q:'+$G(DF NN)!'$L(VI SITDT) -1 ;return - 1 if bad p arameter
	11497	"RTN","HMP DJ02",153, 0)
	11498	N REVDT,V ISITIEN
	11499	"RTN","HMP DJ02",154, 0)
	11500	S REVDT=9 999999-$P( VISITDT,". ",1)_$S($P (VISITDT," .",2)'="": "."_$P(VIS ITDT,".",2 ),1:"")
	11501	"RTN","HMP DJ02",155, 0)
	11502	; ;DE2818 , ^AUPNVSI T( - ICR 2 028
	11503	"RTN","HMP DJ02",156, 0)
	11504	S VISITIE N=$O(^AUPN VSIT("AA", DFNN,REVDT ,"")) ; u sing "AA" cross-refe rence
	11505	"RTN","HMP DJ02",157, 0)
	11506	Q:VISITIE N="" -1
	11507	"RTN","HMP DJ02",158, 0)
	11508	Q VISITIE N
	11509	"RTN","HMP DJ02",159, 0)
	11510	;
	11511	"RTN","HMP DJ02",160, 0)
	11512	DIAGLIST(D IAGS,DFN,O RDATE,ORPR CNT) ;BL,J L; get lis t diagnosi s on past notes
	11513	"RTN","HMP DJ02",161, 0)
	11514	S:'+$G(OR DATE) ORDA TE=DT
	11515	"RTN","HMP DJ02",162, 0)
	11516	S:'+$G(OR PRCNT) ORP RCNT=1
	11517	"RTN","HMP DJ02",163, 0)
	11518	;Use TIU DOCUMENTS BY CONTEXT to retrie ve all not es associa ted with p atient (CO NTEXT^TIUS RVLO)
	11519	"RTN","HMP DJ02",164, 0)
	11520	K ENC,DIA GCODE,CNT, DIAG,DIAGN UM,DIAGLIN E,ENCNUM,L INE,IEN,CL ASS,CONTEX T,EARLY,LA TE,PERSON, OCCLIM,SEQ UENCE,SHOW ADD,INCUND ,LSTNUM,NO TEINFO
	11521	"RTN","HMP DJ02",165, 0)
	11522	K NEWCNT, OLDLST,DIA GCNT
	11523	"RTN","HMP DJ02",166, 0)
	11524	S CLASS=3 ,CONTEXT=1 ,EARLY=-1, LATE=-1,PE RSON=0,OCC LIM=0,SEQU ENCE="D",S HOWADD=0,I NCUND=0,OL DLST=""
	11525	"RTN","HMP DJ02",167, 0)
	11526	;TAKE EXI STING LIST FROM ENCO UNTER CALL AND PRESE RVE TO BE APPENDED A FTERWARD
	11527	"RTN","HMP DJ02",168, 0)
	11528	K DIAGS S DIAGS=""
	11529	"RTN","HMP DJ02",169, 0)
	11530	D CONTEXT ^TIUSRVLO( .DIAGS,CLA SS,CONTEXT ,DFN,EARLY ,LATE,PERS ON,OCCLIM, SEQUENCE,S HOWADD,INC UND)
	11531	"RTN","HMP DJ02",170, 0)
	11532	M DIAGS=^ TMP("TIUR" ,$J)
	11533	"RTN","HMP DJ02",171, 0)
	11534	;Go throu gh notes l ist and us e ORWPCE P CE4NOTE to extract d iagnosis a ssociated with each encounter to previou s problem list (PCE4 NOTE^ORWPC E3)
	11535	"RTN","HMP DJ02",172, 0)
	11536	S LSTNUM= ""
	11537	"RTN","HMP DJ02",173, 0)
	11538	;THIS CAL L WILL EXT RACT ALL T HE VISIT I NFORMATION TO ^TMP(P XKENC,$J,V ISIT)
	11539	"RTN","HMP DJ02",174, 0)
	11540	N VIEN
	11541	"RTN","HMP DJ02",175, 0)
	11542	F S LSTN UM=$O(DIAG S(LSTNUM)) Q:LSTNUM= "" D
	11543	"RTN","HMP DJ02",176, 0)
	11544	. S NOTEI NFO=""
	11545	"RTN","HMP DJ02",177, 0)
	11546	. S IEN=$ P(DIAGS(LS TNUM),"^", 1)
	11547	"RTN","HMP DJ02",178, 0)
	11548	. D PCE4N OTE^ORWPCE 3(.NOTEINF O,IEN,DFN)
	11549	"RTN","HMP DJ02",179, 0)
	11550	. S CNT=0 ,DIAGCNT=0
	11551	"RTN","HMP DJ02",180, 0)
	11552	. F S CN T=$O(NOTEI NFO(CNT)) Q:CNT="" D
	11553	"RTN","HMP DJ02",181, 0)
	11554	. . Q:$P( NOTEINFO(C NT),"^",1) '["POV"
	11555	"RTN","HMP DJ02",182, 0)
	11556	. . S DIA GCNT=DIAGC NT+1
	11557	"RTN","HMP DJ02",183, 0)
	11558	. . S VIS ITDT=$P($G (NOTEINFO( 2)),U,3) ; get the visit date time
	11559	"RTN","HMP DJ02",184, 0)
	11560	. . S ICD CODE=$P(NO TEINFO(CNT ),U,2) ; get the di agnosis co de
	11561	"RTN","HMP DJ02",185, 0)
	11562	. . I $D( ENC(ICDCOD E,VISITDT) )=0 D
	11563	"RTN","HMP DJ02",186, 0)
	11564	. . . S V IEN=$$GETV IEN(DFN,VI SITDT)
	11565	"RTN","HMP DJ02",187, 0)
	11566	. . . ;W: VIEN=-1 "C an not fin d Visit ID for "_NOT EINFO(CNT) ,!
	11567	"RTN","HMP DJ02",188, 0)
	11568	. . . S:V IEN'=-1 EN C(ICDCODE, VISITDT)=V IEN_U_$G(D IAGS(LSTNU M)) ; add to list o nly if vis it ien is valid
	11569	"RTN","HMP DJ02",189, 0)
	11570	; KILL DI AGS BECAUS E IT NOW C ONTAINS NO TE INFO
	11571	"RTN","HMP DJ02",190, 0)
	11572	K DIAGS
	11573	"RTN","HMP DJ02",191, 0)
	11574	M DIAGS=E NC
	11575	"RTN","HMP DJ02",192, 0)
	11576	;CLEAN UP ARRAYS
	11577	"RTN","HMP DJ02",193, 0)
	11578	K NOTEINF O,ENC,DIAG ,^TMP("TIU R",$J)
	11579	"RTN","HMP DJ02",194, 0)
	11580	D GMPLPOV (DFN,.DIAG S,1) ; Al so loop th ru V POV f ile to fin d extra en counter
	11581	"RTN","HMP DJ02",195, 0)
	11582	Q
	11583	"RTN","HMP DJ02",196, 0)
	11584	;
	11585	"RTN","HMP DJ02",197, 0)
	11586	GMRA1(ID) ; -- aller gy/reactio n GMRAL(ID )
	11587	"RTN","HMP DJ02",198, 0)
	11588	N GMRA,HM PY,REAC,X, Y,I,USER,C MMT
	11589	"RTN","HMP DJ02",199, 0)
	11590	S GMRA=$G (GMRAL(ID) ) D EN1^GM RAOR2(ID," HMPY")
	11591	"RTN","HMP DJ02",200, 0)
	11592	N $ES,$ET ,ERRPAT,ER RMSG
	11593	"RTN","HMP DJ02",201, 0)
	11594	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	11595	"RTN","HMP DJ02",202, 0)
	11596	S ERRMSG= "A problem occurred converting record "_ ID_" for t he allergy domain"
	11597	"RTN","HMP DJ02",203, 0)
	11598	;
	11599	"RTN","HMP DJ02",204, 0)
	11600	S X=$P(HM PY,U,10) I $L(X) S X =$$DATE^HM PDGMRA(X) Q:X<HMPSTA RT Q:X>HM PSTOP S R EAC("enter ed")=$$JSO NDT^HMPUTI LS(X)
	11601	"RTN","HMP DJ02",205, 0)
	11602	S X=$$FAC ^HMPD D FA CILITY^HMP UTILS(X,"R EAC")
	11603	"RTN","HMP DJ02",206, 0)
	11604	S REAC("k ind")="All ergy / Adv erse React ion"
	11605	"RTN","HMP DJ02",207, 0)
	11606	S REAC("l ocalId")=I D,REAC("ui d")=$$SETU ID^HMPUTIL S("allergy ",DFN,ID)
	11607	"RTN","HMP DJ02",208, 0)
	11608	S (REAC(" summary"), REAC("prod ucts",1,"n ame"))=$P( HMPY,U) I $P(GMRA,U, 9) D
	11609	"RTN","HMP DJ02",209, 0)
	11610	. S X=$P( GMRA,U,9), REAC("refe rence")=X
	11611	"RTN","HMP DJ02",210, 0)
	11612	. S Y=+$P (X,"(",2) I 'Y,X["PS DRUG" S Y= 50
	11613	"RTN","HMP DJ02",211, 0)
	11614	. S I=$$V UID^HMPD(+ X,Y),REAC( "products" ,1,"vuid") =$$SETVURN ^HMPUTILS( "vuid",I)
	11615	"RTN","HMP DJ02",212, 0)
	11616	S X=$P(HM PY,U,2) S: $L(X) REAC ("originat orName")=X
	11617	"RTN","HMP DJ02",213, 0)
	11618	S REAC("h istorical" )=$S($E($P (HMPY,U,5) )="H":"tru e",1:"fals e")
	11619	"RTN","HMP DJ02",214, 0)
	11620	S X=$P(HM PY,U,6) S: $L(X) REAC ("mechanis m")=X
	11621	"RTN","HMP DJ02",215, 0)
	11622	S X=$P(HM PY,U,7) S: $L(X) REAC ("typeName ")=X
	11623	"RTN","HMP DJ02",216, 0)
	11624	; REAC("a dverseEven tTypeName" )=$P(HMPY, U,7)_" "_$ P(HMPY,U,6 ) ;TYPE_ME CH
	11625	"RTN","HMP DJ02",217, 0)
	11626	I $P(HMPY ,U,4)="VER IFIED",$P( HMPY,U,9) D
	11627	"RTN","HMP DJ02",218, 0)
	11628	. S REAC( "verified" )=$$JSONDT ^HMPUTILS( $P(HMPY,U, 9))
	11629	"RTN","HMP DJ02",219, 0)
	11630	. S REAC( "verifierN ame")=$P(H MPY,U,8)
	11631	"RTN","HMP DJ02",220, 0)
	11632	; severit y
	11633	"RTN","HMP DJ02",221, 0)
	11634	S I=0 F S I=$O(HMP Y("O",I)) Q:I<1 D
	11635	"RTN","HMP DJ02",222, 0)
	11636	. S X=$G( HMPY("O",I ))
	11637	"RTN","HMP DJ02",223, 0)
	11638	. S REAC( "observati ons",I,"da te")=$$JSO NDT^HMPUTI LS(+X)
	11639	"RTN","HMP DJ02",224, 0)
	11640	. S REAC( "observati ons",I,"se verity")=$ P(X,U,2)
	11641	"RTN","HMP DJ02",225, 0)
	11642	; reactio ns
	11643	"RTN","HMP DJ02",226, 0)
	11644	S I=0 F S I=$O(GMR AL(ID,"S", I)) Q:I<1 D
	11645	"RTN","HMP DJ02",227, 0)
	11646	. S X=$G( GMRAL(ID," S",I))
	11647	"RTN","HMP DJ02",228, 0)
	11648	. S REAC( "reactions ",I,"name" )=$P(X,";" )
	11649	"RTN","HMP DJ02",229, 0)
	11650	. S Y=$$V UID^HMPD(+ $P(X,";",2 ),120.83)
	11651	"RTN","HMP DJ02",230, 0)
	11652	. S REAC( "reactions ",I,"vuid" )=$$SETVUR N^HMPUTILS ("vuid",Y)
	11653	"RTN","HMP DJ02",231, 0)
	11654	; drug cl asses
	11655	"RTN","HMP DJ02",232, 0)
	11656	S I=0 F S I=$O(HMP Y("V",I)) Q:I<1 D
	11657	"RTN","HMP DJ02",233, 0)
	11658	. S X=$G( HMPY("V",I ))
	11659	"RTN","HMP DJ02",234, 0)
	11660	. S REAC( "drugClass es",I,"cod e")=$P(X,U )
	11661	"RTN","HMP DJ02",235, 0)
	11662	. S REAC( "drugClass es",I,"nam e")=$P(X,U ,2)
	11663	"RTN","HMP DJ02",236, 0)
	11664	S I=0 F S I=$O(HMP Y("C",I)) Q:I<1 D
	11665	"RTN","HMP DJ02",237, 0)
	11666	. S X=$G( HMPY("C",I )),USER=$$ VA200^HMPD GMPL($P(X, U,3))
	11667	"RTN","HMP DJ02",238, 0)
	11668	. S REAC( "comments" ,I,"entere dByUid")=$ $SETUID^HM PUTILS("us er",,+USER )
	11669	"RTN","HMP DJ02",239, 0)
	11670	. S REAC( "comments" ,I,"entere dByName")= $P(X,U,3)
	11671	"RTN","HMP DJ02",240, 0)
	11672	. S REAC( "comments" ,I,"entere d")=$$JSON DT^HMPUTIL S(+X)
	11673	"RTN","HMP DJ02",241, 0)
	11674	. K CMMT M CMMT=HMP Y("C",I)
	11675	"RTN","HMP DJ02",242, 0)
	11676	. S REAC( "comments" ,I,"commen t")=$$STRI NG^HMPD(.C MMT)
	11677	"RTN","HMP DJ02",243, 0)
	11678	I GMRA="" S REAC("r emoved")=" true" ;ent ered in er ror
	11679	"RTN","HMP DJ02",244, 0)
	11680	; next
	11681	"RTN","HMP DJ02",245, 0)
	11682	S REAC("l astUpdateT ime")=$$EN ^HMPSTMP(" allergy")
	11683	"RTN","HMP DJ02",246, 0)
	11684	S REAC("s tampTime") =REAC("las tUpdateTim e") ; RHL 20141231
	11685	"RTN","HMP DJ02",247, 0)
	11686	;US6734 - pre-compi le metasta mp
	11687	"RTN","HMP DJ02",248, 0)
	11688	I $G(HMPM ETA) D ADD ^HMPMETA(" allergy",R EAC("uid") ,REAC("sta mpTime")) Q:HMPMETA= 1 ;US6734 ,US11019
	11689	"RTN","HMP DJ02",249, 0)
	11690	D ADD^HMP DJ("REAC", "allergy")
	11691	"RTN","HMP DJ02",250, 0)
	11692	Q
	11693	"RTN","HMP DJ02",251, 0)
	11694	;
	11695	"RTN","HMP DJ02",252, 0)
	11696	NKA ; -- n o assessme nt or NKA [GMRAL=0 o r ""]
	11697	"RTN","HMP DJ02",253, 0)
	11698	N REAC,X
	11699	"RTN","HMP DJ02",254, 0)
	11700	;DE2818, ^GMR(120.8 6 - ICR 34 49
	11701	"RTN","HMP DJ02",255, 0)
	11702	S X=$G(^G MR(120.86, DFN,0)) Q: GMRAL=""!' $P(X,U,2) ;DE2818, ICR 3449
	11703	"RTN","HMP DJ02",256, 0)
	11704	S REAC("u id")=$$SET UID^HMPUTI LS("obs",D FN,"120.86 ;"_DFN)
	11705	"RTN","HMP DJ02",257, 0)
	11706	S REAC("t ypeCode")= "urn:sct:1 60244002"
	11707	"RTN","HMP DJ02",258, 0)
	11708	S REAC("t ypeName")= "No known allergies"
	11709	"RTN","HMP DJ02",259, 0)
	11710	S X=$$FAC ^HMPD D FA CILITY^HMP UTILS(X,"R EAC")
	11711	"RTN","HMP DJ02",260, 0)
	11712	D ADD^HMP DJ("REAC", "allergy")
	11713	"RTN","HMP DJ02",261, 0)
	11714	Q
	11715	"RTN","HMP DJ02",262, 0)
	11716	;
	11717	"RTN","HMP DJ02",263, 0)
	11718	GMV1(ID) ; -- vital/ measuremen t ^UTILITY ($J,"GMRVD ",HMPIDT,H MPTYP,ID)
	11719	"RTN","HMP DJ02",264, 0)
	11720	N VIT,HMP Y,X0,TYPE, LOC,FAC,X, Y,MRES,MUN T,HIGH,LOW ,I
	11721	"RTN","HMP DJ02",265, 0)
	11722	D GETREC^ GMVUTL(.HM PY,ID,1) S X0=$G(HMP Y(0))
	11723	"RTN","HMP DJ02",266, 0)
	11724	; DE281, ^PXRMINDX( 120.5 - IC R 4290
	11725	"RTN","HMP DJ02",267, 0)
	11726	; GMRVUT0 returns C LiO data w ith a pseu do-ID >> g et real ID
	11727	"RTN","HMP DJ02",268, 0)
	11728	I X0="",$ G(HMPIDT), $D(HMPTYP) D ;[from HMPDJ0]
	11729	"RTN","HMP DJ02",269, 0)
	11730	. N GMRVD S GMRVD=$ G(^UTILITY ($J,"GMRVD ",HMPIDT,H MPTYP,ID))
	11731	"RTN","HMP DJ02",270, 0)
	11732	. S ID=$O (^PXRMINDX (120.5,"PI ",DFN,$P(G MRVD,U,3), +GMRVD,"") )
	11733	"RTN","HMP DJ02",271, 0)
	11734	. I $L(ID ) D GETREC ^GMVUTL(.H MPY,ID,1) S X0=$G(HM PY(0))
	11735	"RTN","HMP DJ02",272, 0)
	11736	Q:X0=""
	11737	"RTN","HMP DJ02",273, 0)
	11738	;
	11739	"RTN","HMP DJ02",274, 0)
	11740	N $ES,$ET ,ERRPAT,ER RMSG
	11741	"RTN","HMP DJ02",275, 0)
	11742	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	11743	"RTN","HMP DJ02",276, 0)
	11744	S ERRMSG= "A problem occurred converting record "_ ID_" for t he vitals domain"
	11745	"RTN","HMP DJ02",277, 0)
	11746	S VIT("lo calId")=ID ,VIT("kind ")="Vital Sign"
	11747	"RTN","HMP DJ02",278, 0)
	11748	S VIT("ui d")=$$SETU ID^HMPUTIL S("vital", DFN,ID)
	11749	"RTN","HMP DJ02",279, 0)
	11750	S VIT("ob served")=$ $JSONDT^HM PUTILS(+X0 )
	11751	"RTN","HMP DJ02",280, 0)
	11752	S VIT("re sulted")=$ $JSONDT^HM PUTILS(+$P (X0,U,4))
	11753	"RTN","HMP DJ02",281, 0)
	11754	S TYPE=$$ FIELD^GMVG ETVT(+$P(X 0,U,3),2)
	11755	"RTN","HMP DJ02",282, 0)
	11756	S VIT("di splayName" )=TYPE
	11757	"RTN","HMP DJ02",283, 0)
	11758	S VIT("ty peName")=$ $FIELD^GMV GETVT($P(X 0,U,3),1)
	11759	"RTN","HMP DJ02",284, 0)
	11760	S VIT("ty peCode")=" urn:va:vui d:"_$$FIEL D^GMVGETVT ($P(X0,U,3 ),4)
	11761	"RTN","HMP DJ02",285, 0)
	11762	S X=$P(X0 ,U,8),VIT( "result")= X
	11763	"RTN","HMP DJ02",286, 0)
	11764	S VIT("un its")=$$UN IT^HMPDGMV (TYPE),(MR ES,MUNT)=" "
	11765	"RTN","HMP DJ02",287, 0)
	11766	I TYPE="T " S MUNT= "C",MRES=$ J(X-32*5/9 ,0,1) ;EN1 ^GMRVUTL
	11767	"RTN","HMP DJ02",288, 0)
	11768	I TYPE="H T" S MUNT= "cm",MRES= $J(2.54*X, 0,2) ;EN2 ^GMRVUTL
	11769	"RTN","HMP DJ02",289, 0)
	11770	I TYPE="W T" S MUNT= "kg",MRES= $J(X/2.2,0 ,2) ;EN3 ^GMRVUTL
	11771	"RTN","HMP DJ02",290, 0)
	11772	I TYPE="C G" S MUNT= "cm",MRES= $J(2.54*X, 0,2)
	11773	"RTN","HMP DJ02",291, 0)
	11774	S:MRES VI T("metricR esult")=MR ES,VIT("me tricUnits" )=MUNT
	11775	"RTN","HMP DJ02",292, 0)
	11776	S X=$$RAN GE^HMPDGMV (TYPE) I $ L(X) S VIT ("high")=$ P(X,U),VIT ("low")=$P (X,U,2)
	11777	"RTN","HMP DJ02",293, 0)
	11778	S VIT("su mmary")=VI T("typeNam e")_" "_VI T("result" )_" "_VIT( "units")
	11779	"RTN","HMP DJ02",294, 0)
	11780	F I=1:1:$ L(HMPY(5), U) S X=$P( HMPY(5),U, I) I X D
	11781	"RTN","HMP DJ02",295, 0)
	11782	. S VIT(" qualifiers ",I,"name" )=$$FIELD^ GMVGETQL(X ,1)
	11783	"RTN","HMP DJ02",296, 0)
	11784	. S VIT(" qualifiers ",I,"vuid" )=$$FIELD^ GMVGETQL(X ,3)
	11785	"RTN","HMP DJ02",297, 0)
	11786	;US4338 - add pulse ox qualif ier if it exists. na me compone nt is requ ired. vuid is not pe r Thomas L oth
	11787	"RTN","HMP DJ02",298, 0)
	11788	I $P(X0,U ,10) S VIT ("qualifie rs",I+1,"n ame")=$P(X 0,U,10)
	11789	"RTN","HMP DJ02",299, 0)
	11790	I $G(HMPY (2)) S VIT ("removed" )="true" ;ent ered in er ror
	11791	"RTN","HMP DJ02",300, 0)
	11792	S LOC=+$P (X0,U,5),F AC=$$FAC^H MPD(LOC)
	11793	"RTN","HMP DJ02",301, 0)
	11794	S VIT("lo cationUid" )=$$SETUID ^HMPUTILS( "location" ,,LOC)
	11795	"RTN","HMP DJ02",302, 0)
	11796	S VIT("lo cationName ")=$S(LOC: $$GET1^DIQ (44,LOC_", ",.01),1:" unknown") ;DE2818, ICR 10040
	11797	"RTN","HMP DJ02",303, 0)
	11798	N USERID S USERID=$ P(HMPY(0), U,6)
	11799	"RTN","HMP DJ02",304, 0)
	11800	I $G(USER ID) D
	11801	"RTN","HMP DJ02",305, 0)
	11802	. S VIT(" enteredByU id")=$$SET UID^HMPUTI LS("user", ,USERID)
	11803	"RTN","HMP DJ02",306, 0)
	11804	. S VIT(" enteredByN ame")=$$GE T1^DIQ(200 ,USERID_", ",.01) ;D E2818, ICR 10060
	11805	"RTN","HMP DJ02",307, 0)
	11806	D FACILIT Y^HMPUTILS (FAC,"VIT" )
	11807	"RTN","HMP DJ02",308, 0)
	11808	S VIT("la stUpdateTi me")=$$EN^ HMPSTMP("v ital")
	11809	"RTN","HMP DJ02",309, 0)
	11810	S VIT("st ampTime")= VIT("lastU pdateTime" ) ; RHL 20 141231
	11811	"RTN","HMP DJ02",310, 0)
	11812	;US6734 - pre-compi le metasta mp
	11813	"RTN","HMP DJ02",311, 0)
	11814	I $G(HMPM ETA) D ADD ^HMPMETA(" vital",VIT ("uid"),VI T("stampTi me")) Q:HM PMETA=1 ; US6734,US1 1019
	11815	"RTN","HMP DJ02",312, 0)
	11816	D ADD^HMP DJ("VIT"," vital")
	11817	"RTN","HMP DJ02",313, 0)
	11818	Q
	11819	"RTN","HMP DJ02",314, 0)
	11820	;
	11821	"RTN","HMP DJ02",315, 0)
	11822	HMP(COLL) ; -- HMP P atient Obj ects
	11823	"RTN","HMP DJ02",316, 0)
	11824	N ID I $L ($G(HMPID) ) D Q
	11825	"RTN","HMP DJ02",317, 0)
	11826	. S ID=+H MPID I 'ID S ID=+$O( ^HMP(80000 0.1,"B",HM PID,0)) ;I EN or UID
	11827	"RTN","HMP DJ02",318, 0)
	11828	. D:ID HM P1(800000. 1,ID)
	11829	"RTN","HMP DJ02",319, 0)
	11830	Q:$G(COLL )="" ;err or
	11831	"RTN","HMP DJ02",320, 0)
	11832	S ID=0 F S ID=$O(^ HMP(800000 .1,"C",DFN ,COLL,ID)) Q:ID<1 D HMP1(8000 00.1,ID)
	11833	"RTN","HMP DJ02",321, 0)
	11834	Q
	11835	"RTN","HMP DJ02",322, 0)
	11836	HMP1(FNUM, ID) ; -- [ patient] o bject
	11837	"RTN","HMP DJ02",323, 0)
	11838	N I,X,HMP Y
	11839	"RTN","HMP DJ02",324, 0)
	11840	N $ES,$ET ,ERRPAT,ER RMSG
	11841	"RTN","HMP DJ02",325, 0)
	11842	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=$G(DF N)
	11843	"RTN","HMP DJ02",326, 0)
	11844	S ERRMSG= "A problem occurred retreiving record "_ ID_" for t he HMP dom ain"
	11845	"RTN","HMP DJ02",327, 0)
	11846	S I=0 F S I=$O(^HM P(FNUM,ID, 1,I)) Q:I< 1 S X=$G( ^(I,0)),HM PY(I)=X
	11847	"RTN","HMP DJ02",328, 0)
	11848	I $D(HMPY ) D ;alre ady encode d JSON
	11849	"RTN","HMP DJ02",329, 0)
	11850	. S HMPI= HMPI+1 S:H MPI>1 @HMP @(HMPI,.3) =","
	11851	"RTN","HMP DJ02",330, 0)
	11852	. M @HMP@ (HMPI)=HMP Y
	11853	"RTN","HMP DJ02",331, 0)
	11854	. ; -- ch unk data i f from DQI NIT^HMPDJF SP ; i.e. HMPCHNK de fined ;S6 8-JCH
	11855	"RTN","HMP DJ02",332, 0)
	11856	. D CHNKC HK^HMPDJFS P(.HMP,.HM PI) ;S68- JCH
	11857	"RTN","HMP DJ02",333, 0)
	11858	Q
	11859	"RTN","HMP DJ03")
	11860	0^36^B9773 9485
	11861	"RTN","HMP DJ03",1,0)
	11862	HMPDJ03 ;S LC/MKB,ASM R/RRB - Co nsults,Cli nProcedure s,CLiO;Nov 09, 2015 13:00:03
	11863	"RTN","HMP DJ03",2,0)
	11864	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	11865	"RTN","HMP DJ03",3,0)
	11866	;Per VA D irective 6 402, this routine sh ould not b e modified .
	11867	"RTN","HMP DJ03",4,0)
	11868	;
	11869	"RTN","HMP DJ03",5,0)
	11870	; Externa l Referenc es DBIA#
	11871	"RTN","HMP DJ03",6,0)
	11872	; ------- ---------- -- -----
	11873	"RTN","HMP DJ03",7,0)
	11874	; ^SC( 10040
	11875	"RTN","HMP DJ03",8,0)
	11876	; ^TIU(89 25.1 5677
	11877	"RTN","HMP DJ03",9,0)
	11878	; ^VA(200 10060
	11879	"RTN","HMP DJ03",10,0 )
	11880	; %DT 10003
	11881	"RTN","HMP DJ03",11,0 )
	11882	; DILFD 2055
	11883	"RTN","HMP DJ03",12,0 )
	11884	; DIQ 2056
	11885	"RTN","HMP DJ03",13,0 )
	11886	; GMRCAPI 6082
	11887	"RTN","HMP DJ03",14,0 )
	11888	; GMRCGUI B 2980
	11889	"RTN","HMP DJ03",15,0 )
	11890	; GMRCSLM 1,^TMP("GM RCR" 2740
	11891	"RTN","HMP DJ03",16,0 )
	11892	; MCARUTL 3 3280
	11893	"RTN","HMP DJ03",17,0 )
	11894	; MDPS1,^ TMP("MDHSP " 4230
	11895	"RTN","HMP DJ03",18,0 )
	11896	; ORX8 2467
	11897	"RTN","HMP DJ03",19,0 )
	11898	; TIULQ 2693
	11899	"RTN","HMP DJ03",20,0 )
	11900	; TIUSRVL O 2834
	11901	"RTN","HMP DJ03",21,0 )
	11902	; XLFSTR 10104
	11903	"RTN","HMP DJ03",22,0 )
	11904	; XUAF4 2171
	11905	"RTN","HMP DJ03",23,0 )
	11906	;
	11907	"RTN","HMP DJ03",24,0 )
	11908	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	11909	"RTN","HMP DJ03",25,0 )
	11910	Q
	11911	"RTN","HMP DJ03",26,0 )
	11912	;
	11913	"RTN","HMP DJ03",27,0 )
	11914	GMRC1(ID) ; -- consu lt/request HMPX=^TMP ("GMRCR",$ J,"CS",HMP N,0)
	11915	"RTN","HMP DJ03",28,0 )
	11916	N CONS,OR DER,HMPD,X 0,X,HMPA,D A,ACT0,ACT 2,ACT3,ACT ,HMPEASON, HMPJ,HMPTI U
	11917	"RTN","HMP DJ03",29,0 )
	11918	N $ES,$ET ,ERRPAT,ER RMSG
	11919	"RTN","HMP DJ03",30,0 )
	11920	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	11921	"RTN","HMP DJ03",31,0 )
	11922	S ERRMSG= "A problem occurred converting record "_ ID_" for t he consult s domain"
	11923	"RTN","HMP DJ03",32,0 )
	11924	;
	11925	"RTN","HMP DJ03",33,0 )
	11926	S CONS("l ocalId")=+ HMPX,CONS( "uid")=$$S ETUID^HMPU TILS("cons ult",DFN,+ HMPX)
	11927	"RTN","HMP DJ03",34,0 )
	11928	S CONS("d ateTime")= $$JSONDT^H MPUTILS($P (HMPX,U,2) )
	11929	"RTN","HMP DJ03",35,0 )
	11930	S CONS("s tatusName" )=$P(HMPX, U,3),CONS( "service") =$P(HMPX,U ,4)
	11931	"RTN","HMP DJ03",36,0 )
	11932	S CONS("c onsultProc edure")=$P (HMPX,U,5)
	11933	"RTN","HMP DJ03",37,0 )
	11934	I $P(HMPX ,U,6)="*" S CONS("in terpretati on")="SIGN IFICANT FI NDINGS"
	11935	"RTN","HMP DJ03",38,0 )
	11936	S CONS("t ypeName")= $P(HMPX,U, 7),CONS("c ategory")= $P(HMPX,U, 9)
	11937	"RTN","HMP DJ03",39,0 )
	11938	S ORDER=+ $P(HMPX,U, 8),CONS("o rderName") =$P($$OI^O RX8(ORDER) ,U,2)
	11939	"RTN","HMP DJ03",40,0 )
	11940	S CONS("o rderUid")= $$SETUID^H MPUTILS("o rder",DFN, ORDER)
	11941	"RTN","HMP DJ03",41,0 )
	11942	D GET^GMR CAPI(.HMPD ,+HMPX) S X0=$G(HMPD (0)) ;=^GM R(123,ID,0 )
	11943	"RTN","HMP DJ03",42,0 )
	11944	S X=$P(X0 ,U,6) S:X CONS("from Service")= $$GET1^DIQ (44,X_",", .01) ;DE2 818
	11945	"RTN","HMP DJ03",43,0 )
	11946	S X=$P(X0 ,U,9) S:X] "" CONS("u rgency")=X
	11947	"RTN","HMP DJ03",44,0 )
	11948	S X=$P(X0 ,U,10) S:X ]"" CONS(" place")=X
	11949	"RTN","HMP DJ03",45,0 )
	11950	S X=$P(X0 ,U,11) S:X CONS("att ention")=$ $GET1^DIQ( 200,X_",", .01) ;DE2 818
	11951	"RTN","HMP DJ03",46,0 )
	11952	S X=$P(X0 ,U,13) S:X ]"" CONS(" lastAction ")=X
	11953	"RTN","HMP DJ03",47,0 )
	11954	S X=$P(X0 ,U,14) I X D ;order ing provid er
	11955	"RTN","HMP DJ03",48,0 )
	11956	. S CONS( "providerU id")=$$SET UID^HMPUTI LS("user", ,+X)
	11957	"RTN","HMP DJ03",49,0 )
	11958	. S CONS( "providerN ame")=$$GE T1^DIQ(200 ,X_",",.01 ) ;DE2818
	11959	"RTN","HMP DJ03",50,0 )
	11960	S X=$P(X0 ,U,18) I $ L(X) D
	11961	"RTN","HMP DJ03",51,0 )
	11962	. S CONS( "patientCl assCode")= "urn:va:pa tient-clas s:"_$S(X=" I":"IMP",1 :"AMB")
	11963	"RTN","HMP DJ03",52,0 )
	11964	. S CONS( "patientCl assName")= $S(X="I":" Inpatient" ,1:"Ambula tory")
	11965	"RTN","HMP DJ03",53,0 )
	11966	S X=+$P(X 0,U,24) S: X CONS("ea rliestDate ")=$$JSOND T^HMPUTILS (X)
	11967	"RTN","HMP DJ03",54,0 )
	11968	I $P(HMPX ,U,9)="M" S CONS("cl inicalProc edure")=$G (HMPD(1))
	11969	"RTN","HMP DJ03",55,0 )
	11970	I $D(HMPD (20)) M HM PEASON=HMP D(20) S CO NS("reason ")=$$STRIN G^HMPD(.HM PEASON)
	11971	"RTN","HMP DJ03",56,0 )
	11972	S X=$G(HM PD(30)) S: $L(X) CONS ("provisio nalDx")=X
	11973	"RTN","HMP DJ03",57,0 )
	11974	;
	11975	"RTN","HMP DJ03",58,0 )
	11976	I $P(X0,U ,23) D ;i nter-facil ity
	11977	"RTN","HMP DJ03",59,0 )
	11978	. N IFC S X=$$NS^XU AF4($P(X0, U,23))
	11979	"RTN","HMP DJ03",60,0 )
	11980	. S CONS( "remote"," facilityCo de")=$P(X, U,2),CONS( "remote"," facilityNa me")=$P(X, U)
	11981	"RTN","HMP DJ03",61,0 )
	11982	. S:$P(X0 ,U,22) CON S("remote" ,"id")=$P( X0,U,22)
	11983	"RTN","HMP DJ03",62,0 )
	11984	. S IFC=$ $IFC^GMRCA PI(ID)
	11985	"RTN","HMP DJ03",63,0 )
	11986	. S X=$P( IFC,U) S:$ L(X) CONS( "remote"," service")= X
	11987	"RTN","HMP DJ03",64,0 )
	11988	. S X=$P( IFC,U,5) S :$L(X) CON S("remote" ,"role")=$ S(X="P":"R equesting facility", 1:"Consult ing facili ty")
	11989	"RTN","HMP DJ03",65,0 )
	11990	. S CONS( "remote"," providerNa me")=$P(IF C,U,6)
	11991	"RTN","HMP DJ03",66,0 )
	11992	. S X=$P( IFC,U,2) S :$L(X) CON S("remote" ,"provider phone")=X
	11993	"RTN","HMP DJ03",67,0 )
	11994	. S X=$P( IFC,U,3) S :$L(X) CON S("remote" ,"provider pager")=X
	11995	"RTN","HMP DJ03",68,0 )
	11996	;
	11997	"RTN","HMP DJ03",69,0 )
	11998	D ACT^GMR CAPI(.HMPA ,ID)
	11999	"RTN","HMP DJ03",70,0 )
	12000	S DA=0 F S DA=$O(H MPA(DA)) Q :DA<1 D
	12001	"RTN","HMP DJ03",71,0 )
	12002	. S ACT0= $G(HMPA(DA ,0)),ACT2= $G(HMPA(DA ,2)),ACT3= $G(HMPA(DA ,3)) K ACT
	12003	"RTN","HMP DJ03",72,0 )
	12004	. I $L(AC T2),$P(X0, U,23) S X= $$NS^XUAF4 ($P(X0,U,2 3)),ACT("f acilityCod e")=$P(X,U ,2),ACT("f acilityNam e")=$P(X,U )
	12005	"RTN","HMP DJ03",73,0 )
	12006	. S ACT(" name")=$P( ACT0,U,2)
	12007	"RTN","HMP DJ03",74,0 )
	12008	. S ACT(" entered")= $$JSONDT^H MPUTILS($P (ACT0,U))
	12009	"RTN","HMP DJ03",75,0 )
	12010	. S ACT(" dateTime") =$$JSONDT^ HMPUTILS($ P(ACT0,U,3 ))
	12011	"RTN","HMP DJ03",76,0 )
	12012	. S:$L($P (ACT2,U,3) ) ACT("tim eZone")=$P (ACT2,U,3)
	12013	"RTN","HMP DJ03",77,0 )
	12014	. I $L(AC T2) S ACT( "enteredBy ")=$P(ACT2 ,U),ACT("r esponsible ")=$P(ACT2 ,U,2)
	12015	"RTN","HMP DJ03",78,0 )
	12016	. E D ; remote vs. local use rs
	12017	"RTN","HMP DJ03",79,0 )
	12018	.. S X=+$ P(ACT0,U,4 ) S:X ACT( "responsib le")=$$GET 1^DIQ(200, X_",",.01) ;DE2818
	12019	"RTN","HMP DJ03",80,0 )
	12020	.. S X=+$ P(ACT0,U,5 ) S:X ACT( "enteredBy ")=$$GET1^ DIQ(200,X_ ",",.01) ;DE2818
	12021	"RTN","HMP DJ03",81,0 )
	12022	. S X=$S( $L(ACT3):A CT3,1:$P(A CT0,U,6)) S:$L(X) AC T("forward edFrom")=X
	12023	"RTN","HMP DJ03",82,0 )
	12024	. S X=$P( ACT0,U,7) S:X ACT("p reviousAtt ention")=$ $GET1^DIQ( 200,X_",", .01) ;DE2 818
	12025	"RTN","HMP DJ03",83,0 )
	12026	. S X=$P( ACT0,U,8) S:X ACT("d evice")=$$ GET1^DIQ(3 .5,X_",",. 01)
	12027	"RTN","HMP DJ03",84,0 )
	12028	. S X=$P( ACT0,U,9) I X,X["TIU " S ACT("r esultUid") =$$SETUID^ HMPUTILS(" document", DFN,+X)
	12029	"RTN","HMP DJ03",85,0 )
	12030	. I $D(HM PA(DA,1)) M HMPEASON =HMPA(DA,1 ) S ACT("c omment")=$ $STRING^HM PD(.HMPEAS ON)
	12031	"RTN","HMP DJ03",86,0 )
	12032	. M CONS( "activity" ,DA)=ACT
	12033	"RTN","HMP DJ03",87,0 )
	12034	;
	12035	"RTN","HMP DJ03",88,0 )
	12036	S HMPJ=0 F S HMPJ= $O(HMPD(50 ,HMPJ)) Q: HMPJ<1 S X=$G(HMPD( 50,HMPJ)) D
	12037	"RTN","HMP DJ03",89,0 )
	12038	. Q:'$D(@ (U_$P(X,"; ",2)_+X_") ")) ;text deleted
	12039	"RTN","HMP DJ03",90,0 )
	12040	. S CONS( "results", HMPJ,"uid" )=$$SETUID ^HMPUTILS( "document" ,DFN,+X)
	12041	"RTN","HMP DJ03",91,0 )
	12042	. D EXTRA CT^TIULQ(+ X,"HMPTIU" ,,.01)
	12043	"RTN","HMP DJ03",92,0 )
	12044	. S CONS( "results", HMPJ,"loca lTitle")=$ G(HMPTIU(+ X,.01,"E") )
	12045	"RTN","HMP DJ03",93,0 )
	12046	S X=$P(X0 ,U,21),X=$ S(X:$$STA^ XUAF4(X)_U _$P($$NS^X UAF4(X),U) ,1:$$FAC^H MPD)
	12047	"RTN","HMP DJ03",94,0 )
	12048	D FACILIT Y^HMPUTILS (X,"CONS")
	12049	"RTN","HMP DJ03",95,0 )
	12050	S CONS("l astUpdateT ime")=$$EN ^HMPSTMP(" consult")
	12051	"RTN","HMP DJ03",96,0 )
	12052	S CONS("s tampTime") =CONS("las tUpdateTim e") ; RHL 20141231
	12053	"RTN","HMP DJ03",97,0 )
	12054	;US6734 - pre-compi le metasta mp
	12055	"RTN","HMP DJ03",98,0 )
	12056	I $G(HMPM ETA) D ADD ^HMPMETA(" consult",C ONS("uid") ,CONS("sta mpTime")) Q:HMPMETA= 1 ;US6734 ,US11019
	12057	"RTN","HMP DJ03",99,0 )
	12058	D ADD^HMP DJ("CONS", "consult")
	12059	"RTN","HMP DJ03",100, 0)
	12060	Q
	12061	"RTN","HMP DJ03",101, 0)
	12062	;
	12063	"RTN","HMP DJ03",102, 0)
	12064	MDPS1(DFN, BEG,END,MA X) ; -- pe rform CP s earch (sco pe variabl es)
	12065	"RTN","HMP DJ03",103, 0)
	12066	N MCARCOD E,MCARDT,M CARPROC,MC ESKEY,MCES SEC,MCFILE ,MDC,MDIMG ,RES
	12067	"RTN","HMP DJ03",104, 0)
	12068	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	12069	"RTN","HMP DJ03",105, 0)
	12070	K ^TMP("M DHSP",$J) S RES=""
	12071	"RTN","HMP DJ03",106, 0)
	12072	D EN1^MDP S1(.RES,DF N,BEG,END, MAX,"",0) ;RES=^TMP( "MDHSP",$J )
	12073	"RTN","HMP DJ03",107, 0)
	12074	Q
	12075	"RTN","HMP DJ03",108, 0)
	12076	;
	12077	"RTN","HMP DJ03",109, 0)
	12078	MC1(ID) ; -- clinica l procedur e HMPX=^TM P("MDHSP", $J,HMPN)
	12079	"RTN","HMP DJ03",110, 0)
	12080	N X,Y,%DT ,DATE,RTN, GBL,CONS,T IUN,HMPD,X 0,PROC,HMP T,LOC,FAC
	12081	"RTN","HMP DJ03",111, 0)
	12082	N $ES,$ET ,ERRPAT,ER RMSG
	12083	"RTN","HMP DJ03",112, 0)
	12084	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	12085	"RTN","HMP DJ03",113, 0)
	12086	S ERRMSG= "A problem occurred converting record "_ ID_" for t he clinica l procedur e domain"
	12087	"RTN","HMP DJ03",114, 0)
	12088	;
	12089	"RTN","HMP DJ03",115, 0)
	12090	S RTN=$P( HMPX,U,3,4 ) Q:RTN="P RPRO^MDPS4 " ;skip n on-CP item s
	12091	"RTN","HMP DJ03",116, 0)
	12092	S X=$P(HM PX,U,6),%D T="TXS" D ^%DT Q:Y'> 0 S DATE= Y
	12093	"RTN","HMP DJ03",117, 0)
	12094	S GBL=+$P (HMPX,U,2) _";"_$S(RT N="PR702^M DPS1":"MDD (702,",1:$ $ROOT^HMPD MC(DFN,$P( HMPX,U,11) ,DATE))
	12095	"RTN","HMP DJ03",118, 0)
	12096	Q:'GBL I $G(ID),ID '=GBL Q ;unknow n, or not requested
	12097	"RTN","HMP DJ03",119, 0)
	12098	;
	12099	"RTN","HMP DJ03",120, 0)
	12100	S CONS=+$ P(HMPX,U,1 3) D:CONS DOCLIST^GM RCGUIB(.HM PD,CONS) S X0=$G(HMP D(0)) ;=^G MR(123,ID, 0)
	12101	"RTN","HMP DJ03",121, 0)
	12102	S TIUN=+$ P(HMPX,U,1 4) S:TIUN TIUN=TIUN_ U_$$RESOLV E^TIUSRVLO (TIUN)
	12103	"RTN","HMP DJ03",122, 0)
	12104	S PROC("l ocalId")=G BL,PROC("c ategory")= "CP"
	12105	"RTN","HMP DJ03",123, 0)
	12106	S PROC("u id")=$$SET UID^HMPUTI LS("proced ure",DFN,G BL)
	12107	"RTN","HMP DJ03",124, 0)
	12108	S PROC("n ame")=$P(H MPX,U),PRO C("dateTim e")=$$JSON DT^HMPUTIL S(DATE)
	12109	"RTN","HMP DJ03",125, 0)
	12110	S X=$P(HM PX,U,7) S: $L(X) PROC ("interpre tation")=X
	12111	"RTN","HMP DJ03",126, 0)
	12112	S PROC("k ind")="Pro cedure"
	12113	"RTN","HMP DJ03",127, 0)
	12114	I CONS,X0 D
	12115	"RTN","HMP DJ03",128, 0)
	12116	. N HMPJ S PROC("re quested")= $$JSONDT^H MPUTILS(+X 0)
	12117	"RTN","HMP DJ03",129, 0)
	12118	. S PROC( "consultUi d")=$$SETU ID^HMPUTIL S("consult ",DFN,CONS )
	12119	"RTN","HMP DJ03",130, 0)
	12120	. S PROC( "orderUid" )=$$SETUID ^HMPUTILS( "order",DF N,+$P(X0,U ,3))
	12121	"RTN","HMP DJ03",131, 0)
	12122	. S PROC( "statusNam e")=$$EXTE RNAL^DILFD (123,8,,$P (X0,U,12))
	12123	"RTN","HMP DJ03",132, 0)
	12124	. S HMPJ= 0 F S HMP J=$O(HMPD( 50,HMPJ)) Q:HMPJ<1 S X=+$G(HM PD(50,HMPJ )) D
	12125	"RTN","HMP DJ03",133, 0)
	12126	.. D NOTE (X)
	12127	"RTN","HMP DJ03",134, 0)
	12128	.. S:'TIU N TIUN=X_U _$$RESOLVE ^TIUSRVLO( X)
	12129	"RTN","HMP DJ03",135, 0)
	12130	I TIUN D
	12131	"RTN","HMP DJ03",136, 0)
	12132	. S X=$P( TIUN,U,5) I X D
	12133	"RTN","HMP DJ03",137, 0)
	12134	.. S PROC ("provider s",1,"prov iderUid")= $$SETUID^H MPUTILS("u ser",,+X)
	12135	"RTN","HMP DJ03",138, 0)
	12136	.. S PROC ("provider s",1,"prov iderName") =$P(X,";", 3)
	12137	"RTN","HMP DJ03",139, 0)
	12138	. S:$P(TI UN,U,11) P ROC("hasIm ages")="tr ue"
	12139	"RTN","HMP DJ03",140, 0)
	12140	. K HMPT D EXTRACT^ TIULQ(+TIU N,"HMPT",, ".03;.05;1 211",,,"I" )
	12141	"RTN","HMP DJ03",141, 0)
	12142	. S X=+$G (HMPT(+TIU N,.03,"I") ),PROC("en counterUid ")=$$SETUI D^HMPUTILS ("visit",D FN,X)
	12143	"RTN","HMP DJ03",142, 0)
	12144	. S LOC=+ $G(HMPT(+T IUN,1211," I")) I LOC S LOC=LOC _U_$$GET1^ DIQ(44,LOC _",",.01) ;DE2818
	12145	"RTN","HMP DJ03",143, 0)
	12146	. E S X= $P(TIUN,U, 6) S:$L(X) LOC=+$O(^ SC("B",X,0 ))_U_X ; DE2818, IC R 10040
	12147	"RTN","HMP DJ03",144, 0)
	12148	. S:LOC P ROC("locat ionUid")=$ $SETUID^HM PUTILS("lo cation",,+ LOC),PROC( "locationN ame")=$P(L OC,U,2),FA C=$$FAC^HM PD(+LOC)
	12149	"RTN","HMP DJ03",145, 0)
	12150	. I '$D(P ROC("statu sName")) S X=+$G(HMP T(+TIUN,.0 5,"I")),PR OC("status Name")=$S( X<6:"PARTI AL RESULTS ",1:"COMPL ETE")
	12151	"RTN","HMP DJ03",146, 0)
	12152	. I '$G(P ROC("resul ts",+TIUN) ) D NOTE(+ TIUN)
	12153	"RTN","HMP DJ03",147, 0)
	12154	; if no c onsult or note/visit ...
	12155	"RTN","HMP DJ03",148, 0)
	12156	S:'$D(PRO C("statusN ame")) PRO C("statusN ame")="COM PLETE"
	12157	"RTN","HMP DJ03",149, 0)
	12158	I '$D(FAC ) S X=$P(X 0,U,21),FA C=$S(X:$$S TA^XUAF4(X )_U_$P($$N S^XUAF4(X) ,U),1:$$FA C^HMPD)
	12159	"RTN","HMP DJ03",150, 0)
	12160	D FACILIT Y^HMPUTILS (FAC,"PROC ")
	12161	"RTN","HMP DJ03",151, 0)
	12162	S PROC("l astUpdateT ime")=$$EN ^HMPSTMP(" procedure" )
	12163	"RTN","HMP DJ03",152, 0)
	12164	S PROC("s tampTime") =PROC("las tUpdateTim e") ; RHL 20141231
	12165	"RTN","HMP DJ03",153, 0)
	12166	;US6734 - pre-compi le metasta mp
	12167	"RTN","HMP DJ03",154, 0)
	12168	I $G(HMPM ETA) D ADD ^HMPMETA(" procedure" ,PROC("uid "),PROC("s tampTime") ) Q:HMPMET A=1 ;US67 34,US11019
	12169	"RTN","HMP DJ03",155, 0)
	12170	D ADD^HMP DJ("PROC", "procedure ")
	12171	"RTN","HMP DJ03",156, 0)
	12172	Q
	12173	"RTN","HMP DJ03",157, 0)
	12174	;
	12175	"RTN","HMP DJ03",158, 0)
	12176	NOTE(DA) ; -- add TI U note inf o
	12177	"RTN","HMP DJ03",159, 0)
	12178	N HMPT,TE XT
	12179	"RTN","HMP DJ03",160, 0)
	12180	D EXTRACT ^TIULQ(DA, "HMPT",,.0 1)
	12181	"RTN","HMP DJ03",161, 0)
	12182	S PROC("r esults",DA ,"uid")=$$ SETUID^HMP UTILS("doc ument",+$G (DFN),DA)
	12183	"RTN","HMP DJ03",162, 0)
	12184	S PROC("r esults",DA ,"localTit le")=$G(HM PT(DA,.01, "E"))
	12185	"RTN","HMP DJ03",163, 0)
	12186	Q
	12187	"RTN","HMP DJ03",164, 0)
	12188	;
	12189	"RTN","HMP DJ03",165, 0)
	12190	MDC1(ID) ; -- clinic al observa tion
	12191	"RTN","HMP DJ03",166, 0)
	12192	N GUID,CL IO,HMPC,HM PT,LOC,FAC ,I,X,Y
	12193	"RTN","HMP DJ03",167, 0)
	12194	S GUID=$G (ID) Q:GUI D="" ;inv alid GUID
	12195	"RTN","HMP DJ03",168, 0)
	12196	D QRYOBS^ HMPDMDC("H MPC",GUID) Q:'$D(HMP C) ;doesn 't exist
	12197	"RTN","HMP DJ03",169, 0)
	12198	Q:$L($G(H MPC("PAREN T_ID","E") )) ;PAREN T also in list
	12199	"RTN","HMP DJ03",170, 0)
	12200	N $ES,$ET ,ERRPAT,ER RMSG
	12201	"RTN","HMP DJ03",171, 0)
	12202	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	12203	"RTN","HMP DJ03",172, 0)
	12204	S ERRMSG= "A problem occurred converting record "_ ID_" for t he clinica l observat ion domain "
	12205	"RTN","HMP DJ03",173, 0)
	12206	;
	12207	"RTN","HMP DJ03",174, 0)
	12208	S CLIO("l ocalId")=G UID,CLIO(" uid")=$$SE TUID^HMPUT ILS("obs", DFN,GUID)
	12209	"RTN","HMP DJ03",175, 0)
	12210	S X=$G(HM PC("TERM_I D","I")) S :X CLIO("t ypeVuid")= "urn:va:vu id:"_X
	12211	"RTN","HMP DJ03",176, 0)
	12212	S CLIO("t ypeCode")= "urn:va:cl ioterminol ogy:"_$G(H MPC("TERM_ ID","GUID" ))
	12213	"RTN","HMP DJ03",177, 0)
	12214	S CLIO("t ypeName")= $G(HMPC("T ERM_ID","E "))
	12215	"RTN","HMP DJ03",178, 0)
	12216	S CLIO("r esult")=$G (HMPC("SVA LUE","E"))
	12217	"RTN","HMP DJ03",179, 0)
	12218	S X=$G(HM PC("UNIT_I D","ABBV") ) S:$L(X) CLIO("unit s")=X
	12219	"RTN","HMP DJ03",180, 0)
	12220	S X=$G(HM PC("ENTERE D_DATE_TIM E","I")),C LIO("enter ed")=$$JSO NDT^HMPUTI LS(X)
	12221	"RTN","HMP DJ03",181, 0)
	12222	S X=$G(HM PC("OBSERV ED_DATE_TI ME","I")), CLIO("obse rved")=$$J SONDT^HMPU TILS(X)
	12223	"RTN","HMP DJ03",182, 0)
	12224	D QRYTYPE S^HMPDMDC( "HMPT")
	12225	"RTN","HMP DJ03",183, 0)
	12226	F I=3,5 S X=$G(HMPT (I,"XML")) I $L($G(H MPC(X,"E") )) D
	12227	"RTN","HMP DJ03",184, 0)
	12228	. S Y=HMP T(I,"NAME" ),Y=$S(Y=" LOCATION": "bodySite" ,1:$$LOW^X LFSTR(Y))
	12229	"RTN","HMP DJ03",185, 0)
	12230	. S CLIO( Y_"Code")= HMPC(X,"I" ),CLIO(Y_" Name")=HMP C(X,"E")
	12231	"RTN","HMP DJ03",186, 0)
	12232	F I=4,6,7 S X=$G(HM PT(I,"XML" )) I $L($G (HMPC(X,"E "))) D
	12233	"RTN","HMP DJ03",187, 0)
	12234	. S CLIO( "qualifier s",I,"type ")=$$LOW^X LFSTR(HMPT (I,"NAME") )
	12235	"RTN","HMP DJ03",188, 0)
	12236	. S CLIO( "qualifier s",I,"code ")=HMPC(X, "I")
	12237	"RTN","HMP DJ03",189, 0)
	12238	. S CLIO( "qualifier s",I,"name ")=HMPC(X, "E")
	12239	"RTN","HMP DJ03",190, 0)
	12240	S X=$G(HM PC("RANGE" ,"E")) I $ L(X) D
	12241	"RTN","HMP DJ03",191, 0)
	12242	. S Y=$S( X="Out of Bounds Low ":"<",X="O ut of Boun ds High":" >",1:$E(X) )
	12243	"RTN","HMP DJ03",192, 0)
	12244	. S CLIO( "interpret ationCode" )="urn:hl7 :observati on-interpr etation:"_ Y
	12245	"RTN","HMP DJ03",193, 0)
	12246	. S CLIO( "interpret ationName" )=$S(X="<" :"Low off scale",X=" >":"High o ff scale", 1:X)
	12247	"RTN","HMP DJ03",194, 0)
	12248	; X=$G(HM PC("STATUS ","E")) S: $L(X) CLIO ("resultSt atus")=$S( X="unverif ied":"acti ve",1:"com plete")
	12249	"RTN","HMP DJ03",195, 0)
	12250	I $D(HMPC ("SUPP_PAG E")) D ;a dd set inf o
	12251	"RTN","HMP DJ03",196, 0)
	12252	. S CLIO( "setID")=$ G(HMPC("SU PP_PAGE"," GUID"))
	12253	"RTN","HMP DJ03",197, 0)
	12254	. S CLIO( "setName") =$G(HMPC(" SUPP_PAGE" ,"DISPLAY_ NAME"))
	12255	"RTN","HMP DJ03",198, 0)
	12256	. S X=$G( HMPC("SUPP _PAGE","TY PE")) S:$L (X) CLIO(" setType")= X
	12257	"RTN","HMP DJ03",199, 0)
	12258	. S X=$G( HMPC("SUPP _PAGE","AC TIVATED_DA TE_TIME")) S:X CLIO( "setStart" )=$$JSONDT ^HMPUTILS( X)
	12259	"RTN","HMP DJ03",200, 0)
	12260	. S X=$G( HMPC("SUPP _PAGE","DE ACTIVATED_ DATE_TIME" )) S:X CLI O("setStop ")=$$JSOND T^HMPUTILS (X)
	12261	"RTN","HMP DJ03",201, 0)
	12262	S CLIO("s tatusCode" )="urn:va: observatio n-status:c omplete",C LIO("statu sName")="c omplete"
	12263	"RTN","HMP DJ03",202, 0)
	12264	S LOC=$G( HMPC("HOSP ITAL_LOCAT ION_ID","I ")),FAC=$$ FAC^HMPD(L OC)
	12265	"RTN","HMP DJ03",203, 0)
	12266	S CLIO("l ocationUid ")=$$SETUI D^HMPUTILS ("location ",,LOC)
	12267	"RTN","HMP DJ03",204, 0)
	12268	S CLIO("l ocationNam e")=$G(HMP C("HOSPITA L_LOCATION _ID","E"))
	12269	"RTN","HMP DJ03",205, 0)
	12270	D FACILIT Y^HMPUTILS (FAC,"CLIO ")
	12271	"RTN","HMP DJ03",206, 0)
	12272	S X=$G(HM PC("COMMEN T","E")) S :$L(X) CLI O("comment ")=X
	12273	"RTN","HMP DJ03",207, 0)
	12274	S CLIO("l astUpdateT ime")=$$EN ^HMPSTMP(" obs") ; RH L 20141231
	12275	"RTN","HMP DJ03",208, 0)
	12276	S CLIO("s tampTime") =CLIO("las tUpdateTim e") ; RHL 20141231
	12277	"RTN","HMP DJ03",209, 0)
	12278	;US6734 - pre-compi le metasta mp
	12279	"RTN","HMP DJ03",210, 0)
	12280	I $G(HMPM ETA) D ADD ^HMPMETA(" obs",CLIO( "uid"),CLI O("stampTi me")) Q:HM PMETA=1 ; US6734,US1 1019
	12281	"RTN","HMP DJ03",211, 0)
	12282	D ADD^HMP DJ("CLIO", "obs")
	12283	"RTN","HMP DJ03",212, 0)
	12284	Q
	12285	"RTN","HMP DJ04")
	12286	0^37^B8621 9849
	12287	"RTN","HMP DJ04",1,0)
	12288	HMPDJ04 ;S LC/MKB,ASM R/RRB - Ap pointments ,Visits;No v 12, 2015 15:21:17
	12289	"RTN","HMP DJ04",2,0)
	12290	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	12291	"RTN","HMP DJ04",3,0)
	12292	;Per VA D irective 6 402, this routine sh ould not b e modified .
	12293	"RTN","HMP DJ04",4,0)
	12294	;
	12295	"RTN","HMP DJ04",5,0)
	12296	; Externa l Referenc es DBIA#
	12297	"RTN","HMP DJ04",6,0)
	12298	; ------- ---------- -- -----
	12299	"RTN","HMP DJ04",7,0)
	12300	; ^AUPNVS IT 2028
	12301	"RTN","HMP DJ04",8,0)
	12302	; ^DGS(41 .1 3796
	12303	"RTN","HMP DJ04",9,0)
	12304	; ^DIC(42 10039
	12305	"RTN","HMP DJ04",10,0 )
	12306	; ^SC 10040
	12307	"RTN","HMP DJ04",11,0 )
	12308	; ^VA(200 10060
	12309	"RTN","HMP DJ04",12,0 )
	12310	; DIQ 2056
	12311	"RTN","HMP DJ04",13,0 )
	12312	; ICPTCOD 1995
	12313	"RTN","HMP DJ04",14,0 )
	12314	; PXAPI,^ TMP("PXKEN C" 1894
	12315	"RTN","HMP DJ04",15,0 )
	12316	; SDAMA30 1 4433
	12317	"RTN","HMP DJ04",16,0 )
	12318	; XLFDT 10103
	12319	"RTN","HMP DJ04",17,0 )
	12320	; XUAF4 2171
	12321	"RTN","HMP DJ04",18,0 )
	12322	; EDP(230 6275
	12323	"RTN","HMP DJ04",19,0 )
	12324	;
	12325	"RTN","HMP DJ04",20,0 )
	12326	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	12327	"RTN","HMP DJ04",21,0 )
	12328	Q
	12329	"RTN","HMP DJ04",22,0 )
	12330	;
	12331	"RTN","HMP DJ04",23,0 )
	12332	SDAM1 ; -- appointme nt ^TMP($J ,"SDAMA301 ",DFN,HMPD T)
	12333	"RTN","HMP DJ04",24,0 )
	12334	N NODE,HL OC,APPT,X, STS,CLS,FA C,SV,PRV
	12335	"RTN","HMP DJ04",25,0 )
	12336	S NODE=$G (^TMP($J," SDAMA301", DFN,HMPDT) )
	12337	"RTN","HMP DJ04",26,0 )
	12338	N $ES,$ET ,ERRPAT,ER RMSG
	12339	"RTN","HMP DJ04",27,0 )
	12340	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	12341	"RTN","HMP DJ04",28,0 )
	12342	S ERRMSG= "A problem occurred converting a record for the ap pointment domain"
	12343	"RTN","HMP DJ04",29,0 )
	12344	;
	12345	"RTN","HMP DJ04",30,0 )
	12346	S HLOC=$P (NODE,U,2) ,X="A;"_HM PDT_";"_+H LOC
	12347	"RTN","HMP DJ04",31,0 )
	12348	I $L($G(I D)),$P(ID, ";",1,3)'= X Q
	12349	"RTN","HMP DJ04",32,0 )
	12350	S APPT("l ocalId")=X ,APPT("uid ")=$$SETUI D^HMPUTILS ("appointm ent",DFN,X )
	12351	"RTN","HMP DJ04",33,0 )
	12352	S X=$P(NO DE,U,10),A PPT("typeC ode")=$P(X ,";"),APPT ("typeName ")=$P(X,"; ",2)
	12353	"RTN","HMP DJ04",34,0 )
	12354	S STS=$P( NODE,U,3), CLS=$S($E( STS)="I":" I",1:"O")
	12355	"RTN","HMP DJ04",35,0 )
	12356	S STS=$P( $$STATUS^S DAMA308(DF N,HMPDT,+H LOC),";",1 ,2) ;DE255 2 ASF 2015 /11/16 han dles "sche duled/kept " issue; I CR in-prog ress
	12357	"RTN","HMP DJ04",36,0 )
	12358	S APPT("d ateTime")= $$JSONDT^H MPUTILS(HM PDT)
	12359	"RTN","HMP DJ04",37,0 )
	12360	S:$L($P(N ODE,U,6)) APPT("comm ent")=$P(N ODE,U,6)
	12361	"RTN","HMP DJ04",38,0 )
	12362	S:$P(NODE ,U,9) APPT ("checkIn" )=$$JSONDT ^HMPUTILS( $P(NODE,U, 9))
	12363	"RTN","HMP DJ04",39,0 )
	12364	S:$P(NODE ,U,11) APP T("checkOu t")=$$JSON DT^HMPUTIL S($P(NODE, U,11))
	12365	"RTN","HMP DJ04",40,0 )
	12366	I $L(ID," ;")>3 S AP PT("reason Name")=$P( ID,";",4), PRV=+$P(ID ,";",5) ;f rom SDAM e vent
	12367	"RTN","HMP DJ04",41,0 )
	12368	S FAC=$$F AC^HMPD(+H LOC) D FAC ILITY^HMPU TILS(FAC," APPT") I H LOC D
	12369	"RTN","HMP DJ04",42,0 )
	12370	. S APPT( "locationN ame")=$P(H LOC,";",2)
	12371	"RTN","HMP DJ04",43,0 )
	12372	. S APPT( "locationU id")=$$SET UID^HMPUTI LS("locati on",,+HLOC )
	12373	"RTN","HMP DJ04",44,0 )
	12374	. S X=$$G ET1^DIQ(44 ,(+HLOC)_" ,",1) S:X] "" APPT("s hortLocati onName")=X ;DE2818, (#1) ABBR EVIATION
	12375	"RTN","HMP DJ04",45,0 )
	12376	. S X=$$A MIS^HMPDVS IT(+$P(NOD E,U,13))
	12377	"RTN","HMP DJ04",46,0 )
	12378	. S:$L(X) APPT("sto pCodeUid") ="urn:va:s top-code:" _$P(X,U),A PPT("stopC odeName")= $P(X,U,2)
	12379	"RTN","HMP DJ04",47,0 )
	12380	. S SV=$$ GET1^DIQ(4 4,+HLOC_", ",9.5,"I")
	12381	"RTN","HMP DJ04",48,0 )
	12382	. I SV S APPT("serv ice")=$$SE RV^HMPDSDA M(SV)
	12383	"RTN","HMP DJ04",49,0 )
	12384	. ;find d efault pro vider
	12385	"RTN","HMP DJ04",50,0 )
	12386	. S:'$G(P RV) PRV=+$ $GET1^DIQ( 44,+HLOC_" ,",16,"I") I 'PRV D
	12387	"RTN","HMP DJ04",51,0 )
	12388	.. N HMPP ,I,FIRST
	12389	"RTN","HMP DJ04",52,0 )
	12390	.. D GETS ^DIQ(44,+H LOC_",","2 600*","I", "HMPP")
	12391	"RTN","HMP DJ04",53,0 )
	12392	.. S FIRS T=$O(HMPP( 44.1,"")), I=""
	12393	"RTN","HMP DJ04",54,0 )
	12394	.. F S I =$O(HMPP(4 4.1,I)) Q: I="" I $G (HMPP(44.1 ,I,.02,"I" )) S PRV=$ G(HMPP(44. 1,I,.01,"I ")) Q
	12395	"RTN","HMP DJ04",55,0 )
	12396	.. I 'PRV ,FIRST S P RV=$G(HMPP (44.1,FIRS T,.01,"I") )
	12397	"RTN","HMP DJ04",56,0 )
	12398	I $G(PRV) S APPT("p roviders", 1,"provide rUid")=$$S ETUID^HMPU TILS("user ",,PRV),AP PT("provid ers",1,"pr oviderName ")=$$GET1^ DIQ(200,PR V_",",.01) ;DE2818
	12399	"RTN","HMP DJ04",57,0 )
	12400	S APPT("p atientClas sCode")="u rn:va:pati ent-class: "_$S(CLS=" I":"IMP",1 :"AMB")
	12401	"RTN","HMP DJ04",58,0 )
	12402	S APPT("p atientClas sName")=$S (CLS="I":" Inpatient" ,1:"Ambula tory")
	12403	"RTN","HMP DJ04",59,0 )
	12404	S APPT("c ategoryCod e")="urn:v a:encounte r-category :OV",APPT( "categoryN ame")="Out patient Vi sit"
	12405	"RTN","HMP DJ04",60,0 )
	12406	S APPT("a ppointment Status")=$ P(STS,";", 2)
	12407	"RTN","HMP DJ04",61,0 )
	12408	S APPT("l astUpdateT ime")=$$EN ^HMPSTMP(" appointmen t") ;RHL 2 0150102
	12409	"RTN","HMP DJ04",62,0 )
	12410	S APPT("s tampTime") =APPT("las tUpdateTim e") ; RHL 20150102
	12411	"RTN","HMP DJ04",63,0 )
	12412	;US6734 - pre-compi le metasta mp
	12413	"RTN","HMP DJ04",64,0 )
	12414	I $G(HMPM ETA) D ADD ^HMPMETA(" appointmen t",APPT("u id"),APPT( "stampTime ")) Q:HMPM ETA=1 ;US 6734,US110 19
	12415	"RTN","HMP DJ04",65,0 )
	12416	D ADD^HMP DJ("APPT", "appointme nt")
	12417	"RTN","HMP DJ04",66,0 )
	12418	Q
	12419	"RTN","HMP DJ04",67,0 )
	12420	;
	12421	"RTN","HMP DJ04",68,0 )
	12422	DGS ; sche duled admi ssions [fr om APPOINT M^HMPDJ0]
	12423	"RTN","HMP DJ04",69,0 )
	12424	;DE2818, ^DGS(41.1) reference s ICR 3796
	12425	"RTN","HMP DJ04",70,0 )
	12426	S HMPA=0 F S HMPA= $O(^DGS(41 .1,"B",DFN ,HMPA)) Q: HMPA<1 D Q:HMPI'<H MPMAX
	12427	"RTN","HMP DJ04",71,0 )
	12428	. S HMPX= $G(^DGS(41 .1,HMPA,0) )
	12429	"RTN","HMP DJ04",72,0 )
	12430	. I $L($G (ID)),+$P( ID,";",2)= +$P(HMPX,U ,2) D DGS1 (HMPA) Q
	12431	"RTN","HMP DJ04",73,0 )
	12432	. Q:$P(HM PX,U,13) Q:$P(HMPX, U,17) ;ca ncelled or admitted
	12433	"RTN","HMP DJ04",74,0 )
	12434	. S X=$P( HMPX,U,2) Q:X<HMPSTA RT!(X>HMPS TOP) ;out of date r ange
	12435	"RTN","HMP DJ04",75,0 )
	12436	. D DGS1( HMPA)
	12437	"RTN","HMP DJ04",76,0 )
	12438	Q
	12439	"RTN","HMP DJ04",77,0 )
	12440	;
	12441	"RTN","HMP DJ04",78,0 )
	12442	DGS1(IFN) ; -- sched uled admis sion
	12443	"RTN","HMP DJ04",79,0 )
	12444	N ADM,X0, DATE,HLOC, FAC,SV,X
	12445	"RTN","HMP DJ04",80,0 )
	12446	S X0=$G(^ DGS(41.1,+ $G(IFN),0) ) Q:X0="" ;deleted (DE2818, I CR 3796)
	12447	"RTN","HMP DJ04",81,0 )
	12448	;
	12449	"RTN","HMP DJ04",82,0 )
	12450	S DATE=+$ P(X0,U,2), HLOC=+$$GE T1^DIQ(42, +$P(X0,U,8 )_",",.01) ;DE2818, ICR 10039
	12451	"RTN","HMP DJ04",83,0 )
	12452	S X="H;"_ DATE,ADM(" localId")= X,ADM("uid ")=$$SETUI D^HMPUTILS ("appointm ent",DFN,X )
	12453	"RTN","HMP DJ04",84,0 )
	12454	S ADM("da teTime")=$ $JSONDT^HM PUTILS(DAT E)
	12455	"RTN","HMP DJ04",85,0 )
	12456	S FAC=$$F AC^HMPD(+H LOC) D FAC ILITY^HMPU TILS(FAC," ADM") I HL OC D
	12457	"RTN","HMP DJ04",86,0 )
	12458	. S HLOC= $$GET1^DIQ (44,(+HLOC )_",",.01) ;DE2818, (#.01) NA ME
	12459	"RTN","HMP DJ04",87,0 )
	12460	. S ADM(" uid")=ADM( "uid")_";" _+HLOC
	12461	"RTN","HMP DJ04",88,0 )
	12462	. S ADM(" locationNa me")=$P(HL OC,";",2)
	12463	"RTN","HMP DJ04",89,0 )
	12464	. S X=$$G ET1^DIQ(44 ,(+HLOC)_" ,",1) S:X ]"" ADM("s hortLocati onName")=X ;DE2818, (#1) ABBR EVIATION
	12465	"RTN","HMP DJ04",90,0 )
	12466	. S ADM(" locationUi d")=$$SETU ID^HMPUTIL S("locatio n",,+HLOC)
	12467	"RTN","HMP DJ04",91,0 )
	12468	. S X=$$G ET1^DIQ(44 ,+HLOC_"," ,8,"I"),X= $$AMIS^HMP DVSIT(X)
	12469	"RTN","HMP DJ04",92,0 )
	12470	. S:$L(X) ADM("stop CodeUid")= "urn:va:st op-code:"_ $P(X,U),AD M("stopCod eName")=$P (X,U,2)
	12471	"RTN","HMP DJ04",93,0 )
	12472	. S SV=$$ GET1^DIQ(4 4,+HLOC_", ",9.5,"I")
	12473	"RTN","HMP DJ04",94,0 )
	12474	. I SV S ADM("servi ce")=$$SER V^HMPDSDAM (SV)
	12475	"RTN","HMP DJ04",95,0 )
	12476	S X=+$P(X 0,U,5) I X D
	12477	"RTN","HMP DJ04",96,0 )
	12478	. S ADM(" providers" ,1,"provid erUid")=$$ SETUID^HMP UTILS("use r",,X)
	12479	"RTN","HMP DJ04",97,0 )
	12480	. S ADM(" providers" ,1,"provid erName")=$ $GET1^DIQ( 200,X_",", .01) ;DE2 818
	12481	"RTN","HMP DJ04",98,0 )
	12482	S ADM("pa tientClass Code")="ur n:va:patie nt-class:I MP",ADM("p atientClas sName")="I npatient"
	12483	"RTN","HMP DJ04",99,0 )
	12484	S ADM("ca tegoryCode ")="urn:va :encounter -category: AD",ADM("c ategoryNam e")="Admis sion"
	12485	"RTN","HMP DJ04",100, 0)
	12486	S ADM("ap pointmentS tatus")=$S ($P(X0,U,1 7):"ADMITT ED",$P(X0, U,13):"CAN CELLED",1: "SCHEDULED ")
	12487	"RTN","HMP DJ04",101, 0)
	12488	S ADM("la stUpdateTi me")=$$EN^ HMPSTMP("a dm") ;RHL 20150102
	12489	"RTN","HMP DJ04",102, 0)
	12490	S ADM("st ampTime")= ADM("lastU pdateTime" ) ; RHL 20 150102
	12491	"RTN","HMP DJ04",103, 0)
	12492	;US6734 - pre-compi le metasta mp
	12493	"RTN","HMP DJ04",104, 0)
	12494	I $G(HMPM ETA) D ADD ^HMPMETA(" appointmen t",ADM("ui d"),ADM("s tampTime") ) Q:HMPMET A=1 ;US67 34,US11019
	12495	"RTN","HMP DJ04",105, 0)
	12496	D ADD^HMP DJ("ADM"," appointmen t")
	12497	"RTN","HMP DJ04",106, 0)
	12498	Q
	12499	"RTN","HMP DJ04",107, 0)
	12500	;
	12501	"RTN","HMP DJ04",108, 0)
	12502	VSIT1(ID) ; -- visit
	12503	"RTN","HMP DJ04",109, 0)
	12504	N VST,X0, X15,X,FAC, LOC,CATG,A MIS,INPT,D A,PS
	12505	"RTN","HMP DJ04",110, 0)
	12506	I $G(ID)? 1"H"1.N D ADM^HMPDJ0 4A(ID) Q
	12507	"RTN","HMP DJ04",111, 0)
	12508	;DE2818, ICR 6275
	12509	"RTN","HMP DJ04",112, 0)
	12510	I $D(^EDP (230,"V",I D)),$L($T( EDP1^HMPDJ 04E)) D ED P1^HMPDJ04 E(ID) Q
	12511	"RTN","HMP DJ04",113, 0)
	12512	; ENCEVEN T^PXAPI(ID )
	12513	"RTN","HMP DJ04",114, 0)
	12514	; DE2818, ^AUPNVSIT - ICR 202 8
	12515	"RTN","HMP DJ04",115, 0)
	12516	S X0=$G(^ AUPNVSIT(I D,0)),X15= $G(^(150)) Q:X0="" ;pjh - qui t if visit already d eleted
	12517	"RTN","HMP DJ04",116, 0)
	12518	; X0=$G(^ TMP("PXKEN C",$J,ID," VST",ID,0) ),X15=$G(^ (150))
	12519	"RTN","HMP DJ04",117, 0)
	12520	;Q:$P(X15 ,U,3)'="P" Q:$P(X0, U,7)="E" Q:$P(X0,U, 12) ;prim ary, not h istorical or child
	12521	"RTN","HMP DJ04",118, 0)
	12522	I $P(X0,U ,7)="H" D ADM^HMPDJ0 4A(ID,+X0) Q
	12523	"RTN","HMP DJ04",119, 0)
	12524	S VST("lo calId")=ID ,VST("uid" )=$$SETUID ^HMPUTILS( "visit",DF N,ID)
	12525	"RTN","HMP DJ04",120, 0)
	12526	S VST("da teTime")=$ $JSONDT^HM PUTILS(+X0 ) ;(#.01) VISIT/ADM IT DATE&TI ME
	12527	"RTN","HMP DJ04",121, 0)
	12528	S:$P(X0,U ,18) VST(" checkOut") =$$JSONDT^ HMPUTILS($ P(X0,U,18) ) ;(#.18) CHECK OUT DATE&TIME
	12529	"RTN","HMP DJ04",122, 0)
	12530	S:$P(X0,U ,12) VST(" parentUid" )=$$SETUID ^HMPUTILS( "visit",DF N,$P(X0,U, 12)) ;(#. 12) PARENT VISIT LIN K
	12531	"RTN","HMP DJ04",123, 0)
	12532	;(#.06) L OC. OF ENC OUNTER, (# .07) SERVI CE CATEGOR Y, (#.22) HOSPITAL L OCATION
	12533	"RTN","HMP DJ04",124, 0)
	12534	S FAC=+$P (X0,U,6),C ATG=$P(X0, U,7),LOC=+ $P(X0,U,22 )
	12535	"RTN","HMP DJ04",125, 0)
	12536	S:FAC X=$ $STA^XUAF4 (FAC)_U_$P ($$NS^XUAF 4(FAC),U)
	12537	"RTN","HMP DJ04",126, 0)
	12538	S:'FAC X= $$FAC^HMPD (LOC) D FA CILITY^HMP UTILS(X,"V ST")
	12539	"RTN","HMP DJ04",127, 0)
	12540	S X=$S(CA TG="H":"AD ",CATG="C" :"CR",CATG ="T":"TC", CATG="N":" U",CATG="R ":"NH","D^ X"[CATG:"O ",1:"OV")
	12541	"RTN","HMP DJ04",128, 0)
	12542	S VST("ca tegoryCode ")="urn:va :encounter -category: "_X
	12543	"RTN","HMP DJ04",129, 0)
	12544	S VST("ca tegoryName ")=$S(X="A D":"Admiss ion",X="CR ":"Chart R eview",X=" TC":"Phone Contact", X="U":"Unk nown",X="N H":"Nursin g Home",X= "O":"Other ",1:"Outpa tient Visi t")
	12545	"RTN","HMP DJ04",130, 0)
	12546	S INPT=$P (X15,U,2) S:INPT="" INPT=$S("H ^I^R^D"[CA TG:1,1:0) ;(#15002) PATIENT S TATUS IN/O UT
	12547	"RTN","HMP DJ04",131, 0)
	12548	S X=$P(X1 5,U,3) S:$ L(X) VST(" encounterT ype")=X ; (#15003) E NCOUNTER T YPE
	12549	"RTN","HMP DJ04",132, 0)
	12550	S X=$$CPT (ID) S:X V ST("typeNa me")=$P($$ CPT^ICPTCO D(X),U,3)
	12551	"RTN","HMP DJ04",133, 0)
	12552	I 'X S VS T("typeNam e")=$S('IN PT&LOC:$$G ET1^DIQ(44 ,LOC_",",. 01)_" VISI T",1:$$CAT G^HMPDVSIT (CATG)) ; DE2818
	12553	"RTN","HMP DJ04",134, 0)
	12554	S VST("pa tientClass Code")="ur n:va:patie nt-class:" _$S(INPT:" IMP",1:"AM B")
	12555	"RTN","HMP DJ04",135, 0)
	12556	S VST("pa tientClass Name")=$S( INPT:"Inpa tient",1:" Ambulatory ")
	12557	"RTN","HMP DJ04",136, 0)
	12558	;(#.08) D SS ID
	12559	"RTN","HMP DJ04",137, 0)
	12560	S X=$P(X0 ,U,8) S:X AMIS=$$AMI S^HMPDVSIT (X) I LOC D
	12561	"RTN","HMP DJ04",138, 0)
	12562	. ;DE2818 , calls ch anged $$GE T1^DIQ
	12563	"RTN","HMP DJ04",139, 0)
	12564	. I 'X S AMIS=$$GET 1^DIQ(44,L OC_",",8) ;DE2818, (#8) STOP CODE NUMBE R
	12565	"RTN","HMP DJ04",140, 0)
	12566	. S VST(" locationUi d")=$$SETU ID^HMPUTIL S("locatio n",,+LOC)
	12567	"RTN","HMP DJ04",141, 0)
	12568	. S X=$$G ET1^DIQ(44 ,LOC_",",1 ) S:X]"" V ST("shortL ocationNam e")=X ;DE 2818, (#1) ABBREVIAT ION
	12569	"RTN","HMP DJ04",142, 0)
	12570	. S VST(" locationNa me")=$$GET 1^DIQ(44,L OC_",",.01 ) ;DE2818 , (#.01) N AME
	12571	"RTN","HMP DJ04",143, 0)
	12572	. S VST(" locationOo s")=$S($$G ET1^DIQ(44 ,LOC_",",5 0.01,"I"): "true",1:" false") ; DE2818, (# 50.01) OCC ASION OF S ERVICE CLI NIC?
	12573	"RTN","HMP DJ04",144, 0)
	12574	. S X=$$S ERV^HMPDVS IT($$GET1^ DIQ(44,LOC _",",9.5," I")) S:$L( X) VST("se rvice")=X ;DE2818, (#9.5) TRE ATING SPEC IALTY
	12575	"RTN","HMP DJ04",145, 0)
	12576	S:$D(AMIS ) VST("sto pCodeUid") ="urn:va:s top-code:" _$P(AMIS,U ),VST("sto pCodeName" )=$P(AMIS, U,2)
	12577	"RTN","HMP DJ04",146, 0)
	12578	S X=$$POV (ID) S:$L( X) VST("re asonUid")= $$SETNCS^H MPUTILS("i cd",$P(X,U )),VST("re asonName") =$P(X,U,2)
	12579	"RTN","HMP DJ04",147, 0)
	12580	; provide r(s), DE28 18 - ^AUPN VPRV refer ences - IC R 2316
	12581	"RTN","HMP DJ04",148, 0)
	12582	S DA=0 F S DA=$O(^ AUPNVPRV(" AD",ID,DA) ) Q:DA<1 D
	12583	"RTN","HMP DJ04",149, 0)
	12584	. S X0=$G (^AUPNVPRV (DA,0))
	12585	"RTN","HMP DJ04",150, 0)
	12586	. I $P(X0 ,U,4)="P" D PROV("VS T",DA,+X0, "P",1) Q ;primary
	12587	"RTN","HMP DJ04",151, 0)
	12588	. D:'$D(P S(+X0)) PR OV("VST",D A,+X0,"S") ;secondary
	12589	"RTN","HMP DJ04",152, 0)
	12590	. S PS(+X 0)="" ; (no dupl icates)
	12591	"RTN","HMP DJ04",153, 0)
	12592	K ^TMP("P XKENC",$J, ID)
	12593	"RTN","HMP DJ04",154, 0)
	12594	S VST("la stUpdateTi me")=$$EN^ HMPSTMP("v isit") ;RH L 20150103
	12595	"RTN","HMP DJ04",155, 0)
	12596	S VST("st ampTime")= VST("lastU pdateTime" ) ; RHL 20 150103
	12597	"RTN","HMP DJ04",156, 0)
	12598	;US6734 - pre-compi le metasta mp
	12599	"RTN","HMP DJ04",157, 0)
	12600	I $G(HMPM ETA) D ADD ^HMPMETA(" visit",VST ("uid"),VS T("stampTi me")) Q:HM PMETA=1 ; US6734,US1 1019
	12601	"RTN","HMP DJ04",158, 0)
	12602	D ADD^HMP DJ("VST"," visit")
	12603	"RTN","HMP DJ04",159, 0)
	12604	Q
	12605	"RTN","HMP DJ04",160, 0)
	12606	;
	12607	"RTN","HMP DJ04",161, 0)
	12608	CPT(VISIT) ; -- Retu rn CPT cod e of encou nter type
	12609	"RTN","HMP DJ04",162, 0)
	12610	;DE2818 - Change to use API a nd not dir ectly acce ss the glo bal
	12611	"RTN","HMP DJ04",163, 0)
	12612	N DA,Y S Y=""
	12613	"RTN","HMP DJ04",164, 0)
	12614	;DE2818, ICR 2048 f or ^AUPNVC PT referen ces
	12615	"RTN","HMP DJ04",165, 0)
	12616	S DA=0 F S DA=$O(^ AUPNVCPT(" AD",VISIT, DA)) Q:DA< 1 D Q:$L (Y)
	12617	"RTN","HMP DJ04",166, 0)
	12618	. D ENCEV ENT^PXAPI( VISIT,1)
	12619	"RTN","HMP DJ04",167, 0)
	12620	. I +$G(^ TMP("PXKEN C",$J,VISI T,"CPT",DA ,0))?1"992 "2N S Y=+$ G(^TMP("PX KENC",$J,V ISIT,"CPT" ,DA,0))
	12621	"RTN","HMP DJ04",168, 0)
	12622	Q Y
	12623	"RTN","HMP DJ04",169, 0)
	12624	;
	12625	"RTN","HMP DJ04",170, 0)
	12626	POV(VISIT) ; -- retu rn the pri mary Purpo se of Visi t as ICD^P roviderNar rative
	12627	"RTN","HMP DJ04",171, 0)
	12628	N DA,Y,X, X0,ICD S Y =""
	12629	"RTN","HMP DJ04",172, 0)
	12630	;DE2818, ^AUPNVPOV( - ICR 309 4
	12631	"RTN","HMP DJ04",173, 0)
	12632	S DA=0 F S DA=$O(^ AUPNVPOV(" AD",VISIT, DA)) Q:DA< 1 D Q:$L (Y)
	12633	"RTN","HMP DJ04",174, 0)
	12634	. S X0=$G (^AUPNVPOV (DA,0)) Q: $P(X0,U,12 )'="P"
	12635	"RTN","HMP DJ04",175, 0)
	12636	. S X=+$P (X0,U,4),I CD=$$ICD^H MPDVSIT(+X 0)
	12637	"RTN","HMP DJ04",176, 0)
	12638	. S Y=ICD _U_$$EXTER NAL^DILFD( 9000010.07 ,.04,,X)
	12639	"RTN","HMP DJ04",177, 0)
	12640	Q Y
	12641	"RTN","HMP DJ04",178, 0)
	12642	;
	12643	"RTN","HMP DJ04",179, 0)
	12644	PROV(ARR,I ,IEN,ROLE, PRIM) ; -- add provi ders
	12645	"RTN","HMP DJ04",180, 0)
	12646	S @ARR@(" providers" ,I,"provid erUid")=$$ SETUID^HMP UTILS("use r",,+IEN)
	12647	"RTN","HMP DJ04",181, 0)
	12648	S @ARR@(" providers" ,I,"provid erName")=$ $GET1^DIQ( 200,(+IEN) _",",.01) ;DE2818
	12649	"RTN","HMP DJ04",182, 0)
	12650	S @ARR@(" providers" ,I,"role") =ROLE
	12651	"RTN","HMP DJ04",183, 0)
	12652	S:$G(PRIM ) @ARR@("p roviders", I,"primary ")="true"
	12653	"RTN","HMP DJ04",184, 0)
	12654	Q
	12655	"RTN","HMP DJ04",185, 0)
	12656	;
	12657	"RTN","HMP DJ04",186, 0)
	12658	NAME(IEN) ; -- Retur n a string 'name' fo r the visi t
	12659	"RTN","HMP DJ04",187, 0)
	12660	N Y,X0,LO C,DATE
	12661	"RTN","HMP DJ04",188, 0)
	12662	S X0=$G(^ AUPNVSIT(+ $G(IEN),0) ),Y="" ;D E2818, ICR 2028
	12663	"RTN","HMP DJ04",189, 0)
	12664	S DATE=+X 0,LOC=+$P( X0,U,22) S :LOC LOC=$ $GET1^DIQ( 44,LOC_"," ,.01)_" " ;DE2818
	12665	"RTN","HMP DJ04",190, 0)
	12666	S Y=LOC_$ $FMTE^XLFD T(DATE,"1D ") ;Mon DD , YYYY
	12667	"RTN","HMP DJ04",191, 0)
	12668	Q Y
	12669	"RTN","HMP DJ04",192, 0)
	12670	;
	12671	"RTN","HMP DJ04",193, 0)
	12672	FAC(IEN) ; -- Retur n Facility for the v isit
	12673	"RTN","HMP DJ04",194, 0)
	12674	Q:'+$G(IE N) ""
	12675	"RTN","HMP DJ04",195, 0)
	12676	N FAC S F AC=+$$GET1 ^DIQ(90000 10,IEN_"," ,.06,"I")
	12677	"RTN","HMP DJ04",196, 0)
	12678	Q:FAC $$S TA^XUAF4(F AC)_U_$P($ $NS^XUAF4( FAC),U)
	12679	"RTN","HMP DJ04",197, 0)
	12680	S FAC=+$$ GET1^DIQ(9 000010,IEN _",",.22," I")
	12681	"RTN","HMP DJ04",198, 0)
	12682	Q $$FAC^H MPD(FAC)
	12683	"RTN","HMP DJ04",199, 0)
	12684	;
	12685	"RTN","HMP DJ04",200, 0)
	12686	STCODE(IEN ) ; -- R eturn stop code info rmation fo r the visi t Q:'+$G(I EN) ""
	12687	"RTN","HMP DJ04",201, 0)
	12688	Q:'+$G(IE N) ""
	12689	"RTN","HMP DJ04",202, 0)
	12690	N STCODE, LIEN S STC ODE=+$$GET 1^DIQ(9000 010,IEN_", ",.08,"I")
	12691	"RTN","HMP DJ04",203, 0)
	12692	Q:STCODE $$AMIS^HMP DVSIT(STCO DE)
	12693	"RTN","HMP DJ04",204, 0)
	12694	S LIEN=+$ $GET1^DIQ( 9000010,IE N_",",.22, "I")
	12695	"RTN","HMP DJ04",205, 0)
	12696	I LIEN S STCODE=+$$ GET1^DIQ(4 4,LIEN_"," ,8,"I")
	12697	"RTN","HMP DJ04",206, 0)
	12698	Q:STCODE $$AMIS^HMP DVSIT(STCO DE)
	12699	"RTN","HMP DJ04",207, 0)
	12700	Q ""
	12701	"RTN","HMP DJ04",208, 0)
	12702	;
	12703	"RTN","HMP DJ04",209, 0)
	12704	STOPCODE(X ,Y) ; -- Return st op code in fo for JSO N
	12705	"RTN","HMP DJ04",210, 0)
	12706	S @Y@("st opCodeUid" )="urn:va: stop-code: "_$P(X,U)
	12707	"RTN","HMP DJ04",211, 0)
	12708	S @Y@("st opCodeName ")=$P(X,U, 2)
	12709	"RTN","HMP DJ04",212, 0)
	12710	Q
	12711	"RTN","HMP DJ04",213, 0)
	12712	;
	12713	"RTN","HMP DJ04A")
	12714	0^38^B5976 8993
	12715	"RTN","HMP DJ04A",1,0 )
	12716	HMPDJ04A ; ASMR/MKB - Admission s,PTF;Nov 12, 2015 1 6:42:22
	12717	"RTN","HMP DJ04A",2,0 )
	12718	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	12719	"RTN","HMP DJ04A",3,0 )
	12720	;Per VA D irective 6 402, this routine sh ould not b e modified .
	12721	"RTN","HMP DJ04A",4,0 )
	12722	;
	12723	"RTN","HMP DJ04A",5,0 )
	12724	; Externa l Referenc es DBIA#
	12725	"RTN","HMP DJ04A",6,0 )
	12726	; ------- ---------- -- -----
	12727	"RTN","HMP DJ04A",7,0 )
	12728	; ^AUPNVS IT 2028
	12729	"RTN","HMP DJ04A",8,0 )
	12730	; ^DGPM 1865
	12731	"RTN","HMP DJ04A",9,0 )
	12732	; ^DIC(42 10039
	12733	"RTN","HMP DJ04A",10, 0)
	12734	; ^DPT 10035
	12735	"RTN","HMP DJ04A",11, 0)
	12736	; ^SC 10040
	12737	"RTN","HMP DJ04A",12, 0)
	12738	; ^VA(200 10060
	12739	"RTN","HMP DJ04A",13, 0)
	12740	; DGPTFAP I 3157
	12741	"RTN","HMP DJ04A",14, 0)
	12742	; DIC 2051
	12743	"RTN","HMP DJ04A",15, 0)
	12744	; DILFD 2055
	12745	"RTN","HMP DJ04A",16, 0)
	12746	; DIQ 2056
	12747	"RTN","HMP DJ04A",17, 0)
	12748	; ICDCODE 3990
	12749	"RTN","HMP DJ04A",18, 0)
	12750	; ICPTCOD 1995
	12751	"RTN","HMP DJ04A",19, 0)
	12752	; VADPT 10061
	12753	"RTN","HMP DJ04A",20, 0)
	12754	; XUAF4 2171
	12755	"RTN","HMP DJ04A",21, 0)
	12756	;
	12757	"RTN","HMP DJ04A",22, 0)
	12758	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	12759	"RTN","HMP DJ04A",23, 0)
	12760	Q
	12761	"RTN","HMP DJ04A",24, 0)
	12762	;
	12763	"RTN","HMP DJ04A",25, 0)
	12764	ADM(ID,DAT E) ; -- ad mission [f rom VSIT1]
	12765	"RTN","HMP DJ04A",26, 0)
	12766	N ADM,VAD MVT,VAIP,V AERR,MVT,S PEC,HLOC,F AC,ICD,I
	12767	"RTN","HMP DJ04A",27, 0)
	12768	S ID=$G(I D),DATE=+$ G(DATE) Q: ID="" ;Q: DATE<1
	12769	"RTN","HMP DJ04A",28, 0)
	12770	I ID S VA IP("D")=DA TE,VST=+ID
	12771	"RTN","HMP DJ04A",29, 0)
	12772	I ID?1"H" 1.N S VAIP ("E")=+$E( ID,2,99),V ST=0
	12773	"RTN","HMP DJ04A",30, 0)
	12774	D IN5^VAD PT Q:'$G(V AIP(1)) ; deleted
	12775	"RTN","HMP DJ04A",31, 0)
	12776	S VADMVT= +$G(VAIP(1 3)),ID="H" _VADMVT
	12777	"RTN","HMP DJ04A",32, 0)
	12778	S ADM("lo calId")=ID ,ADM("uid" )=$$SETUID ^HMPUTILS( "visit",DF N,ID)
	12779	"RTN","HMP DJ04A",33, 0)
	12780	S:'DATE D ATE=+$G(VA IP(13,1)) S:'VST VST =$$VISIT(D FN,DATE)
	12781	"RTN","HMP DJ04A",34, 0)
	12782	S (ADM("d ateTime"), ADM("stay" ,"arrivalD ateTime")) =$$JSONDT^ HMPUTILS(D ATE)
	12783	"RTN","HMP DJ04A",35, 0)
	12784	S:$L($P(V AIP(6),U,2 )) ADM("ro omBed")=$P (VAIP(6),U ,2)
	12785	"RTN","HMP DJ04A",36, 0)
	12786	;DE2818, (#.105) CU RRENT ADMI SSION, cha nged ^DPT to FileMan , ICR 1003 5
	12787	"RTN","HMP DJ04A",37, 0)
	12788	S MVT=13, I=0 I VADM VT=$$GET1^ DIQ(2,DFN_ ",",.105," I") D ;if current a dmission,
	12789	"RTN","HMP DJ04A",38, 0)
	12790	. S ADM(" current")= "true",MVT =14 ; use last move ment info
	12791	"RTN","HMP DJ04A",39, 0)
	12792	. S X=$$G ET1^DIQ(2, DFN_",",.1 01,"I") S: $L(X) ADM( "roomBed") =X ;(#.10 1) ROOM-BE D, DE2818
	12793	"RTN","HMP DJ04A",40, 0)
	12794	. K HMPAD MIT ;kill flag from HMPDJ0
	12795	"RTN","HMP DJ04A",41, 0)
	12796	S SPEC=$G (VAIP(MVT, 6)),ADM("s pecialty") =$P(SPEC,U ,2)
	12797	"RTN","HMP DJ04A",42, 0)
	12798	S X=$$SER V^HMPDVSIT (+SPEC),AD M("service ")=X
	12799	"RTN","HMP DJ04A",43, 0)
	12800	;DE2818, changed fr om ^DIC(42 ) to FileM an, ICR 10 039
	12801	"RTN","HMP DJ04A",44, 0)
	12802	S HLOC=+$ $GET1^DIQ( 42,+$G(VAI P(MVT,4))_ ",",44,"I" ),FAC=$$FA C^HMPD(+HL OC) I HLOC D
	12803	"RTN","HMP DJ04A",45, 0)
	12804	. S ADM(" locationUi d")=$$SETU ID^HMPUTIL S("locatio n",,+HLOC)
	12805	"RTN","HMP DJ04A",46, 0)
	12806	. ;DE2818 begin, ch anged ^SC to FileMan , ICR 1004 0
	12807	"RTN","HMP DJ04A",47, 0)
	12808	. S X=$$G ET1^DIQ(44 ,HLOC_",", 1) S:X]"" ADM("short LocationNa me")=X ;( #1) ABBREV IATION
	12809	"RTN","HMP DJ04A",48, 0)
	12810	. S ADM(" locationNa me")=$$GET 1^DIQ(44,H LOC_",",.0 1) ;(#.01 ) NAME
	12811	"RTN","HMP DJ04A",49, 0)
	12812	. S X=$$A MIS^HMPDVS IT($$GET1^ DIQ(44,HLO C_",",8,"I ")) ;(#8) STOP CODE NUMBER
	12813	"RTN","HMP DJ04A",50, 0)
	12814	. ;DE2818 , end
	12815	"RTN","HMP DJ04A",51, 0)
	12816	. S:$L($G (X)) ADM(" stopCodeUi d")="urn:v a:stop-cod e:"_$P(X,U ),ADM("sto pCodeName" )=$P(X,U,2 )
	12817	"RTN","HMP DJ04A",52, 0)
	12818	. S ADM(" summary")= "${"_ADM(" service")_ "}:"_ADM(" locationNa me")
	12819	"RTN","HMP DJ04A",53, 0)
	12820	D FACILIT Y^HMPUTILS (FAC,"ADM" )
	12821	"RTN","HMP DJ04A",54, 0)
	12822	S ADM("ca tegoryCode ")="urn:va :encounter -category: AD",ADM("c ategoryNam e")="Admis sion"
	12823	"RTN","HMP DJ04A",55, 0)
	12824	S ADM("pa tientClass Code")="ur n:va:patie nt-class:I MP",ADM("p atientClas sName")="I npatient"
	12825	"RTN","HMP DJ04A",56, 0)
	12826	I $G(VAIP (17)) S AD M("stay"," dischargeD ateTime")= $$JSONDT^H MPUTILS(+$ G(VAIP(17, 1)))
	12827	"RTN","HMP DJ04A",57, 0)
	12828	I $G(VAIP (18)) S I= I+1 D PROV ("ADM",I,+ VAIP(18)," A") ;attendi ng
	12829	"RTN","HMP DJ04A",58, 0)
	12830	I $G(VAIP (MVT,5)) S I=I+1 D P ROV("ADM", I,+VAIP(MV T,5),"P",1 ) ;primary
	12831	"RTN","HMP DJ04A",59, 0)
	12832	S ICD=$$P OV^HMPDJ04 (VST) S:'I CD ICD=$$P TF^HMPDVSI T(DFN,VAIP (12)) ;PTF >ICD
	12833	"RTN","HMP DJ04A",60, 0)
	12834	I $L(ICD) <2 S ADM(" reasonName ")=$G(VAIP (MVT,7))
	12835	"RTN","HMP DJ04A",61, 0)
	12836	E S ADM( "reasonUid ")=$$SETNC S^HMPUTILS ("icd",ICD ),ADM("rea sonName")= $P(ICD,U,2 )
	12837	"RTN","HMP DJ04A",62, 0)
	12838	S X=$$CPT ^HMPDJ04(V ST),ADM("t ypeName")= $S(X:$P($$ CPT^ICPTCO D(X),U,3), 1:$$CATG^H MPDVSIT("H "))
	12839	"RTN","HMP DJ04A",63, 0)
	12840	D MVT(VAD MVT) ;su b-movement s
	12841	"RTN","HMP DJ04A",64, 0)
	12842	; TIU(VST ,.ADM) ;no tes/summar y
	12843	"RTN","HMP DJ04A",65, 0)
	12844	; Next 2 lines adde d for visi ts whose I Ds start w ith an "H" . JD - 1/ 26/15
	12845	"RTN","HMP DJ04A",66, 0)
	12846	S ADM("la stUpdateTi me")=$$EN^ HMPSTMP("a dm") ;RHL 20150102
	12847	"RTN","HMP DJ04A",67, 0)
	12848	S ADM("st ampTime")= ADM("lastU pdateTime" ) ; RHL 20 150102
	12849	"RTN","HMP DJ04A",68, 0)
	12850	;US6734 - pre-compi le metasta mp
	12851	"RTN","HMP DJ04A",69, 0)
	12852	I $G(HMPM ETA) D ADD ^HMPMETA(" visit",ADM ("uid"),AD M("stampTi me")) Q:HM PMETA=1 ; US6734,US1 1019
	12853	"RTN","HMP DJ04A",70, 0)
	12854	D ADD^HMP DJ("ADM"," visit")
	12855	"RTN","HMP DJ04A",71, 0)
	12856	Q
	12857	"RTN","HMP DJ04A",72, 0)
	12858	;
	12859	"RTN","HMP DJ04A",73, 0)
	12860	TIU(VISIT, ARR) ; -- add notes to ARR("do cument")
	12861	"RTN","HMP DJ04A",74, 0)
	12862	N X,Y,I,H MPX,LT,NT, DA,CNT,HMP Y
	12863	"RTN","HMP DJ04A",75, 0)
	12864	D FIND^DI C(8925,,.0 1,"QX",+$G (VISIT),," V",,,"HMPX ")
	12865	"RTN","HMP DJ04A",76, 0)
	12866	S Y="",(I ,CNT)=0
	12867	"RTN","HMP DJ04A",77, 0)
	12868	F S I=$O (HMPX("DIL IST",1,I)) Q:I<1 D
	12869	"RTN","HMP DJ04A",78, 0)
	12870	. S LT=$G (HMPX("DIL IST","ID", I,.01)) Q: $P(LT," ") ="Addendum "
	12871	"RTN","HMP DJ04A",79, 0)
	12872	. S DA=$G (HMPX("DIL IST",2,I))
	12873	"RTN","HMP DJ04A",80, 0)
	12874	. S NT=$$ GET1^DIQ(8 925,+DA_", ",".01:150 1")
	12875	"RTN","HMP DJ04A",81, 0)
	12876	. S CNT=C NT+1,ARR(" documents" ,CNT,"uid" )=$$SETUID ^HMPUTILS( "document" ,DFN,+DA)
	12877	"RTN","HMP DJ04A",82, 0)
	12878	. S ARR(" documents" ,CNT,"loca lTitle")=L T
	12879	"RTN","HMP DJ04A",83, 0)
	12880	. S:$L(NT ) ARR("doc uments",CN T,"nationa lTitle")=N T
	12881	"RTN","HMP DJ04A",84, 0)
	12882	Q
	12883	"RTN","HMP DJ04A",85, 0)
	12884	;
	12885	"RTN","HMP DJ04A",86, 0)
	12886	PROV(ARR,I ,IEN,ROLE, PRIM) ; -- add provi ders
	12887	"RTN","HMP DJ04A",87, 0)
	12888	S @ARR@(" providers" ,I,"provid erUid")=$$ SETUID^HMP UTILS("use r",,+IEN)
	12889	"RTN","HMP DJ04A",88, 0)
	12890	S @ARR@(" providers" ,I,"provid erName")=$ $GET1^DIQ( 200,IEN_", ",.01) ;D E2818, cha nged ^VA(2 00) to Fil eMan ICR 1 0060
	12891	"RTN","HMP DJ04A",89, 0)
	12892	S @ARR@(" providers" ,I,"role") =ROLE
	12893	"RTN","HMP DJ04A",90, 0)
	12894	S:$G(PRIM ) @ARR@("p roviders", I,"primary ")="true"
	12895	"RTN","HMP DJ04A",91, 0)
	12896	Q
	12897	"RTN","HMP DJ04A",92, 0)
	12898	;
	12899	"RTN","HMP DJ04A",93, 0)
	12900	MVT(CA) ; -- add mov ements to ADM("movem ent",i,"at tribute")
	12901	"RTN","HMP DJ04A",94, 0)
	12902	N DATE,DA ,CNT,X S ( DATE,CNT)= 0
	12903	"RTN","HMP DJ04A",95, 0)
	12904	;DE2818, ^DGPM( - I CR 1865
	12905	"RTN","HMP DJ04A",96, 0)
	12906	F S DATE =$O(^DGPM( "APCA",DFN ,CA,DATE)) Q:DATE<1 S DA=+$O( ^(DATE,0)) I DA'=CA D
	12907	"RTN","HMP DJ04A",97, 0)
	12908	. S X0=$G (^DGPM(DA, 0)),CNT=CN T+1
	12909	"RTN","HMP DJ04A",98, 0)
	12910	. S ADM(" movements" ,CNT,"loca lId")=DA
	12911	"RTN","HMP DJ04A",99, 0)
	12912	. S ADM(" movements" ,CNT,"date Time")=$$J SONDT^HMPU TILS(DATE)
	12913	"RTN","HMP DJ04A",100 ,0)
	12914	. S ADM(" movements" ,CNT,"move mentType") =$$EXTERNA L^DILFD(40 5,.02,,$P( X0,U,2))
	12915	"RTN","HMP DJ04A",101 ,0)
	12916	. S X=+$P (X0,U,19) I X D
	12917	"RTN","HMP DJ04A",102 ,0)
	12918	.. S ADM( "movements ",CNT,"pro viderUid") =$$SETUID^ HMPUTILS(" user",,X)
	12919	"RTN","HMP DJ04A",103 ,0)
	12920	.. S ADM( "movements ",CNT,"pro viderName" )=$$GET1^D IQ(200,X_" ,",.01) ; DE2818, ch anged ^VA( 200) to Fi leMan ICR 10060
	12921	"RTN","HMP DJ04A",104 ,0)
	12922	. S X=+$P (X0,U,9)
	12923	"RTN","HMP DJ04A",105 ,0)
	12924	. S:X ADM ("movement s",CNT,"sp ecialty")= $$EXTERNAL ^DILFD(405 ,.09,,X)
	12925	"RTN","HMP DJ04A",106 ,0)
	12926	. ;DE2818 , changed ^DIC(42) t o FileMan, ICR 10039
	12927	"RTN","HMP DJ04A",107 ,0)
	12928	. S HLOC= +$$GET1^DI Q(42,+$P(X 0,U,6)_"," ,44,"I"),F AC=$$FAC^H MPD(HLOC) I HLOC D
	12929	"RTN","HMP DJ04A",108 ,0)
	12930	.. S ADM( "movements ",CNT,"loc ationUid") =$$SETUID^ HMPUTILS(" location", ,HLOC)
	12931	"RTN","HMP DJ04A",109 ,0)
	12932	.. ;DE281 8, changed ^SC to Fi leMan, ICR 10040
	12933	"RTN","HMP DJ04A",110 ,0)
	12934	.. S ADM( "movements ",CNT,"loc ationName" )=$$GET1^D IQ(44,HLOC _",",.01) ;(#.01) N AME
	12935	"RTN","HMP DJ04A",111 ,0)
	12936	Q
	12937	"RTN","HMP DJ04A",112 ,0)
	12938	;
	12939	"RTN","HMP DJ04A",113 ,0)
	12940	PTFA(HMPLI D) ; -- fi nd ID in ^ PXRMINDX(4 5) and cal l PTF1 if successful
	12941	"RTN","HMP DJ04A",114 ,0)
	12942	;Purpose - Build ^T MP("HMPPX" ) from ^PX RMINDX(45, HMPISYS,"P NI",DFN)
	12943	"RTN","HMP DJ04A",115 ,0)
	12944	;
	12945	"RTN","HMP DJ04A",116 ,0)
	12946	;Called b y - PTF^HM PDJ0 (if H MPID is se t)
	12947	"RTN","HMP DJ04A",117 ,0)
	12948	;
	12949	"RTN","HMP DJ04A",118 ,0)
	12950	;Assumpti ons -
	12951	"RTN","HMP DJ04A",119 ,0)
	12952	;1. ID is being pas sed and DF N variable exists
	12953	"RTN","HMP DJ04A",120 ,0)
	12954	;2. ^TMP( "HMPPX") d oes not al ready exis t
	12955	"RTN","HMP DJ04A",121 ,0)
	12956	;
	12957	"RTN","HMP DJ04A",122 ,0)
	12958	;
	12959	"RTN","HMP DJ04A",123 ,0)
	12960	;Modifica tion Histo ry -
	12961	"RTN","HMP DJ04A",124 ,0)
	12962	;US5630 ( TW) 1. HM PISYS can be either "ICD" (ICD -9) or "10 D" (ICD-10 )
	12963	"RTN","HMP DJ04A",125 ,0)
	12964	; 2. Na mespaced v ariables a nd enhance d newing
	12965	"RTN","HMP DJ04A",126 ,0)
	12966	;
	12967	"RTN","HMP DJ04A",127 ,0)
	12968	N HMPLEN, HMPTYP,HMP ID,HMPISYS ,HMPTYP,HM PDX,HMPDT, HMPITEM,HM PRDT,HMPX
	12969	"RTN","HMP DJ04A",128 ,0)
	12970	S HMPLEN= $L(HMPLID, ";"),HMPTY P=$P(HMPLI D,";",HMPL EN),HMPID= $P(HMPLID, ";",1,HMPL EN-1)
	12971	"RTN","HMP DJ04A",129 ,0)
	12972	; DE2818, ^PXRMINDX - ICR 429 0
	12973	"RTN","HMP DJ04A",130 ,0)
	12974	;Get ICD System fro m ^PXRMIND X Xref and loop for remaining subscripts
	12975	"RTN","HMP DJ04A",131 ,0)
	12976	S HMPISYS ="" F S H MPISYS=$O( ^PXRMINDX( 45,HMPISYS )) Q:HMPIS YS="" D
	12977	"RTN","HMP DJ04A",132 ,0)
	12978	. I '$D(^ PXRMINDX(4 5,HMPISYS, "PNI",+$G( DFN),HMPTY P)) Q
	12979	"RTN","HMP DJ04A",133 ,0)
	12980	. S HMPDX ="" F S H MPDX=$O(^P XRMINDX(45 ,HMPISYS," PNI",+$G(D FN),HMPTYP ,HMPDX)) Q :HMPDX="" D
	12981	"RTN","HMP DJ04A",134 ,0)
	12982	.. S HMPD T=0 F S HMPDT=$O(^ PXRMINDX(4 5,HMPISYS, "PNI",+$G( DFN),HMPTY P,HMPDX,HM PDT)) Q:HM PDT="" D
	12983	"RTN","HMP DJ04A",135 ,0)
	12984	... S HMP ITEM="" F S HMPITE M=$O(^PXRM INDX(45,HM PISYS,"PNI ",+$G(DFN) ,HMPTYP,HM PDX,HMPDT, HMPITEM)) Q:HMPITEM= "" D
	12985	"RTN","HMP DJ04A",136 ,0)
	12986	.... I HM PITEM'[HMP ID Q
	12987	"RTN","HMP DJ04A",137 ,0)
	12988	.... S HM PRDT=99999 99-HMPDT
	12989	"RTN","HMP DJ04A",138 ,0)
	12990	.... S HM PX=HMPDX_U _HMPDT_U_H MPISYS
	12991	"RTN","HMP DJ04A",139 ,0)
	12992	.... S ^T MP("HMPPX" ,$J,HMPRDT ,HMPLID)=H MPX
	12993	"RTN","HMP DJ04A",140 ,0)
	12994	Q:'$D(^TM P("HMPPX", $J))
	12995	"RTN","HMP DJ04A",141 ,0)
	12996	D PTF1
	12997	"RTN","HMP DJ04A",142 ,0)
	12998	K ^TMP("H MPPX",$J)
	12999	"RTN","HMP DJ04A",143 ,0)
	13000	Q
	13001	"RTN","HMP DJ04A",144 ,0)
	13002	;
	13003	"RTN","HMP DJ04A",145 ,0)
	13004	PTF1 ; Set PTF data into PTF a rray
	13005	"RTN","HMP DJ04A",146 ,0)
	13006	;Purpose - Get data from ^TMP ("HMPPX"), lookup ad dl PTF, se t into PTF array and ^TMP
	13007	"RTN","HMP DJ04A",147 ,0)
	13008	;
	13009	"RTN","HMP DJ04A",148 ,0)
	13010	;Called b y - PTFA^H MPDJ04A if HMPID is set, other wise PTF^H MPDJ0
	13011	"RTN","HMP DJ04A",149 ,0)
	13012	;
	13013	"RTN","HMP DJ04A",150 ,0)
	13014	;Assumpti ons -
	13015	"RTN","HMP DJ04A",151 ,0)
	13016	;1. HMPLI D (local I D) is bein g passed a nd DFN,HMP RDT variab les exist
	13017	"RTN","HMP DJ04A",152 ,0)
	13018	;2. ^TMP( "HMPPX",$J ,HMPRDT,ID )=DxCode^[ Discharge] Date exist s
	13019	"RTN","HMP DJ04A",153 ,0)
	13020	;
	13021	"RTN","HMP DJ04A",154 ,0)
	13022	;Modifica tion Histo ry -
	13023	"RTN","HMP DJ04A",155 ,0)
	13024	;US5630 ( TW)- HMPIS YS can be either "IC D9" or "10 D" (ICD-10 )
	13025	"RTN","HMP DJ04A",156 ,0)
	13026	;
	13027	"RTN","HMP DJ04A",157 ,0)
	13028	N HMPTMP, PTF,HMPP,H MPTYP,HMPD IS,VAIN,HM PADM,VAIND T,HMPLOC,H MPFAC,HMPX ,HMPISYS
	13029	"RTN","HMP DJ04A",158 ,0)
	13030	S HMPTMP= $G(^TMP("H MPPX",$J,H MPRDT,HMPL ID))
	13031	"RTN","HMP DJ04A",159 ,0)
	13032	S PTF("lo calId")=HM PLID
	13033	"RTN","HMP DJ04A",160 ,0)
	13034	S PTF("ui d")=$$SETU ID^HMPUTIL S("ptf",DF N,HMPLID)
	13035	"RTN","HMP DJ04A",161 ,0)
	13036	S HMPP=$L (HMPLID,"; ")
	13037	"RTN","HMP DJ04A",162 ,0)
	13038	S HMPTYP= $P(HMPLID, ";",HMPP)
	13039	"RTN","HMP DJ04A",163 ,0)
	13040	I HMPTYP= "DXLS" S P TF("princi palDx")="t rue" ; Is this the principal dx?
	13041	"RTN","HMP DJ04A",164 ,0)
	13042	I $P(HMPT YP," ")="M " Q ; Qui t if movem ent dx
	13043	"RTN","HMP DJ04A",165 ,0)
	13044	S HMPDIS= $P(HMPTMP, U,2)
	13045	"RTN","HMP DJ04A",166 ,0)
	13046	I HMPDIS S VAINDT=H MPDIS-.000 1
	13047	"RTN","HMP DJ04A",167 ,0)
	13048	D INP^VAD PT ; Get inpatient VAIN array
	13049	"RTN","HMP DJ04A",168 ,0)
	13050	I '$G(VAI N(1)) Q ; Quit if n ot inpatie nt
	13051	"RTN","HMP DJ04A",169 ,0)
	13052	;US5630 - TW - Extr act Calcul ated DRG f or PTF
	13053	"RTN","HMP DJ04A",170 ,0)
	13054	S PTF("dr g")=$$GET1 ^DIQ(45,+H MPLID_",", 9,"")
	13055	"RTN","HMP DJ04A",171 ,0)
	13056	S PTF("ad missionUid ")=$$SETUI D^HMPUTILS ("visit",D FN,"H"_VAI N(1))
	13057	"RTN","HMP DJ04A",172 ,0)
	13058	S HMPADM= +$G(VAIN(7 )) ; Admi ssion date
	13059	"RTN","HMP DJ04A",173 ,0)
	13060	;DE2818, changed fr om ^DIC(42 ) to FileM an, ICR 10 039
	13061	"RTN","HMP DJ04A",174 ,0)
	13062	S HMPLOC= +$$GET1^DI Q(42,+$G(V AIN(4))_", ",44,"I") ; Get loc ation
	13063	"RTN","HMP DJ04A",175 ,0)
	13064	S:HMPADM PTF("arriv alDateTime ")=$$JSOND T^HMPUTILS (HMPADM)
	13065	"RTN","HMP DJ04A",176 ,0)
	13066	S:HMPDIS PTF("disch argeDateTi me")=$$JSO NDT^HMPUTI LS(HMPDIS)
	13067	"RTN","HMP DJ04A",177 ,0)
	13068	S HMPFAC= $$FAC^HMPD (HMPLOC) D :HMPFAC FA CILITY^HMP UTILS(HMPF AC,"PTF")
	13069	"RTN","HMP DJ04A",178 ,0)
	13070	S PTF("la stUpdateTi me")=$$EN^ HMPSTMP("p tf") ;RHL 20150102
	13071	"RTN","HMP DJ04A",179 ,0)
	13072	S PTF("st ampTime")= PTF("lastU pdateTime" ) ; RHL 20 150102
	13073	"RTN","HMP DJ04A",180 ,0)
	13074	;US5630 - TW - Chec k for ICD Coding Sys tem
	13075	"RTN","HMP DJ04A",181 ,0)
	13076	S HMPDX=$ P(HMPTMP,U )
	13077	"RTN","HMP DJ04A",182 ,0)
	13078	S HMPISYS =$P(HMPTMP ,U,3)
	13079	"RTN","HMP DJ04A",183 ,0)
	13080	S HMPISYS =$S(HMPISY S="ICD":1, "ICP":2,"1 0D":30,"10 P":31,1:1) ; Identi fy ICD cod ing system for corre ct lookup
	13081	"RTN","HMP DJ04A",184 ,0)
	13082	S HMPX=$$ ICDDX^ICDE X(HMPDX,"" ,HMPISYS)
	13083	"RTN","HMP DJ04A",185 ,0)
	13084	S PTF("ic dCode")=$$ SETNCS^HMP UTILS("icd ",$P(HMPX, U,2))
	13085	"RTN","HMP DJ04A",186 ,0)
	13086	S PTF("ic dName")=$P (HMPX,U,4)
	13087	"RTN","HMP DJ04A",187 ,0)
	13088	;US6734 - pre-comp ile metast amp
	13089	"RTN","HMP DJ04A",188 ,0)
	13090	I $G(HMPM ETA) D ADD ^HMPMETA(" ptf",PTF(" uid"),PTF( "stampTime ")) Q:HMPM ETA=1 ;US 6734,US110 19
	13091	"RTN","HMP DJ04A",189 ,0)
	13092	D ADD^HMP DJ("PTF"," ptf")
	13093	"RTN","HMP DJ04A",190 ,0)
	13094	Q
	13095	"RTN","HMP DJ04A",191 ,0)
	13096	;
	13097	"RTN","HMP DJ04A",192 ,0)
	13098	VISIT(DFN, DATE) ; -- Return vi sit# for a dmission
	13099	"RTN","HMP DJ04A",193 ,0)
	13100	N X,Y
	13101	"RTN","HMP DJ04A",194 ,0)
	13102	S X=99999 99-$P(DATE ,".")_"."_ $P(DATE,". ",2)
	13103	"RTN","HMP DJ04A",195 ,0)
	13104	S Y=+$O(^ AUPNVSIT(" AAH",DFN,X ,0)) ;DE2 818, ICR 2 028
	13105	"RTN","HMP DJ04A",196 ,0)
	13106	Q Y
	13107	"RTN","HMP DJ04E")
	13108	0^39^B1807 4806
	13109	"RTN","HMP DJ04E",1,0 )
	13110	HMPDJ04E ; SLC/MKB,AS MR/RRB - E DIS VISIT; 6/25/12 1 6:11
	13111	"RTN","HMP DJ04E",2,0 )
	13112	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	13113	"RTN","HMP DJ04E",3,0 )
	13114	;Per VA D irective 6 402, this routine sh ould not b e modified .
	13115	"RTN","HMP DJ04E",4,0 )
	13116	;
	13117	"RTN","HMP DJ04E",5,0 )
	13118	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	13119	"RTN","HMP DJ04E",6,0 )
	13120	;
	13121	"RTN","HMP DJ04E",7,0 )
	13122	; Externa l Referenc es DBIA#
	13123	"RTN","HMP DJ04E",8,0 )
	13124	; ------- ---------- -- -----
	13125	"RTN","HMP DJ04E",9,0 )
	13126	; EDP(230 6275
	13127	"RTN","HMP DJ04E",10, 0)
	13128	;
	13129	"RTN","HMP DJ04E",11, 0)
	13130	; DE2818/ RRB SQA fi ndings cha nged top l ine from E DIS to EDI S VISITS
	13131	"RTN","HMP DJ04E",12, 0)
	13132	Q
	13133	"RTN","HMP DJ04E",13, 0)
	13134	;
	13135	"RTN","HMP DJ04E",14, 0)
	13136	EDP1(ID) ; -- ED vis it
	13137	"RTN","HMP DJ04E",15, 0)
	13138	;DE2818 m odified to use FM ca lls to pul l data fro m the EDP files
	13139	"RTN","HMP DJ04E",16, 0)
	13140	N IENS,ED P,X0,FAC,V ST,LOC,LOC 0,X,I,ICD, FILE,FLDS, FLGS,ARR,E RR
	13141	"RTN","HMP DJ04E",17, 0)
	13142	S IENS=$$ FIND1^DIC( 230,"","Q" ,ID,"V","" ) Q:IENS<1
	13143	"RTN","HMP DJ04E",18, 0)
	13144	S IENS=IE NS_",",FLG S="IE",ARR ="EDP",ERR ="EDPERR", FLDS=".01; 3.5;3.6;3. 7;3.8;3.3; .08;.09;1. 1;.02;.14; 3.2"
	13145	"RTN","HMP DJ04E",19, 0)
	13146	D GETS^DI Q(230,IENS ,FLDS,FLGS ,ARR,ERR)
	13147	"RTN","HMP DJ04E",20, 0)
	13148	S X0=$G(^ AUPNVSIT(I D,0))
	13149	"RTN","HMP DJ04E",21, 0)
	13150	;.01 LOG ENTRY TIME
	13151	"RTN","HMP DJ04E",22, 0)
	13152	;.08 TIME IN
	13153	"RTN","HMP DJ04E",23, 0)
	13154	;.08 TIME OUT
	13155	"RTN","HMP DJ04E",24, 0)
	13156	;1.1 COMP LAINT
	13157	"RTN","HMP DJ04E",25, 0)
	13158	;.02 INST ITUTION
	13159	"RTN","HMP DJ04E",26, 0)
	13160	;.14 CLIN IC
	13161	"RTN","HMP DJ04E",27, 0)
	13162	;#3.2) ST ATUS [2P:2 33.1]
	13163	"RTN","HMP DJ04E",28, 0)
	13164	;(#3.3) A CUITY [3P: 233.1] ^
	13165	"RTN","HMP DJ04E",29, 0)
	13166	;(#3.4) L OC [4P:231 .8]
	13167	"RTN","HMP DJ04E",30, 0)
	13168	;(#3.5) M D ASSIGNED [5P:200]
	13169	"RTN","HMP DJ04E",31, 0)
	13170	;(#3.6) N URSE ASSIG NED [6P:20 0]
	13171	"RTN","HMP DJ04E",32, 0)
	13172	;(#3.7) R ESIDENT AS SIGNED [7P :200] ^
	13173	"RTN","HMP DJ04E",33, 0)
	13174	;#3.8) CO MMENT [8F]
	13175	"RTN","HMP DJ04E",34, 0)
	13176	;(#3.9) H ELD LOC [9 P:231.8] ^
	13177	"RTN","HMP DJ04E",35, 0)
	13178	S VST("lo calId")=ID ,VST("uid" )=$$SETUID ^HMPUTILS( "visit",DF N,ID)
	13179	"RTN","HMP DJ04E",36, 0)
	13180	S VST("da teTime")=$ $JSONDT^HM PUTILS(+X0 )
	13181	"RTN","HMP DJ04E",37, 0)
	13182	S:$G(EDP( 230,IENS,. 08,"I"))'= "" VST("st ay","arriv alDateTime ")=$$JSOND T^HMPUTILS ($G(EDP(23 0,IENS,.08 ,"I")))
	13183	"RTN","HMP DJ04E",38, 0)
	13184	S:$G(EDP( 230,IENS,. 09,"I"))'= "" VST("st ay","disch argeDateTi me")=$$JSO NDT^HMPUTI LS($G(EDP( 230,IENS,. 09,"I")))
	13185	"RTN","HMP DJ04E",39, 0)
	13186	S:$G(EDP( 230,IENS,. 02,"I"))'= "" FAC=$G( EDP(230,IE NS,.02,"I" ))
	13187	"RTN","HMP DJ04E",40, 0)
	13188	S:$G(EDP( 230,IENS,. 14,"I"))'= "" LOC=$G( EDP(230,IE NS,.14,"I" )),LOC0=$S (LOC:$G(^S C(LOC,0)), 1:"")
	13189	"RTN","HMP DJ04E",41, 0)
	13190	S:FAC X=$ $STA^XUAF4 (FAC)_U_$P ($$NS^XUAF 4(FAC),U)
	13191	"RTN","HMP DJ04E",42, 0)
	13192	S:'FAC X= $$FAC^HMPD (LOC) D FA CILITY^HMP UTILS(X,"V ST")
	13193	"RTN","HMP DJ04E",43, 0)
	13194	S VST("ca tegoryCode ")="urn:va :encounter -category: OV"
	13195	"RTN","HMP DJ04E",44, 0)
	13196	S VST("ca tegoryName ")="Outpat ient Visit "
	13197	"RTN","HMP DJ04E",45, 0)
	13198	S VST("pa tientClass Code")="ur n:va:patie nt-class:E MER"
	13199	"RTN","HMP DJ04E",46, 0)
	13200	S VST("pa tientClass Name")="Em ergency"
	13201	"RTN","HMP DJ04E",47, 0)
	13202	;
	13203	"RTN","HMP DJ04E",48, 0)
	13204	S X=$$CPT ^HMPDJ04(I D) S:$G(X) '="" VST(" typeName") =$P($$CPT^ ICPTCOD(X) ,U,3)
	13205	"RTN","HMP DJ04E",49, 0)
	13206	I 'X S VS T("typeNam e")=$S(LOC :$P(LOC0,U )_" VISIT" ,1:"EMERGE NCY")
	13207	"RTN","HMP DJ04E",50, 0)
	13208	S X=$P(X0 ,U,8) S:X AMIS=$$AMI S^HMPDVSIT (X) I LOC D
	13209	"RTN","HMP DJ04E",51, 0)
	13210	. I 'X S AMIS=$$AMI S^HMPDVSIT ($P(LOC0,U ,7))
	13211	"RTN","HMP DJ04E",52, 0)
	13212	. S VST(" locationUi d")=$$SETU ID^HMPUTIL S("locatio n",,+LOC)
	13213	"RTN","HMP DJ04E",53, 0)
	13214	. S VST(" locationNa me")=$P(LO C0,U)
	13215	"RTN","HMP DJ04E",54, 0)
	13216	. S X=$$S ERV^HMPDVS IT($P(LOC0 ,U,20)) Q: X=""
	13217	"RTN","HMP DJ04E",55, 0)
	13218	. S:$L(X) VST("serv ice")=X,VS T("summary ")="${"_VS T("service ")_"}:"_$P (LOC0,U)
	13219	"RTN","HMP DJ04E",56, 0)
	13220	S:$G(AMIS ) VST("sto pCodeUid") ="urn:va:s top-code:" _$P(AMIS,U ),VST("sto pCodeName" )=$P(AMIS, U,2)
	13221	"RTN","HMP DJ04E",57, 0)
	13222	;
	13223	"RTN","HMP DJ04E",58, 0)
	13224	S:$G(EDP( 230,IENS,1 .1,"E"))'= "" VST("re asonName") =$G(EDP(23 0,IENS,1.1 ,"E"))
	13225	"RTN","HMP DJ04E",59, 0)
	13226	S I=0 F S I=$O(^ED P(230,+IEN S,4,I)) Q: I<1 I $P( $G(^(I,0)) ,U,3) D ; primary Dx
	13227	"RTN","HMP DJ04E",60, 0)
	13228	. S X=$G( ^EDP(230,+ IENS,4,I,0 )),VST("re asonName") =$P(X,U) Q :'$P(X,U,2 )
	13229	"RTN","HMP DJ04E",61, 0)
	13230	. S ICD=$ $ICD^HMPDV SIT($P(X,U ,2)) Q:$L( ICD)'>1
	13231	"RTN","HMP DJ04E",62, 0)
	13232	. S VST(" reasonUid" )=$$SETNCS ^HMPUTILS( "icd",$P(I CD,U)),VST ("reasonNa me")=$P(IC D,U,2)
	13233	"RTN","HMP DJ04E",63, 0)
	13234	;
	13235	"RTN","HMP DJ04E",64, 0)
	13236	; provide r(s)
	13237	"RTN","HMP DJ04E",65, 0)
	13238	S I=0
	13239	"RTN","HMP DJ04E",66, 0)
	13240	I $G(EDP( 230,IENS,3 .5,"I"))'= "" S I=I+1 D PROV("V ST",I,$G(E DP(230,IEN S,3.5,"I") ),"P",1) ; primary/MD
	13241	"RTN","HMP DJ04E",67, 0)
	13242	I $G(EDP( 230,IENS,3 .6,"I"))'= "" S I=I+1 D PROV("V ST",I,$G(E DP(230,IEN S,3.6,"I") ),"P",1) ; nurse
	13243	"RTN","HMP DJ04E",68, 0)
	13244	I $G(EDP( 230,IENS,3 .7,"I"))'= "" S I=I+1 D PROV("V ST",I,$G(E DP(230,IEN S,3.7,"I") ),"P",1) ; resident
	13245	"RTN","HMP DJ04E",69, 0)
	13246	S:$G(EDP( 230,IENS,3 .8,"I"))'= "" VST("co mment")=$G (EDP(230,I ENS,3.8,"I "))
	13247	"RTN","HMP DJ04E",70, 0)
	13248	S:$G(EDP( 230,IENS,3 .3,"E")) V ST("appoin tmentStatu s")=$G(EDP (230,IENS, 3.3,"E"))
	13249	"RTN","HMP DJ04E",71, 0)
	13250	;
	13251	"RTN","HMP DJ04E",72, 0)
	13252	; note(s)
	13253	"RTN","HMP DJ04E",73, 0)
	13254	; TIU^HMP DJ04A(ID,. VST)
	13255	"RTN","HMP DJ04E",74, 0)
	13256	K ^TMP("P XKENC",$J, ID)
	13257	"RTN","HMP DJ04E",75, 0)
	13258	S VST("la stUpdateTi me")=$$EN^ HMPSTMP("v isit") ;RH L 20150102
	13259	"RTN","HMP DJ04E",76, 0)
	13260	S VST("st ampTime")= VST("lastU pdateTime" ) ; RHL 20 150102
	13261	"RTN","HMP DJ04E",77, 0)
	13262	;US6734 - pre-compi le metasta mp
	13263	"RTN","HMP DJ04E",78, 0)
	13264	I $G(HMPM ETA) D ADD ^HMPMETA(" visit",VST ("uid"),VS T("stampTi me")) Q:HM PMETA=1 ; US6734,US1 1019
	13265	"RTN","HMP DJ04E",79, 0)
	13266	D ADD^HMP DJ("VST"," visit")
	13267	"RTN","HMP DJ04E",80, 0)
	13268	Q
	13269	"RTN","HMP DJ04E",81, 0)
	13270	;
	13271	"RTN","HMP DJ04E",82, 0)
	13272	PROV(ARR,I ,IEN,ROLE, PRIM) ; -- add provi ders
	13273	"RTN","HMP DJ04E",83, 0)
	13274	S @ARR@(" providers" ,I,"provid erUid")=$$ SETUID^HMP UTILS("use r",,+IEN)
	13275	"RTN","HMP DJ04E",84, 0)
	13276	S @ARR@(" providers" ,I,"provid erName")=$ $GET1^DIQ( 200,(+IEN) _",",.01) ;DE2818, ICR 10060
	13277	"RTN","HMP DJ04E",85, 0)
	13278	S @ARR@(" providers" ,I,"role") =ROLE
	13279	"RTN","HMP DJ04E",86, 0)
	13280	S:$G(PRIM ) @ARR@("p roviders", I,"primary ")="true"
	13281	"RTN","HMP DJ04E",87, 0)
	13282	Q
	13283	"RTN","HMP DJ04E",88, 0)
	13284	;
	13285	"RTN","HMP DJ04E",89, 0)
	13286	NAME(X) ; -- name of a code in #233.1
	13287	"RTN","HMP DJ04E",90, 0)
	13288	Q
	13289	"RTN","HMP DJ04E",91, 0)
	13290	N Y S Y=$ P($G(^EDPB (233.1,+$G (X),0)),U, 2)
	13291	"RTN","HMP DJ04E",92, 0)
	13292	Q Y
	13293	"RTN","HMP DJ05")
	13294	0^40^B8568 2186
	13295	"RTN","HMP DJ05",1,0)
	13296	HMPDJ05 ;S LC/MKB,ASM R/RRB - Me dications by order;N ov 09, 201 5 15:12:10
	13297	"RTN","HMP DJ05",2,0)
	13298	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	13299	"RTN","HMP DJ05",3,0)
	13300	;Per VA D irective 6 402, this routine sh ould not b e modified .
	13301	"RTN","HMP DJ05",4,0)
	13302	;
	13303	"RTN","HMP DJ05",5,0)
	13304	; Externa l Referenc es: see HM PDJ05V for DBIA list
	13305	"RTN","HMP DJ05",6,0)
	13306	; ^OR(100 ) referenc es - ICR 5 771
	13307	"RTN","HMP DJ05",7,0)
	13308	;
	13309	"RTN","HMP DJ05",8,0)
	13310	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	13311	"RTN","HMP DJ05",9,0)
	13312	Q
	13313	"RTN","HMP DJ05",10,0 )
	13314	;
	13315	"RTN","HMP DJ05",11,0 )
	13316	PS1(ID) ; -- med ord er
	13317	"RTN","HMP DJ05",12,0 )
	13318	N $ES,$ET ,ERRPAT,ER RMSG
	13319	"RTN","HMP DJ05",13,0 )
	13320	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	13321	"RTN","HMP DJ05",14,0 )
	13322	S ERRMSG= "A problem occurred converting order "_I D_" for th e medicati on domain"
	13323	"RTN","HMP DJ05",15,0 )
	13324	N ORPK,TY PE S ID=+$ G(ID)
	13325	"RTN","HMP DJ05",16,0 )
	13326	S ORPK=$$ PKGID^ORX8 (ID),TYPE= $E(ORPK,$L (ORPK)) S: TYPE=+TYPE TYPE="R"
	13327	"RTN","HMP DJ05",17,0 )
	13328	;
	13329	"RTN","HMP DJ05",18,0 )
	13330	N ORUPCHU K,ORVP,ORP CL,ORDUZ,O RODT,ORSTR T,ORSTOP,O RL,ORTO,OR STS,ORNP,O RPV,ORTX
	13331	"RTN","HMP DJ05",19,0 )
	13332	N MED,CLS ,OI,X,LOC, FAC,DRUG,D A,CNT,HMPE SP
	13333	"RTN","HMP DJ05",20,0 )
	13334	S X=$S(OR PK:$E(ORPK ,$L(ORPK)) ,1:"Z") S: X=+X X="R" ;last cha r = PS fil e
	13335	"RTN","HMP DJ05",21,0 )
	13336	S CLS=$S( "RSN"[X:"O ","UV"[X:" I",1:$$GET 1^DIQ(100, ID_",",10, "I"))
	13337	"RTN","HMP DJ05",22,0 )
	13338	S MED("ui d")=$$SETU ID^HMPUTIL S("med",DF N,ID)
	13339	"RTN","HMP DJ05",23,0 )
	13340	S MED("or ders",1,"o rderUid")= $$SETUID^H MPUTILS("o rder",DFN, ID)
	13341	"RTN","HMP DJ05",24,0 )
	13342	S X=$$GET 1^DIQ(100, ID_",",9," I") S:X ME D("orders" ,1,"predec essor")=$$ SETUID^HMP UTILS("med ",DFN,+X)
	13343	"RTN","HMP DJ05",25,0 )
	13344	S X=$$GET 1^DIQ(100, ID_",",9.1 ,"I") S:X MED("order s",1,"succ essor")=$$ SETUID^HMP UTILS("med ",DFN,+X)
	13345	"RTN","HMP DJ05",26,0 )
	13346	S:ORPK ME D("localId ")=ORPK_"; "_CLS
	13347	"RTN","HMP DJ05",27,0 )
	13348	D EN^ORX8 (ID) S X=" " F S X=$ O(ORUPCHUK (X)) Q:X=" " S:$D(OR UPCHUK(X)) #2 @X=ORUP CHUK(X)
	13349	"RTN","HMP DJ05",28,0 )
	13350	S:$G(OROD T) MED("or ders",1,"o rdered")=$ $JSONDT^HM PUTILS(ORO DT)
	13351	"RTN","HMP DJ05",29,0 )
	13352	S:$G(ORNP ) MED("ord ers",1,"pr oviderUid" )=$$SETUID ^HMPUTILS( "user",,+O RNP),MED(" orders",1, "providerN ame")=$P(O RNP,U,2)
	13353	"RTN","HMP DJ05",30,0 )
	13354	S LOC=+$G (ORL),FAC= $$FAC^HMPD (LOC) I LO C D
	13355	"RTN","HMP DJ05",31,0 )
	13356	. S MED(" orders",1, "locationU id")=$$SET UID^HMPUTI LS("locati on",,LOC)
	13357	"RTN","HMP DJ05",32,0 )
	13358	. S MED(" orders",1, "locationN ame")=$$GE T1^DIQ(44, LOC_",",.0 1) ;DE281 8, ICR 100 40
	13359	"RTN","HMP DJ05",33,0 )
	13360	D FACILIT Y^HMPUTILS (FAC,"MED" )
	13361	"RTN","HMP DJ05",34,0 )
	13362	S:$G(ORST RT) MED("o verallStar t")=$$JSON DT^HMPUTIL S(ORSTRT)
	13363	"RTN","HMP DJ05",35,0 )
	13364	S:$G(ORST OP) (MED(" stopped"), MED("overa llStop"))= $$JSONDT^H MPUTILS(OR STOP)
	13365	"RTN","HMP DJ05",36,0 )
	13366	S MED("va Status")=$ P($G(ORSTS ),U,2)
	13367	"RTN","HMP DJ05",37,0 )
	13368	S MED("me dStatusNam e")=$$STAT US^HMPDPSO R(+$G(ORST S))
	13369	"RTN","HMP DJ05",38,0 )
	13370	S MED("me dStatus")= $$MEDSTAT^ HMPDJ05V(M ED("medSta tusName"))
	13371	"RTN","HMP DJ05",39,0 )
	13372	I CLS="I" D
	13373	"RTN","HMP DJ05",40,0 )
	13374	. S:$$GET 1^DIQ(44,L OC_",",280 2,"I") MED ("IMO")="t rue" ;DE2 818, ICR 1 0040, (#28 02) ADMINI STER INPAT IENT MEDS? [25S]
	13375	"RTN","HMP DJ05",41,0 )
	13376	. S X=$$G ET1^DIQ(10 0,ID_",",3 6) S:X MED ("parent") =X ;DE281 8, ICR 577 1, (#36) P ARENT
	13377	"RTN","HMP DJ05",42,0 )
	13378	I ORPK D OEL^PSOORR L(DFN,ORPK _";"_CLS)
	13379	"RTN","HMP DJ05",43,0 )
	13380	S X=$S(OR PK["N":"N" ,1:CLS),ME D("vaType" )=X,MED("m edType")=$ $TYPE^HMPD J05V(X)
	13381	"RTN","HMP DJ05",44,0 )
	13382	I CLS="O" S MED("ty pe")=$S(OR PK["N":"OT C",1:"Pres cription")
	13383	"RTN","HMP DJ05",45,0 )
	13384	S X=$G(HM PESP("COMM ENT",1)) S :$L(X) MED ("comment" )=X
	13385	"RTN","HMP DJ05",46,0 )
	13386	I $$ISIV^ HMPDJ05V G IV1^HMPDJ 05V
	13387	"RTN","HMP DJ05",47,0 )
	13388	;
	13389	"RTN","HMP DJ05",48,0 )
	13390	A ; - Get order resp onses
	13391	"RTN","HMP DJ05",49,0 )
	13392	S OI=$$OI ^ORX8(ID) I OI D
	13393	"RTN","HMP DJ05",50,0 )
	13394	. S X=$P( OI,U,2) S: $E(X,$L(X) )=" " X=$E (X,1,$L(X) -1)
	13395	"RTN","HMP DJ05",51,0 )
	13396	. S MED(" name")=X
	13397	"RTN","HMP DJ05",52,0 )
	13398	. D ZERO^ PSS50P7(+$ P(OI,U,3), ,,"PSOI")
	13399	"RTN","HMP DJ05",53,0 )
	13400	. S MED(" productFor mName")=$P ($G(^TMP($ J,"PSOI",+ $P(OI,U,3) ,.02)),U,2 )
	13401	"RTN","HMP DJ05",54,0 )
	13402	. S:+$G(^ TMP($J,"PS OI",+$P(OI ,U,3),.09) ) MED("sup ply")="tru e"
	13403	"RTN","HMP DJ05",55,0 )
	13404	D RESP^HM PDPSOR(ID, .HMPESP) ; order resp onses
	13405	"RTN","HMP DJ05",56,0 )
	13406	S DRUG=+$ G(^TMP("PS ",$J,"DD", 1,0)) S:'D RUG DRUG=+ $G(HMPESP( "DRUG",1))
	13407	"RTN","HMP DJ05",57,0 )
	13408	S MED("si g")=$S(CLS ="I":"Give : ",1:"")_ $G(HMPESP( "SIG",1)) ;ORTX(2)
	13409	"RTN","HMP DJ05",58,0 )
	13410	I CLS="O" ,'$L($G(HM PESP("SIG" ,1))),'$D( HMPESP("IN STR")) S M ED("sig")= $G(HMPESP( "COMMENT", 1)) ;old R x
	13411	"RTN","HMP DJ05",59,0 )
	13412	;
	13413	"RTN","HMP DJ05",60,0 )
	13414	B ; - Get dosages
	13415	"RTN","HMP DJ05",61,0 )
	13416	;DE2818 b egin, ^OR( 100) refer ences - IC R 5771
	13417	"RTN","HMP DJ05",62,0 )
	13418	I '$O(^OR (100,ID,2, 0)) D ;si ngle dose or OP
	13419	"RTN","HMP DJ05",63,0 )
	13420	. N HMPY, START,STOP ,DUR,CONJ, MIN
	13421	"RTN","HMP DJ05",64,0 )
	13422	. S START =$G(ORSTRT ),STOP=$G( ORSTOP),MI N=0
	13423	"RTN","HMP DJ05",65,0 )
	13424	. S CNT=0 F S CNT= $O(HMPESP( "INSTR",CN T)) Q:CNT< 1 D
	13425	"RTN","HMP DJ05",66,0 )
	13426	.. K HMPY D DOSE(.H MPY,CNT) M MED("dosa ges",CNT)= HMPY
	13427	"RTN","HMP DJ05",67,0 )
	13428	.. ;deter mine start & stop pe r dose
	13429	"RTN","HMP DJ05",68,0 )
	13430	.. S MED( "dosages", CNT,"relat iveStart") =MIN
	13431	"RTN","HMP DJ05",69,0 )
	13432	.. S DUR= $G(HMPY("c omplexDura tion")),CO NJ=$G(HMPY ("complexC onjunction "))
	13433	"RTN","HMP DJ05",70,0 )
	13434	.. S STOP =$S(DUR:$$ STOP(START ,DUR),1:ST OP)
	13435	"RTN","HMP DJ05",71,0 )
	13436	.. S:STAR T MED("dos ages",CNT, "start")=$ $JSONDT^HM PUTILS(STA RT)
	13437	"RTN","HMP DJ05",72,0 )
	13438	.. S:STOP MED("dosa ges",CNT," stop")=$$J SONDT^HMPU TILS(STOP)
	13439	"RTN","HMP DJ05",73,0 )
	13440	.. S X=$$ RELTIME(ST ART,STOP,D UR,MIN),ME D("dosages ",CNT,"rel ativeStop" )=$S($E(X) =".":0_X,1 :X)
	13441	"RTN","HMP DJ05",74,0 )
	13442	.. I $E(C ONJ)="T",D UR S START =STOP,MIN= X
	13443	"RTN","HMP DJ05",75,0 )
	13444	I $O(^OR( 100,ID,2,0 )) D
	13445	"RTN","HMP DJ05",76,0 )
	13446	. N DD,CO NJ,HMPY,MI N
	13447	"RTN","HMP DJ05",77,0 )
	13448	. M CONJ= HMPESP("CO NJ"),DUR=H MPESP("DAY S") S MIN= 0
	13449	"RTN","HMP DJ05",78,0 )
	13450	. S (DA,C NT)=0 F S DA=$O(^OR (100,ID,2, DA)) Q:DA< 1 D ;chi ld orders
	13451	"RTN","HMP DJ05",79,0 )
	13452	.. K HMPE SP,HMPY D RESP^HMPDP SOR(DA,.HM PESP),DOSE (.HMPY,1)
	13453	"RTN","HMP DJ05",80,0 )
	13454	.. S CNT= CNT+1 M ME D("dosages ",CNT)=HMP Y
	13455	"RTN","HMP DJ05",81,0 )
	13456	.. S MED( "dosages", CNT,"relat iveStart") =MIN
	13457	"RTN","HMP DJ05",82,0 )
	13458	.. S MED( "dosages", CNT,"compl exConjunct ion")=$G(C ONJ(CNT))
	13459	"RTN","HMP DJ05",83,0 )
	13460	.. S MED( "dosages", CNT,"compl exDuration ")=$G(DUR( CNT))
	13461	"RTN","HMP DJ05",84,0 )
	13462	.. S MED( "dosages", CNT,"relat edOrder")= DA
	13463	"RTN","HMP DJ05",85,0 )
	13464	.. S X=$P ($G(^OR(10 0,DA,0)),U ,8,9)
	13465	"RTN","HMP DJ05",86,0 )
	13466	.. S:$P(X ,U) MED("d osages",CN T,"start") =$$JSONDT^ HMPUTILS($ P(X,U))
	13467	"RTN","HMP DJ05",87,0 )
	13468	.. S:$P(X ,U,2) MED( "dosages", CNT,"stop" )=$$JSONDT ^HMPUTILS( $P(X,U,2))
	13469	"RTN","HMP DJ05",88,0 )
	13470	.. I $P(X ,U,2)>$G(O RSTOP) S O RSTOP=$P(X ,U,2) ;get last stop time
	13471	"RTN","HMP DJ05",89,0 )
	13472	.. S X=$$ RELTIME($P (X,U),$P(X ,U,2),$G(D UR(CNT)),M IN)
	13473	"RTN","HMP DJ05",90,0 )
	13474	.. S MED( "dosages", CNT,"relat iveStop")= $S($E(X)=" .":0_X,1:X ) S:$G(CON J(CNT))="T " MIN=X
	13475	"RTN","HMP DJ05",91,0 )
	13476	.. S:'DRU G DD=+$G(H MPESP("DRU G",1)),DD( DD,DA)="" ;dispense drug(s)
	13477	"RTN","HMP DJ05",92,0 )
	13478	.. ; get ^TMP("PS", $J) from 1 st child, if Inpt pa rent:
	13479	"RTN","HMP DJ05",93,0 )
	13480	.. I '$D( ^TMP("PS", $J)) S ORP K=$$PKGID^ ORX8(DA) D OEL^PSOOR RL(DFN,ORP K_";"_CLS)
	13481	"RTN","HMP DJ05",94,0 )
	13482	. S MED(" stopped")= $$JSONDT^H MPUTILS($G (ORSTOP)) ;reset fro m last chi ld order
	13483	"RTN","HMP DJ05",95,0 )
	13484	. S DD=$O (DD(0)) I DD,'$O(DD( DD)) S DRU G=DD Q ;1 drug fo r order
	13485	"RTN","HMP DJ05",96,0 )
	13486	. S (DD,C NT)=0 F S DD=$O(DD( DD)) Q:DD< 1 S DA=0 F S DA=$O (DD(DD,DA) ) Q:DA<1 S CNT=CNT+ 1 D NDF(DD ,CNT,DA)
	13487	"RTN","HMP DJ05",97,0 )
	13488	;
	13489	"RTN","HMP DJ05",98,0 )
	13490	;DE2818 e nd
	13491	"RTN","HMP DJ05",99,0 )
	13492	C ; - Get OP data
	13493	"RTN","HMP DJ05",100, 0)
	13494	I CLS="O" ,ORPK'["N" D
	13495	"RTN","HMP DJ05",101, 0)
	13496	. S MED(" orders",1, "quantityO rdered")=$ G(HMPESP(" QTY",1))
	13497	"RTN","HMP DJ05",102, 0)
	13498	. S MED(" orders",1, "daysSuppl y")=$G(HMP ESP("SUPPL Y",1))
	13499	"RTN","HMP DJ05",103, 0)
	13500	. S MED(" orders",1, "vaRouting ")=$G(HMPE SP("PICKUP ",1))
	13501	"RTN","HMP DJ05",104, 0)
	13502	. S MED(" orders",1, "fillsAllo wed")=$G(H MPESP("REF ILLS",1))
	13503	"RTN","HMP DJ05",105, 0)
	13504	. S MED(" patientIns truction") =$G(HMPESP ("PI",1))
	13505	"RTN","HMP DJ05",106, 0)
	13506	. Q:ORPK[ "P"!(ORPK[ "S") ;pen ding
	13507	"RTN","HMP DJ05",107, 0)
	13508	. N HMP,R X0,RX1,FIL L,RFD,MW,R EL
	13509	"RTN","HMP DJ05",108, 0)
	13510	. K ^TMP( "PSOR",$J) D EN^PSOO RDER(DFN,+ ORPK)
	13511	"RTN","HMP DJ05",109, 0)
	13512	. S RX0=$ G(^TMP("PS OR",$J,+OR PK,0)),RX1 =$G(^(1)), MED("order s",1,"pres criptionId ")=$P(RX0, U,5)
	13513	"RTN","HMP DJ05",110, 0)
	13514	. I '$G(H MPESP("QTY ",1)) S ME D("orders" ,1,"quanti tyOrdered" )=$P(RX0,U ,6)
	13515	"RTN","HMP DJ05",111, 0)
	13516	. I '$G(H MPESP("SUP PLY",1)) S MED("orde rs",1,"day sSupply")= $P(RX0,U,7 )
	13517	"RTN","HMP DJ05",112, 0)
	13518	. S MED(" orders",1, "fillsRema ining")=$P (RX0,U,9), MED("lastF illed")=$$ JSONDT^HMP UTILS($P(R X0,U,3))
	13519	"RTN","HMP DJ05",113, 0)
	13520	. S I=$P( RX0,U,2) I I S FILL( I)=I_"^^^" _$P(RX0,U, 6,7)_"^^^" _$P(RX0,U, 13)_"^^"_$ P(RX1,U,6) ;original fill
	13521	"RTN","HMP DJ05",114, 0)
	13522	. S I=0 F S I=$O(^ TMP("PSOR" ,$J,+ORPK, "REF",I)) Q:I<1 S X =$G(^(I,0) ),FILL(+X) =X
	13523	"RTN","HMP DJ05",115, 0)
	13524	. S I=0 F S I=$O(^ TMP("PSOR" ,$J,+ORPK, "RPAR",I)) Q:I<1 S X=$G(^(I,0 )),$P(X,U, 14)=1,FILL (+X)=X
	13525	"RTN","HMP DJ05",116, 0)
	13526	. S (I,RF D)=0 F S RFD=$O(FIL L(RFD)) Q: RFD<1 S X =$G(FILL(R FD)) D ;s ort 1st
	13527	"RTN","HMP DJ05",117, 0)
	13528	.. S I=I+ 1,MW=$P($P (X,U,10)," ;"),REL=$P ($P(X,U,8) ,".")
	13529	"RTN","HMP DJ05",118, 0)
	13530	.. S MED( "fills",I, "dispenseD ate")=$$JS ONDT^HMPUT ILS($P(RFD ,"."))
	13531	"RTN","HMP DJ05",119, 0)
	13532	.. S MED( "fills",I, "releaseDa te")=$$JSO NDT^HMPUTI LS(REL)
	13533	"RTN","HMP DJ05",120, 0)
	13534	.. S MED( "fills",I, "routing") =MW
	13535	"RTN","HMP DJ05",121, 0)
	13536	.. S MED( "fills",I, "quantityD ispensed") =$P(X,U,4)
	13537	"RTN","HMP DJ05",122, 0)
	13538	.. S MED( "fills",I, "daysSuppl yDispensed ")=$P(X,U, 5)
	13539	"RTN","HMP DJ05",123, 0)
	13540	.. S:$P(X ,U,14) MED ("fills",I ,"partial" )=1 ;"true "
	13541	"RTN","HMP DJ05",124, 0)
	13542	. S X=$S( $P(RX0,U,1 1):$P(RX0, U,11),$P(R X0,U,10):$ P(RX0,U,10 ),1:0)
	13543	"RTN","HMP DJ05",125, 0)
	13544	. S:X MED ("orders", 1,"fillCos t")=X
	13545	"RTN","HMP DJ05",126, 0)
	13546	. S X=$$G ET1^PSODI( 52,+ORPK_" ,",26,"I") S:X MED(" overallSto p")=$$JSON DT^HMPUTIL S($P(X,U,2 )) ;1^expi rationDate
	13547	"RTN","HMP DJ05",127, 0)
	13548	I CLS="I" D
	13549	"RTN","HMP DJ05",128, 0)
	13550	. S X=$$G ET1^DIQ(55 .06,+ORPK_ ","_DFN_", ",25,"I")
	13551	"RTN","HMP DJ05",129, 0)
	13552	. S:X MED ("overallS top")=$$JS ONDT^HMPUT ILS(X)
	13553	"RTN","HMP DJ05",130, 0)
	13554	. D BCMA^ HMPDJ05V(. MED,DFN,OR PK)
	13555	"RTN","HMP DJ05",131, 0)
	13556	;
	13557	"RTN","HMP DJ05",132, 0)
	13558	PSQ ; fini sh
	13559	"RTN","HMP DJ05",133, 0)
	13560	D:DRUG ND F(+DRUG)
	13561	"RTN","HMP DJ05",134, 0)
	13562	S MED("qu alifiedNam e")=$G(MED ("name"))
	13563	"RTN","HMP DJ05",135, 0)
	13564	S X=+$P($ G(^TMP("PS ",$J,"RXN" ,0)),U,5)
	13565	"RTN","HMP DJ05",136, 0)
	13566	S:X MED(" orders",1, "pharmacis tUid")=$$S ETUID^HMPU TILS("user ",,X),MED( "orders",1 ,"pharmaci stName")=$ $GET1^DIQ( 200,X_",", .01) ;DE2 818, ICR 1 0035
	13567	"RTN","HMP DJ05",137, 0)
	13568	K ^TMP("P S",$J),^TM P($J,"PSOI "),^TMP("P SOR",$J)
	13569	"RTN","HMP DJ05",138, 0)
	13570	S MED("la stUpdateTi me")=$$EN^ HMPSTMP("m ed") ;RHL 20150102
	13571	"RTN","HMP DJ05",139, 0)
	13572	S MED("st ampTime")= MED("lastU pdateTime" ) ; RHL 20 150102
	13573	"RTN","HMP DJ05",140, 0)
	13574	;US6734 - pre-compi le metasta mp
	13575	"RTN","HMP DJ05",141, 0)
	13576	I $G(HMPM ETA) D ADD ^HMPMETA(" med",MED(" uid"),MED( "stampTime ")) Q:HMPM ETA=1 ;US 6734,US110 19
	13577	"RTN","HMP DJ05",142, 0)
	13578	D ADD^HMP DJ("MED"," med")
	13579	"RTN","HMP DJ05",143, 0)
	13580	Q
	13581	"RTN","HMP DJ05",144, 0)
	13582	;
	13583	"RTN","HMP DJ05",145, 0)
	13584	DOSE(Y,N) ; -- retur n dosage d ata from H MPESP(ID,N ) to Y("na me")
	13585	"RTN","HMP DJ05",146, 0)
	13586	N X,DOSE, DUR,CONJ S N=+$G(N,1 ) K Y
	13587	"RTN","HMP DJ05",147, 0)
	13588	S Y("inst ructions") =$G(HMPESP ("INSTR",N ))
	13589	"RTN","HMP DJ05",148, 0)
	13590	S DOSE=$G (HMPESP("D OSE",N)),X =$P(DOSE," &",1,2)
	13591	"RTN","HMP DJ05",149, 0)
	13592	S:$L(X)>1 Y("dose") =$P(X,"&") ,Y("units" )=$P(X,"&" ,2)
	13593	"RTN","HMP DJ05",150, 0)
	13594	S X=$P(DO SE,"&",3,4 ) S:X Y("a mount")=$P (X,"&"),Y( "noun")=$P (X,"&",2)
	13595	"RTN","HMP DJ05",151, 0)
	13596	; Y("dose ")=$S($L(X )>2:$TR(X, "&"," "),1 :$P(X,"&") )
	13597	"RTN","HMP DJ05",152, 0)
	13598	S X=+$G(H MPESP("ROU TE",N)) D ALL^PSS51P 2(X,,,,"HM PTE")
	13599	"RTN","HMP DJ05",153, 0)
	13600	S Y("rout eName")=$G (^TMP($J," HMPTE",X,1 ))
	13601	"RTN","HMP DJ05",154, 0)
	13602	S X=$G(HM PESP("SCHE DULE",N)) I $L(X) S Y("schedul eName")=X D SCH^HMPD J05V(X)
	13603	"RTN","HMP DJ05",155, 0)
	13604	S X=$G(HM PESP("ADMI N",N)) S:$ L(X) Y("ad minTimes") =X
	13605	"RTN","HMP DJ05",156, 0)
	13606	S X=$G(HM PESP("DAYS ",N)) S:$L (X) Y("com plexDurati on")=X,DUR =X
	13607	"RTN","HMP DJ05",157, 0)
	13608	S X=$G(HM PESP("CONJ ",N)) S:$L (X) Y("com plexConjun ction")=X, CONJ=X
	13609	"RTN","HMP DJ05",158, 0)
	13610	I $L($G(C ONJ)),'$L( $G(DUR)) D ;look ah ead to fin d duration
	13611	"RTN","HMP DJ05",159, 0)
	13612	. N I,D S I=$O(HMPE SP("DAYS", N)),D=$S(I :$G(HMPESP ("DAYS",I) ),1:"")
	13613	"RTN","HMP DJ05",160, 0)
	13614	. S:$L(D) Y("comple xDuration" )=D
	13615	"RTN","HMP DJ05",161, 0)
	13616	K ^TMP($J ,"HMPTE")
	13617	"RTN","HMP DJ05",162, 0)
	13618	Q
	13619	"RTN","HMP DJ05",163, 0)
	13620	;
	13621	"RTN","HMP DJ05",164, 0)
	13622	STOP(BEG,X ) ; -- Ret urn date a fter addin g X to BEG
	13623	"RTN","HMP DJ05",165, 0)
	13624	N D,H,M,U NT,Y
	13625	"RTN","HMP DJ05",166, 0)
	13626	S Y=BEG,( D,H,M)=0,U NT=$P(X,+X ,2),X=+X
	13627	"RTN","HMP DJ05",167, 0)
	13628	S UNT=$S( $E(UNT)=" ":$E(UNT,2 ),1:$E(UNT )) I UNT=" " S UNT="D "
	13629	"RTN","HMP DJ05",168, 0)
	13630	S:UNT="L" D=30*X
	13631	"RTN","HMP DJ05",169, 0)
	13632	S:UNT="W" D=7*X
	13633	"RTN","HMP DJ05",170, 0)
	13634	S:UNT="D" D=X
	13635	"RTN","HMP DJ05",171, 0)
	13636	S:UNT="H" H=X
	13637	"RTN","HMP DJ05",172, 0)
	13638	S:UNT="M" M=X
	13639	"RTN","HMP DJ05",173, 0)
	13640	S Y=$$FMA DD^XLFDT(B EG,D,H,M)
	13641	"RTN","HMP DJ05",174, 0)
	13642	Q Y
	13643	"RTN","HMP DJ05",175, 0)
	13644	;
	13645	"RTN","HMP DJ05",176, 0)
	13646	NDF(DRUG,V PI,ORD) ; -- Set NDF data for dispense D RUG ien
	13647	"RTN","HMP DJ05",177, 0)
	13648	; code ^ name ^ vui d [^ role ^ concentr ation ^ or der]
	13649	"RTN","HMP DJ05",178, 0)
	13650	N LEN,HMP X,STR,VUID ,X,I
	13651	"RTN","HMP DJ05",179, 0)
	13652	S DRUG=+$ G(DRUG) Q: 'DRUG
	13653	"RTN","HMP DJ05",180, 0)
	13654	D EN^PSSD I(50,,50," 901;902",D RUG,"HMPX" )
	13655	"RTN","HMP DJ05",181, 0)
	13656	S STR=$S( $G(HMPX(50 ,DRUG,901) ):$G(HMPX( 50,DRUG,90 1))_" "_$G (HMPX(50,D RUG,902)), 1:"")
	13657	"RTN","HMP DJ05",182, 0)
	13658	D NDF^PSS 50(DRUG,,, ,,"NDF") S VPI=+$G(V PI,1)
	13659	"RTN","HMP DJ05",183, 0)
	13660	;
	13661	"RTN","HMP DJ05",184, 0)
	13662	S MED("pr oducts",VP I,"ingredi entRole")= "urn:sct:4 10942007" ;Drug
	13663	"RTN","HMP DJ05",185, 0)
	13664	S:$G(ORD) MED("prod ucts",VPI, "relatedOr der")=ORD
	13665	"RTN","HMP DJ05",186, 0)
	13666	S:$G(STR) MED("prod ucts",VPI, "strength" )=STR
	13667	"RTN","HMP DJ05",187, 0)
	13668	S X=$G(ME D("name")) S:$L(X) M ED("produc ts",VPI,"i ngredientN ame")=X
	13669	"RTN","HMP DJ05",188, 0)
	13670	;
	13671	"RTN","HMP DJ05",189, 0)
	13672	S X=$G(^T MP($J,"NDF ",DRUG,20) ) ;VA Gene ric
	13673	"RTN","HMP DJ05",190, 0)
	13674	S MED("pr oducts",VP I,"ingredi entCode")= "urn:va:vu id:"_$$VUI D^HMPD(+X, 50.6)
	13675	"RTN","HMP DJ05",191, 0)
	13676	S MED("pr oducts",VP I,"ingredi entCodeNam e")=$P(X,U ,2)
	13677	"RTN","HMP DJ05",192, 0)
	13678	;
	13679	"RTN","HMP DJ05",193, 0)
	13680	S X=$G(^T MP($J,"NDF ",DRUG,22) ) ;VA Prod uct
	13681	"RTN","HMP DJ05",194, 0)
	13682	S MED("pr oducts",VP I,"supplie dCode")="u rn:va:vuid :"_$$VUID^ HMPD(+X,50 .68)
	13683	"RTN","HMP DJ05",195, 0)
	13684	S MED("pr oducts",VP I,"supplie dName")=$P (X,U,2)
	13685	"RTN","HMP DJ05",196, 0)
	13686	;
	13687	"RTN","HMP DJ05",197, 0)
	13688	S X=$G(^T MP($J,"NDF ",DRUG,25) ) ;VA Drug Class
	13689	"RTN","HMP DJ05",198, 0)
	13690	S MED("pr oducts",VP I,"drugCla ssCode")=" urn:vadc:" _$P(X,U,2)
	13691	"RTN","HMP DJ05",199, 0)
	13692	S MED("pr oducts",VP I,"drugCla ssName")=$ P(X,U,3)
	13693	"RTN","HMP DJ05",200, 0)
	13694	;
	13695	"RTN","HMP DJ05",201, 0)
	13696	K ^TMP($J ,"NDF")
	13697	"RTN","HMP DJ05",202, 0)
	13698	Q
	13699	"RTN","HMP DJ05",203, 0)
	13700	;
	13701	"RTN","HMP DJ05",204, 0)
	13702	RELTIME(ST ART,STOP,D UR,MIN) ; -- Return #min for d ose
	13703	"RTN","HMP DJ05",205, 0)
	13704	N Y S Y=0
	13705	"RTN","HMP DJ05",206, 0)
	13706	I START>0 ,STOP>0 S Y=$$FMDIFF ^XLFDT(STO P,START,2) \60 I 1
	13707	"RTN","HMP DJ05",207, 0)
	13708	E I DUR S Y=$$TOMI N(DUR) I 1
	13709	"RTN","HMP DJ05",208, 0)
	13710	E S Y=$G (HMPESP("S UPPLY",1)) *1440
	13711	"RTN","HMP DJ05",209, 0)
	13712	S Y=$S(Y: Y+MIN,1:MI N)
	13713	"RTN","HMP DJ05",210, 0)
	13714	Q Y
	13715	"RTN","HMP DJ05",211, 0)
	13716	;
	13717	"RTN","HMP DJ05",212, 0)
	13718	TOMIN(DUR) ;
	13719	"RTN","HMP DJ05",213, 0)
	13720	N RESULT, TIME,UNIT
	13721	"RTN","HMP DJ05",214, 0)
	13722	S UNIT=$$ UP^XLFSTR( $E($P(DUR, " ",2)))
	13723	"RTN","HMP DJ05",215, 0)
	13724	I UNIT="" Q 0
	13725	"RTN","HMP DJ05",216, 0)
	13726	S TIME=$P (DUR," ")
	13727	"RTN","HMP DJ05",217, 0)
	13728	S RESULT= $S(UNIT="M ":TIME,UNI T="H":TIME 60,UNIT=" D":TIME14 40,UNIT="W ":TIME100 80,UNIT="L ":TIME432 00,1:0)
	13729	"RTN","HMP DJ05",218, 0)
	13730	Q RESULT
	13731	"RTN","HMP DJ05V")
	13732	0^41^B6906 5747
	13733	"RTN","HMP DJ05V",1,0 )
	13734	HMPDJ05V ; SLC/MKB,AS MR/RRB - I V/Infusion s;Nov 09, 2015 15:40 :35
	13735	"RTN","HMP DJ05V",2,0 )
	13736	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	13737	"RTN","HMP DJ05V",3,0 )
	13738	;Per VA D irective 6 402, this routine sh ould not b e modified .
	13739	"RTN","HMP DJ05V",4,0 )
	13740	;
	13741	"RTN","HMP DJ05V",5,0 )
	13742	; Externa l Referenc es DBIA#
	13743	"RTN","HMP DJ05V",6,0 )
	13744	; ------- ---------- -- -----
	13745	"RTN","HMP DJ05V",7,0 )
	13746	; ^OR(100 5771
	13747	"RTN","HMP DJ05V",8,0 )
	13748	; ^ORD(10 0.98 873
	13749	"RTN","HMP DJ05V",9,0 )
	13750	; ^ORD(10 1.43 2843
	13751	"RTN","HMP DJ05V",10, 0)
	13752	; ^PSB(53 .79 5909
	13753	"RTN","HMP DJ05V",11, 0)
	13754	; ^SC 10040
	13755	"RTN","HMP DJ05V",12, 0)
	13756	; ^VA(200 10060
	13757	"RTN","HMP DJ05V",13, 0)
	13758	; DIQ 2056
	13759	"RTN","HMP DJ05V",14, 0)
	13760	; ORQ1,^T MP("ORR" 3154
	13761	"RTN","HMP DJ05V",15, 0)
	13762	; ORX8 24 67,3071
	13763	"RTN","HMP DJ05V",16, 0)
	13764	; PSODI 4858
	13765	"RTN","HMP DJ05V",17, 0)
	13766	; PSOORDE R,^TMP("PS OR" 1878
	13767	"RTN","HMP DJ05V",18, 0)
	13768	; PSOORRL ,^TMP("PS" 2400
	13769	"RTN","HMP DJ05V",19, 0)
	13770	; PSS50 4533
	13771	"RTN","HMP DJ05V",20, 0)
	13772	; PSS50P7 4662
	13773	"RTN","HMP DJ05V",21, 0)
	13774	; PSS51P1 4546
	13775	"RTN","HMP DJ05V",22, 0)
	13776	; PSS51P2 4548
	13777	"RTN","HMP DJ05V",23, 0)
	13778	; PSS52P6 4549
	13779	"RTN","HMP DJ05V",24, 0)
	13780	; PSS52P7 4550
	13781	"RTN","HMP DJ05V",25, 0)
	13782	; PSSDI 4551
	13783	"RTN","HMP DJ05V",26, 0)
	13784	; XLFDT 10103
	13785	"RTN","HMP DJ05V",27, 0)
	13786	; XLFSTR 10104
	13787	"RTN","HMP DJ05V",28, 0)
	13788	;
	13789	"RTN","HMP DJ05V",29, 0)
	13790	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	13791	"RTN","HMP DJ05V",30, 0)
	13792	Q
	13793	"RTN","HMP DJ05V",31, 0)
	13794	;
	13795	"RTN","HMP DJ05V",32, 0)
	13796	ISIV() ; - - Return 1 or 0, if order is f or IV/infu sion
	13797	"RTN","HMP DJ05V",33, 0)
	13798	I ORPK["V " Q 1
	13799	"RTN","HMP DJ05V",34, 0)
	13800	I $P($G(O RTO),U,2)? 1"IV".E Q 1
	13801	"RTN","HMP DJ05V",35, 0)
	13802	I +$G(ORP CL)=130 Q 1
	13803	"RTN","HMP DJ05V",36, 0)
	13804	I $G(^TMP ("PS",$J," B",0)) Q 1
	13805	"RTN","HMP DJ05V",37, 0)
	13806	Q 0
	13807	"RTN","HMP DJ05V",38, 0)
	13808	;
	13809	"RTN","HMP DJ05V",39, 0)
	13810	IV1 ; -- I V fluid, I nfusion or der [conti nued from HMPDJ05]
	13811	"RTN","HMP DJ05V",40, 0)
	13812	; [Also e xpects ORP K, OEL^PSO ORRL data]
	13813	"RTN","HMP DJ05V",41, 0)
	13814	N PS,PS0, X,X0,RTE,I ,ADD,BASE
	13815	"RTN","HMP DJ05V",42, 0)
	13816	S MED("va Type")="V" ,MED("medT ype")="urn :sct:10590 3003"
	13817	"RTN","HMP DJ05V",43, 0)
	13818	S (ADD,BA SE)=""
	13819	"RTN","HMP DJ05V",44, 0)
	13820	I ORPK,$D (^TMP("PS" ,$J)) D G IVQ
	13821	"RTN","HMP DJ05V",45, 0)
	13822	. M PS=^T MP("PS",$J ) S PS0=$G (PS(0)),ME D("name")= $P(PS0,U)
	13823	"RTN","HMP DJ05V",46, 0)
	13824	. S X=$G( PS("MDR",1 ,0)) S:$L( X) MED("do sages",1," routeName" )=X
	13825	"RTN","HMP DJ05V",47, 0)
	13826	. S X=$P( $G(PS("SCH ",1,0)),U) I $L(X) D
	13827	"RTN","HMP DJ05V",48, 0)
	13828	.. S MED( "dosages", 1,"schedul eName")=X
	13829	"RTN","HMP DJ05V",49, 0)
	13830	.. N Y D SCH(X)
	13831	"RTN","HMP DJ05V",50, 0)
	13832	.. M MED( "dosages", 1)=Y
	13833	"RTN","HMP DJ05V",51, 0)
	13834	. S X=$G( PS("ADM",1 ,0)) S:$L( X) MED("do sages",1," adminTimes ")=X
	13835	"RTN","HMP DJ05V",52, 0)
	13836	. S X=$P( PS0,U,2) I X["INFUSE OVER" S M ED("dosage s",1,"dura tion")=X
	13837	"RTN","HMP DJ05V",53, 0)
	13838	. E S ME D("dosages ",1,"ivRat e")=X
	13839	"RTN","HMP DJ05V",54, 0)
	13840	. S X=$G( PS("IVLIM" ,0)) S:$L( X) MED("do sages",1," restrictio n")=$$IVLI M(X)
	13841	"RTN","HMP DJ05V",55, 0)
	13842	. S X=+$P ($G(PS("RX N",0)),U,5 )
	13843	"RTN","HMP DJ05V",56, 0)
	13844	. S:X MED ("orders", 1,"pharmac istUid")=$ $SETUID^HM PUTILS("us er",,X),ME D("orders" ,1,"pharma cistName") =$$GET1^DI Q(200,X_", ",.01) ;D E2818
	13845	"RTN","HMP DJ05V",57, 0)
	13846	. D IVP
	13847	"RTN","HMP DJ05V",58, 0)
	13848	; no med in PS (pen ding or ca ncelled), so use Ord er values
	13849	"RTN","HMP DJ05V",59, 0)
	13850	S RTE=+$$ VALUE^ORX8 (ID,"ROUTE ") I RTE D
	13851	"RTN","HMP DJ05V",60, 0)
	13852	. D ALL^P SS51P2(RTE ,,,,"HMPTE ")
	13853	"RTN","HMP DJ05V",61, 0)
	13854	. S MED(" dosages",1 ,"routeNam e")=$G(^TM P($J,"HMPT E",RTE,1))
	13855	"RTN","HMP DJ05V",62, 0)
	13856	S X=$$VAL UE^ORX8(ID ,"SCHEDULE ") I $L(X) D
	13857	"RTN","HMP DJ05V",63, 0)
	13858	. S MED(" dosages",1 ,"schedule Name")=X
	13859	"RTN","HMP DJ05V",64, 0)
	13860	. N Y D S CH(X)
	13861	"RTN","HMP DJ05V",65, 0)
	13862	. M MED(" dosages",1 )=Y
	13863	"RTN","HMP DJ05V",66, 0)
	13864	S X=$$VAL UE^ORX8(ID ,"ADMIN") S:$L(X) ME D("dosages ",1,"admin Times")=X
	13865	"RTN","HMP DJ05V",67, 0)
	13866	S X=$$VAL UE^ORX8(ID ,"RATE")
	13867	"RTN","HMP DJ05V",68, 0)
	13868	I X["INFU SE OVER" S MED("dosa ges",1,"du ration")=X
	13869	"RTN","HMP DJ05V",69, 0)
	13870	E S MED( "dosages", 1,"ivRate" )=X
	13871	"RTN","HMP DJ05V",70, 0)
	13872	;DE2818, ^OR(100) r eferences - ICR 5771
	13873	"RTN","HMP DJ05V",71, 0)
	13874	S I=0 F S I=$O(^OR (100,ID,.1 ,I)) Q:I<1 S X=+$G( ^(I,0)) D
	13875	"RTN","HMP DJ05V",72, 0)
	13876	. S X0=$$ GET1^DIQ(1 01.43,X_", ",.01),MED ("name")=$ P(X0,U) ; DE2818, IC R 2843
	13877	"RTN","HMP DJ05V",73, 0)
	13878	. S MED(" products", I,"ingredi entName")= $P(X0,U)
	13879	"RTN","HMP DJ05V",74, 0)
	13880	S X=$$VAL UE^ORX8(ID ,"DAYS") I $L(X) D S MED("dos ages",1,"r estriction ")=X
	13881	"RTN","HMP DJ05V",75, 0)
	13882	. I X?1.A 1.N S X=$$ IVLIM(X) Q
	13883	"RTN","HMP DJ05V",76, 0)
	13884	. ; CPRS format = " for a tota l of 3 dos es" or "wi th total v olume 100m l"
	13885	"RTN","HMP DJ05V",77, 0)
	13886	. F I=1:1 :$L(X) I $ E(X,I)=+$E (X,I) S X= $E(X,I,$L( X)) Q
	13887	"RTN","HMP DJ05V",78, 0)
	13888	IVQ ; done
	13889	"RTN","HMP DJ05V",79, 0)
	13890	K ^TMP("P S",$J),^TM P($J,"HMPT E")
	13891	"RTN","HMP DJ05V",80, 0)
	13892	S MED("qu alifiedNam e")=ADD_$S ($L(ADD)&$ L(BASE):" in ",1:"") _BASE
	13893	"RTN","HMP DJ05V",81, 0)
	13894	S MED("la stUpdateTi me")=$$EN^ HMPSTMP("m ed") ;RHL 20150102
	13895	"RTN","HMP DJ05V",82, 0)
	13896	S MED("st ampTime")= MED("lastU pdateTime" ) ; RHL 20 150102
	13897	"RTN","HMP DJ05V",83, 0)
	13898	D BCMA(.M ED,DFN,ORP K)
	13899	"RTN","HMP DJ05V",84, 0)
	13900	;US6734 - pre-compi le metasta mp
	13901	"RTN","HMP DJ05V",85, 0)
	13902	I $G(HMPM ETA) D ADD ^HMPMETA(" med",MED(" uid"),MED( "stampTime ")) Q:HMPM ETA=1 ;US 6734,US110 19
	13903	"RTN","HMP DJ05V",86, 0)
	13904	D ADD^HMP DJ("MED"," med")
	13905	"RTN","HMP DJ05V",87, 0)
	13906	Q
	13907	"RTN","HMP DJ05V",88, 0)
	13908	;
	13909	"RTN","HMP DJ05V",89, 0)
	13910	IVP ; -- a dd IV prod ucts
	13911	"RTN","HMP DJ05V",90, 0)
	13912	; [expect s PS("A") & PS("B") data array s from IV1 ]
	13913	"RTN","HMP DJ05V",91, 0)
	13914	N VPI,N,N AME,IEN,DR UG,OI,X S N=0
	13915	"RTN","HMP DJ05V",92, 0)
	13916	; IV Addi tives
	13917	"RTN","HMP DJ05V",93, 0)
	13918	S VPI=0 F S VPI=$O (PS("A",VP I)) Q:VPI< 1 D
	13919	"RTN","HMP DJ05V",94, 0)
	13920	. K ^TMP( $J,"HMPPSI V") S NAME =$P($G(PS( "A",VPI,0) ),U)
	13921	"RTN","HMP DJ05V",95, 0)
	13922	. D ZERO^ PSS52P6("" ,NAME,""," HMPPSIV")
	13923	"RTN","HMP DJ05V",96, 0)
	13924	. S IEN=$ O(^TMP($J, "HMPPSIV", 0)),DRUG=+ $G(^(IEN,1 )) Q:IEN<1
	13925	"RTN","HMP DJ05V",97, 0)
	13926	. S OI=$G (^TMP($J," HMPPSIV",I EN,15)) S: OI NAME=$$ NAME(+OI)
	13927	"RTN","HMP DJ05V",98, 0)
	13928	. S N=N+1 D:DRUG ND F(DRUG,N," A",NAME)
	13929	"RTN","HMP DJ05V",99, 0)
	13930	. S MED(" products", N,"strengt h")=$P($G( PS("A",VPI ,0)),U,2)
	13931	"RTN","HMP DJ05V",100 ,0)
	13932	; IV Base Solutions
	13933	"RTN","HMP DJ05V",101 ,0)
	13934	S VPI=0 F S VPI=$O (PS("B",VP I)) Q:VPI< 1 D
	13935	"RTN","HMP DJ05V",102 ,0)
	13936	. K ^TMP( $J,"HMPPSI V") S NAME =$P($G(PS( "B",VPI,0) ),U)
	13937	"RTN","HMP DJ05V",103 ,0)
	13938	. D ZERO^ PSS52P7("" ,NAME,""," HMPPSIV")
	13939	"RTN","HMP DJ05V",104 ,0)
	13940	. S IEN=$ O(^TMP($J, "HMPPSIV", 0)),DRUG=+ $G(^(IEN,1 )) Q:IEN<1
	13941	"RTN","HMP DJ05V",105 ,0)
	13942	. S OI=$G (^TMP($J," HMPPSIV",I EN,9)) S:O I NAME=$$N AME(+OI)
	13943	"RTN","HMP DJ05V",106 ,0)
	13944	. S N=N+1 D:DRUG ND F(DRUG,N," B",NAME)
	13945	"RTN","HMP DJ05V",107 ,0)
	13946	. S MED(" products", N,"volume" )=$P($G(PS ("B",VPI,0 )),U,2)
	13947	"RTN","HMP DJ05V",108 ,0)
	13948	K ^TMP($J ,"HMPPSIV" )
	13949	"RTN","HMP DJ05V",109 ,0)
	13950	Q
	13951	"RTN","HMP DJ05V",110 ,0)
	13952	;
	13953	"RTN","HMP DJ05V",111 ,0)
	13954	NAME(PSOI) ; -- retu rn name_fo rm of PS o rderable i tem
	13955	"RTN","HMP DJ05V",112 ,0)
	13956	N Y,HMPX S PSOI=+$G (PSOI),Y=" "
	13957	"RTN","HMP DJ05V",113 ,0)
	13958	D EN^PSSD I(50.7,,50 .7,".01;.0 2",PSOI,"H MPX")
	13959	"RTN","HMP DJ05V",114 ,0)
	13960	S:$D(HMPX ) Y=$G(HMP X(50.7,PSO I,.01))_" "_$G(HMPX( 50.7,PSOI, .02))
	13961	"RTN","HMP DJ05V",115 ,0)
	13962	Q Y
	13963	"RTN","HMP DJ05V",116 ,0)
	13964	;
	13965	"RTN","HMP DJ05V",117 ,0)
	13966	NDF(DRUG,V PI,ROLE,OI ) ; -- Set NDF data for dispen se DRUG ie n
	13967	"RTN","HMP DJ05V",118 ,0)
	13968	; code ^ name ^ vui d ^ role ^ concentra tion
	13969	"RTN","HMP DJ05V",119 ,0)
	13970	N HMPX,VU ID,X,I,CON C,NM
	13971	"RTN","HMP DJ05V",120 ,0)
	13972	S DRUG=+$ G(DRUG) Q: 'DRUG
	13973	"RTN","HMP DJ05V",121 ,0)
	13974	D NDF^PSS 50(DRUG,,, ,,"NDF")
	13975	"RTN","HMP DJ05V",122 ,0)
	13976	S CONC=$P ($G(PS(ROL E,VPI,0)), U,2),NM=""
	13977	"RTN","HMP DJ05V",123 ,0)
	13978	;
	13979	"RTN","HMP DJ05V",124 ,0)
	13980	S MED("pr oducts",VP I,"ingredi entRole")= $$ROLE(ROL E)
	13981	"RTN","HMP DJ05V",125 ,0)
	13982	S OI=$G(O I) S:$L(OI ) MED("pro ducts",VPI ,"ingredie ntName")=O I,NM=OI
	13983	"RTN","HMP DJ05V",126 ,0)
	13984	; NM=X
	13985	"RTN","HMP DJ05V",127 ,0)
	13986	;
	13987	"RTN","HMP DJ05V",128 ,0)
	13988	S X=$G(^T MP($J,"NDF ",DRUG,20) ) I X D ; VA Generic
	13989	"RTN","HMP DJ05V",129 ,0)
	13990	. S MED(" products", VPI,"ingre dientCode" )="urn:va: vuid:"_$$V UID^HMPD(+ X,50.6)
	13991	"RTN","HMP DJ05V",130 ,0)
	13992	. S MED(" products", VPI,"ingre dientCodeN ame")=$P(X ,U,2)
	13993	"RTN","HMP DJ05V",131 ,0)
	13994	;
	13995	"RTN","HMP DJ05V",132 ,0)
	13996	S X=$G(^T MP($J,"NDF ",DRUG,22) ) I X D ; VA Product
	13997	"RTN","HMP DJ05V",133 ,0)
	13998	. S MED(" products", VPI,"suppl iedCode")= "urn:va:vu id:"_$$VUI D^HMPD(+X, 50.68)
	13999	"RTN","HMP DJ05V",134 ,0)
	14000	. S MED(" products", VPI,"suppl iedName")= $P(X,U,2)_ " "_CONC
	14001	"RTN","HMP DJ05V",135 ,0)
	14002	. S:NM="" NM=$P(X,U ,2)
	14003	"RTN","HMP DJ05V",136 ,0)
	14004	;
	14005	"RTN","HMP DJ05V",137 ,0)
	14006	S X=$G(^T MP($J,"NDF ",DRUG,25) ) I X D ; VA Drug Cl ass
	14007	"RTN","HMP DJ05V",138 ,0)
	14008	. S MED(" products", VPI,"drugC lassCode") ="urn:vadc :"_$P(X,U, 2)
	14009	"RTN","HMP DJ05V",139 ,0)
	14010	. S MED(" products", VPI,"drugC lassName") =$P(X,U,3)
	14011	"RTN","HMP DJ05V",140 ,0)
	14012	. S:NM="" NM=$P(X,U ,3)
	14013	"RTN","HMP DJ05V",141 ,0)
	14014	;
	14015	"RTN","HMP DJ05V",142 ,0)
	14016	I $L(NM), ROLE="A" S ADD=ADD_$ S($L(ADD): ", ",1:"") _NM
	14017	"RTN","HMP DJ05V",143 ,0)
	14018	I $L(NM), ROLE="B" S BASE=BASE _$S($L(BAS E):", ",1: "")_NM
	14019	"RTN","HMP DJ05V",144 ,0)
	14020	K ^TMP($J ,"NDF",DRU G)
	14021	"RTN","HMP DJ05V",145 ,0)
	14022	Q
	14023	"RTN","HMP DJ05V",146 ,0)
	14024	;
	14025	"RTN","HMP DJ05V",147 ,0)
	14026	IVLIM(X) ; -- Return expanded version of IV Limit X
	14027	"RTN","HMP DJ05V",148 ,0)
	14028	I '$L($G( X)) Q ""
	14029	"RTN","HMP DJ05V",149 ,0)
	14030	N Y,VAL,U NT,I
	14031	"RTN","HMP DJ05V",150 ,0)
	14032	S Y="",X= $$UP^XLFST R(X)
	14033	"RTN","HMP DJ05V",151 ,0)
	14034	I X?1"DOS ES".E S X= "A"_$P(X," DOSES",2)
	14035	"RTN","HMP DJ05V",152 ,0)
	14036	S UNT=$E( X),VAL=0 F I=2:1:$L( X) I $E(X, I) S VAL=$ E(X,I,$L(X )) Q
	14037	"RTN","HMP DJ05V",153 ,0)
	14038	I UNT="A" S Y=+VAL_ $S(+VAL>1: " doses",1 :" dose")
	14039	"RTN","HMP DJ05V",154 ,0)
	14040	I UNT="D" S Y=+VAL_ $S(+VAL>1: " days",1: " day")
	14041	"RTN","HMP DJ05V",155 ,0)
	14042	I UNT="H" S Y=+VAL_ $S(+VAL>1: " hours",1 :" hour")
	14043	"RTN","HMP DJ05V",156 ,0)
	14044	I UNT="C" S Y=+VAL_ " CC"
	14045	"RTN","HMP DJ05V",157 ,0)
	14046	I UNT="M" S Y=+VAL_ " ml"
	14047	"RTN","HMP DJ05V",158 ,0)
	14048	I UNT="L" S Y=+VAL_ " L"
	14049	"RTN","HMP DJ05V",159 ,0)
	14050	Q Y
	14051	"RTN","HMP DJ05V",160 ,0)
	14052	;
	14053	"RTN","HMP DJ05V",161 ,0)
	14054	ROLE(X) ;
	14055	"RTN","HMP DJ05V",162 ,0)
	14056	N RESULT, TXT,Y
	14057	"RTN","HMP DJ05V",163 ,0)
	14058	S RESULT= "",TXT="ur n:sct:"
	14059	"RTN","HMP DJ05V",164 ,0)
	14060	S RESULT= $S(X="A":T XT_"418804 003",X="B" :TXT_"4182 97009",1:T XT_"410942 007")
	14061	"RTN","HMP DJ05V",165 ,0)
	14062	Q RESULT
	14063	"RTN","HMP DJ05V",166 ,0)
	14064	;
	14065	"RTN","HMP DJ05V",167 ,0)
	14066	MEDSTAT(X) ;
	14067	"RTN","HMP DJ05V",168 ,0)
	14068	N Y S Y=" urn:sct:"
	14069	"RTN","HMP DJ05V",169 ,0)
	14070	S Y=Y_$S( X="active" :"55561003 ",X="histo rical":"39 2521001"," hold":"421 139008",1: "73425007" )
	14071	"RTN","HMP DJ05V",170 ,0)
	14072	Q Y
	14073	"RTN","HMP DJ05V",171 ,0)
	14074	;
	14075	"RTN","HMP DJ05V",172 ,0)
	14076	TYPE(VA) ;
	14077	"RTN","HMP DJ05V",173 ,0)
	14078	N RESULT, TXT,Y
	14079	"RTN","HMP DJ05V",174 ,0)
	14080	S RESULT= "",TXT="ur n:sct:"
	14081	"RTN","HMP DJ05V",175 ,0)
	14082	S RESULT= $S(VA="N": TXT_"32950 5003",VA=" O":TXT_"73 639000",1: TXT_"10590 3003")
	14083	"RTN","HMP DJ05V",176 ,0)
	14084	Q RESULT
	14085	"RTN","HMP DJ05V",177 ,0)
	14086	;
	14087	"RTN","HMP DJ05V",178 ,0)
	14088	SCH(NAME) ; -- Retur n other sc hedule inf o
	14089	"RTN","HMP DJ05V",179 ,0)
	14090	N I K ^TM P($J,"HMPS ")
	14091	"RTN","HMP DJ05V",180 ,0)
	14092	I NAME?.E 1" PRN" S NAME=$P(NA ME," PRN") Q:NAME="" ;strip o ff PRN for search
	14093	"RTN","HMP DJ05V",181 ,0)
	14094	D ZERO^PS S51P1("",N AME,"PSJ", ,"HMPS")
	14095	"RTN","HMP DJ05V",182 ,0)
	14096	S I=+$O(^ TMP($J,"HM PS","B",NA ME,0)) Q:' I
	14097	"RTN","HMP DJ05V",183 ,0)
	14098	S Y("sche duleFreq") =+$G(^TMP( $J,"HMPS", I,2))
	14099	"RTN","HMP DJ05V",184 ,0)
	14100	S Y("sche duleType") =$P($G(^TM P($J,"HMPS ",I,5)),U, 2)
	14101	"RTN","HMP DJ05V",185 ,0)
	14102	K ^TMP($J ,"HMPS")
	14103	"RTN","HMP DJ05V",186 ,0)
	14104	Q
	14105	"RTN","HMP DJ05V",187 ,0)
	14106	;
	14107	"RTN","HMP DJ05V",188 ,0)
	14108	BCMA(RET,D FN,ORPK) ; -- admini stration t imes
	14109	"RTN","HMP DJ05V",189 ,0)
	14110	Q:$G(DFN) <1 Q:$G(O RPK)<1
	14111	"RTN","HMP DJ05V",190 ,0)
	14112	N LAST,AD T,DA,CNT,X ,Y,N,NODE, X0,DRUG,HM PDT
	14113	"RTN","HMP DJ05V",191 ,0)
	14114	;DE2818 b egin, ^PSB (53.79) re ferences - ICR 5909
	14115	"RTN","HMP DJ05V",192 ,0)
	14116	S LAST=$P ($O(^PSB(5 3.79,"AORD X",DFN,ORP K,9999999) ,-1),".")
	14117	"RTN","HMP DJ05V",193 ,0)
	14118	S ADT=$$F MADD^XLFDT (LAST,-90) ;return m ost recent 90 days
	14119	"RTN","HMP DJ05V",194 ,0)
	14120	S CNT=0 F S ADT=$O (^PSB(53.7 9,"AORDX", DFN,ORPK,A DT)) Q:ADT <1 D
	14121	"RTN","HMP DJ05V",195 ,0)
	14122	. S DA=0 F S DA=+$ O(^PSB(53. 79,"AORDX" ,DFN,ORPK, ADT,DA)) Q :DA<1 D
	14123	"RTN","HMP DJ05V",196 ,0)
	14124	.. S X=$$ GET1^DIQ(5 3.79,DA_", ",.09) Q:X ="REMOVED" ;status
	14125	"RTN","HMP DJ05V",197 ,0)
	14126	.. S Y("s tatus")=X, Y("dateTim e")=$$JSON DT^HMPUTIL S(ADT)
	14127	"RTN","HMP DJ05V",198 ,0)
	14128	.. S X=+$ P($G(^PSB( 53.79,DA,0 )),U,7) I X D
	14129	"RTN","HMP DJ05V",199 ,0)
	14130	... S Y(" administer edByUid")= $$SETUID^H MPUTILS("u ser",,X)
	14131	"RTN","HMP DJ05V",200 ,0)
	14132	... S Y(" administer edByName") =$$GET1^DI Q(200,X_", ",.01) ;D E2818
	14133	"RTN","HMP DJ05V",201 ,0)
	14134	.. S X=$P ($G(^PSB(5 3.79,DA,.1 )),U,6) S: $L(X) Y("i njectionSi te")=X
	14135	"RTN","HMP DJ05V",202 ,0)
	14136	.. S X=$G (^PSB(53.7 9,DA,.2)) ;PRN
	14137	"RTN","HMP DJ05V",203 ,0)
	14138	.. S:$L($ P(X,U,1)) Y("prnReas on")=$P(X, U)
	14139	"RTN","HMP DJ05V",204 ,0)
	14140	.. S:$L($ P(X,U,2)) Y("prnEffe ctiveness" )=$P(X,U,2 )
	14141	"RTN","HMP DJ05V",205 ,0)
	14142	.. ; comm ents
	14143	"RTN","HMP DJ05V",206 ,0)
	14144	.. S N=0 F S N=$O( ^PSB(53.79 ,DA,.3,N)) Q:N<1 S X=$G(^(N,0 )) D
	14145	"RTN","HMP DJ05V",207 ,0)
	14146	... S Y(" comment",N ,"text")=$ P(X,U)
	14147	"RTN","HMP DJ05V",208 ,0)
	14148	... S:$P( X,U,3) Y(" comment",N ,"dateTime ")=$$JSOND T^HMPUTILS ($P(X,U,3) )
	14149	"RTN","HMP DJ05V",209 ,0)
	14150	... S X=+ $P(X,U,2) Q:X<1
	14151	"RTN","HMP DJ05V",210 ,0)
	14152	... S Y(" comment",N ,"enteredB yUid")=$$S ETUID^HMPU TILS("user ",,X)
	14153	"RTN","HMP DJ05V",211 ,0)
	14154	... S Y(" comment",N ,"enteredB yName")=$$ GET1^DIQ(2 00,X_",",. 01) ;DE28 18
	14155	"RTN","HMP DJ05V",212 ,0)
	14156	.. ; drug s administ ered
	14157	"RTN","HMP DJ05V",213 ,0)
	14158	.. F NODE =.5,.6,.7 S N=0 F S N=$O(^PSB (53.79,DA, NODE,N)) Q :N<1 S X0 =$G(^(N,0) ) D
	14159	"RTN","HMP DJ05V",214 ,0)
	14160	... S X=$ P(X0,U,2)
	14161	"RTN","HMP DJ05V",215 ,0)
	14162	... I NOD E=.5 S X=$ G(DRUG(+X0 )) S:X="" X=$$EXTERN AL^DILFD(5 3.795,.01, ,+X0),DRUG (+X0)=X
	14163	"RTN","HMP DJ05V",216 ,0)
	14164	... S:$L( X) Y("medi cation",N, "name")=X
	14165	"RTN","HMP DJ05V",217 ,0)
	14166	... S X=$ P(X0,U,3) S:$L(X) Y( "medicatio n",N,"amou nt")=X
	14167	"RTN","HMP DJ05V",218 ,0)
	14168	... S X=$ P(X0,U,4) S:$L(X) Y( "medicatio n",N,"unit s")=X
	14169	"RTN","HMP DJ05V",219 ,0)
	14170	.. S CNT= CNT+1 M RE T("adminis trations", CNT)=Y
	14171	"RTN","HMP DJ05V",220 ,0)
	14172	;DE2818 e nd, ^PSB(5 3.79) refe rences - I CR 5909
	14173	"RTN","HMP DJ05V",221 ,0)
	14174	; get nex t schedule d administ ration tim e
	14175	"RTN","HMP DJ05V",222 ,0)
	14176	;D ADMIN^ PSBHMP(.HM PDT,DFN,OR PK) ; <<< 12.3
	14177	"RTN","HMP DJ05V",223 ,0)
	14178	D ADMIN^P SBVPR(.HMP DT,DFN,ORP K) ; <<<< 12.3
	14179	"RTN","HMP DJ05V",224 ,0)
	14180	S:$G(HMPD T) RET("ne xtAdminTim e")=HMPDT
	14181	"RTN","HMP DJ05V",225 ,0)
	14182	Q
	14183	"RTN","HMP DJ06")
	14184	0^42^B6403 7338
	14185	"RTN","HMP DJ06",1,0)
	14186	HMPDJ06 ;S LC/MKB,ASM R/RRB - La boratory;N ov 12, 201 5 18:20:53
	14187	"RTN","HMP DJ06",2,0)
	14188	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	14189	"RTN","HMP DJ06",3,0)
	14190	;Per VA D irective 6 402, this routine sh ould not b e modified .
	14191	"RTN","HMP DJ06",4,0)
	14192	;
	14193	"RTN","HMP DJ06",5,0)
	14194	; Externa l Referenc es DBIA#
	14195	"RTN","HMP DJ06",6,0)
	14196	; ------- ---------- -- -----
	14197	"RTN","HMP DJ06",7,0)
	14198	; ^LAB(60 91
	14199	"RTN","HMP DJ06",8,0)
	14200	; ^LR 525
	14201	"RTN","HMP DJ06",9,0)
	14202	; ^PXRMIN DX 4290
	14203	"RTN","HMP DJ06",10,0 )
	14204	; ^TMP("L RRR" [LR7O R1] 2503
	14205	"RTN","HMP DJ06",11,0 )
	14206	; DIQ 2056
	14207	"RTN","HMP DJ06",12,0 )
	14208	; LR7OR1, ^TMP("LRRR " 2503
	14209	"RTN","HMP DJ06",13,0 )
	14210	; LRPXAPI 4245
	14211	"RTN","HMP DJ06",14,0 )
	14212	; LRPXAPI U 4246
	14213	"RTN","HMP DJ06",15,0 )
	14214	; XLFSTR 10104
	14215	"RTN","HMP DJ06",16,0 )
	14216	; XUAF4 2171
	14217	"RTN","HMP DJ06",17,0 )
	14218	;
	14219	"RTN","HMP DJ06",18,0 )
	14220	; All tag s expect D FN, ID, LR DFN, [HMPS TART, HMPS TOP, HMPMA X, HMPTEXT ]
	14221	"RTN","HMP DJ06",19,0 )
	14222	; & ^ TMP("LRRR" ,$J,DFN,HM PSUB,HMPID T,HMPP),HM PN
	14223	"RTN","HMP DJ06",20,0 )
	14224	Q
	14225	"RTN","HMP DJ06",21,0 )
	14226	;
	14227	"RTN","HMP DJ06",22,0 )
	14228	CH1 ; -- l ab ID = CH ;HMPIDT;HM PN
	14229	"RTN","HMP DJ06",23,0 )
	14230	N LAB,LRI ,X,X0,SPC, LOINC,ORD, CMMT
	14231	"RTN","HMP DJ06",24,0 )
	14232	N $ES,$ET ,ERRPAT,ER RMSG
	14233	"RTN","HMP DJ06",25,0 )
	14234	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	14235	"RTN","HMP DJ06",26,0 )
	14236	S ERRMSG= "A problem occurred converting record "_ ID_" for t he chemist ry domain"
	14237	"RTN","HMP DJ06",27,0 )
	14238	;
	14239	"RTN","HMP DJ06",28,0 )
	14240	M LAB=HMP ACC ;get a ccession i nfo
	14241	"RTN","HMP DJ06",29,0 )
	14242	S LAB("lo calId")=ID ,LAB("uid" )=$$SETUID ^HMPUTILS( "lab",DFN, ID)
	14243	"RTN","HMP DJ06",30,0 )
	14244	S LAB("ca tegoryCode ")="urn:va :lab-categ ory:CH"
	14245	"RTN","HMP DJ06",31,0 )
	14246	S LAB("ca tegoryName ")="Labora tory"
	14247	"RTN","HMP DJ06",32,0 )
	14248	S LAB("di splayOrder ")=HMPP
	14249	"RTN","HMP DJ06",33,0 )
	14250	S LRI=$G( ^LR(LRDFN, "CH",HMPID T,HMPN)) ;DE2818, ^ LR( - ICR5 25
	14251	"RTN","HMP DJ06",34,0 )
	14252	S X0=$G(^ TMP("LRRR" ,$J,DFN,"C H",HMPIDT, HMPP)),SPC =+$P(X0,U, 19)
	14253	"RTN","HMP DJ06",35,0 )
	14254	;DE2818 - ^LAB(60) references - ICR 91
	14255	"RTN","HMP DJ06",36,0 )
	14256	S LAB("ty peId")=+X0 ,LAB("type Name")=$P( $G(^LAB(60 ,+X0,0)),U )
	14257	"RTN","HMP DJ06",37,0 )
	14258	S:$L($P(X 0,U,2)) LA B("result" )=$P(X0,U, 2)
	14259	"RTN","HMP DJ06",38,0 )
	14260	S:$L($P(X 0,U,4)) LA B("units") =$P(X0,U,4 )
	14261	"RTN","HMP DJ06",39,0 )
	14262	S X=$P(X0 ,U,5) I $L (X),X["-" S LAB("low ")=$$TRIM^ XLFSTR($P( X,"-")),LA B("high")= $$TRIM^XLF STR($P(X," -",2))
	14263	"RTN","HMP DJ06",40,0 )
	14264	S X=$P(X0 ,U,3) I $L (X) D
	14265	"RTN","HMP DJ06",41,0 )
	14266	. S:X["*" X=$S(X["L ":"LL",1:" HH")
	14267	"RTN","HMP DJ06",42,0 )
	14268	. S LAB(" interpreta tionCode") ="urn:hl7: observatio n-interpre tation:"_X
	14269	"RTN","HMP DJ06",43,0 )
	14270	. S LAB(" interpreta tionName") =$S(X["L": "Low",1:"H igh")_$S($ L(X)>1:" a lert",1:"" )
	14271	"RTN","HMP DJ06",44,0 )
	14272	S LAB("di splayName" )=$S($L($P (X0,U,15)) :$P(X0,U,1 5),1:LAB(" test"))
	14273	"RTN","HMP DJ06",45,0 )
	14274	S ORD=+$P (X0,U,17) S:ORD LAB( "labOrderI d")=ORD
	14275	"RTN","HMP DJ06",46,0 )
	14276	S X=$$ORD ER^HMPDLR( ORD,+X0) S :X LAB("or derUid")=$ $SETUID^HM PUTILS("or der",DFN,X )
	14277	"RTN","HMP DJ06",47,0 )
	14278	S LOINC=$ P($P(LRI,U ,3),"!",3) ;S:'LOINC LOINC=$$L OINC^HMPDJ 06X(+X0,SP C)
	14279	"RTN","HMP DJ06",48,0 )
	14280	I LOINC S LAB("type Code")="ur n:lnc:"_$$ GET1^DIQ(9 5.3,+LOINC _",",.01), LAB("vuid" )="urn:va: vuid:"_$$V UID^HMPD(+ LOINC,95.3 )
	14281	"RTN","HMP DJ06",49,0 )
	14282	I 'LOINC S LAB("typ eCode")="u rn:va:ien: 60:"_+X0_" :"_SPC
	14283	"RTN","HMP DJ06",50,0 )
	14284	I $D(^TMP ("LRRR",$J ,DFN,"CH", HMPIDT,"N" )) M CMMT= ^("N") S L AB("commen t")=$$STRI NG^HMPD(.C MMT)
	14285	"RTN","HMP DJ06",51,0 )
	14286	S LAB("st atusCode") ="urn:va:l ab-status: completed" ,LAB("stat usName")=" completed"
	14287	"RTN","HMP DJ06",52,0 )
	14288	S LAB("la stUpdateTi me")=$$EN^ HMPSTMP("l ab") ;RHL 20150102
	14289	"RTN","HMP DJ06",53,0 )
	14290	S LAB("st ampTime")= LAB("lastU pdateTime" ) ; RHL 20 150102
	14291	"RTN","HMP DJ06",54,0 )
	14292	;US6734 - pre-compi le metasta mp
	14293	"RTN","HMP DJ06",55,0 )
	14294	I $G(HMPM ETA) D ADD ^HMPMETA(" lab",LAB(" uid"),LAB( "stampTime ")) Q:HMPM ETA=1 ;US 6734,US110 19
	14295	"RTN","HMP DJ06",56,0 )
	14296	D ADD^HMP DJ("LAB"," lab")
	14297	"RTN","HMP DJ06",57,0 )
	14298	Q
	14299	"RTN","HMP DJ06",58,0 )
	14300	;
	14301	"RTN","HMP DJ06",59,0 )
	14302	ACC ; -- p ut accessi on-level d ata in HMP ACC("attri bute")
	14303	"RTN","HMP DJ06",60,0 )
	14304	N LR0,CDT ,SPC,X K H MPACC
	14305	"RTN","HMP DJ06",61,0 )
	14306	S LR0=$G( ^LR(LRDFN, HMPSUB,HMP IDT,0)) ; DE2818, ^L R( - ICR52 5
	14307	"RTN","HMP DJ06",62,0 )
	14308	S CDT=999 9999-HMPID T,HMPACC(" observed") =$$DATE(CD T)
	14309	"RTN","HMP DJ06",63,0 )
	14310	S HMPACC( "resulted" )=$$DATE($ P(LR0,U,3) ),SPC=+$P( LR0,U,5) I SPC D
	14311	"RTN","HMP DJ06",64,0 )
	14312	. N IENS, HMPY S IEN S=SPC_","
	14313	"RTN","HMP DJ06",65,0 )
	14314	. D GETS^ DIQ(61,IEN S,".01;4.1 ",,"HMPY")
	14315	"RTN","HMP DJ06",66,0 )
	14316	. S HMPAC C("specime n")=$G(HMP Y(61,IENS, .01))
	14317	"RTN","HMP DJ06",67,0 )
	14318	. S HMPAC C("sample" )=$G(HMPY( 61,IENS,4. 1))
	14319	"RTN","HMP DJ06",68,0 )
	14320	S HMPACC( "groupUid" )=$$SETUID ^HMPUTILS( "accession ",DFN,HMPS UB_";"_HMP IDT)
	14321	"RTN","HMP DJ06",69,0 )
	14322	S HMPACC( "groupName ")=$P(LR0, U,6)
	14323	"RTN","HMP DJ06",70,0 )
	14324	S X=+$P(L R0,U,14) D D FACILI TY^HMPUTIL S(X,"HMPAC C")
	14325	"RTN","HMP DJ06",71,0 )
	14326	. S:X X=$ $STA^XUAF4 (X)_U_$P($ $NS^XUAF4( X),U)
	14327	"RTN","HMP DJ06",72,0 )
	14328	. I 'X S X=$$FAC^HM PD ;local stn#^name
	14329	"RTN","HMP DJ06",73,0 )
	14330	Q
	14331	"RTN","HMP DJ06",74,0 )
	14332	;
	14333	"RTN","HMP DJ06",75,0 )
	14334	MI ; -- mi crobiology accession ID = MI;H MPIDT
	14335	"RTN","HMP DJ06",76,0 )
	14336	N LAB,CDT ,LR0,X,ACC ,FAC,X0,X1 ,X2,IDX,HM PM,HMPPX,H MPITM,DA,F LD
	14337	"RTN","HMP DJ06",77,0 )
	14338	N $ES,$ET ,ERRPAT,ER RMSG
	14339	"RTN","HMP DJ06",78,0 )
	14340	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	14341	"RTN","HMP DJ06",79,0 )
	14342	S ERRMSG= "A problem occurred converting record "_ ID_" for t he microbi ology doma in"
	14343	"RTN","HMP DJ06",80,0 )
	14344	;
	14345	"RTN","HMP DJ06",81,0 )
	14346	S LAB("lo calId")=ID ,LAB("uid" )=$$SETUID ^HMPUTILS( "lab",DFN, ID)
	14347	"RTN","HMP DJ06",82,0 )
	14348	S LAB("ca tegoryCode ")="urn:va :lab-categ ory:MI"
	14349	"RTN","HMP DJ06",83,0 )
	14350	S LAB("ca tegoryName ")="Microb iology"
	14351	"RTN","HMP DJ06",84,0 )
	14352	S LAB("st atusCode") ="urn:va:l ab-status: completed" ,LAB("stat usName")=" completed"
	14353	"RTN","HMP DJ06",85,0 )
	14354	S CDT=999 9999-HMPID T,LAB("obs erved")=$$ DATE(CDT)
	14355	"RTN","HMP DJ06",86,0 )
	14356	S LR0=$G( ^LR(LRDFN, "MI",HMPID T,0)) ; D E2818, ^LR ( - ICR525
	14357	"RTN","HMP DJ06",87,0 )
	14358	S:$P(LR0, U,3) LAB(" resulted") =$$DATE($P (LR0,U,3))
	14359	"RTN","HMP DJ06",88,0 )
	14360	S X=+$P(L R0,U,5) I X D ;spec imen
	14361	"RTN","HMP DJ06",89,0 )
	14362	. N IENS, HMPY S IEN S=X_","
	14363	"RTN","HMP DJ06",90,0 )
	14364	. D GETS^ DIQ(61,IEN S,".01;2", ,"HMPY")
	14365	"RTN","HMP DJ06",91,0 )
	14366	. S LAB(" specimen") =$G(HMPY(6 1,IENS,.01 ))
	14367	"RTN","HMP DJ06",92,0 )
	14368	. S LAB(" sample")=$ $GET1^DIQ( 61,X_",",4 .1)
	14369	"RTN","HMP DJ06",93,0 )
	14370	S LAB("gr oupName")= $P(LR0,U,6 ),ACC=$P(I D,";",1,2) ;accessio n#
	14371	"RTN","HMP DJ06",94,0 )
	14372	S LAB("gr oupUid")=$ $SETUID^HM PUTILS("ac cession",D FN,ACC)
	14373	"RTN","HMP DJ06",95,0 )
	14374	S X=$P(LR 0,U,14),FA C=$S(X:$$S TA^XUAF4(X )_U_$P($$N S^XUAF4(X) ,U),1:$$FA C^HMPD)
	14375	"RTN","HMP DJ06",96,0 )
	14376	D FACILIT Y^HMPUTILS (FAC,"LAB" )
	14377	"RTN","HMP DJ06",97,0 )
	14378	; get res ults from ^TMP
	14379	"RTN","HMP DJ06",98,0 )
	14380	S HMPN=0 F S HMPN= $O(^TMP("L RRR",$J,DF N,HMPSUB,H MPIDT,HMPN )) Q:HMPN< 1 D
	14381	"RTN","HMP DJ06",99,0 )
	14382	. S X0=$G (^TMP("LRR R",$J,DFN, "MI",HMPID T,HMPN)),X 1=$P(X0,U) ,X2=$P(X0, U,2)
	14383	"RTN","HMP DJ06",100, 0)
	14384	. I X1="U RINE SCREE N" S LAB(" urineScree n")=X2 Q
	14385	"RTN","HMP DJ06",101, 0)
	14386	. ; X1="O RGANISM" S LAB("orga nism")=$P( X2,";"),LA B("organis mQty")=$P( X2,";",2)
	14387	"RTN","HMP DJ06",102, 0)
	14388	. I X1="G RAM STAIN" S LAB("gr amStain",H MPN,"resul t")=X2 Q
	14389	"RTN","HMP DJ06",103, 0)
	14390	. I X1="B acteriolog y Remark(s )" S LAB(" bactRemark s")=X2 Q
	14391	"RTN","HMP DJ06",104, 0)
	14392	; get oth er results from ^PXR MINDX
	14393	"RTN","HMP DJ06",105, 0)
	14394	S X=$O(^P XRMINDX(63 ,"PDI",DFN ,CDT,"M;T; 0")) I X?1 "M;T;"1.N D
	14395	"RTN","HMP DJ06",106, 0)
	14396	. S IDX=$ O(^PXRMIND X(63,"PDI" ,DFN,CDT,X ,"")) K HM PM
	14397	"RTN","HMP DJ06",107, 0)
	14398	. D LRPXR M^LRPXAPI( .HMPM,IDX, X) Q:HMPM< 1
	14399	"RTN","HMP DJ06",108, 0)
	14400	. S LAB(" typeName") =$P(HMPM,U ,2)
	14401	"RTN","HMP DJ06",109, 0)
	14402	. S LAB(" typeCode") ="urn:va:i en:60:"_+H MPM_":"_+$ P(HMPM,U,7 )
	14403	"RTN","HMP DJ06",110, 0)
	14404	F HMPPX=" M;O;","M;A ;" D
	14405	"RTN","HMP DJ06",111, 0)
	14406	. S HMPIT M=HMPPX F S HMPITM= $O(^PXRMIN DX(63,"PDI ",DFN,CDT, HMPITM)) Q :$E(HMPITM ,1,4)'=HMP PX D
	14407	"RTN","HMP DJ06",112, 0)
	14408	.. S IDX= $O(^PXRMIN DX(63,"PDI ",DFN,CDT, HMPITM,"") ) K HMPM
	14409	"RTN","HMP DJ06",113, 0)
	14410	.. S DA=$ P(IDX,";", 5),FLD=$P( IDX,";",6)
	14411	"RTN","HMP DJ06",114, 0)
	14412	.. D LRPX RM^LRPXAPI (.HMPM,IDX ,HMPITM) Q :'$L($G(HM PM))
	14413	"RTN","HMP DJ06",115, 0)
	14414	.. I HMPP X["O" S LA B("organis ms",DA,"na me")=$P(HM PM,U,2),LA B("organis ms",DA,"qt y")=$P(HMP M,U,4) Q
	14415	"RTN","HMP DJ06",116, 0)
	14416	.. I HMPP X["A" D Q
	14417	"RTN","HMP DJ06",117, 0)
	14418	... S LAB ("organism s",DA,"dru gs",FLD,"n ame")=$P(H MPM,U,2)
	14419	"RTN","HMP DJ06",118, 0)
	14420	... S LAB ("organism s",DA,"dru gs",FLD,"r esult")=$P (HMPM,U,3)
	14421	"RTN","HMP DJ06",119, 0)
	14422	... S LAB ("organism s",DA,"dru gs",FLD,"i nterp")=$P (HMPM,U,4)
	14423	"RTN","HMP DJ06",120, 0)
	14424	... S:$L( $P(HMPM,U, 5)) LAB("o rganisms", DA,"drugs" ,FLD,"rest rict")=$P( HMPM,U,5)
	14425	"RTN","HMP DJ06",121, 0)
	14426	;
	14427	"RTN","HMP DJ06",122, 0)
	14428	S LAB("re sults",1," uid")=ACC
	14429	"RTN","HMP DJ06",123, 0)
	14430	S LAB("re sults",1," resultUid" )=$$SETUID ^HMPUTILS( "document" ,DFN,ACC)
	14431	"RTN","HMP DJ06",124, 0)
	14432	S LAB("re sults",1," localTitle ")="LR MIC ROBIOLOGY REPORT"
	14433	"RTN","HMP DJ06",125, 0)
	14434	I $L($G(^ LR(LRDFN," MI",HMPIDT ,99))) S L AB("commen t")=^(99) ; DE2818, ^LR( - IC R525
	14435	"RTN","HMP DJ06",126, 0)
	14436	S LAB("la stUpdateTi me")=$$EN^ HMPSTMP("l ab") ;RHL 20150102
	14437	"RTN","HMP DJ06",127, 0)
	14438	S LAB("st ampTime")= LAB("lastU pdateTime" ) ; RHL 20 150102
	14439	"RTN","HMP DJ06",128, 0)
	14440	;US6734 - pre-compi le metasta mp
	14441	"RTN","HMP DJ06",129, 0)
	14442	I $G(HMPM ETA) D ADD ^HMPMETA(" lab",LAB(" uid"),LAB( "stampTime ")) Q:HMPM ETA=1 ;US 6734,US110 19
	14443	"RTN","HMP DJ06",130, 0)
	14444	D ADD^HMP DJ("LAB"," lab")
	14445	"RTN","HMP DJ06",131, 0)
	14446	Q
	14447	"RTN","HMP DJ06",132, 0)
	14448	;
	14449	"RTN","HMP DJ06",133, 0)
	14450	ITEM() ; - - find ITE M string f rom ^PXRMI NDX [uses LRDFN,ID,D FN,CDT]
	14451	"RTN","HMP DJ06",134, 0)
	14452	N ITM,IDX ,Y S Y=""
	14453	"RTN","HMP DJ06",135, 0)
	14454	S IDX=LRD FN_";"_ID, ITM="M"
	14455	"RTN","HMP DJ06",136, 0)
	14456	F S ITM= $O(^PXRMIN DX(63,"PI" ,DFN,ITM)) Q:$E(ITM) '="M" I $ D(^PXRMIND X(63,"PI", DFN,ITM,CD T,IDX)) S Y=ITM Q
	14457	"RTN","HMP DJ06",137, 0)
	14458	Q Y
	14459	"RTN","HMP DJ06",138, 0)
	14460	;
	14461	"RTN","HMP DJ06",139, 0)
	14462	AP ; -- pa thology ID = HMPSUB; HMPIDT
	14463	"RTN","HMP DJ06",140, 0)
	14464	N LAB,LR0 ,X,I,NODE
	14465	"RTN","HMP DJ06",141, 0)
	14466	N $ES,$ET ,ERRPAT,ER RMSG
	14467	"RTN","HMP DJ06",142, 0)
	14468	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	14469	"RTN","HMP DJ06",143, 0)
	14470	S ERRMSG= "A problem occurred converting record "_ ID_" for t he patholo gy domain"
	14471	"RTN","HMP DJ06",144, 0)
	14472	;
	14473	"RTN","HMP DJ06",145, 0)
	14474	S LAB("lo calId")=ID ,LAB("orga nizerType" )="accessi on"
	14475	"RTN","HMP DJ06",146, 0)
	14476	S LAB("ui d")=$$SETU ID^HMPUTIL S("lab",DF N,ID)
	14477	"RTN","HMP DJ06",147, 0)
	14478	S LAB("ca tegoryCode ")="urn:va :lab-categ ory:"_HMPS UB
	14479	"RTN","HMP DJ06",148, 0)
	14480	S LAB("ca tegoryName ")=$S(HMPS UB="BB":"B lood Bank" ,HMPSUB="S P":"Surgic al Patholo gy",1:"Pat hology")
	14481	"RTN","HMP DJ06",149, 0)
	14482	S LAB("st atusCode") ="urn:va:l ab-status: completed" ,LAB("stat usName")=" completed"
	14483	"RTN","HMP DJ06",150, 0)
	14484	S CDT=999 9999-HMPID T,LAB("obs erved")=$$ DATE(CDT)
	14485	"RTN","HMP DJ06",151, 0)
	14486	;DE2818 b egin, ^LR( reference s - ICR525
	14487	"RTN","HMP DJ06",152, 0)
	14488	S LR0=$G( ^LR(LRDFN, HMPSUB,HMP IDT,0))
	14489	"RTN","HMP DJ06",153, 0)
	14490	S LAB("re sulted")=$ $DATE($P(L R0,U,11)), LAB("group Name")=$P( LR0,U,6)
	14491	"RTN","HMP DJ06",154, 0)
	14492	S X="",I= 0 F S I=$ O(^LR(LRDF N,HMPSUB,H MPIDT,.1,I )) Q:I<1 S X=X_$S($ L(X):", ", 1:"")_$P($ G(^(I,0)), U)
	14493	"RTN","HMP DJ06",155, 0)
	14494	S:$L(X) L AB("specim en")=X
	14495	"RTN","HMP DJ06",156, 0)
	14496	D FACILIT Y^HMPUTILS ($$FAC^HMP D,"LAB")
	14497	"RTN","HMP DJ06",157, 0)
	14498	S NODE=$S (HMPSUB="A U":$NA(^LR (LRDFN,101 )),1:$NA(^ LR(LRDFN,H MPSUB,HMPI DT,.05)))
	14499	"RTN","HMP DJ06",158, 0)
	14500	S I=0 F S I=$O(@NO DE@(I)) Q: I<1 S X=+ $P($G(@NOD E@(I,0)),U ,2) I X D
	14501	"RTN","HMP DJ06",159, 0)
	14502	. N LT S LT=$$GET1^ DIQ(8925,+ X_",",.01) Q:$P(LT," ")="Adden dum"
	14503	"RTN","HMP DJ06",160, 0)
	14504	. S LAB(" results",I ,"uid")=LA B("uid")
	14505	"RTN","HMP DJ06",161, 0)
	14506	. S LAB(" results",I ,"resultUi d")=$$SETU ID^HMPUTIL S("documen t",DFN,X)
	14507	"RTN","HMP DJ06",162, 0)
	14508	. S LAB(" results",I ,"localTit le")=LT
	14509	"RTN","HMP DJ06",163, 0)
	14510	I '$O(LAB ("results" ,0)) D ;n on-TIU rep orts
	14511	"RTN","HMP DJ06",164, 0)
	14512	. S LAB(" results",1 ,"uid")=LA B("uid")
	14513	"RTN","HMP DJ06",165, 0)
	14514	. S LAB(" results",1 ,"resultUi d")=$$SETU ID^HMPUTIL S("documen t",DFN,ID)
	14515	"RTN","HMP DJ06",166, 0)
	14516	. S LAB(" results",1 ,"localTit le")="LR " _$$NAME^HM PDLRA(HMPS UB)_" REPO RT"
	14517	"RTN","HMP DJ06",167, 0)
	14518	; ;DE2818 end, ^LR( reference s - ICR525
	14519	"RTN","HMP DJ06",168, 0)
	14520	S LAB("la stUpdateTi me")=$$EN^ HMPSTMP("l ab") ;RHL 20150102
	14521	"RTN","HMP DJ06",169, 0)
	14522	S LAB("st ampTime")= LAB("lastU pdateTime" ) ; RHL 20 150102
	14523	"RTN","HMP DJ06",170, 0)
	14524	;US6734 - pre-compi le metasta mp
	14525	"RTN","HMP DJ06",171, 0)
	14526	I $G(HMPM ETA) D ADD ^HMPMETA(" lab",LAB(" uid"),LAB( "stampTime ")) Q:HMPM ETA=1 ;US 6734,US110 19
	14527	"RTN","HMP DJ06",172, 0)
	14528	D ADD^HMP DJ("LAB"," lab")
	14529	"RTN","HMP DJ06",173, 0)
	14530	;
	14531	"RTN","HMP DJ06",174, 0)
	14532	DATE(X) ; -- strip o ff seconds , return J SON format
	14533	"RTN","HMP DJ06",175, 0)
	14534	N Y S Y=$ G(X)
	14535	"RTN","HMP DJ06",176, 0)
	14536	I $L($P(Y ,".",2))>4 S Y=$P(Y, ".")_"."_$ E($P(Y,"." ,2),1,4) ; strip seco nds
	14537	"RTN","HMP DJ06",177, 0)
	14538	S:Y Y=$$J SONDT^HMPU TILS(Y)
	14539	"RTN","HMP DJ06",178, 0)
	14540	Q Y
	14541	"RTN","HMP DJ07")
	14542	0^43^B2695 5013
	14543	"RTN","HMP DJ07",1,0)
	14544	HMPDJ07 ;S LC/MKB,ASM R/RRB - Ra diology,Su rgery;6/25 /12 16:11
	14545	"RTN","HMP DJ07",2,0)
	14546	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	14547	"RTN","HMP DJ07",3,0)
	14548	;Per VA D irective 6 402, this routine sh ould not b e modified .
	14549	"RTN","HMP DJ07",4,0)
	14550	;
	14551	"RTN","HMP DJ07",5,0)
	14552	; Externa l Referenc es DBIA#
	14553	"RTN","HMP DJ07",6,0)
	14554	; ------- ---------- -- -----
	14555	"RTN","HMP DJ07",7,0)
	14556	; ^SC 10040
	14557	"RTN","HMP DJ07",8,0)
	14558	; ^VA(200 10060
	14559	"RTN","HMP DJ07",9,0)
	14560	; DIC 2051
	14561	"RTN","HMP DJ07",10,0 )
	14562	; DIQ 2056
	14563	"RTN","HMP DJ07",11,0 )
	14564	; RAO7PC1 20 43,2265
	14565	"RTN","HMP DJ07",12,0 )
	14566	; SROESTV 3533
	14567	"RTN","HMP DJ07",13,0 )
	14568	;
	14569	"RTN","HMP DJ07",14,0 )
	14570	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	14571	"RTN","HMP DJ07",15,0 )
	14572	Q
	14573	"RTN","HMP DJ07",16,0 )
	14574	;
	14575	"RTN","HMP DJ07",17,0 )
	14576	RA1(ID) ; -- radiolo gy exam ^T MP($J,"RAE 1",DFN,ID)
	14577	"RTN","HMP DJ07",18,0 )
	14578	N EXAM,X0 ,SET,PROC, DATE,LOC,X ,Y,IENS,ID 3,N
	14579	"RTN","HMP DJ07",19,0 )
	14580	N $ES,$ET ,ERRPAT,ER RMSG
	14581	"RTN","HMP DJ07",20,0 )
	14582	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	14583	"RTN","HMP DJ07",21,0 )
	14584	S ERRMSG= "A problem occurred converting record "_ ID_" for t he radiolo gy domain"
	14585	"RTN","HMP DJ07",22,0 )
	14586	;
	14587	"RTN","HMP DJ07",23,0 )
	14588	S X0=$G(^ TMP($J,"RA E1",DFN,ID )),SET=$G( ^(ID,"CPRS ")),PROC=$ P(X0,U) Q: X0=""
	14589	"RTN","HMP DJ07",24,0 )
	14590	S EXAM("l ocalId")=I D,EXAM("ui d")=$$SETU ID^HMPUTIL S("image", DFN,ID)
	14591	"RTN","HMP DJ07",25,0 )
	14592	S EXAM("n ame")=PROC ,EXAM("cas e")=$P(X0, U,2),EXAM( "category" )="RA"
	14593	"RTN","HMP DJ07",26,0 )
	14594	S DATE=99 99999.9999 -+ID,EXAM( "dateTime" )=$$JSONDT ^HMPUTILS( DATE)
	14595	"RTN","HMP DJ07",27,0 )
	14596	I $P(X0,U ,5) D ;re port exist s
	14597	"RTN","HMP DJ07",28,0 )
	14598	. N NM S NM=$S(+SET =2:$P(SET, U,2),1:PRO C) ;2 = sh ared repor t
	14599	"RTN","HMP DJ07",29,0 )
	14600	. S EXAM( "results", 1,"uid")=$ $SETUID^HM PUTILS("do cument",DF N,ID)
	14601	"RTN","HMP DJ07",30,0 )
	14602	. S EXAM( "results", 1,"localTi tle")=NM
	14603	"RTN","HMP DJ07",31,0 )
	14604	. S EXAM( "verified" )=$S($E($P (X0,U,3))= "V":"true" ,1:"false" )
	14605	"RTN","HMP DJ07",32,0 )
	14606	S:$L($P(X 0,U,6)) EX AM("status Name")=$P( $P(X0,U,6) ,"~",2)
	14607	"RTN","HMP DJ07",33,0 )
	14608	S X=$P(X0 ,U,7),LOC= "" I $L(X) D
	14609	"RTN","HMP DJ07",34,0 )
	14610	. S EXAM( "imageLoca tion")=X,E XAM("locat ionName")= X
	14611	"RTN","HMP DJ07",35,0 )
	14612	. S LOC=+ $O(^SC("B" ,X,0)) ;IC R 10040 DE 2818 ASF 1 1/10/15
	14613	"RTN","HMP DJ07",36,0 )
	14614	. S EXAM( "locationU id")=$$SET UID^HMPUTI LS("locati on",,LOC)
	14615	"RTN","HMP DJ07",37,0 )
	14616	S X=$$FAC ^HMPD(LOC) D FACILIT Y^HMPUTILS (X,"EXAM")
	14617	"RTN","HMP DJ07",38,0 )
	14618	I $L($P(X 0,U,8)) S X=$P($P(X0 ,U,8),"~", 2),EXAM("i magingType Uid")=$$SE TVURN^HMPU TILS("imag ing-Type", X)
	14619	"RTN","HMP DJ07",39,0 )
	14620	S X=$P(X0 ,U,10) I X D
	14621	"RTN","HMP DJ07",40,0 )
	14622	. N CPT S CPT=$$CPT ^HMPDRA(X)
	14623	"RTN","HMP DJ07",41,0 )
	14624	. S (EXAM ("typeName "),EXAM("s ummary"))= $P(CPT,U,2 )
	14625	"RTN","HMP DJ07",42,0 )
	14626	. ;I $D(^ TMP($J,"RA E1",DFN,ID ,"CMOD")) M EXAM("mo difier")=^ ("CMOD")
	14627	"RTN","HMP DJ07",43,0 )
	14628	I $P(X0,U ,11) D
	14629	"RTN","HMP DJ07",44,0 )
	14630	. S EXAM( "orderUid" )=$$SETUID ^HMPUTILS( "order",DF N,+$P(X0,U ,11))
	14631	"RTN","HMP DJ07",45,0 )
	14632	. S EXAM( "orderName ")=$S($L(S ET):$P(SET ,U,2),1:PR OC)
	14633	"RTN","HMP DJ07",46,0 )
	14634	S EXAM("h asImages") =$S($P(X0, U,12)="Y": "true",1:" false")
	14635	"RTN","HMP DJ07",47,0 )
	14636	I $P(X0,U ,4)="Y"!($ P(X0,U,9)= "Y") S EXA M("interpr etation")= "ABNORMAL"
	14637	"RTN","HMP DJ07",48,0 )
	14638	S IENS=$P (ID,"-",2) _","_+ID_" ,"_DFN_","
	14639	"RTN","HMP DJ07",49,0 )
	14640	S X=$$GET 1^DIQ(70.0 3,IENS,27, "I") I X D
	14641	"RTN","HMP DJ07",50,0 )
	14642	. S EXAM( "encounter Uid")=$$SE TUID^HMPUT ILS("visit ",DFN,+X)
	14643	"RTN","HMP DJ07",51,0 )
	14644	. S EXAM( "encounter Name")=$$N AME^HMPDJ0 4(+X)
	14645	"RTN","HMP DJ07",52,0 )
	14646	S ID3=DFN _U_$TR(ID, "-","^") D EN3^RAO7P C1(ID3) D ;get addi tional val ues
	14647	"RTN","HMP DJ07",53,0 )
	14648	. S EXAM( "reason")= $G(^TMP($J ,"RAE2",DF N,+$P(ID3, U,3),PROC, "RFS"))
	14649	"RTN","HMP DJ07",54,0 )
	14650	. S X=+$G (^TMP($J," RAE2",DFN, +$P(ID3,U, 3),PROC,"P ")) D:X
	14651	"RTN","HMP DJ07",55,0 )
	14652	.. S EXAM ("provider s",1,"prov iderUid")= $$SETUID^H MPUTILS("u ser",,X)
	14653	"RTN","HMP DJ07",56,0 )
	14654	.. S EXAM ("provider s",1,"prov iderName") =$P($G(^VA (200,X,0)) ,U) ;ICR 1 0060 DE281 8 ASF 11/1 0/15
	14655	"RTN","HMP DJ07",57,0 )
	14656	. S N=0 F S N=$O(^ TMP($J,"RA E2",DFN,+$ P(ID3,U,3) ,PROC,"D", N)) Q:N<1 S X=$G(^( N)) D
	14657	"RTN","HMP DJ07",58,0 )
	14658	.. S EXAM ("diagnosi s",N,"code ")=X
	14659	"RTN","HMP DJ07",59,0 )
	14660	.. S:N=1 EXAM("diag nosis",N," primary")= "true"
	14661	"RTN","HMP DJ07",60,0 )
	14662	.. N EXP S EXP=$$LE X(X) S:EXP EXAM("dia gnosis",N, "lexicon") =X
	14663	"RTN","HMP DJ07",61,0 )
	14664	. K ^TMP( $J,"RAE2", DFN)
	14665	"RTN","HMP DJ07",62,0 )
	14666	S EXAM("k ind")="Ima ging"
	14667	"RTN","HMP DJ07",63,0 )
	14668	S EXAM("l astUpdateT ime")=$$EN ^HMPSTMP(" image") ;R HL 2015010 2
	14669	"RTN","HMP DJ07",64,0 )
	14670	S EXAM("s tampTime") =EXAM("las tUpdateTim e") ; RHL 20150102
	14671	"RTN","HMP DJ07",65,0 )
	14672	;US6734 - pre-compi le metasta mp
	14673	"RTN","HMP DJ07",66,0 )
	14674	I $G(HMPM ETA) D ADD ^HMPMETA(" image",EXA M("uid"),E XAM("stamp Time")) Q: HMPMETA=1 ;US6734,U S11019
	14675	"RTN","HMP DJ07",67,0 )
	14676	D ADD^HMP DJ("EXAM", "image")
	14677	"RTN","HMP DJ07",68,0 )
	14678	Q
	14679	"RTN","HMP DJ07",69,0 )
	14680	;
	14681	"RTN","HMP DJ07",70,0 )
	14682	LEX(X) ; - - Return L exicon ptr for a Dx Code
	14683	"RTN","HMP DJ07",71,0 )
	14684	N Y,DIC,L EX
	14685	"RTN","HMP DJ07",72,0 )
	14686	S DIC=78. 3,DIC(0)=" BFOXZ" D ^ DIC
	14687	"RTN","HMP DJ07",73,0 )
	14688	S LEX=$P( $G(Y(0)),U ,6)
	14689	"RTN","HMP DJ07",74,0 )
	14690	Q LEX
	14691	"RTN","HMP DJ07",75,0 )
	14692	;
	14693	"RTN","HMP DJ07",76,0 )
	14694	SR1(ID) ; -- surgery
	14695	"RTN","HMP DJ07",77,0 )
	14696	N SURG,HM PX,HMPY,X, Y,I
	14697	"RTN","HMP DJ07",78,0 )
	14698	D ONE^SRO ESTV("HMPY ",ID) S HM PX=$G(HMPY (ID)) Q:HM PX=""
	14699	"RTN","HMP DJ07",79,0 )
	14700	N $ES,$ET ,ERRPAT,ER RMSG
	14701	"RTN","HMP DJ07",80,0 )
	14702	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	14703	"RTN","HMP DJ07",81,0 )
	14704	S ERRMSG= "A problem occurred converting record "_ ID_" for t he surgery domain"
	14705	"RTN","HMP DJ07",82,0 )
	14706	;
	14707	"RTN","HMP DJ07",83,0 )
	14708	S SURG("l ocalId")=I D,SURG("ui d")=$$SETU ID^HMPUTIL S("surgery ",DFN,ID)
	14709	"RTN","HMP DJ07",84,0 )
	14710	S X=$P(HM PX,U,2),SU RG("status Name")="CO MPLETED"
	14711	"RTN","HMP DJ07",85,0 )
	14712	I X?1"* A borted * " .E S X=$E( X,13,999), SURG("stat usName")=" ABORTED"
	14713	"RTN","HMP DJ07",86,0 )
	14714	S (SURG(" typeName") ,SURG("sum mary"))=X
	14715	"RTN","HMP DJ07",87,0 )
	14716	S SURG("d ateTime")= $$JSONDT^H MPUTILS($P (HMPX,U,3) )
	14717	"RTN","HMP DJ07",88,0 )
	14718	S X=$P(HM PX,U,4) I X D
	14719	"RTN","HMP DJ07",89,0 )
	14720	. S SURG( "providers ",1,"provi derUid")=$ $SETUID^HM PUTILS("us er",,+X)
	14721	"RTN","HMP DJ07",90,0 )
	14722	. S SURG( "providers ",1,"provi derName")= $P(X,";",2 )
	14723	"RTN","HMP DJ07",91,0 )
	14724	S X=$$GET 1^DIQ(130, ID_",",50, "I"),X=$$F AC^HMPD(X)
	14725	"RTN","HMP DJ07",92,0 )
	14726	D FACILIT Y^HMPUTILS (X,"SURG")
	14727	"RTN","HMP DJ07",93,0 )
	14728	S X=$$GET 1^DIQ(130, ID_",",.01 5,"I") I X D
	14729	"RTN","HMP DJ07",94,0 )
	14730	. S SURG( "encounter Uid")=$$SE TUID^HMPUT ILS("visit ",DFN,+X)
	14731	"RTN","HMP DJ07",95,0 )
	14732	. S SURG( "encounter Name")=$$N AME^HMPDJ0 4(+X)
	14733	"RTN","HMP DJ07",96,0 )
	14734	S X=$$GET 1^DIQ(136, ID_",",.02 ,"I") I X D
	14735	"RTN","HMP DJ07",97,0 )
	14736	. S X=$$C PT^HMPDSR( X)
	14737	"RTN","HMP DJ07",98,0 )
	14738	. S (SURG ("typeName "),SURG("s ummary"))= $P(X,U,2)
	14739	"RTN","HMP DJ07",99,0 )
	14740	. S SURG( "typeCode" )=$$SETNCS ^HMPUTILS( "cpt",+X)
	14741	"RTN","HMP DJ07",100, 0)
	14742	S I=0 F S I=$O(HMP Y(ID,I)) Q :I<1 S X= $G(HMPY(ID ,I)) I X D
	14743	"RTN","HMP DJ07",101, 0)
	14744	. N LT S LT=$P(X,U, 2) Q:$P(LT ," ")="Add endum"
	14745	"RTN","HMP DJ07",102, 0)
	14746	. S SURG( "results", I,"uid")=$ $SETUID^HM PUTILS("do cument",DF N,+X)
	14747	"RTN","HMP DJ07",103, 0)
	14748	. S SURG( "results", I,"localTi tle")=LT
	14749	"RTN","HMP DJ07",104, 0)
	14750	S SURG("k ind")="Sur gery",SURG ("category ")="SR"
	14751	"RTN","HMP DJ07",105, 0)
	14752	K ^TMP("T IULIST",$J )
	14753	"RTN","HMP DJ07",106, 0)
	14754	S SURG("l astUpdateT ime")=$$EN ^HMPSTMP(" surgery") ;RHL 20150 102
	14755	"RTN","HMP DJ07",107, 0)
	14756	S SURG("s tampTime") =SURG("las tUpdateTim e") ; RHL 20150102
	14757	"RTN","HMP DJ07",108, 0)
	14758	;US6734 - pre-compi le metasta mp
	14759	"RTN","HMP DJ07",109, 0)
	14760	I $G(HMPM ETA) D ADD ^HMPMETA(" surgery",S URG("uid") ,SURG("sta mpTime")) Q:HMPMETA= 1 ;US6734 ,US11019
	14761	"RTN","HMP DJ07",110, 0)
	14762	D ADD^HMP DJ("SURG", "surgery")
	14763	"RTN","HMP DJ07",111, 0)
	14764	Q
	14765	"RTN","HMP DJ08")
	14766	0^44^B7357 0854
	14767	"RTN","HMP DJ08",1,0)
	14768	HMPDJ08 ;S LC/MKB,ASM R/RRB - TI U Document s;6/25/12 16:11
	14769	"RTN","HMP DJ08",2,0)
	14770	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	14771	"RTN","HMP DJ08",3,0)
	14772	;Per VA D irective 6 402, this routine sh ould not b e modified .
	14773	"RTN","HMP DJ08",4,0)
	14774	;
	14775	"RTN","HMP DJ08",5,0)
	14776	;11/19/14 - Fix mis sing MCAR documents tag EN1+4, EN1+13 j s
	14777	"RTN","HMP DJ08",6,0)
	14778	;
	14779	"RTN","HMP DJ08",7,0)
	14780	; Externa l Referenc es DBIA#
	14781	"RTN","HMP DJ08",8,0)
	14782	; ------- ---------- -- -----
	14783	"RTN","HMP DJ08",9,0)
	14784	; ^SC 10040
	14785	"RTN","HMP DJ08",10,0 )
	14786	; ^TIU(89 25.1 23 21,5677
	14787	"RTN","HMP DJ08",11,0 )
	14788	; ^TIU(89 26.1 5678
	14789	"RTN","HMP DJ08",12,0 )
	14790	; ^VA(200 10060
	14791	"RTN","HMP DJ08",13,0 )
	14792	; DIQ 2056
	14793	"RTN","HMP DJ08",14,0 )
	14794	; RAO7PC1 2043
	14795	"RTN","HMP DJ08",15,0 )
	14796	; TIUCNSL T 5546
	14797	"RTN","HMP DJ08",16,0 )
	14798	; TIUCP 3568
	14799	"RTN","HMP DJ08",17,0 )
	14800	; TIULQ 2693
	14801	"RTN","HMP DJ08",18,0 )
	14802	; TIULX 3058
	14803	"RTN","HMP DJ08",19,0 )
	14804	; TIUSROI 5676
	14805	"RTN","HMP DJ08",20,0 )
	14806	; TIUSRVL O 28 34,2865
	14807	"RTN","HMP DJ08",21,0 )
	14808	; XLFSTR 10104
	14809	"RTN","HMP DJ08",22,0 )
	14810	;
	14811	"RTN","HMP DJ08",23,0 )
	14812	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	14813	"RTN","HMP DJ08",24,0 )
	14814	Q
	14815	"RTN","HMP DJ08",25,0 )
	14816	;
	14817	"RTN","HMP DJ08",26,0 )
	14818	TIU1(ID) ; -- docume nt
	14819	"RTN","HMP DJ08",27,0 )
	14820	I ID[";" D Q
	14821	"RTN","HMP DJ08",28,0 )
	14822	. I ID D EN1($$CP1^ HMPDJ08A(D FN,ID),"CP ") Q ;CP
	14823	"RTN","HMP DJ08",29,0 )
	14824	. D EN1($ $LR1^HMPDJ 08A(DFN,ID ),"LR") Q ;Lab
	14825	"RTN","HMP DJ08",30,0 )
	14826	I ID["-" D Q ;Rad iology
	14827	"RTN","HMP DJ08",31,0 )
	14828	. S (BEG, END)=99999 99.9999-+I D D EN1^RA O7PC1(DFN, BEG,END,"9 9P")
	14829	"RTN","HMP DJ08",32,0 )
	14830	. Q:'$D(^ TMP($J,"RA E1",DFN,ID )) ;del eted
	14831	"RTN","HMP DJ08",33,0 )
	14832	. D EN1($ $RA1^HMPDJ 08A(DFN,ID ),"RA") K ^TMP($J,"R AE1")
	14833	"RTN","HMP DJ08",34,0 )
	14834	D EN1(ID, 38)
	14835	"RTN","HMP DJ08",35,0 )
	14836	Q
	14837	"RTN","HMP DJ08",36,0 )
	14838	;
	14839	"RTN","HMP DJ08",37,0 )
	14840	EN1(HMPX,T IU,OUTPUT) ; -- docu ment
	14841	"RTN","HMP DJ08",38,0 )
	14842	; Expect s DFN, HMP X=IEN^$$RE SOLVE^TIUS RVLO(IEN) or equival ent
	14843	"RTN","HMP DJ08",39,0 )
	14844	; TIU = do cument cla ss#, or co de (CP, RA , LR) if n on-TIU
	14845	"RTN","HMP DJ08",40,0 )
	14846	; OUTPUT = store the result in the outpu t array in stead (by reference)
	14847	"RTN","HMP DJ08",41,0 )
	14848	N DOC,IEN ,X,HMPTIU, NT,ES,I,TE XT,SUB,HMP Y,ERR
	14849	"RTN","HMP DJ08",42,0 )
	14850	; --- CP HMPX recor ds with $p 1 not the file ien ---
	14851	"RTN","HMP DJ08",43,0 )
	14852	S IEN=$P( $G(HMPX),U ),TIU=$G(T IU) I TIU= "CP" I IEN ="" D Q:I EN="" ;in valid ien
	14853	"RTN","HMP DJ08",44,0 )
	14854	. S HMPIE N=+$P(HMPX ,$J_",""", 2)
	14855	"RTN","HMP DJ08",45,0 )
	14856	. I +HMPI EN>0 S IEN =+HMPIEN
	14857	"RTN","HMP DJ08",46,0 )
	14858	. Q
	14859	"RTN","HMP DJ08",47,0 )
	14860	; ---
	14861	"RTN","HMP DJ08",48,0 )
	14862	I +HMPX=H MPX,TIU D ;get TIU data strin g, if need ed
	14863	"RTN","HMP DJ08",49,0 )
	14864	. N SHOWA DD,DA S SH OWADD=1,DA =+HMPX
	14865	"RTN","HMP DJ08",50,0 )
	14866	. S HMPX= DA_U_$$RES OLVE^TIUSR VLO(DA)
	14867	"RTN","HMP DJ08",51,0 )
	14868	; --- CP HMPX recor ds with $p 1 not the file ien ---
	14869	"RTN","HMP DJ08",52,0 )
	14870	I +HMPX=" " I TIU="C P" D ;get TIU data string, if needed
	14871	"RTN","HMP DJ08",53,0 )
	14872	. N SHOWA DD,DA S SH OWADD=1,DA =+IEN
	14873	"RTN","HMP DJ08",54,0 )
	14874	. S HMPX= DA_U_$$RES OLVE^TIUSR VLO(DA)
	14875	"RTN","HMP DJ08",55,0 )
	14876	; ---
	14877	"RTN","HMP DJ08",56,0 )
	14878	Q:"UNKNOW N"[$P($G(H MPX),U,2) ;null or invalid
	14879	"RTN","HMP DJ08",57,0 )
	14880	N $ES,$ET ,ERRPAT,ER RMSG
	14881	"RTN","HMP DJ08",58,0 )
	14882	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	14883	"RTN","HMP DJ08",59,0 )
	14884	S ERRMSG= "A problem occurred converting record "_ IEN_" for the docume nt domain"
	14885	"RTN","HMP DJ08",60,0 )
	14886	S DOC("lo calId")=IE N,DOC("uid ")=$$SETUI D^HMPUTILS ("document ",DFN,IEN)
	14887	"RTN","HMP DJ08",61,0 )
	14888	S DOC("lo calTitle") =$P(HMPX,U ,2)
	14889	"RTN","HMP DJ08",62,0 )
	14890	S DOC("re ferenceDat eTime")=$$ JSONDT^HMP UTILS($P(H MPX,U,3))
	14891	"RTN","HMP DJ08",63,0 )
	14892	S X=$P(HM PX,U,6) D ;S:$L(X) DOC("locat ion")=X
	14893	"RTN","HMP DJ08",64,0 )
	14894	. N LOC,F AC S LOC=$ S($L(X):+$ O(^SC("B", X,0)),1:0) ;ICR 1004 0 DE2818 A SF 11/10/1 5
	14895	"RTN","HMP DJ08",65,0 )
	14896	. S X=$$F AC^HMPD(LO C)
	14897	"RTN","HMP DJ08",66,0 )
	14898	. S DOC(" facilityCo de")=$P(X, U),DOC("fa cilityName ")=$P(X,U, 2)
	14899	"RTN","HMP DJ08",67,0 )
	14900	S X=$P(HM PX,U,7) I $L(X) S DO C("status" )=$$UP^XLF STR(X)
	14901	"RTN","HMP DJ08",68,0 )
	14902	S:$P(HMPX ,U,11) DOC ("images") =+$P(HMPX, U,11)
	14903	"RTN","HMP DJ08",69,0 )
	14904	S:$L($P(H MPX,U,12)) DOC("subj ect")=$P(H MPX,U,12)
	14905	"RTN","HMP DJ08",70,0 )
	14906	I $P(HMPX ,U,14)>5 S DOC("pare ntUid")=$$ SETUID^HMP UTILS("doc ument",DFN ,$P(HMPX,U ,14)) ;ID notes
	14907	"RTN","HMP DJ08",71,0 )
	14908	B ; other TIU data
	14909	"RTN","HMP DJ08",72,0 )
	14910	D:TIU EXT RACT^TIULQ (IEN,"HMPT IU",,,,1,, 1) ;".01:. 04;1501:15 08")
	14911	"RTN","HMP DJ08",73,0 )
	14912	S X=$G(HM PTIU(IEN,. 01,"I")) S :X DOC("do cumentDefU id")=$$SET UID^HMPUTI LS("doc-de f",,X)
	14913	"RTN","HMP DJ08",74,0 )
	14914	S NT=$S(X :+$G(^TIU( 8925.1,X,1 5)),1:$P(H MPX,U,10)) I NT D ; ICR 2321 D E2818 ASF 11/110/15
	14915	"RTN","HMP DJ08",75,0 )
	14916	. S DOC(" nationalTi tle","vuid ")="urn:va :vuid:"_$$ VUID^HMPD( NT,8926.1)
	14917	"RTN","HMP DJ08",76,0 )
	14918	. S DOC(" nationalTi tle","name ")=$$GET1^ DIQ(8926.1 ,NT_",",.0 1)
	14919	"RTN","HMP DJ08",77,0 )
	14920	S X=$G(HM PTIU(IEN,1 201,"I")) S:X DOC("e ntered")=$ $JSONDT^HM PUTILS(X)
	14921	"RTN","HMP DJ08",78,0 )
	14922	S X=$G(HM PTIU(IEN,. 09,"E")) S :$L(X) DOC ("urgency" )=X
	14923	"RTN","HMP DJ08",79,0 )
	14924	S X=TIU I TIU S X=+ $G(HMPTIU( IEN,.01,"I ")),X=$$CA TG^HMPDTIU (X) ;2U ty pe code
	14925	"RTN","HMP DJ08",80,0 )
	14926	S DOC("do cumentType Code")=X,D OC("docume ntTypeName ")=$$TYPE( X)
	14927	"RTN","HMP DJ08",81,0 )
	14928	S DOC("do cumentClas s")=$S(X=" LR":"LR LA BORATORY R EPORTS",X= "SR":"SURG ICAL REPOR TS",X="CP" :"CLINICAL PROCEDURE S",X="RA": "RADIOLOGY REPORTS", X="DS":"DI SCHARGE SU MMARY",1:" PROGRESS N OTES")
	14929	"RTN","HMP DJ08",82,0 )
	14930	S X=$S(TI U:$G(HMPTI U(IEN,.03, "I")),1:$P (HMPX,U,8) ) ;visit#
	14931	"RTN","HMP DJ08",83,0 )
	14932	S:X DOC(" encounterU id")=$$SET UID^HMPUTI LS("visit" ,DFN,X),DO C("encount erName")=$ $NAME^HMPD J04(X)
	14933	"RTN","HMP DJ08",84,0 )
	14934	C ; text b locks, sig natures
	14935	"RTN","HMP DJ08",85,0 )
	14936	N HMPT,HM PA,HMPADD
	14937	"RTN","HMP DJ08",86,0 )
	14938	S DOC("te xt",1,"dat eTime")=DO C("referen ceDateTime ")
	14939	"RTN","HMP DJ08",87,0 )
	14940	S DOC("te xt",1,"sta tus")=$G(D OC("status "))
	14941	"RTN","HMP DJ08",88,0 )
	14942	S DOC("te xt",1,"uid ")=DOC("ui d")
	14943	"RTN","HMP DJ08",89,0 )
	14944	S HMPT=1, X=$P(HMPX, U,5),I=0
	14945	"RTN","HMP DJ08",90,0 )
	14946	I X D USE R(.I,+X,$P (X,";",3), "AU") ; author
	14947	"RTN","HMP DJ08",91,0 )
	14948	M ES=HMPT IU(IEN) S X=$P(HMPX, "//",2) ;n on-TIU, pu t into ES for use:
	14949	"RTN","HMP DJ08",92,0 )
	14950	I $L(X) S ES(1502," I")=+X,ES( 1502,"E")= $P(X,";",2 ),ES(1501, "I")=$P(X, ";",3)
	14951	"RTN","HMP DJ08",93,0 )
	14952	I $G(ES(1 501,"I")) D USER(.I, ES(1502,"I "),ES(1502 ,"E"),"S", ES(1501,"I "),$G(ES(1 503,"E")), $G(ES(1504 ,"E")))
	14953	"RTN","HMP DJ08",94,0 )
	14954	I $G(ES(1 507,"I")) D USER(.I, ES(1508,"I "),ES(1508 ,"E"),"C", ES(1507,"I "),$G(ES(1 509,"E")), $G(ES(1510 ,"E")))
	14955	"RTN","HMP DJ08",95,0 )
	14956	I $G(ES(1 204,"I")) D USER(.I, ES(1204,"I "),ES(1204 ,"E"),"ES" ) ;expe cted signe r
	14957	"RTN","HMP DJ08",96,0 )
	14958	I $G(ES(1 208,"I")) D USER(.I, ES(1208,"I "),ES(1208 ,"E"),"EC" ) ;expe cted cosig ner
	14959	"RTN","HMP DJ08",97,0 )
	14960	I $G(ES(1 302,"I")) D USER(.I, ES(1302,"I "),ES(1302 ,"E"),"E") ;ente red
	14961	"RTN","HMP DJ08",98,0 )
	14962	I $G(ES(1 209,"I")) D USER(.I, ES(1209,"I "),ES(1209 ,"E"),"ATT ") ;atte nding
	14963	"RTN","HMP DJ08",99,0 )
	14964	I $G(HMPT EXT) D
	14965	"RTN","HMP DJ08",100, 0)
	14966	. S X=$S( TIU:$NA(HM PTIU(IEN," TEXT")),1: $NA(^TMP(" HMPTEXT",$ J,IEN)))
	14967	"RTN","HMP DJ08",101, 0)
	14968	. K ^TMP( $J,"HMP TI U TEXT")
	14969	"RTN","HMP DJ08",102, 0)
	14970	. D SETTE XT^HMPUTIL S(X,$NA(^T MP($J,"HMP TIU TEXT" )))
	14971	"RTN","HMP DJ08",103, 0)
	14972	. M DOC(" text",1,"c ontent","\ ")=^TMP($J ,"HMP TIU TEXT")
	14973	"RTN","HMP DJ08",104, 0)
	14974	D ; addend a
	14975	"RTN","HMP DJ08",105, 0)
	14976	S HMPA=0 F S HMPA= $O(HMPTIU( IEN,"ZADD" ,HMPA)) Q: HMPA<1 D
	14977	"RTN","HMP DJ08",106, 0)
	14978	. S HMPT= HMPT+1,I=0 K HMPADD M HMPADD=H MPTIU(IEN, "ZADD",HMP A)
	14979	"RTN","HMP DJ08",107, 0)
	14980	. S DOC(" text",HMPT ,"status") =$G(HMPADD (.05,"E"))
	14981	"RTN","HMP DJ08",108, 0)
	14982	. S DOC(" text",HMPT ,"uid")=$$ SETUID^HMP UTILS("doc ument",DFN ,HMPA)
	14983	"RTN","HMP DJ08",109, 0)
	14984	. S DOC(" text",HMPT ,"dateTime ")=$$JSOND T^HMPUTILS ($G(HMPADD (1301,"I") ))
	14985	"RTN","HMP DJ08",110, 0)
	14986	. I $G(HM PADD(1302, "I")) D US ER(.I,HMPA DD(1302,"I "),HMPADD( 1302,"E"), "E")
	14987	"RTN","HMP DJ08",111, 0)
	14988	. I $G(HM PADD(1202, "I")) D US ER(.I,HMPA DD(1202,"I "),HMPADD( 1202,"E"), "AU")
	14989	"RTN","HMP DJ08",112, 0)
	14990	. I $G(HM PADD(1501, "I")) D US ER(.I,HMPA DD(1502,"I "),HMPADD( 1502,"E"), "S",HMPADD (1501,"I") )
	14991	"RTN","HMP DJ08",113, 0)
	14992	. I $G(HM PADD(1507, "I")) D US ER(.I,HMPA DD(1508,"I "),HMPADD( 1508,"E"), "C",HMPADD (1507,"I") )
	14993	"RTN","HMP DJ08",114, 0)
	14994	. I $G(HM PADD(1204, "I")) D US ER(.I,HMPA DD(1204,"I "),HMPADD( 1204,"E"), "ES")
	14995	"RTN","HMP DJ08",115, 0)
	14996	. I $G(HM PADD(1208, "I")) D US ER(.I,HMPA DD(1208,"I "),HMPADD( 1208,"E"), "EC")
	14997	"RTN","HMP DJ08",116, 0)
	14998	. I $G(HM PADD(1209, "I")) D US ER(.I,HMPA DD(1209,"I "),HMPADD( 1209,"E"), "ATT")
	14999	"RTN","HMP DJ08",117, 0)
	15000	. Q:'$G(H MPTEXT) K ^TMP($J," HMP TIU TE XT")
	15001	"RTN","HMP DJ08",118, 0)
	15002	. S X=$NA (HMPTIU(IE N,"ZADD",H MPA,"TEXT" ))
	15003	"RTN","HMP DJ08",119, 0)
	15004	. D SETTE XT^HMPUTIL S(X,$NA(^T MP($J,"HMP TIU TEXT" )))
	15005	"RTN","HMP DJ08",120, 0)
	15006	. M DOC(" text",HMPT ,"content" ,"\")=^TMP ($J,"HMP T IU TEXT")
	15007	"RTN","HMP DJ08",121, 0)
	15008	ENQ ; end
	15009	"RTN","HMP DJ08",122, 0)
	15010	K ^TMP($J ,"HMP TIU TEXT")
	15011	"RTN","HMP DJ08",123, 0)
	15012	S DOC("la stUpdateTi me")=$$EN^ HMPSTMP("d ocument") ;RHL 20150 102
	15013	"RTN","HMP DJ08",124, 0)
	15014	S DOC("st ampTime")= DOC("lastU pdateTime" ) ; RHL 20 150102
	15015	"RTN","HMP DJ08",125, 0)
	15016	;US6734 - pre-compi le metasta mp
	15017	"RTN","HMP DJ08",126, 0)
	15018	I '$D(OUT PUT),$G(HM PMETA) D A DD^HMPMETA ("document ",DOC("uid "),DOC("st ampTime")) Q:HMPMETA =1 ;US673 4,US11019
	15019	"RTN","HMP DJ08",127, 0)
	15020	I '$D(OUT PUT) D ADD ^HMPDJ("DO C","docume nt") Q
	15021	"RTN","HMP DJ08",128, 0)
	15022	M OUTPUT= DOC
	15023	"RTN","HMP DJ08",129, 0)
	15024	Q
	15025	"RTN","HMP DJ08",130, 0)
	15026	;
	15027	"RTN","HMP DJ08",131, 0)
	15028	USER(N,IEN ,NAME,ROLE ,DATE,SBN, SBT) ; -- set author , signer(s )
	15029	"RTN","HMP DJ08",132, 0)
	15030	Q:'$G(IEN ) S N=+$G (N)+1
	15031	"RTN","HMP DJ08",133, 0)
	15032	S DOC("te xt",HMPT," clinicians ",N,"uid") =$$SETUID^ HMPUTILS(" user",,IEN )
	15033	"RTN","HMP DJ08",134, 0)
	15034	S DOC("te xt",HMPT," clinicians ",N,"name" )=$S($L($G (NAME)):NA ME,1:$P($G (^VA(200,I EN,0)),U)) ;ICR 1006 0 DE2818 A SF 11/10/1 5
	15035	"RTN","HMP DJ08",135, 0)
	15036	S DOC("te xt",HMPT," clinicians ",N,"role" )=$G(ROLE)
	15037	"RTN","HMP DJ08",136, 0)
	15038	Q:'$G(DAT E) ;not c o/signed
	15039	"RTN","HMP DJ08",137, 0)
	15040	S DOC("te xt",HMPT," clinicians ",N,"signe dDateTime" )=$$JSONDT ^HMPUTILS( DATE)
	15041	"RTN","HMP DJ08",138, 0)
	15042	I '$D(SBN ) S SBN=NA ME
	15043	"RTN","HMP DJ08",139, 0)
	15044	S DOC("te xt",HMPT," clinicians ",N,"signa ture")=SBN _$S($L($G( SBT)):" "_ SBT,1:"")
	15045	"RTN","HMP DJ08",140, 0)
	15046	;$$SIG^HM PDTIU(IEN)
	15047	"RTN","HMP DJ08",141, 0)
	15048	Q
	15049	"RTN","HMP DJ08",142, 0)
	15050	;
	15051	"RTN","HMP DJ08",143, 0)
	15052	;
	15053	"RTN","HMP DJ08",144, 0)
	15054	; ------- ----- Get/ apply sear ch criteri a -------- ----
	15055	"RTN","HMP DJ08",145, 0)
	15056	; [fr om DOCUMEN T^HMPDJ0]
	15057	"RTN","HMP DJ08",146, 0)
	15058	;
	15059	"RTN","HMP DJ08",147, 0)
	15060	SETUP ; -- convert F ILTER("att ribute") = value to TIU criter ia
	15061	"RTN","HMP DJ08",148, 0)
	15062	; Expects : FILTER(" category") = code (s ee $$CATG)
	15063	"RTN","HMP DJ08",149, 0)
	15064	; FILTER(" status") = 'signed ','unsigne d','all'
	15065	"RTN","HMP DJ08",150, 0)
	15066	; Returns : CLASS,[S UBCLASS,ST ATUS]
	15067	"RTN","HMP DJ08",151, 0)
	15068	;
	15069	"RTN","HMP DJ08",152, 0)
	15070	N TYPE,ST S,CP
	15071	"RTN","HMP DJ08",153, 0)
	15072	S TYPE=$$ UP^XLFSTR( $G(FILTER( "category" )))
	15073	"RTN","HMP DJ08",154, 0)
	15074	S CLASS=0 ,(SUBCLASS ,STATUS)=" "
	15075	"RTN","HMP DJ08",155, 0)
	15076	;
	15077	"RTN","HMP DJ08",156, 0)
	15078	; status [default=' signed']
	15079	"RTN","HMP DJ08",157, 0)
	15080	S STS=$$L OW^XLFSTR( $G(FILTER( "status")) )
	15081	"RTN","HMP DJ08",158, 0)
	15082	S STATUS= $S(STS?1"u nsig".E:2, STS="all": "5^2",1:5) ;TIUS RVLO statu ses
	15083	"RTN","HMP DJ08",159, 0)
	15084	;
	15085	"RTN","HMP DJ08",160, 0)
	15086	; all doc uments
	15087	"RTN","HMP DJ08",161, 0)
	15088	S:TYPE="" TYPE="ALL "
	15089	"RTN","HMP DJ08",162, 0)
	15090	I TYPE="A LL" S CLAS S="3^244^" _+$$CLASS^ TIUSROI("S URGICAL RE PORTS")_"^ CP^LR^RA" Q
	15091	"RTN","HMP DJ08",163, 0)
	15092	;
	15093	"RTN","HMP DJ08",164, 0)
	15094	I TYPE="P N" S CLA SS=3 Q ;Progr ess Notes
	15095	"RTN","HMP DJ08",165, 0)
	15096	I TYPE="C R" S CLA SS=3,SUBCL ASS=$$CLAS S^TIUCNSLT Q ;Consu lts
	15097	"RTN","HMP DJ08",166, 0)
	15098	I TYPE="C WAD" S CLA SS=3,SUBCL ASS="25^27 ^30^31" Q ;CWAD
	15099	"RTN","HMP DJ08",167, 0)
	15100	I TYPE="C " S CLA SS=3,SUBCL ASS=30 Q ;Crisi s Note
	15101	"RTN","HMP DJ08",168, 0)
	15102	I TYPE="W " S CLA SS=3,SUBCL ASS=31 Q ;Clini cal Warnin g
	15103	"RTN","HMP DJ08",169, 0)
	15104	I TYPE="A " S CLA SS=3,SUBCL ASS=25 Q ;Aller gy Note
	15105	"RTN","HMP DJ08",170, 0)
	15106	I TYPE="D " S CLA SS=3,SUBCL ASS=27 Q ;Advan ce Directi ve
	15107	"RTN","HMP DJ08",171, 0)
	15108	;
	15109	"RTN","HMP DJ08",172, 0)
	15110	I TYPE="D S" S CLA SS=244 Q ;Disch arge Summa ry
	15111	"RTN","HMP DJ08",173, 0)
	15112	;
	15113	"RTN","HMP DJ08",174, 0)
	15114	I TYPE="S R" S CLA SS=$$CLASS ^TIUSROI(" SURGICAL R EPORTS") Q
	15115	"RTN","HMP DJ08",175, 0)
	15116	I TYPE="C P" D Q ;Clin Procedures
	15117	"RTN","HMP DJ08",176, 0)
	15118	. I STATU S'=2 S CLA SS="CP" ; if u nsigned,
	15119	"RTN","HMP DJ08",177, 0)
	15120	. E D CP CLASS^TIUC P(.CP) S C LASS=CP ; use TIU class#
	15121	"RTN","HMP DJ08",178, 0)
	15122	;
	15123	"RTN","HMP DJ08",179, 0)
	15124	I TYPE="L R" S CLA SS=$S(STAT US=2:$$LR, 1:"LR") Q ;Lab/P athology
	15125	"RTN","HMP DJ08",180, 0)
	15126	;
	15127	"RTN","HMP DJ08",181, 0)
	15128	I TYPE="R A" S CLA SS="RA" Q ;Radio logy
	15129	"RTN","HMP DJ08",182, 0)
	15130	;
	15131	"RTN","HMP DJ08",183, 0)
	15132	Q
	15133	"RTN","HMP DJ08",184, 0)
	15134	;
	15135	"RTN","HMP DJ08",185, 0)
	15136	LR() ; -- Return ien of Lab cl ass
	15137	"RTN","HMP DJ08",186, 0)
	15138	N Y S Y=+ $O(^TIU(89 25.1,"B"," LR LABORAT ORY REPORT S",0)) ;IC R 2321 DE2 818 ASF 11 /10/15
	15139	"RTN","HMP DJ08",187, 0)
	15140	I Y>0,$S( $P($G(^TIU (8925.1,Y, 0)),U,4)=" CL":0,$P($ G(^(0)),U, 4)="DC":0, 1:1) S Y=0
	15141	"RTN","HMP DJ08",188, 0)
	15142	Q Y
	15143	"RTN","HMP DJ08",189, 0)
	15144	;
	15145	"RTN","HMP DJ08",190, 0)
	15146	MATCH(DOC, STS) ; -- Return 1 o r 0, if do cument DA matches se arch crite ria
	15147	"RTN","HMP DJ08",191, 0)
	15148	N Y,DA,LO CAL,OK S Y =0
	15149	"RTN","HMP DJ08",192, 0)
	15150	S DA=+$G( DOC) G:DA< 1 MQ
	15151	"RTN","HMP DJ08",193, 0)
	15152	; include addenda i f pulling only unsig ned items
	15153	"RTN","HMP DJ08",194, 0)
	15154	I $P(DOC, U,2)?1"Add endum ".E, STATUS'=2 G MQ
	15155	"RTN","HMP DJ08",195, 0)
	15156	; TIU uns igned list can inclu de complet ed parent notes
	15157	"RTN","HMP DJ08",196, 0)
	15158	I $G(STS) =2,$P(DOC, U,7)'="uns igned" G M Q
	15159	"RTN","HMP DJ08",197, 0)
	15160	S LOCAL=$ $GET1^DIQ( 8925,DA_", ",.01,"I") ;local Ti tle 8925.1 ien
	15161	"RTN","HMP DJ08",198, 0)
	15162	I $L(SUBC LASS) D G :'OK MQ
	15163	"RTN","HMP DJ08",199, 0)
	15164	. N I,X S OK=0
	15165	"RTN","HMP DJ08",200, 0)
	15166	. F I=1:1 :$L(SUBCLA SS,"^") S X=$P(SUBCL ASS,U,I) I $$ISA^TIU LX(LOCAL,X ) S OK=1 Q
	15167	"RTN","HMP DJ08",201, 0)
	15168	S Y=1
	15169	"RTN","HMP DJ08",202, 0)
	15170	MQ Q Y
	15171	"RTN","HMP DJ08",203, 0)
	15172	;
	15173	"RTN","HMP DJ08",204, 0)
	15174	TYPE(X) ; -- Return name of ca tegory typ e X
	15175	"RTN","HMP DJ08",205, 0)
	15176	S X=$G(X)
	15177	"RTN","HMP DJ08",206, 0)
	15178	I X="PN" Q "Progres s Note"
	15179	"RTN","HMP DJ08",207, 0)
	15180	I X="DS" Q "Dischar ge Summary "
	15181	"RTN","HMP DJ08",208, 0)
	15182	I X="CP" Q "Clinica l Procedur e"
	15183	"RTN","HMP DJ08",209, 0)
	15184	I X="SR" Q "Surgery Report"
	15185	"RTN","HMP DJ08",210, 0)
	15186	I X="LR" Q "Laborat ory Report "
	15187	"RTN","HMP DJ08",211, 0)
	15188	I X="RA" Q "Radiolo gy Report"
	15189	"RTN","HMP DJ08",212, 0)
	15190	I X="CR" Q "Consult Report"
	15191	"RTN","HMP DJ08",213, 0)
	15192	I X="C" Q "Crisis Note"
	15193	"RTN","HMP DJ08",214, 0)
	15194	I X="W" Q "Clinica l Warning"
	15195	"RTN","HMP DJ08",215, 0)
	15196	I X="A" Q "Allergy /Adverse R eaction"
	15197	"RTN","HMP DJ08",216, 0)
	15198	I X="D" Q "Advance Directive "
	15199	"RTN","HMP DJ08",217, 0)
	15200	Q ""
	15201	"RTN","HMP DJ08A")
	15202	0^45^B5035 3978
	15203	"RTN","HMP DJ08A",1,0 )
	15204	HMPDJ08A ; SLC/MKB,AS MR/RRB - T IU Documen ts continu ed;10/29/2 015 12:08: 30
	15205	"RTN","HMP DJ08A",2,0 )
	15206	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	15207	"RTN","HMP DJ08A",3,0 )
	15208	;Per VA D irective 6 402, this routine sh ould not b e modified .
	15209	"RTN","HMP DJ08A",4,0 )
	15210	;
	15211	"RTN","HMP DJ08A",5,0 )
	15212	; Called by HMPDJ08
	15213	"RTN","HMP DJ08A",6,0 )
	15214	;
	15215	"RTN","HMP DJ08A",7,0 )
	15216	;pass HMP XX from CP 1 section 12.2.14 ag ilex/js
	15217	"RTN","HMP DJ08A",8,0 )
	15218	;
	15219	"RTN","HMP DJ08A",9,0 )
	15220	; Externa l Referenc es DBIA#
	15221	"RTN","HMP DJ08A",10, 0)
	15222	; ------- ---------- -- -----
	15223	"RTN","HMP DJ08A",11, 0)
	15224	; ^DPT 10035
	15225	"RTN","HMP DJ08A",12, 0)
	15226	; ^LR 525
	15227	"RTN","HMP DJ08A",13, 0)
	15228	; ^RADPT 2480
	15229	"RTN","HMP DJ08A",14, 0)
	15230	; ^RARPT 8000005
	15231	"RTN","HMP DJ08A",15, 0)
	15232	; ^SC 10040
	15233	"RTN","HMP DJ08A",16, 0)
	15234	; ^TMP("M DHSP" [MDP S1] 4230
	15235	"RTN","HMP DJ08A",17, 0)
	15236	; ^VA(200 10060
	15237	"RTN","HMP DJ08A",18, 0)
	15238	; %DT 10003
	15239	"RTN","HMP DJ08A",19, 0)
	15240	; DIQ 2056
	15241	"RTN","HMP DJ08A",20, 0)
	15242	; GMRCGUI B 2980
	15243	"RTN","HMP DJ08A",21, 0)
	15244	; LR7OR1, ^TMP("LRRR " 2503
	15245	"RTN","HMP DJ08A",22, 0)
	15246	; MCARUTL 3 3280
	15247	"RTN","HMP DJ08A",23, 0)
	15248	; PXAPI 1894
	15249	"RTN","HMP DJ08A",24, 0)
	15250	; RAO7PC1 20 43,2265
	15251	"RTN","HMP DJ08A",25, 0)
	15252	; RAO7PC3 2877
	15253	"RTN","HMP DJ08A",26, 0)
	15254	;
	15255	"RTN","HMP DJ08A",27, 0)
	15256	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	15257	"RTN","HMP DJ08A",28, 0)
	15258	;
	15259	"RTN","HMP DJ08A",29, 0)
	15260	; ------- ---------- ---------- ---------- ---------- ---------- ---------
	15261	"RTN","HMP DJ08A",30, 0)
	15262	; documen tClass = C LINICAL PR OCEDURES
	15263	"RTN","HMP DJ08A",31, 0)
	15264	; nationa lTitle = 4 696566^PRO CEDURE REP ORT
	15265	"RTN","HMP DJ08A",32, 0)
	15266	; S ervice = 4 696471^PRO CEDURE
	15267	"RTN","HMP DJ08A",33, 0)
	15268	; Type = 4 696123^REP ORT
	15269	"RTN","HMP DJ08A",34, 0)
	15270	Q
	15271	"RTN","HMP DJ08A",35, 0)
	15272	;
	15273	"RTN","HMP DJ08A",36, 0)
	15274	CP(DFN,BEG ,END,MAX) ; -- Medic ine report s
	15275	"RTN","HMP DJ08A",37, 0)
	15276	N HMPN,HM PX,RTN,TIU N,CONS,HMP D,I,DA,X,Y ,%DT,DATE, GBL
	15277	"RTN","HMP DJ08A",38, 0)
	15278	S DFN=+$G (DFN) Q:$G (DFN)<1
	15279	"RTN","HMP DJ08A",39, 0)
	15280	D MDPS1^H MPDJ03(DFN ,BEG,END,M AX) ;get s ^TMP("MD HSP",$J)
	15281	"RTN","HMP DJ08A",40, 0)
	15282	S HMPN=0 F S HMPN= $O(^TMP("M DHSP",$J,H MPN)) Q:HM PN<1 S HM PX=$G(^(HM PN)) D
	15283	"RTN","HMP DJ08A",41, 0)
	15284	. N $ES,$ ET,ERRPAT, ERRMSG
	15285	"RTN","HMP DJ08A",42, 0)
	15286	. S $ET=" D ERRHDLR^ HMPDERRH", ERRPAT=DFN
	15287	"RTN","HMP DJ08A",43, 0)
	15288	. S ERRMS G="A probl em occurre d converti ng a medic ine report ."
	15289	"RTN","HMP DJ08A",44, 0)
	15290	. S RTN=$ P(HMPX,U,3 ,4) Q:RTN ="PRPRO^MD PS4" ;ski p non-CP i tems
	15291	"RTN","HMP DJ08A",45, 0)
	15292	. S TIUN= +$P(HMPX,U ,14)
	15293	"RTN","HMP DJ08A",46, 0)
	15294	. I TIUN D EN1^HMPD J08(TIUN,3 8) ;38= TIU Clinic al Documen t
	15295	"RTN","HMP DJ08A",47, 0)
	15296	. S CONS= +$P(HMPX,U ,13) D:CON S DOCLIST^ GMRCGUIB(. HMPD,CONS)
	15297	"RTN","HMP DJ08A",48, 0)
	15298	. K DA S I=0 F S I =$O(HMPD(5 0,I)) Q:I< 1 D
	15299	"RTN","HMP DJ08A",49, 0)
	15300	.. S DA=+ HMPD(50,I) Q:DA=TIUN
	15301	"RTN","HMP DJ08A",50, 0)
	15302	.. D EN1^ HMPDJ08(DA ,38)
	15303	"RTN","HMP DJ08A",51, 0)
	15304	. Q:TIUN! $G(DA) ;don e [got TIU note(s)]
	15305	"RTN","HMP DJ08A",52, 0)
	15306	. Q:RTN=" PR702^MDPS 1" ;CP, but no TI U note yet
	15307	"RTN","HMP DJ08A",53, 0)
	15308	. Q:RTN=" PRPRO^MDPS 4" ;non -CP proced ure
	15309	"RTN","HMP DJ08A",54, 0)
	15310	. ; find ID for pre -TIU repor t
	15311	"RTN","HMP DJ08A",55, 0)
	15312	. S X=$P( HMPX,U,6), %DT="TXS" D ^%DT Q:Y '>0 S DAT E=Y
	15313	"RTN","HMP DJ08A",56, 0)
	15314	. S GBL=+ $P(HMPX,U, 2)_";"_$$R OOT^HMPDMC (DFN,$P(HM PX,U,11),D ATE)
	15315	"RTN","HMP DJ08A",57, 0)
	15316	. I GBL S X=$$CP1(D FN,GBL)
	15317	"RTN","HMP DJ08A",58, 0)
	15318	. I $G(HM PXX)]"" D EN1^HMPDJ0 8(HMPXX,"C P") ; pas s HMPXX fr om CP1 sec tion 12.2. 14 js
	15319	"RTN","HMP DJ08A",59, 0)
	15320	K ^TMP("M DHSP",$J), ^TMP("HMPT EXT",$J)
	15321	"RTN","HMP DJ08A",60, 0)
	15322	K HMPXX
	15323	"RTN","HMP DJ08A",61, 0)
	15324	Q
	15325	"RTN","HMP DJ08A",62, 0)
	15326	;
	15327	"RTN","HMP DJ08A",63, 0)
	15328	CP1(DFN,ID ) ; -- ret urn report data as T IU string [$$RESOLVE ] /DE2818
	15329	"RTN","HMP DJ08A",64, 0)
	15330	S DFN=+$G (DFN),ID=$ G(ID) I DF N<1!'$L(ID ) Q ""
	15331	"RTN","HMP DJ08A",65, 0)
	15332	N Y,HMPY, HMPFN,X,NA ME,DATE,ST S,USER,SIG N,TEXT
	15333	"RTN","HMP DJ08A",66, 0)
	15334	S HMPFN=+ $P(ID,"(", 2) ; examp le 699.5
	15335	"RTN","HMP DJ08A",67, 0)
	15336	D MEDLKUP ^MCARUTL3( .HMPY,HMPF N,+ID)
	15337	"RTN","HMP DJ08A",68, 0)
	15338	I HMPY<1 Q "" ;err or in CP
	15339	"RTN","HMP DJ08A",69, 0)
	15340	S NAME=$P (HMPY,U,9) ,DATE=$P(H MPY,U,6)
	15341	"RTN","HMP DJ08A",70, 0)
	15342	S X=$$GET 1^DIQ(HMPF N,+ID_",", 1506)
	15343	"RTN","HMP DJ08A",71, 0)
	15344	S STS=$S( $L(X):X,1: "COMPLETED ")
	15345	"RTN","HMP DJ08A",72, 0)
	15346	S X=+$$GE T1^DIQ(HMP FN,+ID_"," ,701,"I"), (USER,SIGN )=""
	15347	"RTN","HMP DJ08A",73, 0)
	15348	S:X USER= X_";;"_$P( $G(^VA(200 ,X,0)),U) ;ICR 10060 DE2818 AS F 11/10/15
	15349	"RTN","HMP DJ08A",74, 0)
	15350	S X=+$$GE T1^DIQ(HMP FN,+ID_"," ,1503,"I")
	15351	"RTN","HMP DJ08A",75, 0)
	15352	S:X SIGN= "//"_X_";" _$P($G(^VA (200,X,0)) ,U)_";"_$$ GET1^DIQ(H MPFN,+ID_" ,",1505,"I ") ;ICR 10 060 DE2818 ASF 11/10 /15
	15353	"RTN","HMP DJ08A",76, 0)
	15354	; VST=$$G ET1^DIQ(HM PFN,+ID_", ",900,"I")
	15355	"RTN","HMP DJ08A",77, 0)
	15356	S Y=ID_U_ NAME_U_DAT E_U_U_USER _U_U_STS_" ^^^2461^"_ SIGN
	15357	"RTN","HMP DJ08A",78, 0)
	15358	S HMPXX=I D_U_NAME_U _DATE_U_U_ USER_U_U_S TS_"^^^246 1^"_SIGN ; 12.2.14 j s
	15359	"RTN","HMP DJ08A",79, 0)
	15360	S:$G(HMPT EXT) TEXT= $$TEXT^HMP DMC(DFN,ID ,NAME) ;^T MP("HMPTEX T",$J,ID)
	15361	"RTN","HMP DJ08A",80, 0)
	15362	Q Y
	15363	"RTN","HMP DJ08A",81, 0)
	15364	;
	15365	"RTN","HMP DJ08A",82, 0)
	15366	; ------- ---------- ---------- ---------- ---------- ---------- ---------
	15367	"RTN","HMP DJ08A",83, 0)
	15368	; documen tClass = L R LABORATO RY REPORTS
	15369	"RTN","HMP DJ08A",84, 0)
	15370	; nationa lTitle = 4 697105^LAB ORATORY NO TE
	15371	"RTN","HMP DJ08A",85, 0)
	15372	; S ubject = 4 697104^LAB ORATORY
	15373	"RTN","HMP DJ08A",86, 0)
	15374	; Type = 4 696120^NOT E
	15375	"RTN","HMP DJ08A",87, 0)
	15376	;
	15377	"RTN","HMP DJ08A",88, 0)
	15378	LR(DFN,BEG ,END,MAX) ; -- Lab r eports
	15379	"RTN","HMP DJ08A",89, 0)
	15380	N HMPSUB, HMPIDT,HMP ITM,HMPTIU ,HMPXID,LR DFN,IVDT,H MPN,DA
	15381	"RTN","HMP DJ08A",90, 0)
	15382	S DFN=+$G (DFN) Q:$G (DFN)<1
	15383	"RTN","HMP DJ08A",91, 0)
	15384	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	15385	"RTN","HMP DJ08A",92, 0)
	15386	S LRDFN=+ $G(^DPT(DF N,"LR")),I VDT=999999 9-+$G(^LR( LRDFN,"AU" )) ;LR7OB6 3D error
	15387	"RTN","HMP DJ08A",93, 0)
	15388	K ^TMP("L RRR",$J,DF N) D RR^LR 7OR1(DFN,, BEG,END,"M IAP",,,MAX )
	15389	"RTN","HMP DJ08A",94, 0)
	15390	S HMPSUB= "" F S HM PSUB=$O(^T MP("LRRR", $J,DFN,HMP SUB)) Q:HM PSUB="" D
	15391	"RTN","HMP DJ08A",95, 0)
	15392	. S HMPID T=0 F S H MPIDT=$O(^ TMP("LRRR" ,$J,DFN,HM PSUB,HMPID T)) Q:HMPI DT<1 I $O (^(HMPIDT, 0)) D
	15393	"RTN","HMP DJ08A",96, 0)
	15394	.. S HMPT IU=$S(HMPS UB="AU":$N A(^LR(LRDF N,101)),1: $NA(^LR(LR DFN,HMPSUB ,HMPIDT,.0 5)))
	15395	"RTN","HMP DJ08A",97, 0)
	15396	.. K HMPI TM S HMPXI D=HMPSUB_" ;"_HMPIDT
	15397	"RTN","HMP DJ08A",98, 0)
	15398	.. I '$O( @HMPTIU@(0 )) S HMPX= $$LR1(DFN, HMPXID) D EN1^HMPDJ0 8(HMPX,"LR ") Q
	15399	"RTN","HMP DJ08A",99, 0)
	15400	.. S HMPN =0 F S HM PN=$O(@HMP TIU@(HMPN) ) Q:HMPN<1 D ;38=T IU Clin Do c
	15401	"RTN","HMP DJ08A",100 ,0)
	15402	... S DA= +$P($G(@HM PTIU@(HMPN ,0)),U,2)
	15403	"RTN","HMP DJ08A",101 ,0)
	15404	... D:DA EN1^HMPDJ0 8(DA,38)
	15405	"RTN","HMP DJ08A",102 ,0)
	15406	K ^TMP("L RRR",$J,DF N),^TMP("H MPTEXT",$J )
	15407	"RTN","HMP DJ08A",103 ,0)
	15408	Q
	15409	"RTN","HMP DJ08A",104 ,0)
	15410	;
	15411	"RTN","HMP DJ08A",105 ,0)
	15412	LR1(DFN,ID ) ; -- ret urn report data as T IU string [$$RESOLVE ]
	15413	"RTN","HMP DJ08A",106 ,0)
	15414	N $ES,$ET ,ERRPAT,ER RMSG
	15415	"RTN","HMP DJ08A",107 ,0)
	15416	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	15417	"RTN","HMP DJ08A",108 ,0)
	15418	S ERRMSG= "A problem occurred converting lab repor t "_ID
	15419	"RTN","HMP DJ08A",109 ,0)
	15420	S DFN=+$G (DFN),ID=$ G(ID) I DF N<1!'$L(ID ) Q ""
	15421	"RTN","HMP DJ08A",110 ,0)
	15422	N Y,SUB,I DT,LRDFN,L R,NAME,LOC ,USER,VST, SIGN,TEXT
	15423	"RTN","HMP DJ08A",111 ,0)
	15424	K ^TMP("H MPTEXT",$J ,ID)
	15425	"RTN","HMP DJ08A",112 ,0)
	15426	S SUB=$P( ID,";"),ID T=+$P(ID," ;",2),LRDF N=$G(^DPT( DFN,"LR")) ;ICR 1003 5 DE 2818 ASF 11/10/ 15
	15427	"RTN","HMP DJ08A",113 ,0)
	15428	S LR=$S(S UB="AU":$G (^LR(LRDFN ,"AU")),1: $G(^LR(LRD FN,SUB,IDT ,0)))
	15429	"RTN","HMP DJ08A",114 ,0)
	15430	S NAME="L R "_$$NAME ^HMPDLRA(S UB)_" REPO RT"
	15431	"RTN","HMP DJ08A",115 ,0)
	15432	S LOC=$P( LR,U,$S(SU B="AU":5,1 :8)) D ;l ook-up vis it
	15433	"RTN","HMP DJ08A",116 ,0)
	15434	. N CDT,S C S CDT=99 99999-IDT, SC="",X=0
	15435	"RTN","HMP DJ08A",117 ,0)
	15436	. S:$L(LO C) SC=+$O( ^SC("B",LO C,0)) ;ICR 10040 DE2 818 ASF 11 /10/15
	15437	"RTN","HMP DJ08A",118 ,0)
	15438	. I CDT,L OC S X=$$G ETENC^PXAP I(DFN,CDT, SC)
	15439	"RTN","HMP DJ08A",119 ,0)
	15440	. S:X VST =+X
	15441	"RTN","HMP DJ08A",120 ,0)
	15442	S X=+$P(L R,U,$S(SUB ="AU":10,S UB="MI":4, 1:2)) ;pat hologist[a uthor]
	15443	"RTN","HMP DJ08A",121 ,0)
	15444	S USER=$S (X:X_";;"_ $P($G(^VA( 200,X,0)), U),1:""),S IGN="" ;IC R 10060 DE 2818 ASF 1 1/10/15
	15445	"RTN","HMP DJ08A",122 ,0)
	15446	S X=$S(SU B="AU":$P( LR,U,15,16 ),SUB="MI" :$P(LR,U,3 ,4),1:$P(L R,U,11)_U_ $P(LR,U,13 )) ;releas ed
	15447	"RTN","HMP DJ08A",123 ,0)
	15448	S:X SIGN= "//"_+$P(X ,U,2)_";"_ $P($G(^VA( 200,+$P(X, U,2),0)),U )_";"_+X ; ICR 10060 DE2818 ASF 11/10/15
	15449	"RTN","HMP DJ08A",124 ,0)
	15450	S Y=ID_U_ NAME_U_(99 99999-IDT) _U_U_USER_ U_LOC_"^CO MPLETED^"_ $G(VST)_"^ ^2753^"_SI GN
	15451	"RTN","HMP DJ08A",125 ,0)
	15452	S:$G(HMPT EXT) TEXT= $$TEXT^HMP DLRA(DFN,S UB,IDT) ;^ TMP("HMPTE XT",$J,ID)
	15453	"RTN","HMP DJ08A",126 ,0)
	15454	Q Y
	15455	"RTN","HMP DJ08A",127 ,0)
	15456	;
	15457	"RTN","HMP DJ08A",128 ,0)
	15458	; ------- ---------- ---------- ---------- ---------- ---------- ---------
	15459	"RTN","HMP DJ08A",129 ,0)
	15460	; nationa lTitle = 4 695068^RAD IOLOGY REP ORT
	15461	"RTN","HMP DJ08A",130 ,0)
	15462	; S ubject = 4 693357^RAD IOLOGY
	15463	"RTN","HMP DJ08A",131 ,0)
	15464	; Type = 4 696123^REP ORT
	15465	"RTN","HMP DJ08A",132 ,0)
	15466	;
	15467	"RTN","HMP DJ08A",133 ,0)
	15468	RA(DFN,BEG ,END,MAX) ; -- Radio logy repor ts
	15469	"RTN","HMP DJ08A",134 ,0)
	15470	N HMPXID, STS,PSET
	15471	"RTN","HMP DJ08A",135 ,0)
	15472	S DFN=+$G (DFN) Q:DF N<1
	15473	"RTN","HMP DJ08A",136 ,0)
	15474	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)_ "P"
	15475	"RTN","HMP DJ08A",137 ,0)
	15476	K ^TMP($J ,"RAE1") D EN1^RAO7P C1(DFN,BEG ,END,MAX)
	15477	"RTN","HMP DJ08A",138 ,0)
	15478	S HMPXID= "" F S HM PXID=$O(^T MP($J,"RAE 1",DFN,HMP XID)) Q:HM PXID="" D
	15479	"RTN","HMP DJ08A",139 ,0)
	15480	. S STS=$ P($G(^TMP( $J,"RAE1", DFN,HMPXID )),U,3),PS ET=$G(^(HM PXID,"CPRS "))
	15481	"RTN","HMP DJ08A",140 ,0)
	15482	. Q:STS=" No Report" !(STS="Del eted") ;! (STS["Draf t")
	15483	"RTN","HMP DJ08A",141 ,0)
	15484	. I +PSET =2,$G(PSET (+HMPXID,$ P(PSET,U,2 ))) Q ;al ready have report
	15485	"RTN","HMP DJ08A",142 ,0)
	15486	. S HMPX= $$RA1(DFN, HMPXID) D EN1^HMPDJ0 8(HMPX,"RA ")
	15487	"RTN","HMP DJ08A",143 ,0)
	15488	. I +PSET =2 S PSET( +HMPXID,$P (PSET,U,2) )=$P(HMPXI D,"-",2) ; parent
	15489	"RTN","HMP DJ08A",144 ,0)
	15490	K ^TMP($J ,"RAE1"),^ TMP("HMPTE XT",$J)
	15491	"RTN","HMP DJ08A",145 ,0)
	15492	Q
	15493	"RTN","HMP DJ08A",146 ,0)
	15494	;
	15495	"RTN","HMP DJ08A",147 ,0)
	15496	RA1(DFN,ID ) ; -- ret urn report data as T IU string [$$RESOLVE ]
	15497	"RTN","HMP DJ08A",148 ,0)
	15498	N $ES,$ET ,ERRPAT,ER RMSG
	15499	"RTN","HMP DJ08A",149 ,0)
	15500	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	15501	"RTN","HMP DJ08A",150 ,0)
	15502	S ERRMSG= "A problem occurred converting radiology report "_ ID
	15503	"RTN","HMP DJ08A",151 ,0)
	15504	S DFN=+$G (DFN),ID=$ G(ID) I DF N<1!'$L(ID ) Q ""
	15505	"RTN","HMP DJ08A",152 ,0)
	15506	N EXAM,CA SE,PROC,RA E3,RAE1,TE XT,I,X,Y,D ATE,LOC,ST S,IENS,VST ,USER,SIGN
	15507	"RTN","HMP DJ08A",153 ,0)
	15508	K RPT,^TM P("HMPTEXT ",$J,ID)
	15509	"RTN","HMP DJ08A",154 ,0)
	15510	S EXAM=DF N_U_$TR(ID ,"-","^") D
	15511	"RTN","HMP DJ08A",155 ,0)
	15512	. N DFN D EN3^RAO7P C3(EXAM) ; report
	15513	"RTN","HMP DJ08A",156 ,0)
	15514	. D EN3^R AO7PC1(EXA M) ; add'l valu es
	15515	"RTN","HMP DJ08A",157 ,0)
	15516	S CASE=$O (^TMP($J," RAE3",DFN, 0)),PROC=$ O(^(CASE," ")),RAE3=$ G(^(PROC))
	15517	"RTN","HMP DJ08A",158 ,0)
	15518	S RAE1=$G (^TMP($J," RAE1",DFN, ID))
	15519	"RTN","HMP DJ08A",159 ,0)
	15520	I $G(HMPT EXT) D
	15521	"RTN","HMP DJ08A",160 ,0)
	15522	. S TEXT= $NA(^TMP(" HMPTEXT",$ J,ID))
	15523	"RTN","HMP DJ08A",161 ,0)
	15524	. S I=0 F S I=$O(^ TMP($J,"RA E3",DFN,CA SE,PROC,I) ) Q:I<1 S X=^(I),@T EXT@(I)=X
	15525	"RTN","HMP DJ08A",162 ,0)
	15526	S DATE=99 99999.9999 -(+ID),LOC =$P(RAE1,U ,7),STS=$P (RAE3,U)
	15527	"RTN","HMP DJ08A",163 ,0)
	15528	S IENS=$P (ID,"-",2) _","_+ID_" ,"_DFN_","
	15529	"RTN","HMP DJ08A",164 ,0)
	15530	S VST=$$G ET1^DIQ(70 .03,IENS,2 7,"I")
	15531	"RTN","HMP DJ08A",165 ,0)
	15532	S X=+$G(^ TMP($J,"RA E2",DFN,CA SE,PROC,"P ")),(USER, SIGN)=""
	15533	"RTN","HMP DJ08A",166 ,0)
	15534	S:X USER= X_";;"_$P( $G(^VA(200 ,X,0)),U) ;ICR 10060 DE2818 AS F 11/10/15
	15535	"RTN","HMP DJ08A",167 ,0)
	15536	S X=$G(^T MP($J,"RAE 2",DFN,CAS E,PROC,"V" ))
	15537	"RTN","HMP DJ08A",168 ,0)
	15538	S:X SIGN= "//"_+X_"; "_$P($G(^V A(200,+X,0 )),U)_";"_ $$GET1^DIQ (74,+$P(RA E1,U,5)_", ",7,"I") ; ICR 10060 DE2818 ASF 11/10/15
	15539	"RTN","HMP DJ08A",169 ,0)
	15540	I $D(^TMP ($J,"RAE3" ,DFN,"PRIN T_SET")) S PROC=$G(^ ("ORD")) ; use parent , if print set
	15541	"RTN","HMP DJ08A",170 ,0)
	15542	S Y=ID_U_ PROC_U_DAT E_U_U_USER _U_LOC_U_S TS_U_VST_" ^^1901^"_S IGN
	15543	"RTN","HMP DJ08A",171 ,0)
	15544	K ^TMP($J ,"RAE3",DF N),^TMP($J ,"RAE2",DF N)
	15545	"RTN","HMP DJ08A",172 ,0)
	15546	Q Y
	15547	"RTN","HMP DJ09")
	15548	0^46^B4725 1770
	15549	"RTN","HMP DJ09",1,0)
	15550	HMPDJ09 ;S LC/MKB,ASM R/RRB - PC E;Nov 16, 2015 14:08 :57
	15551	"RTN","HMP DJ09",2,0)
	15552	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	15553	"RTN","HMP DJ09",3,0)
	15554	;Per VA D irective 6 402, this routine sh ould not b e modified .
	15555	"RTN","HMP DJ09",4,0)
	15556	;
	15557	"RTN","HMP DJ09",5,0)
	15558	; Externa l Referenc es DBIA#
	15559	"RTN","HMP DJ09",6,0)
	15560	; ------- ---------- -- -----
	15561	"RTN","HMP DJ09",7,0)
	15562	; ^AUPNVS IT 2028
	15563	"RTN","HMP DJ09",8,0)
	15564	; ^PXRMIN DX 4290
	15565	"RTN","HMP DJ09",9,0)
	15566	; ^SC 10040
	15567	"RTN","HMP DJ09",10,0 )
	15568	; ^VA(200 10060
	15569	"RTN","HMP DJ09",11,0 )
	15570	; DIC 2051
	15571	"RTN","HMP DJ09",12,0 )
	15572	; DILFD 2055
	15573	"RTN","HMP DJ09",13,0 )
	15574	; DIQ 2056
	15575	"RTN","HMP DJ09",14,0 )
	15576	; PXAPI,^ TMP("PXKEN C" 1894
	15577	"RTN","HMP DJ09",15,0 )
	15578	; VALM1 10116
	15579	"RTN","HMP DJ09",16,0 )
	15580	; XUAF4 2171
	15581	"RTN","HMP DJ09",17,0 )
	15582	;
	15583	"RTN","HMP DJ09",18,0 )
	15584	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	15585	"RTN","HMP DJ09",19,0 )
	15586	Q
	15587	"RTN","HMP DJ09",20,0 )
	15588	;
	15589	"RTN","HMP DJ09",21,0 )
	15590	PX(FNUM) ; -- PCE it em(s)
	15591	"RTN","HMP DJ09",22,0 )
	15592	I $G(HMPI D) D PXA(H MPID) Q
	15593	"RTN","HMP DJ09",23,0 )
	15594	N HMPIDT, ID D SORT ;sort ^PXR MINDX into ^TMP("HMP PX",$J,IDT )
	15595	"RTN","HMP DJ09",24,0 )
	15596	S HMPIDT= 0 F S HMP IDT=$O(^TM P("HMPPX", $J,HMPIDT) ) Q:HMPIDT <1 D Q:H MPI'<HMPMA X
	15597	"RTN","HMP DJ09",25,0 )
	15598	. S ID=0 F S ID=$O (^TMP("HMP PX",$J,HMP IDT,ID)) Q :ID<1 D P X1 Q:HMPI' <HMPMAX
	15599	"RTN","HMP DJ09",26,0 )
	15600	K ^TMP("H MPPX",$J)
	15601	"RTN","HMP DJ09",27,0 )
	15602	Q
	15603	"RTN","HMP DJ09",28,0 )
	15604	;
	15605	"RTN","HMP DJ09",29,0 )
	15606	PXA(ID) ; -- find ID in ^PXRMI NDX(FNUM), fall thru to PX1 if successfu l
	15607	"RTN","HMP DJ09",30,0 )
	15608	N N,ROOT, IDX,P,ITEM ,DATE,HMPI DT
	15609	"RTN","HMP DJ09",31,0 )
	15610	S N=+$P(F NUM,".",2) K ^TMP("H MPPX",$J)
	15611	"RTN","HMP DJ09",32,0 )
	15612	I N=7!(N= 18) S ROOT ="^PXRMIND X("_FNUM_" ,""PPI""," _+$G(DFN)
	15613	"RTN","HMP DJ09",33,0 )
	15614	E S ROOT ="^PXRMIND X("_FNUM_" ,""PI"","_ +$G(DFN)
	15615	"RTN","HMP DJ09",34,0 )
	15616	S IDX=ROO T_")" F S IDX=$Q(@I DX) Q:$P(I DX,",",1,3 )'=ROOT D
	15617	"RTN","HMP DJ09",35,0 )
	15618	. S P=$L( IDX,",") Q :ID'=+$P(I DX,",",P) ;last sub script
	15619	"RTN","HMP DJ09",36,0 )
	15620	. S DATE= +$P(IDX,", ",P-1),ITE M=+$P(IDX, ",",P-2)
	15621	"RTN","HMP DJ09",37,0 )
	15622	. S HMPID T=9999999- DATE,^TMP( "HMPPX",$J ,HMPIDT,ID )=ITEM_U_D ATE
	15623	"RTN","HMP DJ09",38,0 )
	15624	Q:'$D(^TM P("HMPPX", $J)) ;not found
	15625	"RTN","HMP DJ09",39,0 )
	15626	PX1 ; -- P CE ^TMP("H MPPX",$J,H MPIDT,ID)= ITM^DATE f or FNUM
	15627	"RTN","HMP DJ09",40,0 )
	15628	N N,COLL, TAG,HMPF,F LD,TMP,VIS IT,X0,X12, FAC,LOC,X, Y,PCE
	15629	"RTN","HMP DJ09",41,0 )
	15630	N $ES,$ET ,ERRPAT,ER RMSG
	15631	"RTN","HMP DJ09",42,0 )
	15632	S $ET="D ERRHDLR^HM PDERRH",ER RPAT=DFN
	15633	"RTN","HMP DJ09",43,0 )
	15634	S N=+$P(F NUM,".",2) ,TAG=$S(N= 7:"VPOV",N =11:"VIMM" ,N=12:"VSK IN",N=13:" VXAM",N=16 :"VPEDU",N =18:"VCPT" ,1:"VHF")
	15635	"RTN","HMP DJ09",44,0 )
	15636	S ERRMSG= "A problem occurred converting record "_ ID_" for " _TAG
	15637	"RTN","HMP DJ09",45,0 )
	15638	D @(TAG_" ^PXPXRM(ID ,.HMPF)")
	15639	"RTN","HMP DJ09",46,0 )
	15640	;
	15641	"RTN","HMP DJ09",47,0 )
	15642	S PCE("lo calId")=ID ,TMP=$G(^T MP("HMPPX" ,$J,HMPIDT ,ID))
	15643	"RTN","HMP DJ09",48,0 )
	15644	S COLL=$S (N=7:"pov" ,N=11:"imm unization" ,N=12:"ski n",N=13:"e xam",N=16: "education ",N=18:"cp t",1:"fact or")
	15645	"RTN","HMP DJ09",49,0 )
	15646	S PCE("ui d")=$$SETU ID^HMPUTIL S(COLL,DFN ,ID)
	15647	"RTN","HMP DJ09",50,0 )
	15648	; TAG=$S( N=23:"reco rded",N=11 :"administ eredDateTi me",1:"dat eTimeEnter ed")
	15649	"RTN","HMP DJ09",51,0 )
	15650	S TAG=$S( N=11:"admi nisteredDa teTime",1: "entered")
	15651	"RTN","HMP DJ09",52,0 )
	15652	S PCE(TAG )=$$JSONDT ^HMPUTILS( $P(TMP,U,2 ))
	15653	"RTN","HMP DJ09",53,0 )
	15654	S PCE("na me")=$$EXT ERNAL^DILF D(FNUM,.01 ,,+TMP)
	15655	"RTN","HMP DJ09",54,0 )
	15656	S VISIT=+ $G(HMPF("V ISIT")),PC E("encount erUid")=$$ SETUID^HMP UTILS("vis it",DFN,VI SIT)
	15657	"RTN","HMP DJ09",55,0 )
	15658	S PCE("en counterNam e")=$$NAME ^HMPDJ04(V ISIT)
	15659	"RTN","HMP DJ09",56,0 )
	15660	;DE2818, ^AUPNVSIT - ICR 2028
	15661	"RTN","HMP DJ09",57,0 )
	15662	S X0=$G(^ AUPNVSIT(+ VISIT,0)), FAC=+$P(X0 ,U,6),LOC= +$P(X0,U,2 2) ;(#.06 ) LOC. OF ENCOUNTER, (#.22) HO SPITAL LOC ATION
	15663	"RTN","HMP DJ09",58,0 )
	15664	S:FAC X=$ $STA^XUAF4 (FAC)_U_$P ($$NS^XUAF 4(FAC),U)
	15665	"RTN","HMP DJ09",59,0 )
	15666	S:'FAC X= $$FAC^HMPD (LOC)
	15667	"RTN","HMP DJ09",60,0 )
	15668	D FACILIT Y^HMPUTILS (X,"PCE")
	15669	"RTN","HMP DJ09",61,0 )
	15670	;DE2818 ^ SC global reference changed to FileMan
	15671	"RTN","HMP DJ09",62,0 )
	15672	S:LOC PCE ("location Uid")=$$SE TUID^HMPUT ILS("locat ion",,LOC) ,PCE("loca tionName") =$$GET1^DI Q(44,LOC_" ,",.01)
	15673	"RTN","HMP DJ09",63,0 )
	15674	S X=$G(HM PF("COMMEN TS")) S:$L (X) PCE("c omment")=X
	15675	"RTN","HMP DJ09",64,0 )
	15676	POV I FNUM =9000010.0 7 D G PXQ
	15677	"RTN","HMP DJ09",65,0 )
	15678	. S X=$G( HMPF("PRIM ARY/SECOND ARY")),PCE ("type")=$ S($L(X):X, 1:"U")
	15679	"RTN","HMP DJ09",66,0 )
	15680	. S X=PCE ("name"),P CE("icdCod e")=$$SETN CS^HMPUTIL S("icd",X)
	15681	"RTN","HMP DJ09",67,0 )
	15682	. S X=$G( HMPF("PROV IDER NARRA TIVE")),PC E("name")= $$EXTERNAL ^DILFD(900 0010.07,.0 4,,X)
	15683	"RTN","HMP DJ09",68,0 )
	15684	CPT I FNUM =9000010.1 8 D G PXQ
	15685	"RTN","HMP DJ09",69,0 )
	15686	. S X=$G( HMPF("PRIN CIPAL PROC EDURE")),P CE("type") =$S($L(X): X,1:"U")
	15687	"RTN","HMP DJ09",70,0 )
	15688	. S X=PCE ("name"),P CE("cptCod e")=$$SETN CS^HMPUTIL S("cpt",X)
	15689	"RTN","HMP DJ09",71,0 )
	15690	. S X=$G( HMPF("PROV IDER NARRA TIVE")),PC E("name")= $$EXTERNAL ^DILFD(900 0010.18,.0 4,,X)
	15691	"RTN","HMP DJ09",72,0 )
	15692	. S PCE(" quantity") =HMPF("QUA NTITY")
	15693	"RTN","HMP DJ09",73,0 )
	15694	S X=$G(HM PF("VALUE" )),FLD=$S( FNUM=90000 10.16:.06, 1:.04)
	15695	"RTN","HMP DJ09",74,0 )
	15696	S Y=$$EXT ERNAL^DILF D(FNUM,FLD ,,X)
	15697	"RTN","HMP DJ09",75,0 )
	15698	IM I FNUM= 9000010.11 D G PXQ ;immunizat ion
	15699	"RTN","HMP DJ09",76,0 )
	15700	. S:$L(Y) PCE("seri esName")=Y ,PCE("seri esCode")=$ $SETUID^HM PUTILS("se ries",DFN, Y)
	15701	"RTN","HMP DJ09",77,0 )
	15702	. S X=$G( HMPF("REAC TION")) I $L(X) D
	15703	"RTN","HMP DJ09",78,0 )
	15704	.. S PCE( "reactionN ame")=$$EX TERNAL^DIL FD(9000010 .11,.06,,X )
	15705	"RTN","HMP DJ09",79,0 )
	15706	.. S PCE( "reactionC ode")=$$SE TUID^HMPUT ILS("react ion",DFN,X )
	15707	"RTN","HMP DJ09",80,0 )
	15708	. S PCE(" contraindi cated")=$S (+$G(HMPF( "CONTRAIND ICATED")): "true",1:" false")
	15709	"RTN","HMP DJ09",81,0 )
	15710	. I '$D(^ TMP("PXKEN C",$J,VISI T)) D ENCE VENT^PXAPI (VISIT,1)
	15711	"RTN","HMP DJ09",82,0 )
	15712	. S X12=$ G(^TMP("PX KENC",$J,V ISIT,"IMM" ,ID,12))
	15713	"RTN","HMP DJ09",83,0 )
	15714	. S X=$P( X12,U,4) S :'X X=$P(X 12,U,2)
	15715	"RTN","HMP DJ09",84,0 )
	15716	. I 'X S I=0 F S I =$O(^TMP(" PXKENC",$J ,VISIT,"PR V",I)) Q:I <1 I $P($ G(^(I,0)), U,4)="P" S X=+^(0) Q
	15717	"RTN","HMP DJ09",85,0 )
	15718	. ;DE2818 , ^VA(200 reference changed to FileMan
	15719	"RTN","HMP DJ09",86,0 )
	15720	. S:X PCE ("performe rUid")=$$S ETUID^HMPU TILS("user ",,+X),PCE ("performe rName")=$$ GET1^DIQ(2 00,X_",",. 01)
	15721	"RTN","HMP DJ09",87,0 )
	15722	. ; CPT m apping
	15723	"RTN","HMP DJ09",88,0 )
	15724	. S X=+$$ FIND1^DIC( 811.1,,"QX ",+TMP_";A UTTIMM("," B") I X>0 D
	15725	"RTN","HMP DJ09",89,0 )
	15726	.. S Y=$$ GET1^DIQ(8 11.1,X_"," ,.02,"I") Q:Y<1
	15727	"RTN","HMP DJ09",90,0 )
	15728	.. N CPT S CPT=$G(@ (U_$P(Y,"; ",2)_+Y_", 0)"))
	15729	"RTN","HMP DJ09",91,0 )
	15730	.. S PCE( "cptCode") =$$SETNCS^ HMPUTILS(" cpt",+CPT)
	15731	"RTN","HMP DJ09",92,0 )
	15732	.. S (PCE ("summary" ),PCE("cpt Name"))=$P (CPT,U,2)
	15733	"RTN","HMP DJ09",93,0 )
	15734	HF I FNUM= 9000010.23 D G PXQ ;health fa ctor
	15735	"RTN","HMP DJ09",94,0 )
	15736	. S:$L(X) PCE("seve rityUid")= $$SETVURN^ HMPUTILS(" factor-sev erity",X), PCE("sever ityName")= $$LOWER^VA LM1(Y)
	15737	"RTN","HMP DJ09",95,0 )
	15738	. S X=$$G ET1^DIQ(99 99999.64,+ TMP_",",.0 3,"I") I X D
	15739	"RTN","HMP DJ09",96,0 )
	15740	.. S PCE( "categoryU id")=$$SET VURN^HMPUT ILS("facto r-category ",X)
	15741	"RTN","HMP DJ09",97,0 )
	15742	.. S PCE( "categoryN ame")=$$EX TERNAL^DIL FD(9999999 .64,.03,"" ,X)
	15743	"RTN","HMP DJ09",98,0 )
	15744	. S X=$$G ET1^DIQ(99 99999.64,+ TMP_",",.0 8)
	15745	"RTN","HMP DJ09",99,0 )
	15746	. I $E(X) ="Y" S PCE ("display" )="true"
	15747	"RTN","HMP DJ09",100, 0)
	15748	. S PCE(" kind")="He alth Facto r",PCE("su mmary")=PC E("name")
	15749	"RTN","HMP DJ09",101, 0)
	15750	SK I FNUM= 9000010.12 D ;skin test [fall thru to s et result]
	15751	"RTN","HMP DJ09",102, 0)
	15752	. S X=$G( HMPF("READ ING")) S:$ L(X) PCE(" reading")= X
	15753	"RTN","HMP DJ09",103, 0)
	15754	. S X=$G( HMPF("DATE READ")) S :X PCE("da teRead")=$ $JSONDT^HM PUTILS(X)
	15755	"RTN","HMP DJ09",104, 0)
	15756	S:$L(Y) P CE("result ")=Y
	15757	"RTN","HMP DJ09",105, 0)
	15758	PXQ ;finis h
	15759	"RTN","HMP DJ09",106, 0)
	15760	S PCE("la stUpdateTi me")=$$EN^ HMPSTMP(CO LL) ; RHL 20150115
	15761	"RTN","HMP DJ09",107, 0)
	15762	S PCE("st ampTime")= PCE("lastU pdateTime" ) ; RHL 20150115
	15763	"RTN","HMP DJ09",108, 0)
	15764	;US6734 - pre-compi le metasta mp
	15765	"RTN","HMP DJ09",109, 0)
	15766	I $G(HMPM ETA) D ADD ^HMPMETA(C OLL,PCE("u id"),PCE(" stampTime" )) Q:HMPME TA=1 ;US6 734,US1101 9
	15767	"RTN","HMP DJ09",110, 0)
	15768	D ADD^HMP DJ("PCE",C OLL)
	15769	"RTN","HMP DJ09",111, 0)
	15770	Q
	15771	"RTN","HMP DJ09",112, 0)
	15772	;
	15773	"RTN","HMP DJ09",113, 0)
	15774	SORT ; -- build ^TMP ("HMPPX",$ J,9999999- DATE,DA)=I TEM^DATE i n range
	15775	"RTN","HMP DJ09",114, 0)
	15776	N TYPE,IT EM,DATE,DA ,IDT K ^TM P("HMPPX", $J)
	15777	"RTN","HMP DJ09",115, 0)
	15778	I FNUM=90 00010.07!( FNUM=90000 10.18) G P PI
	15779	"RTN","HMP DJ09",116, 0)
	15780	PI ; from ^PXRMINDX( FNUM,"PI", DFN,ITEM,D ATE,DA)
	15781	"RTN","HMP DJ09",117, 0)
	15782	;DE2818, ^PXRMINDX - ICR 4290
	15783	"RTN","HMP DJ09",118, 0)
	15784	S ITEM=0 F S ITEM= $O(^PXRMIN DX(FNUM,"P I",+$G(DFN ),ITEM)) Q :ITEM<1 D
	15785	"RTN","HMP DJ09",119, 0)
	15786	. S DATE= 0 F S DAT E=$O(^PXRM INDX(FNUM, "PI",+$G(D FN),ITEM,D ATE)) Q:DA TE<1 D
	15787	"RTN","HMP DJ09",120, 0)
	15788	.. Q:DATE <HMPSTART Q:DATE>HM PSTOP S I DT=9999999 -DATE
	15789	"RTN","HMP DJ09",121, 0)
	15790	.. S DA=0 F S DA=$ O(^PXRMIND X(FNUM,"PI ",+$G(DFN) ,ITEM,DATE ,DA)) Q:DA <1 S ^TMP ("HMPPX",$ J,IDT,DA)= ITEM_U_DAT E
	15791	"RTN","HMP DJ09",122, 0)
	15792	Q
	15793	"RTN","HMP DJ09",123, 0)
	15794	PPI ; from ^PXRMINDX (FNUM,"PPI ",DFN,TYPE ,ITEM,DATE ,DA)
	15795	"RTN","HMP DJ09",124, 0)
	15796	S TYPE="" F S TYPE =$O(^PXRMI NDX(FNUM," PPI",+$G(D FN),TYPE)) Q:TYPE="" D
	15797	"RTN","HMP DJ09",125, 0)
	15798	. S ITEM= 0 F S ITE M=$O(^PXRM INDX(FNUM, "PPI",+$G( DFN),TYPE, ITEM)) Q:I TEM<1 D
	15799	"RTN","HMP DJ09",126, 0)
	15800	.. S DATE =0 F S DA TE=$O(^PXR MINDX(FNUM ,"PPI",+$G (DFN),TYPE ,ITEM,DATE )) Q:DATE< 1 D
	15801	"RTN","HMP DJ09",127, 0)
	15802	... Q:DAT E<HMPSTART Q:DATE>H MPSTOP S IDT=999999 9-DATE
	15803	"RTN","HMP DJ09",128, 0)
	15804	... S DA= 0 F S DA= $O(^PXRMIN DX(FNUM,"P PI",+$G(DF N),TYPE,IT EM,DATE,DA )) Q:DA<1 S ^TMP("H MPPX",$J,I DT,DA)=ITE M_U_DATE
	15805	"RTN","HMP DJ09",129, 0)
	15806	Q
	15807	"RTN","HMP DJ09",130, 0)
	15808	PTF ; from ^PXRMINDX (45,"ICD9" ,"PNI",DFN ,TYPE,ITEM ,DATE,DA)
	15809	"RTN","HMP DJ09",131, 0)
	15810	;Purpose - Build ^T MP("HMPPX" ) from ^PX RMINDX(45, HMPISYS,"P NI",DFN)
	15811	"RTN","HMP DJ09",132, 0)
	15812	;
	15813	"RTN","HMP DJ09",133, 0)
	15814	;Called b y - PTF^HM PDJ0 (if H MPID is no t set)
	15815	"RTN","HMP DJ09",134, 0)
	15816	;
	15817	"RTN","HMP DJ09",135, 0)
	15818	;Assumpti ons -
	15819	"RTN","HMP DJ09",136, 0)
	15820	;1. DFN, HMPSTART a nd HMPSTOP variables have been set in pr ior code
	15821	"RTN","HMP DJ09",137, 0)
	15822	;2. ^TMP( "HMPPX") d oes not ex ist and ne eds to be built
	15823	"RTN","HMP DJ09",138, 0)
	15824	;3. '$G(H MPID)
	15825	"RTN","HMP DJ09",139, 0)
	15826	;
	15827	"RTN","HMP DJ09",140, 0)
	15828	;Modifica tion Histo ry -
	15829	"RTN","HMP DJ09",141, 0)
	15830	;US5630 ( TW) - HMPI SYS can be either "I CD" or "10 D" (ICD-10 )
	15831	"RTN","HMP DJ09",142, 0)
	15832	;
	15833	"RTN","HMP DJ09",143, 0)
	15834	N HMPISYS ,HMPTYP,HM PDX,HMPDT, HMPITEM
	15835	"RTN","HMP DJ09",144, 0)
	15836	S HMPISYS ="" F S H MPISYS=$O( ^PXRMINDX( 45,HMPISYS )) Q:HMPIS YS="" D
	15837	"RTN","HMP DJ09",145, 0)
	15838	. Q:'$D(^ PXRMINDX(4 5,HMPISYS, "PNI",+$G( DFN)))
	15839	"RTN","HMP DJ09",146, 0)
	15840	. S HMPTY P="" F S HMPTYP=$O( ^PXRMINDX( 45,HMPISYS ,"PNI",+$G (DFN),HMPT YP)) Q:HMP TYP="" D
	15841	"RTN","HMP DJ09",147, 0)
	15842	.. S HMPD X=0 F S H MPDX=$O(^P XRMINDX(45 ,HMPISYS," PNI",+$G(D FN),HMPTYP ,HMPDX)) Q :HMPDX="" D
	15843	"RTN","HMP DJ09",148, 0)
	15844	... S HMP DT=0 F S HMPDT=$O(^ PXRMINDX(4 5,HMPISYS, "PNI",+$G( DFN),HMPTY P,HMPDX,HM PDT)) Q:HM PDT<1 D
	15845	"RTN","HMP DJ09",149, 0)
	15846	.... Q:HM PDT<HMPSTA RT Q:HMPD T>HMPSTOP S HMPRDT= 9999999-HM PDT
	15847	"RTN","HMP DJ09",150, 0)
	15848	.... S HM PITEM="" F S HMPITE M=$O(^PXRM INDX(45,HM PISYS,"PNI ",+$G(DFN) ,HMPTYP,HM PDX,HMPDT, HMPITEM)) Q:HMPITEM= "" S ^TMP ("HMPPX",$ J,HMPRDT,H MPITEM_";" _HMPTYP)=H MPDX_U_HMP DT_U_HMPIS YS
	15849	"RTN","HMP DJ09",151, 0)
	15850	Q
	15851	"RTN","HMP DJ09M")
	15852	0^47^B1431 6939
	15853	"RTN","HMP DJ09M",1,0 )
	15854	HMPDJ09M ; SLC/MKB,AS MR/RRB - M ental Heal th;Nov 16, 2015 17:1 5:13
	15855	"RTN","HMP DJ09M",2,0 )
	15856	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	15857	"RTN","HMP DJ09M",3,0 )
	15858	;Per VA D irective 6 402, this routine sh ould not b e modified .
	15859	"RTN","HMP DJ09M",4,0 )
	15860	;
	15861	"RTN","HMP DJ09M",5,0 )
	15862	; All tag s expect D FN, ID, [H MPSTART, H MPSTOP, HM PMAX, HMPT EXT]
	15863	"RTN","HMP DJ09M",6,0 )
	15864	Q
	15865	"RTN","HMP DJ09M",7,0 )
	15866	;
	15867	"RTN","HMP DJ09M",8,0 )
	15868	MH ; -- Me ntal Healt h Administ rations [f rom ^HMPDJ 0]
	15869	"RTN","HMP DJ09M",9,0 )
	15870	I $G(HMPI D) D MH1(H MPID) Q
	15871	"RTN","HMP DJ09M",10, 0)
	15872	N CNT,HMP IDT,ID,FNU M,TOTAL,HM POUT,HMPYS ,IEN
	15873	"RTN","HMP DJ09M",11, 0)
	15874	;
	15875	"RTN","HMP DJ09M",12, 0)
	15876	;DE2818, for ^YTT(6 01.71), su bscription needed to ICR 5044
	15877	"RTN","HMP DJ09M",13, 0)
	15878	S IEN=0 F S IEN=$O (^YTT(601. 71,IEN)) Q :IEN'>0 D
	15879	"RTN","HMP DJ09M",14, 0)
	15880	.S HMPYS( "CODE")=IE N,HMPYS("D FN")=+$G(D FN),HMPYS( "LIMIT")=9 99
	15881	"RTN","HMP DJ09M",15, 0)
	15882	.K HMPOUT
	15883	"RTN","HMP DJ09M",16, 0)
	15884	.D PTTEST ^YTQPXRM2( .HMPOUT,.H MPYS)
	15885	"RTN","HMP DJ09M",17, 0)
	15886	.I HMPOUT (1)["[ERRO R]" Q
	15887	"RTN","HMP DJ09M",18, 0)
	15888	.S TOTAL= $P(HMPOUT( 1),U,2)+1
	15889	"RTN","HMP DJ09M",19, 0)
	15890	.I $P(HMP OUT(1),U,2 )<1 Q
	15891	"RTN","HMP DJ09M",20, 0)
	15892	.;S CNT=1 F S CNT= $O(HMPOUT( CNT)) Q:CN T'>0 D
	15893	"RTN","HMP DJ09M",21, 0)
	15894	.F CNT=2: 1:TOTAL D
	15895	"RTN","HMP DJ09M",22, 0)
	15896	..I $G(HM POUT(CNT)) ="" Q
	15897	"RTN","HMP DJ09M",23, 0)
	15898	..S ID=$P (HMPOUT(CN T),U)
	15899	"RTN","HMP DJ09M",24, 0)
	15900	..D MH1(I D,IEN)
	15901	"RTN","HMP DJ09M",25, 0)
	15902	;handle o ld MH test before th e latest r evision to their pac kage
	15903	"RTN","HMP DJ09M",26, 0)
	15904	;S FNUM=6 01.2 D SOR T^HMPDJ09 ;sort ^PXR MINDX into ^TMP("HMP PX",$J,IDT )
	15905	"RTN","HMP DJ09M",27, 0)
	15906	;S HMPIDT =0 F S HM PIDT=$O(^T MP("HMPPX" ,$J,HMPIDT )) Q:HMPID T<1 D Q: HMPI'<HMPM AX
	15907	"RTN","HMP DJ09M",28, 0)
	15908	;. S ID=0 F S ID=$ O(^TMP("HM PPX",$J,HM PIDT,ID)) Q:ID<1 D YT1^HMPDJ0 9(ID) Q:HM PI'<HMPMAX
	15909	"RTN","HMP DJ09M",29, 0)
	15910	;I HMPI'< HMPMAX Q
	15911	"RTN","HMP DJ09M",30, 0)
	15912	;handle n ew MH test after re vision to their pack age
	15913	"RTN","HMP DJ09M",31, 0)
	15914	;S FNUM=6 01.84 D SO RT^HMPDJ09 ;sort ^PX RMINDX int o ^TMP("HM PPX",$J,ID T)
	15915	"RTN","HMP DJ09M",32, 0)
	15916	;S HMPIDT =0 F S HM PIDT=$O(^T MP("HMPPX" ,$J,HMPIDT )) Q:HMPID T<1 D Q: HMPI'<HMPM AX
	15917	"RTN","HMP DJ09M",33, 0)
	15918	;. S ID=0 F S ID=$ O(^TMP("HM PPX",$J,HM PIDT,ID)) Q:ID<1 D YT1^HMPDJ0 9(ID) Q:HM PI'<HMPMAX
	15919	"RTN","HMP DJ09M",34, 0)
	15920	K ^TMP("H MPPX",$J)
	15921	"RTN","HMP DJ09M",35, 0)
	15922	Q
	15923	"RTN","HMP DJ09M",36, 0)
	15924	;
	15925	"RTN","HMP DJ09M",37, 0)
	15926	MH1(ID,IEN ) ; -- MH Administra tion
	15927	"RTN","HMP DJ09M",38, 0)
	15928	N HMPY,CO PY,GBL,ISC OPY,MH,NAM E,NODE,CNT ,I,X2,X,Y, TEMP,TEXT
	15929	"RTN","HMP DJ09M",39, 0)
	15930	D ENDAS71 ^YTQPXRM6( .HMPY,ID)
	15931	"RTN","HMP DJ09M",40, 0)
	15932	;DE2818, for ^YTT(6 01.71), su bscription needed to ICR 5044
	15933	"RTN","HMP DJ09M",41, 0)
	15934	S NAME=$P ($G(^YTT(6 01.71,IEN, 0)),U) ;( #.01) NAME
	15935	"RTN","HMP DJ09M",42, 0)
	15936	S COPY=$G (^YTT(601. 71,IEN,7)) ;(#21) C OPYRIGHT T EXT
	15937	"RTN","HMP DJ09M",43, 0)
	15938	S ISCOPY= +$P($G(^YT T(601.71,I EN,8)),U,5 ) ;(#25) IS COPYRIG HTED
	15939	"RTN","HMP DJ09M",44, 0)
	15940	;HMPY(2) = Patient Name (1)^T est Code ( 2)^Test Ti tle (3)^In ternal Adm in date (4 )^External Admin Dat e (5)^Orde red by (6)
	15941	"RTN","HMP DJ09M",45, 0)
	15942	S MH("loc alId")=ID, X2=$G(HMPY (2))
	15943	"RTN","HMP DJ09M",46, 0)
	15944	S MH("uid ")=$$SETUI D^HMPUTILS ("mh",DFN, ID)
	15945	"RTN","HMP DJ09M",47, 0)
	15946	S MH("dis playName") =$P(X2,U,2 ),MH("name ")=$S(NAME '="":NAME, 1:$P(X2,U, 3))
	15947	"RTN","HMP DJ09M",48, 0)
	15948	S MH("adm inisteredD ateTime")= $$JSONDT^H MPUTILS($P (X2,U,4))
	15949	"RTN","HMP DJ09M",49, 0)
	15950	S X=$P(X2 ,U,6) I $L (X) D ;or dered by
	15951	"RTN","HMP DJ09M",50, 0)
	15952	. N HMPER R,HMPOUT ;DE2818, c hanged ^VA (200,"B") global ref erence to FileMan
	15953	"RTN","HMP DJ09M",51, 0)
	15954	. D FIND^ DIC(200,"" ,"@;.01"," X",X,"","B ","","","H MPOUT","HM PERR")
	15955	"RTN","HMP DJ09M",52, 0)
	15956	. ; if si ngle resul t found sa ve it in Y , else zer o
	15957	"RTN","HMP DJ09M",53, 0)
	15958	. S Y=$S( $P($G(HMPO UT("DILIST ",0)),U)=1 :$G(HMPOUT ("DILIST", 2,1)),1:0)
	15959	"RTN","HMP DJ09M",54, 0)
	15960	. S MH("p roviderNam e")=X
	15961	"RTN","HMP DJ09M",55, 0)
	15962	. S:Y MH( "providerU id")=$$SET UID^HMPUTI LS("user", ,Y)
	15963	"RTN","HMP DJ09M",56, 0)
	15964	;get ques tions/answ ers for te st
	15965	"RTN","HMP DJ09M",57, 0)
	15966	S I=0,CNT =0 F S I= $O(HMPY("R ",I)) Q:I' >0 D
	15967	"RTN","HMP DJ09M",58, 0)
	15968	.S NODE=$ G(HMPY("R" ,I))
	15969	"RTN","HMP DJ09M",59, 0)
	15970	.S CNT=CN T+1
	15971	"RTN","HMP DJ09M",60, 0)
	15972	.K TEMP,^ TMP($J,"HM P MH TEXT" )
	15973	"RTN","HMP DJ09M",61, 0)
	15974	.;answers
	15975	"RTN","HMP DJ09M",62, 0)
	15976	.S TEMP=$ P(NODE,U,2 ) I TEMP>0 D
	15977	"RTN","HMP DJ09M",63, 0)
	15978	..S MH("r esponses", CNT,"answe r","uid")= $$SETVURN^ HMPUTILS(" mha-answer ",TEMP)
	15979	"RTN","HMP DJ09M",64, 0)
	15980	..S MH("r esponses", CNT,"answe r","text") =$P(NODE,U ,6)
	15981	"RTN","HMP DJ09M",65, 0)
	15982	.;questio ns
	15983	"RTN","HMP DJ09M",66, 0)
	15984	.S TEMP=$ P(NODE,U,3 ) I TEMP>0 D
	15985	"RTN","HMP DJ09M",67, 0)
	15986	..S MH("r esponses", CNT,"quest ion","uid" )=$$SETVUR N^HMPUTILS ("mha-ques tion",TEMP )
	15987	"RTN","HMP DJ09M",68, 0)
	15988	..;DE2818 - ^YTT(60 1.72,D0,1, D1,0)= (#. 01) QUESTI ON TEXT [1 W], ICR 62 77
	15989	"RTN","HMP DJ09M",69, 0)
	15990	..S GBL=$ NA(^YTT(60 1.72,TEMP, 1))
	15991	"RTN","HMP DJ09M",70, 0)
	15992	..D SETTE XT^HMPUTIL S(GBL,$NA( ^TMP($J,"H MP MH TEXT ")))
	15993	"RTN","HMP DJ09M",71, 0)
	15994	..M MH("r esponses", CNT,"quest ion","text ","\")=^TM P($J,"HMP MH TEXT")
	15995	"RTN","HMP DJ09M",72, 0)
	15996	; get sca le(s) for test
	15997	"RTN","HMP DJ09M",73, 0)
	15998	S I=0,CNT =0 F S I= $O(HMPY("S I",I)) Q:I '>0 D
	15999	"RTN","HMP DJ09M",74, 0)
	16000	.S NODE=$ G(HMPY("SI ",I))
	16001	"RTN","HMP DJ09M",75, 0)
	16002	.S CNT=CN T+1
	16003	"RTN","HMP DJ09M",76, 0)
	16004	.S MH("sc ales",CNT, "scale","u id")=$$SET VURN^HMPUT ILS("mha-s cale",I)
	16005	"RTN","HMP DJ09M",77, 0)
	16006	.S MH("sc ales",CNT, "scale","n ame")=$P(N ODE,U,2)
	16007	"RTN","HMP DJ09M",78, 0)
	16008	.S MH("sc ales",CNT, "scale","r awScore")= $P(NODE,U, 3)
	16009	"RTN","HMP DJ09M",79, 0)
	16010	.I $P(NOD E,U,4)'="" S MH("sca les",CNT," scale","tr ansformSco re")=$P(NO DE,U,4)
	16011	"RTN","HMP DJ09M",80, 0)
	16012	S MH("isC opyright") =$S(ISCOPY =1:"true", 1:"false")
	16013	"RTN","HMP DJ09M",81, 0)
	16014	I ISCOPY= 1 S MH("co pyrightTex t")=COPY
	16015	"RTN","HMP DJ09M",82, 0)
	16016	S MH("las tUpdateTim e")=$$EN^H MPSTMP("mh ") ;RHL 20 150103
	16017	"RTN","HMP DJ09M",83, 0)
	16018	S MH("sta mpTime")=M H("lastUpd ateTime") ; RHL 2015 0103
	16019	"RTN","HMP DJ09M",84, 0)
	16020	;US6734 - pre-compi le metasta mp
	16021	"RTN","HMP DJ09M",85, 0)
	16022	I $G(HMPM ETA) D ADD ^HMPMETA(" mh",MH("ui d"),MH("st ampTime")) Q:HMPMETA =1 ;US673 4,US11019
	16023	"RTN","HMP DJ09M",86, 0)
	16024	D ADD^HMP DJ("MH","m h")
	16025	"RTN","HMP DJ09M",87, 0)
	16026	Q
	16027	"RTN","HMP DJ1")
	16028	0^32^B1864 4090
	16029	"RTN","HMP DJ1",1,0)
	16030	HMPDJ1 ;SL C/MKB,ASMR /RRB - HMP Patient O bject RPCs ;Nov 04, 2 015 17:37
	16031	"RTN","HMP DJ1",2,0)
	16032	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	16033	"RTN","HMP DJ1",3,0)
	16034	;Per VA D irective 6 402, this routine sh ould not b e modified .
	16035	"RTN","HMP DJ1",4,0)
	16036	;
	16037	"RTN","HMP DJ1",5,0)
	16038	Q
	16039	"RTN","HMP DJ1",6,0)
	16040	;
	16041	"RTN","HMP DJ1",7,0)
	16042	PUT(HMP,PA T,TYPE,JSO N) ; -- Sa ve/update JSON OBJEC T in ^HMP( 800000.1), return UI D if succe ssful
	16043	"RTN","HMP DJ1",8,0)
	16044	; RPC = H MP PUT PAT IENT DATA
	16045	"RTN","HMP DJ1",9,0)
	16046	;
	16047	"RTN","HMP DJ1",10,0)
	16048	N ARRAY,C NT,ERR,HMP ERR,UID,DA ,X,I,DFN,H MPSYS
	16049	"RTN","HMP DJ1",11,0)
	16050	;M JSON=I NPUT(0)
	16051	"RTN","HMP DJ1",12,0)
	16052	D DECODE^ HMPJSON("J SON","ARRA Y","HMPERR ")
	16053	"RTN","HMP DJ1",13,0)
	16054	;N XCNT S XCNT=$O(^ XTMP("AGPA RRAY",""), -1),XCNT=X CNT+1
	16055	"RTN","HMP DJ1",14,0)
	16056	;M ^XTMP( "AGPARRAY" ,XCNT,"DAT A")=ARRAY
	16057	"RTN","HMP DJ1",15,0)
	16058	;S ^XTMP( "AGPARRAY" ,XCNT,"TYP E")=TYPE
	16059	"RTN","HMP DJ1",16,0)
	16060	;M ^XTMP( "AGPARRAY" )=ARRAY
	16061	"RTN","HMP DJ1",17,0)
	16062	I $D(HMPE RR) D Q ;S X=$G(ER R(1)) K ER R S ERR=X G PTQ
	16063	"RTN","HMP DJ1",18,0)
	16064	. K ARRAY N HMPTMP, HMPTXT
	16065	"RTN","HMP DJ1",19,0)
	16066	. S HMPTX T(1)="Prob lem decodi ng json in put."
	16067	"RTN","HMP DJ1",20,0)
	16068	. D SETER ROR^HMPUTI LS(.HMPTMP ,.HMPERR,. HMPTXT,.JS ON)
	16069	"RTN","HMP DJ1",21,0)
	16070	. K HMPER R D ENCODE ^HMPJSON(" HMPTMP","A RRAY","HMP ERR")
	16071	"RTN","HMP DJ1",22,0)
	16072	. S HMP(. 5)="{""api Version"": ""1.01""," "error"":{ "
	16073	"RTN","HMP DJ1",23,0)
	16074	. M HMP(1 )=ARRAY
	16075	"RTN","HMP DJ1",24,0)
	16076	. S HMP(2 )="}}"
	16077	"RTN","HMP DJ1",25,0)
	16078	;
	16079	"RTN","HMP DJ1",26,0)
	16080	S UID=$G( ARRAY("uid ")),HMPSYS =$$GET^XPA R("SYS","H MP SYSTEM NAME")
	16081	"RTN","HMP DJ1",27,0)
	16082	I $L(UID) S DA=+$O( ^HMP(80000 0.1,"B",UI D,0)) I DA <1 S ERR=$ $ERR(3,UID ) G PTQ
	16083	"RTN","HMP DJ1",28,0)
	16084	I '$L(UID ) D G:$D( ERR) PTQ Q :$D(HMPERR )
	16085	"RTN","HMP DJ1",29,0)
	16086	. D NEW Q :$D(ERR)
	16087	"RTN","HMP DJ1",30,0)
	16088	. S ARRAY ("uid")=UI D K JSON
	16089	"RTN","HMP DJ1",31,0)
	16090	. D ENCOD E^HMPJSON( "ARRAY","J SON","HMPE RR")
	16091	"RTN","HMP DJ1",32,0)
	16092	. I $D(HM PERR) D Q ;S X=$G( ERR(1)) K ERR S ERR= X Q
	16093	"RTN","HMP DJ1",33,0)
	16094	.. K JSON N HMPTMP, HMPTXT
	16095	"RTN","HMP DJ1",34,0)
	16096	.. S HMPT XT(1)="Pro blem encod ing json o utput."
	16097	"RTN","HMP DJ1",35,0)
	16098	.. D SETE RROR^HMPUT ILS(.HMPTM P,.HMPERR, .HMPTXT,.A RRAY)
	16099	"RTN","HMP DJ1",36,0)
	16100	.. K HMPE RR D ENCOD E^HMPJSON( "HMPTMP"," JSON","HMP ERR")
	16101	"RTN","HMP DJ1",37,0)
	16102	.. S HMP( .5)="{""ap iVersion"" :""1.01"", ""error"": {"
	16103	"RTN","HMP DJ1",38,0)
	16104	.. M HMP( 1)=JSON
	16105	"RTN","HMP DJ1",39,0)
	16106	.. S HMP( 2)="}}"
	16107	"RTN","HMP DJ1",40,0)
	16108	;
	16109	"RTN","HMP DJ1",41,0)
	16110	K ^HMP(80 0000.1,DA, 1) S ^(1,0 )="^800000 .101^^",CN T=0
	16111	"RTN","HMP DJ1",42,0)
	16112	S I="" F S I=$O(JS ON(I)) Q:I ="" S CNT =CNT+1,^HM P(800000.1 ,DA,1,CNT, 0)=JSON(I)
	16113	"RTN","HMP DJ1",43,0)
	16114	S:$G(CNT) ^HMP(8000 00.1,DA,1, 0)="^80000 0.101^"_CN T_U_CNT
	16115	"RTN","HMP DJ1",44,0)
	16116	;
	16117	"RTN","HMP DJ1",45,0)
	16118	PTQ ; add item count and termi nating cha racters
	16119	"RTN","HMP DJ1",46,0)
	16120	I $D(ERR) S HMP="{" "apiVersio n"":""1.01 "",""error "":{""mess age"":"""_ ERR_"""}," "success"" :false}" Q
	16121	"RTN","HMP DJ1",47,0)
	16122	S HMP="{" "apiVersio n"":""1.01 "",""data" ":{""updat ed"":"_""" "_$$HL7NOW _""""_","" uid"":"""_ UID_"""}," "success"" :true}"
	16123	"RTN","HMP DJ1",48,0)
	16124	S DFN=+$P (UID,":",5 )
	16125	"RTN","HMP DJ1",49,0)
	16126	D POST^HM PEVNT(DFN, TYPE,DA) ; UID)
	16127	"RTN","HMP DJ1",50,0)
	16128	Q
	16129	"RTN","HMP DJ1",51,0)
	16130	;
	16131	"RTN","HMP DJ1",52,0)
	16132	NEW ; -- c reate new entry in ^ HMP(800000 .1) from P AT,TYPE,HM PSYS
	16133	"RTN","HMP DJ1",53,0)
	16134	; Return UID & DA, or ERR
	16135	"RTN","HMP DJ1",54,0)
	16136	N DFN,ICN
	16137	"RTN","HMP DJ1",55,0)
	16138	S DFN=+$G (PAT),ICN= "",TYPE=$G (TYPE)
	16139	"RTN","HMP DJ1",56,0)
	16140	I DFN<1,D FN[";" S I CN=+$P($G( DFN),";",2 ),DFN=+$G( DFN)
	16141	"RTN","HMP DJ1",57,0)
	16142	I DFN<1,I CN S DFN=+ $$GETDFN^M PIF001(ICN )
	16143	"RTN","HMP DJ1",58,0)
	16144	I DFN<1!' $D(^DPT(DF N)) S ERR= $$ERR(1,DF N) Q ; IA 10035, DE 2818
	16145	"RTN","HMP DJ1",59,0)
	16146	I TYPE="" S ERR=$$E RR(2,"null ") Q
	16147	"RTN","HMP DJ1",60,0)
	16148	;
	16149	"RTN","HMP DJ1",61,0)
	16150	S DA=$$NE XTIFN I DA <1 S ERR=$ $ERR(4) Q
	16151	"RTN","HMP DJ1",62,0)
	16152	S UID="ur n:va:"_TYP E_":"_HMPS YS_":"_DFN _":"_DA
	16153	"RTN","HMP DJ1",63,0)
	16154	S ^HMP(80 0000.1,DA, 0)=UID_U_D FN_U_TYPE
	16155	"RTN","HMP DJ1",64,0)
	16156	S ^HMP(80 0000.1,"B" ,UID,DA)=" "
	16157	"RTN","HMP DJ1",65,0)
	16158	S ^HMP(80 0000.1,"C" ,DFN,TYPE, DA)=""
	16159	"RTN","HMP DJ1",66,0)
	16160	Q
	16161	"RTN","HMP DJ1",67,0)
	16162	;
	16163	"RTN","HMP DJ1",68,0)
	16164	NEXTIFN() ; -- Retur ns next av ailable IF N
	16165	"RTN","HMP DJ1",69,0)
	16166	N I,HDR,T OTAL,DA
	16167	"RTN","HMP DJ1",70,0)
	16168	L +^HMP(8 00000.1,0) :$S($G(DIL OCKTM)>0:D ILOCKTM,1: 5)
	16169	"RTN","HMP DJ1",71,0)
	16170	I '$T Q " ^"
	16171	"RTN","HMP DJ1",72,0)
	16172	S HDR=$G( ^HMP(80000 0.1,0)),TO TAL=+$P(HD R,U,4),I=$ O(^HMP(800 000.1,"?") ,-1)
	16173	"RTN","HMP DJ1",73,0)
	16174	F I=(I+1) :1 Q:'$D(^ HMP(800000 .1,I,0))
	16175	"RTN","HMP DJ1",74,0)
	16176	S DA=I,$P (HDR,U,3,4 )=DA_U_(TO TAL+1) S ^ HMP(800000 .1,0)=HDR
	16177	"RTN","HMP DJ1",75,0)
	16178	L -^HMP(8 00000.1,0)
	16179	"RTN","HMP DJ1",76,0)
	16180	Q DA
	16181	"RTN","HMP DJ1",77,0)
	16182	;
	16183	"RTN","HMP DJ1",78,0)
	16184	ERR(X,VAL) ; -- retu rn error m essage
	16185	"RTN","HMP DJ1",79,0)
	16186	N MSG S MSG="Error "
	16187	"RTN","HMP DJ1",80,0)
	16188	I X=1 S MSG="Patie nt with df n '"_$G(VA L)_"' not found"
	16189	"RTN","HMP DJ1",81,0)
	16190	I X=2 S MSG="Domai n type '"_ $G(VAL)_"' not recog nized"
	16191	"RTN","HMP DJ1",82,0)
	16192	I X=3 S MSG="UID ' "_$G(VAL)_ "' not fou nd"
	16193	"RTN","HMP DJ1",83,0)
	16194	I X=4 S MSG="Unabl e to creat e new obje ct"
	16195	"RTN","HMP DJ1",84,0)
	16196	I X=99 S MSG="Unkno wn request "
	16197	"RTN","HMP DJ1",85,0)
	16198	Q MSG
	16199	"RTN","HMP DJ1",86,0)
	16200	;
	16201	"RTN","HMP DJ1",87,0)
	16202	HL7NOW() ; -- Return current t ime in HL7 format
	16203	"RTN","HMP DJ1",88,0)
	16204	Q $P($$FM THL7^XLFDT ($$NOW^XLF DT),"-")
	16205	"RTN","HMP DJ1",89,0)
	16206	;
	16207	"RTN","HMP DJ1",90,0)
	16208	CONV ; -- convert ui d format
	16209	"RTN","HMP DJ1",91,0)
	16210	N DA,X0,U ID,HMPSYS, DFN,COLL,N EW,I,JSON, HMPY,ERR,C NT
	16211	"RTN","HMP DJ1",92,0)
	16212	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	16213	"RTN","HMP DJ1",93,0)
	16214	S DA=0 F S DA=$O(^ HMP(800000 .1,DA)) Q: DA<1 D
	16215	"RTN","HMP DJ1",94,0)
	16216	. S X0=$G (^HMP(8000 00.1,DA,0) ),UID=$P(X 0,U)
	16217	"RTN","HMP DJ1",95,0)
	16218	. K ^HMP( 800000.1," B",UID,DA) ,JSON
	16219	"RTN","HMP DJ1",96,0)
	16220	. S DFN=$ P(X0,"^",2 ),COLL=$P( X0,"^",3)
	16221	"RTN","HMP DJ1",97,0)
	16222	. S NEW=" urn:va:"_C OLL_":"_HM PSYS_":"_D FN_":"_DA
	16223	"RTN","HMP DJ1",98,0)
	16224	. S $P(^H MP(800000. 1,DA,0),U) =NEW,^HMP( 800000.1," B",NEW,DA) =""
	16225	"RTN","HMP DJ1",99,0)
	16226	. ;decode JSON obje ct, reset uid
	16227	"RTN","HMP DJ1",100,0 )
	16228	. S I=0 F S I=$O(^ HMP(800000 .1,DA,1,I) ) Q:I<1 S JSON(I)=$ G(^(I,0))
	16229	"RTN","HMP DJ1",101,0 )
	16230	. Q:'$D(J SON) K HM PY,ERR
	16231	"RTN","HMP DJ1",102,0 )
	16232	. D DECOD E^HMPJSON( "JSON","HM PY","ERR") I $D(ERR) W !,DA Q
	16233	"RTN","HMP DJ1",103,0 )
	16234	. S HMPY( "uid")=NEW K JSON
	16235	"RTN","HMP DJ1",104,0 )
	16236	. D ENCOD E^HMPJSON( "HMPY","JS ON","ERR") I $D(ERR) W !,DA Q
	16237	"RTN","HMP DJ1",105,0 )
	16238	. K ^HMP( 800000.1,D A,1) S ^(1 ,0)="^8000 00.101^^", CNT=0
	16239	"RTN","HMP DJ1",106,0 )
	16240	. S I="" F S I=$O( JSON(I)) Q :I="" S C NT=CNT+1,^ HMP(800000 .1,DA,1,CN T,0)=JSON( I)
	16241	"RTN","HMP DJ1",107,0 )
	16242	. S:$G(CN T) ^HMP(80 0000.1,DA, 1,0)="^800 000.101^"_ CNT_U_CNT
	16243	"RTN","HMP DJ1",108,0 )
	16244	Q
	16245	"RTN","HMP DJ2")
	16246	0^34^B2143 9862
	16247	"RTN","HMP DJ2",1,0)
	16248	HMPDJ2 ;SL C/MKB,ASMR /RRB - HMP Object RP Cs;1/18/13 3:54pm
	16249	"RTN","HMP DJ2",2,0)
	16250	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	16251	"RTN","HMP DJ2",3,0)
	16252	;Per VA D irective 6 402, this routine sh ould not b e modified .
	16253	"RTN","HMP DJ2",4,0)
	16254	;
	16255	"RTN","HMP DJ2",5,0)
	16256	Q
	16257	"RTN","HMP DJ2",6,0)
	16258	;
	16259	"RTN","HMP DJ2",7,0)
	16260	GET(HMP,FI LTER) ; -- Return se arch resul ts as JSON in @HMP@( n)
	16261	"RTN","HMP DJ2",8,0)
	16262	; RPC = H MP GET OBJ ECT
	16263	"RTN","HMP DJ2",9,0)
	16264	N TYPE,HM PMAX,HMPI, HMPID,HMPE RR,IEN
	16265	"RTN","HMP DJ2",10,0)
	16266	S HMP=$NA (^TMP("HMP ",$J)),HMP I=0 K @HMP
	16267	"RTN","HMP DJ2",11,0)
	16268	;
	16269	"RTN","HMP DJ2",12,0)
	16270	; parse & validate input para meters
	16271	"RTN","HMP DJ2",13,0)
	16272	S TYPE=$G (FILTER("c ollection" )),TYPE=$$ LOW^XLFSTR (TYPE)
	16273	"RTN","HMP DJ2",14,0)
	16274	S HMPMAX= +$G(FILTER ("max"),99 99) ;??
	16275	"RTN","HMP DJ2",15,0)
	16276	S HMPID=$ G(FILTER(" id"))
	16277	"RTN","HMP DJ2",16,0)
	16278	;
	16279	"RTN","HMP DJ2",17,0)
	16280	;set erro r trap
	16281	"RTN","HMP DJ2",18,0)
	16282	N $ES,$ET ,ERRARRY,E RRDOM,ERRP AT,ERRMSG
	16283	"RTN","HMP DJ2",19,0)
	16284	;S $ET="D ERRHDLR^H MPDERRH G ERRQ^HMPDJ 0"
	16285	"RTN","HMP DJ2",20,0)
	16286	S ERRDOM= "hmp",ERRM SG=$G(TYPE )
	16287	"RTN","HMP DJ2",21,0)
	16288	K ^TMP($J ,"HMP ERRO R")
	16289	"RTN","HMP DJ2",22,0)
	16290	;
	16291	"RTN","HMP DJ2",23,0)
	16292	; extract data
	16293	"RTN","HMP DJ2",24,0)
	16294	I $L(HMPI D) D G GQ
	16295	"RTN","HMP DJ2",25,0)
	16296	. S IEN=+ HMPID I 'I EN S IEN=+ $O(^HMP(80 0000.11,"B ",HMPID,0) ) ;IEN or UID
	16297	"RTN","HMP DJ2",26,0)
	16298	. D:IEN H MP1^HMPDJ0 2(800000.1 1,IEN)
	16299	"RTN","HMP DJ2",27,0)
	16300	I TYPE="" S HMPERR= "Missing o r invalid collection type" G G Q
	16301	"RTN","HMP DJ2",28,0)
	16302	S IEN=0 F S IEN=$O (^HMP(8000 00.11,"C", TYPE,IEN)) Q:IEN<1 D HMP1^HMP DJ02(80000 0.11,IEN)
	16303	"RTN","HMP DJ2",29,0)
	16304	;
	16305	"RTN","HMP DJ2",30,0)
	16306	GQ ;build return JSO N
	16307	"RTN","HMP DJ2",31,0)
	16308	D GTQ^HMP DJ
	16309	"RTN","HMP DJ2",32,0)
	16310	Q
	16311	"RTN","HMP DJ2",33,0)
	16312	;
	16313	"RTN","HMP DJ2",34,0)
	16314	DEL(HMP,HM PID) ; -- Delete obj ect HMPID from ^HMP( 800000.11)
	16315	"RTN","HMP DJ2",35,0)
	16316	; RPC = H MP DELETE OBJECT
	16317	"RTN","HMP DJ2",36,0)
	16318	;
	16319	"RTN","HMP DJ2",37,0)
	16320	N ACTION, ERR,UID,DA ,DIK,TYPE
	16321	"RTN","HMP DJ2",38,0)
	16322	S UID=$G( HMPID) I ' $L(UID) S ERR=$$ERR( 3,"null") G PTQ
	16323	"RTN","HMP DJ2",39,0)
	16324	S DA=+$O( ^HMP(80000 0.11,"B",U ID,0)) I D A<1 S ERR= $$ERR(3,UI D) G PTQ
	16325	"RTN","HMP DJ2",40,0)
	16326	S DIK="^H MP(800000. 11," D ^DI K
	16327	"RTN","HMP DJ2",41,0)
	16328	S ACTION= "@",TYPE=$ P(UID,":", 3)
	16329	"RTN","HMP DJ2",42,0)
	16330	G PTQ
	16331	"RTN","HMP DJ2",43,0)
	16332	Q
	16333	"RTN","HMP DJ2",44,0)
	16334	;
	16335	"RTN","HMP DJ2",45,0)
	16336	PUT(HMP,TY PE,JSON) ; -- Save/u pdate JSON OBJECT in ^HMP(8000 00.11), re turn UID i f successf ul
	16337	"RTN","HMP DJ2",46,0)
	16338	; RPC = H MP PUT OBJ ECT
	16339	"RTN","HMP DJ2",47,0)
	16340	;
	16341	"RTN","HMP DJ2",48,0)
	16342	N ACTION, ARRAY,CNT, ERR,HMPERR ,UID,DA,X, I,HMPSYS
	16343	"RTN","HMP DJ2",49,0)
	16344	D DECODE^ HMPJSON("J SON","ARRA Y","HMPERR ")
	16345	"RTN","HMP DJ2",50,0)
	16346	;N XCNT S XCNT=$O(^ XTMP("AGPA RRAY",""), -1),XCNT=X CNT+1
	16347	"RTN","HMP DJ2",51,0)
	16348	;M ^XTMP( "AGPARRAY" ,XCNT,"DAT A")=ARRAY
	16349	"RTN","HMP DJ2",52,0)
	16350	;S ^XTMP( "AGPARRAY" ,XCNT,"TYP E")=TYPE
	16351	"RTN","HMP DJ2",53,0)
	16352	I $D(HMPE RR) D Q ;S X=$G(ER R(1)) K ER R S ERR=X G PTQ
	16353	"RTN","HMP DJ2",54,0)
	16354	. K ARRAY N HMPTMP, HMPTXT
	16355	"RTN","HMP DJ2",55,0)
	16356	. S HMPTX T(1)="Prob lem decodi ng json in put."
	16357	"RTN","HMP DJ2",56,0)
	16358	. D SETER ROR^HMPUTI LS(.HMPTMP ,.HMPERR,. HMPTXT,.JS ON)
	16359	"RTN","HMP DJ2",57,0)
	16360	. K HMPER R D ENCODE ^HMPJSON(" HMPTMP","A RRAY","HMP ERR")
	16361	"RTN","HMP DJ2",58,0)
	16362	. S HMP(. 5)="{""api Version"": ""1.01""," "error"":{ "
	16363	"RTN","HMP DJ2",59,0)
	16364	. M HMP(1 )=ARRAY
	16365	"RTN","HMP DJ2",60,0)
	16366	. S HMP(2 )="}}"
	16367	"RTN","HMP DJ2",61,0)
	16368	;
	16369	"RTN","HMP DJ2",62,0)
	16370	S UID=$G( ARRAY("uid ")),HMPSYS =$$GET^XPA R("SYS","H MP SYSTEM NAME")
	16371	"RTN","HMP DJ2",63,0)
	16372	I $L(UID) S DA=+$O( ^HMP(80000 0.11,"B",U ID,0)) I D A<1 S ERR= $$ERR(3,UI D) G PTQ
	16373	"RTN","HMP DJ2",64,0)
	16374	;I $L(UID ) S DA=+$O (^HMP(8000 00.11,"B", UID,0)) I DA<1 D NEW 1(UID)
	16375	"RTN","HMP DJ2",65,0)
	16376	I '$L(UID ) D G:$D( ERR) PTQ Q :$D(HMPERR )
	16377	"RTN","HMP DJ2",66,0)
	16378	. D NEW Q :$D(ERR)
	16379	"RTN","HMP DJ2",67,0)
	16380	. S ARRAY ("uid")=UI D K JSON
	16381	"RTN","HMP DJ2",68,0)
	16382	. D ENCOD E^HMPJSON( "ARRAY","J SON","HMPE RR")
	16383	"RTN","HMP DJ2",69,0)
	16384	. I $D(HM PERR) D Q ;S X=$G( ERR(1)) K ERR S ERR= X Q
	16385	"RTN","HMP DJ2",70,0)
	16386	.. K JSON N HMPTMP, HMPTXT
	16387	"RTN","HMP DJ2",71,0)
	16388	.. S HMPT XT(1)="Pro blem encod ing json o utput."
	16389	"RTN","HMP DJ2",72,0)
	16390	.. D SETE RROR^HMPUT ILS(.HMPTM P,.HMPERR, .HMPTXT,.A RRAY)
	16391	"RTN","HMP DJ2",73,0)
	16392	.. K HMPE RR D ENCOD E^HMPJSON( "HMPTMP"," JSON","HMP ERR")
	16393	"RTN","HMP DJ2",74,0)
	16394	.. S HMP( .5)="{""ap iVersion"" :""1.01"", ""error"": {"
	16395	"RTN","HMP DJ2",75,0)
	16396	.. M HMP( 1)=JSON
	16397	"RTN","HMP DJ2",76,0)
	16398	.. S HMP( 2)="}}"
	16399	"RTN","HMP DJ2",77,0)
	16400	;
	16401	"RTN","HMP DJ2",78,0)
	16402	K ^HMP(80 0000.11,DA ,1) S ^(1, 0)="^80000 0.111^^",C NT=0
	16403	"RTN","HMP DJ2",79,0)
	16404	S I="" F S I=$O(JS ON(I)) Q:I ="" S CNT =CNT+1,^HM P(800000.1 1,DA,1,CNT ,0)=JSON(I )
	16405	"RTN","HMP DJ2",80,0)
	16406	S:$G(CNT) ^HMP(8000 00.11,DA,1 ,0)="^8000 00.111^"_C NT_U_CNT
	16407	"RTN","HMP DJ2",81,0)
	16408	;
	16409	"RTN","HMP DJ2",82,0)
	16410	PTQ ; add item count and termi nating cha racters
	16411	"RTN","HMP DJ2",83,0)
	16412	I $D(ERR) S HMP="{" "apiVersio n"":""1.01 "",""error "":{""mess age"":"""_ ERR_"""}," "success"" :false}" Q
	16413	"RTN","HMP DJ2",84,0)
	16414	S HMP="{" "apiVersio n"":""1.01 "",""data" ":{""updat ed"":"_""" "_$$HL7NOW _""""_","" uid"":"""_ UID_"""}," "success"" :true}"
	16415	"RTN","HMP DJ2",85,0)
	16416	D POSTX^H MPEVNT(TYP E,DA,$G(AC TION)) ;UI D)
	16417	"RTN","HMP DJ2",86,0)
	16418	Q
	16419	"RTN","HMP DJ2",87,0)
	16420	;
	16421	"RTN","HMP DJ2",88,0)
	16422	NEW1(UID) ; -- creat e new entr y in ^HMP( 800000.11) from PAT, TYPE,HMPSY S
	16423	"RTN","HMP DJ2",89,0)
	16424	; Return UID & DA, or ERR
	16425	"RTN","HMP DJ2",90,0)
	16426	S TYPE=$G (TYPE)
	16427	"RTN","HMP DJ2",91,0)
	16428	I TYPE="" S ERR=$$E RR(2,"null ") Q
	16429	"RTN","HMP DJ2",92,0)
	16430	;
	16431	"RTN","HMP DJ2",93,0)
	16432	S DA=$$NE XTIFN I DA <1 S ERR=$ $ERR(4) Q
	16433	"RTN","HMP DJ2",94,0)
	16434	S UID="ur n:va:"_TYP E_":"_HMPS YS_":"_DA
	16435	"RTN","HMP DJ2",95,0)
	16436	S ^HMP(80 0000.11,DA ,0)=UID_U_ U_TYPE
	16437	"RTN","HMP DJ2",96,0)
	16438	S ^HMP(80 0000.11,"B ",UID,DA)= ""
	16439	"RTN","HMP DJ2",97,0)
	16440	S ^HMP(80 0000.11,"C ",TYPE,DA) =""
	16441	"RTN","HMP DJ2",98,0)
	16442	Q
	16443	"RTN","HMP DJ2",99,0)
	16444	;
	16445	"RTN","HMP DJ2",100,0 )
	16446	NEW ; -- c reate new entry in ^ HMP(800000 .11) from PAT,TYPE,H MPSYS
	16447	"RTN","HMP DJ2",101,0 )
	16448	; Return UID & DA, or ERR
	16449	"RTN","HMP DJ2",102,0 )
	16450	S TYPE=$G (TYPE)
	16451	"RTN","HMP DJ2",103,0 )
	16452	I TYPE="" S ERR=$$E RR(2,"null ") Q
	16453	"RTN","HMP DJ2",104,0 )
	16454	;
	16455	"RTN","HMP DJ2",105,0 )
	16456	S DA=$$NE XTIFN I DA <1 S ERR=$ $ERR(4) Q
	16457	"RTN","HMP DJ2",106,0 )
	16458	S UID="ur n:va:"_TYP E_":"_HMPS YS_":"_DA
	16459	"RTN","HMP DJ2",107,0 )
	16460	S ^HMP(80 0000.11,DA ,0)=UID_U_ U_TYPE
	16461	"RTN","HMP DJ2",108,0 )
	16462	S ^HMP(80 0000.11,"B ",UID,DA)= ""
	16463	"RTN","HMP DJ2",109,0 )
	16464	S ^HMP(80 0000.11,"C ",TYPE,DA) =""
	16465	"RTN","HMP DJ2",110,0 )
	16466	Q
	16467	"RTN","HMP DJ2",111,0 )
	16468	;
	16469	"RTN","HMP DJ2",112,0 )
	16470	NEXTIFN() ; -- Retur ns next av ailable IF N
	16471	"RTN","HMP DJ2",113,0 )
	16472	N I,HDR,T OTAL,DA
	16473	"RTN","HMP DJ2",114,0 )
	16474	L +^HMP(8 00000.11,0 ):$S($G(DI LOCKTM)>0: DILOCKTM,1 :5)
	16475	"RTN","HMP DJ2",115,0 )
	16476	I '$T Q " ^"
	16477	"RTN","HMP DJ2",116,0 )
	16478	S HDR=$G( ^HMP(80000 0.11,0)),T OTAL=+$P(H DR,U,4),I= $O(^HMP(80 0000.11,"? "),-1)
	16479	"RTN","HMP DJ2",117,0 )
	16480	F I=(I+1) :1 Q:'$D(^ HMP(800000 .11,I,0))
	16481	"RTN","HMP DJ2",118,0 )
	16482	S DA=I,$P (HDR,U,3,4 )=DA_U_(TO TAL+1) S ^ HMP(800000 .11,0)=HDR
	16483	"RTN","HMP DJ2",119,0 )
	16484	L -^HMP(8 00000.11,0 )
	16485	"RTN","HMP DJ2",120,0 )
	16486	Q DA
	16487	"RTN","HMP DJ2",121,0 )
	16488	;
	16489	"RTN","HMP DJ2",122,0 )
	16490	ERR(X,VAL) ; -- retu rn error m essage
	16491	"RTN","HMP DJ2",123,0 )
	16492	N MSG S MSG="Error "
	16493	"RTN","HMP DJ2",124,0 )
	16494	I X=1 S MSG="Patie nt with df n '"_$G(VA L)_"' not found"
	16495	"RTN","HMP DJ2",125,0 )
	16496	I X=2 S MSG="Domai n type '"_ $G(VAL)_"' not recog nized"
	16497	"RTN","HMP DJ2",126,0 )
	16498	I X=3 S MSG="UID ' "_$G(VAL)_ "' not fou nd"
	16499	"RTN","HMP DJ2",127,0 )
	16500	I X=4 S MSG="Unabl e to creat e new obje ct"
	16501	"RTN","HMP DJ2",128,0 )
	16502	I X=99 S MSG="Unkno wn request "
	16503	"RTN","HMP DJ2",129,0 )
	16504	Q MSG
	16505	"RTN","HMP DJ2",130,0 )
	16506	;
	16507	"RTN","HMP DJ2",131,0 )
	16508	HL7NOW() ; -- Return current t ime in HL7 format
	16509	"RTN","HMP DJ2",132,0 )
	16510	Q $P($$FM THL7^XLFDT ($$NOW^XLF DT),"-")
	16511	"RTN","HMP DJFS")
	16512	0^48^B7487 1558
	16513	"RTN","HMP DJFS",1,0)
	16514	HMPDJFS ;S LC/KCM,ASM R/RRB -- A synchronou s Extracts and Fresh ness via s tream;Oct 15, 2015 1 8:39:51
	16515	"RTN","HMP DJFS",2,0)
	16516	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	16517	"RTN","HMP DJFS",3,0)
	16518	;Per VA D irective 6 402, this routine sh ould not b e modified .
	16519	"RTN","HMP DJFS",4,0)
	16520	;
	16521	"RTN","HMP DJFS",5,0)
	16522	; JD - 1/ 14/15 - Re moved "+" from "$$GE TICN^MPIF0 01(DFN)" s o that the
	16523	"RTN","HMP DJFS",6,0)
	16524	; fu ll value o f icn (<ic n>V<checks um>) could be captur ed. US4194 .
	16525	"RTN","HMP DJFS",7,0)
	16526	; JD - 3/ 16/15 - Ad ded checks to preven t restagin g of data if the dat a has
	16527	"RTN","HMP DJFS",8,0)
	16528	; al ready been staged. US4304
	16529	"RTN","HMP DJFS",9,0)
	16530	;
	16531	"RTN","HMP DJFS",10,0 )
	16532	; PUT/POS T call $ $TAG^ROUTI NE(.args,. body)
	16533	"RTN","HMP DJFS",11,0 )
	16534	; GET/DEL ETE call TAG^ROUTI NE(.respon se,.args)
	16535	"RTN","HMP DJFS",12,0 )
	16536	;
	16537	"RTN","HMP DJFS",13,0 )
	16538	; TODO: c reate func tion to bu ild ARGS f rom PATH
	16539	"RTN","HMP DJFS",14,0 )
	16540	; TODO: c reate func tion to re turn TAG^R OUTINE fro m MTHD,PAT H
	16541	"RTN","HMP DJFS",15,0 )
	16542	;
	16543	"RTN","HMP DJFS",16,0 )
	16544	; todo: g et the big sync work ing
	16545	"RTN","HMP DJFS",17,0 )
	16546	; todo: c hange to u se RPC cal ls
	16547	"RTN","HMP DJFS",18,0 )
	16548	; todo: a dd in fres hness
	16549	"RTN","HMP DJFS",19,0 )
	16550	;
	16551	"RTN","HMP DJFS",20,0 )
	16552	; DE2818/ RRB SQA fi ndings 1st 2 lines o f code
	16553	"RTN","HMP DJFS",21,0 )
	16554	;
	16555	"RTN","HMP DJFS",22,0 )
	16556	Q
	16557	"RTN","HMP DJFS",23,0 )
	16558	;
	16559	"RTN","HMP DJFS",24,0 )
	16560	API(HMPFRS P,ARGS) ;
	16561	"RTN","HMP DJFS",25,0 )
	16562	N HMPFERR ,HMPFHMP,H MPFLOG,CNT ,ACNT
	16563	"RTN","HMP DJFS",26,0 )
	16564	K ^TMP("H MPF",$J)
	16565	"RTN","HMP DJFS",27,0 )
	16566	S HMPFHMP =$TR($G(AR GS("server ")),"~","= ")
	16567	"RTN","HMP DJFS",28,0 )
	16568	S HMPFRSP =$NA(^TMP( "HMPF",$J) )
	16569	"RTN","HMP DJFS",29,0 )
	16570	S HMPFLOG =+$$GET^XP AR("ALL"," HMP LOG LE VEL")
	16571	"RTN","HMP DJFS",30,0 )
	16572	I HMPFLOG D LOGREQ( HMPFHMP,.A RGS)
	16573	"RTN","HMP DJFS",31,0 )
	16574	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	16575	"RTN","HMP DJFS",32,0 )
	16576	I '$L(HMP FHMP) D SE TERR("Miss ing HMP Se rver ID") QUIT
	16577	"RTN","HMP DJFS",33,0 )
	16578	I '$O(^HM P(800000," B",HMPFHMP ,0)) D SET ERR("HMP S erver not registered ") QUIT
	16579	"RTN","HMP DJFS",34,0 )
	16580	;
	16581	"RTN","HMP DJFS",35,0 )
	16582	; begin s elect case
	16583	"RTN","HMP DJFS",36,0 )
	16584	I ARGS("c ommand")=" putPtSubsc ription" D G XAPI
	16585	"RTN","HMP DJFS",37,0 )
	16586	. N LOC
	16587	"RTN","HMP DJFS",38,0 )
	16588	. S LOC=$ $PUTSUB^HM PDJFSP(.AR GS) ; Adde d ELSE for US4304
	16589	"RTN","HMP DJFS",39,0 )
	16590	. I $L(LO C) S ^TMP( "HMPF",$J, 1)="{""api Version"": ""1.0"","" location"" :"""_LOC_" """_$$PROG RESS_"}"
	16591	"RTN","HMP DJFS",40,0 )
	16592	I ARGS("c ommand")=" startOpera tionalData Extract" D G XAPI
	16593	"RTN","HMP DJFS",41,0 )
	16594	. N HMPX2 ,LOC
	16595	"RTN","HMP DJFS",42,0 )
	16596	. S ARGS( "localId") ="OPD" ; use OPD to indicate "sync oper ational"
	16597	"RTN","HMP DJFS",43,0 )
	16598	. ; Next 2 lines ad ded for US 4304
	16599	"RTN","HMP DJFS",44,0 )
	16600	. S HMPX2 ="HMPFX~"_ $G(HMPFHMP )_"~OPD"
	16601	"RTN","HMP DJFS",45,0 )
	16602	. I $D(^X TMP(HMPX2) ) S LOC="/ hmp/subscr iption/ope rational d ata/"
	16603	"RTN","HMP DJFS",46,0 )
	16604	. E S LO C=$$PUTSUB ^HMPDJFSP( .ARGS) ; A dded ELSE for US4304
	16605	"RTN","HMP DJFS",47,0 )
	16606	. I $L(LO C) S ^TMP( "HMPF",$J, 1)="{""api Version"": ""1.0"","" location"" :"""_LOC_" ""}"
	16607	"RTN","HMP DJFS",48,0 )
	16608	I ARGS("c ommand")=" getPtUpdat es" D G X API
	16609	"RTN","HMP DJFS",49,0 )
	16610	. D GETSU B^HMPDJFSG (HMPFRSP,. ARGS)
	16611	"RTN","HMP DJFS",50,0 )
	16612	I ARGS("c ommand")=" resetAllSu bscription s" D G XA PI
	16613	"RTN","HMP DJFS",51,0 )
	16614	. D RESET SVR(.ARGS)
	16615	"RTN","HMP DJFS",52,0 )
	16616	. S ^TMP( "HMPF",$J, 1)="{""api Version"": ""1.0"","" removed"": ""true""}"
	16617	"RTN","HMP DJFS",53,0 )
	16618	I ARGS("c ommand")=" checkHealt h" D G XA PI
	16619	"RTN","HMP DJFS",54,0 )
	16620	. D HLTHC HK^HMPDJFS M(.ARGS)
	16621	"RTN","HMP DJFS",55,0 )
	16622	; else
	16623	"RTN","HMP DJFS",56,0 )
	16624	D SETERR( "command n ot recogni zed") ; s hould not get this f ar
	16625	"RTN","HMP DJFS",57,0 )
	16626	;
	16627	"RTN","HMP DJFS",58,0 )
	16628	XAPI ; end select ca se
	16629	"RTN","HMP DJFS",59,0 )
	16630	;
	16631	"RTN","HMP DJFS",60,0 )
	16632	I HMPFLOG =2 D LOGRS P(HMPFHMP)
	16633	"RTN","HMP DJFS",61,0 )
	16634	Q
	16635	"RTN","HMP DJFS",62,0 )
	16636	;
	16637	"RTN","HMP DJFS",63,0 )
	16638	LOGREQ(SRV ,ARGS) ; L og the req uest
	16639	"RTN","HMP DJFS",64,0 )
	16640	I $D(^XTM P("HMPFLOG ",0,"start ")) D Q:' $$GET^XPAR ("ALL","HM P LOG LEVE L")
	16641	"RTN","HMP DJFS",65,0 )
	16642	. N ELAPS ED S ELAPS ED=$$HDIFF ^XLFDT($H, ^XTMP("HMP FLOG",0,"s tart"),2)
	16643	"RTN","HMP DJFS",66,0 )
	16644	. I ELAPS ED>$$GET^X PAR("ALL", "HMP LOG L IMIT") D P UT^XPAR("S YS","HMP L OG LEVEL", 1,0)
	16645	"RTN","HMP DJFS",67,0 )
	16646	E D
	16647	"RTN","HMP DJFS",68,0 )
	16648	. D NEWXT MP("HMPFLO G",1,"HMP Freshness Logging")
	16649	"RTN","HMP DJFS",69,0 )
	16650	. S ^XTMP ("HMPFLOG" ,0,"start" )=$H
	16651	"RTN","HMP DJFS",70,0 )
	16652	S ^XTMP(" HMPFLOG",0 ,"total")= $G(^XTMP(" HMPFLOG",0 ,"total")) +1
	16653	"RTN","HMP DJFS",71,0 )
	16654	S:'$L(SRV ) SRV="unk nown"
	16655	"RTN","HMP DJFS",72,0 )
	16656	N SEQ
	16657	"RTN","HMP DJFS",73,0 )
	16658	S SEQ=+$G (^XTMP("HM PFLOG",SRV ))+1,^XTMP ("HMPFLOG" ,SRV)=SEQ
	16659	"RTN","HMP DJFS",74,0 )
	16660	M ^XTMP(" HMPFLOG",S RV,SEQ,"re quest")=AR GS
	16661	"RTN","HMP DJFS",75,0 )
	16662	S HMPFLOG ("seq")=SE Q
	16663	"RTN","HMP DJFS",76,0 )
	16664	Q
	16665	"RTN","HMP DJFS",77,0 )
	16666	LOGRSP(SRV ) ; Log th e response
	16667	"RTN","HMP DJFS",78,0 )
	16668	M ^XTMP(" HMPFLOG",S RV,HMPFLOG ("seq"),"r esponse")= ^TMP("HMPF ",$J)
	16669	"RTN","HMP DJFS",79,0 )
	16670	Q
	16671	"RTN","HMP DJFS",80,0 )
	16672	;
	16673	"RTN","HMP DJFS",81,0 )
	16674	; delete a patient subscripti on
	16675	"RTN","HMP DJFS",82,0 )
	16676	DELSUB(RSP ,ARGS) ; c ancel a su bscription
	16677	"RTN","HMP DJFS",83,0 )
	16678	; DELETE with: /hmp /subscript ion/{hmpSr vId}/patie nt/{pid}
	16679	"RTN","HMP DJFS",84,0 )
	16680	; remove patient fr om HMP SUB SCRIPTION file
	16681	"RTN","HMP DJFS",85,0 )
	16682	; remove ^XTMP(HMPX and ^XTMP (HMPH node s
	16683	"RTN","HMP DJFS",86,0 )
	16684	; look ah ead (from lastId) an d remove a ny nodes f or the pat ient
	16685	"RTN","HMP DJFS",87,0 )
	16686	N DFN,HMP SRV,BATCH, HMPSRVID
	16687	"RTN","HMP DJFS",88,0 )
	16688	K ^TMP("H MPF",$J)
	16689	"RTN","HMP DJFS",89,0 )
	16690	S DFN=$$D FN(ARGS("p id")) Q:$D (HMPFERR)
	16691	"RTN","HMP DJFS",90,0 )
	16692	S HMPSRV= ARGS("hmpS rvId")
	16693	"RTN","HMP DJFS",91,0 )
	16694	S BATCH=" HMPFX~"_HM PSRV_"~"_D FN
	16695	"RTN","HMP DJFS",92,0 )
	16696	L +^XTMP( "HMPFP",DF N,HMPSRV): 20 E D SE TERR("unab le to get lock") Q
	16697	"RTN","HMP DJFS",93,0 )
	16698	; if extr act still running, i t should r emove itse lf when it finishes
	16699	"RTN","HMP DJFS",94,0 )
	16700	K ^XTMP(" HMPFX~"_HM PSRV_"~"_D FN) ; kill extract n odes
	16701	"RTN","HMP DJFS",95,0 )
	16702	K ^XTMP(" HMPFH~"_HM PSRV_"~"_D FN) ; kill held fres hness upda tes
	16703	"RTN","HMP DJFS",96,0 )
	16704	; remove all nodes for this p atient bet ween "last " and "nex t"
	16705	"RTN","HMP DJFS",97,0 )
	16706	; loop fo rward from "last" in ^XTMP("HM PFP",0,hmp Srv) and r emove node s for this DFN
	16707	"RTN","HMP DJFS",98,0 )
	16708	K ^XTMP(" HMPFP",DFN ,HMPSRV) ; kill subscript ion
	16709	"RTN","HMP DJFS",99,0 )
	16710	D DELPT(D FN,HMPSRV)
	16711	"RTN","HMP DJFS",100, 0)
	16712	L -^XTMP( "HMPFP",DF N,HMPSRV)
	16713	"RTN","HMP DJFS",101, 0)
	16714	S RSP="{" "apiVersio n"":""1.0" ",""succes s"":""true ""}" ; if successful
	16715	"RTN","HMP DJFS",102, 0)
	16716	Q
	16717	"RTN","HMP DJFS",103, 0)
	16718	DELPT(DFN, SRV) ; del ete patien t DFN for server SRV
	16719	"RTN","HMP DJFS",104, 0)
	16720	N DIK,DA
	16721	"RTN","HMP DJFS",105, 0)
	16722	S DA(1)=$ O(^HMP(800 000,"B",SR V,"")) Q:' DA(1)
	16723	"RTN","HMP DJFS",106, 0)
	16724	S DA=DFN Q:'DA
	16725	"RTN","HMP DJFS",107, 0)
	16726	S DIK="^H MP(800000, "_DA(1)_", 1,"
	16727	"RTN","HMP DJFS",108, 0)
	16728	D ^DIK
	16729	"RTN","HMP DJFS",109, 0)
	16730	Q
	16731	"RTN","HMP DJFS",110, 0)
	16732	;
	16733	"RTN","HMP DJFS",111, 0)
	16734	; --- pos t freshnes s updates (internal to VistA)
	16735	"RTN","HMP DJFS",112, 0)
	16736	;
	16737	"RTN","HMP DJFS",113, 0)
	16738	POST(DFN,T YPE,ID,ACT ,SERVER,NO DES) ; add s new fres hness item , return D T-seq
	16739	"RTN","HMP DJFS",114, 0)
	16740	; if init ializing u se: ^XTMP( "HMPFH-hmp serverid-d fn",seq#) -hold
	16741	"RTN","HMP DJFS",115, 0)
	16742	; o therwise u se: ^XTMP( "HMPFS-hmp serverid-d ate",seq#) -stream
	16743	"RTN","HMP DJFS",116, 0)
	16744	;
	16745	"RTN","HMP DJFS",117, 0)
	16746	; loop th rough subs cribing st reams for this patie nt
	16747	"RTN","HMP DJFS",118, 0)
	16748	; if pati ent is ini tialized f or an hmp server sen d events d irectly to stream
	16749	"RTN","HMP DJFS",119, 0)
	16750	; otherwi se, events go to tem porary hol ding area
	16751	"RTN","HMP DJFS",120, 0)
	16752	; initial extracts always sen t directly to stream
	16753	"RTN","HMP DJFS",121, 0)
	16754	N HMPSRV, INIT,STREA M,DATE,SEQ ,CNT
	16755	"RTN","HMP DJFS",122, 0)
	16756	S DATE=$$ DT^XLFDT
	16757	"RTN","HMP DJFS",123, 0)
	16758	S HMPSRV= "" F S HM PSRV=$O(^H MP(800000, "AITEM",DF N,HMPSRV)) Q:'$L(HMP SRV) D
	16759	"RTN","HMP DJFS",124, 0)
	16760	. I SERVE R'="",HMPS RV'=SERVER Q
	16761	"RTN","HMP DJFS",125, 0)
	16762	. I '$D(^ HMP(800000 ,"AITEM",D FN,HMPSRV) ) Q ; patie nt not sub scribed
	16763	"RTN","HMP DJFS",126, 0)
	16764	. S INIT= (^HMP(8000 00,"AITEM" ,DFN,HMPSR V)=2),CNT= 1 ; 2 mea ns patient initializ ed
	16765	"RTN","HMP DJFS",127, 0)
	16766	. I $E(TY PE,1,4)="s ync" S INI T=1 ; sync* go es to main stream
	16767	"RTN","HMP DJFS",128, 0)
	16768	. I TYPE= "syncDomai n" S CNT=+ $P(ID,":", 3) S:CNT<1 CNT=1 ; C NT must be >0
	16769	"RTN","HMP DJFS",129, 0)
	16770	. S STREA M=$S(INIT: "HMPFS~",1 :"HMPFH~") _HMPSRV_"~ "_$S(INIT: DATE,1:DFN )
	16771	"RTN","HMP DJFS",130, 0)
	16772	. I '$D(^ XTMP(STREA M)) D NEWX TMP(STREAM ,8,"HMP Fr eshness St ream")
	16773	"RTN","HMP DJFS",131, 0)
	16774	. L +^XTM P(STREAM): 5 E S $EC =",Uno loc k obtained ," Q ; th row error
	16775	"RTN","HMP DJFS",132, 0)
	16776	. S SEQ=$ G(^XTMP(ST REAM,"last "),0)+CNT
	16777	"RTN","HMP DJFS",133, 0)
	16778	. S ^XTMP (STREAM,SE Q)=DFN_U_T YPE_U_ID_U _$G(ACT)_U _$P($H,"," ,2)
	16779	"RTN","HMP DJFS",134, 0)
	16780	. S ^XTMP (STREAM,"l ast")=SEQ
	16781	"RTN","HMP DJFS",135, 0)
	16782	. L -^XTM P(STREAM)
	16783	"RTN","HMP DJFS",136, 0)
	16784	. ; NODES (hmpserver id)=stream Date^seque nce -- opt ionally re turned
	16785	"RTN","HMP DJFS",137, 0)
	16786	. S NODES ($P(STREAM ,"~",2))=$ S(INIT:DAT E,1:0)_U_S EQ
	16787	"RTN","HMP DJFS",138, 0)
	16788	Q
	16789	"RTN","HMP DJFS",139, 0)
	16790	;
	16791	"RTN","HMP DJFS",140, 0)
	16792	NEWXTMP(NO DE,DAYS,DE SC) ; Set a new node in ^XTMP
	16793	"RTN","HMP DJFS",141, 0)
	16794	K ^XTMP(N ODE)
	16795	"RTN","HMP DJFS",142, 0)
	16796	S ^XTMP(N ODE,0)=$$H TFM^XLFDT( +$H+DAYS)_ U_$$HTFM^X LFDT(+$H)_ U_DESC
	16797	"RTN","HMP DJFS",143, 0)
	16798	Q
	16799	"RTN","HMP DJFS",144, 0)
	16800	PIDS(DFN) ; return s tring cont aining pat ient id's ready for JSON
	16801	"RTN","HMP DJFS",145, 0)
	16802	; expects HMPFSYS, HMPFHMP
	16803	"RTN","HMP DJFS",146, 0)
	16804	Q:'DFN ""
	16805	"RTN","HMP DJFS",147, 0)
	16806	;
	16807	"RTN","HMP DJFS",148, 0)
	16808	N X
	16809	"RTN","HMP DJFS",149, 0)
	16810	S X=",""p id"":"""_$ $PID(DFN)_ """"
	16811	"RTN","HMP DJFS",150, 0)
	16812	S X=X_"," "systemId" ":"""_HMPS YS_""""
	16813	"RTN","HMP DJFS",151, 0)
	16814	S X=X_"," "localId"" :"""_DFN_" """
	16815	"RTN","HMP DJFS",152, 0)
	16816	S X=X_"," "icn"":""" _$$GETICN^ MPIF001(DF N)_"""" ; US4194
	16817	"RTN","HMP DJFS",153, 0)
	16818	Q X
	16819	"RTN","HMP DJFS",154, 0)
	16820	;
	16821	"RTN","HMP DJFS",155, 0)
	16822	PID(DFN) ; return mo st likely PID (ICN o r SYS;DFN)
	16823	"RTN","HMP DJFS",156, 0)
	16824	Q:'DFN ""
	16825	"RTN","HMP DJFS",157, 0)
	16826	I '$D(HMP SYS) S HMP SYS=$$GET^ XPAR("SYS" ,"HMP SYST EM NAME")
	16827	"RTN","HMP DJFS",158, 0)
	16828	Q HMPSYS_ ";"_DFN ; otherwise use SysId ;DFN
	16829	"RTN","HMP DJFS",159, 0)
	16830	;
	16831	"RTN","HMP DJFS",160, 0)
	16832	DFN(PID) ; return th e DFN give n the PID (ICN or SY S;DFN)
	16833	"RTN","HMP DJFS",161, 0)
	16834	N DFN
	16835	"RTN","HMP DJFS",162, 0)
	16836	S PID=$TR (PID,":"," ;")
	16837	"RTN","HMP DJFS",163, 0)
	16838	I PID'["; " D Q DFN ; treat as ICN
	16839	"RTN","HMP DJFS",164, 0)
	16840	. S DFN=$ $GETDFN^MP IF001(PID)
	16841	"RTN","HMP DJFS",165, 0)
	16842	. I DFN<0 D SETERR( $P(DFN,"^" ,2))
	16843	"RTN","HMP DJFS",166, 0)
	16844	; otherwi se
	16845	"RTN","HMP DJFS",167, 0)
	16846	I $P(PID, ";")'=$$GE T^XPAR("SY S","HMP SY STEM NAME" ) D SETERR ("DFN unkn own to thi s system") Q 0
	16847	"RTN","HMP DJFS",168, 0)
	16848	Q $P(PID, ";",2)
	16849	"RTN","HMP DJFS",169, 0)
	16850	;
	16851	"RTN","HMP DJFS",170, 0)
	16852	PROGRESS(L ASTITM) ; set the no de in REF with progr ess proper ties
	16853	"RTN","HMP DJFS",171, 0)
	16854	; expects HMPFHMP,H MPSYS
	16855	"RTN","HMP DJFS",172, 0)
	16856	N RSLT,HM PIEN,CNT,S TS,TS,DFN, FIRST
	16857	"RTN","HMP DJFS",173, 0)
	16858	S HMPIEN= $O(^HMP(80 0000,"B",H MPFHMP,0)) Q:'HMPIEN ""
	16859	"RTN","HMP DJFS",174, 0)
	16860	S CNT=0,R SLT=""
	16861	"RTN","HMP DJFS",175, 0)
	16862	F STS=0,1 D ; 0=un initialize d, 1=initi alizing
	16863	"RTN","HMP DJFS",176, 0)
	16864	. S FIRST =1
	16865	"RTN","HMP DJFS",177, 0)
	16866	. S RSLT= $S(STS=0:" ,""waiting Pids"":[", 1:RSLT_"], ""processi ngPids"":[ ")
	16867	"RTN","HMP DJFS",178, 0)
	16868	. S TS=0 F S TS=$O (^HMP(8000 00,HMPIEN, 1,"AP",STS ,TS)) Q:'T S D Q:CN T>99
	16869	"RTN","HMP DJFS",179, 0)
	16870	. . S DFN =0 F S DF N=$O(^HMP( 800000,HMP IEN,1,"AP" ,STS,TS,DF N)) Q:'DFN D
	16871	"RTN","HMP DJFS",180, 0)
	16872	. . . S C NT=CNT+1
	16873	"RTN","HMP DJFS",181, 0)
	16874	. . . S R SLT=RSLT_$ S(FIRST=1: "",1:",")_ """"_HMPSY S_";"_DFN_ """"
	16875	"RTN","HMP DJFS",182, 0)
	16876	. . . S F IRST=0
	16877	"RTN","HMP DJFS",183, 0)
	16878	S RSLT=RS LT_"]"
	16879	"RTN","HMP DJFS",184, 0)
	16880	;
	16881	"RTN","HMP DJFS",185, 0)
	16882	N STRM,ST RMDT,CURRD T
	16883	"RTN","HMP DJFS",186, 0)
	16884	I $G(LAST ITM)="" S LASTITM=$P (^HMP(8000 00,HMPIEN, 0),U,2)
	16885	"RTN","HMP DJFS",187, 0)
	16886	I $L(LAST ITM,"-")<2 S LASTITM =$$DT^XLFD T_"-"_+LAS TITM
	16887	"RTN","HMP DJFS",188, 0)
	16888	S STRMDT= $P(LASTITM ,"-"),CURR DT=$$DT^XL FDT,SEQ=$P (LASTITM," -",2)
	16889	"RTN","HMP DJFS",189, 0)
	16890	S CNT=0 F D Q:$$F MDIFF^XLFD T(STRMDT,C URRDT,1)'< 0
	16891	"RTN","HMP DJFS",190, 0)
	16892	. S STRM= "HMPFS~"_H MPFHMP_"~" _STRMDT
	16893	"RTN","HMP DJFS",191, 0)
	16894	. S CNT=C NT+$G(^XTM P(STRM,"la st"))-SEQ
	16895	"RTN","HMP DJFS",192, 0)
	16896	. S STRMD T=$$FMADD^ XLFDT(STRM DT,1),SEQ= 0
	16897	"RTN","HMP DJFS",193, 0)
	16898	S RSLT=RS LT_",""rem ainingObje cts"":"_CN T
	16899	"RTN","HMP DJFS",194, 0)
	16900	Q RSLT
	16901	"RTN","HMP DJFS",195, 0)
	16902	;
	16903	"RTN","HMP DJFS",196, 0)
	16904	; --- han dle errors
	16905	"RTN","HMP DJFS",197, 0)
	16906	;
	16907	"RTN","HMP DJFS",198, 0)
	16908	SETERR(MSG ) ; create error obj ect in ^TM P("HMPFERR ",$J) and set HMPFER R
	16909	"RTN","HMP DJFS",199, 0)
	16910	; TODO: e scape MSG for JSON
	16911	"RTN","HMP DJFS",200, 0)
	16912	S @HMPFRS P@(1)="{"" apiVersion "":""1.0"" ,""error"" :{""messag e"":"""_MS G_"""}}"
	16913	"RTN","HMP DJFS",201, 0)
	16914	S ^TMP("H MPFERR",$J ,$H)=MSG
	16915	"RTN","HMP DJFS",202, 0)
	16916	S HMPFERR =1
	16917	"RTN","HMP DJFS",203, 0)
	16918	Q
	16919	"RTN","HMP DJFS",204, 0)
	16920	;
	16921	"RTN","HMP DJFS",205, 0)
	16922	DEBUG(MSG) ;
	16923	"RTN","HMP DJFS",206, 0)
	16924	S ^TMP("H MPDEBUG",$ J,0)=$G(^T MP("HMPDEB UG",$J,0), 0)+1
	16925	"RTN","HMP DJFS",207, 0)
	16926	I $D(MSG) '=1 M ^TMP ("HMPDEBUG ",$J,^TMP( "HMPDEBUG" ,$J,0))=MS G Q
	16927	"RTN","HMP DJFS",208, 0)
	16928	S ^TMP("H MPDEBUG",$ J,^TMP("HM PDEBUG",$J ,0))=MSG
	16929	"RTN","HMP DJFS",209, 0)
	16930	Q
	16931	"RTN","HMP DJFS",210, 0)
	16932	RESETSVR(A RGS) ;
	16933	"RTN","HMP DJFS",211, 0)
	16934	N DA,DIE, DIK,DR,IEN ,SRV,SRVIE N,X
	16935	"RTN","HMP DJFS",212, 0)
	16936	S SRV=$G( ARGS("serv er")) I SR V="" Q
	16937	"RTN","HMP DJFS",213, 0)
	16938	S DA=$O(^ HMP(800000 ,"B",SRV," ")) I DA'> 0 Q
	16939	"RTN","HMP DJFS",214, 0)
	16940	S SRVIEN= DA
	16941	"RTN","HMP DJFS",215, 0)
	16942	L +^HMP(8 00000,SRVI EN):5 E S $EC=",Uno lock obta ined," Q
	16943	"RTN","HMP DJFS",216, 0)
	16944	;delete o perational data fiel d
	16945	"RTN","HMP DJFS",217, 0)
	16946	S DIE="^H MP(800000, ",DR=".03/ //@" D ^DI E
	16947	"RTN","HMP DJFS",218, 0)
	16948	S DA(1)=D A,DA=0
	16949	"RTN","HMP DJFS",219, 0)
	16950	;delete p atient mul tiple valu es
	16951	"RTN","HMP DJFS",220, 0)
	16952	S DIK="^H MP(800000, "_DA(1)_", 1,"
	16953	"RTN","HMP DJFS",221, 0)
	16954	F S DA=$ O(^HMP(800 000,DA(1), 1,DA)) Q:D A'>0 D ^D IK
	16955	"RTN","HMP DJFS",222, 0)
	16956	;kill ser ver ^XTMP
	16957	"RTN","HMP DJFS",223, 0)
	16958	S X="HMPF " F S X=$ O(^XTMP(X) ) Q:$E(X,1 ,4)'="HMPF " D
	16959	"RTN","HMP DJFS",224, 0)
	16960	. I X[SRV K ^XTMP(X ) I 1
	16961	"RTN","HMP DJFS",225, 0)
	16962	;kill tid y node
	16963	"RTN","HMP DJFS",226, 0)
	16964	K ^XTMP(" HMPFP","ti dy",SRV)
	16965	"RTN","HMP DJFS",227, 0)
	16966	L -^HMP(8 00000,SRVI EN)
	16967	"RTN","HMP DJFS",228, 0)
	16968	Q
	16969	"RTN","HMP DJFS",229, 0)
	16970	;
	16971	"RTN","HMP DJFS",230, 0)
	16972	CLEARDOM(S VR,PAT) ;
	16973	"RTN","HMP DJFS",231, 0)
	16974	Q
	16975	"RTN","HMP DJFS",232, 0)
	16976	;
	16977	"RTN","HMP DJFS",233, 0)
	16978	CLEARPAT(S VR,PAT) ;
	16979	"RTN","HMP DJFS",234, 0)
	16980	I '$D(^XT MP("HMPFP" ,PAT,SVR)) Q
	16981	"RTN","HMP DJFS",235, 0)
	16982	;do we ne ed a check for patie nt initial ized?
	16983	"RTN","HMP DJFS",236, 0)
	16984	K ^XTMP(" HMPFP",PAT ,SVR)
	16985	"RTN","HMP DJFS",237, 0)
	16986	Q
	16987	"RTN","HMP DJFS",238, 0)
	16988	;
	16989	"RTN","HMP DJFS",239, 0)
	16990	HMPSET(DA, NEW) ;
	16991	"RTN","HMP DJFS",240, 0)
	16992	N IEN,NAM E
	16993	"RTN","HMP DJFS",241, 0)
	16994	S IEN=0 F S IEN=$O (^HMP(8000 00,IEN)) Q :IEN'>0 D
	16995	"RTN","HMP DJFS",242, 0)
	16996	.S NAME=$ P(^HMP(800 000,IEN,0) ,U)
	16997	"RTN","HMP DJFS",243, 0)
	16998	.I $D(^HM P(800000,I EN,1,NEW(1 )))>0 S ^H MP(800000, "AITEM",NE W(1),NAME) =NEW(2)
	16999	"RTN","HMP DJFS",244, 0)
	17000	Q
	17001	"RTN","HMP DJFS",245, 0)
	17002	;
	17003	"RTN","HMP DJFS",246, 0)
	17004	HMPKILL(DA ,OLD) ;
	17005	"RTN","HMP DJFS",247, 0)
	17006	N NAME
	17007	"RTN","HMP DJFS",248, 0)
	17008	S NAME=$P ($G(^HMP(8 00000,DA(1 ),0)),U) I NAME="" Q
	17009	"RTN","HMP DJFS",249, 0)
	17010	K ^HMP(80 0000,"AITE M",OLD(1), NAME)
	17011	"RTN","HMP DJFS",250, 0)
	17012	Q
	17013	"RTN","HMP DJFS",251, 0)
	17014	;
	17015	"RTN","HMP DJFS",252, 0)
	17016	HMPOSET(DA ,NEW) ;
	17017	"RTN","HMP DJFS",253, 0)
	17018	N IEN,NAM E
	17019	"RTN","HMP DJFS",254, 0)
	17020	S IEN=0 F S IEN=$O (^HMP(8000 00,IEN)) Q :IEN'>0 D
	17021	"RTN","HMP DJFS",255, 0)
	17022	.S NAME=$ P(^HMP(800 000,IEN,0) ,U)
	17023	"RTN","HMP DJFS",256, 0)
	17024	.S ^HMP(8 00000,"AIT EM","OPD", NAME)=NEW
	17025	"RTN","HMP DJFS",257, 0)
	17026	Q
	17027	"RTN","HMP DJFS",258, 0)
	17028	;
	17029	"RTN","HMP DJFS",259, 0)
	17030	HMPOKILL(D A) ;
	17031	"RTN","HMP DJFS",260, 0)
	17032	N NAME
	17033	"RTN","HMP DJFS",261, 0)
	17034	S NAME=$P ($G(^HMP(8 00000,DA,0 )),U) I NA ME="" Q
	17035	"RTN","HMP DJFS",262, 0)
	17036	K ^HMP(80 0000,"AITE M","OPD",N AME)
	17037	"RTN","HMP DJFS",263, 0)
	17038	Q
	17039	"RTN","HMP DJFS",264, 0)
	17040	KILL ; cle ar out all ^XTMP nod es
	17041	"RTN","HMP DJFS",265, 0)
	17042	N X
	17043	"RTN","HMP DJFS",266, 0)
	17044	S X="HMPF " F S X=$ O(^XTMP(X) ) Q:$E(X,1 ,4)'="HMPF " W !,X K ^XTMP(X)
	17045	"RTN","HMP DJFS",267, 0)
	17046	Q
	17047	"RTN","HMP DJFS",268, 0)
	17048	KILLSVR(SV R) ; clear out for s pecific ma chine
	17049	"RTN","HMP DJFS",269, 0)
	17050	N X
	17051	"RTN","HMP DJFS",270, 0)
	17052	S X="HMPF " F S X=$ O(^XTMP(X) ) Q:$E(X,1 ,4)'="HMPF " D
	17053	"RTN","HMP DJFS",271, 0)
	17054	. I X[SVR W !,X K ^XTMP(X) I 1
	17055	"RTN","HMP DJFS",272, 0)
	17056	S X="" F S X=$O(^X TMP("HMPFP ",X)) Q:X= "" D
	17057	"RTN","HMP DJFS",273, 0)
	17058	. I $D(^X TMP("HMPFP ",X,SVR)) K ^XTMP("H MPFP",X,SV R)
	17059	"RTN","HMP DJFS",274, 0)
	17060	Q
	17061	"RTN","HMP DJFS1")
	17062	0^148^B188 7278
	17063	"RTN","HMP DJFS1",1,0 )
	17064	HMPDJFS1 ; ASMR/CPC,h rubovcak - for Extra ct and Fre shness Str eam;Oct 15 , 2015 18: 39:51
	17065	"RTN","HMP DJFS1",2,0 )
	17066	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	17067	"RTN","HMP DJFS1",3,0 )
	17068	;Per VA D irective 6 402, this routine sh ould not b e modified .
	17069	"RTN","HMP DJFS1",4,0 )
	17070	;
	17071	"RTN","HMP DJFS1",5,0 )
	17072	Q
	17073	"RTN","HMP DJFS1",6,0 )
	17074	; continu ation code for HMPDJ FSP
	17075	"RTN","HMP DJFS1",7,0 )
	17076	;
	17077	"RTN","HMP DJFS1",8,0 )
	17078	BACKDOM ; task patie nt domain to the bac kground, c alled from HMPDJFSP
	17079	"RTN","HMP DJFS1",9,0 )
	17080	N ZTDESC, ZTDTH,ZTIO ,ZTRTN,ZTS AVE,ZTSK
	17081	"RTN","HMP DJFS1",10, 0)
	17082	S ZTRTN=" DQBACKDM^H MPDJFS1",Z TIO="",ZTD TH=$H
	17083	"RTN","HMP DJFS1",11, 0)
	17084	S ZTSAVE( "HMPBATCH" )="",ZTSAV E("HMPFDFN ")=""
	17085	"RTN","HMP DJFS1",12, 0)
	17086	S ZTSAVE( "HMPFDOMI" )="",ZTSAV E("ZTQUEUE D")="",ZTS AVE("HMPME TA")="",ZT SAVE("HMPF DOM(")=""
	17087	"RTN","HMP DJFS1",13, 0)
	17088	S ZTSAVE( "HMPFZTSK" )=""
	17089	"RTN","HMP DJFS1",14, 0)
	17090	S ZTSAVE( "HMPENVIR( ")="" ; e nvironment informati on
	17091	"RTN","HMP DJFS1",15, 0)
	17092	S ZTSAVE( "HMPSTMP") ="" ; Ope rational d ata stampt ime US6734
	17093	"RTN","HMP DJFS1",16, 0)
	17094	S ZTDESC= "Build HMP subdomain s for a pa tient"
	17095	"RTN","HMP DJFS1",17, 0)
	17096	D ^%ZTLOA D
	17097	"RTN","HMP DJFS1",18, 0)
	17098	I $G(ZTSK ) S ^XTMP( HMPBATCH,0 ,"task","b ",ZTSK)="" Q
	17099	"RTN","HMP DJFS1",19, 0)
	17100	; no task , log erro r
	17101	"RTN","HMP DJFS1",20, 0)
	17102	D SETERR^ HMPDJFS("T ask not cr eated")
	17103	"RTN","HMP DJFS1",21, 0)
	17104	Q
	17105	"RTN","HMP DJFS1",22, 0)
	17106	;
	17107	"RTN","HMP DJFS1",23, 0)
	17108	DQBACKDM ; TaskMan e ntry point
	17109	"RTN","HMP DJFS1",24, 0)
	17110	; patient 's domain has been " chunked"
	17111	"RTN","HMP DJFS1",25, 0)
	17112	N HMPFBJ S HMPFBJ=1 ; flag, background job
	17113	"RTN","HMP DJFS1",26, 0)
	17114	D DOMPT^H MPDJFSP(HM PFDOM(HMPF DOMI))
	17115	"RTN","HMP DJFS1",27, 0)
	17116	K ^XTMP(H MPBATCH,0, "task","b" ,ZTSK)
	17117	"RTN","HMP DJFS1",28, 0)
	17118	Q
	17119	"RTN","HMP DJFS1",29, 0)
	17120	;
	17121	"RTN","HMP DJFSD")
	17122	0^49^B6635 230
	17123	"RTN","HMP DJFSD",1,0 )
	17124	HMPDJFSD ; SLC/KCM,AS MR/RRB -- Domain Lis ts for Ext ract and F reshness S tream;Oct 15, 2015 1 8:39:51
	17125	"RTN","HMP DJFSD",2,0 )
	17126	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	17127	"RTN","HMP DJFSD",3,0 )
	17128	;Per VA D irective 6 402, this routine sh ould not b e modified .
	17129	"RTN","HMP DJFSD",4,0 )
	17130	;
	17131	"RTN","HMP DJFSD",5,0 )
	17132	; DE2818/ RRB: SQA f indings 1s t 3 lines
	17133	"RTN","HMP DJFSD",6,0 )
	17134	;
	17135	"RTN","HMP DJFSD",7,0 )
	17136	Q
	17137	"RTN","HMP DJFSD",8,0 )
	17138	;
	17139	"RTN","HMP DJFSD",9,0 )
	17140	PTDOMS(LIS T) ; load default pa tient doma ins (put i n paramete r?); cpc m odded orde r 9/29/201 5
	17141	"RTN","HMP DJFSD",10, 0)
	17142	;;order
	17143	"RTN","HMP DJFSD",11, 0)
	17144	;;vital
	17145	"RTN","HMP DJFSD",12, 0)
	17146	;;lab
	17147	"RTN","HMP DJFSD",13, 0)
	17148	;;med
	17149	"RTN","HMP DJFSD",14, 0)
	17150	;;documen t
	17151	"RTN","HMP DJFSD",15, 0)
	17152	;;allergy
	17153	"RTN","HMP DJFSD",16, 0)
	17154	;;auxilia ry
	17155	"RTN","HMP DJFSD",17, 0)
	17156	;;appoint ment
	17157	"RTN","HMP DJFSD",18, 0)
	17158	;;diagnos is
	17159	"RTN","HMP DJFSD",19, 0)
	17160	;;visit
	17161	"RTN","HMP DJFSD",20, 0)
	17162	;;factor
	17163	"RTN","HMP DJFSD",21, 0)
	17164	;;immuniz ation
	17165	"RTN","HMP DJFSD",22, 0)
	17166	;;obs
	17167	"RTN","HMP DJFSD",23, 0)
	17168	;;problem
	17169	"RTN","HMP DJFSD",24, 0)
	17170	;;procedu re
	17171	"RTN","HMP DJFSD",25, 0)
	17172	;;consult
	17173	"RTN","HMP DJFSD",26, 0)
	17174	;;image
	17175	"RTN","HMP DJFSD",27, 0)
	17176	;;surgery
	17177	"RTN","HMP DJFSD",28, 0)
	17178	;;task
	17179	"RTN","HMP DJFSD",29, 0)
	17180	;;ptf
	17181	"RTN","HMP DJFSD",30, 0)
	17182	;;exam
	17183	"RTN","HMP DJFSD",31, 0)
	17184	;;cpt
	17185	"RTN","HMP DJFSD",32, 0)
	17186	;;educati on
	17187	"RTN","HMP DJFSD",33, 0)
	17188	;;pov
	17189	"RTN","HMP DJFSD",34, 0)
	17190	;;skin
	17191	"RTN","HMP DJFSD",35, 0)
	17192	;;treatme nt
	17193	"RTN","HMP DJFSD",36, 0)
	17194	;;roadtri p
	17195	"RTN","HMP DJFSD",37, 0)
	17196	;;patient
	17197	"RTN","HMP DJFSD",38, 0)
	17198	;;zzzzz
	17199	"RTN","HMP DJFSD",39, 0)
	17200	;
	17201	"RTN","HMP DJFSD",40, 0)
	17202	;;mh
	17203	"RTN","HMP DJFSD",41, 0)
	17204	;
	17205	"RTN","HMP DJFSD",42, 0)
	17206	N I,X
	17207	"RTN","HMP DJFSD",43, 0)
	17208	F I=1:1 S X=$P($T(P TDOMS+I)," ;;",2,99) Q:X="zzzzz " S LIST( I)=X
	17209	"RTN","HMP DJFSD",44, 0)
	17210	Q
	17211	"RTN","HMP DJFSD",45, 0)
	17212	;
	17213	"RTN","HMP DJFSD",46, 0)
	17214	OPDOMS(LIS T) ; load default op erational domains (p ut in para meter?)
	17215	"RTN","HMP DJFSD",47, 0)
	17216	;;asu-cla ss;^USR(89 30)
	17217	"RTN","HMP DJFSD",48, 0)
	17218	;;asu-rul e;^USR(893 0.1)
	17219	"RTN","HMP DJFSD",49, 0)
	17220	;;categor y;^HMP(800 000.11)
	17221	"RTN","HMP DJFSD",50, 0)
	17222	;;chartta b;^HMP(800 000.11)
	17223	"RTN","HMP DJFSD",51, 0)
	17224	;;display group;^ORD (100.98)
	17225	"RTN","HMP DJFSD",52, 0)
	17226	;;doc-def ;^TIU(8925 .1)
	17227	"RTN","HMP DJFSD",53, 0)
	17228	;;labgrou p;^LAB(64. 5,1,1)
	17229	"RTN","HMP DJFSD",54, 0)
	17230	;;labpane l;^LAB(60)
	17231	"RTN","HMP DJFSD",55, 0)
	17232	;;locatio n;^SC
	17233	"RTN","HMP DJFSD",56, 0)
	17234	;;orderab le;^ORD(10 1.43)
	17235	"RTN","HMP DJFSD",57, 0)
	17236	;;page;^H MP(800000. 11)
	17237	"RTN","HMP DJFSD",58, 0)
	17238	;;pt-sele ct;^DPT
	17239	"RTN","HMP DJFSD",59, 0)
	17240	;;personp hoto;^HMP( 800000.11)
	17241	"RTN","HMP DJFSD",60, 0)
	17242	;;pointof care;^HMP( 800000.11)
	17243	"RTN","HMP DJFSD",61, 0)
	17244	;;quick;^ ORD(101.41 )
	17245	"RTN","HMP DJFSD",62, 0)
	17246	;;roster; ^HMPROSTR
	17247	"RTN","HMP DJFSD",63, 0)
	17248	;;route;^ PS(51.2)
	17249	"RTN","HMP DJFSD",64, 0)
	17250	;;schedul e;^PS(51.1 )
	17251	"RTN","HMP DJFSD",65, 0)
	17252	;;team;^H MP(800000. 11)
	17253	"RTN","HMP DJFSD",66, 0)
	17254	;;teampos ition;^HMP (800000.11 )
	17255	"RTN","HMP DJFSD",67, 0)
	17256	;;user;^V A(200)
	17257	"RTN","HMP DJFSD",68, 0)
	17258	;;usertab prefs;^HMP (800000.11 )
	17259	"RTN","HMP DJFSD",69, 0)
	17260	;;viewdef def;^HMP(8 00000.11)
	17261	"RTN","HMP DJFSD",70, 0)
	17262	;;viewdef defcoldefc onfigtempl ate;^HMP(8 00000.11)
	17263	"RTN","HMP DJFSD",71, 0)
	17264	;;immuniz ation;^AUT TIMM
	17265	"RTN","HMP DJFSD",72, 0)
	17266	;;allergy -list;^GMR D(120.82)
	17267	"RTN","HMP DJFSD",73, 0)
	17268	;;sign-sy mptom;^GMR D(120.83)
	17269	"RTN","HMP DJFSD",74, 0)
	17270	;;vital-t ype;^GMRD( 120.51)
	17271	"RTN","HMP DJFSD",75, 0)
	17272	;;vital-q ualifier;^ GMRD(120.5 2)
	17273	"RTN","HMP DJFSD",76, 0)
	17274	;;vital-c ategory;^G MRD(120.53 )
	17275	"RTN","HMP DJFSD",77, 0)
	17276	;;zzzzz
	17277	"RTN","HMP DJFSD",78, 0)
	17278	;
	17279	"RTN","HMP DJFSD",79, 0)
	17280	;;problem -list;^LEX (757.01)
	17281	"RTN","HMP DJFSD",80, 0)
	17282	;;clioter minology
	17283	"RTN","HMP DJFSD",81, 0)
	17284	;;doc-act ion
	17285	"RTN","HMP DJFSD",82, 0)
	17286	;;doc-sta tus
	17287	"RTN","HMP DJFSD",83, 0)
	17288	;
	17289	"RTN","HMP DJFSD",84, 0)
	17290	N I,X
	17291	"RTN","HMP DJFSD",85, 0)
	17292	F I=1:1 S X=$P($T(O PDOMS+I)," ;",3) Q:X= "zzzzz" S LIST(I)=X
	17293	"RTN","HMP DJFSD",86, 0)
	17294	Q
	17295	"RTN","HMP DJFSD",87, 0)
	17296	;
	17297	"RTN","HMP DJFSG")
	17298	0^50^B2163 82035
	17299	"RTN","HMP DJFSG",1,0 )
	17300	HMPDJFSG ; SLC/KCM,AS MR/RRB,CPC -- GET fo r Extract and Freshn ess Stream ;Jan 29, 2 016 13:05: 21
	17301	"RTN","HMP DJFSG",2,0 )
	17302	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	17303	"RTN","HMP DJFSG",3,0 )
	17304	;Per VA D irective 6 402, this routine sh ould not b e modified .
	17305	"RTN","HMP DJFSG",4,0 )
	17306	;
	17307	"RTN","HMP DJFSG",5,0 )
	17308	; US3907 - Allow fo r jobId an d rootJobI d to be re trieved fr om ^XTMP. JD - 1/20 /15
	17309	"RTN","HMP DJFSG",6,0 )
	17310	; DE2818 - SQA find ings. Newe d ERRCNT i n BLDSERR+ 2. RRB - 10/24/2015
	17311	"RTN","HMP DJFSG",7,0 )
	17312	;
	17313	"RTN","HMP DJFSG",8,0 )
	17314	; --- ret rieve upda tes for an HMP serve r's subscr iptions
	17315	"RTN","HMP DJFSG",9,0 )
	17316	;
	17317	"RTN","HMP DJFSG",10, 0)
	17318	GETSUB(HMP FRSP,ARGS) ; retriev e items fr om stream
	17319	"RTN","HMP DJFSG",11, 0)
	17320	; GE T from: /h mp/subscri ption/{hmp SrvId}/{la st}?limit= {limit}
	17321	"RTN","HMP DJFSG",12, 0)
	17322	; ARGS("l ast") : da te-seq of last item retrieved (ex. 31312 06-27)
	17323	"RTN","HMP DJFSG",13, 0)
	17324	; ARGS("m ax") : maximum nu mber of it ems to ret urn (defau lt 99999) S68-JCH
	17325	"RTN","HMP DJFSG",14, 0)
	17326	; ARGS("m axSize"): approximat e number b ytes to re turn S68-JCH
	17327	"RTN","HMP DJFSG",15, 0)
	17328	;
	17329	"RTN","HMP DJFSG",16, 0)
	17330	; HMPFSYS : the id (hash) of the VistA system
	17331	"RTN","HMP DJFSG",17, 0)
	17332	; HMPFHMP : the nam e of the H MP server
	17333	"RTN","HMP DJFSG",18, 0)
	17334	; HMPFSEQ : final s equence (b ecomes nex t LASTSEQ)
	17335	"RTN","HMP DJFSG",19, 0)
	17336	; HMPFIDX : index t o iterate from LASTS EQ to fina l sequence
	17337	"RTN","HMP DJFSG",20, 0)
	17338	; HMPFLAS T: used to clean up extracts p rior to th is
	17339	"RTN","HMP DJFSG",21, 0)
	17340	; HMPFSTR M: the ext ract/fresh ness strea m (HMPFS~h mpSrvId~fm Date)
	17341	"RTN","HMP DJFSG",22, 0)
	17342	; (most v ariables n amespaced since call ing variet y of extra cts)
	17343	"RTN","HMP DJFSG",23, 0)
	17344	;
	17345	"RTN","HMP DJFSG",24, 0)
	17346	K ^TMP("H MPF",$J)
	17347	"RTN","HMP DJFSG",25, 0)
	17348	N HMPFSYS ,HMPFSTRM, HMPFLAST,H MPFDT,HMPF LIM,HMPFMA X,HMPFSIZE ,HMPCLFLG
	17349	"RTN","HMP DJFSG",26, 0)
	17350	N HMPFSEQ ,HMPFIDX,H MPFCNT,SNO DE,STYPE,H MPFERR,HMP DEL,HMPERR ,HMPSTGET, HMPLITEM ;S68-JCH , DE3502
	17351	"RTN","HMP DJFSG",27, 0)
	17352	S HMPFRSP =$NA(^TMP( "HMPF",$J) )
	17353	"RTN","HMP DJFSG",28, 0)
	17354	; Next li ne added f or US6734 - Make sur e OPD meta stamp data has been completed before fet ching.
	17355	"RTN","HMP DJFSG",29, 0)
	17356	I '$$OPD^ HMPMETA(HM PFHMP) S @ HMPFRSP@(1 )="{""warn ing"":""St aging is n ot complet e yet!""}" Q
	17357	"RTN","HMP DJFSG",30, 0)
	17358	;
	17359	"RTN","HMP DJFSG",31, 0)
	17360	S HMPFSYS =$$GET^XPA R("SYS","H MP SYSTEM NAME") ; T ODO -- swi tch to HMP SYS
	17361	"RTN","HMP DJFSG",32, 0)
	17362	S HMPFHMP ("ien")=$O (^HMP(8000 00,"B",HMP FHMP,0))
	17363	"RTN","HMP DJFSG",33, 0)
	17364	S HMPFDT= $P($G(ARGS ("lastUpda te")),"-")
	17365	"RTN","HMP DJFSG",34, 0)
	17366	S HMPFSEQ =+$P($G(AR GS("lastUp date")),"- ",2)
	17367	"RTN","HMP DJFSG",35, 0)
	17368	S HMPSTGE T=$G(ARGS( "getStatus "))
	17369	"RTN","HMP DJFSG",36, 0)
	17370	S HMPLITE M="" ; DE3 502 initia lise track ing of las t item typ e
	17371	"RTN","HMP DJFSG",37, 0)
	17372	; stream goes back a maximum of 8 days
	17373	"RTN","HMP DJFSG",38, 0)
	17374	I HMPFDT< $$FMADD^XL FDT($$DT^X LFDT,-8) S HMPFDT=$$ HTFM^XLFDT (+$H-8),HM PFSEQ=0
	17375	"RTN","HMP DJFSG",39, 0)
	17376	S HMPFLAS T=HMPFDT_" -"_HMPFSEQ
	17377	"RTN","HMP DJFSG",40, 0)
	17378	D LASTUPD (HMPFHMP,H MPFLAST)
	17379	"RTN","HMP DJFSG",41, 0)
	17380	D SETLIMI T(.ARGS) ; se t HMPFLIM, HMPFMAX, HMPFSIZE ; S68-PJH
	17381	"RTN","HMP DJFSG",42, 0)
	17382	S HMPFLIM =$G(ARGS(" max"),9999 9)
	17383	"RTN","HMP DJFSG",43, 0)
	17384	S HMPFSTR M="HMPFS~" _HMPFHMP_" ~"_HMPFDT ; st ream ident ifier
	17385	"RTN","HMP DJFSG",44, 0)
	17386	I '$D(^XT MP(HMPFSTR M,"job",$J )) S ^XTMP (HMPFSTRM, "job",$J," start")=$H
	17387	"RTN","HMP DJFSG",45, 0)
	17388	S ^XTMP(H MPFSTRM,"j ob",$J)=$H ; re cord conne ction info
	17389	"RTN","HMP DJFSG",46, 0)
	17390	I '$$VERM ATCH(HMPFH MP("ien"), $G(ARGS("e xtractSche ma"))) D N OOP(HMPFLA ST) QUIT
	17391	"RTN","HMP DJFSG",47, 0)
	17392	S HMPFCNT =0,HMPFIDX =HMPFSEQ
	17393	"RTN","HMP DJFSG",48, 0)
	17394	F D Q:H MPFSIZE'<H MPFMAX D NXTSTRM Q: HMPFSTRM=" " ; S68- JCH
	17395	"RTN","HMP DJFSG",49, 0)
	17396	. F S HM PFIDX=$O(^ XTMP(HMPFS TRM,HMPFID X)) Q:'HMP FIDX D Q :HMPFCNT'< HMPFLIM
	17397	"RTN","HMP DJFSG",50, 0)
	17398	.. S SNO DE=^XTMP(H MPFSTRM,HM PFIDX),STY PE=$P(SNOD E,U,2)
	17399	"RTN","HMP DJFSG",51, 0)
	17400	.. ;===J D START===
	17401	"RTN","HMP DJFSG",52, 0)
	17402	.. K ARG S("hmp-fst ") I $P(SN ODE,U,4)=" @" S ARGS( "hmp-fst") =$P(SNODE, U,5)
	17403	"RTN","HMP DJFSG",53, 0)
	17404	.. ;===J D END===
	17405	"RTN","HMP DJFSG",54, 0)
	17406	.. S $P( ^XTMP(HMPF STRM,HMPFI DX),U,6)=$ P($H,",",2 ) ; timest amp when s ent
	17407	"RTN","HMP DJFSG",55, 0)
	17408	.. I STY PE="syncNo op" Q ; s kip, patie nt was uns ubscribed
	17409	"RTN","HMP DJFSG",56, 0)
	17410	.. I STY PE="syncDo main" D DO MITMS Q ; a dd multipl e extract items
	17411	"RTN","HMP DJFSG",57, 0)
	17412	.. S HMP FSEQ=HMPFI DX
	17413	"RTN","HMP DJFSG",58, 0)
	17414	.. I STY PE="syncCo mmand" D S YNCCMD(SNO DE) Q ; c ommand to middle tie r
	17415	"RTN","HMP DJFSG",59, 0)
	17416	.. I STY PE="syncEr ror" D SYN CERR(SNODE ,.HMPERR) Q
	17417	"RTN","HMP DJFSG",60, 0)
	17418	.. I STY PE="syncSt art" D SYN CSTRT(SNOD E) S HMPLI TEM="SYNC" Q ; begi n initial extraction ;DE3502
	17419	"RTN","HMP DJFSG",61, 0)
	17420	.. I STY PE="syncMe ta" D SYNC META(SNODE ) S HMPLIT EM="SYNC" Q ; US11 019 - Buil d replacem ent syncst art ;DE350 2
	17421	"RTN","HMP DJFSG",62, 0)
	17422	.. I STY PE="syncDo ne" D SYNC DONE(SNODE ) S HMPLIT EM="SYNC" Q ; end of initial extractio n ;DE3502
	17423	"RTN","HMP DJFSG",63, 0)
	17424	.. D FRE SHITM(SNOD E,.HMPDEL, .HMPERR) S HMPLITEM= "FRESH" ; othe rwise, fre shness ite m ;DE3502
	17425	"RTN","HMP DJFSG",64, 0)
	17426	Q:$G(HMPF ERR)
	17427	"RTN","HMP DJFSG",65, 0)
	17428	D FINISH( .HMPDEL,.H MPERR)
	17429	"RTN","HMP DJFSG",66, 0)
	17430	;Check if HMP GLOBA L USAGE MO NITOR mail message i s required - US8228
	17431	"RTN","HMP DJFSG",67, 0)
	17432	D CHECK^H MPMETA(HMP FHMP) ; US 8228
	17433	"RTN","HMP DJFSG",68, 0)
	17434	Q
	17435	"RTN","HMP DJFSG",69, 0)
	17436	DOMITMS ; loop thru extract it ems, OFFSE T is last sent
	17437	"RTN","HMP DJFSG",70, 0)
	17438	; expects HMPFSTRM, HMPFIDX,HM PFHMP,HMPF SYS
	17439	"RTN","HMP DJFSG",71, 0)
	17440	; changes HMPFSEQ,H MPFCNT,HMP FSIZE as e ach item a dded ; S 68-JCH
	17441	"RTN","HMP DJFSG",72, 0)
	17442	N X,OFFSE T,DFN,PIDS ,DOMAIN,TA SK,BATCH,C OUNT,ITEMN UM,DOMSIZE ,SECSIZE
	17443	"RTN","HMP DJFSG",73, 0)
	17444	S X=^XTMP (HMPFSTRM, HMPFIDX),D FN=$P(X,U) ,X=$P(X,U, 3)
	17445	"RTN","HMP DJFSG",74, 0)
	17446	S PIDS=$S (DFN:$$PID S^HMPDJFS( DFN),1:"")
	17447	"RTN","HMP DJFSG",75, 0)
	17448	S DOMAIN= $P(X,":") ; doma in{#sectio nNumber}
	17449	"RTN","HMP DJFSG",76, 0)
	17450	S TASK=$P (X,":",2) ; task number in ^XTMP
	17451	"RTN","HMP DJFSG",77, 0)
	17452	S COUNT=$ P(X,":",3) ; coun t in this section
	17453	"RTN","HMP DJFSG",78, 0)
	17454	S DOMSIZE =$P(X,":", 4) ; esti mated tota l for the domain
	17455	"RTN","HMP DJFSG",79, 0)
	17456	S SECSIZE =$P(X,":", 5) ; sect ion size ( for operat ional)
	17457	"RTN","HMP DJFSG",80, 0)
	17458	S BATCH=" HMPFX~"_HM PFHMP_"~"_ DFN ; extr act node i n ^XTMP
	17459	"RTN","HMP DJFSG",81, 0)
	17460	S OFFSET= COUNT-(HMP FIDX-HMPFS EQ)
	17461	"RTN","HMP DJFSG",82, 0)
	17462	F S OFFS ET=$O(^XTM P(BATCH,TA SK,DOMAIN, OFFSET)) Q :'OFFSET D Q:HMPFC NT'<HMPFLI M
	17463	"RTN","HMP DJFSG",83, 0)
	17464	. ;;PJH;; S HMPFCNT= HMPFCNT+1 ; increme nt the cou nt of retu rned items
	17465	"RTN","HMP DJFSG",84, 0)
	17466	. S HMPFS EQ=HMPFSEQ +1 ; incr ement the sequence n umber in t he stream
	17467	"RTN","HMP DJFSG",85, 0)
	17468	. S HMPFS IZE=$$INCI TEM($P(DOM AIN,"#")) ; S68-JCH
	17469	"RTN","HMP DJFSG",86, 0)
	17470	. S ITEMN UM=OFFSET+ ($P(DOMAIN ,"#",2)*SE CSIZE)
	17471	"RTN","HMP DJFSG",87, 0)
	17472	. M ^TMP( "HMPF",$J, HMPFCNT)=^ XTMP(BATCH ,TASK,DOMA IN,OFFSET)
	17473	"RTN","HMP DJFSG",88, 0)
	17474	. ;S ^TMP ("HMPF",$J ,HMPFCNT,. 3)=$$WRAPP ER(DOMAIN, PIDS,$S('C OUNT:0,1:I TEMNUM),+D OMSIZE)
	17475	"RTN","HMP DJFSG",89, 0)
	17476	. S ^TMP( "HMPF",$J, HMPFCNT,.3 )=$$WRAPPE R(DOMAIN,P IDS,$S('CO UNT:0,1:IT EMNUM),+DO MSIZE,1) ; S68-JCH
	17477	"RTN","HMP DJFSG",90, 0)
	17478	. S HMPLI TEM="SYNC" ,HMPCLFLG= 0 ; DE3502
	17479	"RTN","HMP DJFSG",91, 0)
	17480	Q
	17481	"RTN","HMP DJFSG",92, 0)
	17482	MIDXTRCT() ; Return true if mi d-extract
	17483	"RTN","HMP DJFSG",93, 0)
	17484	; from GE TSUB expec ts HMPFSTR M,HMPFSEQ
	17485	"RTN","HMP DJFSG",94, 0)
	17486	I 'HMPFSE Q Q 0
	17487	"RTN","HMP DJFSG",95, 0)
	17488	I '$D(^XT MP(HMPFSTR M,HMPFSEQ) ) Q 1 ; middl e of extra ct
	17489	"RTN","HMP DJFSG",96, 0)
	17490	I $P(^XTM P(HMPFSTRM ,HMPFSEQ), U,2)="sync Domain" Q 1 ; just starting e xtract
	17491	"RTN","HMP DJFSG",97, 0)
	17492	Q 0
	17493	"RTN","HMP DJFSG",98, 0)
	17494	;
	17495	"RTN","HMP DJFSG",99, 0)
	17496	NXTSTRM ; Reset vari ables for next date in this HM P stream
	17497	"RTN","HMP DJFSG",100 ,0)
	17498	; from GE TSUB expec ts HMPFSTR M,HMPFDT,H MPFIDX
	17499	"RTN","HMP DJFSG",101 ,0)
	17500	; HMPFSTR M set to " " if no ne xt stream
	17501	"RTN","HMP DJFSG",102 ,0)
	17502	; HMPFIDX set to 0 if next s tream, or left as is
	17503	"RTN","HMP DJFSG",103 ,0)
	17504	; HMPFDT set to l ast date a ctually us ed
	17505	"RTN","HMP DJFSG",104 ,0)
	17506	N NEXTDT, DONE
	17507	"RTN","HMP DJFSG",105 ,0)
	17508	S NEXTDT= HMPFDT,DON E=0
	17509	"RTN","HMP DJFSG",106 ,0)
	17510	F D Q:D ONE
	17511	"RTN","HMP DJFSG",107 ,0)
	17512	. S NEXTD T=$$FMADD^ XLFDT(NEXT DT,1)
	17513	"RTN","HMP DJFSG",108 ,0)
	17514	. I NEXTD T>$$DT^XLF DT S HMPFS TRM="" S D ONE=1 Q
	17515	"RTN","HMP DJFSG",109 ,0)
	17516	. S $P(HM PFSTRM,"~" ,3)=NEXTDT
	17517	"RTN","HMP DJFSG",110 ,0)
	17518	. I '+$O( ^XTMP(HMPF STRM,0)) Q ; nothin g here, tr y next dat e
	17519	"RTN","HMP DJFSG",111 ,0)
	17520	. S HMPFD T=NEXTDT,H MPFIDX=0,H MPFSEQ=0,D ONE=1
	17521	"RTN","HMP DJFSG",112 ,0)
	17522	Q
	17523	"RTN","HMP DJFSG",113 ,0)
	17524	;
	17525	"RTN","HMP DJFSG",114 ,0)
	17526	SETLIMIT(A RGS) ; set s HMPFLIM, HMPFMAX, HMPFSIZE v ariables BEGINS68 -JCH*
	17527	"RTN","HMP DJFSG",115 ,0)
	17528	I $G(ARGS ("maxSize" )) D Q
	17529	"RTN","HMP DJFSG",116 ,0)
	17530	. S HMPFL IM="s"
	17531	"RTN","HMP DJFSG",117 ,0)
	17532	. S HMPFM AX=ARGS("m axSize")
	17533	"RTN","HMP DJFSG",118 ,0)
	17534	. D GETLS T^XPAR(.HM PFSIZE,"PK G","HMP DO MAIN SIZES ","I")
	17535	"RTN","HMP DJFSG",119 ,0)
	17536	. S HMPFS IZE=0
	17537	"RTN","HMP DJFSG",120 ,0)
	17538	; otherwi se
	17539	"RTN","HMP DJFSG",121 ,0)
	17540	S HMPFLIM ="c"
	17541	"RTN","HMP DJFSG",122 ,0)
	17542	S HMPFMAX =$G(ARGS(" max"),9999 9)
	17543	"RTN","HMP DJFSG",123 ,0)
	17544	S HMPFSIZ E=0
	17545	"RTN","HMP DJFSG",124 ,0)
	17546	Q
	17547	"RTN","HMP DJFSG",125 ,0)
	17548	;
	17549	"RTN","HMP DJFSG",126 ,0)
	17550	INCITEM(DO MAIN) ; in crement co unters as item added BEGINS6 8-JCH*
	17551	"RTN","HMP DJFSG",127 ,0)
	17552	S HMPFCNT =HMPFCNT+1
	17553	"RTN","HMP DJFSG",128 ,0)
	17554	I HMPFLIM ="s" Q HMP FSIZE+$G(H MPFSIZE(DO MAIN),1200 )
	17555	"RTN","HMP DJFSG",129 ,0)
	17556	I HMPFLIM ="c" Q HMP FCNT
	17557	"RTN","HMP DJFSG",130 ,0)
	17558	Q 0
	17559	"RTN","HMP DJFSG",131 ,0)
	17560	; END S68-JCH*
	17561	"RTN","HMP DJFSG",132 ,0)
	17562	;
	17563	"RTN","HMP DJFSG",133 ,0)
	17564	FINISH(HMP DEL,HMPERR ) ;reset t he FIRST o bject deli miter, add header an d tail
	17565	"RTN","HMP DJFSG",134 ,0)
	17566	; expects HMPFCNT,H MPFDT,HMPF SEQ,HMPFHM P,HMPFLAST
	17567	"RTN","HMP DJFSG",135 ,0)
	17568	N CLOSE,I ,START,TEX T,UID,X,II
	17569	"RTN","HMP DJFSG",136 ,0)
	17570	S X=$G(^T MP("HMPF", $J,1,.3))
	17571	"RTN","HMP DJFSG",137 ,0)
	17572	I $E(X,1, 2)="}," S X=$E(X,3,$ L(X)),^TMP ("HMPF",$J ,1,.3)=X
	17573	"RTN","HMP DJFSG",138 ,0)
	17574	S ^TMP("H MPF",$J,.5 )=$$APIHDR (HMPFCNT,H MPFDT_"-"_ HMPFSEQ)
	17575	"RTN","HMP DJFSG",139 ,0)
	17576	I $D(HMPE RR) D
	17577	"RTN","HMP DJFSG",140 ,0)
	17578	.S CLOSE= $S(HMPFCNT :"},",1:"" ),START=1
	17579	"RTN","HMP DJFSG",141 ,0)
	17580	.S HMPFCN T=HMPFCNT+ 1,^TMP("HM PF",$J,HMP FCNT)=CLOS E_"{""erro r"":["
	17581	"RTN","HMP DJFSG",142 ,0)
	17582	.S I=0 F S I=$O(HM PERR(I)) Q :I'>0 D
	17583	"RTN","HMP DJFSG",143 ,0)
	17584	..S TEXT= HMPERR(I)
	17585	"RTN","HMP DJFSG",144 ,0)
	17586	..S HMPFC NT=HMPFCNT +1,^TMP("H MPF",$J,HM PFCNT)=$S( START:"",1 :",")_TEXT S START=0
	17587	"RTN","HMP DJFSG",145 ,0)
	17588	.S HMPFCN T=HMPFCNT+ 1,^TMP("HM PF",$J,HMP FCNT)="]"
	17589	"RTN","HMP DJFSG",146 ,0)
	17590	; operati onal sync item or pa tient
	17591	"RTN","HMP DJFSG",147 ,0)
	17592	; Check f or closing flag & HM PFCNT and if it does n't exist add a clos ing brace, always cl ose array
	17593	"RTN","HMP DJFSG",148 ,0)
	17594	S ^TMP("H MPF",$J,HM PFCNT+1)=$ S(HMPFCNT& ('$G(HMPCL FLG)):"}", 1:"")_"]", HMPFCNT=HM PFCNT+1
	17595	"RTN","HMP DJFSG",149 ,0)
	17596	; modifie d
	17597	"RTN","HMP DJFSG",150 ,0)
	17598	I $G(HMPS TGET)="tru e" D ; tr ue if "get Status" ar gument pas sed in
	17599	"RTN","HMP DJFSG",151 ,0)
	17600	. S HMPFC NT=HMPFCNT +1,^TMP("H MPF",$J,HM PFCNT)="," "syncStati i"":[",STA RT=1
	17601	"RTN","HMP DJFSG",152 ,0)
	17602	. S I=0 F S I=$O(^ HMP(800000 ,I)) Q:+I= 0 D
	17603	"RTN","HMP DJFSG",153 ,0)
	17604	. . I $P( $G(^HMP(80 0000,I,0)) ,"^",1)=HM PFHMP D
	17605	"RTN","HMP DJFSG",154 ,0)
	17606	. . . S I I=0 F S I I=$O(^HMP( 800000,I,1 ,II)) Q:+I I=0 D
	17607	"RTN","HMP DJFSG",155 ,0)
	17608	. . . . S TEXT="{"" pid"":"_II _",""statu s"":"_$P(^ HMP(800000 ,I,1,II,0) ,"^",2)_"} "
	17609	"RTN","HMP DJFSG",156 ,0)
	17610	. . . . S HMPFCNT=H MPFCNT+1,^ TMP("HMPF" ,$J,HMPFCN T)=$S(STAR T:"",1:"," )_TEXT S S TART=0
	17611	"RTN","HMP DJFSG",157 ,0)
	17612	. S HMPFC NT=HMPFCNT +1,^TMP("H MPF",$J,HM PFCNT)="]"
	17613	"RTN","HMP DJFSG",158 ,0)
	17614	;
	17615	"RTN","HMP DJFSG",159 ,0)
	17616	S ^TMP("H MPF",$J,HM PFCNT+1)=" }}"
	17617	"RTN","HMP DJFSG",160 ,0)
	17618	; remove any ^XTMP nodes that have been successfu lly sent b ased on LA ST
	17619	"RTN","HMP DJFSG",161 ,0)
	17620	N DATE,SE Q,LASTDT,L ASTSEQ,STR M,LSTRM,RS TRM
	17621	"RTN","HMP DJFSG",162 ,0)
	17622	S LASTDT= +$P(HMPFLA ST,"-"),LA STSEQ=+$P( HMPFLAST," -",2)
	17623	"RTN","HMP DJFSG",163 ,0)
	17624	S RSTRM=" HMPFS~"_HM PFHMP_"~", LSTRM=$L(R STRM),STRM =RSTRM
	17625	"RTN","HMP DJFSG",164 ,0)
	17626	F S STRM =$O(^XTMP( STRM)) Q:' $L(STRM) Q:$E(STRM, 1,LSTRM)'= RSTRM D
	17627	"RTN","HMP DJFSG",165 ,0)
	17628	. S DATE= $P(STRM,"~ ",3) Q:DAT E>LASTDT
	17629	"RTN","HMP DJFSG",166 ,0)
	17630	. S SEQ=0 F S SEQ= $O(^XTMP(S TRM,"tidy" ,SEQ)) Q:' SEQ Q:(DA TE=LASTDT) &(SEQ>LAST SEQ) D TI DYX(STRM,S EQ)
	17631	"RTN","HMP DJFSG",167 ,0)
	17632	Q
	17633	"RTN","HMP DJFSG",168 ,0)
	17634	TIDYX(STRE AM,SEQ) ; clean up e xtracts af ter they h ave been r etrieved
	17635	"RTN","HMP DJFSG",169 ,0)
	17636	; from FI NISH
	17637	"RTN","HMP DJFSG",170 ,0)
	17638	N BATCH,D OMAIN,TASK
	17639	"RTN","HMP DJFSG",171 ,0)
	17640	S BATCH=^ XTMP(STREA M,"tidy",S EQ,"batch" )
	17641	"RTN","HMP DJFSG",172 ,0)
	17642	S DOMAIN= ^XTMP(STRE AM,"tidy", SEQ,"domai n")
	17643	"RTN","HMP DJFSG",173 ,0)
	17644	S TASK=^X TMP(STREAM ,"tidy",SE Q,"task")
	17645	"RTN","HMP DJFSG",174 ,0)
	17646	I DOMAIN= "<done>" K ^XTMP(BAT CH) I 1
	17647	"RTN","HMP DJFSG",175 ,0)
	17648	E K ^XTM P(BATCH,TA SK,DOMAIN)
	17649	"RTN","HMP DJFSG",176 ,0)
	17650	K ^XTMP(S TREAM,"tid y",SEQ)
	17651	"RTN","HMP DJFSG",177 ,0)
	17652	Q
	17653	"RTN","HMP DJFSG",178 ,0)
	17654	SYNCCMD(SE QNODE) ; B uild syncC ommand obj ect and st ick in ^TM P
	17655	"RTN","HMP DJFSG",179 ,0)
	17656	; expects : HMPSYS, HMPFCNT
	17657	"RTN","HMP DJFSG",180 ,0)
	17658	N DFN,CMD ,CMDJSON,E RR
	17659	"RTN","HMP DJFSG",181 ,0)
	17660	S DFN=+SE QNODE
	17661	"RTN","HMP DJFSG",182 ,0)
	17662	S CMD("co mmand")=$P ($P(SEQNOD E,U,3),":" )
	17663	"RTN","HMP DJFSG",183 ,0)
	17664	S CMD("do main")=$P( $P(SEQNODE ,U,3),":", 2)
	17665	"RTN","HMP DJFSG",184 ,0)
	17666	S:DFN CMD ("pid")=$$ PID^HMPDJF S(DFN)
	17667	"RTN","HMP DJFSG",185 ,0)
	17668	S CMD("sy stem")=HMP SYS
	17669	"RTN","HMP DJFSG",186 ,0)
	17670	D ENCODE^ HMPJSON("C MD","CMDJS ON","ERR")
	17671	"RTN","HMP DJFSG",187 ,0)
	17672	I $D(ERR) S $EC=",U JSON encod e error," Q
	17673	"RTN","HMP DJFSG",188 ,0)
	17674	S HMPFSIZ E=$$INCITE M("syncCom mand") ; S68-JCH
	17675	"RTN","HMP DJFSG",189 ,0)
	17676	M ^TMP("H MPF",$J,HM PFCNT)=CMD JSON
	17677	"RTN","HMP DJFSG",190 ,0)
	17678	S ^TMP("H MPF",$J,HM PFCNT,.3)= $$WRAPPER( "syncComma nd",$$PIDS ^HMPDJFS(D FN),1,1)
	17679	"RTN","HMP DJFSG",191 ,0)
	17680	Q
	17681	"RTN","HMP DJFSG",192 ,0)
	17682	SYNCSTRT(S EQNODE) ; Build sync Start obje ct with de mograhics
	17683	"RTN","HMP DJFSG",193 ,0)
	17684	; expects HMPFSYS, HMPFHMP, H MPFCNT, HM PFSIZE * S68-JCH*
	17685	"RTN","HMP DJFSG",194 ,0)
	17686	S HMPFSIZ E=$$INCITE M("patient ") ; * S68-JCH*
	17687	"RTN","HMP DJFSG",195 ,0)
	17688	N DFN,FIL TER,DFN,WR AP
	17689	"RTN","HMP DJFSG",196 ,0)
	17690	S DFN=$P( $P(SEQNODE ,U,3),"~", 3) ; HMPFX ~hmpSrvId~ dfn
	17691	"RTN","HMP DJFSG",197 ,0)
	17692	I DFN D
	17693	"RTN","HMP DJFSG",198 ,0)
	17694	. N RSLT ;cpc 2015/ 10/01
	17695	"RTN","HMP DJFSG",199 ,0)
	17696	. S FILTE R("patient Id")=DFN,F ILTER("dom ain")="pat ient"
	17697	"RTN","HMP DJFSG",200 ,0)
	17698	. D GET^H MPDJ(.RSLT ,.FILTER)
	17699	"RTN","HMP DJFSG",201 ,0)
	17700	. M ^TMP( "HMPF",$J, HMPFCNT)=^ TMP("HMP", $J,1)
	17701	"RTN","HMP DJFSG",202 ,0)
	17702	; for OPD there is no object, so 4th ar gument is 0
	17703	"RTN","HMP DJFSG",203 ,0)
	17704	S ^TMP("H MPF",$J,HM PFCNT,.3)= $$WRAPPER( "syncStart ",$$PIDS^H MPDJFS(DFN ),$S(DFN:1 ,1:-1),$S( DFN:1,1:-1 ))
	17705	"RTN","HMP DJFSG",204 ,0)
	17706	Q
	17707	"RTN","HMP DJFSG",205 ,0)
	17708	SYNCDONE(S EQNODE) ; Build sync Status obj ect and st ick in ^TM P
	17709	"RTN","HMP DJFSG",206 ,0)
	17710	; expect s: HMPFSYS , HMPFCNT, HMPFHMP, HMPFSIZE S68-JCH
	17711	"RTN","HMP DJFSG",207 ,0)
	17712	N HMPBATC H,DFN,STS, STSJSON,X, ERR
	17713	"RTN","HMP DJFSG",208 ,0)
	17714	S HMPBATC H=$P(SEQNO DE,U,3) ; HMPFX~hmpS rvId~dfn
	17715	"RTN","HMP DJFSG",209 ,0)
	17716	S DFN=$P( HMPBATCH," ~",3)
	17717	"RTN","HMP DJFSG",210 ,0)
	17718	S STS("ui d")="urn:v a:syncStat us:"_HMPFS YS_":"_DFN
	17719	"RTN","HMP DJFSG",211 ,0)
	17720	S STS("in itialized" )="true"
	17721	"RTN","HMP DJFSG",212 ,0)
	17722	I DFN S S TS("localI d")=DFN
	17723	"RTN","HMP DJFSG",213 ,0)
	17724	S X="" F S X=$O(^X TMP(HMPBAT CH,0,"coun t",X)) Q:' $L(X) D
	17725	"RTN","HMP DJFSG",214 ,0)
	17726	. S STS(" domainTota ls",X)=^XT MP(HMPBATC H,0,"count ",X)
	17727	"RTN","HMP DJFSG",215 ,0)
	17728	;===JD ST ART===
	17729	"RTN","HMP DJFSG",216 ,0)
	17730	; If resu bscribing a patient, just send demograph ics
	17731	"RTN","HMP DJFSG",217 ,0)
	17732	I DFN'="O PD",$D(^HM P(800000," AITEM",DFN )) D
	17733	"RTN","HMP DJFSG",218 ,0)
	17734	. N HMP99
	17735	"RTN","HMP DJFSG",219 ,0)
	17736	. S HMP99 =""
	17737	"RTN","HMP DJFSG",220 ,0)
	17738	. ; Reset all domai n counts t o zero exc ept for de mographics
	17739	"RTN","HMP DJFSG",221 ,0)
	17740	. F S HM P99=$O(STS ("domainTo tals",HMP9 9)) Q:'HMP 99 I HMP9 9'="patien t" S STS(" domainTota ls",HMP99) =0
	17741	"RTN","HMP DJFSG",222 ,0)
	17742	;===JD END===
	17743	"RTN","HMP DJFSG",223 ,0)
	17744	D ENCODE^ HMPJSON("S TS","STSJS ON","ERR")
	17745	"RTN","HMP DJFSG",224 ,0)
	17746	I $D(ERR) S $EC=",U JSON encod e error," Q
	17747	"RTN","HMP DJFSG",225 ,0)
	17748	S HMPFSIZ E=$$INCITE M("syncsta tus") ; * S68-JCH*
	17749	"RTN","HMP DJFSG",226 ,0)
	17750	M ^TMP("H MPF",$J,HM PFCNT)=STS JSON
	17751	"RTN","HMP DJFSG",227 ,0)
	17752	S ^TMP("H MPF",$J,HM PFCNT,.3)= $$WRAPPER( "syncStatu s",$$PIDS^ HMPDJFS(DF N),1,1)
	17753	"RTN","HMP DJFSG",228 ,0)
	17754	Q
	17755	"RTN","HMP DJFSG",229 ,0)
	17756	;
	17757	"RTN","HMP DJFSG",230 ,0)
	17758	SYNCMETA(S NODE) ; US 11019 Buil d NEW sync Start obje ct
	17759	"RTN","HMP DJFSG",231 ,0)
	17760	; expects HMPFSYS, HMPFHMP, H MPFCNT
	17761	"RTN","HMP DJFSG",232 ,0)
	17762	; need to rebuild S NODE becau se WRAPPER expects i t to fall in
	17763	"RTN","HMP DJFSG",233 ,0)
	17764	N BATCH,D FN,WRAP,ME TADOM
	17765	"RTN","HMP DJFSG",234 ,0)
	17766	S DFN=$P( SNODE,U,1)
	17767	"RTN","HMP DJFSG",235 ,0)
	17768	S METADOM =$P(SNODE, U,3)
	17769	"RTN","HMP DJFSG",236 ,0)
	17770	S BATCH=" HMPFX~"_HM PFHMP_"~"_ DFN
	17771	"RTN","HMP DJFSG",237 ,0)
	17772	S $P(SNOD E,U,3)=BAT CH
	17773	"RTN","HMP DJFSG",238 ,0)
	17774	S HMPFSIZ E=$$INCITE M("syncmet a") ;need to increme nt count
	17775	"RTN","HMP DJFSG",239 ,0)
	17776	S ^TMP("H MPF",$J,HM PFCNT,.3)= $$WRAPPER( "syncStart "_"#"_META DOM,$$PIDS ^HMPDJFS(D FN),$S(DFN :1,1:-1),$ S(DFN:1,1: -1))
	17777	"RTN","HMP DJFSG",240 ,0)
	17778	S ^TMP("H MPF",$J,HM PFCNT,1)=" null" ;alw ays null o bject with this reco rd
	17779	"RTN","HMP DJFSG",241 ,0)
	17780	S HMPCLFL G=0 ; DE35 02
	17781	"RTN","HMP DJFSG",242 ,0)
	17782	Q
	17783	"RTN","HMP DJFSG",243 ,0)
	17784	;
	17785	"RTN","HMP DJFSG",244 ,0)
	17786	SYNCERR(SN ODE,HMPERR ) ;
	17787	"RTN","HMP DJFSG",245 ,0)
	17788	N BATCH,C NT,DFN,NUM ,OFFSET,PI DS,TASK,TO TAL,X
	17789	"RTN","HMP DJFSG",246 ,0)
	17790	S DFN=$P( SNODE,U),X =$P(SNODE, U,3)
	17791	"RTN","HMP DJFSG",247 ,0)
	17792	S PIDS=$$ PIDS^HMPDJ FS(DFN)
	17793	"RTN","HMP DJFSG",248 ,0)
	17794	S TASK=$P (X,":",2), TOTAL=$P(X ,":",4)
	17795	"RTN","HMP DJFSG",249 ,0)
	17796	S BATCH=" HMPFX~"_HM PFHMP_"~"_ DFN ; extract node in ^X TMP
	17797	"RTN","HMP DJFSG",250 ,0)
	17798	S CNT=$O( HMPERR("") ,-1)
	17799	"RTN","HMP DJFSG",251 ,0)
	17800	S NUM=0 F S NUM=$O (^XTMP(BAT CH,TASK,"e rror",NUM) ) Q:NUM'>0 D
	17801	"RTN","HMP DJFSG",252 ,0)
	17802	.S CNT=CN T+1 S HMPE RR(CNT)=$G (^XTMP(BAT CH,TASK,"e rror",NUM, 1))
	17803	"RTN","HMP DJFSG",253 ,0)
	17804	Q
	17805	"RTN","HMP DJFSG",254 ,0)
	17806	;
	17807	"RTN","HMP DJFSG",255 ,0)
	17808	FRESHITM(S EQNODE,DEL ETE,ERROR) ; Get fre shness ite m and stic k in ^TMP
	17809	"RTN","HMP DJFSG",256 ,0)
	17810	; expects HMPFSYS, HMPFHMP
	17811	"RTN","HMP DJFSG",257 ,0)
	17812	N ACT,DFN ,DOMAIN,EC NT,FILTER, ID,RSLT,UI D,HMP97,HM PI,WRAP,HM PPAT7,HMPP AT8
	17813	"RTN","HMP DJFSG",258 ,0)
	17814	S FILTER( "noHead")= 1
	17815	"RTN","HMP DJFSG",259 ,0)
	17816	S DFN=$P( SEQNODE,U) ,DOMAIN=$P (SEQNODE,U ,2),ID=$P( SEQNODE,U, 3),ACT=$P( SEQNODE,U, 4)
	17817	"RTN","HMP DJFSG",260 ,0)
	17818	;==JD STA RT
	17819	"RTN","HMP DJFSG",261 ,0)
	17820	;Create a phantom " patient" i f visit is the domai n
	17821	"RTN","HMP DJFSG",262 ,0)
	17822	I DOMAIN= "visit" D
	17823	"RTN","HMP DJFSG",263 ,0)
	17824	.S HMPPAT 7=HMPFIDX_ ".99",HMPP AT8=^XTMP( HMPFSTRM,H MPFIDX),$P (HMPPAT8,U ,2)="patie nt" ;BL;D E2280
	17825	"RTN","HMP DJFSG",264 ,0)
	17826	.S ^XTMP( HMPFSTRM,H MPPAT7)=HM PPAT8
	17827	"RTN","HMP DJFSG",265 ,0)
	17828	;==JD END
	17829	"RTN","HMP DJFSG",266 ,0)
	17830	;
	17831	"RTN","HMP DJFSG",267 ,0)
	17832	I ACT'="@ " D
	17833	"RTN","HMP DJFSG",268 ,0)
	17834	. S FILTE R("id")=ID
	17835	"RTN","HMP DJFSG",269 ,0)
	17836	. S FILTE R("domain" )=DOMAIN
	17837	"RTN","HMP DJFSG",270 ,0)
	17838	. I DFN=" OPD" D GET ^HMPEF(.RS LT,.FILTER )
	17839	"RTN","HMP DJFSG",271 ,0)
	17840	. I +DFN> 0 D
	17841	"RTN","HMP DJFSG",272 ,0)
	17842	. . S FIL TER("patie ntId")=DFN
	17843	"RTN","HMP DJFSG",273 ,0)
	17844	. . D GET ^HMPDJ(.RS LT,.FILTER )
	17845	"RTN","HMP DJFSG",274 ,0)
	17846	I ACT'="@ ",$L($G(^T MP("HMP",$ J,"error") ))>0 D BLD SERR(DFN,. ERROR) Q
	17847	"RTN","HMP DJFSG",275 ,0)
	17848	I '$D(^TM P("HMP",$J ,1)) S ACT ="@"
	17849	"RTN","HMP DJFSG",276 ,0)
	17850	I ACT="@" D
	17851	"RTN","HMP DJFSG",277 ,0)
	17852	. S UID=$ $SETUID^HM PUTILS(DOM AIN,$S(+DF N>0:DFN,1: ""),ID)
	17853	"RTN","HMP DJFSG",278 ,0)
	17854	. S HMP97 =UID
	17855	"RTN","HMP DJFSG",279 ,0)
	17856	. K ^TMP( "HMP",$J) S ^TMP("HM P",$J,1)=" " ; Need t o dummy th is up or i t will nev er get set later
	17857	"RTN","HMP DJFSG",280 ,0)
	17858	;
	17859	"RTN","HMP DJFSG",281 ,0)
	17860	;Add sync start, dat a and sync status to JSON for u nsolicited updates - US4588 & US3682
	17861	"RTN","HMP DJFSG",282 ,0)
	17862	I (DOMAIN ="pt-selec t")!(DOMAI N="user")! (DOMAIN["a su-")!(DOM AIN="doc-d ef")!(DFN= +DFN) D Q
	17863	"RTN","HMP DJFSG",283 ,0)
	17864	.D ADHOC^ HMPUTIL1(D OMAIN,.HMP FCNT,DFN)
	17865	"RTN","HMP DJFSG",284 ,0)
	17866	.I $P(HMP FIDX,".",2 )=99 K ^XT MP(HMPFSTR M,HMPFIDX) ;Remove t he phantom "patient" ; JD
	17867	"RTN","HMP DJFSG",285 ,0)
	17868	.S HMPLIT EM="FRESH" ; DE3502
	17869	"RTN","HMP DJFSG",286 ,0)
	17870	;
	17871	"RTN","HMP DJFSG",287 ,0)
	17872	S WRAP=$$ WRAPPER(DO MAIN,$$PID S^HMPDJFS( DFN),1,1) ; N.B. thi s updates the .3 nod e on this HMPFCNT
	17873	"RTN","HMP DJFSG",288 ,0)
	17874	F HMPI=1: 1 Q:'$D(^T MP("HMP",$ J,HMPI)) D
	17875	"RTN","HMP DJFSG",289 ,0)
	17876	. S HMPFC NT=HMPFCNT +1
	17877	"RTN","HMP DJFSG",290 ,0)
	17878	. M ^TMP( "HMPF",$J, HMPFCNT)=^ TMP("HMP", $J,HMPI)
	17879	"RTN","HMP DJFSG",291 ,0)
	17880	. I HMPLI TEM="SYNC" S HMPLITE M="FRESH" I WRAP="," S ^TMP("H MPF",$J,HM PFCNT,.3)= "}," Q ; DE3502 add closing
	17881	"RTN","HMP DJFSG",292 ,0)
	17882	. S ^TMP( "HMPF",$J, HMPFCNT,.3 )=WRAP
	17883	"RTN","HMP DJFSG",293 ,0)
	17884	Q
	17885	"RTN","HMP DJFSG",294 ,0)
	17886	;
	17887	"RTN","HMP DJFSG",295 ,0)
	17888	BLDSERR(DF N,ERROR) ; Create sy ncError ob ject in ER RJSON
	17889	"RTN","HMP DJFSG",296 ,0)
	17890	; expects : HMPBATCH , HMPFSYS, HMPFZTSK
	17891	"RTN","HMP DJFSG",297 ,0)
	17892	N COUNT,E RRVAL,ERRO BJ,ERR,ERR CNT,ERRMSG ,SYNCERR
	17893	"RTN","HMP DJFSG",298 ,0)
	17894	M ERRVAL= ^TMP("HMP" ,$J,"error ")
	17895	"RTN","HMP DJFSG",299 ,0)
	17896	I $G(ERRV AL)="" Q
	17897	"RTN","HMP DJFSG",300 ,0)
	17898	S ERRVAL= "{"_ERRVAL _"}"
	17899	"RTN","HMP DJFSG",301 ,0)
	17900	D DECODE^ HMPJSON("E RRVAL","ER ROBJ","ERR ")
	17901	"RTN","HMP DJFSG",302 ,0)
	17902	I $D(ERR) S $EC=",U JSON decod e error,"
	17903	"RTN","HMP DJFSG",303 ,0)
	17904	S ERRMSG= ERROBJ("er ror","mess age")
	17905	"RTN","HMP DJFSG",304 ,0)
	17906	Q:'$L(ERR MSG)
	17907	"RTN","HMP DJFSG",305 ,0)
	17908	S SYNCERR ("uid")="u rn:va:sync Error:"_HM PFSYS_":"_ DFN_":FRES HNESS"
	17909	"RTN","HMP DJFSG",306 ,0)
	17910	S SYNCERR ("collecti on")=DOMAI N
	17911	"RTN","HMP DJFSG",307 ,0)
	17912	S SYNCERR ("error")= ERRMSG
	17913	"RTN","HMP DJFSG",308 ,0)
	17914	D ENCODE^ HMPJSON("S YNCERR","E RRJSON","E RR") I $D( ERR) S $EC =",UJSON e ncode erro r," Q
	17915	"RTN","HMP DJFSG",309 ,0)
	17916	S COUNT=$ O(ERROR("" ),-1) ; BEGINS68 -JCH*
	17917	"RTN","HMP DJFSG",310 ,0)
	17918	S ERRCNT= 0 F S ERR CNT=$O(ERR JSON(ERRCN T)) Q:ERRC NT'>0 D
	17919	"RTN","HMP DJFSG",311 ,0)
	17920	.S COUNT= COUNT+1 M ERROR(COUN T)=ERRJSON (COUNT) ; ENDS68 -JCH*
	17921	"RTN","HMP DJFSG",312 ,0)
	17922	Q
	17923	"RTN","HMP DJFSG",313 ,0)
	17924	WRAPPER(DO MAIN,PIDS, OFFSET,DOM SIZE,FROMX TR) ; retu rn JSON wr apper for each item S68-JCH
	17925	"RTN","HMP DJFSG",314 ,0)
	17926	; add obj ect tag if extract t otal not z ero or if total pass ed as -1
	17927	"RTN","HMP DJFSG",315 ,0)
	17928	; seq and total tag s only add ed if non- zero
	17929	"RTN","HMP DJFSG",316 ,0)
	17930	N X,Y,Z,H MPSVERS ;U S11019
	17931	"RTN","HMP DJFSG",317 ,0)
	17932	; Ensure that X exi sts
	17933	"RTN","HMP DJFSG",318 ,0)
	17934	S X=""
	17935	"RTN","HMP DJFSG",319 ,0)
	17936	S Z=$P(SN ODE,U,3)
	17937	"RTN","HMP DJFSG",320 ,0)
	17938	S HMPSVER S=$G(^XTMP (Z,"HMPSVE RS")) ;US1 1019 If HM PSVERS=0 t hen runnin g in previ ous mode
	17939	"RTN","HMP DJFSG",321 ,0)
	17940	S HMPSTMP =$G(^XTMP( Z,"HMPSTMP ")) ;; PJH - THIS US ED ONLY FO R OPD COMP ILE IN PRI OR VERSION - NEEDS R EMOVING US 6734
	17941	"RTN","HMP DJFSG",322 ,0)
	17942	; This wa s working for operat ional data , not pati ent data
	17943	"RTN","HMP DJFSG",323 ,0)
	17944	; DFN wil l be OPD i f this is operationa l data (no n-obvious I know)
	17945	"RTN","HMP DJFSG",324 ,0)
	17946	I DFN="OP D" D
	17947	"RTN","HMP DJFSG",325 ,0)
	17948	. S:$P($G (DOMAIN)," #")'="sync Start" X=" },{""colle ction"":"" "_$P(DOMAI N,"#")_""" "_PIDS ;US 11019
	17949	"RTN","HMP DJFSG",326 ,0)
	17950	E S X="} ,{""collec tion"":""" _$P(DOMAIN ,"#")_"""" _PIDS ; I f ONLY pat ient data exists
	17951	"RTN","HMP DJFSG",327 ,0)
	17952	I HMPLITE M="FRESH" I $E(X)="} " S X=$E(X ,2,$L(X)) ; DE3502 - remove cl osing when coming fr om Fresh
	17953	"RTN","HMP DJFSG",328 ,0)
	17954	I $P(DOMA IN,"#")="s yncStart", $O(^XTMP(Z ,0))]"" D Q X
	17955	"RTN","HMP DJFSG",329 ,0)
	17956	.; --- St art US3907 ---
	17957	"RTN","HMP DJFSG",330 ,0)
	17958	.; Pass J obId and R ootJobId b ack in the response if we were given the m
	17959	"RTN","HMP DJFSG",331 ,0)
	17960	.; This b ridges the gap betwe en Job sta tus and Sy nc Status (since Vis tA will be giving th e syncStat us)
	17961	"RTN","HMP DJFSG",332 ,0)
	17962	.; US1101 9 use doma in specifi c Job id
	17963	"RTN","HMP DJFSG",333 ,0)
	17964	.S Y=$S($ P(DOMAIN," #",2)="":$ G(^XTMP(Z, "JOBID")), 1:$G(^XTMP (Z,"JOBID" ,$P(DOMAIN ,"#",2)))) ;US11019
	17965	"RTN","HMP DJFSG",334 ,0)
	17966	.I Y]"" S X=X_",""j obId"":""" _Y_""""
	17967	"RTN","HMP DJFSG",335 ,0)
	17968	.S Y=$G(^ XTMP(Z,"RO OTJOBID"))
	17969	"RTN","HMP DJFSG",336 ,0)
	17970	.I Y]"" S X=X_",""r ootJobId"" :"""_Y_""" "
	17971	"RTN","HMP DJFSG",337 ,0)
	17972	.; --- En d US3907 - --
	17973	"RTN","HMP DJFSG",338 ,0)
	17974	.I DFN'=" OPD" D MET APT^HMPMET A(SNODE,$S (HMPSVERS: $P(DOMAIN, "#",2),1:" ")) Q ; U S11019 ext ra para ;C ollect Pat ient metas tamp data from XTMP - US6734
	17975	"RTN","HMP DJFSG",339 ,0)
	17976	.D METAOP ^HMPMETA(S NODE) ; Co llect OPD metastamp data from XTMP - US6 734
	17977	"RTN","HMP DJFSG",340 ,0)
	17978	S X=X_","
	17979	"RTN","HMP DJFSG",341 ,0)
	17980	; if batc hed by ext ract S68 -JCH
	17981	"RTN","HMP DJFSG",342 ,0)
	17982	I $G(OFFS ET)>-1 S X =X_"""seq" ":"_OFFSET _","
	17983	"RTN","HMP DJFSG",343 ,0)
	17984	I $G(DOMS IZE)>-1 S X=X_"""tot al"":"_DOM SIZE_","
	17985	"RTN","HMP DJFSG",344 ,0)
	17986	I $G(OFFS ET)>-1 S X =X_"""obje ct"":"
	17987	"RTN","HMP DJFSG",345 ,0)
	17988	Q X
	17989	"RTN","HMP DJFSG",346 ,0)
	17990	;
	17991	"RTN","HMP DJFSG",347 ,0)
	17992	APIHDR(COU NT,LASTITM ) ; return JSON
	17993	"RTN","HMP DJFSG",348 ,0)
	17994	; expects HMPFSYS
	17995	"RTN","HMP DJFSG",349 ,0)
	17996	I $P($G(L ASTITM),". ",2)="99" S LASTITM= $P(LASTITM ,".") ;ma ke sure la stUpdate i s correct; JD;BL;DE22 80
	17997	"RTN","HMP DJFSG",350 ,0)
	17998	N X
	17999	"RTN","HMP DJFSG",351 ,0)
	18000	S X="{""a piVersion" ":1.02,""p arams"":{" "domain"": """_$$KSP^ XUPARAM("W HERE")_""" "
	18001	"RTN","HMP DJFSG",352 ,0)
	18002	S X=X_"," "systemId" ":"""_HMPF SYS_"""}," "data"":{" "updated"" :"""_$$HL7 NOW^HMPDJ_ """"
	18003	"RTN","HMP DJFSG",353 ,0)
	18004	S X=X_"," "totalItem s"":"_COUN T_",""last Update"":" ""_LASTITM _""""_$$PR OGRESS^HMP DJFS(LASTI TM)
	18005	"RTN","HMP DJFSG",354 ,0)
	18006	S X=X_"," "items"":[ "
	18007	"RTN","HMP DJFSG",355 ,0)
	18008	Q X
	18009	"RTN","HMP DJFSG",356 ,0)
	18010	;
	18011	"RTN","HMP DJFSG",357 ,0)
	18012	NOOP(LASTI TM) ; No-o p, don't r eturn any items
	18013	"RTN","HMP DJFSG",358 ,0)
	18014	S ^TMP("H MPF",$J,.5 )=$$APIHDR (0,LASTITM )_"]}}"
	18015	"RTN","HMP DJFSG",359 ,0)
	18016	Q
	18017	"RTN","HMP DJFSG",360 ,0)
	18018	VERMATCH(H MPIEN,VERS ION) ; tru e if middl e tier HMP and VistA version m atch
	18019	"RTN","HMP DJFSG",361 ,0)
	18020	; version s match, q ueue any p atients wa iting for match
	18021	"RTN","HMP DJFSG",362 ,0)
	18022	I $P($$GE T^XPAR("PK G","HMP JS ON SCHEMA" ),".")=$P( VERSION,". ") D QUIT 1
	18023	"RTN","HMP DJFSG",363 ,0)
	18024	. Q:'$G(^ XTMP("HMPF S~"_HMPIEN ,"waiting" )) ; no p atients aw aiting que uing
	18025	"RTN","HMP DJFSG",364 ,0)
	18026	. S ^XTMP ("HMPFS~"_ HMPIEN,"wa iting")=0
	18027	"RTN","HMP DJFSG",365 ,0)
	18028	. N DOMAI NS,BATCH,H MPNAME
	18029	"RTN","HMP DJFSG",366 ,0)
	18030	. S HMPNA ME=$P(^HMP (800000,HM PIEN,0),U)
	18031	"RTN","HMP DJFSG",367 ,0)
	18032	. D PTDOM S^HMPDJFSD (.DOMAINS)
	18033	"RTN","HMP DJFSG",368 ,0)
	18034	. S DFN=0 F S DFN= $O(^XTMP(" HMPFS~"_HM PIEN,"wait ing",DFN)) Q:'DFN D
	18035	"RTN","HMP DJFSG",369 ,0)
	18036	. . Q:'$D (^HMP(8000 00,HMPIEN, 1,DFN)) ; subscript ion cancel led while waiting * S68-JCH*
	18037	"RTN","HMP DJFSG",370 ,0)
	18038	. . S BAT CH="HMPFX~ "_HMPNAME_ "~"_DFN
	18039	"RTN","HMP DJFSG",371 ,0)
	18040	. . D QUI NIT^HMPDJF SP(BATCH,D FN,.DOMAIN S)
	18041	"RTN","HMP DJFSG",372 ,0)
	18042	. K ^XTMP ("HMPFS~"_ HMPIEN)
	18043	"RTN","HMP DJFSG",373 ,0)
	18044	;
	18045	"RTN","HMP DJFSG",374 ,0)
	18046	; otherwi se, hold t hings
	18047	"RTN","HMP DJFSG",375 ,0)
	18048	D NEWXTMP ^HMPDJFS(" HMPFS~"_HM PIEN,8,"HM P Awaiting Version M atch")
	18049	"RTN","HMP DJFSG",376 ,0)
	18050	S ^XTMP(" HMPFS~"_HM PIEN,"wait ing")=1
	18051	"RTN","HMP DJFSG",377 ,0)
	18052	Q 0
	18053	"RTN","HMP DJFSG",378 ,0)
	18054	;
	18055	"RTN","HMP DJFSG",379 ,0)
	18056	LASTUPD(HM PSRV,LASTU PD) ; save the last update
	18057	"RTN","HMP DJFSG",380 ,0)
	18058	; TODO: c hange this to use Fi leman call
	18059	"RTN","HMP DJFSG",381 ,0)
	18060	N IEN,CUR RUPD,REPEA T
	18061	"RTN","HMP DJFSG",382 ,0)
	18062	S IEN=$O( ^HMP(80000 0,"B",HMPS RV,0)) Q:' IEN
	18063	"RTN","HMP DJFSG",383 ,0)
	18064	Q:LASTUPD ["^"
	18065	"RTN","HMP DJFSG",384 ,0)
	18066	S CURRUPD =$P(^HMP(8 00000,IEN, 0),"^",2), REPEAT=$P( ^HMP(80000 0,IEN,0)," ^",4)
	18067	"RTN","HMP DJFSG",385 ,0)
	18068	I LASTUPD =CURRUPD S $P(^HMP(8 00000,IEN, 0),"^",4)= REPEAT+1 Q UIT
	18069	"RTN","HMP DJFSG",386 ,0)
	18070	S $P(^HMP (800000,IE N,0),"^",2 )=LASTUPD, $P(^HMP(80 0000,IEN,0 ),"^",4)=0
	18071	"RTN","HMP DJFSG",387 ,0)
	18072	Q
	18073	"RTN","HMP DJFSG",388 ,0)
	18074	JSONOUT ; Write out JSON in ^T MP
	18075	"RTN","HMP DJFSG",389 ,0)
	18076	N X
	18077	"RTN","HMP DJFSG",390 ,0)
	18078	S X=$NA(^ TMP("HMPF" ,$J))
	18079	"RTN","HMP DJFSG",391 ,0)
	18080	F S X=$Q (@X) Q:($Q S(X,1)'="H MPF")!($QS (X,2)'=$J) W !,@X
	18081	"RTN","HMP DJFSG",392 ,0)
	18082	Q
	18083	"RTN","HMP DJFSG",393 ,0)
	18084	;
	18085	"RTN","HMP DJFSM")
	18086	0^51^B9194 3836
	18087	"RTN","HMP DJFSM",1,0 )
	18088	HMPDJFSM ; SLC/KCM,AS MR/RRB - M onitoring Tools for Extracts;N ov 04, 201 5 17:46:48
	18089	"RTN","HMP DJFSM",2,0 )
	18090	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	18091	"RTN","HMP DJFSM",3,0 )
	18092	;Per VA D irective 6 402, this routine sh ould not b e modified .
	18093	"RTN","HMP DJFSM",4,0 )
	18094	;
	18095	"RTN","HMP DJFSM",5,0 )
	18096	Q
	18097	"RTN","HMP DJFSM",6,0 )
	18098	;
	18099	"RTN","HMP DJFSM",7,0 )
	18100	EN ; Show informatio n for one server
	18101	"RTN","HMP DJFSM",8,0 )
	18102	N IEN
	18103	"RTN","HMP DJFSM",9,0 )
	18104	S IEN=$$G ETSRV() Q: IEN'>0
	18105	"RTN","HMP DJFSM",10, 0)
	18106	D LOOP(IE N)
	18107	"RTN","HMP DJFSM",11, 0)
	18108	Q
	18109	"RTN","HMP DJFSM",12, 0)
	18110	ALL ; Show informati on for all servers
	18111	"RTN","HMP DJFSM",13, 0)
	18112	S IEN=0 F S IEN=$O (^HMP(8000 00,IEN)) Q :'IEN W ! D SHOWSRV (IEN)
	18113	"RTN","HMP DJFSM",14, 0)
	18114	Q
	18115	"RTN","HMP DJFSM",15, 0)
	18116	ADDPT(PAT) ; Add pat ient to se rver
	18117	"RTN","HMP DJFSM",16, 0)
	18118	N SRV,ARG S,RESULT
	18119	"RTN","HMP DJFSM",17, 0)
	18120	I '$G(PAT ) S PAT=$$ GETPAT() Q :'PAT
	18121	"RTN","HMP DJFSM",18, 0)
	18122	S SRV=$$G ETSRV() Q: SRV'>0
	18123	"RTN","HMP DJFSM",19, 0)
	18124	I $G(^HMP (800000,"A ITEM",PAT, SRV))>0 W !,"Patient "_PAT_" a lready syn ced."
	18125	"RTN","HMP DJFSM",20, 0)
	18126	;
	18127	"RTN","HMP DJFSM",21, 0)
	18128	S ARGS("c ommand")=" putPtSubsc ription"
	18129	"RTN","HMP DJFSM",22, 0)
	18130	S ARGS("s erver")=$P (^HMP(8000 00,SRV,0), "^")
	18131	"RTN","HMP DJFSM",23, 0)
	18132	S ARGS("l ocalId")=P AT
	18133	"RTN","HMP DJFSM",24, 0)
	18134	D API^HMP DJFS(.RESU LT,.ARGS)
	18135	"RTN","HMP DJFSM",25, 0)
	18136	I ^TMP("H MPF",$J,1) ["location " W !,$P($ G(^DPT(PAT ,0)),"^"), " is being synced." ; IA10035 , DE2818
	18137	"RTN","HMP DJFSM",26, 0)
	18138	E W !,"S ubscriptio n failed."
	18139	"RTN","HMP DJFSM",27, 0)
	18140	Q
	18141	"RTN","HMP DJFSM",28, 0)
	18142	LOGLVL ; S et log lev el
	18143	"RTN","HMP DJFSM",29, 0)
	18144	N DIR,DTO UT,DUOUT,D IRUT,Y,ERR
	18145	"RTN","HMP DJFSM",30, 0)
	18146	W !,"Set freshness logging le vel."
	18147	"RTN","HMP DJFSM",31, 0)
	18148	W !,"Curr ent level is ",$$GET ^XPAR("ALL ","HMP LOG LEVEL")
	18149	"RTN","HMP DJFSM",32, 0)
	18150	S DIR(0)= "S^0:no lo gging;1:re quest logg ing;2:resp onse loggi ng;C:clear logs"
	18151	"RTN","HMP DJFSM",33, 0)
	18152	D ^DIR
	18153	"RTN","HMP DJFSM",34, 0)
	18154	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T) Q
	18155	"RTN","HMP DJFSM",35, 0)
	18156	I Y="C" K ^XTMP("HM PFLOG") Q
	18157	"RTN","HMP DJFSM",36, 0)
	18158	I Y>0 K ^ XTMP("HMPF LOG")
	18159	"RTN","HMP DJFSM",37, 0)
	18160	D PUT^XPA R("SYS","H MP LOG LEV EL",1,Y,.E RR)
	18161	"RTN","HMP DJFSM",38, 0)
	18162	I $G(ERR) W !,"Erro r saving l og level"
	18163	"RTN","HMP DJFSM",39, 0)
	18164	Q
	18165	"RTN","HMP DJFSM",40, 0)
	18166	THLTH ; te st health
	18167	"RTN","HMP DJFSM",41, 0)
	18168	K ^TMP("H MPF",$J)
	18169	"RTN","HMP DJFSM",42, 0)
	18170	N ARGS,HM PFHMP,HMPS YS,HMPFRSP
	18171	"RTN","HMP DJFSM",43, 0)
	18172	S ARGS("s erver")="T est-Server -1"
	18173	"RTN","HMP DJFSM",44, 0)
	18174	S HMPFRSP =$NA(^TMP( "HMPF",$J) )
	18175	"RTN","HMP DJFSM",45, 0)
	18176	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	18177	"RTN","HMP DJFSM",46, 0)
	18178	S HMPFHMP =$TR($G(AR GS("server ")),"~","= ")
	18179	"RTN","HMP DJFSM",47, 0)
	18180	D HLTHCHK (.ARGS)
	18181	"RTN","HMP DJFSM",48, 0)
	18182	N I S I=0 F S I=$O (^TMP("HMP F",$J,I)) Q:'I W !, ^TMP("HMPF ",$J,I)
	18183	"RTN","HMP DJFSM",49, 0)
	18184	Q
	18185	"RTN","HMP DJFSM",50, 0)
	18186	HLTHCHK(AR GS) ; Chec k health o f VistA Se rver subsc ription
	18187	"RTN","HMP DJFSM",51, 0)
	18188	; expect HMPFRSP, H MPFHMP, HM PSYS to be created b y API^HMPD JFS
	18189	"RTN","HMP DJFSM",52, 0)
	18190	; . ARGS( "server")= HMP Server Id
	18191	"RTN","HMP DJFSM",53, 0)
	18192	; return a list of extracts t hat are cu rrently ac tive
	18193	"RTN","HMP DJFSM",54, 0)
	18194	; {pid="A BCD;229",d omainsComp leted=8,do mainsPendi ng=20,obje ctCount=13 7,
	18195	"RTN","HMP DJFSM",55, 0)
	18196	; subscr ibeTime=20 1406091127 34,extract Status="in itializing "}
	18197	"RTN","HMP DJFSM",56, 0)
	18198	; ^TMP("H MPF",$J,1) =results
	18199	"RTN","HMP DJFSM",57, 0)
	18200	;
	18201	"RTN","HMP DJFSM",58, 0)
	18202	N HMPIEN, STS,TIME,D FN
	18203	"RTN","HMP DJFSM",59, 0)
	18204	S HMPIEN= $O(^HMP(80 0000,"B",H MPFHMP,0))
	18205	"RTN","HMP DJFSM",60, 0)
	18206	I 'HMPIEN D SETERR^ HMPDJFS("S erver not registered ") QUIT
	18207	"RTN","HMP DJFSM",61, 0)
	18208	S NODE=0
	18209	"RTN","HMP DJFSM",62, 0)
	18210	S STS="" F S STS=$ O(^HMP(800 000,HMPIEN ,1,"AP",ST S)) Q:'$L( STS) D
	18211	"RTN","HMP DJFSM",63, 0)
	18212	. S TIME= "" F S TI ME=$O(^HMP (800000,HM PIEN,1,"AP ",STS,TIME )) Q:'$L(T IME) D
	18213	"RTN","HMP DJFSM",64, 0)
	18214	. . S DFN ="" F S D FN=$O(^HMP (800000,HM PIEN,1,"AP ",STS,TIME ,DFN)) Q:' DFN D
	18215	"RTN","HMP DJFSM",65, 0)
	18216	. . . S N ODE=NODE+1
	18217	"RTN","HMP DJFSM",66, 0)
	18218	. . . S ^ TMP("HMPF" ,$J,NODE)= $$HLTHINFO (HMPFHMP,H MPIEN,DFN)
	18219	"RTN","HMP DJFSM",67, 0)
	18220	S ^TMP("H MPF",$J,.5 )=$$HLTHHD R(NODE)
	18221	"RTN","HMP DJFSM",68, 0)
	18222	S ^TMP("H MPF",$J,NO DE+1)="]}} "
	18223	"RTN","HMP DJFSM",69, 0)
	18224	Q
	18225	"RTN","HMP DJFSM",70, 0)
	18226	HLTHINFO(S RV,SRVIEN, DFN) ; Ret urn a stri ng of JSON reporting progress for this d omain
	18227	"RTN","HMP DJFSM",71, 0)
	18228	; {pid,do mainsCompl eted,domai nsPending, objectCoun t,queuedTi me,phase(w aiting,ext racting)
	18229	"RTN","HMP DJFSM",72, 0)
	18230	N BATCH,Q TIME,DONE, PEND,CNT,D OM,INFO,ST S,JSON
	18231	"RTN","HMP DJFSM",73, 0)
	18232	S BATCH=" HMPFX~"_SR V_"~"_DFN
	18233	"RTN","HMP DJFSM",74, 0)
	18234	S QTIME=$ G(^XTMP(BA TCH,0,"tim e")) S:$L( QTIME) QTI ME=$$HTFM^ XLFDT(QTIM E)
	18235	"RTN","HMP DJFSM",75, 0)
	18236	S DONE=0, PEND=0,CNT =0
	18237	"RTN","HMP DJFSM",76, 0)
	18238	S DOM="" F S DOM=$ O(^XTMP(BA TCH,0,"sta tus",DOM)) Q:DOM="" D
	18239	"RTN","HMP DJFSM",77, 0)
	18240	. S CNT=C NT+$G(^XTM P(BATCH,0, "count",DO M))
	18241	"RTN","HMP DJFSM",78, 0)
	18242	. I $G(^X TMP(BATCH, 0,"status" ,DOM)) S D ONE=DONE+1 QUIT
	18243	"RTN","HMP DJFSM",79, 0)
	18244	. S PEND= PEND+1
	18245	"RTN","HMP DJFSM",80, 0)
	18246	S INFO("p id")=$$PID ^HMPDJFS(D FN)
	18247	"RTN","HMP DJFSM",81, 0)
	18248	S INFO("d omainsComp leted")=DO NE
	18249	"RTN","HMP DJFSM",82, 0)
	18250	S INFO("d omainsPend ing")=PEND
	18251	"RTN","HMP DJFSM",83, 0)
	18252	S INFO("o bjectCount ")=CNT
	18253	"RTN","HMP DJFSM",84, 0)
	18254	I $L(QTIM E) S INFO( "queuedTim e")=$P($$F MTHL7^XLFD T(QTIME)," -")
	18255	"RTN","HMP DJFSM",85, 0)
	18256	S STS=$P( $G(^HMP(80 0000,SRVIE N,1,DFN,0) ),"^",2)
	18257	"RTN","HMP DJFSM",86, 0)
	18258	S INFO("e xtractStat us")=$S(ST S=1:"initi alizing",S TS=2:"init ialized",1 :"uninitia lized")
	18259	"RTN","HMP DJFSM",87, 0)
	18260	D ENCODE^ HMPJSON("I NFO","JSON ")
	18261	"RTN","HMP DJFSM",88, 0)
	18262	Q JSON(1)
	18263	"RTN","HMP DJFSM",89, 0)
	18264	;
	18265	"RTN","HMP DJFSM",90, 0)
	18266	HLTHHDR(CO UNT) ; ret urn JSON
	18267	"RTN","HMP DJFSM",91, 0)
	18268	; expects HMPFSYS
	18269	"RTN","HMP DJFSM",92, 0)
	18270	N X
	18271	"RTN","HMP DJFSM",93, 0)
	18272	S X="{""a piVersion" ":1.02,""p arams"":{" "domain"": """_$$KSP^ XUPARAM("W HERE")_""" "
	18273	"RTN","HMP DJFSM",94, 0)
	18274	S X=X_"," "systemId" ":"""_HMPS YS_"""},"" data"":{"" updated"": """_$$HL7N OW^HMPDJ_" """
	18275	"RTN","HMP DJFSM",95, 0)
	18276	S X=X_"," "totalItem s"":"_COUN T
	18277	"RTN","HMP DJFSM",96, 0)
	18278	S X=X_"," "items"":[ "
	18279	"RTN","HMP DJFSM",97, 0)
	18280	Q X
	18281	"RTN","HMP DJFSM",98, 0)
	18282	;
	18283	"RTN","HMP DJFSM",99, 0)
	18284	LOOP(SRV) ; Monitor refresh lo op
	18285	"RTN","HMP DJFSM",100 ,0)
	18286	D HOME^%Z IS
	18287	"RTN","HMP DJFSM",101 ,0)
	18288	N ACT,IEN
	18289	"RTN","HMP DJFSM",102 ,0)
	18290	S ACT="R" F D Q:" RV"'[ACT
	18291	"RTN","HMP DJFSM",103 ,0)
	18292	. I ACT=" R" D SHOWM AIN(SRV)
	18293	"RTN","HMP DJFSM",104 ,0)
	18294	. I ACT=" V" D SHOWH MPN
	18295	"RTN","HMP DJFSM",105 ,0)
	18296	. W ! S A CT=$$GETCM D
	18297	"RTN","HMP DJFSM",106 ,0)
	18298	Q
	18299	"RTN","HMP DJFSM",107 ,0)
	18300	GETSRV() ; Return th e IEN for the server to monito r
	18301	"RTN","HMP DJFSM",108 ,0)
	18302	N DIC,Y
	18303	"RTN","HMP DJFSM",109 ,0)
	18304	S DIC="^H MP(800000, ",DIC(0)=" AEMQ",DIC( "A")="Sele ct HMP ser ver instan ce: "
	18305	"RTN","HMP DJFSM",110 ,0)
	18306	D ^DIC
	18307	"RTN","HMP DJFSM",111 ,0)
	18308	Q +Y
	18309	"RTN","HMP DJFSM",112 ,0)
	18310	;
	18311	"RTN","HMP DJFSM",113 ,0)
	18312	GETPAT() ; Return DF N for a pa tient
	18313	"RTN","HMP DJFSM",114 ,0)
	18314	N DIC,Y
	18315	"RTN","HMP DJFSM",115 ,0)
	18316	S DIC=2,D IC(0)="AEM Q" ; DE28 18, change d to file number, no t global
	18317	"RTN","HMP DJFSM",116 ,0)
	18318	D ^DIC
	18319	"RTN","HMP DJFSM",117 ,0)
	18320	Q +Y
	18321	"RTN","HMP DJFSM",118 ,0)
	18322	;
	18323	"RTN","HMP DJFSM",119 ,0)
	18324	GETCMD() ; Get the n ext comman d
	18325	"RTN","HMP DJFSM",120 ,0)
	18326	N X,Y,DIR ,DTOUT,DUO UT,DIRUT,D IROUT
	18327	"RTN","HMP DJFSM",121 ,0)
	18328	S DIR(0)= "SB^R:Refr esh;V:View HMP Nodes ;Q:Quit"
	18329	"RTN","HMP DJFSM",122 ,0)
	18330	S DIR("B" )="Refresh "
	18331	"RTN","HMP DJFSM",123 ,0)
	18332	D ^DIR
	18333	"RTN","HMP DJFSM",124 ,0)
	18334	I $D(DIRU T)!$D(DIRO UT) S Y="Q "
	18335	"RTN","HMP DJFSM",125 ,0)
	18336	Q Y
	18337	"RTN","HMP DJFSM",126 ,0)
	18338	;
	18339	"RTN","HMP DJFSM",127 ,0)
	18340	SHOWHMPN ; Show HMP global nod es
	18341	"RTN","HMP DJFSM",128 ,0)
	18342	W !!,"Cur rent HMP t emporary n odes",?40, "High Nume ric or Las t Subscrip t",!
	18343	"RTN","HMP DJFSM",129 ,0)
	18344	N X,Y,J
	18345	"RTN","HMP DJFSM",130 ,0)
	18346	S X="VPQ~ " F S X=$ O(^XTMP(X) ) Q:$E(X,1 ,3)'="HMP" D
	18347	"RTN","HMP DJFSM",131 ,0)
	18348	. W !,"^X TMP("""_X_ """)"
	18349	"RTN","HMP DJFSM",132 ,0)
	18350	. S Y=$O( ^XTMP(X," "),-1) S:' $L(Y) Y=$O (^XTMP(X," "),-1) W ? 40,Y
	18351	"RTN","HMP DJFSM",133 ,0)
	18352	W !
	18353	"RTN","HMP DJFSM",134 ,0)
	18354	S X="VPQ~ " F S X=$ O(^TMP(X)) Q:$E(X,1, 3)'="HMP" D
	18355	"RTN","HMP DJFSM",135 ,0)
	18356	. S J=0 F S J=$O(^ TMP(X,J)) Q:'J D
	18357	"RTN","HMP DJFSM",136 ,0)
	18358	. . W !," ^TMP("""_X _""","_J_" )"
	18359	"RTN","HMP DJFSM",137 ,0)
	18360	. . S Y=$ O(^TMP(X,J ," "),-1) S:'$L(Y) Y =$O(^TMP(X ,J,""),-1) W ?40,Y
	18361	"RTN","HMP DJFSM",138 ,0)
	18362	S J=0 F S J=$O(^TM P(J)) Q:'J D
	18363	"RTN","HMP DJFSM",139 ,0)
	18364	. S X="VP Q~" F S X =$O(^TMP(J ,X)) Q:$E( X,1,3)'="H MP" D
	18365	"RTN","HMP DJFSM",140 ,0)
	18366	. . W !," ^TMP("_J_" ,"""_X_""" )"
	18367	"RTN","HMP DJFSM",141 ,0)
	18368	. . S Y=$ O(^TMP(J,X ," "),-1) S:'$L(Y) Y =$O(^TMP(J ,X,""),-1) W ?40,Y
	18369	"RTN","HMP DJFSM",142 ,0)
	18370	Q
	18371	"RTN","HMP DJFSM",143 ,0)
	18372	SHOWMAIN(S RV) ; Show main info rmation fo r server
	18373	"RTN","HMP DJFSM",144 ,0)
	18374	N STREAM
	18375	"RTN","HMP DJFSM",145 ,0)
	18376	S STREAM= $$LSTREAM( SRV)
	18377	"RTN","HMP DJFSM",146 ,0)
	18378	W @IOF
	18379	"RTN","HMP DJFSM",147 ,0)
	18380	W !,$$HTE ^XLFDT($H) ,?64,"Slot s Open: ", $$SLOTS,!
	18381	"RTN","HMP DJFSM",148 ,0)
	18382	I STREAM= "" W !,"No HMP extra ct stream found." Q
	18383	"RTN","HMP DJFSM",149 ,0)
	18384	D SHOWSRV (SRV)
	18385	"RTN","HMP DJFSM",150 ,0)
	18386	D LJOBS(S RV)
	18387	"RTN","HMP DJFSM",151 ,0)
	18388	D LQUEUE( SRV,10)
	18389	"RTN","HMP DJFSM",152 ,0)
	18390	Q
	18391	"RTN","HMP DJFSM",153 ,0)
	18392	SHOWSRV(IE N) ; Show informatio n for a se rver
	18393	"RTN","HMP DJFSM",154 ,0)
	18394	N X0,ROOT ,BATCH,STR EAM,SRVNM, LASTUP,REP EAT,TASK,T ASKS
	18395	"RTN","HMP DJFSM",155 ,0)
	18396	S X0=^HMP (800000,IE N,0)
	18397	"RTN","HMP DJFSM",156 ,0)
	18398	S SRVNM=$ P(X0,"^"), LASTUP=$P( X0,"^",2), REPEAT=$P( X0,"^",4)
	18399	"RTN","HMP DJFSM",157 ,0)
	18400	S STREAM= $$LSTREAM( IEN)
	18401	"RTN","HMP DJFSM",158 ,0)
	18402	W !,SRVNM ,?30,"Last Update: " ,LASTUP W: REPEAT " x",REPEAT
	18403	"RTN","HMP DJFSM",159 ,0)
	18404	I $D(^XTM P(STREAM)) D
	18405	"RTN","HMP DJFSM",160 ,0)
	18406	. W !,?29 ,"End of Q ueue: ",$P (STREAM,"~ ",3),"-",$ G(^XTMP(ST REAM,"last "))
	18407	"RTN","HMP DJFSM",161 ,0)
	18408	; loop th ru extract s for this server
	18409	"RTN","HMP DJFSM",162 ,0)
	18410	S ROOT="H MPFX~"_SRV NM_"~",BAT CH=ROOT
	18411	"RTN","HMP DJFSM",163 ,0)
	18412	S BATCH=R OOT F S B ATCH=$O(^X TMP(BATCH) ) Q:$E(BAT CH,1,$L(RO OT))'=ROOT D
	18413	"RTN","HMP DJFSM",164 ,0)
	18414	. W !,$J( $P(BATCH," ~",3),12)
	18415	"RTN","HMP DJFSM",165 ,0)
	18416	. S TASK= 0,TASKS=""
	18417	"RTN","HMP DJFSM",166 ,0)
	18418	. F S TA SK=$O(^XTM P(BATCH,0, "task",TAS K)) Q:'TAS K S TASKS =TASKS_$S( $L(TASKS): ",",1:"")_ TASK
	18419	"RTN","HMP DJFSM",167 ,0)
	18420	. W ?14," Task(s)"_T ASKS
	18421	"RTN","HMP DJFSM",168 ,0)
	18422	. I '$D(^ XTMP(BATCH ,0,"wait") ) W ?34,"w aiting: ", $$WAIT(BAT CH)," seco nds" Q
	18423	"RTN","HMP DJFSM",169 ,0)
	18424	. W ?31," extracting : ",$$LOBJ (BATCH,TAS K)
	18425	"RTN","HMP DJFSM",170 ,0)
	18426	Q
	18427	"RTN","HMP DJFSM",171 ,0)
	18428	WAIT(BATCH ) ; Return the numbe r of secon ds the bat ch has bee n waiting
	18429	"RTN","HMP DJFSM",172 ,0)
	18430	N START
	18431	"RTN","HMP DJFSM",173 ,0)
	18432	S START=$ G(^XTMP(BA TCH,0,"tim e")) Q:'ST ART 0
	18433	"RTN","HMP DJFSM",174 ,0)
	18434	Q $$HDIFF ^XLFDT($H, START,2)
	18435	"RTN","HMP DJFSM",175 ,0)
	18436	;
	18437	"RTN","HMP DJFSM",176 ,0)
	18438	LOBJ(BATCH ,TASK) ; R eturn the last domai n>count re trieved fo r this bat ch
	18439	"RTN","HMP DJFSM",177 ,0)
	18440	Q:'TASK " no task"
	18441	"RTN","HMP DJFSM",178 ,0)
	18442	N LASTITM ,DOMAIN,NU M
	18443	"RTN","HMP DJFSM",179 ,0)
	18444	S LASTITM =""
	18445	"RTN","HMP DJFSM",180 ,0)
	18446	S DOMAIN= "",LASTITM =""
	18447	"RTN","HMP DJFSM",181 ,0)
	18448	F S DOMA IN=$O(^XTM P(BATCH,0, "status",D OMAIN)) Q: '$L(DOMAIN ) D Q:$L (LASTITM)
	18449	"RTN","HMP DJFSM",182 ,0)
	18450	. I $G(^X TMP(BATCH, 0,"status" ,DOMAIN)) Q ; domai n complete
	18451	"RTN","HMP DJFSM",183 ,0)
	18452	. S NUM=$ O(^XTMP(BA TCH,TASK,D OMAIN,""), -1)
	18453	"RTN","HMP DJFSM",184 ,0)
	18454	. S LASTI TM=DOMAIN_ $S(NUM:" # "_NUM,1:"" )
	18455	"RTN","HMP DJFSM",185 ,0)
	18456	Q $S('$L( LASTITM):" <finished> ",1:LASTIT M)
	18457	"RTN","HMP DJFSM",186 ,0)
	18458	;
	18459	"RTN","HMP DJFSM",187 ,0)
	18460	SLOTS() ; Return the number of slots ava ilable
	18461	"RTN","HMP DJFSM",188 ,0)
	18462	N OUT
	18463	"RTN","HMP DJFSM",189 ,0)
	18464	D FIND^DI C(3.54,"", "1","BX"," HMP EXTRAC T RESOURCE ","","","" ,"","OUT")
	18465	"RTN","HMP DJFSM",190 ,0)
	18466	Q $G(OUT( "DILIST"," ID",1,1))
	18467	"RTN","HMP DJFSM",191 ,0)
	18468	;
	18469	"RTN","HMP DJFSM",192 ,0)
	18470	LJOBS(SRV) ; Show jo bs polling in this s tream
	18471	"RTN","HMP DJFSM",193 ,0)
	18472	N STREAM, JOBLIST,JO BNUM,JOBNA ,X,Y
	18473	"RTN","HMP DJFSM",194 ,0)
	18474	S STREAM= $$LSTREAM( SRV),JOBLI ST="",JOBN A=0
	18475	"RTN","HMP DJFSM",195 ,0)
	18476	S JOBNUM= "" F S JO BNUM=$O(^X TMP(STREAM ,"job",JOB NUM)) Q:'J OBNUM D
	18477	"RTN","HMP DJFSM",196 ,0)
	18478	. ; check if job is still act ive
	18479	"RTN","HMP DJFSM",197 ,0)
	18480	. S X=JOB NUM X ^%ZO SF("JOBPAR AM") I '$L (Y) S JOBN A=JOBNA+1 QUIT ; ch eck if job active
	18481	"RTN","HMP DJFSM",198 ,0)
	18482	. S JOBLI ST=JOBLIST _$S($L(JOB LIST):", " ,1:"")_JOB NUM
	18483	"RTN","HMP DJFSM",199 ,0)
	18484	W !!,"Pol ling job n umber(s): "_JOBLIST
	18485	"RTN","HMP DJFSM",200 ,0)
	18486	I JOBNA W " ("_JOB NA_" no lo nger activ e)"
	18487	"RTN","HMP DJFSM",201 ,0)
	18488	Q
	18489	"RTN","HMP DJFSM",202 ,0)
	18490	LQUEUE(SRV ,MAX) ; Sh ow last MA X items in freshness queue
	18491	"RTN","HMP DJFSM",203 ,0)
	18492	W !!,"Las t items in the queue ---"
	18493	"RTN","HMP DJFSM",204 ,0)
	18494	N CNT,SEQ ,LIST,STRE AM
	18495	"RTN","HMP DJFSM",205 ,0)
	18496	S STREAM= $$LSTREAM( SRV)
	18497	"RTN","HMP DJFSM",206 ,0)
	18498	S CNT=0,S EQ=" " ; r everse fro m space to get numer ic entries
	18499	"RTN","HMP DJFSM",207 ,0)
	18500	F S SEQ= $O(^XTMP(S TREAM,SEQ) ,-1) Q:'SE Q D Q:CN T>9
	18501	"RTN","HMP DJFSM",208 ,0)
	18502	. S CNT=C NT+1
	18503	"RTN","HMP DJFSM",209 ,0)
	18504	. S LIST( SEQ)=^XTMP (STREAM,SE Q)
	18505	"RTN","HMP DJFSM",210 ,0)
	18506	S SEQ="" F S SEQ=$ O(LIST(SEQ )) Q:'SEQ W !,SEQ,? 8,LIST(SEQ )
	18507	"RTN","HMP DJFSM",211 ,0)
	18508	Q
	18509	"RTN","HMP DJFSM",212 ,0)
	18510	LSTREAM(SR V) ; Retur n the late st stream for this s erver
	18511	"RTN","HMP DJFSM",213 ,0)
	18512	N STREAM
	18513	"RTN","HMP DJFSM",214 ,0)
	18514	S STREAM= "HMPFS~"_$ P($G(^HMP( 800000,SRV ,0)),"^")_ "~9999999"
	18515	"RTN","HMP DJFSM",215 ,0)
	18516	S STREAM= $O(^XTMP(S TREAM),-1)
	18517	"RTN","HMP DJFSM",216 ,0)
	18518	Q STREAM
	18519	"RTN","HMP DJFSM",217 ,0)
	18520	;
	18521	"RTN","HMP DJFSM",218 ,0)
	18522	EMERSTOP ; Emergency Stop for Freshness
	18523	"RTN","HMP DJFSM",219 ,0)
	18524	D SETFRUP (0)
	18525	"RTN","HMP DJFSM",220 ,0)
	18526	Q
	18527	"RTN","HMP DJFSM",221 ,0)
	18528	RSTRTFR ; Re-start f reshness u pdates
	18529	"RTN","HMP DJFSM",222 ,0)
	18530	D SETFRUP (1)
	18531	"RTN","HMP DJFSM",223 ,0)
	18532	Q
	18533	"RTN","HMP DJFSM",224 ,0)
	18534	SETFRUP(ST ART) ; Set flag for freshness updates
	18535	"RTN","HMP DJFSM",225 ,0)
	18536	I 'START D
	18537	"RTN","HMP DJFSM",226 ,0)
	18538	. W !,"WA RNING! Th is will st op freshne ss updates for the H MP."
	18539	"RTN","HMP DJFSM",227 ,0)
	18540	. W !," It will be n ecessary t o re-synch patient d ata.",!
	18541	"RTN","HMP DJFSM",228 ,0)
	18542	I START D
	18543	"RTN","HMP DJFSM",229 ,0)
	18544	. W !,"Th is will -- RESUME-- f reshness u pdates for the HMP."
	18545	"RTN","HMP DJFSM",230 ,0)
	18546	. W !,"It may be ne cessary to re-synch patient an d operatio nal data." ,!
	18547	"RTN","HMP DJFSM",231 ,0)
	18548	N TYPLST, ALPHA,I,TY PE
	18549	"RTN","HMP DJFSM",232 ,0)
	18550	D EVNTYPS (.TYPLST)
	18551	"RTN","HMP DJFSM",233 ,0)
	18552	S I=0 F S I=$O(TYP LST(I)) Q: 'I S ALPH A(TYPLST(I ))=""
	18553	"RTN","HMP DJFSM",234 ,0)
	18554	S TYPE=$$ GETFTYP(.A LPHA,START )
	18555	"RTN","HMP DJFSM",235 ,0)
	18556	Q:TYPE=""
	18557	"RTN","HMP DJFSM",236 ,0)
	18558	I TYPE="* " D Q
	18559	"RTN","HMP DJFSM",237 ,0)
	18560	. S TYPE= "" F S TY PE=$O(ALPH A(TYPE)) Q :TYPE="" D CHGFTYP( TYPE,START )
	18561	"RTN","HMP DJFSM",238 ,0)
	18562	D CHGFTYP (TYPE,STAR T)
	18563	"RTN","HMP DJFSM",239 ,0)
	18564	Q
	18565	"RTN","HMP DJFSM",240 ,0)
	18566	CHGFTYP(TY PE,START) ; Change t he freshne ss update flag for a type
	18567	"RTN","HMP DJFSM",241 ,0)
	18568	I START D STRTFTYP( TYPE) Q
	18569	"RTN","HMP DJFSM",242 ,0)
	18570	; otherwi se
	18571	"RTN","HMP DJFSM",243 ,0)
	18572	D STOPFTY P(TYPE)
	18573	"RTN","HMP DJFSM",244 ,0)
	18574	Q
	18575	"RTN","HMP DJFSM",245 ,0)
	18576	STOPFTYP(T YPE) ; Sto p freshnes s updates for type
	18577	"RTN","HMP DJFSM",246 ,0)
	18578	I '$D(^XT MP("HMP-of f",0)) D N EWXTMP^HMP DJFS("HMP- off",999," Switch off HMP fresh ness updat es")
	18579	"RTN","HMP DJFSM",247 ,0)
	18580	W !,"Stop ping fresh ness updat es for: ", TYPE
	18581	"RTN","HMP DJFSM",248 ,0)
	18582	S ^XTMP(" HMP-off",T YPE)=1
	18583	"RTN","HMP DJFSM",249 ,0)
	18584	Q
	18585	"RTN","HMP DJFSM",250 ,0)
	18586	STRTFTYP(T YPE) ; Res ume freshn ess update s for type
	18587	"RTN","HMP DJFSM",251 ,0)
	18588	W !,"Resu ming fresh ness updat es for: ", TYPE
	18589	"RTN","HMP DJFSM",252 ,0)
	18590	K ^XTMP(" HMP-off",T YPE)
	18591	"RTN","HMP DJFSM",253 ,0)
	18592	Q
	18593	"RTN","HMP DJFSM",254 ,0)
	18594	GETFTYP(AL PHA,START) ; Return item from the list
	18595	"RTN","HMP DJFSM",255 ,0)
	18596	N X,T,P
	18597	"RTN","HMP DJFSM",256 ,0)
	18598	S P=$S(ST ART:"start ",1:"stop" )
	18599	"RTN","HMP DJFSM",257 ,0)
	18600	F D Q:X '["?"
	18601	"RTN","HMP DJFSM",258 ,0)
	18602	. D SHOWF TYP(.ALPHA )
	18603	"RTN","HMP DJFSM",259 ,0)
	18604	. W !!,"C hoose doma in to "_P_ " (* "_P_" s all): "
	18605	"RTN","HMP DJFSM",260 ,0)
	18606	. R X:300 S:$E(X)=" ^" X="" Q: X="" Q:X= "*"
	18607	"RTN","HMP DJFSM",261 ,0)
	18608	. S X=$$L OW^XLFSTR( X)
	18609	"RTN","HMP DJFSM",262 ,0)
	18610	. Q:$D(AL PHA(X))
	18611	"RTN","HMP DJFSM",263 ,0)
	18612	. S T=$O( ALPHA(X))
	18613	"RTN","HMP DJFSM",264 ,0)
	18614	. I X=$E( T,1,$L(X)) W " ",T S X=T Q
	18615	"RTN","HMP DJFSM",265 ,0)
	18616	. W " ?? ",! S X="? "
	18617	"RTN","HMP DJFSM",266 ,0)
	18618	Q X
	18619	"RTN","HMP DJFSM",267 ,0)
	18620	;
	18621	"RTN","HMP DJFSM",268 ,0)
	18622	SHOWFTYP(A LPHA) ; Sh ow freshne ss types
	18623	"RTN","HMP DJFSM",269 ,0)
	18624	N I,X,P
	18625	"RTN","HMP DJFSM",270 ,0)
	18626	S I=0,X=" " F S X=$ O(ALPHA(X) ) Q:'$L(X) D
	18627	"RTN","HMP DJFSM",271 ,0)
	18628	. S I=I+1 ,P=I#3
	18629	"RTN","HMP DJFSM",272 ,0)
	18630	. W:P=1 ! ,X
	18631	"RTN","HMP DJFSM",273 ,0)
	18632	. W:P=2 ? 26,X
	18633	"RTN","HMP DJFSM",274 ,0)
	18634	. W:P=0 ? 52,X
	18635	"RTN","HMP DJFSM",275 ,0)
	18636	Q
	18637	"RTN","HMP DJFSM",276 ,0)
	18638	EVNTYPS(LI ST) ; load event typ es
	18639	"RTN","HMP DJFSM",277 ,0)
	18640	;;allergy
	18641	"RTN","HMP DJFSM",278 ,0)
	18642	;;med
	18643	"RTN","HMP DJFSM",279 ,0)
	18644	;;auxilia ry
	18645	"RTN","HMP DJFSM",280 ,0)
	18646	;;appoint ment
	18647	"RTN","HMP DJFSM",281 ,0)
	18648	;;diagnos is
	18649	"RTN","HMP DJFSM",282 ,0)
	18650	;;documen t
	18651	"RTN","HMP DJFSM",283 ,0)
	18652	;;factor
	18653	"RTN","HMP DJFSM",284 ,0)
	18654	;;immuniz ation
	18655	"RTN","HMP DJFSM",285 ,0)
	18656	;;lab
	18657	"RTN","HMP DJFSM",286 ,0)
	18658	;;obs
	18659	"RTN","HMP DJFSM",287 ,0)
	18660	;;order
	18661	"RTN","HMP DJFSM",288 ,0)
	18662	;;problem
	18663	"RTN","HMP DJFSM",289 ,0)
	18664	;;procedu re
	18665	"RTN","HMP DJFSM",290 ,0)
	18666	;;consult
	18667	"RTN","HMP DJFSM",291 ,0)
	18668	;;image
	18669	"RTN","HMP DJFSM",292 ,0)
	18670	;;surgery
	18671	"RTN","HMP DJFSM",293 ,0)
	18672	;;task
	18673	"RTN","HMP DJFSM",294 ,0)
	18674	;;visit
	18675	"RTN","HMP DJFSM",295 ,0)
	18676	;;vital
	18677	"RTN","HMP DJFSM",296 ,0)
	18678	;;mh
	18679	"RTN","HMP DJFSM",297 ,0)
	18680	;;ptf
	18681	"RTN","HMP DJFSM",298 ,0)
	18682	;;exam
	18683	"RTN","HMP DJFSM",299 ,0)
	18684	;;cpt
	18685	"RTN","HMP DJFSM",300 ,0)
	18686	;;educati on
	18687	"RTN","HMP DJFSM",301 ,0)
	18688	;;pov
	18689	"RTN","HMP DJFSM",302 ,0)
	18690	;;skin
	18691	"RTN","HMP DJFSM",303 ,0)
	18692	;;treatme nt
	18693	"RTN","HMP DJFSM",304 ,0)
	18694	;;roadtri p
	18695	"RTN","HMP DJFSM",305 ,0)
	18696	;;diet
	18697	"RTN","HMP DJFSM",306 ,0)
	18698	;;pt-sele ct
	18699	"RTN","HMP DJFSM",307 ,0)
	18700	;;patient
	18701	"RTN","HMP DJFSM",308 ,0)
	18702	;;roster
	18703	"RTN","HMP DJFSM",309 ,0)
	18704	;;user
	18705	"RTN","HMP DJFSM",310 ,0)
	18706	;;zzzzz
	18707	"RTN","HMP DJFSM",311 ,0)
	18708	N I,X
	18709	"RTN","HMP DJFSM",312 ,0)
	18710	F I=1:1 S X=$P($T(E VNTYPS+I), ";;",2,99) Q:X="zzzz z" S LIST (I)=X
	18711	"RTN","HMP DJFSM",313 ,0)
	18712	Q
	18713	"RTN","HMP DJFSM",314 ,0)
	18714	;
	18715	"RTN","HMP DJFSP")
	18716	0^52^B2283 47665
	18717	"RTN","HMP DJFSP",1,0 )
	18718	HMPDJFSP ; SLC/KCM,AS MR/RRB -- PUT/POST f or Extract and Fresh ness Strea m;Nov 04, 2015 17:46 :48
	18719	"RTN","HMP DJFSP",2,0 )
	18720	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	18721	"RTN","HMP DJFSP",3,0 )
	18722	;Per VA D irective 6 402, this routine sh ould not b e modified .
	18723	"RTN","HMP DJFSP",4,0 )
	18724	;
	18725	"RTN","HMP DJFSP",5,0 )
	18726	; DE2818/ RRB: SQA f indings 1s t 3 lines
	18727	"RTN","HMP DJFSP",6,0 )
	18728	Q
	18729	"RTN","HMP DJFSP",7,0 )
	18730	;
	18731	"RTN","HMP DJFSP",8,0 )
	18732	; --- cre ate a new patient su bscription
	18733	"RTN","HMP DJFSP",9,0 )
	18734	;
	18735	"RTN","HMP DJFSP",10, 0)
	18736	PUTSUB(ARG S) ; retur n location after cre ating a ne w subscrip tion
	18737	"RTN","HMP DJFSP",11, 0)
	18738	; fn ret urns : /hmp/sub scription/ {hmpSrvId} /patient/{ sysId;dfn}
	18739	"RTN","HMP DJFSP",12, 0)
	18740	; : "" if er ror, error s in ^TMP( "HMPFERR", $J)
	18741	"RTN","HMP DJFSP",13, 0)
	18742	; .ARGS(" server") : name of HMP server
	18743	"RTN","HMP DJFSP",14, 0)
	18744	; .ARGS(" localId") : dfn for patient to subscribe or "OPD" (operation al data)
	18745	"RTN","HMP DJFSP",15, 0)
	18746	; .ARGS(" icn") : icn for patient to subscribe
	18747	"RTN","HMP DJFSP",16, 0)
	18748	; .ARGS(" domains") : optional array of domains to initializ e (depreca ted)
	18749	"RTN","HMP DJFSP",17, 0)
	18750	;
	18751	"RTN","HMP DJFSP",18, 0)
	18752	I '$$TM^% ZTLOAD D S ETERR^HMPD JFS("Taskm an not run ning") Q " "
	18753	"RTN","HMP DJFSP",19, 0)
	18754	;
	18755	"RTN","HMP DJFSP",20, 0)
	18756	N HMPSRV, HMPFDFN,HM PBATCH,HMP FERR,I,NEW SUB,DOMAIN S,HMPSVERS ,HMPSTMP
	18757	"RTN","HMP DJFSP",21, 0)
	18758	;
	18759	"RTN","HMP DJFSP",22, 0)
	18760	; make su re we can identify t he patient ("OPD" si gnals sync operation al)
	18761	"RTN","HMP DJFSP",23, 0)
	18762	S HMPFDFN =$G(ARGS(" localId"))
	18763	"RTN","HMP DJFSP",24, 0)
	18764	S HMPSVER S=+$G(ARGS ("HMPSVERS ")) ;US110 19 get syn c version
	18765	"RTN","HMP DJFSP",25, 0)
	18766	I HMPFDFN '="OPD" D Q:$G(HMPF ERR) ""
	18767	"RTN","HMP DJFSP",26, 0)
	18768	. I '$L(H MPFDFN),$L (ARGS("icn ")) S HMPF DFN=+$$GET DFN^MPIF00 1(ARGS("ic n"))
	18769	"RTN","HMP DJFSP",27, 0)
	18770	. I 'HMPF DFN D SETE RR^HMPDJFS ("No patie nt specifi ed") Q
	18771	"RTN","HMP DJFSP",28, 0)
	18772	. I '$D(^ DPT(HMPFDF N)) D SETE RR^HMPDJFS ("Patient not found" ) ; IA 10 035, DE281 8
	18773	"RTN","HMP DJFSP",29, 0)
	18774	;
	18775	"RTN","HMP DJFSP",30, 0)
	18776	; make su re server is known a nd create batch id
	18777	"RTN","HMP DJFSP",31, 0)
	18778	S HMPSRV= HMPFHMP ; TODO: swi tch to HMP FHMP as se rver ien
	18779	"RTN","HMP DJFSP",32, 0)
	18780	I '$L(HMP SRV) D SET ERR^HMPDJF S("Missing HMP Serve r ID") Q " "
	18781	"RTN","HMP DJFSP",33, 0)
	18782	S HMPSRV( "ien")=$O( ^HMP(80000 0,"B",HMPS RV,0))
	18783	"RTN","HMP DJFSP",34, 0)
	18784	I 'HMPSRV ("ien") D SETERR^HMP DJFS("HMP Server not registere d") Q ""
	18785	"RTN","HMP DJFSP",35, 0)
	18786	S HMPBATC H="HMPFX~" _HMPSRV_"~ "_HMPFDFN
	18787	"RTN","HMP DJFSP",36, 0)
	18788	;
	18789	"RTN","HMP DJFSP",37, 0)
	18790	; set up domains to extract
	18791	"RTN","HMP DJFSP",38, 0)
	18792	D @($S(HM PFDFN="OPD ":"OPDOMS" ,1:"PTDOMS ")_"^HMPDJ FSD(.DOMAI NS)")
	18793	"RTN","HMP DJFSP",39, 0)
	18794	;
	18795	"RTN","HMP DJFSP",40, 0)
	18796	; ejk US5 647
	18797	"RTN","HMP DJFSP",41, 0)
	18798	; code be low restor es selecti ve domain functional ity.
	18799	"RTN","HMP DJFSP",42, 0)
	18800	; once th e complete list of d omains is returned f rom HMPDJF SD,
	18801	"RTN","HMP DJFSP",43, 0)
	18802	; if ARGS ("domains" ) is passe d in, anyt hing not i n that par ameter
	18803	"RTN","HMP DJFSP",44, 0)
	18804	; will be excluded from the O DS extract .
	18805	"RTN","HMP DJFSP",45, 0)
	18806	I $G(ARGS ("domains" ))'="" D
	18807	"RTN","HMP DJFSP",46, 0)
	18808	.F I=1:1 Q:'$D(DOMA INS(I)) I ARGS("dom ains")'[DO MAINS(I) K DOMAINS(I )
	18809	"RTN","HMP DJFSP",47, 0)
	18810	;
	18811	"RTN","HMP DJFSP",48, 0)
	18812	; see if this is ne w subscrip tion and t ask extrac t if new
	18813	"RTN","HMP DJFSP",49, 0)
	18814	D SETPAT( HMPFDFN,HM PSRV,.NEWS UB) Q:$G(H MPFERR) ""
	18815	"RTN","HMP DJFSP",50, 0)
	18816	;For oper ational da ta set sta mptime as time subsc ription pl aced US673 4
	18817	"RTN","HMP DJFSP",51, 0)
	18818	S HMPSTMP =$$EN^HMPS TMP("NOW") ;DE3377
	18819	"RTN","HMP DJFSP",52, 0)
	18820	;
	18821	"RTN","HMP DJFSP",53, 0)
	18822	;cpc US11 019 follow ing chunk of code mo ved out of QUINIT as was being called mu ltiple tim es
	18823	"RTN","HMP DJFSP",54, 0)
	18824	;US11019 get array of job ids by domain
	18825	"RTN","HMP DJFSP",55, 0)
	18826	; only do ne once wh en beginni ng the bat ch, no mat ter how ma ny tasked jobs
	18827	"RTN","HMP DJFSP",56, 0)
	18828	L +^XTMP( HMPBATCH): 5 E D SET ERR^HMPDJF S("Cannot lock batch :"_HMPBATC H) QUIT
	18829	"RTN","HMP DJFSP",57, 0)
	18830	I '$D(^XT MP(HMPBATC H)) D
	18831	"RTN","HMP DJFSP",58, 0)
	18832	. D NEWXT MP^HMPDJFS (HMPBATCH, 2,"HMP Pat ient Extra ct")
	18833	"RTN","HMP DJFSP",59, 0)
	18834	. ;US1101 9 - store domain spe cific job ids
	18835	"RTN","HMP DJFSP",60, 0)
	18836	. N EMPB S EMPB="jo bDomainId- " ;US11019
	18837	"RTN","HMP DJFSP",61, 0)
	18838	. F S EM PB=$O(ARGS (EMPB)) Q: EMPB="" Q :EMPB'["jo bDomainId- " S:'HMPS VERS HMPSV ERS=1 S ^X TMP(HMPBAT CH,"JOBID" ,$P(EMPB," jobDomainI d-",2))=AR GS(EMPB) ; US11019 3 rd version
	18839	"RTN","HMP DJFSP",62, 0)
	18840	. S ^XTMP (HMPBATCH, "HMPSVERS" )=HMPSVERS ;US11019 store sync version
	18841	"RTN","HMP DJFSP",63, 0)
	18842	. I $G(AR GS("jobId" ))]"" S ^X TMP(HMPBAT CH,"JOBID" )=ARGS("jo bId") ;US 3907 /US11 019
	18843	"RTN","HMP DJFSP",64, 0)
	18844	. I $G(AR GS("rootJo bId"))]"" S ^XTMP(HM PBATCH,"RO OTJOBID")= ARGS("root JobId") ; US3907
	18845	"RTN","HMP DJFSP",65, 0)
	18846	. S ^XTMP (HMPBATCH, 0,"time")= $H
	18847	"RTN","HMP DJFSP",66, 0)
	18848	. ; US673 4 - settin g of syncS tart for O PD only
	18849	"RTN","HMP DJFSP",67, 0)
	18850	. I HMPFD FN="OPD" D SETMARK(" Start",HMP FDFN,HMPBA TCH),INIT^ HMPMETA(HM PBATCH,HMP FDFN,.ARGS ) ; US6734
	18851	"RTN","HMP DJFSP",68, 0)
	18852	L -^XTMP( HMPBATCH)
	18853	"RTN","HMP DJFSP",69, 0)
	18854	;cpc US11 019 end mo ved code
	18855	"RTN","HMP DJFSP",70, 0)
	18856	;Every Do main in it 's own tas k (unless running in original mode)
	18857	"RTN","HMP DJFSP",71, 0)
	18858	I NEWSUB D Q:$G(HM PFERR) ""
	18859	"RTN","HMP DJFSP",72, 0)
	18860	. ; if pa tient's ex tracts are held (ver sion misma tch), put DFN on wai t list
	18861	"RTN","HMP DJFSP",73, 0)
	18862	. I +HMPF DFN,$G(^XT MP("HMPFS~ "_HMPSRV(" ien"),"wai ting")) S ^XTMP("HMP FS~"_HMPSR V("ien")," waiting",H MPFDFN)="" QUIT
	18863	"RTN","HMP DJFSP",74, 0)
	18864	. D UPDST S(HMPFDFN, $P(HMPBATC H,"~",2),1 ) ;moved f rom backgr ound job t o once in foreground 12/17/201 5
	18865	"RTN","HMP DJFSP",75, 0)
	18866	. I 'HMPS VERS N HMP FDOM M HMP FDOM=DOMAI NS D QUINI T(HMPBATCH ,HMPFDFN,. HMPFDOM) Q ;US11019 Enable pr evious beh avior
	18867	"RTN","HMP DJFSP",76, 0)
	18868	. S I="" F S I=$O( DOMAINS(I) ) Q:'I D
	18869	"RTN","HMP DJFSP",77, 0)
	18870	.. N HMP FDOM
	18871	"RTN","HMP DJFSP",78, 0)
	18872	.. S HMP FDOM(1)=DO MAINS(I)
	18873	"RTN","HMP DJFSP",79, 0)
	18874	.. D QUI NIT(HMPBAT CH,HMPFDFN ,.HMPFDOM)
	18875	"RTN","HMP DJFSP",80, 0)
	18876	;===JD ST ART===
	18877	"RTN","HMP DJFSP",81, 0)
	18878	; For pat ient resub scribes, n eed to sen d demograp hics ONLY
	18879	"RTN","HMP DJFSP",82, 0)
	18880	I 'NEWSUB ,HMPFDFN'= "OPD",'$D( ^XTMP(HMPB ATCH,0,"st atus")) D ;DE3331 c heck expan ded to ens ure not cu rrent
	18881	"RTN","HMP DJFSP",83, 0)
	18882	. N HMPFD OM,HMPDSAV E ;DE3331
	18883	"RTN","HMP DJFSP",84, 0)
	18884	. M HMPDS AVE=DOMAIN S ;DE3331
	18885	"RTN","HMP DJFSP",85, 0)
	18886	. K DOMAI NS S DOMAI NS(1)="pat ient"
	18887	"RTN","HMP DJFSP",86, 0)
	18888	. M HMPFD OM=DOMAINS
	18889	"RTN","HMP DJFSP",87, 0)
	18890	. D QUINI T(HMPBATCH ,HMPFDFN,. HMPFDOM)
	18891	"RTN","HMP DJFSP",88, 0)
	18892	. I $G(HM PSVERS) S I="" F S I=$O(HMPDS AVE(I)) Q: 'I D ;DE 3331 creat e empty me tastamp en tries for remaining domains
	18893	"RTN","HMP DJFSP",89, 0)
	18894	.. I HMP DSAVE(I)'= "patient" D SETMARK( "Meta",HMP FDFN,HMPDS AVE(I))
	18895	"RTN","HMP DJFSP",90, 0)
	18896	;===JD EN D===
	18897	"RTN","HMP DJFSP",91, 0)
	18898	Q "/hmp/s ubscriptio n/"_HMPSRV _"/patient /"_$$PID^H MPDJFS(HMP FDFN)
	18899	"RTN","HMP DJFSP",92, 0)
	18900	;
	18901	"RTN","HMP DJFSP",93, 0)
	18902	QUINIT(HMP BATCH,HMPF DFN,HMPFDO M) ; Queue the initi al extract s for a pa tient
	18903	"RTN","HMP DJFSP",94, 0)
	18904	; HMPBATC H="HMPFX~h mpsrvid~df n" exampl e: HMPFX~h mpXYZ~229
	18905	"RTN","HMP DJFSP",95, 0)
	18906	; HMPFDOM (n)="domai nName"
	18907	"RTN","HMP DJFSP",96, 0)
	18908	;
	18909	"RTN","HMP DJFSP",97, 0)
	18910	; ^XTMP(" HMPFX~hmps rvid~dfn", 0)=expires ^created^H MP Patient Extract
	18911	"RTN","HMP DJFSP",98, 0)
	18912	; , 0,"status" ,domain)=0 :waiting;1 :ready
	18913	"RTN","HMP DJFSP",99, 0)
	18914	; , 0,"task",t askIen)=""
	18915	"RTN","HMP DJFSP",100 ,0)
	18916	; , taskIen,do main,... ( extract da ta)
	18917	"RTN","HMP DJFSP",101 ,0)
	18918	;
	18919	"RTN","HMP DJFSP",102 ,0)
	18920	; set up the domain s to be do ne by this task
	18921	"RTN","HMP DJFSP",103 ,0)
	18922	N I S I=0 F S I=$O (HMPFDOM(I )) Q:'I D SETDOM("s tatus",HMP FDOM(I),0)
	18923	"RTN","HMP DJFSP",104 ,0)
	18924	;
	18925	"RTN","HMP DJFSP",105 ,0)
	18926	; create task for t his set of domains w ithin the batch
	18927	"RTN","HMP DJFSP",106 ,0)
	18928	N ZTRTN,Z TDESC,ZTDT H,ZTIO,ZTS AVE,ZTSK
	18929	"RTN","HMP DJFSP",107 ,0)
	18930	S ZTRTN=" DQINIT^HMP DJFSP",ZTI O="HMP EXT RACT RESOU RCE",ZTDTH =$H
	18931	"RTN","HMP DJFSP",108 ,0)
	18932	S ZTSAVE( "HMPBATCH" )="",ZTSAV E("HMPFDFN ")="",ZTSA VE("HMPFDO M(")=""
	18933	"RTN","HMP DJFSP",109 ,0)
	18934	S ZTSAVE( "HMPENVIR( ")="" ; e nvironment informati on
	18935	"RTN","HMP DJFSP",110 ,0)
	18936	S ZTSAVE( "HMPSTMP") ="" ; Oper ational da ta stampti me US6734
	18937	"RTN","HMP DJFSP",111 ,0)
	18938	S ZTSAVE( "HMPSVERS" )="" ;sync version U S11019
	18939	"RTN","HMP DJFSP",112 ,0)
	18940	S ZTDESC= "Build HMP domains f or a patie nt"
	18941	"RTN","HMP DJFSP",113 ,0)
	18942	D ^%ZTLOA D
	18943	"RTN","HMP DJFSP",114 ,0)
	18944	I $G(ZTSK ) S ^XTMP( HMPBATCH,0 ,"task",ZT SK)="" Q
	18945	"RTN","HMP DJFSP",115 ,0)
	18946	D SETERR^ HMPDJFS("T ask not cr eated")
	18947	"RTN","HMP DJFSP",116 ,0)
	18948	Q
	18949	"RTN","HMP DJFSP",117 ,0)
	18950	SETDOM(ATT RIB,DOMAIN ,VALUE,HMP META) ; Se t value fo r a domain ; cpc TA4 1760
	18951	"RTN","HMP DJFSP",118 ,0)
	18952	; ATTRIB: "status" or "count" attribute
	18953	"RTN","HMP DJFSP",119 ,0)
	18954	; for sta tus, VALUE : 0=waitin g, 1=ready
	18955	"RTN","HMP DJFSP",120 ,0)
	18956	; for cou nt, VALUE : count of items
	18957	"RTN","HMP DJFSP",121 ,0)
	18958	;don't up date to fi nished val ue if just tracking metastamp
	18959	"RTN","HMP DJFSP",122 ,0)
	18960	I $G(HMPM ETA)'="" S ^XTMP(HMP BATCH,0,AT TRIB,DOMAI N,$S(HMPME TA=1:"Meta Stamp",HMP META=2:"Co mbined",1: "Staging") ,$S(VALUE: "Stop",1:" Start"))=$ H Q:(HMPME TA=1&VALUE ) ;cpc TA 41760 10/7 /2015 add time loggi ng
	18961	"RTN","HMP DJFSP",123 ,0)
	18962	S ^XTMP(H MPBATCH,0, ATTRIB,DOM AIN)=VALUE
	18963	"RTN","HMP DJFSP",124 ,0)
	18964	Q
	18965	"RTN","HMP DJFSP",125 ,0)
	18966	SETMARK(TY PE,HMPFDFN ,HMPBATCH) ; Post ma rkers for begin and end of ini tial synch
	18967	"RTN","HMP DJFSP",126 ,0)
	18968	; ^XTMP(" HMPFP","ti dy",hmpSer ver,fmDate ,sequence) =batch
	18969	"RTN","HMP DJFSP",127 ,0)
	18970	Q:$G(HMPE NVIR("conv erting")) ; don't s et markers during co nversion
	18971	"RTN","HMP DJFSP",128 ,0)
	18972	N HPMSRV, NODES,X
	18973	"RTN","HMP DJFSP",129 ,0)
	18974	S HMPSRV= $P(HMPBATC H,"~",2)
	18975	"RTN","HMP DJFSP",130 ,0)
	18976	D POST^HM PDJFS(HMPF DFN,"sync" _TYPE,HMPB ATCH,"",HM PSRV,.NODE S)
	18977	"RTN","HMP DJFSP",131 ,0)
	18978	Q:TYPE="S tart"!(TYP E="Meta") ; US11019
	18979	"RTN","HMP DJFSP",132 ,0)
	18980	D SETTIDY ("<done>", .NODES)
	18981	"RTN","HMP DJFSP",133 ,0)
	18982	Q
	18983	"RTN","HMP DJFSP",134 ,0)
	18984	;
	18985	"RTN","HMP DJFSP",135 ,0)
	18986	DQINIT ; D equeue ini tial extra cts
	18987	"RTN","HMP DJFSP",136 ,0)
	18988	; expects : HMPBATC H, HMPFDFN , HMPFDOM, ZTSK
	18989	"RTN","HMP DJFSP",137 ,0)
	18990	N COUNT,H MPFDOMI,HM PFSYS,HMPF ZTSK
	18991	"RTN","HMP DJFSP",138 ,0)
	18992	F COUNT=1 :1:10 Q:$D (^XTMP(HMP BATCH,0,"t ask",ZTSK) ) H .5 ;c pc 9/18/20 15 In case job runni ng too qui ckly
	18993	"RTN","HMP DJFSP",139 ,0)
	18994	I '$D(^XT MP(HMPBATC H,0,"task" ,ZTSK)) Q ; extract was super ceded
	18995	"RTN","HMP DJFSP",140 ,0)
	18996	K ^TMP("H MPERR",$J)
	18997	"RTN","HMP DJFSP",141 ,0)
	18998	S HMPFSYS =$$GET^XPA R("SYS","H MP SYSTEM NAME")
	18999	"RTN","HMP DJFSP",142 ,0)
	19000	S HMPFZTS K=ZTSK ; j ust in cas e the unex pected hap pens to ZT SK
	19001	"RTN","HMP DJFSP",143 ,0)
	19002	S ^XTMP(H MPBATCH,0, "task",ZTS K,"job")=$ J
	19003	"RTN","HMP DJFSP",144 ,0)
	19004	S ^XTMP(H MPBATCH,0, "task",ZTS K,"wait")= $$HDIFF^XL FDT($H,$G( ^XTMP(HMPB ATCH,0,"ti me")),2)
	19005	"RTN","HMP DJFSP",145 ,0)
	19006	;
	19007	"RTN","HMP DJFSP",146 ,0)
	19008	; S68 ch eck space
	19009	"RTN","HMP DJFSP",147 ,0)
	19010	D CHKSP^H MPUTILS($P (HMPBATCH, "~",2)) ; US8228
	19011	"RTN","HMP DJFSP",148 ,0)
	19012	N HMPMETA ; US6734
	19013	"RTN","HMP DJFSP",149 ,0)
	19014	F HMPMETA =$S(HMPSVE RS:2,1:1): -1:0 D Q: HMPMETA=2 ;
	19015	"RTN","HMP DJFSP",150 ,0)
	19016	. I HMPME TA=0,+HMPF DFN D SETM ARK("Start ",HMPFDFN, HMPBATCH) ; US6734
	19017	"RTN","HMP DJFSP",151 ,0)
	19018	. S HMPFD OMI=""
	19019	"RTN","HMP DJFSP",152 ,0)
	19020	. F S HM PFDOMI=$O( HMPFDOM(HM PFDOMI)) Q :'HMPFDOMI D
	19021	"RTN","HMP DJFSP",153 ,0)
	19022	.. D SET DOM("statu s",HMPFDOM (HMPFDOMI) ,0,HMPMETA ) ; cpc TA 41760
	19023	"RTN","HMP DJFSP",154 ,0)
	19024	.. I HMP FDFN="OPD" D
	19025	"RTN","HMP DJFSP",155 ,0)
	19026	... D D OMOPD(HMPF DOM(HMPFDO MI))
	19027	"RTN","HMP DJFSP",156 ,0)
	19028	... I H MPMETA=2 D UPD^HMPME TA(HMPFDOM (HMPFDOMI) ) ; US6734 - mark OP D domain a s complete in metast amp
	19029	"RTN","HMP DJFSP",157 ,0)
	19030	.. I +HM PFDFN D DO MPT(HMPFDO M(HMPFDOMI ))
	19031	"RTN","HMP DJFSP",158 ,0)
	19032	.. I HMP META=1 D:' $O(HMPFDOM (HMPFDOMI) ) MERGE^HM PMETA(HMPB ATCH) D:HM PFDFN="OPD " UPD^HMPM ETA(HMPFDO M(HMPFDOMI )) Q
	19033	"RTN","HMP DJFSP",159 ,0)
	19034	.. I HMP META=2 D
	19035	"RTN","HMP DJFSP",160 ,0)
	19036	... D M ERGE1^HMPM ETA(HMPBAT CH,HMPFDOM (HMPFDOMI) ) ;US11019 - merge d ata into m etastamp
	19037	"RTN","HMP DJFSP",161 ,0)
	19038	... I + HMPFDFN D SETMARK("M eta",HMPFD FN,HMPFDOM (HMPFDOMI) ) ;US11019 - new fre shness ent ry replaci ng syncSta rt
	19039	"RTN","HMP DJFSP",162 ,0)
	19040	... I H MPFDFN="OP D" D:'$O(H MPFDOM(HMP FDOMI)) ME RGE^HMPMET A(HMPBATCH ) ; US6734 - merge d ata into m etastamp
	19041	"RTN","HMP DJFSP",163 ,0)
	19042	.. D SET DOM("statu s",HMPFDOM (HMPFDOMI) ,1,HMPMETA ) ; ready ; cpc TA41 760
	19043	"RTN","HMP DJFSP",164 ,0)
	19044	.. ; if superceded , stop pro cessing do mains
	19045	"RTN","HMP DJFSP",165 ,0)
	19046	.. I '$D (^XTMP(HMP BATCH,0,"t ask",HMPFZ TSK)) S HM PFDOMI=999 Q
	19047	"RTN","HMP DJFSP",166 ,0)
	19048	.. ; -- if more do mains, che ck ^XTMP s ize before continuin g; may hav e to HANG if too big BEGINS 68-JCH*
	19049	"RTN","HMP DJFSP",167 ,0)
	19050	.. I +HM PFDFN,HMPF DOMI'=+$O( HMPFDOM("" ),-1) D CH KXTMP(HMPB ATCH,HMPFZ TSK) ;; US 5074 - re moved
	19051	"RTN","HMP DJFSP",168 ,0)
	19052	; if supe rceded, re move extra cts produc ed by this task
	19053	"RTN","HMP DJFSP",169 ,0)
	19054	I '$D(^XT MP(HMPBATC H,0,"task" ,HMPFZTSK) ) K ^XTMP( HMPBATCH,H MPFZTSK) Q
	19055	"RTN","HMP DJFSP",170 ,0)
	19056	; don't a ssume init ialized, s ince we ma y split do mains to o ther tasks
	19057	"RTN","HMP DJFSP",171 ,0)
	19058	I $$INITD ONE(HMPBAT CH) D ; i f all doma ins extrac ted
	19059	"RTN","HMP DJFSP",172 ,0)
	19060	. S COUNT =$O(^TMP(" HMPERR",$J ,"")) I CO UNT>0 D PO STERR(COUN T,HMPFDFN)
	19061	"RTN","HMP DJFSP",173 ,0)
	19062	. D SETMA RK("Done", HMPFDFN,HM PBATCH) ; - add upda ted syncSt atus
	19063	"RTN","HMP DJFSP",174 ,0)
	19064	. D MVFRU PD(HMPBATC H,HMPFDFN) ; - move fre shness upd ates over
	19065	"RTN","HMP DJFSP",175 ,0)
	19066	;
	19067	"RTN","HMP DJFSP",176 ,0)
	19068	K ^XTMP(H MPBATCH,0, "task",HMP FZTSK) ; this task is done
	19069	"RTN","HMP DJFSP",177 ,0)
	19070	Q
	19071	"RTN","HMP DJFSP",178 ,0)
	19072	;
	19073	"RTN","HMP DJFSP",179 ,0)
	19074	DOMPT(HMPF ADOM) ; Lo ad a patie nt domain
	19075	"RTN","HMP DJFSP",180 ,0)
	19076	N FILTER, RSLT,HMPFE ST,HMPCHNK ; S68-J CH
	19077	"RTN","HMP DJFSP",181 ,0)
	19078	S FILTER( "noHead")= 1
	19079	"RTN","HMP DJFSP",182 ,0)
	19080	S FILTER( "domain")= HMPFADOM
	19081	"RTN","HMP DJFSP",183 ,0)
	19082	S FILTER( "patientId ")=HMPFDFN
	19083	"RTN","HMP DJFSP",184 ,0)
	19084	; -- doma in var use d for chun king patie nt objects using <do main>#<num ber> const ruct BEG INS68-JCH *
	19085	"RTN","HMP DJFSP",185 ,0)
	19086	S HMPCHNK =HMPFADOM
	19087	"RTN","HMP DJFSP",186 ,0)
	19088	S HMPCHNK ("trigger count")=$$ CHNKCNT(HM PFADOM) ; ENDS68- JCH*
	19089	"RTN","HMP DJFSP",187 ,0)
	19090	D GET^HMP DJ(.RSLT,. FILTER) ;U S11019 I $ G(HMPMETA) D SETDOM( "status",H MPFADOM,1, 1) Q ;US1 1019/US673 4 - do not update st ream if co mpiling me tastamp ; CPC TA4176 0
	19091	"RTN","HMP DJFSP",188 ,0)
	19092	I $G(HMPM ETA)=1 D S ETDOM("sta tus",HMPFA DOM,1,1) Q ;US11019 /US6734 - do not upd ate stream if compil ing metast amp ; CPC TA41760
	19093	"RTN","HMP DJFSP",189 ,0)
	19094	; add to HMPFS queu e if total >0 OR this is the fi rst chunck (#0) sect ion S68- JCH
	19095	"RTN","HMP DJFSP",190 ,0)
	19096	I ($G(@RS LT@("total "),0)>0)!( $P(HMPCHNK ,"#",2)=0) D CHNKFIN ; S68-J CH
	19097	"RTN","HMP DJFSP",191 ,0)
	19098	Q
	19099	"RTN","HMP DJFSP",192 ,0)
	19100	;
	19101	"RTN","HMP DJFSP",193 ,0)
	19102	DOMOPD(HMP FADOM) ; L oad an ope rational d omain in s maller bat ches
	19103	"RTN","HMP DJFSP",194 ,0)
	19104	; expects HMPBATCH, HMPFZTSK
	19105	"RTN","HMP DJFSP",195 ,0)
	19106	N FILTER, RSLT,NEXTI D,DONE,HMP FEST,HMPFS EC,HMPFSIZ E,HMPFLDON ; cpc
	19107	"RTN","HMP DJFSP",196 ,0)
	19108	S HMPFSIZ E=1000 ; section size (adj ust to tas te)
	19109	"RTN","HMP DJFSP",197 ,0)
	19110	S HMPFEST =$$TOTAL(H MPFADOM) ; set est imated dom ain total
	19111	"RTN","HMP DJFSP",198 ,0)
	19112	S NEXTID= 0,HMPFSEC= 0,DONE=0,H MPFLDON=0 ;cpc
	19113	"RTN","HMP DJFSP",199 ,0)
	19114	S HMPFADO M=HMPFADOM _"#"_HMPFS EC
	19115	"RTN","HMP DJFSP",200 ,0)
	19116	F D Q:D ONE
	19117	"RTN","HMP DJFSP",201 ,0)
	19118	. N FILTE R,RSLT
	19119	"RTN","HMP DJFSP",202 ,0)
	19120	. S FILTE R("noHead" )=1
	19121	"RTN","HMP DJFSP",203 ,0)
	19122	. S FILTE R("domain" )=HMPFADOM ; include section f or ^XTMP l ocation
	19123	"RTN","HMP DJFSP",204 ,0)
	19124	. S FILTE R("start") =NEXTID
	19125	"RTN","HMP DJFSP",205 ,0)
	19126	. S FILTE R("limit") =HMPFSIZE
	19127	"RTN","HMP DJFSP",206 ,0)
	19128	. D GET^H MPEF(.RSLT ,.FILTER)
	19129	"RTN","HMP DJFSP",207 ,0)
	19130	. I $G(HM PMETA)=1 S DONE=1 Q ;US6734 - do not up date strea m if compi ling metas tamp
	19131	"RTN","HMP DJFSP",208 ,0)
	19132	. I '$D(^ XTMP(HMPBA TCH,0,"tas k",HMPFZTS K)) S DONE =1 QUIT ; supercede d
	19133	"RTN","HMP DJFSP",209 ,0)
	19134	. I $G(^X TMP(HMPBAT CH,HMPFZTS K,HMPFADOM ,"total"), 0)=0,(HMPF SEC>0) S D ONE=1 QUIT
	19135	"RTN","HMP DJFSP",210 ,0)
	19136	. I $G(^X TMP(HMPBAT CH,HMPFZTS K,HMPFADOM ,"finished ")) S DONE =1
	19137	"RTN","HMP DJFSP",211 ,0)
	19138	. D MOD4S TRM(HMPFAD OM)
	19139	"RTN","HMP DJFSP",212 ,0)
	19140	. I DONE S HMPFEST= ^XTMP(HMPB ATCH,0,"co unt",$P(HM PFADOM,"#" )) S:'HMPF EST HMPFES T=1
	19141	"RTN","HMP DJFSP",213 ,0)
	19142	. D POSTS EC(HMPFADO M,HMPFEST, HMPFSIZE)
	19143	"RTN","HMP DJFSP",214 ,0)
	19144	. Q:DONE
	19145	"RTN","HMP DJFSP",215 ,0)
	19146	. S NEXTI D=$G(^XTMP (HMPBATCH, HMPFZTSK,H MPFADOM,"l ast"),0)
	19147	"RTN","HMP DJFSP",216 ,0)
	19148	. S HMPFS EC=HMPFSEC +1
	19149	"RTN","HMP DJFSP",217 ,0)
	19150	. S $P(HM PFADOM,"#" ,2)=HMPFSE C
	19151	"RTN","HMP DJFSP",218 ,0)
	19152	Q
	19153	"RTN","HMP DJFSP",219 ,0)
	19154	;
	19155	"RTN","HMP DJFSP",220 ,0)
	19156	CHNKCNT(DO MAIN) ; -- get patie nt object chunk coun t trigger BEGIN S68-JCH*
	19157	"RTN","HMP DJFSP",221 ,0)
	19158	; input: DOMAIN := current do main name being proc essed
	19159	"RTN","HMP DJFSP",222 ,0)
	19160	Q $S(+$$G ET^XPAR("P KG","HMP D OMAIN SIZE S",$P($G(D OMAIN),"#" ),"Q")>300 0:500,1:10 00) ; EN DS68-JCH*
	19161	"RTN","HMP DJFSP",223 ,0)
	19162	;
	19163	"RTN","HMP DJFSP",224 ,0)
	19164	CHNKINIT(H MP,HMPI) ; -- init c hunk secti on callbac k BEGIN S68-JCH*
	19165	"RTN","HMP DJFSP",225 ,0)
	19166	; input b y ref: HM P := $NA o f location for chunk of object s
	19167	"RTN","HMP DJFSP",226 ,0)
	19168	; HMP I := numbe r of objec ts in @HMP
	19169	"RTN","HMP DJFSP",227 ,0)
	19170	; -- quit if not in chunking mode
	19171	"RTN","HMP DJFSP",228 ,0)
	19172	Q:'$D(HMP CHNK)
	19173	"RTN","HMP DJFSP",229 ,0)
	19174	;
	19175	"RTN","HMP DJFSP",230 ,0)
	19176	S $P(HMPC HNK,"#",2) =$S(HMPCHN K["#":$P(H MPCHNK,"#" ,2)+1,1:0)
	19177	"RTN","HMP DJFSP",231 ,0)
	19178	S HMP=$NA (^XTMP(HMP BATCH,HMPF ZTSK,HMPCH NK))
	19179	"RTN","HMP DJFSP",232 ,0)
	19180	K @HMP
	19181	"RTN","HMP DJFSP",233 ,0)
	19182	S HMPI=0
	19183	"RTN","HMP DJFSP",234 ,0)
	19184	Q ; END S68-JCH*
	19185	"RTN","HMP DJFSP",235 ,0)
	19186	;
	19187	"RTN","HMP DJFSP",236 ,0)
	19188	CHNKCHK(HM P,HMPI) ; -- check i f chunk sh ould be qu eued callb ack BEGIN S68-JCH*
	19189	"RTN","HMP DJFSP",237 ,0)
	19190	; (called by ADD^HM PDJ & HMP1 ^HMPDJ02)
	19191	"RTN","HMP DJFSP",238 ,0)
	19192	; input b y ref: HM P := $NA o f location for chunk of object s
	19193	"RTN","HMP DJFSP",239 ,0)
	19194	; HMP I := numbe r of objec ts in @HMP
	19195	"RTN","HMP DJFSP",240 ,0)
	19196	; quit if not in ch unking mod e
	19197	"RTN","HMP DJFSP",241 ,0)
	19198	Q:'$D(HMP CHNK)
	19199	"RTN","HMP DJFSP",242 ,0)
	19200	;
	19201	"RTN","HMP DJFSP",243 ,0)
	19202	; execute 'whether to chunk' criteria
	19203	"RTN","HMP DJFSP",244 ,0)
	19204	Q:HMPI<HM PCHNK("tri gger count ")
	19205	"RTN","HMP DJFSP",245 ,0)
	19206	; -- add tail to js on to sect ion
	19207	"RTN","HMP DJFSP",246 ,0)
	19208	D GTQ^HMP DJ
	19209	"RTN","HMP DJFSP",247 ,0)
	19210	; -- fini sh section and put o n HMPFS~ q ueue
	19211	"RTN","HMP DJFSP",248 ,0)
	19212	D CHNKFIN
	19213	"RTN","HMP DJFSP",249 ,0)
	19214	; -- chec k ^XTMP si ze before continuing ; may have to HANG i f too big
	19215	"RTN","HMP DJFSP",250 ,0)
	19216	D CHKXTMP (HMPBATCH, HMPFZTSK) ; US5074 disable lo opback
	19217	"RTN","HMP DJFSP",251 ,0)
	19218	; -- init ialize for next sect ion
	19219	"RTN","HMP DJFSP",252 ,0)
	19220	D CHNKINI T(.HMP,.HM PI)
	19221	"RTN","HMP DJFSP",253 ,0)
	19222	Q ; END S68-JCH*
	19223	"RTN","HMP DJFSP",254 ,0)
	19224	;
	19225	"RTN","HMP DJFSP",255 ,0)
	19226	CHNKFIN ; -- finish chunk sect ion callba ck BEGIN S68-JCH*
	19227	"RTN","HMP DJFSP",256 ,0)
	19228	; -- quit if not in chunking mode
	19229	"RTN","HMP DJFSP",257 ,0)
	19230	Q:'$D(HMP CHNK)
	19231	"RTN","HMP DJFSP",258 ,0)
	19232	;
	19233	"RTN","HMP DJFSP",259 ,0)
	19234	D MOD4STR M(HMPCHNK)
	19235	"RTN","HMP DJFSP",260 ,0)
	19236	; -- doma in#number, <no estim ated do> , chunk tri gger count for domai n
	19237	"RTN","HMP DJFSP",261 ,0)
	19238	D POSTSEC (HMPCHNK,, HMPCHNK("t rigger cou nt"))
	19239	"RTN","HMP DJFSP",262 ,0)
	19240	Q ; END S68-JCH*
	19241	"RTN","HMP DJFSP",263 ,0)
	19242	;
	19243	"RTN","HMP DJFSP",264 ,0)
	19244	MOD4STRM(D OMAIN) ; m odify extr act to be ready for stream
	19245	"RTN","HMP DJFSP",265 ,0)
	19246	; expects : HMPBATCH , HMPFSYS, HMPFZTSK
	19247	"RTN","HMP DJFSP",266 ,0)
	19248	; results are in ^X TMP("HMPFX ~hmpsrv~df n",DFN,DOM AIN,...)
	19249	"RTN","HMP DJFSP",267 ,0)
	19250	; syncErr or: {uid,c ollection, error} ui d=urn:va:s yncError:s ysId:dfn:e xtract
	19251	"RTN","HMP DJFSP",268 ,0)
	19252	N DFN,HMP SRV,COUNT, DOMONLY
	19253	"RTN","HMP DJFSP",269 ,0)
	19254	S DOMONLY =$P(DOMAIN ,"#")
	19255	"RTN","HMP DJFSP",270 ,0)
	19256	S DFN=$P( HMPBATCH," ~",3),HMPS RV=$P(HMPB ATCH,"~",2 )
	19257	"RTN","HMP DJFSP",271 ,0)
	19258	S COUNT=+ $G(^XTMP(H MPBATCH,HM PFZTSK,DOM AIN,"total "),0)
	19259	"RTN","HMP DJFSP",272 ,0)
	19260	I COUNT=0 S ^XTMP(H MPBATCH,HM PFZTSK,DOM AIN,1,1)=" null"
	19261	"RTN","HMP DJFSP",273 ,0)
	19262	;
	19263	"RTN","HMP DJFSP",274 ,0)
	19264	S ^XTMP(H MPBATCH,HM PFZTSK,DOM AIN,"total ")=COUNT ; include errors and /or empty
	19265	"RTN","HMP DJFSP",275 ,0)
	19266	D SETDOM( "count",DO MONLY,$G(^ XTMP(HMPBA TCH,0,"cou nt",DOMONL Y),0)+COUN T)
	19267	"RTN","HMP DJFSP",276 ,0)
	19268	Q
	19269	"RTN","HMP DJFSP",277 ,0)
	19270	;
	19271	"RTN","HMP DJFSP",278 ,0)
	19272	POSTSEC(DO MAIN,ETOTA L,SECSIZE) ; post do main secti on to stre am and set tidy node s
	19273	"RTN","HMP DJFSP",279 ,0)
	19274	N DFN,HMP SRV,COUNT, X,NODES
	19275	"RTN","HMP DJFSP",280 ,0)
	19276	S COUNT=^ XTMP(HMPBA TCH,HMPFZT SK,DOMAIN, "total")
	19277	"RTN","HMP DJFSP",281 ,0)
	19278	S ETOTAL= $G(ETOTAL, COUNT)
	19279	"RTN","HMP DJFSP",282 ,0)
	19280	s SECSIZE =$G(SECSIZ E,0)
	19281	"RTN","HMP DJFSP",283 ,0)
	19282	S DFN=$P( HMPBATCH," ~",3)
	19283	"RTN","HMP DJFSP",284 ,0)
	19284	S HMPSRV= $P(HMPBATC H,"~",2)
	19285	"RTN","HMP DJFSP",285 ,0)
	19286	D POST^HM PDJFS(DFN, "syncDomai n",DOMAIN_ ":"_HMPFZT SK_":"_COU NT_":"_ETO TAL_":"_SE CSIZE,"",H MPSRV,.NOD ES)
	19287	"RTN","HMP DJFSP",286 ,0)
	19288	D SETTIDY (DOMAIN,.N ODES)
	19289	"RTN","HMP DJFSP",287 ,0)
	19290	Q
	19291	"RTN","HMP DJFSP",288 ,0)
	19292	;
	19293	"RTN","HMP DJFSP",289 ,0)
	19294	SETTIDY(DO MAIN,NODES ) ; Set ti dy nodes f or clean-u p of the e xtracts in ^XTMP
	19295	"RTN","HMP DJFSP",290 ,0)
	19296	; expects HMPBATCH, HMPFZTSK
	19297	"RTN","HMP DJFSP",291 ,0)
	19298	N X,STREA M,SEQ
	19299	"RTN","HMP DJFSP",292 ,0)
	19300	S X="" F S X=$O(NO DES(X)) Q: X="" D ; itera te hmp ser vers
	19301	"RTN","HMP DJFSP",293 ,0)
	19302	. S STREA M="HMPFS~" _X_"~"_$P( NODES(X),U ) ; HMPFS ~hmpSrv~fm Date
	19303	"RTN","HMP DJFSP",294 ,0)
	19304	. S SEQ=$ P(NODES(X) ,U,2)
	19305	"RTN","HMP DJFSP",295 ,0)
	19306	. S ^XTMP (STREAM,"t idy",SEQ," batch")=HM PBATCH
	19307	"RTN","HMP DJFSP",296 ,0)
	19308	. S ^XTMP (STREAM,"t idy",SEQ," domain")=D OMAIN
	19309	"RTN","HMP DJFSP",297 ,0)
	19310	. S ^XTMP (STREAM,"t idy",SEQ," task")=HMP FZTSK
	19311	"RTN","HMP DJFSP",298 ,0)
	19312	Q
	19313	"RTN","HMP DJFSP",299 ,0)
	19314	;
	19315	"RTN","HMP DJFSP",300 ,0)
	19316	MVFRUPD(HM PBATCH,HMP FDFN) ; Mo ve freshne ss updates over acti ve stream
	19317	"RTN","HMP DJFSP",301 ,0)
	19318	N I,X,FRO M,HMPSRV,D FN,TYPE,ID ,ACT
	19319	"RTN","HMP DJFSP",302 ,0)
	19320	S HMPSRV= $P(HMPBATC H,"~",2)
	19321	"RTN","HMP DJFSP",303 ,0)
	19322	D UPDSTS( HMPFDFN,HM PSRV,2) ; now ini tialized
	19323	"RTN","HMP DJFSP",304 ,0)
	19324	S FROM="H MPFH~"_HMP SRV_"~"_HM PFDFN
	19325	"RTN","HMP DJFSP",305 ,0)
	19326	S I=0 F S I=$O(^XT MP(FROM,I) ) Q:'I D ; move ov er held up dates
	19327	"RTN","HMP DJFSP",306 ,0)
	19328	. S X=^XT MP(FROM,I)
	19329	"RTN","HMP DJFSP",307 ,0)
	19330	. S DFN=$ P(X,U),TYP E=$P(X,U,2 ),ID=$P(X, U,3),ACT=$ P(X,U,4)
	19331	"RTN","HMP DJFSP",308 ,0)
	19332	. D POST^ HMPDJFS(DF N,TYPE,ID, ACT,HMPSRV )
	19333	"RTN","HMP DJFSP",309 ,0)
	19334	K ^XTMP(F ROM)
	19335	"RTN","HMP DJFSP",310 ,0)
	19336	Q
	19337	"RTN","HMP DJFSP",311 ,0)
	19338	;
	19339	"RTN","HMP DJFSP",312 ,0)
	19340	BLDSERR(DF N,DOMAIN,E RRJSON) ; Create syn cError obj ect in ERR JSON
	19341	"RTN","HMP DJFSP",313 ,0)
	19342	; expects : HMPBATCH , HMPFSYS, HMPFZTSK
	19343	"RTN","HMP DJFSP",314 ,0)
	19344	N COUNT,E RRVAL,ERRO BJ,ERR,ERR MSG,SYNCER R
	19345	"RTN","HMP DJFSP",315 ,0)
	19346	M ERRVAL= ^XTMP(HMPB ATCH,HMPFZ TSK,DOMAIN ,"error")
	19347	"RTN","HMP DJFSP",316 ,0)
	19348	I $G(ERRV AL)="" Q
	19349	"RTN","HMP DJFSP",317 ,0)
	19350	S ERRVAL= "{"_ERRVAL _"}"
	19351	"RTN","HMP DJFSP",318 ,0)
	19352	D DECODE^ HMPJSON("E RRVAL","ER ROBJ","ERR ")
	19353	"RTN","HMP DJFSP",319 ,0)
	19354	I $D(ERR) S $EC=",U JSON decod e error,"
	19355	"RTN","HMP DJFSP",320 ,0)
	19356	K ^XTMP(H MPBATCH,HM PFZTSK,DOM AIN,"error ")
	19357	"RTN","HMP DJFSP",321 ,0)
	19358	S ERRMSG= ERROBJ("er ror","mess age")
	19359	"RTN","HMP DJFSP",322 ,0)
	19360	Q:'$L(ERR MSG)
	19361	"RTN","HMP DJFSP",323 ,0)
	19362	S SYNCERR ("uid")="u rn:va:sync Error:"_HM PFSYS_":"_ DFN_":"_DO MAIN
	19363	"RTN","HMP DJFSP",324 ,0)
	19364	S SYNCERR ("collecti on")=DOMAI N
	19365	"RTN","HMP DJFSP",325 ,0)
	19366	S SYNCERR ("error")= ERRMSG
	19367	"RTN","HMP DJFSP",326 ,0)
	19368	D ENCODE^ HMPJSON("S YNCERR","E RRJSON","E RR") I $D( ERR) S $EC =",UJSON e ncode erro r," Q
	19369	"RTN","HMP DJFSP",327 ,0)
	19370	S COUNT=$ O(^TMP("HM PERR",$J," "),-1)+1
	19371	"RTN","HMP DJFSP",328 ,0)
	19372	M ^TMP("H MPERR",$J, COUNT)=ERR JSON
	19373	"RTN","HMP DJFSP",329 ,0)
	19374	Q
	19375	"RTN","HMP DJFSP",330 ,0)
	19376	;
	19377	"RTN","HMP DJFSP",331 ,0)
	19378	POSTERR(CO UNT,DFN) ; put error into ^XTM P(batch)
	19379	"RTN","HMP DJFSP",332 ,0)
	19380	N CNT,NOD E,HMPSRV
	19381	"RTN","HMP DJFSP",333 ,0)
	19382	S HMPSRV= $P(HMPBATC H,"~",2)
	19383	"RTN","HMP DJFSP",334 ,0)
	19384	S CNT=0 F S CNT=$O (^TMP("HMP ERR",$J,CN T)) Q:CNT' >0 D
	19385	"RTN","HMP DJFSP",335 ,0)
	19386	.S NODE=$ G(^TMP("HM PERR",$J,C NT,1))
	19387	"RTN","HMP DJFSP",336 ,0)
	19388	.S ^XTMP( HMPBATCH,H MPFZTSK,"e rror",CNT, 1)=NODE
	19389	"RTN","HMP DJFSP",337 ,0)
	19390	.I CNT>1 S ^XTMP(HM PBATCH,HMP FZTSK,"err or",CNT,.3 )=","
	19391	"RTN","HMP DJFSP",338 ,0)
	19392	D POST^HM PDJFS(DFN, "syncError ","error:" _HMPFZTSK_ ":"_COUNT_ ":"_COUNT, "",HMPSRV)
	19393	"RTN","HMP DJFSP",339 ,0)
	19394	Q
	19395	"RTN","HMP DJFSP",340 ,0)
	19396	;
	19397	"RTN","HMP DJFSP",341 ,0)
	19398	INITDONE(H MPBATCH) ; Return 1 if all dom ains are d one
	19399	"RTN","HMP DJFSP",342 ,0)
	19400	N X,DONE
	19401	"RTN","HMP DJFSP",343 ,0)
	19402	S X="",DO NE=1
	19403	"RTN","HMP DJFSP",344 ,0)
	19404	F S X=$O (^XTMP(HMP BATCH,0,"s tatus",X)) Q:'$L(X) I '^(X) S DONE=0
	19405	"RTN","HMP DJFSP",345 ,0)
	19406	Q DONE
	19407	"RTN","HMP DJFSP",346 ,0)
	19408	;
	19409	"RTN","HMP DJFSP",347 ,0)
	19410	SETPAT(DFN ,SRV,NEWSU B) ; Add p atient to 800000 if not there
	19411	"RTN","HMP DJFSP",348 ,0)
	19412	N ERR,FDA ,IEN,IENRO OT
	19413	"RTN","HMP DJFSP",349 ,0)
	19414	S IEN=$O( ^HMP(80000 0,"B",SRV, 0))
	19415	"RTN","HMP DJFSP",350 ,0)
	19416	I 'IEN D SETERR^HMP DJFS("Unab le to find server: " _SRV) QUIT
	19417	"RTN","HMP DJFSP",351 ,0)
	19418	; for ope rational, only start sync if n ot yet sub scribed
	19419	"RTN","HMP DJFSP",352 ,0)
	19420	I DFN="OP D" D QUIT
	19421	"RTN","HMP DJFSP",353 ,0)
	19422	. L +^HMP (800000,IE N):5 E D SETERR^HMP DJFS("Unab le to lock server: " _SRV) Q
	19423	"RTN","HMP DJFSP",354 ,0)
	19424	. ; statu s is empty string (n ot 0) when unsubscri bed
	19425	"RTN","HMP DJFSP",355 ,0)
	19426	. S NEWSU B='$L($P($ G(^HMP(800 000,IEN,0) ),U,3))
	19427	"RTN","HMP DJFSP",356 ,0)
	19428	. I NEWSU B D UPDOPD (IEN,1) ; set to sub scribed
	19429	"RTN","HMP DJFSP",357 ,0)
	19430	. L -^HMP (800000,IE N)
	19431	"RTN","HMP DJFSP",358 ,0)
	19432	;
	19433	"RTN","HMP DJFSP",359 ,0)
	19434	; for pat ient, chec k subscrib ed and get the PID
	19435	"RTN","HMP DJFSP",360 ,0)
	19436	L +^HMP(8 00000,IEN, 1,DFN):5 E D SETERR ^HMPDJFS(" Unable to lock patie nt: "_DFN) Q
	19437	"RTN","HMP DJFSP",361 ,0)
	19438	S NEWSUB= '$D(^HMP(8 00000,IEN, 1,DFN))
	19439	"RTN","HMP DJFSP",362 ,0)
	19440	I NEWSUB D ADDPAT(D FN,IEN)
	19441	"RTN","HMP DJFSP",363 ,0)
	19442	L -^HMP(8 00000,IEN, 1,DFN)
	19443	"RTN","HMP DJFSP",364 ,0)
	19444	Q
	19445	"RTN","HMP DJFSP",365 ,0)
	19446	;
	19447	"RTN","HMP DJFSP",366 ,0)
	19448	UPDOPD(SRV ,STS) ; Up date statu s of opera tional syn ch
	19449	"RTN","HMP DJFSP",367 ,0)
	19450	N FDA,ERR ,DIERR
	19451	"RTN","HMP DJFSP",368 ,0)
	19452	S FDA(800 000,SRV_", ",.03)=STS
	19453	"RTN","HMP DJFSP",369 ,0)
	19454	D FILE^DI E("","FDA" ,"ERR")
	19455	"RTN","HMP DJFSP",370 ,0)
	19456	I $D(ERR) D SETERR^ HMPDJFS("E rror chang ing operat ional stat us")
	19457	"RTN","HMP DJFSP",371 ,0)
	19458	D CLEAN^D ILF
	19459	"RTN","HMP DJFSP",372 ,0)
	19460	Q
	19461	"RTN","HMP DJFSP",373 ,0)
	19462	ADDPAT(DFN ,SRV) ; Ad d a patien t as subsc ribed for server
	19463	"RTN","HMP DJFSP",374 ,0)
	19464	N FDA,FDA IEN,DIERR, ERR,IENS
	19465	"RTN","HMP DJFSP",375 ,0)
	19466	S IENS="? +"_DFN_"," _SRV_","
	19467	"RTN","HMP DJFSP",376 ,0)
	19468	S FDAIEN( DFN)=DFN ; help DIN UM to work
	19469	"RTN","HMP DJFSP",377 ,0)
	19470	S FDA(800 000.01,IEN S,.01)=DFN
	19471	"RTN","HMP DJFSP",378 ,0)
	19472	S FDA(800 000.01,IEN S,2)=0
	19473	"RTN","HMP DJFSP",379 ,0)
	19474	S FDA(800 000.01,IEN S,3)=$$NOW ^XLFDT
	19475	"RTN","HMP DJFSP",380 ,0)
	19476	D UPDATE^ DIE("","FD A","FDAIEN ","ERR")
	19477	"RTN","HMP DJFSP",381 ,0)
	19478	I $D(ERR) D SETERR^ HMPDJFS("E rror addin g patient subscripti on")
	19479	"RTN","HMP DJFSP",382 ,0)
	19480	D CLEAN^D ILF
	19481	"RTN","HMP DJFSP",383 ,0)
	19482	Q
	19483	"RTN","HMP DJFSP",384 ,0)
	19484	;
	19485	"RTN","HMP DJFSP",385 ,0)
	19486	UPDSTS(DFN ,SRVNM,STS ) ; Update the sync status
	19487	"RTN","HMP DJFSP",386 ,0)
	19488	N SRV,ERR ;US11019
	19489	"RTN","HMP DJFSP",387 ,0)
	19490	S SRV=$O( ^HMP(80000 0,"B",SRVN M,0)) I 'S RV D SETER R^HMPDJFS( "Missing S erver") Q
	19491	"RTN","HMP DJFSP",388 ,0)
	19492	I DFN="OP D" D UPDOP D(SRV,STS) QUIT
	19493	"RTN","HMP DJFSP",389 ,0)
	19494	;
	19495	"RTN","HMP DJFSP",390 ,0)
	19496	S FDA(800 000.01,DFN _","_SRV_" ,",2)=STS
	19497	"RTN","HMP DJFSP",391 ,0)
	19498	S FDA(800 000.01,DFN _","_SRV_" ,",3)=$$NO W^XLFDT
	19499	"RTN","HMP DJFSP",392 ,0)
	19500	D FILE^DI E("","FDA" ,"ERR")
	19501	"RTN","HMP DJFSP",393 ,0)
	19502	I $D(ERR) D SETERR^ HMPDJFS("E rror updat ing patien t sync sta tus")
	19503	"RTN","HMP DJFSP",394 ,0)
	19504	D CLEAN^D ILF
	19505	"RTN","HMP DJFSP",395 ,0)
	19506	Q
	19507	"RTN","HMP DJFSP",396 ,0)
	19508	;
	19509	"RTN","HMP DJFSP",397 ,0)
	19510	UPDPAT(DFN ,SRV,STS) ; DEPRECAT ED?
	19511	"RTN","HMP DJFSP",398 ,0)
	19512	N ERR,FDA ,IEN
	19513	"RTN","HMP DJFSP",399 ,0)
	19514	S IEN=$O( ^HMP(80000 0,"B",SRV, "")) I +IE N'>0 Q
	19515	"RTN","HMP DJFSP",400 ,0)
	19516	I DFN="OP D" D
	19517	"RTN","HMP DJFSP",401 ,0)
	19518	. S FDA(8 00000,"?"_ IEN_",",.0 1)=SRV
	19519	"RTN","HMP DJFSP",402 ,0)
	19520	. S FDA(8 00000,"?"_ IEN_",",.0 3)=STS
	19521	"RTN","HMP DJFSP",403 ,0)
	19522	I +DFN>0 D
	19523	"RTN","HMP DJFSP",404 ,0)
	19524	.S FDA(80 0000.01,"? "_DFN_","_ IEN_",",.0 1)=DFN
	19525	"RTN","HMP DJFSP",405 ,0)
	19526	.S FDA(80 0000.01,"? "_DFN_","_ IEN_",",2) =STS
	19527	"RTN","HMP DJFSP",406 ,0)
	19528	D UPDATE^ DIE("","FD A","","ERR ")
	19529	"RTN","HMP DJFSP",407 ,0)
	19530	Q
	19531	"RTN","HMP DJFSP",408 ,0)
	19532	;
	19533	"RTN","HMP DJFSP",409 ,0)
	19534	TOTAL(DOMA IN) ; retu rn size to tal
	19535	"RTN","HMP DJFSP",410 ,0)
	19536	N I,X,SIZ E,ROOT
	19537	"RTN","HMP DJFSP",411 ,0)
	19538	S SIZE=0
	19539	"RTN","HMP DJFSP",412 ,0)
	19540	F I=1:1 S X=$T(OPDO MS+I^HMPDJ FSD) Q:$P( X,";",3)=" zzzzz" D Q:SIZE
	19541	"RTN","HMP DJFSP",413 ,0)
	19542	. I $P(X, ";",3)'=DO MAIN Q
	19543	"RTN","HMP DJFSP",414 ,0)
	19544	. S ROOT= $P(X,";",4 )
	19545	"RTN","HMP DJFSP",415 ,0)
	19546	. I ROOT= "^HMP(8000 00.11)" S SIZE=$G(^H MP(800000. 11,"ACNT", DOMAIN)) Q
	19547	"RTN","HMP DJFSP",416 ,0)
	19548	. I $L(RO OT) S SIZE =$P($G(@RO OT@(0)),U, 4)
	19549	"RTN","HMP DJFSP",417 ,0)
	19550	Q $S(SIZE :SIZE,1:99 99)
	19551	"RTN","HMP DJFSP",418 ,0)
	19552	;
	19553	"RTN","HMP DJFSP",419 ,0)
	19554	;
	19555	"RTN","HMP DJFSP",420 ,0)
	19556	OKTORUN(HM PTTYPE) ;e xecute 'ok to run' s trategy
	19557	"RTN","HMP DJFSP",421 ,0)
	19558	; input: HMPTTYPE : = type of task [ 're doer' \| 'e xtractor' \| 'hangLoo p']
	19559	"RTN","HMP DJFSP",422 ,0)
	19560	; - curren tly not us ed but may become us eful for s trategy al gorithms
	19561	"RTN","HMP DJFSP",423 ,0)
	19562	; returns : 1 - ok t o run task \| 0 - do not run ta sk
	19563	"RTN","HMP DJFSP",424 ,0)
	19564	Q $$CHKSI ZE
	19565	"RTN","HMP DJFSP",425 ,0)
	19566	;
	19567	"RTN","HMP DJFSP",426 ,0)
	19568	CHKSIZE() ; aggregat e extract ^XTMP size strategy
	19569	"RTN","HMP DJFSP",427 ,0)
	19570	; returns : 1 - ^XTM P extract size withi n limit \| 0 - ^XTMP size over limit
	19571	"RTN","HMP DJFSP",428 ,0)
	19572	; Note: l ogic used regardless of HMP se rver
	19573	"RTN","HMP DJFSP",429 ,0)
	19574	Q $$GETMA X>+$$GETSI ZE^HMPUTIL S()
	19575	"RTN","HMP DJFSP",430 ,0)
	19576	;
	19577	"RTN","HMP DJFSP",431 ,0)
	19578	CHKXTMP(HM PBATCH,HMP FZTSK) ; - - ^XTMP ch eck at end each doma in loop it eration ; if too big HANG
	19579	"RTN","HMP DJFSP",432 ,0)
	19580	N HMPOK
	19581	"RTN","HMP DJFSP",433 ,0)
	19582	S HMPOK=0
	19583	"RTN","HMP DJFSP",434 ,0)
	19584	F D Q:H MPOK
	19585	"RTN","HMP DJFSP",435 ,0)
	19586	. ; -- if ok to run , continue
	19587	"RTN","HMP DJFSP",436 ,0)
	19588	. I $$OKT ORUN("hang Loop") K ^ XTMP(HMPBA TCH,0,"tas k",HMPFZTS K,"hanging ") S HMPOK =1 Q
	19589	"RTN","HMP DJFSP",437 ,0)
	19590	. S ^("ha nging")=$G (^XTMP(HMP BATCH,0,"t ask",HMPFZ TSK,"hangi ng"))+1
	19591	"RTN","HMP DJFSP",438 ,0)
	19592	. H $$GET SECS
	19593	"RTN","HMP DJFSP",439 ,0)
	19594	Q
	19595	"RTN","HMP DJFSP",440 ,0)
	19596	;
	19597	"RTN","HMP DJFSP",441 ,0)
	19598	GETMAX() ; return th e max allo wable aggr egate extr act size
	19599	"RTN","HMP DJFSP",442 ,0)
	19600	N HMPLIM
	19601	"RTN","HMP DJFSP",443 ,0)
	19602	S HMPLIM= $$GET^XPAR ("SYS","HM P EXTRACT DISK SIZE LIMIT")*10 00000
	19603	"RTN","HMP DJFSP",444 ,0)
	19604	Q $S(HMPL IM:HMPLIM, 1:20000000 ) ; if no t set, 20m b characte rs
	19605	"RTN","HMP DJFSP",445 ,0)
	19606	;
	19607	"RTN","HMP DJFSP",446 ,0)
	19608	GETSECS() ; return d efault # o f seconds to requeue in future or hang w hen proces sing domai ns
	19609	"RTN","HMP DJFSP",447 ,0)
	19610	N SECS
	19611	"RTN","HMP DJFSP",448 ,0)
	19612	S SECS=+$ $GET^XPAR( "SYS","HMP EXTRACT T ASK REQUEU E SECS")
	19613	"RTN","HMP DJFSP",449 ,0)
	19614	Q $S(SECS :SECS,1:10 ) ; not set, wait 10 seconds
	19615	"RTN","HMP DJFSP",450 ,0)
	19616	;
	19617	"RTN","HMP DJFST")
	19618	1^162
	19619	"RTN","HMP DJT")
	19620	1^163
	19621	"RTN","HMP DJX")
	19622	0^55^B3608 9287
	19623	"RTN","HMP DJX",1,0)
	19624	HMPDJX ;SL C/MKB,ASMR /RRB - New data upda te;11/5/13 7:02pm
	19625	"RTN","HMP DJX",2,0)
	19626	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	19627	"RTN","HMP DJX",3,0)
	19628	;Per VA D irective 6 402, this routine sh ould not b e modified .
	19629	"RTN","HMP DJX",4,0)
	19630	;
	19631	"RTN","HMP DJX",5,0)
	19632	; Externa l Referenc es DBIA#
	19633	"RTN","HMP DJX",6,0)
	19634	; ------- ---------- -- -----
	19635	"RTN","HMP DJX",7,0)
	19636	; ^DPT 10035
	19637	"RTN","HMP DJX",8,0)
	19638	; MPIF001 2701
	19639	"RTN","HMP DJX",9,0)
	19640	; XLFSTR 10104
	19641	"RTN","HMP DJX",10,0)
	19642	Q
	19643	"RTN","HMP DJX",11,0)
	19644	;
	19645	"RTN","HMP DJX",12,0)
	19646	EN(LAST,MA X) ; -- ge t data fro m ^XTMP("H MP-<date>" ,n)
	19647	"RTN","HMP DJX",13,0)
	19648	; Expects HMP=$NA(^ TMP("HMP", $J))
	19649	"RTN","HMP DJX",14,0)
	19650	;
	19651	"RTN","HMP DJX",15,0)
	19652	N SYS,X,Y ,HMPTOTL,D FN,PATCNT, ICN,DOMCNT ,TYPE,RTN, HMPLASTI,H MPID,DATA, DELETE,UID ,CNT,TSTAR T,TSTOP
	19653	"RTN","HMP DJX",16,0)
	19654	S TSTART= $$NOW^XLFD T()
	19655	"RTN","HMP DJX",17,0)
	19656	S LAST=$G (LAST),SYS =$G(FILTER ("systemID ")) Q:SYS= ""
	19657	"RTN","HMP DJX",18,0)
	19658	S MAX=$G( MAX,999)
	19659	"RTN","HMP DJX",19,0)
	19660	D GETLIST (LAST,SYS, MAX)
	19661	"RTN","HMP DJX",20,0)
	19662	;
	19663	"RTN","HMP DJX",21,0)
	19664	S (DFN,PA TCNT,HMPTO TL)=0 F S DFN=$O(^T MP("HMPX", $J,DFN)) Q :DFN<1 D
	19665	"RTN","HMP DJX",22,0)
	19666	. K ^TMP( $J,"HMP ER ROR")
	19667	"RTN","HMP DJX",23,0)
	19668	. S PATCN T=PATCNT+1 ,ICN=+$$GE TICN^MPIF0 01(DFN),ER RPAT=DFN
	19669	"RTN","HMP DJX",24,0)
	19670	. S DOMCN T=0 K DATA ,DELETE
	19671	"RTN","HMP DJX",25,0)
	19672	. S TYPE= "" F S TY PE=$O(^TMP ("HMPX",$J ,DFN,TYPE) ) Q:TYPE=" " D
	19673	"RTN","HMP DJX",26,0)
	19674	.. S RTN= $$TAG^HMPD J(TYPE)_"^ HMPDJ0" Q: '$L($T(@RT N))
	19675	"RTN","HMP DJX",27,0)
	19676	.. S DOMC NT=DOMCNT+ 1
	19677	"RTN","HMP DJX",28,0)
	19678	.. ;
	19679	"RTN","HMP DJX",29,0)
	19680	.. N HMP S HMP=$NA( ^TMP("HMP" ,$J,PATCNT ,DOMCNT)), HMPI=0,HMP ID=""
	19681	"RTN","HMP DJX",30,0)
	19682	.. F S H MPID=$O(^T MP("HMPX", $J,DFN,TYP E,HMPID)) Q:HMPID="" S X=$G(^ (HMPID)) D
	19683	"RTN","HMP DJX",31,0)
	19684	... N $ES ,$ET,ERRPA T,ERRMSG
	19685	"RTN","HMP DJX",32,0)
	19686	... S $ET ="D ERRHDL R^HMPDERRH ",ERRPAT=D FN
	19687	"RTN","HMP DJX",33,0)
	19688	... S ERR MSG="A pro blem occur red when t rying to r efresh pat ient data from an AP I."
	19689	"RTN","HMP DJX",34,0)
	19690	... ;
	19691	"RTN","HMP DJX",35,0)
	19692	... I X=" @" D DELET E(TYPE,DFN ,HMPID) Q
	19693	"RTN","HMP DJX",36,0)
	19694	... S HMP LASTI=HMPI D @RTN ;creates @ HMP@(HMPI+ 1)
	19695	"RTN","HMP DJX",37,0)
	19696	... ;
	19697	"RTN","HMP DJX",38,0)
	19698	... ; if no new ite m, assume the record has been deleted
	19699	"RTN","HMP DJX",39,0)
	19700	... I HMP I'>HMPLAST I D DELETE (TYPE,DFN, HMPID) Q
	19701	"RTN","HMP DJX",40,0)
	19702	... S HMP TOTL=HMPTO TL+1,DATA= 1
	19703	"RTN","HMP DJX",41,0)
	19704	.. I 'HMP I S DOMCNT =DOMCNT-1 Q ;no da ta, or err or
	19705	"RTN","HMP DJX",42,0)
	19706	.. ;
	19707	"RTN","HMP DJX",43,0)
	19708	.. S:DOMC NT>1 @HMP@ (.3)=","
	19709	"RTN","HMP DJX",44,0)
	19710	.. S @HMP @(.5)="{"" domainName "":"""_TYP E_""",""to tal"":"_HM PI_",""ite ms"":["
	19711	"RTN","HMP DJX",45,0)
	19712	.. S HMPI =HMPI+1,@H MP@(HMPI)= "]}"
	19713	"RTN","HMP DJX",46,0)
	19714	. ;
	19715	"RTN","HMP DJX",47,0)
	19716	A . ; HMP= $NA(^TMP(" HMP",$J)) again
	19717	"RTN","HMP DJX",48,0)
	19718	. S:PATCN T>1 @HMP@( PATCNT,.3) =","
	19719	"RTN","HMP DJX",49,0)
	19720	. S @HMP@ (PATCNT,.5 )="{""pati entDfn"":" _DFN_",""p atientIcn" ":"""_ICN_ """"
	19721	"RTN","HMP DJX",50,0)
	19722	. I DOMCN T D
	19723	"RTN","HMP DJX",51,0)
	19724	.. S @HMP @(PATCNT,. 6)=",""dom ains"":["
	19725	"RTN","HMP DJX",52,0)
	19726	.. S DOMC NT=DOMCNT+ 1,@HMP@(PA TCNT,DOMCN T)="]"
	19727	"RTN","HMP DJX",53,0)
	19728	. ;
	19729	"RTN","HMP DJX",54,0)
	19730	. I $D(DE LETE) D
	19731	"RTN","HMP DJX",55,0)
	19732	.. S DOMC NT=DOMCNT+ 1,@HMP@(PA TCNT,DOMCN T,.5)=","" deletes"": ["
	19733	"RTN","HMP DJX",56,0)
	19734	.. S HMPI =0,UID="" F S UID=$ O(DELETE(U ID)) Q:UID ="" D
	19735	"RTN","HMP DJX",57,0)
	19736	... S TYP E=DELETE(U ID),HMPI=H MPI+1
	19737	"RTN","HMP DJX",58,0)
	19738	... S:HMP I>1 @HMP@( PATCNT,DOM CNT,HMPI,. 3)=","
	19739	"RTN","HMP DJX",59,0)
	19740	... S @HM P@(PATCNT, DOMCNT,HMP I,1)="{""u id"":"""_U ID_""",""d omainName" ":"""_TYPE _"""}"
	19741	"RTN","HMP DJX",60,0)
	19742	.. S HMPI =HMPI+1,@H MP@(PATCNT ,DOMCNT,HM PI)="]"
	19743	"RTN","HMP DJX",61,0)
	19744	. ;
	19745	"RTN","HMP DJX",62,0)
	19746	. I $D(^T MP($J,"HMP ERROR")) D
	19747	"RTN","HMP DJX",63,0)
	19748	.. N ERRO R D BUILDE RR^HMPDJ(. ERROR)
	19749	"RTN","HMP DJX",64,0)
	19750	.. S DOMC NT=DOMCNT+ 1,@HMP@(PA TCNT,DOMCN T,.3)=","
	19751	"RTN","HMP DJX",65,0)
	19752	.. M @HMP @(PATCNT,D OMCNT)=ERR OR
	19753	"RTN","HMP DJX",66,0)
	19754	.. K ^TMP ($J,"HMP E RROR")
	19755	"RTN","HMP DJX",67,0)
	19756	. ;
	19757	"RTN","HMP DJX",68,0)
	19758	. S DOMCN T=DOMCNT+1 ,@HMP@(PAT CNT,DOMCNT )="}"
	19759	"RTN","HMP DJX",69,0)
	19760	;
	19761	"RTN","HMP DJX",70,0)
	19762	S Y=$G(^T MP("HMPX", $J,0)) S:Y ="" Y=LAST
	19763	"RTN","HMP DJX",71,0)
	19764	S T=$$NOW ^XLFDT()
	19765	"RTN","HMP DJX",72,0)
	19766	S @HMP@(. 5)="{""api Version"": ""1.01""," "data"":{" "lastUpdat e"":"""_Y_ """,""star tDateTime" ":"""_TSTA RT_""",""t otalPatien ts"":"_PAT CNT
	19767	"RTN","HMP DJX",73,0)
	19768	S:PATCNT @HMP@(.6)= ",""patien ts"":[",PA TCNT=PATCN T+1,@HMP@( PATCNT)="] "
	19769	"RTN","HMP DJX",74,0)
	19770	;
	19771	"RTN","HMP DJX",75,0)
	19772	B ;
	19773	"RTN","HMP DJX",76,0)
	19774	I $D(^TMP ("HMPX",$J ,"OP")) D ;o perational data
	19775	"RTN","HMP DJX",77,0)
	19776	. S (HMPT OTL,DOMCNT )=0,PATCNT =PATCNT+1 K DATA,DEL ETE
	19777	"RTN","HMP DJX",78,0)
	19778	. S TYPE= "" F S TY PE=$O(^TMP ("HMPX",$J ,"OP",TYPE )) Q:TYPE= "" D
	19779	"RTN","HMP DJX",79,0)
	19780	.. S RTN= $$TAG^HMPE F(TYPE)_"^ HMPEF" Q:' $L($T(@RTN ))
	19781	"RTN","HMP DJX",80,0)
	19782	.. S DOMC NT=DOMCNT+ 1,DFN=""
	19783	"RTN","HMP DJX",81,0)
	19784	.. ;
	19785	"RTN","HMP DJX",82,0)
	19786	.. N HMP S HMP=$NA( ^TMP("HMP" ,$J,PATCNT ,DOMCNT)), HMPI=0,HMP ID=""
	19787	"RTN","HMP DJX",83,0)
	19788	.. F S H MPID=$O(^T MP("HMPX", $J,"OP",TY PE,HMPID)) Q:HMPID=" " S X=$G( ^(HMPID)) D
	19789	"RTN","HMP DJX",84,0)
	19790	... I X=" @" D DELET E(TYPE,DFN ,HMPID) Q
	19791	"RTN","HMP DJX",85,0)
	19792	... S HMP LASTI=HMPI D @RTN ;c reates @HM P@(HMPI+1)
	19793	"RTN","HMP DJX",86,0)
	19794	... ; if no new ite m, assume the record has been deleted
	19795	"RTN","HMP DJX",87,0)
	19796	... I HMP I'>HMPLAST I D DELETE (TYPE,DFN, HMPID) Q
	19797	"RTN","HMP DJX",88,0)
	19798	... S HMP TOTL=HMPTO TL+1,DATA= 1
	19799	"RTN","HMP DJX",89,0)
	19800	.. I 'HMP I S DOMCNT =DOMCNT-1 Q ;n o data, or error
	19801	"RTN","HMP DJX",90,0)
	19802	.. ;
	19803	"RTN","HMP DJX",91,0)
	19804	.. S:DOMC NT>1 @HMP@ (.3)=","
	19805	"RTN","HMP DJX",92,0)
	19806	.. S @HMP @(.5)="{"" domainName "":"""_TYP E_""",""to tal"":"_HM PI_",""ite ms"":["
	19807	"RTN","HMP DJX",93,0)
	19808	.. S HMPI =HMPI+1,@H MP@(HMPI)= "]}"
	19809	"RTN","HMP DJX",94,0)
	19810	. ;
	19811	"RTN","HMP DJX",95,0)
	19812	C . ; HMP= $NA(^TMP(" HMP",$J)) again
	19813	"RTN","HMP DJX",96,0)
	19814	. I 'DOMC NT,'$D(DEL ETE) Q ;n o data, or error
	19815	"RTN","HMP DJX",97,0)
	19816	. S @HMP@ (PATCNT,.5 )=",""oper ational"": {"
	19817	"RTN","HMP DJX",98,0)
	19818	. I DOMCN T D
	19819	"RTN","HMP DJX",99,0)
	19820	.. S @HMP @(PATCNT,. 6)="""doma ins"":["
	19821	"RTN","HMP DJX",100,0 )
	19822	.. S DOMC NT=DOMCNT+ 1 S @HMP@( PATCNT,DOM CNT)="]"
	19823	"RTN","HMP DJX",101,0 )
	19824	. ;
	19825	"RTN","HMP DJX",102,0 )
	19826	. I $D(DE LETE) D
	19827	"RTN","HMP DJX",103,0 )
	19828	.. S DOMC NT=DOMCNT+ 1 S:DOMCNT >1 @HMP@(P ATCNT,DOMC NT,.3)=","
	19829	"RTN","HMP DJX",104,0 )
	19830	.. S @HMP @(PATCNT,D OMCNT,.5)= """deletes "":["
	19831	"RTN","HMP DJX",105,0 )
	19832	.. S HMPI =0,UID="" F S UID=$ O(DELETE(U ID)) Q:UID ="" D
	19833	"RTN","HMP DJX",106,0 )
	19834	... S TYP E=DELETE(U ID),HMPI=H MPI+1
	19835	"RTN","HMP DJX",107,0 )
	19836	... S:HMP I>1 @HMP@( PATCNT,DOM CNT,HMPI,. 3)=","
	19837	"RTN","HMP DJX",108,0 )
	19838	... S @HM P@(PATCNT, DOMCNT,HMP I,1)="{""u id"":"""_U ID_""",""d omainName" ":"""_TYPE _"""}"
	19839	"RTN","HMP DJX",109,0 )
	19840	.. S HMPI =HMPI+1,@H MP@(PATCNT ,DOMCNT,HM PI)="]"
	19841	"RTN","HMP DJX",110,0 )
	19842	. ;
	19843	"RTN","HMP DJX",111,0 )
	19844	. S DOMCN T=DOMCNT+1 ,@HMP@(PAT CNT,DOMCNT )="}"
	19845	"RTN","HMP DJX",112,0 )
	19846	;
	19847	"RTN","HMP DJX",113,0 )
	19848	S TSTOP=$ $NOW^XLFDT ()
	19849	"RTN","HMP DJX",114,0 )
	19850	S PATCNT= PATCNT+1,@ HMP@(PATCN T)=",""end DateTime"" :"""_TSTOP _"""}}" ;c lose JSON
	19851	"RTN","HMP DJX",115,0 )
	19852	K ^TMP("H MPX",$J),^ TMP("HMPTE XT",$J)
	19853	"RTN","HMP DJX",116,0 )
	19854	Q
	19855	"RTN","HMP DJX",117,0 )
	19856	;
	19857	"RTN","HMP DJX",118,0 )
	19858	DELETE(NAM E,DFN,ID) ; -- set D ELETE node s
	19859	"RTN","HMP DJX",119,0 )
	19860	N UID
	19861	"RTN","HMP DJX",120,0 )
	19862	S UID=$$S ETUID^HMPU TILS(NAME, DFN,ID)
	19863	"RTN","HMP DJX",121,0 )
	19864	S DELETE( UID)=NAME
	19865	"RTN","HMP DJX",122,0 )
	19866	Q
	19867	"RTN","HMP DJX",123,0 )
	19868	;
	19869	"RTN","HMP DJX",124,0 )
	19870	GETLIST(LA ST,SYS,MAX ) ; -- bui ld list of updates f or client
	19871	"RTN","HMP DJX",125,0 )
	19872	; Returns ^TMP("HMP X",$J,0) = last DATE :SEQ inclu ded
	19873	"RTN","HMP DJX",126,0 )
	19874	; ^TMP("HMP X",$J,DFN, TYPE,ID)=A CT
	19875	"RTN","HMP DJX",127,0 )
	19876	N DATE,SE Q,DA,END,I DX,X0,DFN, TYPE,ID,AC T,D,N,CNT
	19877	"RTN","HMP DJX",128,0 )
	19878	K ^TMP("H MPX",$J)
	19879	"RTN","HMP DJX",129,0 )
	19880	S DATE=+L AST,SEQ=+$ P(LAST,":" ,2),CNT=0
	19881	"RTN","HMP DJX",130,0 )
	19882	S DA=$$FI ND^HMPPATS (SYS) Q:'D A
	19883	"RTN","HMP DJX",131,0 )
	19884	;
	19885	"RTN","HMP DJX",132,0 )
	19886	; generat e list ID, and end p oint
	19887	"RTN","HMP DJX",133,0 )
	19888	S D=DT,N= +$O(^XTMP( "HMP-"_DT, "A"),-1) ;last entry, as of now
	19889	"RTN","HMP DJX",134,0 )
	19890	I DATE=DT ,SEQ=N S ^ TMP("HMPX" ,$J,0)=LAS T Q ;no n ew items
	19891	"RTN","HMP DJX",135,0 )
	19892	;
	19893	"RTN","HMP DJX",136,0 )
	19894	S IDX=$NA (^XTMP("HM P-"_DATE,S EQ)),END=N ;init loop wher e left off
	19895	"RTN","HMP DJX",137,0 )
	19896	F S IDX= $Q(@IDX) Q :$$DONE D Q:CNT'<M AX
	19897	"RTN","HMP DJX",138,0 )
	19898	. S D=+$P (IDX,"-",2 ),N=+$P(ID X,",",2)
	19899	"RTN","HMP DJX",139,0 )
	19900	. S X0=@I DX,DFN=$P( X0,U) S:DF N="" DFN=" OP"
	19901	"RTN","HMP DJX",140,0 )
	19902	. I DFN,' $D(^HMP(80 0000,"ADFN ",DFN,DA)) Q
	19903	"RTN","HMP DJX",141,0 )
	19904	. S TYPE= $P(X0,U,2) ,ID=$P(X0, U,3),ACT=$ P(X0,U,4)
	19905	"RTN","HMP DJX",142,0 )
	19906	. I TYPE= ""!(ID="") Q ;error
	19907	"RTN","HMP DJX",143,0 )
	19908	. I TYPE= "ROSTER",' $D(^HMP(80 0000,"AROS ",ID,DA)) Q
	19909	"RTN","HMP DJX",144,0 )
	19910	. S:'$D(^ TMP("HMPX" ,$J,DFN,TY PE,ID)) CN T=CNT+1
	19911	"RTN","HMP DJX",145,0 )
	19912	. S ^TMP( "HMPX",$J, DFN,TYPE,I D)=ACT
	19913	"RTN","HMP DJX",146,0 )
	19914	S ^TMP("H MPX",$J,0) =D_":"_N ;fina l date:seq
	19915	"RTN","HMP DJX",147,0 )
	19916	Q
	19917	"RTN","HMP DJX",148,0 )
	19918	;
	19919	"RTN","HMP DJX",149,0 )
	19920	DONE() ; - - Return 1 or 0, if loop has f inished
	19921	"RTN","HMP DJX",150,0 )
	19922	I IDX'?1" ^XTMP(""HM P-"7N.E Q 1 ; end of ^XT MP("HMP")
	19923	"RTN","HMP DJX",151,0 )
	19924	N D,N S D =+$P(IDX," -",2),N=+$ P(IDX,",", 2)
	19925	"RTN","HMP DJX",152,0 )
	19926	; check H MP-DATE su bscript
	19927	"RTN","HMP DJX",153,0 )
	19928	I D<DT Q 0 ; prior day: keep goin g
	19929	"RTN","HMP DJX",154,0 )
	19930	I D>DT Q 1 ; next day: stop loop
	19931	"RTN","HMP DJX",155,0 )
	19932	; D=DT: c heck seque nce# subsc ript
	19933	"RTN","HMP DJX",156,0 )
	19934	I N>END Q 1
	19935	"RTN","HMP DJX",157,0 )
	19936	Q 0
	19937	"RTN","HMP DLR")
	19938	0^56^B2426 2347
	19939	"RTN","HMP DLR",1,0)
	19940	HMPDLR ;SL C/MKB,ASMR /RRB - Lab oratory ex tract;Nov 05, 2015 1 9:21:53
	19941	"RTN","HMP DLR",2,0)
	19942	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	19943	"RTN","HMP DLR",3,0)
	19944	;Per VA D irective 6 402, this routine sh ould not b e modified .
	19945	"RTN","HMP DLR",4,0)
	19946	;
	19947	"RTN","HMP DLR",5,0)
	19948	; Externa l Referenc es DBIA#
	19949	"RTN","HMP DLR",6,0)
	19950	; ------- ---------- -- -----
	19951	"RTN","HMP DLR",7,0)
	19952	; ^LAB(61 524
	19953	"RTN","HMP DLR",8,0)
	19954	; ^LRO(69 2407
	19955	"RTN","HMP DLR",9,0)
	19956	; ^LR 525
	19957	"RTN","HMP DLR",10,0)
	19958	; DIC 2051
	19959	"RTN","HMP DLR",11,0)
	19960	; DIQ 2056
	19961	"RTN","HMP DLR",12,0)
	19962	; LR7OR1, ^TMP("LRRR ",$J) 2503
	19963	"RTN","HMP DLR",13,0)
	19964	; XUAF4 2171
	19965	"RTN","HMP DLR",14,0)
	19966	Q
	19967	"RTN","HMP DLR",15,0)
	19968	; ------- ----- Get results fr om VistA - ---------- -
	19969	"RTN","HMP DLR",16,0)
	19970	;
	19971	"RTN","HMP DLR",17,0)
	19972	EN(DFN,BEG ,END,MAX,I D) ; -- fi nd patient 's lab res ults, DE28 18
	19973	"RTN","HMP DLR",18,0)
	19974	N HMPSUB, HMPIDT,HMP N,HMPITM,L RDFN,SUB
	19975	"RTN","HMP DLR",19,0)
	19976	S DFN=+$G (DFN) Q:$G (DFN)<1
	19977	"RTN","HMP DLR",20,0)
	19978	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	19979	"RTN","HMP DLR",21,0)
	19980	K ^TMP("L RRR",$J,DF N)
	19981	"RTN","HMP DLR",22,0)
	19982	S LRDFN=$ $LRDFN^HMP XGLAB(DFN) ,HMPSUB="C H" ;DE281 8, (#63) L ABORATORY REFERENCE
	19983	"RTN","HMP DLR",23,0)
	19984	;
	19985	"RTN","HMP DLR",24,0)
	19986	; get res ult(s)
	19987	"RTN","HMP DLR",25,0)
	19988	I $L($G(I D)) D Q:H MPN ;done
	19989	"RTN","HMP DLR",26,0)
	19990	. S HMPSU B=$P(ID,"; "),HMPIDT= +$P(ID,";" ,2),(BEG,E ND)=999999 9-HMPIDT
	19991	"RTN","HMP DLR",27,0)
	19992	. S HMPN= $P(ID,";", 3) I HMPN D ;skip l oop - sing le result
	19993	"RTN","HMP DLR",28,0)
	19994	.. D RR^L R7OR1(DFN, ,BEG,END,H MPSUB)
	19995	"RTN","HMP DLR",29,0)
	19996	.. S SUB= $S("CH^MI" [HMPSUB:HM PSUB,1:"AP ")_"(.HMPI TM)"
	19997	"RTN","HMP DLR",30,0)
	19998	.. D @SUB ,XML(.HMPI TM)
	19999	"RTN","HMP DLR",31,0)
	20000	.. K ^TMP ("LRRR",$J ,DFN)
	20001	"RTN","HMP DLR",32,0)
	20002	;
	20003	"RTN","HMP DLR",33,0)
	20004	D RR^LR7O R1(DFN,,BE G,END,HMPS UB,,,MAX)
	20005	"RTN","HMP DLR",34,0)
	20006	S HMPSUB= "" F S HM PSUB=$O(^T MP("LRRR", $J,DFN,HMP SUB)) Q:HM PSUB="" D
	20007	"RTN","HMP DLR",35,0)
	20008	. S HMPID T=0 F S H MPIDT=$O(^ TMP("LRRR" ,$J,DFN,HM PSUB,HMPID T)) Q:HMPI DT<1 D
	20009	"RTN","HMP DLR",36,0)
	20010	.. S HMPN =0 F S HM PN=$O(^TMP ("LRRR",$J ,DFN,HMPSU B,HMPIDT,H MPN)) Q:HM PN<1 D
	20011	"RTN","HMP DLR",37,0)
	20012	... K HMP ITM S SUB= $S("CH^MI" [HMPSUB:HM PSUB,1:"AP ")_"(.HMPI TM)"
	20013	"RTN","HMP DLR",38,0)
	20014	... D @SU B,XML(.HMP ITM)
	20015	"RTN","HMP DLR",39,0)
	20016	K ^TMP("L RRR",$J,DF N)
	20017	"RTN","HMP DLR",40,0)
	20018	Q
	20019	"RTN","HMP DLR",41,0)
	20020	;
	20021	"RTN","HMP DLR",42,0)
	20022	CH(LAB) ; -- return a Chemistr y result i n LAB("att ribute")=v alue
	20023	"RTN","HMP DLR",43,0)
	20024	; Ex pects ^TMP ("LRRR",$J ,DFN,"CH", HMPIDT,HMP N),LRDFN
	20025	"RTN","HMP DLR",44,0)
	20026	N CDT,LR0 ,LRI,X0,X, LOINC,ORD, CMMT K LAB
	20027	"RTN","HMP DLR",45,0)
	20028	S LAB("id ")="CH;"_H MPIDT_";"_ HMPN,LAB(" type")="CH "
	20029	"RTN","HMP DLR",46,0)
	20030	S CDT=999 9999-HMPID T,LAB("col lected")=C DT
	20031	"RTN","HMP DLR",47,0)
	20032	S LR0=$G( ^LR(LRDFN, "CH",HMPID T,0)),LRI= $G(^(HMPN) )
	20033	"RTN","HMP DLR",48,0)
	20034	S LAB("st atus")="co mpleted",L AB("result ed")=$P(LR 0,U,3)
	20035	"RTN","HMP DLR",49,0)
	20036	S X0=$G(^ TMP("LRRR" ,$J,DFN,"C H",HMPIDT, HMPN))
	20037	"RTN","HMP DLR",50,0)
	20038	S LAB("te st")=$$LAB TSTNM^HMPX GLAB(+X0) ; DE2818
	20039	"RTN","HMP DLR",51,0)
	20040	S:$L($P(X 0,U,2)) LA B("result" )=$P(X0,U, 2)
	20041	"RTN","HMP DLR",52,0)
	20042	S:$L($P(X 0,U,4)) LA B("units") =$P(X0,U,4 )
	20043	"RTN","HMP DLR",53,0)
	20044	S:$L($P(X 0,U,3)) LA B("interpr etation")= $P(X0,U,3)
	20045	"RTN","HMP DLR",54,0)
	20046	S X=$P(X0 ,U,5) I $L (X),X["-" S LAB("low ")=$P(X,"- "),LAB("hi gh")=$P(X, "-",2)
	20047	"RTN","HMP DLR",55,0)
	20048	S LAB("lo calName")= $S($L($P(X 0,U,15)):$ P(X0,U,15) ,1:LAB("te st"))
	20049	"RTN","HMP DLR",56,0)
	20050	S LAB("gr oupName")= $P(X0,U,16 ) ;accessi on#
	20051	"RTN","HMP DLR",57,0)
	20052	S X=+$P(X 0,U,19) I X D ;spec imen
	20053	"RTN","HMP DLR",58,0)
	20054	. N IENS, HMPY S IEN S=X_","
	20055	"RTN","HMP DLR",59,0)
	20056	. D GETS^ DIQ(61,IEN S,".01;2", ,"HMPY")
	20057	"RTN","HMP DLR",60,0)
	20058	. S LAB(" specimen") =$G(HMPY(6 1,IENS,2)) _U_$G(HMPY (61,IENS,. 01)) ;SNOM ED^name
	20059	"RTN","HMP DLR",61,0)
	20060	. S LAB(" sample")=$ $GET1^DIQ( 61,X_",",4 .1) ;name
	20061	"RTN","HMP DLR",62,0)
	20062	S ORD=+$P (X0,U,17) S:ORD LAB( "labOrderI D")=ORD
	20063	"RTN","HMP DLR",63,0)
	20064	S X=$$ORD ER(ORD,+X0 ) S:X LAB( "orderID") =X
	20065	"RTN","HMP DLR",64,0)
	20066	S X=$P($P (LRI,U,3), "!",3) S:X LOINC=$$G ET1^DIQ(95 .3,X_",",. 01)
	20067	"RTN","HMP DLR",65,0)
	20068	I $G(LOIN C) S LAB(" loinc")=LO INC,LAB("v uid")=$$VU ID^HMPD(+L OINC,95.3)
	20069	"RTN","HMP DLR",66,0)
	20070	S X=$P(LR 0,U,14)
	20071	"RTN","HMP DLR",67,0)
	20072	S:X LAB(" facility") =$$STA^XUA F4(X)_U_$P ($$NS^XUAF 4(X),U)
	20073	"RTN","HMP DLR",68,0)
	20074	I 'X S LA B("facilit y")=$$FAC^ HMPD ;loca l stn#^nam e
	20075	"RTN","HMP DLR",69,0)
	20076	I $D(^TMP ("LRRR",$J ,DFN,"CH", HMPIDT,"N" )) M CMMT= ^("N") S L AB("commen t")=$$STRI NG^HMPD(.C MMT)
	20077	"RTN","HMP DLR",70,0)
	20078	Q
	20079	"RTN","HMP DLR",71,0)
	20080	;
	20081	"RTN","HMP DLR",72,0)
	20082	ORDER(LABO RD,TEST) ; -- return #100 orde r for Lab order# & T est
	20083	"RTN","HMP DLR",73,0)
	20084	N Y,D,S,T S Y=""
	20085	"RTN","HMP DLR",74,0)
	20086	S D=$O(^L RO(69,"C", LABORD,0)) I D D
	20087	"RTN","HMP DLR",75,0)
	20088	. S S=0 F S S=$O(^ LRO(69,"C" ,LABORD,D, S)) Q:S<1 D
	20089	"RTN","HMP DLR",76,0)
	20090	.. S T=0 F S T=$O( ^LRO(69,D, 1,S,2,T)) Q:T<1 I + $G(^(T,0)) =TEST S Y= +$P(^(0),U ,7)
	20091	"RTN","HMP DLR",77,0)
	20092	Q Y
	20093	"RTN","HMP DLR",78,0)
	20094	;
	20095	"RTN","HMP DLR",79,0)
	20096	MI(LAB) ; -- return a Microbio logy resul t in LAB(" attribute" )=value
	20097	"RTN","HMP DLR",80,0)
	20098	; Expe cts ^TMP(" LRRR",$J,D FN,"MI",HM PIDT,HMPN) ,LRDFN
	20099	"RTN","HMP DLR",81,0)
	20100	N ID,CDT, X0,X,CMMT, LR0 K LAB
	20101	"RTN","HMP DLR",82,0)
	20102	S X0=$G(^ TMP("LRRR" ,$J,DFN,"M I",HMPIDT, HMPN)) Q:$ L($P(X0,U) )'>1
	20103	"RTN","HMP DLR",83,0)
	20104	S LAB("id ")="MI;"_H MPIDT_"#"_ HMPN,LAB(" status")=" completed"
	20105	"RTN","HMP DLR",84,0)
	20106	S LAB("ty pe")="MI", CDT=999999 9-HMPIDT,L AB("collec ted")=CDT
	20107	"RTN","HMP DLR",85,0)
	20108	S LR0=$G( ^LR(LRDFN, "MI",HMPID T,0)),LAB( "resulted" )=$P(LR0,U ,3)
	20109	"RTN","HMP DLR",86,0)
	20110	S:$L($P(X 0,U,2)) LA B("result" )=$P(X0,U, 2)
	20111	"RTN","HMP DLR",87,0)
	20112	S:$L($P(X 0,U,4)) LA B("units") =$P(X0,U,4 )
	20113	"RTN","HMP DLR",88,0)
	20114	S:$L($P(X 0,U,3)) LA B("interpr etation")= $P(X0,U,3)
	20115	"RTN","HMP DLR",89,0)
	20116	S (LAB("t est"),LAB( "localName "))=$P(X0, U,15)
	20117	"RTN","HMP DLR",90,0)
	20118	S X=+$P(X 0,U,19) I X D ;spec imen
	20119	"RTN","HMP DLR",91,0)
	20120	. N IENS, HMPY S IEN S=X_","
	20121	"RTN","HMP DLR",92,0)
	20122	. D GETS^ DIQ(61,IEN S,".01;2", ,"HMPY")
	20123	"RTN","HMP DLR",93,0)
	20124	. S LAB(" specimen") =$G(HMPY(6 1,IENS,2)) _U_$G(HMPY (61,IENS,. 01)) ;SNOM ED^name
	20125	"RTN","HMP DLR",94,0)
	20126	. S LAB(" sample")=$ $GET1^DIQ( 61,X_",",4 .1) ;name
	20127	"RTN","HMP DLR",95,0)
	20128	S X=$P(LR 0,U,14)
	20129	"RTN","HMP DLR",96,0)
	20130	S:X LAB(" facility") =$$STA^XUA F4(X)_U_$P ($$NS^XUAF 4(X),U)
	20131	"RTN","HMP DLR",97,0)
	20132	I 'X S LA B("facilit y")=$$FAC^ HMPD ;loca l stn#^nam e
	20133	"RTN","HMP DLR",98,0)
	20134	I $D(^TMP ("LRRR",$J ,DFN,"MI", HMPIDT,"N" )) M CMMT= ^("N") S L AB("commen t")=$$STRI NG^HMPD(.C MMT)
	20135	"RTN","HMP DLR",99,0)
	20136	Q
	20137	"RTN","HMP DLR",100,0 )
	20138	;
	20139	"RTN","HMP DLR",101,0 )
	20140	AP(LAB) ; -- return a Patholog y result i n LAB("att ribute")=v alue
	20141	"RTN","HMP DLR",102,0 )
	20142	K LAB ;i mplemented in HMPDLR A
	20143	"RTN","HMP DLR",103,0 )
	20144	Q
	20145	"RTN","HMP DLR",104,0 )
	20146	;
	20147	"RTN","HMP DLR",105,0 )
	20148	; ------- ----- Retu rn data to middle ti er ------- -----
	20149	"RTN","HMP DLR",106,0 )
	20150	;
	20151	"RTN","HMP DLR",107,0 )
	20152	XML(LAB) ; -- Return result as XML in @H MP@(#)
	20153	"RTN","HMP DLR",108,0 )
	20154	N ATT,X,Y ,P,NAMES,T AG
	20155	"RTN","HMP DLR",109,0 )
	20156	D ADD("<l ab>") S HM PTOTL=$G(H MPTOTL)+1
	20157	"RTN","HMP DLR",110,0 )
	20158	S ATT="" F S ATT=$ O(LAB(ATT) ) Q:ATT="" D D:$L( Y) ADD(Y)
	20159	"RTN","HMP DLR",111,0 )
	20160	. S X=$G( LAB(ATT)), Y="" Q:'$L (X)
	20161	"RTN","HMP DLR",112,0 )
	20162	. I ATT=" comment" S Y="<"_ATT _" xml:spa ce='preser ve'>"_$$ES C^HMPD(X)_ "</"_ATT_" >" Q
	20163	"RTN","HMP DLR",113,0 )
	20164	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	20165	"RTN","HMP DLR",114,0 )
	20166	. I $L(X) >1 D S Y= ""
	20167	"RTN","HMP DLR",115,0 )
	20168	.. S Y="< "_ATT_" ", NAMES="cod e^name^Z"
	20169	"RTN","HMP DLR",116,0 )
	20170	.. F P=1: 1 S TAG=$P (NAMES,U,P ) Q:TAG="Z " I $L($P (X,U,P)) S Y=Y_TAG_" ='"_$$ESC^ HMPD($P(X, U,P))_"' "
	20171	"RTN","HMP DLR",117,0 )
	20172	.. S Y=Y_ "/>" D ADD (Y)
	20173	"RTN","HMP DLR",118,0 )
	20174	D ADD("</ lab>")
	20175	"RTN","HMP DLR",119,0 )
	20176	Q
	20177	"RTN","HMP DLR",120,0 )
	20178	;
	20179	"RTN","HMP DLR",121,0 )
	20180	ADD(X) ; - - Add a li ne @HMP@(n )=X
	20181	"RTN","HMP DLR",122,0 )
	20182	S HMPI=$G (HMPI)+1
	20183	"RTN","HMP DLR",123,0 )
	20184	S @HMP@(H MPI)=X
	20185	"RTN","HMP DLR",124,0 )
	20186	Q
	20187	"RTN","HMP DLR",125,0 )
	20188	;
	20189	"RTN","HMP DLRA")
	20190	0^57^B7968 6061
	20191	"RTN","HMP DLRA",1,0)
	20192	HMPDLRA ;S LC/MKB,ASM R/RRB - La boratory e xtract by accession; Nov 05, 20 15 19:21:5 3
	20193	"RTN","HMP DLRA",2,0)
	20194	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	20195	"RTN","HMP DLRA",3,0)
	20196	;Per VA D irective 6 402, this routine sh ould not b e modified .
	20197	"RTN","HMP DLRA",4,0)
	20198	;
	20199	"RTN","HMP DLRA",5,0)
	20200	; Externa l Referenc es DBIA#
	20201	"RTN","HMP DLRA",6,0)
	20202	; ------- ---------- -- -----
	20203	"RTN","HMP DLRA",7,0)
	20204	; ^DPT 10035
	20205	"RTN","HMP DLRA",8,0)
	20206	; ^LAB(61 524
	20207	"RTN","HMP DLRA",9,0)
	20208	; ^LRO(68 1963
	20209	"RTN","HMP DLRA",10,0 )
	20210	; ^LRO(69 2407
	20211	"RTN","HMP DLRA",11,0 )
	20212	; ^LR 525
	20213	"RTN","HMP DLRA",12,0 )
	20214	; ^SC 10040
	20215	"RTN","HMP DLRA",13,0 )
	20216	; ^VA(200 10060
	20217	"RTN","HMP DLRA",14,0 )
	20218	; DIC 2051
	20219	"RTN","HMP DLRA",15,0 )
	20220	; DIQ 2056
	20221	"RTN","HMP DLRA",16,0 )
	20222	; LR7OR1, ^TMP("LRRR ",$J) 2503
	20223	"RTN","HMP DLRA",17,0 )
	20224	; LR7OSUM ,^TMP("LRC ",$J), 2766
	20225	"RTN","HMP DLRA",18,0 )
	20226	; ^TMP(" LRH",$J),^ TMP("LRT", $J)
	20227	"RTN","HMP DLRA",19,0 )
	20228	; ORX8 2467
	20229	"RTN","HMP DLRA",20,0 )
	20230	; PXAPI 1894
	20231	"RTN","HMP DLRA",21,0 )
	20232	; XUAF4 2171
	20233	"RTN","HMP DLRA",22,0 )
	20234	Q
	20235	"RTN","HMP DLRA",23,0 )
	20236	; ------- ----- Get results fr om VistA - ---------- -
	20237	"RTN","HMP DLRA",24,0 )
	20238	;
	20239	"RTN","HMP DLRA",25,0 )
	20240	EN(DFN,BEG ,END,MAX,I D) ; -- fi nd patient 's lab res ults
	20241	"RTN","HMP DLRA",26,0 )
	20242	N HMPSUB, HMPIDT,HMP N,HMPITM,L RDFN,LR0,O RD,X
	20243	"RTN","HMP DLRA",27,0 )
	20244	S DFN=+$G (DFN) Q:$G (DFN)<1
	20245	"RTN","HMP DLRA",28,0 )
	20246	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	20247	"RTN","HMP DLRA",29,0 )
	20248	S HMPSUB= $G(FILTER( "type")),L RDFN=$$LRD FN^HMPXGLA B(DFN) ;D E2818, (#6 3) LABORAT ORY REFERE NCE
	20249	"RTN","HMP DLRA",30,0 )
	20250	K ^TMP("L RRR",$J,DF N)
	20251	"RTN","HMP DLRA",31,0 )
	20252	;
	20253	"RTN","HMP DLRA",32,0 )
	20254	; get res ult(s)
	20255	"RTN","HMP DLRA",33,0 )
	20256	I $L($G(I D)) D ;re set search parameter s
	20257	"RTN","HMP DLRA",34,0 )
	20258	. S HMPSU B=$P(ID,"; "),HMPIDT= +$P(ID,";" ,2)
	20259	"RTN","HMP DLRA",35,0 )
	20260	. S:HMPID T (BEG,END )=9999999- HMPIDT
	20261	"RTN","HMP DLRA",36,0 )
	20262	;
	20263	"RTN","HMP DLRA",37,0 )
	20264	D RR^LR7O R1(DFN,,BE G,END,HMPS UB,,,MAX)
	20265	"RTN","HMP DLRA",38,0 )
	20266	S HMPSUB= "" F S HM PSUB=$O(^T MP("LRRR", $J,DFN,HMP SUB)) Q:HM PSUB="" D
	20267	"RTN","HMP DLRA",39,0 )
	20268	. S HMPID T=0 F S H MPIDT=$O(^ TMP("LRRR" ,$J,DFN,HM PSUB,HMPID T)) Q:HMPI DT<1 I $O (^(HMPIDT, 0)) D
	20269	"RTN","HMP DLRA",40,0 )
	20270	.. K HMPI TM,ORD,CMM T,^TMP("HM PTEXT",$J)
	20271	"RTN","HMP DLRA",41,0 )
	20272	.. I "CH^ MI"'[HMPSU B D AP(.HM PITM),XML( .HMPITM) Q
	20273	"RTN","HMP DLRA",42,0 )
	20274	.. S HMPI TM("type") =HMPSUB,HM PITM("id") =HMPSUB_"; "_HMPIDT
	20275	"RTN","HMP DLRA",43,0 )
	20276	.. S HMPI TM("collec ted")=9999 999-HMPIDT ,HMPITM("s tatus")="c ompleted"
	20277	"RTN","HMP DLRA",44,0 )
	20278	.. S LR0= $G(^LR(LRD FN,HMPSUB, HMPIDT,0))
	20279	"RTN","HMP DLRA",45,0 )
	20280	.. S HMPI TM("result ed")=$P(LR 0,U,3),X=+ $P(LR0,U,5 ) I X D
	20281	"RTN","HMP DLRA",46,0 )
	20282	... N IEN S,HMPY S I ENS=X_","
	20283	"RTN","HMP DLRA",47,0 )
	20284	... D GET S^DIQ(61,I ENS,".01;2 ;4.1",,"HM PY")
	20285	"RTN","HMP DLRA",48,0 )
	20286	... S HMP ITM("speci men")=$G(H MPY(61,IEN S,2))_U_$G (HMPY(61,I ENS,.01)) ;SNOMED^na me
	20287	"RTN","HMP DLRA",49,0 )
	20288	... S HMP ITM("sampl e")=$G(HMP Y(61,IENS, 4.1)) ;nam e
	20289	"RTN","HMP DLRA",50,0 )
	20290	.. S X=$P (LR0,U,6), HMPITM("na me")=$$ARE A(X),HMPIT M("groupNa me")=X
	20291	"RTN","HMP DLRA",51,0 )
	20292	.. S X=+$ P(LR0,U,14 ) S:X HMPI TM("facili ty")=$$STA ^XUAF4(X)_ U_$P($$NS^ XUAF4(X),U )
	20293	"RTN","HMP DLRA",52,0 )
	20294	.. I 'X S HMPITM("f acility")= $$FAC^HMPD ;local st n#^name
	20295	"RTN","HMP DLRA",53,0 )
	20296	.. I HMPS UB="MI" D ;report
	20297	"RTN","HMP DLRA",54,0 )
	20298	... S HMP ITM("docum ent",1)=HM PSUB_";"_H MPIDT_"^LR MICROBIOL OGY REPORT ^LABORATOR Y NOTE"
	20299	"RTN","HMP DLRA",55,0 )
	20300	... S:$G( HMPTEXT) H MPITM("doc ument",1," content")= $$TEXT(DFN ,HMPSUB,HM PIDT)
	20301	"RTN","HMP DLRA",56,0 )
	20302	.. S HMPN =0 F S HM PN=$O(^TMP ("LRRR",$J ,DFN,HMPSU B,HMPIDT,H MPN)) Q:HM PN<1 D
	20303	"RTN","HMP DLRA",57,0 )
	20304	... S X=$ S(HMPSUB=" MI":$$MI,1 :$$CH)
	20305	"RTN","HMP DLRA",58,0 )
	20306	... S:$L( X) HMPITM( "value",HM PN)=X
	20307	"RTN","HMP DLRA",59,0 )
	20308	... S:$G( ORD) HMPIT M("labOrde rID")=ORD
	20309	"RTN","HMP DLRA",60,0 )
	20310	.. I $D(^ TMP("LRRR" ,$J,DFN,HM PSUB,HMPID T,"N")) M CMMT=^("N" ) S HMPITM ("comment" )=$$STRING ^HMPD(.CMM T)
	20311	"RTN","HMP DLRA",61,0 )
	20312	.. D XML( .HMPITM)
	20313	"RTN","HMP DLRA",62,0 )
	20314	K ^TMP("L RRR",$J,DF N),^TMP("H MPTEXT",$J )
	20315	"RTN","HMP DLRA",63,0 )
	20316	Q
	20317	"RTN","HMP DLRA",64,0 )
	20318	;
	20319	"RTN","HMP DLRA",65,0 )
	20320	CH() ; -- return a C hemistry r esult as:
	20321	"RTN","HMP DLRA",66,0 )
	20322	; id^te st^result^ interpreta tion^units ^low^high^ localName^ loinc^vuid ^order
	20323	"RTN","HMP DLRA",67,0 )
	20324	; Expec ts ^TMP("L RRR",$J,DF N,"CH",HMP IDT,HMPN), LRDFN
	20325	"RTN","HMP DLRA",68,0 )
	20326	N X,Y,X0, NODE,CMMT, LOINC
	20327	"RTN","HMP DLRA",69,0 )
	20328	S X0=$G(^ TMP("LRRR" ,$J,DFN,"C H",HMPIDT, HMPN)),NOD E=$G(^LR(L RDFN,"CH", HMPIDT,HMP N))
	20329	"RTN","HMP DLRA",70,0 )
	20330	S X=$$LAB TSTNM^HMPX GLAB(+X0) ; DE2818
	20331	"RTN","HMP DLRA",71,0 )
	20332	S Y="CH;" _HMPIDT_"; "_HMPN_U_X _U_$P(X0,U ,2,4)
	20333	"RTN","HMP DLRA",72,0 )
	20334	S X=$P(X0 ,U,5) I $L (X),X["-" S X=$TR(X, "- ","^"), $P(Y,U,6,7 )=X
	20335	"RTN","HMP DLRA",73,0 )
	20336	S $P(Y,U, 8)=$P(X0,U ,15) ;test short nam e
	20337	"RTN","HMP DLRA",74,0 )
	20338	S X=$P($P (NODE,U,3) ,"!",3) S: X LOINC=$$ GET1^DIQ(9 5.3,X_",", .01)
	20339	"RTN","HMP DLRA",75,0 )
	20340	S:$G(LOIN C) $P(Y,U, 9,10)=LOIN C_U_$$VUID ^HMPD(+LOI NC,95.3)
	20341	"RTN","HMP DLRA",76,0 )
	20342	S ORD=+$P (X0,U,17), X=$$ORDER( ORD,+X0) S :X $P(Y,U, 11)=X
	20343	"RTN","HMP DLRA",77,0 )
	20344	Q Y
	20345	"RTN","HMP DLRA",78,0 )
	20346	;
	20347	"RTN","HMP DLRA",79,0 )
	20348	MI() ; -- return a M icrobiolog y result a s:
	20349	"RTN","HMP DLRA",80,0 )
	20350	; id^te st^result^ interpreta tion^units
	20351	"RTN","HMP DLRA",81,0 )
	20352	; Expec ts ^TMP("L RRR",$J,DF N,"MI",HMP IDT,HMPN)
	20353	"RTN","HMP DLRA",82,0 )
	20354	N Y,X0
	20355	"RTN","HMP DLRA",83,0 )
	20356	S X0=$G(^ TMP("LRRR" ,$J,DFN,"M I",HMPIDT, HMPN)),Y=" "
	20357	"RTN","HMP DLRA",84,0 )
	20358	S:$L($P(X 0,U))>1 Y= "MI;"_HMPI DT_";"_HMP N_U_$P(X0, U,1,4)
	20359	"RTN","HMP DLRA",85,0 )
	20360	S ORD=+$P (X0,U,17)
	20361	"RTN","HMP DLRA",86,0 )
	20362	Q Y
	20363	"RTN","HMP DLRA",87,0 )
	20364	;
	20365	"RTN","HMP DLRA",88,0 )
	20366	AP(LAB) ; -- return a Patholog y result i n LAB("att ribute")=v alue
	20367	"RTN","HMP DLRA",89,0 )
	20368	N LR0,X,I ,NODE
	20369	"RTN","HMP DLRA",90,0 )
	20370	S LR0=$G( ^LR(LRDFN, HMPSUB,HMP IDT,0))
	20371	"RTN","HMP DLRA",91,0 )
	20372	S LAB("ty pe")=HMPSU B,LAB("id" )=HMPSUB_" ;"_HMPIDT
	20373	"RTN","HMP DLRA",92,0 )
	20374	S LAB("co llected")= 9999999-HM PIDT,LAB(" status")=" completed"
	20375	"RTN","HMP DLRA",93,0 )
	20376	S LAB("re sulted")=$ P(LR0,U,11 ),LAB("gro upName")=$ P(LR0,U,6)
	20377	"RTN","HMP DLRA",94,0 )
	20378	S X="",I= 0 F S I=$ O(^LR(LRDF N,HMPSUB,H MPIDT,.1,I )) Q:I<1 S X=X_$S($ L(X):", ", 1:"")_$P($ G(^(I,0)), U)
	20379	"RTN","HMP DLRA",95,0 )
	20380	S:$L(X) L AB("specim en")=U_X
	20381	"RTN","HMP DLRA",96,0 )
	20382	S LAB("fa cility")=$ $FAC^HMPD
	20383	"RTN","HMP DLRA",97,0 )
	20384	S NODE=$S (HMPSUB="A U":$NA(^LR (LRDFN,101 )),1:$NA(^ LR(LRDFN,H MPSUB,HMPI DT,.05)))
	20385	"RTN","HMP DLRA",98,0 )
	20386	S I=0 F S I=$O(@NO DE@(I)) Q: I<1 S X=+ $P($G(@NOD E@(I,0)),U ,2) I X D
	20387	"RTN","HMP DLRA",99,0 )
	20388	. N LT,NT ,HMPY
	20389	"RTN","HMP DLRA",100, 0)
	20390	. S LT=$$ GET1^DIQ(8 925,+X_"," ,.01) Q:$P (LT," ")=" Addendum"
	20391	"RTN","HMP DLRA",101, 0)
	20392	. S NT=$$ GET1^DIQ(8 925,+X_"," ,".01:1501 ") S:NT="" NT="LABOR ATORY NOTE "
	20393	"RTN","HMP DLRA",102, 0)
	20394	. S LAB(" document", I)=+X_U_LT _U_NT
	20395	"RTN","HMP DLRA",103, 0)
	20396	. S:$G(HM PTEXT) LAB ("document ",I,"conte nt")=$$TEX T^HMPDTIU( +X)
	20397	"RTN","HMP DLRA",104, 0)
	20398	I '$O(LAB ("document ",0)) D ; non-TIU re ports
	20399	"RTN","HMP DLRA",105, 0)
	20400	. S LAB(" document", 1)=HMPSUB_ ";"_HMPIDT _"^LR "_$$ NAME(HMPSU B)_" REPOR T^LABORATO RY NOTE"
	20401	"RTN","HMP DLRA",106, 0)
	20402	. S:$G(HM PTEXT) LAB ("document ",1,"conte nt")=$$TEX T(DFN,HMPS UB,HMPIDT)
	20403	"RTN","HMP DLRA",107, 0)
	20404	Q
	20405	"RTN","HMP DLRA",108, 0)
	20406	;
	20407	"RTN","HMP DLRA",109, 0)
	20408	ORDER(LABO RD,TEST) ; -- return #100 orde r^name for Lab order # & Test
	20409	"RTN","HMP DLRA",110, 0)
	20410	N Y,D,S,T
	20411	"RTN","HMP DLRA",111, 0)
	20412	S D=$P(99 99999-HMPI DT,"."),Y= ""
	20413	"RTN","HMP DLRA",112, 0)
	20414	S S=0 F S S=$O(^LR O(69,"C",L ABORD,D,S) ) Q:S<1 D Q:Y
	20415	"RTN","HMP DLRA",113, 0)
	20416	. S T=0 F S T=$O(^ LRO(69,D,1 ,S,2,T)) Q :T<1 I 'T EST!(+$G(^ (T,0))=TES T) S Y=+$P (^(0),U,7)
	20417	"RTN","HMP DLRA",114, 0)
	20418	;I Y S Y= Y_U_$P($$O I^ORX8(Y), U,2)
	20419	"RTN","HMP DLRA",115, 0)
	20420	Q Y
	20421	"RTN","HMP DLRA",116, 0)
	20422	;
	20423	"RTN","HMP DLRA",117, 0)
	20424	NAME(X) ; -- Return name of su bscript X
	20425	"RTN","HMP DLRA",118, 0)
	20426	I X="AU" Q "AUTOPSY "
	20427	"RTN","HMP DLRA",119, 0)
	20428	I X="BB" Q "BLOOD B ANK"
	20429	"RTN","HMP DLRA",120, 0)
	20430	I X="CH" Q "CHEM,HE M,TOX,RIA, SER,etc."
	20431	"RTN","HMP DLRA",121, 0)
	20432	I X="CY" Q "CYTOPAT HOLOGY"
	20433	"RTN","HMP DLRA",122, 0)
	20434	I X="EM" Q "ELECTRO N MICROSCO PY"
	20435	"RTN","HMP DLRA",123, 0)
	20436	I X="MI" Q "MICROBI OLOGY"
	20437	"RTN","HMP DLRA",124, 0)
	20438	I X="SP" Q "SURGICA L PATHOLOG Y"
	20439	"RTN","HMP DLRA",125, 0)
	20440	Q "ANATOM IC PATHOLO GY"
	20441	"RTN","HMP DLRA",126, 0)
	20442	;
	20443	"RTN","HMP DLRA",127, 0)
	20444	AREA(ACCNU M) ; -- Re turn name of accessi on area
	20445	"RTN","HMP DLRA",128, 0)
	20446	N X,Y,HMP A
	20447	"RTN","HMP DLRA",129, 0)
	20448	S X=$P($G (ACCNUM)," "),Y=""
	20449	"RTN","HMP DLRA",130, 0)
	20450	I $L(X) D FIND^DIC( 68,,.01,"Q X",X,,,,," HMPA")
	20451	"RTN","HMP DLRA",131, 0)
	20452	S Y=$G(HM PA("DILIST ",1,1))
	20453	"RTN","HMP DLRA",132, 0)
	20454	Q Y
	20455	"RTN","HMP DLRA",133, 0)
	20456	;
	20457	"RTN","HMP DLRA",134, 0)
	20458	; ------- ----- Get report(s) [via HMPDT IU] ------ ------
	20459	"RTN","HMP DLRA",135, 0)
	20460	;
	20461	"RTN","HMP DLRA",136, 0)
	20462	RPTS(DFN,B EG,END,MAX ) ; -- fin d patient' s lab repo rts
	20463	"RTN","HMP DLRA",137, 0)
	20464	N HMPSUB, HMPIDT,HMP ITM,HMPTIU ,HMPXID,LR DFN,HMPN,D A
	20465	"RTN","HMP DLRA",138, 0)
	20466	S DFN=+$G (DFN) Q:$G (DFN)<1
	20467	"RTN","HMP DLRA",139, 0)
	20468	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	20469	"RTN","HMP DLRA",140, 0)
	20470	S LRDFN=$ $LRDFN^HMP XGLAB(DFN) ;DE2818, (#63) LAB ORATORY RE FERENCE
	20471	"RTN","HMP DLRA",141, 0)
	20472	K ^TMP("L RRR",$J,DF N) D RR^LR 7OR1(DFN,, BEG,END,"A P",,,MAX)
	20473	"RTN","HMP DLRA",142, 0)
	20474	S HMPSUB= "" F S HM PSUB=$O(^T MP("LRRR", $J,DFN,HMP SUB)) Q:HM PSUB="" D
	20475	"RTN","HMP DLRA",143, 0)
	20476	. S HMPID T=0 F S H MPIDT=$O(^ TMP("LRRR" ,$J,DFN,HM PSUB,HMPID T)) Q:HMPI DT<1 I $O (^(HMPIDT, 0)) D
	20477	"RTN","HMP DLRA",144, 0)
	20478	.. S HMPT IU=$S(HMPS UB="AU":$N A(^LR(LRDF N,101)),1: $NA(^LR(LR DFN,HMPSUB ,HMPIDT,.0 5)))
	20479	"RTN","HMP DLRA",145, 0)
	20480	.. K HMPI TM S HMPXI D=HMPSUB_" ;"_HMPIDT
	20481	"RTN","HMP DLRA",146, 0)
	20482	.. I '$O( @HMPTIU@(0 )) D RPT1( DFN,HMPXID ,.HMPITM), XML^HMPDTI U(.HMPITM) :$D(HMPITM ) Q
	20483	"RTN","HMP DLRA",147, 0)
	20484	.. S HMPN =0 F S HM PN=$O(@HMP TIU@(HMPN) ) Q:HMPN<1 D
	20485	"RTN","HMP DLRA",148, 0)
	20486	... S DA= +$P($G(@HM PTIU@(HMPN ,0)),U,2) Q:DA<1 K HMPITM
	20487	"RTN","HMP DLRA",149, 0)
	20488	... D EN1 ^HMPDTIU(D A,.HMPITM) ,XML^HMPDT IU(.HMPITM ):$D(HMPIT M)
	20489	"RTN","HMP DLRA",150, 0)
	20490	K ^TMP("L RRR",$J,DF N),^TMP("H MPTEXT",$J )
	20491	"RTN","HMP DLRA",151, 0)
	20492	Q
	20493	"RTN","HMP DLRA",152, 0)
	20494	;
	20495	"RTN","HMP DLRA",153, 0)
	20496	RPT1(DFN,I D,RPT) ; - - return r eport as a TIU docum ent
	20497	"RTN","HMP DLRA",154, 0)
	20498	S DFN=+$G (DFN),ID=$ G(ID) Q:DF N<1 Q:'$L (ID)
	20499	"RTN","HMP DLRA",155, 0)
	20500	N SUB,IDT ,LRDFN,LR0 ,X,LOC
	20501	"RTN","HMP DLRA",156, 0)
	20502	K RPT,^TM P("HMPTEXT ",$J)
	20503	"RTN","HMP DLRA",157, 0)
	20504	S SUB=$P( ID,";"),ID T=+$P(ID," ;",2),LRDF N=$$LRDFN^ HMPXGLAB(D FN) ;DE28 18, (#63) LABORATORY REFERENCE
	20505	"RTN","HMP DLRA",158, 0)
	20506	S LR0=$S( SUB="AU":$ G(^LR(LRDF N,"AU")),1 :$G(^LR(LR DFN,SUB,ID T,0)))
	20507	"RTN","HMP DLRA",159, 0)
	20508	S RPT("id ")=ID,RPT( "reference DateTime") =9999999-I DT
	20509	"RTN","HMP DLRA",160, 0)
	20510	S RPT("lo calTitle") ="LR "_$$N AME(SUB)_" REPORT"
	20511	"RTN","HMP DLRA",161, 0)
	20512	S RPT("do cumentClas s")="LR LA BORATORY R EPORTS"
	20513	"RTN","HMP DLRA",162, 0)
	20514	S RPT("na tionalTitl e")="46971 05^LABORAT ORY NOTE"
	20515	"RTN","HMP DLRA",163, 0)
	20516	S RPT("na tionalTitl eSubject") ="4697104^ LABORATORY "
	20517	"RTN","HMP DLRA",164, 0)
	20518	S RPT("na tionalTitl eType")="4 696120^NOT E"
	20519	"RTN","HMP DLRA",165, 0)
	20520	S RPT("ty pe")="LR", RPT("statu s")="COMPL ETED"
	20521	"RTN","HMP DLRA",166, 0)
	20522	S:$G(FILT ER("loinc" )) RPT("lo inc")=$P(F ILTER("loi nc"),U)
	20523	"RTN","HMP DLRA",167, 0)
	20524	S X=$P(LR 0,U,$S(SUB ="AU":5,1: 8)),LOC="" S:$L(X) L OC=+$O(^SC ("B",X,0)) ;DE2818, *fix ne eded to ge t location IEN*
	20525	"RTN","HMP DLRA",168, 0)
	20526	S RPT("fa cility")=$ $FAC^HMPD( LOC)
	20527	"RTN","HMP DLRA",169, 0)
	20528	I LOC D ;look-up v isit
	20529	"RTN","HMP DLRA",170, 0)
	20530	. N CDT S CDT=99999 99-IDT
	20531	"RTN","HMP DLRA",171, 0)
	20532	. S X=$$G ETENC^PXAP I(DFN,CDT, LOC)
	20533	"RTN","HMP DLRA",172, 0)
	20534	. S:X RPT ("encounte r")=+X
	20535	"RTN","HMP DLRA",173, 0)
	20536	S X=+$P(L R0,U,$S(SU B="AU":10, 1:2)) ;pat hologist
	20537	"RTN","HMP DLRA",174, 0)
	20538	S:X RPT(" clinician" ,1)=X_U_$$ GET1^DIQ(2 00,X_",",. 01)_"^A" ;DE2818, c hanged glo bal read t o FileMan
	20539	"RTN","HMP DLRA",175, 0)
	20540	S X=$S(SU B="AU":$P( LR0,U,15,1 6),1:$P(LR 0,U,11)_U_ $P(LR0,U,1 3)) I X D
	20541	"RTN","HMP DLRA",176, 0)
	20542	. N Y S Y =$P(X,U,2)
	20543	"RTN","HMP DLRA",177, 0)
	20544	. ;DE2818 , changed global rea d to FileM an - (#.01 ) NAME and (#1) INIT IAL
	20545	"RTN","HMP DLRA",178, 0)
	20546	. S RPT(" clinician" ,2)=Y_U_$$ GET1^DIQ(2 00,+Y_",", .01)_"^S^" _+X_U_$$GE T1^DIQ(200 ,+Y_",",1)
	20547	"RTN","HMP DLRA",179, 0)
	20548	S:$G(HMPT EXT) RPT(" content")= $$TEXT(DFN ,SUB,IDT)
	20549	"RTN","HMP DLRA",180, 0)
	20550	Q
	20551	"RTN","HMP DLRA",181, 0)
	20552	;
	20553	"RTN","HMP DLRA",182, 0)
	20554	TEXT(DFN,S UB,IDT) ; -- Get rep ort text, return tem p array na me
	20555	"RTN","HMP DLRA",183, 0)
	20556	N LRDFN,D ATE,NAME,H MPS,HMPY,I ,X,Y
	20557	"RTN","HMP DLRA",184, 0)
	20558	K ^TMP("L RC",$J),^T MP("LRH",$ J),^TMP("L RT",$J)
	20559	"RTN","HMP DLRA",185, 0)
	20560	S DATE=99 99999-+$G( IDT),NAME= $$NAME(SUB ),HMPS(NAM E)=""
	20561	"RTN","HMP DLRA",186, 0)
	20562	D EN^LR7O SUM(.HMPY, DFN,DATE,D ATE,,,.HMP S)
	20563	"RTN","HMP DLRA",187, 0)
	20564	S Y=$NA(^ TMP("HMPTE XT",$J,SUB _";"_IDT)) K @Y
	20565	"RTN","HMP DLRA",188, 0)
	20566	S I=+$G(^ TMP("LRH", $J,NAME)) ;LRH=heade r
	20567	"RTN","HMP DLRA",189, 0)
	20568	F S I=$O (^TMP("LRC ",$J,I)) Q :I<1 S X= $G(^(I,0)) Q:X?1."=" S @Y@(I) =X
	20569	"RTN","HMP DLRA",190, 0)
	20570	K ^TMP("L RC",$J),^T MP("LRH",$ J),^TMP("L RT",$J)
	20571	"RTN","HMP DLRA",191, 0)
	20572	Q Y
	20573	"RTN","HMP DLRA",192, 0)
	20574	;
	20575	"RTN","HMP DLRA",193, 0)
	20576	; ------- ----- Retu rn data to middle ti er ------- -----
	20577	"RTN","HMP DLRA",194, 0)
	20578	;
	20579	"RTN","HMP DLRA",195, 0)
	20580	XML(LAB) ; -- Return result as XML in @H MP@(#)
	20581	"RTN","HMP DLRA",196, 0)
	20582	N ATT,X,Y ,NAMES,I,J
	20583	"RTN","HMP DLRA",197, 0)
	20584	D ADD("<a ccession>" ) S HMPTOT L=$G(HMPTO TL)+1
	20585	"RTN","HMP DLRA",198, 0)
	20586	S ATT="" F S ATT=$ O(LAB(ATT) ) Q:ATT="" D D:$L( Y) ADD(Y)
	20587	"RTN","HMP DLRA",199, 0)
	20588	. I $O(LA B(ATT,0)) D S Y="" Q
	20589	"RTN","HMP DLRA",200, 0)
	20590	.. D ADD( "<"_ATT_"s >")
	20591	"RTN","HMP DLRA",201, 0)
	20592	.. S NAME S=$S(ATT=" document": "id^localT itle^natio nalTitle^Z ",ATT="val ue":"id^te st^result^ interpreta tion^units ^low^high^ localName^ loinc^vuid ^order^Z", 1:"code^na me^Z")
	20593	"RTN","HMP DLRA",202, 0)
	20594	.. S I=0 F S I=$O( LAB(ATT,I) ) Q:I<1 D
	20595	"RTN","HMP DLRA",203, 0)
	20596	... S X=$ G(LAB(ATT, I))
	20597	"RTN","HMP DLRA",204, 0)
	20598	... S Y=" <"_ATT_" " _$$LOOP ;_ "/>" D ADD (Y)
	20599	"RTN","HMP DLRA",205, 0)
	20600	... S X=$ G(LAB(ATT, I,"content ")) I '$L( X) S Y=Y_" />" D ADD( Y) Q
	20601	"RTN","HMP DLRA",206, 0)
	20602	... S Y=Y _">" D ADD (Y)
	20603	"RTN","HMP DLRA",207, 0)
	20604	... S Y=" <content x ml:space=' preserve'> " D ADD(Y)
	20605	"RTN","HMP DLRA",208, 0)
	20606	... S J=0 F S J=$O (@X@(J)) Q :J<1 S Y= $$ESC^HMPD (@X@(J)) D ADD(Y)
	20607	"RTN","HMP DLRA",209, 0)
	20608	... D ADD ("</conten t>"),ADD(" </"_ATT_"> ")
	20609	"RTN","HMP DLRA",210, 0)
	20610	.. D ADD( "</"_ATT_" s>")
	20611	"RTN","HMP DLRA",211, 0)
	20612	. S X=$G( LAB(ATT)), Y="" Q:'$L (X)
	20613	"RTN","HMP DLRA",212, 0)
	20614	. I ATT=" comment" S Y="<"_ATT _" xml:spa ce='preser ve'>"_$$ES C^HMPD(X)_ "</"_ATT_" >" Q
	20615	"RTN","HMP DLRA",213, 0)
	20616	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	20617	"RTN","HMP DLRA",214, 0)
	20618	. I $L(X) >1 D S Y= ""
	20619	"RTN","HMP DLRA",215, 0)
	20620	.. S NAME S="code^na me^Z"
	20621	"RTN","HMP DLRA",216, 0)
	20622	.. S Y="< "_ATT_" "_ $$LOOP_"/> " D ADD(Y)
	20623	"RTN","HMP DLRA",217, 0)
	20624	D ADD("</ accession> ")
	20625	"RTN","HMP DLRA",218, 0)
	20626	Q
	20627	"RTN","HMP DLRA",219, 0)
	20628	;
	20629	"RTN","HMP DLRA",220, 0)
	20630	LOOP() ; - - build su b-items st ring from NAMES and X
	20631	"RTN","HMP DLRA",221, 0)
	20632	N STR,P,T AG S STR=" "
	20633	"RTN","HMP DLRA",222, 0)
	20634	F P=1:1 S TAG=$P(NA MES,U,P) Q :TAG="Z" I $L($P(X, U,P)) S ST R=STR_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	20635	"RTN","HMP DLRA",223, 0)
	20636	Q STR
	20637	"RTN","HMP DLRA",224, 0)
	20638	;
	20639	"RTN","HMP DLRA",225, 0)
	20640	ADD(X) ; - - Add a li ne @HMP@(n )=X
	20641	"RTN","HMP DLRA",226, 0)
	20642	S HMPI=$G (HMPI)+1
	20643	"RTN","HMP DLRA",227, 0)
	20644	S @HMP@(H MPI)=X
	20645	"RTN","HMP DLRA",228, 0)
	20646	Q
	20647	"RTN","HMP DLRO")
	20648	1^164
	20649	"RTN","HMP DMC")
	20650	0^59^B5818 1283
	20651	"RTN","HMP DMC",1,0)
	20652	HMPDMC ;SL C/MKB,ASMR /RRB - Cli nical Proc edures (Me dicine);No v 05, 2015 19:31:41
	20653	"RTN","HMP DMC",2,0)
	20654	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	20655	"RTN","HMP DMC",3,0)
	20656	;Per VA D irective 6 402, this routine sh ould not b e modified .
	20657	"RTN","HMP DMC",4,0)
	20658	;
	20659	"RTN","HMP DMC",5,0)
	20660	; DE2818, ^SC and ^ VA(200) re ferences s upprted
	20661	"RTN","HMP DMC",6,0)
	20662	; Externa l Referenc es DBIA#
	20663	"RTN","HMP DMC",7,0)
	20664	; ------- ---------- -- -----
	20665	"RTN","HMP DMC",8,0)
	20666	; ^SC 10040
	20667	"RTN","HMP DMC",9,0)
	20668	; ^TIU(89 25.1 5677
	20669	"RTN","HMP DMC",10,0)
	20670	; ^VA(200 10060
	20671	"RTN","HMP DMC",11,0)
	20672	; %DT 10003
	20673	"RTN","HMP DMC",12,0)
	20674	; DILFD 2055
	20675	"RTN","HMP DMC",13,0)
	20676	; DIQ 2056
	20677	"RTN","HMP DMC",14,0)
	20678	; GMRCGUI B 2980
	20679	"RTN","HMP DMC",15,0)
	20680	; ICPTCOD 1995
	20681	"RTN","HMP DMC",16,0)
	20682	; MCARUTL 2 3279
	20683	"RTN","HMP DMC",17,0)
	20684	; MCARUTL 3 3280
	20685	"RTN","HMP DMC",18,0)
	20686	; MDPS1,^ TMP("MDHSP "/"MDPTXT" 4230
	20687	"RTN","HMP DMC",19,0)
	20688	; TIULQ 2693
	20689	"RTN","HMP DMC",20,0)
	20690	; TIUSRVL O 2834
	20691	"RTN","HMP DMC",21,0)
	20692	; XUAF4 2171
	20693	"RTN","HMP DMC",22,0)
	20694	Q
	20695	"RTN","HMP DMC",23,0)
	20696	; ------- ----- Get procedures from Vist A -------- ----
	20697	"RTN","HMP DMC",24,0)
	20698	;
	20699	"RTN","HMP DMC",25,0)
	20700	EN(DFN,BEG ,END,MAX,I D) ; -- fi nd patient 's procedu res
	20701	"RTN","HMP DMC",26,0)
	20702	N HMPITM, RES,HMPN,H MPX,RTN,DA TE,CONS,TI UN,X0,DA,G BL,X,Y,%DT ,HMPT,LT,N T,LOC
	20703	"RTN","HMP DMC",27,0)
	20704	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	20705	"RTN","HMP DMC",28,0)
	20706	S DFN=+$G (DFN) Q:DF N<1
	20707	"RTN","HMP DMC",29,0)
	20708	;
	20709	"RTN","HMP DMC",30,0)
	20710	; get one procedure
	20711	"RTN","HMP DMC",31,0)
	20712	I $G(ID) D ;reset dates for MDPS1
	20713	"RTN","HMP DMC",32,0)
	20714	. N HMPMC ,IEN,FILE
	20715	"RTN","HMP DMC",33,0)
	20716	. S IEN=+ ID,FILE=+$ P(ID,"(",2 ) Q:FILE=7 02
	20717	"RTN","HMP DMC",34,0)
	20718	. D MEDLK UP^MCARUTL 3(.HMPMC,F ILE,IEN)
	20719	"RTN","HMP DMC",35,0)
	20720	. S X=$P( HMPMC,U,6) S:X (BEG, END)=X
	20721	"RTN","HMP DMC",36,0)
	20722	;
	20723	"RTN","HMP DMC",37,0)
	20724	; get all procedure s
	20725	"RTN","HMP DMC",38,0)
	20726	K ^TMP("M DHSP",$J) S RES=""
	20727	"RTN","HMP DMC",39,0)
	20728	D EN1^MDP S1(RES,DFN ,BEG,END,M AX,"",0)
	20729	"RTN","HMP DMC",40,0)
	20730	S HMPN=0 F S HMPN= $O(^TMP("M DHSP",$J,H MPN)) Q:HM PN<1 S HM PX=$G(^(HM PN)) D
	20731	"RTN","HMP DMC",41,0)
	20732	. I $G(ID ),ID'=+$P( HMPX,U,2) Q ;upda te one pro cedure
	20733	"RTN","HMP DMC",42,0)
	20734	. S RTN=$ P(HMPX,U,3 ,4) Q:RTN= "PRPRO^MDP S4" ;skip non-CP it ems
	20735	"RTN","HMP DMC",43,0)
	20736	. S X=$P( HMPX,U,6), %DT="TX" D ^%DT S:Y> 0 DATE=Y
	20737	"RTN","HMP DMC",44,0)
	20738	. S GBL=+ $P(HMPX,U, 2)_";"_$S( RTN="PR702 ^MDPS1":"M DD(702,",1 :$$ROOT(DF N,$P(HMPX, U,11),DATE ))
	20739	"RTN","HMP DMC",45,0)
	20740	. Q:'GBL I $G(ID), ID'=GBL Q ;unkn own, or no t requeste d
	20741	"RTN","HMP DMC",46,0)
	20742	. ;
	20743	"RTN","HMP DMC",47,0)
	20744	. S CONS= +$P(HMPX,U ,13) D:CON S DOCLIST^ GMRCGUIB(. HMPD,CONS) S X0=$G(H MPD(0)) ;= ^GMR(123,I D,0)
	20745	"RTN","HMP DMC",48,0)
	20746	. S TIUN= +$P(HMPX,U ,14) S:TIU N TIUN=TIU N_U_$$RESO LVE^TIUSRV LO(TIUN)
	20747	"RTN","HMP DMC",49,0)
	20748	A . ;
	20749	"RTN","HMP DMC",50,0)
	20750	. K HMPIT M S HMPITM ("id")=GBL ,HMPITM("n ame")=$P(H MPX,U)
	20751	"RTN","HMP DMC",51,0)
	20752	. S HMPIT M("dateTim e")=DATE,H MPITM("cat egory")="C P"
	20753	"RTN","HMP DMC",52,0)
	20754	. S X=$P( HMPX,U,7) S:$L(X) HM PITM("inte rpretation ")=X
	20755	"RTN","HMP DMC",53,0)
	20756	. I CONS, X0 D
	20757	"RTN","HMP DMC",54,0)
	20758	.. N HMPJ S HMPITM( "consult") =CONS
	20759	"RTN","HMP DMC",55,0)
	20760	.. S HMPI TM("reques ted")=+X0, HMPITM("or der")=+$P( X0,U,3)
	20761	"RTN","HMP DMC",56,0)
	20762	.. S HMPI TM("status ")=$$EXTER NAL^DILFD( 123,8,,$P( X0,U,12))
	20763	"RTN","HMP DMC",57,0)
	20764	.. S HMPJ =0 F S HM PJ=$O(HMPD (50,HMPJ)) Q:HMPJ<1 S X=+$G(H MPD(50,HMP J)) D
	20765	"RTN","HMP DMC",58,0)
	20766	... K HMP T D EXTRAC T^TIULQ(X, "HMPT",,.0 1) S LT=$G (HMPT(X,.0 1,"E"))
	20767	"RTN","HMP DMC",59,0)
	20768	... S NT= $$GET1^DIQ (8925.1,+$ G(HMPT(X,. 01,"I"))_" ,",1501)
	20769	"RTN","HMP DMC",60,0)
	20770	... S HMP ITM("docum ent",X)=X_ U_LT_U_NT ;ien^loca l^national title
	20771	"RTN","HMP DMC",61,0)
	20772	... S:$G( HMPTEXT) H MPITM("doc ument",X," content")= $$TEXT^HMP DTIU(X)
	20773	"RTN","HMP DMC",62,0)
	20774	... S:'TI UN TIUN=X ;get suppo rting fiel ds
	20775	"RTN","HMP DMC",63,0)
	20776	B . ;
	20777	"RTN","HMP DMC",64,0)
	20778	. I TIUN D
	20779	"RTN","HMP DMC",65,0)
	20780	.. S X=$P (TIUN,U,5) S:X HMPIT M("provide r")=+X_U_$ P(X,";",3)
	20781	"RTN","HMP DMC",66,0)
	20782	.. S:$P(T IUN,U,11) HMPITM("ha sImages")= 1
	20783	"RTN","HMP DMC",67,0)
	20784	.. K HMPT D EXTRACT ^TIULQ(+TI UN,"HMPT", ,".03;.05; 1211",,,"I ")
	20785	"RTN","HMP DMC",68,0)
	20786	.. S HMPI TM("encoun ter")=+$G( HMPT(+TIUN ,.03,"I"))
	20787	"RTN","HMP DMC",69,0)
	20788	.. S LOC= +$G(HMPT(+ TIUN,1211, "I")) I LO C S LOC=LO C_U_$P($G( ^SC(LOC,0) ),U)
	20789	"RTN","HMP DMC",70,0)
	20790	.. E S X =$P(TIUN,U ,6) S:$L(X ) LOC=+$O( ^SC("B",X, 0))_U_X
	20791	"RTN","HMP DMC",71,0)
	20792	.. S:LOC HMPITM("lo cation")=L OC,HMPITM( "facility" )=$$FAC^HM PD(+LOC)
	20793	"RTN","HMP DMC",72,0)
	20794	.. I '$D( HMPITM("st atus")) S X=+$G(HMPT (+TIUN,.05 ,"I")),HMP ITM("statu s")=$S(X<6 :"PARTIAL RESULTS",1 :"COMPLETE ")
	20795	"RTN","HMP DMC",73,0)
	20796	.. I '$G( HMPITM("do cument",+T IUN)) D
	20797	"RTN","HMP DMC",74,0)
	20798	... K HMP T D EXTRAC T^TIULQ(+T IUN,"HMPT" ,,.01,,,"I ")
	20799	"RTN","HMP DMC",75,0)
	20800	... S NT= $$GET1^DIQ (8925.1,+$ G(HMPT(+TI UN,.01,"I" ))_",",150 1)
	20801	"RTN","HMP DMC",76,0)
	20802	... S HMP ITM("docum ent",+TIUN )=$P(TIUN, U,1,2)_U_N T ;ien^lo cal^nation al title
	20803	"RTN","HMP DMC",77,0)
	20804	... S:$G( HMPTEXT) H MPITM("doc ument",+TI UN,"conten t")=$$TEXT ^HMPDTIU(+ TIUN)
	20805	"RTN","HMP DMC",78,0)
	20806	C . ;
	20807	"RTN","HMP DMC",79,0)
	20808	. ; if no consult o r note/vis it ...
	20809	"RTN","HMP DMC",80,0)
	20810	. I '$D(H MPITM("fac ility")) S X=$P(X0,U ,21),HMPIT M("facilit y")=$S(X:$ $STA^XUAF4 (X)_U_$P($ $NS^XUAF4( X),U),1:$$ FAC^HMPD)
	20811	"RTN","HMP DMC",81,0)
	20812	. I '$D(H MPITM("sta tus")) S H MPITM("sta tus")="COM PLETE"
	20813	"RTN","HMP DMC",82,0)
	20814	. ;I DA D ;get CPT code from #697.2
	20815	"RTN","HMP DMC",83,0)
	20816	. ;. K HM PT D GETS^ DIQ(697.2, DA_",","10 00*",,"HMP T")
	20817	"RTN","HMP DMC",84,0)
	20818	. ;. N IE NS S IENS= $O(HMPT(69 7.21,"")) Q:IENS=""
	20819	"RTN","HMP DMC",85,0)
	20820	. ;. S X= HMPT(697.2 1,IENS,.01 ),HMPITM(" type")=$$C PT(X)
	20821	"RTN","HMP DMC",86,0)
	20822	. ;
	20823	"RTN","HMP DMC",87,0)
	20824	. D XML(. HMPITM)
	20825	"RTN","HMP DMC",88,0)
	20826	ENQ ;
	20827	"RTN","HMP DMC",89,0)
	20828	K ^TMP("M DHSP",$J), ^TMP("HMPT EXT",$J)
	20829	"RTN","HMP DMC",90,0)
	20830	Q
	20831	"RTN","HMP DMC",91,0)
	20832	;
	20833	"RTN","HMP DMC",92,0)
	20834	ROOT(DFN,N AME,DATE) ; -- retur n vptr ID for proced ure instan ce
	20835	"RTN","HMP DMC",93,0)
	20836	N HMPMC,Y
	20837	"RTN","HMP DMC",94,0)
	20838	D SUB^MCA RUTL2(.HMP MC,DFN,NAM E,DATE,DAT E)
	20839	"RTN","HMP DMC",95,0)
	20840	S Y=$S(+$ G(HMPMC):$ P($G(HMPMC (HMPMC)),U ,4)_",",1: "")
	20841	"RTN","HMP DMC",96,0)
	20842	Q Y
	20843	"RTN","HMP DMC",97,0)
	20844	;
	20845	"RTN","HMP DMC",98,0)
	20846	CPT(IEN) ; -- return code^desc ription fo r CPT code , or "^" i f error
	20847	"RTN","HMP DMC",99,0)
	20848	N X0,HMPX ,N,I,X,Y S IEN=+$G(I EN)
	20849	"RTN","HMP DMC",100,0 )
	20850	S X0=$$CP T^ICPTCOD( IEN) I X0< 0 Q "^"
	20851	"RTN","HMP DMC",101,0 )
	20852	S Y=$P(X0 ,U,2,3) ;CPT Code^Shor t Name
	20853	"RTN","HMP DMC",102,0 )
	20854	S N=$$CPT D^ICPTCOD( $P(Y,U),"H MPX") ;CPT Descripti on
	20855	"RTN","HMP DMC",103,0 )
	20856	I N>0,$L( $G(HMPX(1) )) D
	20857	"RTN","HMP DMC",104,0 )
	20858	. S X=$G( HMPX(1)),I =1
	20859	"RTN","HMP DMC",105,0 )
	20860	. F S I= $O(HMPX(I) ) Q:I<1 Q :HMPX(I)=" " S X=X_ " "_HMPX(I )
	20861	"RTN","HMP DMC",106,0 )
	20862	. S $P(Y, U,2)=X
	20863	"RTN","HMP DMC",107,0 )
	20864	Q Y
	20865	"RTN","HMP DMC",108,0 )
	20866	;
	20867	"RTN","HMP DMC",109,0 )
	20868	; ------- ----- Get report(s) [via HMPDT IU] ------ ------
	20869	"RTN","HMP DMC",110,0 )
	20870	;
	20871	"RTN","HMP DMC",111,0 )
	20872	RPTS(DFN,B EG,END,MAX ) ; -- fin d patient' s medicine reports
	20873	"RTN","HMP DMC",112,0 )
	20874	N HMPITM, HMPN,HMPX, RTN,TIUN,C ONS,HMPD,I ,DA,X,Y,%D T,DATE,GBL ,RES
	20875	"RTN","HMP DMC",113,0 )
	20876	S DFN=+$G (DFN) Q:$G (DFN)<1
	20877	"RTN","HMP DMC",114,0 )
	20878	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999), RES=""
	20879	"RTN","HMP DMC",115,0 )
	20880	K ^TMP("M DHSP",$J) D EN1^MDPS 1(RES,DFN, BEG,END,MA X,"",0)
	20881	"RTN","HMP DMC",116,0 )
	20882	S HMPN=0 F S HMPN= $O(^TMP("M DHSP",$J,H MPN)) Q:HM PN<1 S HM PX=$G(^(HM PN)) D
	20883	"RTN","HMP DMC",117,0 )
	20884	. S RTN=$ P(HMPX,U,3 ,4) ;Q:RTN ="PRPRO^MD PS4" ;ski p non-CP i tems
	20885	"RTN","HMP DMC",118,0 )
	20886	. S TIUN= +$P(HMPX,U ,14) K HMP ITM
	20887	"RTN","HMP DMC",119,0 )
	20888	. I TIUN D EN1^HMPD TIU(TIUN,. HMPITM),XM L^HMPDTIU( .HMPITM):$ D(HMPITM)
	20889	"RTN","HMP DMC",120,0 )
	20890	. S CONS= +$P(HMPX,U ,13) D:CON S DOCLIST^ GMRCGUIB(. HMPD,CONS)
	20891	"RTN","HMP DMC",121,0 )
	20892	. S I=0 F S I=$O(H MPD(50,I)) Q:I<1 D
	20893	"RTN","HMP DMC",122,0 )
	20894	.. K HMPI TM S DA=+H MPD(50,I) Q:DA=TIUN
	20895	"RTN","HMP DMC",123,0 )
	20896	.. D EN1^ HMPDTIU(DA ,.HMPITM), XML^HMPDTI U(.HMPITM) :$D(HMPITM )
	20897	"RTN","HMP DMC",124,0 )
	20898	. Q:TIUN! $G(DA) ;done [got TIU note(s)]
	20899	"RTN","HMP DMC",125,0 )
	20900	. Q:RTN=" PR702^MDPS 1" ;CP, but no TIU note yet
	20901	"RTN","HMP DMC",126,0 )
	20902	. Q:RTN=" PRPRO^MDPS 4" ;non- CP procedu re
	20903	"RTN","HMP DMC",127,0 )
	20904	. ; find ID for pre -TIU repor t
	20905	"RTN","HMP DMC",128,0 )
	20906	. S X=$P( HMPX,U,6), %DT="TX" D ^%DT S:Y> 0 DATE=Y
	20907	"RTN","HMP DMC",129,0 )
	20908	. S GBL=+ $P(HMPX,U, 2)_";"_$$R OOT(DFN,$P (HMPX,U,11 ),DATE)
	20909	"RTN","HMP DMC",130,0 )
	20910	. I GBL D RPT1(DFN, GBL,.HMPIT M),XML^HMP DTIU(.HMPI TM):$D(HMP ITM)
	20911	"RTN","HMP DMC",131,0 )
	20912	K ^TMP("M DHSP",$J), ^TMP("HMPT EXT",$J)
	20913	"RTN","HMP DMC",132,0 )
	20914	Q
	20915	"RTN","HMP DMC",133,0 )
	20916	;
	20917	"RTN","HMP DMC",134,0 )
	20918	RPT1(DFN,I D,RPT) ; - - return r eport as a TIU docum ent
	20919	"RTN","HMP DMC",135,0 )
	20920	S DFN=+$G (DFN),ID=$ G(ID) Q:DF N<1 Q:'$L (ID)
	20921	"RTN","HMP DMC",136,0 )
	20922	N HMPY,HM PFN,X
	20923	"RTN","HMP DMC",137,0 )
	20924	S HMPFN=+ $P(ID,"(", 2)
	20925	"RTN","HMP DMC",138,0 )
	20926	D MEDLKUP ^MCARUTL3( .HMPY,HMPF N,+ID)
	20927	"RTN","HMP DMC",139,0 )
	20928	S RPT("id ")=ID,RPT( "reference DateTime") =$P(HMPY,U ,6)
	20929	"RTN","HMP DMC",140,0 )
	20930	S RPT("lo calTitle") =$P(HMPY,U ,9),RPT("c ategory")= "CP"
	20931	"RTN","HMP DMC",141,0 )
	20932	S RPT("do cumentClas s")="CLINI CAL PROCED URES"
	20933	"RTN","HMP DMC",142,0 )
	20934	S RPT("na tionalTitl e")="46965 66^PROCEDU RE REPORT"
	20935	"RTN","HMP DMC",143,0 )
	20936	S RPT("na tionalTitl eService") ="4696471^ PROCEDURE"
	20937	"RTN","HMP DMC",144,0 )
	20938	S RPT("na tionalTitl eType")="4 696123^REP ORT"
	20939	"RTN","HMP DMC",145,0 )
	20940	S:$G(FILT ER("loinc" )) RPT("lo inc")=$P(F ILTER("loi nc"),U)
	20941	"RTN","HMP DMC",146,0 )
	20942	S X=$$GET 1^DIQ(HMPF N,+ID_",", 1506)
	20943	"RTN","HMP DMC",147,0 )
	20944	S RPT("st atus")=$S( $L(X):X,1: "COMPLETED ")
	20945	"RTN","HMP DMC",148,0 )
	20946	S X=+$$GE T1^DIQ(HMP FN,+ID_"," ,701,"I")
	20947	"RTN","HMP DMC",149,0 )
	20948	S:X RPT(" clinician" ,1)=X_U_$P ($G(^VA(20 0,X,0)),U) _"^A"
	20949	"RTN","HMP DMC",150,0 )
	20950	S X=+$$GE T1^DIQ(HMP FN,+ID_"," ,1503,"I")
	20951	"RTN","HMP DMC",151,0 )
	20952	S:X RPT(" clinician" ,2)=X_U_$P ($G(^VA(20 0,X,0)),U) _"^S^"_$$G ET1^DIQ(HM PFN,+ID_", ",1505,"I" )_U_$$SIG^ HMPDTIU(X)
	20953	"RTN","HMP DMC",152,0 )
	20954	; RPT("en counter")= $$GET1^DIQ (HMPFN,+ID _",",900," I")
	20955	"RTN","HMP DMC",153,0 )
	20956	S RPT("fa cility")=$ $FAC^HMPD
	20957	"RTN","HMP DMC",154,0 )
	20958	S:$G(HMPT EXT) RPT(" content")= $$TEXT(DFN ,ID,$P(HMP Y,U,9))
	20959	"RTN","HMP DMC",155,0 )
	20960	Q
	20961	"RTN","HMP DMC",156,0 )
	20962	;
	20963	"RTN","HMP DMC",157,0 )
	20964	TEXT(DFN,I D,NAME) ; -- Get rep ort text, return tem p array na me
	20965	"RTN","HMP DMC",158,0 )
	20966	N MCARGDA ,MCPRO,MDA LL,I,X
	20967	"RTN","HMP DMC",159,0 )
	20968	S MCARGDA =+$G(ID),M CPRO=NAME, MDALL=1 D PR690^MDPS 1
	20969	"RTN","HMP DMC",160,0 )
	20970	K ^TMP("H MPTEXT",$J ,ID)
	20971	"RTN","HMP DMC",161,0 )
	20972	S I=0 F S I=$O(^TM P("MDPTXT" ,$J,MCARGD A,MCPRO,I) ) Q:I<1 S X=$G(^(I, 0)),^TMP(" HMPTEXT",$ J,ID,I)=X
	20973	"RTN","HMP DMC",162,0 )
	20974	S Y=$NA(^ TMP("HMPTE XT",$J,ID) )
	20975	"RTN","HMP DMC",163,0 )
	20976	Q Y
	20977	"RTN","HMP DMC",164,0 )
	20978	;
	20979	"RTN","HMP DMC",165,0 )
	20980	; ------- ----- Retu rn data to middle ti er ------- -----
	20981	"RTN","HMP DMC",166,0 )
	20982	;
	20983	"RTN","HMP DMC",167,0 )
	20984	XML(PROC) ; -- Retur n patient procedure as XML
	20985	"RTN","HMP DMC",168,0 )
	20986	; as <el ement code ='123' dis playName=' ABC' />
	20987	"RTN","HMP DMC",169,0 )
	20988	N ATT,X,Y ,I,J,NAMES
	20989	"RTN","HMP DMC",170,0 )
	20990	D ADD("<p rocedure>" ) S HMPTOT L=$G(HMPTO TL)+1
	20991	"RTN","HMP DMC",171,0 )
	20992	S ATT="" F S ATT=$ O(PROC(ATT )) Q:ATT=" " D D:$L (Y) ADD(Y)
	20993	"RTN","HMP DMC",172,0 )
	20994	. S NAMES =$S(ATT="d ocument":" id^localTi tle^nation alTitle^Z" ,1:"code^n ame^Z")
	20995	"RTN","HMP DMC",173,0 )
	20996	. I $O(PR OC(ATT,0)) D S Y="" Q ;multi ples
	20997	"RTN","HMP DMC",174,0 )
	20998	.. D ADD( "<"_ATT_"s >")
	20999	"RTN","HMP DMC",175,0 )
	21000	.. S I=0 F S I=$O( PROC(ATT,I )) Q:I<1 D
	21001	"RTN","HMP DMC",176,0 )
	21002	... S X=$ G(PROC(ATT ,I)),Y="<" _ATT_" "_$ $LOOP
	21003	"RTN","HMP DMC",177,0 )
	21004	... S X=$ G(PROC(ATT ,I,"conten t")) I '$L (X) S Y=Y_ "/>" D ADD (Y) Q
	21005	"RTN","HMP DMC",178,0 )
	21006	... S Y=Y _">" D ADD (Y)
	21007	"RTN","HMP DMC",179,0 )
	21008	... S Y=" <content x ml:space=' preserve'> " D ADD(Y)
	21009	"RTN","HMP DMC",180,0 )
	21010	... S J=0 F S J=$O (@X@(J)) Q :J<1 S Y= $$ESC^HMPD (@X@(J)) D ADD(Y)
	21011	"RTN","HMP DMC",181,0 )
	21012	... D ADD ("</conten t>"),ADD(" </"_ATT_"> ")
	21013	"RTN","HMP DMC",182,0 )
	21014	.. D ADD( "</"_ATT_" s>")
	21015	"RTN","HMP DMC",183,0 )
	21016	. S X=$G( PROC(ATT)) ,Y="" Q:'$ L(X)
	21017	"RTN","HMP DMC",184,0 )
	21018	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	21019	"RTN","HMP DMC",185,0 )
	21020	. I $L(X) >1 S Y="<" _ATT_" "_$ $LOOP_"/>"
	21021	"RTN","HMP DMC",186,0 )
	21022	D ADD("</ procedure> ")
	21023	"RTN","HMP DMC",187,0 )
	21024	Q
	21025	"RTN","HMP DMC",188,0 )
	21026	;
	21027	"RTN","HMP DMC",189,0 )
	21028	LOOP() ; - - build su b-items st ring from NAMES and X
	21029	"RTN","HMP DMC",190,0 )
	21030	N STR,P,T AG S STR=" "
	21031	"RTN","HMP DMC",191,0 )
	21032	F P=1:1 S TAG=$P(NA MES,U,P) Q :TAG="Z" I $L($P(X, U,P)) S ST R=STR_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	21033	"RTN","HMP DMC",192,0 )
	21034	Q STR
	21035	"RTN","HMP DMC",193,0 )
	21036	;
	21037	"RTN","HMP DMC",194,0 )
	21038	ADD(X) ; A dd a line @HMP@(n)=X
	21039	"RTN","HMP DMC",195,0 )
	21040	S HMPI=$G (HMPI)+1
	21041	"RTN","HMP DMC",196,0 )
	21042	S @HMP@(H MPI)=X
	21043	"RTN","HMP DMC",197,0 )
	21044	Q
	21045	"RTN","HMP DMDC")
	21046	0^60^B4504 1787
	21047	"RTN","HMP DMDC",1,0)
	21048	HMPDMDC ;S LC/MKB,DP, ASMR/RRB - CLiO extr act;8/2/11 15:29
	21049	"RTN","HMP DMDC",2,0)
	21050	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	21051	"RTN","HMP DMDC",3,0)
	21052	;Per VA D irective 6 402, this routine sh ould not b e modified .
	21053	"RTN","HMP DMDC",4,0)
	21054	;
	21055	"RTN","HMP DMDC",5,0)
	21056	; Externa l Referenc es DBIA#
	21057	"RTN","HMP DMDC",6,0)
	21058	; ------- ---------- -- -----
	21059	"RTN","HMP DMDC",7,0)
	21060	; ^MDC(70 4.101 5748 (Pr ivate)
	21061	"RTN","HMP DMDC",8,0)
	21062	; ^MDC(70 4.102 5748 (Pr ivate)
	21063	"RTN","HMP DMDC",9,0)
	21064	; ^MDC(70 4.117 5748 (Pr ivate)
	21065	"RTN","HMP DMDC",10,0 )
	21066	; ^MDC(70 4.118 5811 (Pr ivate)
	21067	"RTN","HMP DMDC",11,0 )
	21068	; DIC 2051
	21069	"RTN","HMP DMDC",12,0 )
	21070	; DIQ 2056
	21071	"RTN","HMP DMDC",13,0 )
	21072	; XLFDT 10103
	21073	"RTN","HMP DMDC",14,0 )
	21074	; XLFSTR 10104
	21075	"RTN","HMP DMDC",15,0 )
	21076	Q
	21077	"RTN","HMP DMDC",16,0 )
	21078	; ------- ----- Get observatio ns from Vi stA ------ ------
	21079	"RTN","HMP DMDC",17,0 )
	21080	;
	21081	"RTN","HMP DMDC",18,0 )
	21082	EN(DFN,BEG ,END,MAX,I D) ; -- fi nd patient 's observa tions
	21083	"RTN","HMP DMDC",19,0 )
	21084	N HMPCLIO ,HMPN,HMPI TM,HMPCNT, X
	21085	"RTN","HMP DMDC",20,0 )
	21086	;
	21087	"RTN","HMP DMDC",21,0 )
	21088	; get one observati on
	21089	"RTN","HMP DMDC",22,0 )
	21090	I $L($G(I D)) D EN1( ID,.HMPITM ),XML(.HMP ITM) Q
	21091	"RTN","HMP DMDC",23,0 )
	21092	;
	21093	"RTN","HMP DMDC",24,0 )
	21094	; get all patient o bservation s
	21095	"RTN","HMP DMDC",25,0 )
	21096	S DFN=+$G (DFN) Q:DF N<1
	21097	"RTN","HMP DMDC",26,0 )
	21098	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999), HMPCNT=0
	21099	"RTN","HMP DMDC",27,0 )
	21100	;D QRYPT^ MDCLIO1("H MPCLIO",DF N,BEG,END) ;all [ver ified] obs ervations
	21101	"RTN","HMP DMDC",28,0 )
	21102	D QRYPT(" HMPCLIO",D FN,BEG,END ) ;all [ve rified] ob servations
	21103	"RTN","HMP DMDC",29,0 )
	21104	S HMPN=0 F S HMPN= $O(HMPCLIO (HMPN)) Q: (HMPN<1)!( HMPCNT'<MA X) D
	21105	"RTN","HMP DMDC",30,0 )
	21106	. S ID=$G (HMPCLIO(H MPN)) K HM PITM ;GUID
	21107	"RTN","HMP DMDC",31,0 )
	21108	. D EN1(I D,.HMPITM) Q:'$D(HMP ITM)
	21109	"RTN","HMP DMDC",32,0 )
	21110	. D XML(. HMPITM) S HMPCNT=HMP CNT+1
	21111	"RTN","HMP DMDC",33,0 )
	21112	Q
	21113	"RTN","HMP DMDC",34,0 )
	21114	;
	21115	"RTN","HMP DMDC",35,0 )
	21116	EN1(GUID,C LIO) ; -- return an observatio n in CLIO( "attribute ")=value
	21117	"RTN","HMP DMDC",36,0 )
	21118	N HMPT,HM PC,LOC,I,X ,Y K CLIO
	21119	"RTN","HMP DMDC",37,0 )
	21120	S GUID=$G (GUID) Q:G UID="" ;i nvalid GUI D
	21121	"RTN","HMP DMDC",38,0 )
	21122	;D QRYOBS ^MDCLIO1(" HMPC",GUID ) Q:'$D(HM PC) ;does n't exist
	21123	"RTN","HMP DMDC",39,0 )
	21124	D QRYOBS( "HMPC",GUI D) Q:'$D(H MPC) ;doe sn't exist
	21125	"RTN","HMP DMDC",40,0 )
	21126	Q:$L($G(H MPC("PAREN T_ID","E") )) ;PAREN T also in list
	21127	"RTN","HMP DMDC",41,0 )
	21128	S CLIO("i d")=GUID,C LIO("vuid" )=$G(HMPC( "TERM_ID", "I"))
	21129	"RTN","HMP DMDC",42,0 )
	21130	S CLIO("n ame")=$G(H MPC("TERM_ ID","E"))
	21131	"RTN","HMP DMDC",43,0 )
	21132	S CLIO("v alue")=$G( HMPC("SVAL UE","E"))
	21133	"RTN","HMP DMDC",44,0 )
	21134	S CLIO("u nits")=$G( HMPC("UNIT _ID","ABBV "))
	21135	"RTN","HMP DMDC",45,0 )
	21136	S CLIO("e ntered")=$ G(HMPC("EN TERED_DATE _TIME","I" ))
	21137	"RTN","HMP DMDC",46,0 )
	21138	S CLIO("o bserved")= $G(HMPC("O BSERVED_DA TE_TIME"," I"))
	21139	"RTN","HMP DMDC",47,0 )
	21140	;D QRYTYP ES^MDCLIO1 ("HMPT")
	21141	"RTN","HMP DMDC",48,0 )
	21142	D QRYTYPE S("HMPT")
	21143	"RTN","HMP DMDC",49,0 )
	21144	F I=3:1:7 S X=$G(HM PT(I,"XML" )) Q:I<1 I $L($G(HM PC(X,"E")) ) D
	21145	"RTN","HMP DMDC",50,0 )
	21146	. S Y=HMP T(I,"NAME" ),Y=$S(Y=" LOCATION": "bodySite" ,1:$$LOW^X LFSTR(Y))
	21147	"RTN","HMP DMDC",51,0 )
	21148	. S CLIO( Y)=HMPC(X, "I")_U_HMP C(X,"E")
	21149	"RTN","HMP DMDC",52,0 )
	21150	S CLIO("r ange")=$G( HMPC("RANG E","E"))
	21151	"RTN","HMP DMDC",53,0 )
	21152	S CLIO("s tatus")=$G (HMPC("STA TUS","E"))
	21153	"RTN","HMP DMDC",54,0 )
	21154	S LOC=$G( HMPC("HOSP ITAL_LOCAT ION_ID","I ")),CLIO(" facility") =$$FAC^HMP D(LOC)
	21155	"RTN","HMP DMDC",55,0 )
	21156	S CLIO("l ocation")= LOC_U_$G(H MPC("HOSPI TAL_LOCATI ON_ID","E" ))
	21157	"RTN","HMP DMDC",56,0 )
	21158	S CLIO("c omment")=$ G(HMPC("CO MMENT","E" ))
	21159	"RTN","HMP DMDC",57,0 )
	21160	Q
	21161	"RTN","HMP DMDC",58,0 )
	21162	;
	21163	"RTN","HMP DMDC",59,0 )
	21164	; ------- ----- Retu rn data to middle ti er ------- -----
	21165	"RTN","HMP DMDC",60,0 )
	21166	;
	21167	"RTN","HMP DMDC",61,0 )
	21168	XML(OBS) ; -- Return observati on as XML in @HMP@(# )
	21169	"RTN","HMP DMDC",62,0 )
	21170	N ATT,X,Y ,I,J,P,NAM ES,TAG
	21171	"RTN","HMP DMDC",63,0 )
	21172	D ADD("<o bservation >") S HMPT OTL=$G(HMP TOTL)+1
	21173	"RTN","HMP DMDC",64,0 )
	21174	S ATT="" F S ATT=$ O(OBS(ATT) ) Q:ATT="" D
	21175	"RTN","HMP DMDC",65,0 )
	21176	. S X=$G( OBS(ATT)), Y="" Q:'$L (X)
	21177	"RTN","HMP DMDC",66,0 )
	21178	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" D AD D(Y) Q
	21179	"RTN","HMP DMDC",67,0 )
	21180	. I $L(X) >1 D
	21181	"RTN","HMP DMDC",68,0 )
	21182	.. S Y="< "_ATT_" "
	21183	"RTN","HMP DMDC",69,0 )
	21184	.. F P=1: 1 S TAG=$P ("code^nam e^Z",U,P) Q:TAG="Z" I $L($P(X ,U,P)) S Y =Y_TAG_"=' "_$$ESC^HM PD($P(X,U, P))_"' "
	21185	"RTN","HMP DMDC",70,0 )
	21186	.. S Y=Y_ "/>" D ADD (Y)
	21187	"RTN","HMP DMDC",71,0 )
	21188	D ADD("</ observatio n>")
	21189	"RTN","HMP DMDC",72,0 )
	21190	Q
	21191	"RTN","HMP DMDC",73,0 )
	21192	;
	21193	"RTN","HMP DMDC",74,0 )
	21194	LOOP() ; - - build su b-items st ring from NAMES and X
	21195	"RTN","HMP DMDC",75,0 )
	21196	N STR,P,T AG S STR=" "
	21197	"RTN","HMP DMDC",76,0 )
	21198	F P=1:1 S TAG=$P(NA MES,U,P) Q :TAG="Z" I $L($P(X, U,P)) S ST R=STR_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	21199	"RTN","HMP DMDC",77,0 )
	21200	Q STR
	21201	"RTN","HMP DMDC",78,0 )
	21202	;
	21203	"RTN","HMP DMDC",79,0 )
	21204	ADD(X) ; A dd a line @HMP@(n)=X
	21205	"RTN","HMP DMDC",80,0 )
	21206	S HMPI=$G (HMPI)+1
	21207	"RTN","HMP DMDC",81,0 )
	21208	S @HMP@(H MPI)=X
	21209	"RTN","HMP DMDC",82,0 )
	21210	Q
	21211	"RTN","HMP DMDC",83,0 )
	21212	;
	21213	"RTN","HMP DMDC",84,0 )
	21214	; -- CliO specific code acces sing the ^ MDC( globa l for data
	21215	"RTN","HMP DMDC",85,0 )
	21216	;
	21217	"RTN","HMP DMDC",86,0 )
	21218	QRYPT(HMPR ET,HMPDFN, HMPFR,HMPT O,HMPSTAT) ; List of observati ons by pt, datetime, status
	21219	"RTN","HMP DMDC",87,0 )
	21220	K @HMPRET
	21221	"RTN","HMP DMDC",88,0 )
	21222	N HMPDT,H MPIEN
	21223	"RTN","HMP DMDC",89,0 )
	21224	S HMPSTAT =$G(HMPSTA T,1) ; Def ault to Ve rified
	21225	"RTN","HMP DMDC",90,0 )
	21226	F HMPDT=H MPFR-.0000 001:0 S HM PDT=$O(^MD C(704.117, "AS",HMPST AT,HMPDFN, HMPDT)) Q: 'HMPDT!(HM PDT>HMPTO) D
	21227	"RTN","HMP DMDC",91,0 )
	21228	. F HMPIE N=0:0 S HM PIEN=$O(^M DC(704.117 ,"AS",HMPS TAT,HMPDFN ,HMPDT,HMP IEN)) Q:'H MPIEN D
	21229	"RTN","HMP DMDC",92,0 )
	21230	. . S:$P( ^MDC(704.1 17,HMPIEN, 0),U,9)=HM PSTAT @HMP RET@(HMPIE N)=$P(^MDC (704.117,H MPIEN,0),U )
	21231	"RTN","HMP DMDC",93,0 )
	21232	Q
	21233	"RTN","HMP DMDC",94,0 )
	21234	;
	21235	"RTN","HMP DMDC",95,0 )
	21236	QRYOBS(HMP RET,HMPID) ; Return a single o bservation
	21237	"RTN","HMP DMDC",96,0 )
	21238	K @HMPRET
	21239	"RTN","HMP DMDC",97,0 )
	21240	N HMPTMP, HMPIEN
	21241	"RTN","HMP DMDC",98,0 )
	21242	S HMPIEN= $$FIND1^DI C(704.117, "","PKX",H MPID,"PK")
	21243	"RTN","HMP DMDC",99,0 )
	21244	I HMPIEN< 1 S @HMPRE T@(0)="-1^ No such ob servation '"_HMPID_" '" Q
	21245	"RTN","HMP DMDC",100, 0)
	21246	D GETS^DI Q(704.117, HMPIEN_"," ,"*","EIR" ,"HMPTMP")
	21247	"RTN","HMP DMDC",101, 0)
	21248	M @HMPRET =HMPTMP(70 4.117,HMPI EN_",") K HMPTMP
	21249	"RTN","HMP DMDC",102, 0)
	21250	S @HMPRET @("TERM_ID ","I")=$$G ET1^DIQ(70 4.117,HMPI EN_",",".0 7:99.99")
	21251	"RTN","HMP DMDC",103, 0)
	21252	S @HMPRET @("TERM_ID ","E")=$$G ET1^DIQ(70 4.117,HMPI EN_",",".0 7:.02")
	21253	"RTN","HMP DMDC",104, 0)
	21254	S @HMPRET @("TERM_ID ","GUID")= $$GET1^DIQ (704.117,H MPIEN_",", ".07")
	21255	"RTN","HMP DMDC",105, 0)
	21256	S @HMPRET @("TERM_ID ","ABBV")= $$GET1^DIQ (704.117,H MPIEN_",", ".07:.03")
	21257	"RTN","HMP DMDC",106, 0)
	21258	D:$$GET1^ DIQ(704.11 7,HMPIEN_" ,",".07:.0 6","I")=3 ; Coded d ata values
	21259	"RTN","HMP DMDC",107, 0)
	21260	. S HMPTM P=$$FIND1^ DIC(704.10 1,"","PKX" ,@HMPRET@( "SVALUE"," I"),"PK")
	21261	"RTN","HMP DMDC",108, 0)
	21262	. S @HMPR ET@("SVALU E","E")=$$ GET1^DIQ(7 04.101,HMP TMP_",",.0 2)
	21263	"RTN","HMP DMDC",109, 0)
	21264	D QRYQUAL (HMPRET,HM PIEN)
	21265	"RTN","HMP DMDC",110, 0)
	21266	D QRYCTX( $NA(@HMPRE T@("CONTEX T")),HMPID )
	21267	"RTN","HMP DMDC",111, 0)
	21268	Q
	21269	"RTN","HMP DMDC",112, 0)
	21270	;
	21271	"RTN","HMP DMDC",113, 0)
	21272	QRYQUAL(HM PRET,HMPIE N) ; Retur ns the qua lifiers fo r obs in H MPIEN
	21273	"RTN","HMP DMDC",114, 0)
	21274	; We do N OT want to kill HMPR ET here be cause it p oints at t he parent node of th e return
	21275	"RTN","HMP DMDC",115, 0)
	21276	N HMPQUAL
	21277	"RTN","HMP DMDC",116, 0)
	21278	F Y=0:0 S Y=$O(^MDC (704.118," PK",HMPIEN ,Y)) Q:'Y D ;ICR 5 811 DE2818 ASF 11/25 /15
	21279	"RTN","HMP DMDC",117, 0)
	21280	. S HMPQU AL=$$GET1^ DIQ(704.10 1,Y_",",". 05:.02")
	21281	"RTN","HMP DMDC",118, 0)
	21282	. S @HMPR ET@(HMPQUA L,"I")=$$G ET1^DIQ(70 4.101,Y_", ","99.99")
	21283	"RTN","HMP DMDC",119, 0)
	21284	. S @HMPR ET@(HMPQUA L,"E")=$$G ET1^DIQ(70 4.101,Y_", ",".02")
	21285	"RTN","HMP DMDC",120, 0)
	21286	. S @HMPR ET@(HMPQUA L,"GUID")= $$GET1^DIQ (704.101,Y _",",".01" )
	21287	"RTN","HMP DMDC",121, 0)
	21288	. S @HMPR ET@(HMPQUA L,"ABBV")= $$GET1^DIQ (704.101,Y _",",".03" )
	21289	"RTN","HMP DMDC",122, 0)
	21290	Q
	21291	"RTN","HMP DMDC",123, 0)
	21292	;
	21293	"RTN","HMP DMDC",124, 0)
	21294	QRYCTX(HMP RET,HMPID) ; We need a termino logy based context o bservation relations hip here
	21295	"RTN","HMP DMDC",125, 0)
	21296	N HMPIEN, HMPCTX,HMP DT,HMPFR,H MPTO,HMPDF N,HMPTERM, HMPCNT,HMP XID,HMPOBS
	21297	"RTN","HMP DMDC",126, 0)
	21298	S HMPIEN= +$$FIND1^D IC(704.117 ,"","PKX", HMPID,"PK" ) Q:HMPIEN <1
	21299	"RTN","HMP DMDC",127, 0)
	21300	S HMPCTX= $$GET1^DIQ (704.117,H MPIEN_",", .07) ; GET THE PRIMA RY TERM (G UID)
	21301	"RTN","HMP DMDC",128, 0)
	21302	; FILTER OUT EVERYT HING BUT S pO2 for no w
	21303	"RTN","HMP DMDC",129, 0)
	21304	Q:HMPCTX' ="{5F84DD5 5-3CCF-094 C-2536-B51 EB7FAD999} "
	21305	"RTN","HMP DMDC",130, 0)
	21306	S HMPDFN= +$$GET1^DI Q(704.117, HMPIEN_"," ,.08,"I") ; GET THE PATIENT
	21307	"RTN","HMP DMDC",131, 0)
	21308	S HMPDT=+ $$GET1^DIQ (704.117,H MPIEN_",", .05,"I") ; GET THE O BS DATE
	21309	"RTN","HMP DMDC",132, 0)
	21310	S HMPFR=$ $FMADD^XLF DT(HMPDT,0 ,0,0,-30) ; PREVIOUS 30 SECOND S
	21311	"RTN","HMP DMDC",133, 0)
	21312	S HMPTO=$ $FMADD^XLF DT(HMPDT,0 ,0,0,30) ; NEXT 30 S ECONDS
	21313	"RTN","HMP DMDC",134, 0)
	21314	; Now we find the c ontext obs ervations
	21315	"RTN","HMP DMDC",135, 0)
	21316	F HMPDT=H MPFR:0 S H MPDT=$O(^M DC(704.117 ,"PT",HMPD FN,HMPDT)) Q:'HMPDT! (HMPDT>HMP TO) D ;I CR 5810 DE 2818 ASF 1 1/25/15
	21317	"RTN","HMP DMDC",136, 0)
	21318	. F HMPOB S=0:0 S HM POBS=$O(^M DC(704.117 ,"PT",HMPD FN,HMPDT,H MPOBS)) Q: 'HMPOBS D
	21319	"RTN","HMP DMDC",137, 0)
	21320	. . Q:$$G ET1^DIQ(70 4.117,HMPO BS_",",.09 ,"I")'=1 ; Verified Only
	21321	"RTN","HMP DMDC",138, 0)
	21322	. . S HMP XID=$$GET1 ^DIQ(704.1 17,HMPOBS_ ",",.01)
	21323	"RTN","HMP DMDC",139, 0)
	21324	. . Q:HMP XID=HMPID ; You sho uld ignore yourself in this lo op
	21325	"RTN","HMP DMDC",140, 0)
	21326	. . S HMP TERM=$$GET 1^DIQ(704. 117,HMPOBS _",",".07" )
	21327	"RTN","HMP DMDC",141, 0)
	21328	. . ; INS ERT FILTER CODE FOR O2 Flowrat e and Conc entration here - In the future we will f ind all co ntext term s for an o bservation in termin ology
	21329	"RTN","HMP DMDC",142, 0)
	21330	. . Q:(HM PTERM'="{5 6F82CAC-35 64-46CE-A5 20-1025020 DADE9}")&( HMPTERM'=" {3BB314E8- 9BBB-480E- B34E-B56ED E43BAC4}")
	21331	"RTN","HMP DMDC",143, 0)
	21332	. . S HMP CNT=$O(@HM PRET@(""), -1)+1,@HMP RET@(0)=HM PCNT
	21333	"RTN","HMP DMDC",144, 0)
	21334	. . S @HM PRET@(HMPC NT,"OBS_ID ","I")=HMP XID
	21335	"RTN","HMP DMDC",145, 0)
	21336	. . S @HM PRET@(HMPC NT,"OBS_ID ","E")=HMP XID
	21337	"RTN","HMP DMDC",146, 0)
	21338	. . S @HM PRET@(HMPC NT,"TERM_I D","I")=$$ GET1^DIQ(7 04.117,HMP OBS_",",". 07:99.99")
	21339	"RTN","HMP DMDC",147, 0)
	21340	. . S @HM PRET@(HMPC NT,"TERM_I D","E")=$$ GET1^DIQ(7 04.117,HMP OBS_",",". 07:.02")
	21341	"RTN","HMP DMDC",148, 0)
	21342	. . S @HM PRET@(HMPC NT,"SVALUE ","I")=$$G ET1^DIQ(70 4.117,HMPO BS_",",".1 ","I")
	21343	"RTN","HMP DMDC",149, 0)
	21344	. . S @HM PRET@(HMPC NT,"SVALUE ","E")=$$G ET1^DIQ(70 4.117,HMPO BS_",",".1 ","E")
	21345	"RTN","HMP DMDC",150, 0)
	21346	. . D QRY QUAL($NA(@ HMPRET@(HM PCNT)),HMP OBS)
	21347	"RTN","HMP DMDC",151, 0)
	21348	Q
	21349	"RTN","HMP DMDC",152, 0)
	21350	;
	21351	"RTN","HMP DMDC",153, 0)
	21352	QRYTYPES(H MPRET) ; R eturn the terminolog y Term Typ es
	21353	"RTN","HMP DMDC",154, 0)
	21354	K @HMPRET
	21355	"RTN","HMP DMDC",155, 0)
	21356	N X
	21357	"RTN","HMP DMDC",156, 0)
	21358	F X=0:0 S X=$O(^MDC (704.102,X )) Q:'X D ;ICR 574 8 DE2818 A SF 11/25/1 5
	21359	"RTN","HMP DMDC",157, 0)
	21360	. S @HMPR ET@(X,"NAM E")=$P(^MD C(704.102, X,0),U,1)
	21361	"RTN","HMP DMDC",158, 0)
	21362	. S @HMPR ET@(X,"XML ")=$P(^MDC (704.102,X ,0),U,2)
	21363	"RTN","HMP DMDC",159, 0)
	21364	. S @HMPR ET@("B",$P (^MDC(704. 102,X,0),U ,1),X)=""
	21365	"RTN","HMP DMDC",160, 0)
	21366	Q
	21367	"RTN","HMP DMDC",161, 0)
	21368	;
	21369	"RTN","HMP DOR")
	21370	0^61^B1357 4723
	21371	"RTN","HMP DOR",1,0)
	21372	HMPDOR ;SL C/MKB,ASMR /RRB - Ord ers extrac t;8/2/11 15:29
	21373	"RTN","HMP DOR",2,0)
	21374	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	21375	"RTN","HMP DOR",3,0)
	21376	;Per VA D irective 6 402, this routine sh ould not b e modified .
	21377	"RTN","HMP DOR",4,0)
	21378	;
	21379	"RTN","HMP DOR",5,0)
	21380	; Externa l Referenc es DBIA#
	21381	"RTN","HMP DOR",6,0)
	21382	; ------- ---------- -- -----
	21383	"RTN","HMP DOR",7,0)
	21384	; ^ORA(10 2.4) 5769
	21385	"RTN","HMP DOR",8,0)
	21386	; ^SC 10040
	21387	"RTN","HMP DOR",9,0)
	21388	; ^VA(200 ) 10060
	21389	"RTN","HMP DOR",10,0)
	21390	; DIQ 2056
	21391	"RTN","HMP DOR",11,0)
	21392	; ORQ1,^T MP("ORR",$ J) 3154
	21393	"RTN","HMP DOR",12,0)
	21394	; ORQ12,^ TMP("ORGOT IT",$J) 5704
	21395	"RTN","HMP DOR",13,0)
	21396	; ORX8 2467
	21397	"RTN","HMP DOR",14,0)
	21398	Q
	21399	"RTN","HMP DOR",15,0)
	21400	; ------- ----- Get data from VistA ---- --------
	21401	"RTN","HMP DOR",16,0)
	21402	;
	21403	"RTN","HMP DOR",17,0)
	21404	EN(DFN,BEG ,END,MAX,I FN) ; -- f ind a pati ent's orde rs
	21405	"RTN","HMP DOR",18,0)
	21406	S DFN=+$G (DFN) Q:DF N<1 ;inva lid patien t
	21407	"RTN","HMP DOR",19,0)
	21408	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	21409	"RTN","HMP DOR",20,0)
	21410	N ORLIST, HMPN,HMPIT M,HMPCNT
	21411	"RTN","HMP DOR",21,0)
	21412	;
	21413	"RTN","HMP DOR",22,0)
	21414	; get one order
	21415	"RTN","HMP DOR",23,0)
	21416	I $G(IFN) D G ENQ
	21417	"RTN","HMP DOR",24,0)
	21418	. N ORLST S ORLST=0 ,ORLIST=$H
	21419	"RTN","HMP DOR",25,0)
	21420	. D GET^O RQ12(IFN,O RLIST,1) S HMPN=1
	21421	"RTN","HMP DOR",26,0)
	21422	. D EN1(H MPN,.HMPIT M),XML(.HM PITM)
	21423	"RTN","HMP DOR",27,0)
	21424	. K ^TMP( "ORGOTIT", $J)
	21425	"RTN","HMP DOR",28,0)
	21426	;
	21427	"RTN","HMP DOR",29,0)
	21428	; get all orders
	21429	"RTN","HMP DOR",30,0)
	21430	D EN^ORQ1 (DFN_";DPT (",,6,,BEG ,END,1) S HMPCNT=0
	21431	"RTN","HMP DOR",31,0)
	21432	S HMPN=0 F S HMPN= $O(^TMP("O RR",$J,ORL IST,HMPN)) Q:HMPN<1 D Q:HMPC NT'<MAX
	21433	"RTN","HMP DOR",32,0)
	21434	. K HMPIT M D EN1(HM PN,.HMPITM ) Q:'$D(HM PITM)
	21435	"RTN","HMP DOR",33,0)
	21436	. D XML(. HMPITM) S HMPCNT=HMP CNT+1
	21437	"RTN","HMP DOR",34,0)
	21438	ENQ ; end
	21439	"RTN","HMP DOR",35,0)
	21440	K ^TMP("O RR",$J),^T MP("HMPTEX T",$J)
	21441	"RTN","HMP DOR",36,0)
	21442	Q
	21443	"RTN","HMP DOR",37,0)
	21444	;
	21445	"RTN","HMP DOR",38,0)
	21446	EN1(NUM,OR D) ; -- re turn an or der in ORD ("attribut e")=value
	21447	"RTN","HMP DOR",39,0)
	21448	; from E N: expects ^TMP("ORR ",$J,ORLIS T,HMPN)
	21449	"RTN","HMP DOR",40,0)
	21450	N X0,IFN, LOC,X,DA
	21451	"RTN","HMP DOR",41,0)
	21452	K ORD,^TM P("HMPTEXT ",$J)
	21453	"RTN","HMP DOR",42,0)
	21454	S X0=$G(^ TMP("ORR", $J,ORLIST, NUM)),IFN= +X0
	21455	"RTN","HMP DOR",43,0)
	21456	S ORD("id ")=IFN,ORD ("name")=$ $OI^ORX8(+ X0)
	21457	"RTN","HMP DOR",44,0)
	21458	S ORD("gr oup")=$P(X 0,U,2),ORD ("entered" )=$P(X0,U, 3)
	21459	"RTN","HMP DOR",45,0)
	21460	S ORD("st art")=$P(X 0,U,4),ORD ("stop")=$ P(X0,U,5)
	21461	"RTN","HMP DOR",46,0)
	21462	S ORD("st atus")=$P( X0,U,7)_U_ $P(X0,U,6) _U_$$STS($ P(X0,U,7))
	21463	"RTN","HMP DOR",47,0)
	21464	M ^TMP("H MPTEXT",$J ,IFN)=^TMP ("ORR",$J, ORLIST,HMP N,"TX")
	21465	"RTN","HMP DOR",48,0)
	21466	S ORD("co ntent")=$N A(^TMP("HM PTEXT",$J, IFN))
	21467	"RTN","HMP DOR",49,0)
	21468	S X=$$GET 1^DIQ(100, IFN_",",1, "I"),ORD(" provider") =X_U_$P($G (^VA(200,+ X,0)),U) ; ICR 10060 DE2818 ASF 11/10/15
	21469	"RTN","HMP DOR",50,0)
	21470	S X=$$GET 1^DIQ(100, IFN_",",6) ,LOC="" I $L(X) D
	21471	"RTN","HMP DOR",51,0)
	21472	. S LOC=+ $O(^SC("B" ,X,0)),ORD ("location ")=LOC_U_X ;ICR 1004 0 DE2818 A SF 11/9/15
	21473	"RTN","HMP DOR",52,0)
	21474	S ORD("fa cility")=$ $FAC^HMPD( LOC)
	21475	"RTN","HMP DOR",53,0)
	21476	S ORD("se rvice")=$$ GET1^DIQ(1 00,IFN_"," ,"12:1")
	21477	"RTN","HMP DOR",54,0)
	21478	; acknowl edgements
	21479	"RTN","HMP DOR",55,0)
	21480	S DA=0 F S DA=$O(^ ORA(102.4, "B",+IFN,D A)) Q:DA<1 D ;ICR 5769 DE281 8 ASF 11/9 /15
	21481	"RTN","HMP DOR",56,0)
	21482	. S X0=$G (^ORA(102. 4,DA,0)) Q :'$P(X0,U, 3) ;stub - not ack' d
	21483	"RTN","HMP DOR",57,0)
	21484	. S X=+$P (X0,U,2),X =$S(X:X_U_ $P($G(^VA( 200,X,0)), U),1:U)
	21485	"RTN","HMP DOR",58,0)
	21486	. S ORD(" acknowledg ement",DA) =X_U_$P(X0 ,U,3)
	21487	"RTN","HMP DOR",59,0)
	21488	Q
	21489	"RTN","HMP DOR",60,0)
	21490	;
	21491	"RTN","HMP DOR",61,0)
	21492	STS(X) ; - - return V UID for st atus abbre viation X
	21493	"RTN","HMP DOR",62,0)
	21494	N Y,I,STS
	21495	"RTN","HMP DOR",63,0)
	21496	S STS="dc ^comp^hold ^flag^pend ^actv^exp^ schd^part^ dlay^unr^d c/e^canc^l aps^rnew^n one"
	21497	"RTN","HMP DOR",64,0)
	21498	F I=1:1:1 6 Q:$P(STS ,U,I)=X
	21499	"RTN","HMP DOR",65,0)
	21500	S Y=$$VUI D^HMPD(I,1 00.01)
	21501	"RTN","HMP DOR",66,0)
	21502	Q Y
	21503	"RTN","HMP DOR",67,0)
	21504	;
	21505	"RTN","HMP DOR",68,0)
	21506	; ------- ----- Retu rn data to middle ti er ------- -----
	21507	"RTN","HMP DOR",69,0)
	21508	;
	21509	"RTN","HMP DOR",70,0)
	21510	XML(ORD) ; -- Return patient d ata as XML in @HMP@( n)
	21511	"RTN","HMP DOR",71,0)
	21512	; as <ele ment code= '123' disp layName='A BC' />
	21513	"RTN","HMP DOR",72,0)
	21514	N ATT,X,Y ,I,NAMES
	21515	"RTN","HMP DOR",73,0)
	21516	D ADD("<o rder>") S HMPTOTL=$G (HMPTOTL)+ 1
	21517	"RTN","HMP DOR",74,0)
	21518	S ATT="" F S ATT=$ O(ORD(ATT) ) Q:ATT="" D D:$L( Y) ADD(Y)
	21519	"RTN","HMP DOR",75,0)
	21520	. S NAMES ="code^nam e^"_$S(ATT ?1"ack".E: "date",1:" vuid")_"^Z "
	21521	"RTN","HMP DOR",76,0)
	21522	. I ATT?1 "ack".E D S Y="" Q
	21523	"RTN","HMP DOR",77,0)
	21524	.. D ADD( "<"_ATT_"s >")
	21525	"RTN","HMP DOR",78,0)
	21526	.. S I=0 F S I=$O( ORD(ATT,I) ) Q:I<1 D
	21527	"RTN","HMP DOR",79,0)
	21528	... S X=$ G(ORD(ATT, I))
	21529	"RTN","HMP DOR",80,0)
	21530	... S Y=" <"_ATT_" " _$$LOOP_"/ >" D ADD(Y )
	21531	"RTN","HMP DOR",81,0)
	21532	.. D ADD( "</"_ATT_" s>")
	21533	"RTN","HMP DOR",82,0)
	21534	. S X=$G( ORD(ATT)), Y="" Q:'$L (X)
	21535	"RTN","HMP DOR",83,0)
	21536	. I ATT=" content" D S Y="" Q ;text
	21537	"RTN","HMP DOR",84,0)
	21538	.. S Y="< content xm l:space='p reserve'>" D ADD(Y)
	21539	"RTN","HMP DOR",85,0)
	21540	.. S I=0 F S I=$O( @X@(I)) Q: I<1 S Y=$ $ESC^HMPD( @X@(I)) D ADD(Y)
	21541	"RTN","HMP DOR",86,0)
	21542	.. D ADD( "</content >")
	21543	"RTN","HMP DOR",87,0)
	21544	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	21545	"RTN","HMP DOR",88,0)
	21546	. I $L(X) >1 S Y="<" _ATT_" "_$ $LOOP_"/>"
	21547	"RTN","HMP DOR",89,0)
	21548	D ADD("</ order>")
	21549	"RTN","HMP DOR",90,0)
	21550	Q
	21551	"RTN","HMP DOR",91,0)
	21552	;
	21553	"RTN","HMP DOR",92,0)
	21554	LOOP() ; - - build su b-items st ring from NAMES and X
	21555	"RTN","HMP DOR",93,0)
	21556	N STR,P,T AG S STR=" "
	21557	"RTN","HMP DOR",94,0)
	21558	F P=1:1 S TAG=$P(NA MES,U,P) Q :TAG="Z" I $L($P(X, U,P)) S ST R=STR_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	21559	"RTN","HMP DOR",95,0)
	21560	Q STR
	21561	"RTN","HMP DOR",96,0)
	21562	;
	21563	"RTN","HMP DOR",97,0)
	21564	ADD(X) ; A dd a line @HMP@(n)=X
	21565	"RTN","HMP DOR",98,0)
	21566	S HMPI=$G (HMPI)+1
	21567	"RTN","HMP DOR",99,0)
	21568	S @HMP@(H MPI)=X
	21569	"RTN","HMP DOR",100,0 )
	21570	Q
	21571	"RTN","HMP DPROC")
	21572	1^165
	21573	"RTN","HMP DPS")
	21574	1^200
	21575	"RTN","HMP DPSI")
	21576	1^201
	21577	"RTN","HMP DPSO")
	21578	1^202
	21579	"RTN","HMP DPSOR")
	21580	0^66^B2311 665
	21581	"RTN","HMP DPSOR",1,0 )
	21582	HMPDPSOR ; SLC/MKB,AS MR/RRB,SRG - Medicat ion extrac t by order ;8/2/11 1 5:29
	21583	"RTN","HMP DPSOR",2,0 )
	21584	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	21585	"RTN","HMP DPSOR",3,0 )
	21586	;Per VA D irective 6 402, this routine sh ould not b e modified .
	21587	"RTN","HMP DPSOR",4,0 )
	21588	;
	21589	"RTN","HMP DPSOR",5,0 )
	21590	; Externa l Referenc es DBIA#
	21591	"RTN","HMP DPSOR",6,0 )
	21592	; ------- ---------- -- -----
	21593	"RTN","HMP DPSOR",7,0 )
	21594	; ^OR(100 5771
	21595	"RTN","HMP DPSOR",8,0 )
	21596	; ^ORD(10 0.98 873
	21597	"RTN","HMP DPSOR",9,0 )
	21598	; ^SC 10040
	21599	"RTN","HMP DPSOR",10, 0)
	21600	; ^VA(200 10060
	21601	"RTN","HMP DPSOR",11, 0)
	21602	; DIQ 2056
	21603	"RTN","HMP DPSOR",12, 0)
	21604	; ORCD 5493
	21605	"RTN","HMP DPSOR",13, 0)
	21606	; ORQ1,^T MP("ORR",$ J) 3154
	21607	"RTN","HMP DPSOR",14, 0)
	21608	; ORX8 871,24 67,3071
	21609	"RTN","HMP DPSOR",15, 0)
	21610	; PSOORRL ,^TMP("PS" ,$J) 2400
	21611	"RTN","HMP DPSOR",16, 0)
	21612	; PSS50P7 4662
	21613	"RTN","HMP DPSOR",17, 0)
	21614	; PSS51P2 4548
	21615	"RTN","HMP DPSOR",18, 0)
	21616	Q
	21617	"RTN","HMP DPSOR",19, 0)
	21618	; ------- ----- Get data from VistA ---- --------
	21619	"RTN","HMP DPSOR",20, 0)
	21620	;
	21621	"RTN","HMP DPSOR",21, 0)
	21622	STATUS(X) ; -- retur n HITSP st atus for 1 00.01 #X
	21623	"RTN","HMP DPSOR",22, 0)
	21624	S X=+$G(X ) S:'X X=9 9 ;no sta tus
	21625	"RTN","HMP DPSOR",23, 0)
	21626	I X=3 Q " hold"
	21627	"RTN","HMP DPSOR",24, 0)
	21628	I X=10!(X =11)!(X=5) Q "not ac tive"
	21629	"RTN","HMP DPSOR",25, 0)
	21630	I X=1!(X= 12)!(X=13) Q "not ac tive"
	21631	"RTN","HMP DPSOR",26, 0)
	21632	I X=14!(X =99) Q "not ac tive"
	21633	"RTN","HMP DPSOR",27, 0)
	21634	I X=2!(X= 7)!(X=15) Q "histor ical"
	21635	"RTN","HMP DPSOR",28, 0)
	21636	Q "active "
	21637	"RTN","HMP DPSOR",29, 0)
	21638	;
	21639	"RTN","HMP DPSOR",30, 0)
	21640	RESP(ORIFN ,RESP) ; - - return o rder respo nses [inte rnal form]
	21641	"RTN","HMP DPSOR",31, 0)
	21642	N HMPDLG, I,J,W,ID,T YPE,X,Y
	21643	"RTN","HMP DPSOR",32, 0)
	21644	I '$D(ORD IALOG) S O RDIALOG=12 9 D GETDLG 1^ORCD(129 )
	21645	"RTN","HMP DPSOR",33, 0)
	21646	D GETORDE R^ORCD(+$G (ORIFN),"H MPDLG")
	21647	"RTN","HMP DPSOR",34, 0)
	21648	S I=0 F S I=$O(HMP DLG(I)) Q: I<1 D
	21649	"RTN","HMP DPSOR",35, 0)
	21650	. S ID=$P ($G(ORDIAL OG(I)),U,2 ) Q:'$L(ID )
	21651	"RTN","HMP DPSOR",36, 0)
	21652	. S TYPE= $P($G(ORDI ALOG(I,0)) ,U)
	21653	"RTN","HMP DPSOR",37, 0)
	21654	. S J=0 F S J=$O(H MPDLG(I,J) ) Q:J<1 I $D(HMPDLG (I,J)) D
	21655	"RTN","HMP DPSOR",38, 0)
	21656	.. S X=HM PDLG(I,J) I TYPE'="W " S RESP(I D,J)=X Q
	21657	"RTN","HMP DPSOR",39, 0)
	21658	.. S Y=$G (@X@(1,0)) ,W=1 F S W=$O(@X@(W )) Q:W<1 S Y=Y_$S($ E(Y,$L(Y)) '=" ":" ", 1:"")_$G(@ X@(W,0))
	21659	"RTN","HMP DPSOR",40, 0)
	21660	.. S:$L(Y ) RESP(ID, J)=Y
	21661	"RTN","HMP DPSOR",41, 0)
	21662	Q
	21663	"RTN","HMP DPT")
	21664	1^166
	21665	"RTN","HMP DPXAM")
	21666	1^167
	21667	"RTN","HMP DPXED")
	21668	1^168
	21669	"RTN","HMP DPXHF")
	21670	1^169
	21671	"RTN","HMP DPXIM")
	21672	1^170
	21673	"RTN","HMP DPXSK")
	21674	1^171
	21675	"RTN","HMP DRA")
	21676	0^73^B4279 2632
	21677	"RTN","HMP DRA",1,0)
	21678	HMPDRA ;SL C/MKB,ASMR /RRB - Rad iology ext ract;8/2/1 1 15:29
	21679	"RTN","HMP DRA",2,0)
	21680	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	21681	"RTN","HMP DRA",3,0)
	21682	;Per VA D irective 6 402, this routine sh ould not b e modified .
	21683	"RTN","HMP DRA",4,0)
	21684	;
	21685	"RTN","HMP DRA",5,0)
	21686	; Externa l Referenc es DBIA#
	21687	"RTN","HMP DRA",6,0)
	21688	; ------- ---------- -- -----
	21689	"RTN","HMP DRA",7,0)
	21690	; ^RADPT 2480
	21691	"RTN","HMP DRA",8,0)
	21692	; ^RARPT 8000005
	21693	"RTN","HMP DRA",9,0)
	21694	; ^SC( 10040
	21695	"RTN","HMP DRA",10,0)
	21696	; ^VA(200 10060
	21697	"RTN","HMP DRA",11,0)
	21698	; DIQ 2056
	21699	"RTN","HMP DRA",12,0)
	21700	; ICPTCOD 1995
	21701	"RTN","HMP DRA",13,0)
	21702	; RAO7PC1 20 43,2265
	21703	"RTN","HMP DRA",14,0)
	21704	; RAO7PC3 2877
	21705	"RTN","HMP DRA",15,0)
	21706	Q
	21707	"RTN","HMP DRA",16,0)
	21708	; ------- ----- Get exam(s) fr om VistA - ---------- -
	21709	"RTN","HMP DRA",17,0)
	21710	;
	21711	"RTN","HMP DRA",18,0)
	21712	EN(DFN,BEG ,END,MAX,I D) ; -- fi nd patient 's radiolo gy exams
	21713	"RTN","HMP DRA",19,0)
	21714	N HMPITM, HMPXID
	21715	"RTN","HMP DRA",20,0)
	21716	S DFN=+$G (DFN) Q:DF N<1
	21717	"RTN","HMP DRA",21,0)
	21718	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)_ "P"
	21719	"RTN","HMP DRA",22,0)
	21720	K ^TMP($J ,"RAE1") D EN1^RAO7P C1(DFN,BEG ,END,MAX)
	21721	"RTN","HMP DRA",23,0)
	21722	;
	21723	"RTN","HMP DRA",24,0)
	21724	; get exa m(s)
	21725	"RTN","HMP DRA",25,0)
	21726	I $G(ID) D EN1(ID,. HMPITM),XM L(.HMPITM) G ENQ
	21727	"RTN","HMP DRA",26,0)
	21728	;
	21729	"RTN","HMP DRA",27,0)
	21730	; get all exams
	21731	"RTN","HMP DRA",28,0)
	21732	S HMPXID= "" F S HM PXID=$O(^T MP($J,"RAE 1",DFN,HMP XID)) Q:HM PXID="" D
	21733	"RTN","HMP DRA",29,0)
	21734	. K HMPIT M D EN1(HM PXID,.HMPI TM) Q:'$D( HMPITM)
	21735	"RTN","HMP DRA",30,0)
	21736	. D XML(. HMPITM)
	21737	"RTN","HMP DRA",31,0)
	21738	ENQ ; end
	21739	"RTN","HMP DRA",32,0)
	21740	K ^TMP($J ,"RAE1"),^ TMP("HMPTE XT",$J)
	21741	"RTN","HMP DRA",33,0)
	21742	Q
	21743	"RTN","HMP DRA",34,0)
	21744	;
	21745	"RTN","HMP DRA",35,0)
	21746	EN1(ID,EXA M) ; -- re turn an ex am in EXAM ("attribut e")=value
	21747	"RTN","HMP DRA",36,0)
	21748	; Expec ts ^TMP($J ,"RAE1",DF N,ID) from EN1^RAO7P C1
	21749	"RTN","HMP DRA",37,0)
	21750	N X0,SET, PROC,DATE, LOC,X,Y,IE NS
	21751	"RTN","HMP DRA",38,0)
	21752	K EXAM,^T MP("HMPTEX T",$J)
	21753	"RTN","HMP DRA",39,0)
	21754	S X0=$G(^ TMP($J,"RA E1",DFN,ID )),SET=$G( ^(ID,"CPRS ")),PROC=$ P(X0,U)
	21755	"RTN","HMP DRA",40,0)
	21756	S EXAM("i d")=ID,EXA M("name")= PROC,EXAM( "case")=$P (X0,U,2)
	21757	"RTN","HMP DRA",41,0)
	21758	S DATE=99 99999.9999 -+ID,EXAM( "dateTime" )=DATE
	21759	"RTN","HMP DRA",42,0)
	21760	I $P(X0,U ,5) D ;re port exist s
	21761	"RTN","HMP DRA",43,0)
	21762	. N NM S NM=$S(+SET =2:$P(SET, U,2),1:PRO C) ;2 = shared r eport
	21763	"RTN","HMP DRA",44,0)
	21764	. S EXAM( "document" ,1)=ID_U_N M_"^^"_$P( X0,U,3) ;i d^localTit le^^status
	21765	"RTN","HMP DRA",45,0)
	21766	. S:$G(HM PTEXT) EXA M("documen t",1,"cont ent")=$$TE XT(DFN,ID)
	21767	"RTN","HMP DRA",46,0)
	21768	S:$L($P(X 0,U,6)) EX AM("status ")=$P($P(X 0,U,6),"~" ,2)
	21769	"RTN","HMP DRA",47,0)
	21770	S X=$P(X0 ,U,7),LOC= "" I $L(X) D
	21771	"RTN","HMP DRA",48,0)
	21772	. S LOC=+ $O(^SC("B" ,X,0)),EXA M("locatio n")=LOC_U_ X ;ICR 100 40 DE2818 ASF 11/18/ 15
	21773	"RTN","HMP DRA",49,0)
	21774	S EXAM("f acility")= $$FAC^HMPD (LOC)
	21775	"RTN","HMP DRA",50,0)
	21776	I $L($P(X 0,U,8)) S X=$TR($P(X 0,U,8),"~" ,"^"),EXAM ("imagingT ype")=X
	21777	"RTN","HMP DRA",51,0)
	21778	S IENS=$P (ID,"-",2) _","_+ID_" ,"_DFN_","
	21779	"RTN","HMP DRA",52,0)
	21780	S X=$P(X0 ,U,10) I X D
	21781	"RTN","HMP DRA",53,0)
	21782	. S EXAM( "type")=$$ CPT(X)
	21783	"RTN","HMP DRA",54,0)
	21784	. I $D(^T MP($J,"RAE 1",DFN,ID, "CMOD")) M EXAM("mod ifier")=^( "CMOD")
	21785	"RTN","HMP DRA",55,0)
	21786	I $P(X0,U ,11) S EXA M("order") =+$P(X0,U, 11)_U_$S($ L(SET):$P( SET,U,2),1 :PROC)
	21787	"RTN","HMP DRA",56,0)
	21788	S EXAM("h asImages") =$S($P(X0, U,12)="Y": 1,1:0)
	21789	"RTN","HMP DRA",57,0)
	21790	I $P(X0,U ,4)="Y"!($ P(X0,U,9)= "Y") S EXA M("interpr etation")= "ABNORMAL"
	21791	"RTN","HMP DRA",58,0)
	21792	S EXAM("e ncounter") =$$GET1^DI Q(70.03,IE NS,27,"I")
	21793	"RTN","HMP DRA",59,0)
	21794	S ID=DFN_ U_$TR(ID," -","^") D EN3^RAO7PC 1(ID) D ; get additi onal value s
	21795	"RTN","HMP DRA",60,0)
	21796	. S X=+$G (^TMP($J," RAE2",DFN, +$P(ID,U,3 ),PROC,"P" ))
	21797	"RTN","HMP DRA",61,0)
	21798	. I X S E XAM("provi der")=X_U_ $P($G(^VA( 200,X,0)), U) ;ICR100 60 DE2818 ASF 11/18/ 15
	21799	"RTN","HMP DRA",62,0)
	21800	S EXAM("c ategory")= "RA"
	21801	"RTN","HMP DRA",63,0)
	21802	Q
	21803	"RTN","HMP DRA",64,0)
	21804	;
	21805	"RTN","HMP DRA",65,0)
	21806	CPT(IEN) ; -- return code^desc ription fo r CPT code , or "^" i f error
	21807	"RTN","HMP DRA",66,0)
	21808	N X0,HMPX ,N,I,X,Y S IEN=+$G(I EN)
	21809	"RTN","HMP DRA",67,0)
	21810	S X0=$$CP T^ICPTCOD( IEN) I X0< 0 Q "^"
	21811	"RTN","HMP DRA",68,0)
	21812	S Y=$P(X0 ,U,2,3) ;CPT Code^Short Name
	21813	"RTN","HMP DRA",69,0)
	21814	S N=$$CPT D^ICPTCOD( $P(Y,U),"H MPX") ;CPT Descripti on
	21815	"RTN","HMP DRA",70,0)
	21816	I N>0,$L( $G(HMPX(1) )) D
	21817	"RTN","HMP DRA",71,0)
	21818	. S X=$G( HMPX(1)),I =1
	21819	"RTN","HMP DRA",72,0)
	21820	. F S I= $O(HMPX(I) ) Q:I<1 Q :HMPX(I)=" " S X=X_ " "_HMPX(I )
	21821	"RTN","HMP DRA",73,0)
	21822	. S $P(Y, U,2)=X
	21823	"RTN","HMP DRA",74,0)
	21824	Q Y
	21825	"RTN","HMP DRA",75,0)
	21826	;
	21827	"RTN","HMP DRA",76,0)
	21828	TEXT(PAT,I D) ; -- Ge t report t ext, retur n temp arr ay name
	21829	"RTN","HMP DRA",77,0)
	21830	S PAT=+$G (PAT),ID=$ G(ID) I PA T<1!(ID<1) Q ""
	21831	"RTN","HMP DRA",78,0)
	21832	N DFN,EXA M,CASE,PRO C,I,X,Y
	21833	"RTN","HMP DRA",79,0)
	21834	S EXAM=PA T_U_$TR(ID ,"-","^") D EN3^RAO7 PC3(EXAM)
	21835	"RTN","HMP DRA",80,0)
	21836	S Y=$NA(^ TMP("HMPTE XT",$J,ID) ) K @Y
	21837	"RTN","HMP DRA",81,0)
	21838	S CASE=$O (^TMP($J," RAE3",PAT, 0)),PROC=$ O(^(CASE," "))
	21839	"RTN","HMP DRA",82,0)
	21840	S I=0 F S I=$O(^TM P($J,"RAE3 ",PAT,CASE ,PROC,I)) Q:I<1 S X =^(I),@Y@( I)=X
	21841	"RTN","HMP DRA",83,0)
	21842	K ^TMP($J ,"RAE3",PA T)
	21843	"RTN","HMP DRA",84,0)
	21844	Q Y
	21845	"RTN","HMP DRA",85,0)
	21846	;
	21847	"RTN","HMP DRA",86,0)
	21848	; ------- ----- Get report(s) [via HMPDT IU] ------ ------
	21849	"RTN","HMP DRA",87,0)
	21850	;
	21851	"RTN","HMP DRA",88,0)
	21852	RPTS(DFN,B EG,END,MAX ) ; -- fin d patient' s radiolog y reports
	21853	"RTN","HMP DRA",89,0)
	21854	N HMPITM, HMPXID,STS ,PSET
	21855	"RTN","HMP DRA",90,0)
	21856	S DFN=+$G (DFN) Q:DF N<1
	21857	"RTN","HMP DRA",91,0)
	21858	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)_ "P"
	21859	"RTN","HMP DRA",92,0)
	21860	K ^TMP($J ,"RAE1") D EN1^RAO7P C1(DFN,BEG ,END,MAX)
	21861	"RTN","HMP DRA",93,0)
	21862	S HMPXID= "" F S HM PXID=$O(^T MP($J,"RAE 1",DFN,HMP XID)) Q:HM PXID="" D
	21863	"RTN","HMP DRA",94,0)
	21864	. S STS=$ P($G(^TMP( $J,"RAE1", DFN,HMPXID )),U,3),PS ET=$G(^(HM PXID,"CPRS "))
	21865	"RTN","HMP DRA",95,0)
	21866	. Q:STS=" No Report" !(STS="Del eted") ;! (STS["Draf t") ??
	21867	"RTN","HMP DRA",96,0)
	21868	. I +PSET =2,$G(PSET (+HMPXID,$ P(PSET,U,2 ))) Q ;al ready have report
	21869	"RTN","HMP DRA",97,0)
	21870	. K HMPIT M D RPT1(D FN,HMPXID, .HMPITM) D :$D(HMPITM ) XML^HMPD TIU(.HMPIT M)
	21871	"RTN","HMP DRA",98,0)
	21872	. I +PSET =2 S PSET( +HMPXID,$P (PSET,U,2) )=$P(HMPXI D,"-",2) ; parent
	21873	"RTN","HMP DRA",99,0)
	21874	K ^TMP($J ,"RAE1"),^ TMP("HMPTE XT",$J)
	21875	"RTN","HMP DRA",100,0 )
	21876	Q
	21877	"RTN","HMP DRA",101,0 )
	21878	;
	21879	"RTN","HMP DRA",102,0 )
	21880	RPT1(DFN,I D,RPT) ; - - return r eport as a TIU docum ent
	21881	"RTN","HMP DRA",103,0 )
	21882	S DFN=+$G (DFN),ID=$ G(ID) Q:DF N<1 Q:ID< 1
	21883	"RTN","HMP DRA",104,0 )
	21884	N EXAM,CA SE,PROC,RA E3,RAE1,I, X,Y,IENS,L OC
	21885	"RTN","HMP DRA",105,0 )
	21886	K RPT,^TM P("HMPTEXT ",$J)
	21887	"RTN","HMP DRA",106,0 )
	21888	S EXAM=DF N_U_$TR(ID ,"-","^") D
	21889	"RTN","HMP DRA",107,0 )
	21890	. N DFN D EN3^RAO7P C3(EXAM) ; report
	21891	"RTN","HMP DRA",108,0 )
	21892	. D EN3^R AO7PC1(EXA M) ; add'l valu es
	21893	"RTN","HMP DRA",109,0 )
	21894	S CASE=$O (^TMP($J," RAE3",DFN, 0)),PROC=$ O(^(CASE," ")),RAE3=$ G(^(PROC))
	21895	"RTN","HMP DRA",110,0 )
	21896	S RAE1=$G (^TMP($J," RAE1",DFN, ID))
	21897	"RTN","HMP DRA",111,0 )
	21898	I $G(HMPT EXT) D
	21899	"RTN","HMP DRA",112,0 )
	21900	. S Y=$NA (^TMP("HMP TEXT",$J,I D))
	21901	"RTN","HMP DRA",113,0 )
	21902	. S I=0 F S I=$O(^ TMP($J,"RA E3",DFN,CA SE,PROC,I) ) Q:I<1 S X=^(I),@Y @(I)=X
	21903	"RTN","HMP DRA",114,0 )
	21904	. S RPT(" content")= Y
	21905	"RTN","HMP DRA",115,0 )
	21906	S RPT("id ")=ID,RPT( "status")= $P(RAE3,U)
	21907	"RTN","HMP DRA",116,0 )
	21908	S X=99999 99.9999-(+ ID),RPT("r eferenceDa teTime")=X
	21909	"RTN","HMP DRA",117,0 )
	21910	S X=+$G(^ TMP($J,"RA E2",DFN,CA SE,PROC,"P "))
	21911	"RTN","HMP DRA",118,0 )
	21912	I X S RPT ("clinicia n",1)=X_U_ $P($G(^VA( 200,X,0)), U)_"^A" ;I CR10060 DE 2818 ASF 1 1/18/15
	21913	"RTN","HMP DRA",119,0 )
	21914	S X=$G(^T MP($J,"RAE 2",DFN,CAS E,PROC,"V" )) I X D
	21915	"RTN","HMP DRA",120,0 )
	21916	. N Y S Y =$$GET1^DI Q(74,+$P(R AE1,U,5)_" ,",7,"I")
	21917	"RTN","HMP DRA",121,0 )
	21918	. S RPT(" clinician" ,2)=+X_U_$ P($G(^VA(2 00,+X,0)), U)_"^S^"_Y _U_$P(X,U, 2) ;ICR100 60 DE2818 ASF 11/18/ 15
	21919	"RTN","HMP DRA",122,0 )
	21920	I $D(^TMP ($J,"RAE3" ,DFN,"PRIN T_SET")) S PROC=$G(^ ("ORD")) ; use parent , if print set
	21921	"RTN","HMP DRA",123,0 )
	21922	S RPT("lo calTitle") =PROC,RPT( "category" )="RA"
	21923	"RTN","HMP DRA",124,0 )
	21924	S RPT("na tionalTitl e")="46950 68^RADIOLO GY REPORT"
	21925	"RTN","HMP DRA",125,0 )
	21926	S RPT("na tionalTitl eSubject") ="4693357^ RADIOLOGY"
	21927	"RTN","HMP DRA",126,0 )
	21928	S RPT("na tionalTitl eType")="4 696123^REP ORT"
	21929	"RTN","HMP DRA",127,0 )
	21930	S X=$P(RA E1,U,7),LO C="" I $L( X) D
	21931	"RTN","HMP DRA",128,0 )
	21932	. S LOC=+ $O(^SC("B" ,X,0)) ;,E XAM("locat ion")=LOC_ U_X ICR 10 040 DE2818 ASF 11/18 /15
	21933	"RTN","HMP DRA",129,0 )
	21934	S RPT("fa cility")=$ $FAC^HMPD( LOC)
	21935	"RTN","HMP DRA",130,0 )
	21936	S IENS=$P (ID,"-",2) _","_+ID_" ,"_DFN_","
	21937	"RTN","HMP DRA",131,0 )
	21938	S RPT("en counter")= $$GET1^DIQ (70.03,IEN S,27,"I")
	21939	"RTN","HMP DRA",132,0 )
	21940	S:$G(FILT ER("loinc" )) RPT("lo inc")=$P(F ILTER("loi nc"),U)
	21941	"RTN","HMP DRA",133,0 )
	21942	K ^TMP($J ,"RAE3",DF N),^TMP($J ,"RAE2",DF N)
	21943	"RTN","HMP DRA",134,0 )
	21944	Q
	21945	"RTN","HMP DRA",135,0 )
	21946	;
	21947	"RTN","HMP DRA",136,0 )
	21948	; ------- ----- Retu rn data to middle ti er ------- -----
	21949	"RTN","HMP DRA",137,0 )
	21950	;
	21951	"RTN","HMP DRA",138,0 )
	21952	XML(EXAM) ; -- Retur n exams as XML
	21953	"RTN","HMP DRA",139,0 )
	21954	N ATT,X,Y ,NAMES,I,J
	21955	"RTN","HMP DRA",140,0 )
	21956	D ADD("<r adiology>" ) S HMPTOT L=$G(HMPTO TL)+1
	21957	"RTN","HMP DRA",141,0 )
	21958	S ATT="" F S ATT=$ O(EXAM(ATT )) Q:ATT=" " D D:$L (Y) ADD(Y)
	21959	"RTN","HMP DRA",142,0 )
	21960	. S NAMES =$S(ATT="d ocument":" id^localTi tle^nation alTitle^st atus^Z",1: "code^name ^Z")
	21961	"RTN","HMP DRA",143,0 )
	21962	. I $O(EX AM(ATT,0)) D S Y="" Q ;multi ples
	21963	"RTN","HMP DRA",144,0 )
	21964	.. D ADD( "<"_ATT_"s >")
	21965	"RTN","HMP DRA",145,0 )
	21966	.. S I=0 F S I=$O( EXAM(ATT,I )) Q:I<1 D
	21967	"RTN","HMP DRA",146,0 )
	21968	... S X=$ G(EXAM(ATT ,I))
	21969	"RTN","HMP DRA",147,0 )
	21970	... S Y=" <"_ATT_" " _$$LOOP ;_ "/>" D ADD (Y)
	21971	"RTN","HMP DRA",148,0 )
	21972	... S X=$ G(EXAM(ATT ,I,"conten t")) I '$L (X) S Y=Y_ "/>" D ADD (Y) Q
	21973	"RTN","HMP DRA",149,0 )
	21974	... S Y=Y _">" D ADD (Y)
	21975	"RTN","HMP DRA",150,0 )
	21976	... S Y=" <content x ml:space=' preserve'> " D ADD(Y)
	21977	"RTN","HMP DRA",151,0 )
	21978	... S J=0 F S J=$O (@X@(J)) Q :J<1 S Y= $$ESC^HMPD (@X@(J)) D ADD(Y)
	21979	"RTN","HMP DRA",152,0 )
	21980	... D ADD ("</conten t>"),ADD(" </"_ATT_"> ")
	21981	"RTN","HMP DRA",153,0 )
	21982	.. D ADD( "</"_ATT_" s>")
	21983	"RTN","HMP DRA",154,0 )
	21984	. S X=$G( EXAM(ATT)) ,Y="" Q:'$ L(X)
	21985	"RTN","HMP DRA",155,0 )
	21986	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	21987	"RTN","HMP DRA",156,0 )
	21988	. I $L(X) >1 S Y="<" _ATT_" "_$ $LOOP_"/>"
	21989	"RTN","HMP DRA",157,0 )
	21990	D ADD("</ radiology> ")
	21991	"RTN","HMP DRA",158,0 )
	21992	Q
	21993	"RTN","HMP DRA",159,0 )
	21994	;
	21995	"RTN","HMP DRA",160,0 )
	21996	LOOP() ; - - build su b-items st ring from NAMES and X
	21997	"RTN","HMP DRA",161,0 )
	21998	N STR,P,T AG S STR=" "
	21999	"RTN","HMP DRA",162,0 )
	22000	F P=1:1 S TAG=$P(NA MES,U,P) Q :TAG="Z" I $L($P(X, U,P)) S ST R=STR_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	22001	"RTN","HMP DRA",163,0 )
	22002	Q STR
	22003	"RTN","HMP DRA",164,0 )
	22004	;
	22005	"RTN","HMP DRA",165,0 )
	22006	ADD(X) ; - - Add a li ne @HMP@(n )=X
	22007	"RTN","HMP DRA",166,0 )
	22008	S HMPI=$G (HMPI)+1
	22009	"RTN","HMP DRA",167,0 )
	22010	S @HMP@(H MPI)=X
	22011	"RTN","HMP DRA",168,0 )
	22012	Q
	22013	"RTN","HMP DSDAM")
	22014	0^74^B2127 5067
	22015	"RTN","HMP DSDAM",1,0 )
	22016	HMPDSDAM ; SLC/MKB,AS MR/RRB - A ppointment extract;8 /2/11 15: 29
	22017	"RTN","HMP DSDAM",2,0 )
	22018	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	22019	"RTN","HMP DSDAM",3,0 )
	22020	;Per VA D irective 6 402, this routine sh ould not b e modified .
	22021	"RTN","HMP DSDAM",4,0 )
	22022	;
	22023	"RTN","HMP DSDAM",5,0 )
	22024	; Externa l Referenc es DBIA#
	22025	"RTN","HMP DSDAM",6,0 )
	22026	; ------- ---------- -- -----
	22027	"RTN","HMP DSDAM",7,0 )
	22028	; ^DGS(41 .1 3796
	22029	"RTN","HMP DSDAM",8,0 )
	22030	; ^DIC(42 10039
	22031	"RTN","HMP DSDAM",9,0 )
	22032	; ^SC 10040
	22033	"RTN","HMP DSDAM",10, 0)
	22034	; ^VA(200 10060
	22035	"RTN","HMP DSDAM",11, 0)
	22036	; DIQ 2056
	22037	"RTN","HMP DSDAM",12, 0)
	22038	; SDAMA30 1 4433
	22039	"RTN","HMP DSDAM",13, 0)
	22040	Q
	22041	"RTN","HMP DSDAM",14, 0)
	22042	; ------- ----- Get appointmen t(s) from VistA ---- --------
	22043	"RTN","HMP DSDAM",15, 0)
	22044	;
	22045	"RTN","HMP DSDAM",16, 0)
	22046	EN(DFN,BEG ,END,MAX,I D) ; -- fi nd patient 's [future ] appointm ents
	22047	"RTN","HMP DSDAM",17, 0)
	22048	N HMPX,HM PNUM,HMPDT ,HMPCNT,HM PITM,HMPA, X
	22049	"RTN","HMP DSDAM",18, 0)
	22050	S DFN=+$G (DFN) Q:DF N<1
	22051	"RTN","HMP DSDAM",19, 0)
	22052	S BEG=$G( BEG,DT),EN D=$G(END,4 141015),MA X=$G(MAX,9 999)
	22053	"RTN","HMP DSDAM",20, 0)
	22054	S HMPX(1) =BEG_";"_E ND,HMPX(4) =DFN,HMPX( "FLDS")="1 ;2;3;10;13 ",HMPX("SO RT")="P"
	22055	"RTN","HMP DSDAM",21, 0)
	22056	;
	22057	"RTN","HMP DSDAM",22, 0)
	22058	; get one appt
	22059	"RTN","HMP DSDAM",23, 0)
	22060	I $L($G(I D)) D Q
	22061	"RTN","HMP DSDAM",24, 0)
	22062	. S (BEG, END)=$P(ID ,";",2),HM PX(1)=BEG_ ";"_END,HM PX(2)=$P(I D,";",3)
	22063	"RTN","HMP DSDAM",25, 0)
	22064	. S HMPNU M=$$SDAPI^ SDAMA301(. HMPX) Q:HM PNUM<1
	22065	"RTN","HMP DSDAM",26, 0)
	22066	. D EN1(B EG,.HMPITM ),XML(.HMP ITM)
	22067	"RTN","HMP DSDAM",27, 0)
	22068	. K ^TMP( $J,"SDAMA3 01",DFN)
	22069	"RTN","HMP DSDAM",28, 0)
	22070	;
	22071	"RTN","HMP DSDAM",29, 0)
	22072	; get all [future] appointmen ts
	22073	"RTN","HMP DSDAM",30, 0)
	22074	S HMPX(3) ="R;I;NS;N SR;NT" ;no cancelled appt's
	22075	"RTN","HMP DSDAM",31, 0)
	22076	S HMPNUM= $$SDAPI^SD AMA301(.HM PX),(HMPDT ,HMPCNT)=0
	22077	"RTN","HMP DSDAM",32, 0)
	22078	F S HMPD T=$O(^TMP( $J,"SDAMA3 01",DFN,HM PDT)) Q:HM PDT<1 D Q:HMPCNT'< MAX
	22079	"RTN","HMP DSDAM",33, 0)
	22080	. S X=$P( $G(^TMP($J ,"SDAMA301 ",DFN,HMPD T)),U,3)
	22081	"RTN","HMP DSDAM",34, 0)
	22082	. I HMPDT <DT,$P(X," ;")'["NS" Q ;no pr ior kept a ppt's
	22083	"RTN","HMP DSDAM",35, 0)
	22084	. K HMPIT M D EN1(HM PDT,.HMPIT M) Q:'$D(H MPITM)
	22085	"RTN","HMP DSDAM",36, 0)
	22086	. D XML(. HMPITM) S HMPCNT=HMP CNT+1
	22087	"RTN","HMP DSDAM",37, 0)
	22088	K ^TMP($J ,"SDAMA301 ",DFN)
	22089	"RTN","HMP DSDAM",38, 0)
	22090	;
	22091	"RTN","HMP DSDAM",39, 0)
	22092	; get sch eduled adm issions
	22093	"RTN","HMP DSDAM",40, 0)
	22094	S HMPA=0 F S HMPA= $O(^DGS(41 .1,"B",DFN ,HMPA)) Q: HMPA<1 D Q:HMPCNT' <MAX ;ICR 3796 DE28 18 ASF 11/ 20/15
	22095	"RTN","HMP DSDAM",41, 0)
	22096	. S HMPX= $G(^DGS(41 .1,HMPA,0) )
	22097	"RTN","HMP DSDAM",42, 0)
	22098	. Q:$P(HM PX,U,13) Q:$P(HMPX, U,17) ;ca ncelled or admitted
	22099	"RTN","HMP DSDAM",43, 0)
	22100	. S X=$P( HMPX,U,2) Q:X<BEG!(X >END) ;ou t of date range
	22101	"RTN","HMP DSDAM",44, 0)
	22102	. K HMPIT M D DGS(HM PA,.HMPITM ) Q:'$D(HM PITM)
	22103	"RTN","HMP DSDAM",45, 0)
	22104	. D XML(. HMPITM) S HMPCNT=HMP CNT+1
	22105	"RTN","HMP DSDAM",46, 0)
	22106	Q
	22107	"RTN","HMP DSDAM",47, 0)
	22108	;
	22109	"RTN","HMP DSDAM",48, 0)
	22110	EN1(DATE,A PPT) ; -- return an appointmen t in APPT( "attribute ")=value
	22111	"RTN","HMP DSDAM",49, 0)
	22112	; Expect s ^TMP($J, "SDAMA301" ,DFN,DATE)
	22113	"RTN","HMP DSDAM",50, 0)
	22114	N X,HLOC, STS,CLS,SV ,PRV K APP T
	22115	"RTN","HMP DSDAM",51, 0)
	22116	S X=$G(^T MP($J,"SDA MA301",DFN ,DATE))
	22117	"RTN","HMP DSDAM",52, 0)
	22118	S DATE=+$ G(DATE),HL OC=$P(X,U, 2),APPT("t ype")=$TR( $P(X,U,10) ,";","^")
	22119	"RTN","HMP DSDAM",53, 0)
	22120	S STS=$P( X,U,3),CLS =$S($E(STS )="I":"I", 1:"O")
	22121	"RTN","HMP DSDAM",54, 0)
	22122	S APPT("i d")="A;"_D ATE_";"_+H LOC,APPT(" dateTime") =DATE I HL OC D
	22123	"RTN","HMP DSDAM",55, 0)
	22124	. S APPT( "location" )=$P(HLOC, ";",2)
	22125	"RTN","HMP DSDAM",56, 0)
	22126	. S APPT( "clinicSto p")=$$AMIS ^HMPDVSIT( +$P(X,U,13 ))
	22127	"RTN","HMP DSDAM",57, 0)
	22128	. S SV=$$ GET1^DIQ(4 4,+HLOC_", ",9.5,"I")
	22129	"RTN","HMP DSDAM",58, 0)
	22130	. I SV S APPT("serv ice")=$$SE RV(SV)
	22131	"RTN","HMP DSDAM",59, 0)
	22132	. ;find d efault pro vider
	22133	"RTN","HMP DSDAM",60, 0)
	22134	. S PRV=+ $$GET1^DIQ (44,+HLOC_ ",",16,"I" ) I 'PRV D
	22135	"RTN","HMP DSDAM",61, 0)
	22136	.. N HMPP ,I,FIRST
	22137	"RTN","HMP DSDAM",62, 0)
	22138	.. D GETS ^DIQ(44,+H LOC_",","2 600*","I", "HMPP")
	22139	"RTN","HMP DSDAM",63, 0)
	22140	.. S FIRS T=$O(HMPP( 44.1,"")), I=""
	22141	"RTN","HMP DSDAM",64, 0)
	22142	.. F S I =$O(HMPP(4 4.1,I)) Q: I="" I $G (HMPP(44.1 ,I,.02,"I" )) S PRV=$ G(HMPP(44. 1,I,.01,"I ")) Q
	22143	"RTN","HMP DSDAM",65, 0)
	22144	.. I 'PRV ,FIRST S P RV=$G(HMPP (44.1,FIRS T,.01,"I") )
	22145	"RTN","HMP DSDAM",66, 0)
	22146	. I PRV S APPT("pro vider")=PR V_U_$P($G( ^VA(200,PR V,0)),U) Q ;ICR 100 60 DEE2818 ASF 11/20 /15
	22147	"RTN","HMP DSDAM",67, 0)
	22148	S APPT("f acility")= $$FAC^HMPD (+HLOC)
	22149	"RTN","HMP DSDAM",68, 0)
	22150	S APPT("p atientClas s")=$S(CLS ="I":"IMP" ,1:"AMB")
	22151	"RTN","HMP DSDAM",69, 0)
	22152	S APPT("s erviceCate gory")=$S( CLS="I":"I ^INPATIENT VISIT",1: "A^AMBULAT ORY")
	22153	"RTN","HMP DSDAM",70, 0)
	22154	S APPT("a pptStatus" )=$P(STS," ;",2)
	22155	"RTN","HMP DSDAM",71, 0)
	22156	S APPT("v isitString ")=+HLOC_" ;"_DATE_"; A"
	22157	"RTN","HMP DSDAM",72, 0)
	22158	Q
	22159	"RTN","HMP DSDAM",73, 0)
	22160	;
	22161	"RTN","HMP DSDAM",74, 0)
	22162	SERV(FTS) ; -- Retur n #42.4 Se rvice for a Facility Treating Specialty
	22163	"RTN","HMP DSDAM",75, 0)
	22164	N Y S Y=" ",FTS=+$G( FTS)
	22165	"RTN","HMP DSDAM",76, 0)
	22166	S Y=$$GET 1^DIQ(45.7 ,FTS_","," 1:3","E")
	22167	"RTN","HMP DSDAM",77, 0)
	22168	Q Y
	22169	"RTN","HMP DSDAM",78, 0)
	22170	;
	22171	"RTN","HMP DSDAM",79, 0)
	22172	DGS(IFN,AD M) ; -- re turn a sch eduled adm ission in ADM("attri bute")=val ue
	22173	"RTN","HMP DSDAM",80, 0)
	22174	N X0,DATE ,HLOC,SV,X K ADM
	22175	"RTN","HMP DSDAM",81, 0)
	22176	S X0=$G(^ DGS(41.1,+ $G(IFN),0) ) Q:X0="" ;deleted ICR 3796 D E2818 ASF 11/20/15
	22177	"RTN","HMP DSDAM",82, 0)
	22178	S DATE=+$ P(X0,U,2), HLOC=+$G(^ DIC(42,+$P (X0,U,8),4 4)) ;ICR 1 0039 DE281 8 ASF 11/2 0/15
	22179	"RTN","HMP DSDAM",83, 0)
	22180	S ADM("id ")="H;"_DA TE,ADM("da teTime")=D ATE I HLOC D
	22181	"RTN","HMP DSDAM",84, 0)
	22182	. S ADM(" id")=ADM(" id")_";"_H LOC,ADM("v isitString ")=HLOC_"; "_DATE_";H "
	22183	"RTN","HMP DSDAM",85, 0)
	22184	. S ADM(" location") =HLOC_U_$P ($G(^SC(HL OC,0)),U) ;ICR 10040 DE2818 AS F 11/20/15
	22185	"RTN","HMP DSDAM",86, 0)
	22186	. S X=$$G ET1^DIQ(44 ,HLOC_",", 8,"I"),ADM ("clinicSt op")=$$AMI S^HMPDVSIT (X)
	22187	"RTN","HMP DSDAM",87, 0)
	22188	. S SV=$$ GET1^DIQ(4 4,HLOC_"," ,9.5,"I")
	22189	"RTN","HMP DSDAM",88, 0)
	22190	. I SV S ADM("servi ce")=$$SER V(SV)
	22191	"RTN","HMP DSDAM",89, 0)
	22192	S ADM("fa cility")=$ $FAC^HMPD( HLOC)
	22193	"RTN","HMP DSDAM",90, 0)
	22194	S X=$P(X0 ,U,5) I X S ADM("pro vider")=X_ U_$P($G(^V A(200,X,0) ),U) ;ICR 10060 DEE2 818 ASF 11 /20/15
	22195	"RTN","HMP DSDAM",91, 0)
	22196	S ADM("pa tientClass ")="IMP",A DM("servic eCategory" )="H^HOSPI TALIZATION "
	22197	"RTN","HMP DSDAM",92, 0)
	22198	S ADM("ap ptStatus") =$S($P(X0, U,17):"ADM ITTED",$P( X0,U,13):" CANCELLED" ,1:"SCHEDU LED")
	22199	"RTN","HMP DSDAM",93, 0)
	22200	Q
	22201	"RTN","HMP DSDAM",94, 0)
	22202	;
	22203	"RTN","HMP DSDAM",95, 0)
	22204	; ------- ----- Retu rn data to middle ti er ------- -----
	22205	"RTN","HMP DSDAM",96, 0)
	22206	;
	22207	"RTN","HMP DSDAM",97, 0)
	22208	XML(APPT) ; -- Retur n appointm ent as XML
	22209	"RTN","HMP DSDAM",98, 0)
	22210	N ATT,X,Y ,NAMES
	22211	"RTN","HMP DSDAM",99, 0)
	22212	D ADD("<a ppointment >") S HMPT OTL=$G(HMP TOTL)+1
	22213	"RTN","HMP DSDAM",100 ,0)
	22214	S ATT="" F S ATT=$ O(APPT(ATT )) Q:ATT=" " D D:$L (Y) ADD(Y)
	22215	"RTN","HMP DSDAM",101 ,0)
	22216	. S X=$G( APPT(ATT)) ,Y="" Q:'$ L(X)
	22217	"RTN","HMP DSDAM",102 ,0)
	22218	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	22219	"RTN","HMP DSDAM",103 ,0)
	22220	. I $L(X) >1 S NAMES ="code^nam e^Z",Y="<" _ATT_" "_$ $LOOP_"/>"
	22221	"RTN","HMP DSDAM",104 ,0)
	22222	D ADD("</ appointmen t>")
	22223	"RTN","HMP DSDAM",105 ,0)
	22224	Q
	22225	"RTN","HMP DSDAM",106 ,0)
	22226	;
	22227	"RTN","HMP DSDAM",107 ,0)
	22228	LOOP() ; - - build su b-items st ring from NAMES and X
	22229	"RTN","HMP DSDAM",108 ,0)
	22230	N STR,P,T AG S STR=" "
	22231	"RTN","HMP DSDAM",109 ,0)
	22232	F P=1:1 S TAG=$P(NA MES,U,P) Q :TAG="Z" I $L($P(X, U,P)) S ST R=STR_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	22233	"RTN","HMP DSDAM",110 ,0)
	22234	Q STR
	22235	"RTN","HMP DSDAM",111 ,0)
	22236	;
	22237	"RTN","HMP DSDAM",112 ,0)
	22238	ADD(X) ; - - Add a li ne @HMP@(n )=X
	22239	"RTN","HMP DSDAM",113 ,0)
	22240	S HMPI=$G (HMPI)+1
	22241	"RTN","HMP DSDAM",114 ,0)
	22242	S @HMP@(H MPI)=X
	22243	"RTN","HMP DSDAM",115 ,0)
	22244	Q
	22245	"RTN","HMP DSR")
	22246	0^75^B3002 2036
	22247	"RTN","HMP DSR",1,0)
	22248	HMPDSR ;SL C/MKB,ASMR /RRB - Sur gical Proc edures;8/2 /11 15:29
	22249	"RTN","HMP DSR",2,0)
	22250	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	22251	"RTN","HMP DSR",3,0)
	22252	;Per VA D irective 6 402, this routine sh ould not b e modified .
	22253	"RTN","HMP DSR",4,0)
	22254	;
	22255	"RTN","HMP DSR",5,0)
	22256	; Externa l Referenc es DBIA#
	22257	"RTN","HMP DSR",6,0)
	22258	; ------- ---------- -- -----
	22259	"RTN","HMP DSR",7,0)
	22260	; ^SRF(13 0 5675
	22261	"RTN","HMP DSR",8,0)
	22262	; ^SRO(13 6 4872
	22263	"RTN","HMP DSR",9,0)
	22264	; DIQ 2056
	22265	"RTN","HMP DSR",10,0)
	22266	; ICPTCOD 1995
	22267	"RTN","HMP DSR",11,0)
	22268	; ICPTMOD 1996
	22269	"RTN","HMP DSR",12,0)
	22270	; SROESTV 3533
	22271	"RTN","HMP DSR",13,0)
	22272	Q
	22273	"RTN","HMP DSR",14,0)
	22274	; ------- ----- Get surgery(ie s) from Vi stA ------ ------
	22275	"RTN","HMP DSR",15,0)
	22276	;
	22277	"RTN","HMP DSR",16,0)
	22278	EN(DFN,BEG ,END,MAX,I D) ; -- fi nd patient 's surgeri es
	22279	"RTN","HMP DSR",17,0)
	22280	N HMPN,HM PCNT,HMPIT M,HMPY
	22281	"RTN","HMP DSR",18,0)
	22282	S DFN=+$G (DFN) Q:DF N<1
	22283	"RTN","HMP DSR",19,0)
	22284	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	22285	"RTN","HMP DSR",20,0)
	22286	;
	22287	"RTN","HMP DSR",21,0)
	22288	; get one surgery
	22289	"RTN","HMP DSR",22,0)
	22290	I $G(ID) D EN1(ID,. HMPITM),XM L(.HMPITM) G ENQ
	22291	"RTN","HMP DSR",23,0)
	22292	;
	22293	"RTN","HMP DSR",24,0)
	22294	; get all surgeries
	22295	"RTN","HMP DSR",25,0)
	22296	Q:'$L($T( LIST^SROES TV))
	22297	"RTN","HMP DSR",26,0)
	22298	N SHOWADD S SHOWADD =1 ;to omi t leading '+' with n ote titles
	22299	"RTN","HMP DSR",27,0)
	22300	D LIST^SR OESTV(.HMP Y,DFN,BEG, END,MAX,1)
	22301	"RTN","HMP DSR",28,0)
	22302	S HMPN=0 F S HMPN= $O(@HMPY@( HMPN)) Q:H MPN<1 D
	22303	"RTN","HMP DSR",29,0)
	22304	. K HMPIT M D ONE(HM PN,.HMPITM )
	22305	"RTN","HMP DSR",30,0)
	22306	. I $D(HM PITM) D XM L(.HMPITM)
	22307	"RTN","HMP DSR",31,0)
	22308	K @HMPY
	22309	"RTN","HMP DSR",32,0)
	22310	ENQ ; end
	22311	"RTN","HMP DSR",33,0)
	22312	K ^TMP("H MPTEXT",$J )
	22313	"RTN","HMP DSR",34,0)
	22314	Q
	22315	"RTN","HMP DSR",35,0)
	22316	;
	22317	"RTN","HMP DSR",36,0)
	22318	ONE(NUM,SU RG) ; -- r eturn a su rgery in S URG("attri bute")=val ue
	22319	"RTN","HMP DSR",37,0)
	22320	; Expect s DFN, @HM PY@(NUM) f rom LIST^S ROESTV
	22321	"RTN","HMP DSR",38,0)
	22322	N IEN,HMP X,X,Y,I,HM PMOD,HMPOT H
	22323	"RTN","HMP DSR",39,0)
	22324	K SURG,^T MP("HMPTEX T",$J)
	22325	"RTN","HMP DSR",40,0)
	22326	S HMPX=$G (@HMPY@(NU M)),IEN=+$ P(HMPX,U) Q:IEN<1
	22327	"RTN","HMP DSR",41,0)
	22328	S SURG("i d")=IEN,X= $P(HMPX,U, 2),SURG("s tatus")="C OMPLETED"
	22329	"RTN","HMP DSR",42,0)
	22330	I X?1"* A borted * " .E S X=$E( X,13,999), SURG("stat us")="ABOR TED"
	22331	"RTN","HMP DSR",43,0)
	22332	S SURG("n ame")=X,SU RG("dateTi me")=$P(HM PX,U,3)
	22333	"RTN","HMP DSR",44,0)
	22334	S X=$P(HM PX,U,4) S: X SURG("pr ovider")=$ TR(X,";"," ^")
	22335	"RTN","HMP DSR",45,0)
	22336	S X=$$GET 1^DIQ(130, IEN_",",50 ,"I"),SURG ("facility ")=$$FAC^H MPD(X)
	22337	"RTN","HMP DSR",46,0)
	22338	S SURG("e ncounter") =$$GET1^DI Q(130,IEN_ ",",.015," I")
	22339	"RTN","HMP DSR",47,0)
	22340	S X=$$GET 1^DIQ(136, IEN_",",.0 2,"I") I X D
	22341	"RTN","HMP DSR",48,0)
	22342	. S SURG( "type")=$$ CPT(X)
	22343	"RTN","HMP DSR",49,0)
	22344	. D GETS^ DIQ(136,IE N_",","1*" ,"I","HMPM OD") ;CPT modifiers
	22345	"RTN","HMP DSR",50,0)
	22346	. S I="" F S I=$O( HMPMOD(136 .01,I)) Q: I="" D
	22347	"RTN","HMP DSR",51,0)
	22348	.. S X=+$ G(HMPMOD(1 36.01,I,.0 1,"I")),Y= $$MOD^ICPT MOD(X,"I")
	22349	"RTN","HMP DSR",52,0)
	22350	.. S SURG ("modifier ",+I)=$P(Y ,U,2,3)
	22351	"RTN","HMP DSR",53,0)
	22352	D GETS^DI Q(136,IEN_ ",","3*"," I","HMPOTH ") ;other procedures
	22353	"RTN","HMP DSR",54,0)
	22354	S I="" F S I=$O(HM POTH(136.0 3,I)) Q:I= "" D
	22355	"RTN","HMP DSR",55,0)
	22356	. S X=+$G (HMPOTH(13 6.03,I,.01 ,"I")) Q:' X
	22357	"RTN","HMP DSR",56,0)
	22358	. S SURG( "otherProc edure",+I) =$$CPT(X)
	22359	"RTN","HMP DSR",57,0)
	22360	S I=0 F S I=$O(@HM PY@(NUM,I) ) Q:I<1 S X=$G(@HMP Y@(NUM,I)) I X D
	22361	"RTN","HMP DSR",58,0)
	22362	. N LT,NT S LT=$P(X ,U,2) Q:$P (LT," ")=" Addendum"
	22363	"RTN","HMP DSR",59,0)
	22364	. S NT=$$ GET1^DIQ(8 925,+X_"," ,".01:1501 ")
	22365	"RTN","HMP DSR",60,0)
	22366	. S SURG( "document" ,I)=+X_U_L T_U_NT
	22367	"RTN","HMP DSR",61,0)
	22368	. S:$G(HM PTEXT) SUR G("documen t",I,"cont ent")=$$TE XT^HMPDTIU (+X)
	22369	"RTN","HMP DSR",62,0)
	22370	. I LT["O PERATION R EPORT"!(LT ["PROCEDUR E REPORT") S SURG("o pReport")= +X_U_LT_U_ NT
	22371	"RTN","HMP DSR",63,0)
	22372	S SURG("c ategory")= "SR"
	22373	"RTN","HMP DSR",64,0)
	22374	Q
	22375	"RTN","HMP DSR",65,0)
	22376	;
	22377	"RTN","HMP DSR",66,0)
	22378	EN1(IEN,SU RG) ; -- r eturn a su rgery in S URG("attri bute")=val ue
	22379	"RTN","HMP DSR",67,0)
	22380	N HMPX,HM PY,X,Y,I,H MPMOD,HMPO TH,SHOWADD
	22381	"RTN","HMP DSR",68,0)
	22382	K SURG,^T MP("HMPTEX T",$J)
	22383	"RTN","HMP DSR",69,0)
	22384	S SHOWADD =1 ;to omi t leading '+' with n ote titles
	22385	"RTN","HMP DSR",70,0)
	22386	D ONE^SRO ESTV("HMPY ",IEN) S H MPX=$G(HMP Y(IEN)) Q: HMPX=""
	22387	"RTN","HMP DSR",71,0)
	22388	S SURG("i d")=IEN,X= $P(HMPX,U, 2),SURG("s tatus")="C OMPLETED"
	22389	"RTN","HMP DSR",72,0)
	22390	I X?1"* A borted * " .E S X=$E( X,13,999), SURG("stat us")="ABOR TED"
	22391	"RTN","HMP DSR",73,0)
	22392	S SURG("n ame")=X,SU RG("dateTi me")=$P(HM PX,U,3)
	22393	"RTN","HMP DSR",74,0)
	22394	S X=$P(HM PX,U,4) S: X SURG("pr ovider")=$ TR(X,";"," ^")
	22395	"RTN","HMP DSR",75,0)
	22396	S X=$$GET 1^DIQ(130, IEN_",",50 ,"I"),SURG ("facility ")=$$FAC^H MPD(X)
	22397	"RTN","HMP DSR",76,0)
	22398	S SURG("e ncounter") =$$GET1^DI Q(130,IEN_ ",",.015," I")
	22399	"RTN","HMP DSR",77,0)
	22400	S X=$$GET 1^DIQ(136, IEN_",",.0 2,"I") I X D
	22401	"RTN","HMP DSR",78,0)
	22402	. S SURG( "type")=$$ CPT(X)
	22403	"RTN","HMP DSR",79,0)
	22404	. D GETS^ DIQ(136,IE N_",","1*" ,"I","HMPM OD") ;CPT modifiers
	22405	"RTN","HMP DSR",80,0)
	22406	. S I="" F S I=$O( HMPMOD(136 .01,I)) Q: I="" D
	22407	"RTN","HMP DSR",81,0)
	22408	.. S X=+$ G(HMPMOD(1 36.01,I,.0 1,"I")),Y= $$MOD^ICPT MOD(X,"I")
	22409	"RTN","HMP DSR",82,0)
	22410	.. S SURG ("modifier ",+I)=$P(Y ,U,2,3)
	22411	"RTN","HMP DSR",83,0)
	22412	D GETS^DI Q(136,IEN_ ",","3*"," I","HMPOTH ") ;other procedures
	22413	"RTN","HMP DSR",84,0)
	22414	S I="" F S I=$O(HM POTH(136.0 3,I)) Q:I= "" D
	22415	"RTN","HMP DSR",85,0)
	22416	. S X=+$G (HMPOTH(13 6.03,I,.01 ,"I")) Q:' X
	22417	"RTN","HMP DSR",86,0)
	22418	. S SURG( "otherProc edure",+I) =$$CPT(X)
	22419	"RTN","HMP DSR",87,0)
	22420	S I=0 F S I=$O(HMP Y(IEN,I)) Q:I<1 S X =$G(HMPY(I EN,I)) I X D
	22421	"RTN","HMP DSR",88,0)
	22422	. N LT,NT S LT=$P(X ,U,2) Q:$P (LT," ")=" Addendum"
	22423	"RTN","HMP DSR",89,0)
	22424	. S NT=$$ GET1^DIQ(8 925,+X_"," ,".01:1501 ")
	22425	"RTN","HMP DSR",90,0)
	22426	. S SURG( "document" ,I)=+X_U_L T_U_NT
	22427	"RTN","HMP DSR",91,0)
	22428	. S:$G(HM PTEXT) SUR G("documen t",I,"cont ent")=$$TE XT^HMPDTIU (+X)
	22429	"RTN","HMP DSR",92,0)
	22430	. I LT["O PERATION R EPORT"!(LT ["PROCEDUR E REPORT") S SURG("o pReport")= +X_U_LT_U_ NT
	22431	"RTN","HMP DSR",93,0)
	22432	S SURG("c ategory")= "SR"
	22433	"RTN","HMP DSR",94,0)
	22434	Q
	22435	"RTN","HMP DSR",95,0)
	22436	;
	22437	"RTN","HMP DSR",96,0)
	22438	CPT(IEN) ; -- return code^desc ription fo r CPT code , or "^" i f error
	22439	"RTN","HMP DSR",97,0)
	22440	N X0,HMPX ,N,I,X,Y S IEN=+$G(I EN)
	22441	"RTN","HMP DSR",98,0)
	22442	S X0=$$CP T^ICPTCOD( IEN) I X0< 0 Q "^"
	22443	"RTN","HMP DSR",99,0)
	22444	S Y=$P(X0 ,U,2,3) ;CPT Code^Short Name
	22445	"RTN","HMP DSR",100,0 )
	22446	S N=$$CPT D^ICPTCOD( $P(Y,U),"H MPX") ;CPT Descripti on
	22447	"RTN","HMP DSR",101,0 )
	22448	I N>0,$L( $G(HMPX(1) )) D
	22449	"RTN","HMP DSR",102,0 )
	22450	. S X=$G( HMPX(1)),I =1
	22451	"RTN","HMP DSR",103,0 )
	22452	. F S I= $O(HMPX(I) ) Q:I<1 Q :HMPX(I)=" " S X=X_ " "_HMPX(I )
	22453	"RTN","HMP DSR",104,0 )
	22454	. S $P(Y, U,2)=X
	22455	"RTN","HMP DSR",105,0 )
	22456	Q Y
	22457	"RTN","HMP DSR",106,0 )
	22458	;
	22459	"RTN","HMP DSR",107,0 )
	22460	; ------- ----- Retu rn data to middle ti er ------- -----
	22461	"RTN","HMP DSR",108,0 )
	22462	;
	22463	"RTN","HMP DSR",109,0 )
	22464	XML(SURG) ; -- Retur n surgery as XML
	22465	"RTN","HMP DSR",110,0 )
	22466	N ATT,X,Y ,NAMES,I,J
	22467	"RTN","HMP DSR",111,0 )
	22468	D ADD("<s urgery>") S HMPTOTL= $G(HMPTOTL )+1
	22469	"RTN","HMP DSR",112,0 )
	22470	S ATT="" F S ATT=$ O(SURG(ATT )) Q:ATT=" " D D:$L (Y) ADD(Y)
	22471	"RTN","HMP DSR",113,0 )
	22472	. I $O(SU RG(ATT,0)) D S Y="" Q ;multi ples
	22473	"RTN","HMP DSR",114,0 )
	22474	.. D ADD( "<"_ATT_"s >")
	22475	"RTN","HMP DSR",115,0 )
	22476	.. S I=0 F S I=$O( SURG(ATT,I )) Q:I<1 D
	22477	"RTN","HMP DSR",116,0 )
	22478	... S X=$ G(SURG(ATT ,I)),NAMES =""
	22479	"RTN","HMP DSR",117,0 )
	22480	... S NAM ES=$S(ATT= "document" :"id^local Title^nati onalTitle^ Z",1:"code ^name^Z")
	22481	"RTN","HMP DSR",118,0 )
	22482	... S Y=" <"_ATT_" " _$$LOOP ;_ "/>" D ADD (Y)
	22483	"RTN","HMP DSR",119,0 )
	22484	... S X=$ G(SURG(ATT ,I,"conten t")) I '$L (X) S Y=Y_ "/>" D ADD (Y) Q
	22485	"RTN","HMP DSR",120,0 )
	22486	... S Y=Y _">" D ADD (Y)
	22487	"RTN","HMP DSR",121,0 )
	22488	... S Y=" <content x ml:space=' preserve'> " D ADD(Y)
	22489	"RTN","HMP DSR",122,0 )
	22490	... S J=0 F S J=$O (@X@(J)) Q :J<1 S Y= $$ESC^HMPD (@X@(J)) D ADD(Y)
	22491	"RTN","HMP DSR",123,0 )
	22492	... D ADD ("</conten t>"),ADD(" </"_ATT_"> ")
	22493	"RTN","HMP DSR",124,0 )
	22494	.. D ADD( "</"_ATT_" s>")
	22495	"RTN","HMP DSR",125,0 )
	22496	. S X=$G( SURG(ATT)) ,Y="" Q:'$ L(X)
	22497	"RTN","HMP DSR",126,0 )
	22498	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	22499	"RTN","HMP DSR",127,0 )
	22500	. S NAMES =$S(ATT="o pReport":" id^localTi tle^nation alTitle^Z" ,1:"code^n ame^Z")
	22501	"RTN","HMP DSR",128,0 )
	22502	. I $L(X) >1 S Y="<" _ATT_" "_$ $LOOP_"/>"
	22503	"RTN","HMP DSR",129,0 )
	22504	D ADD("</ surgery>")
	22505	"RTN","HMP DSR",130,0 )
	22506	Q
	22507	"RTN","HMP DSR",131,0 )
	22508	;
	22509	"RTN","HMP DSR",132,0 )
	22510	LOOP() ; - - build su b-items st ring from NAMES and X
	22511	"RTN","HMP DSR",133,0 )
	22512	N STR,P,T AG S STR=" "
	22513	"RTN","HMP DSR",134,0 )
	22514	F P=1:1 S TAG=$P(NA MES,U,P) Q :TAG="Z" I $L($P(X, U,P)) S ST R=STR_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	22515	"RTN","HMP DSR",135,0 )
	22516	Q STR
	22517	"RTN","HMP DSR",136,0 )
	22518	;
	22519	"RTN","HMP DSR",137,0 )
	22520	ADD(X) ; - - Add a li ne @HMP@(n )=X
	22521	"RTN","HMP DSR",138,0 )
	22522	S HMPI=$G (HMPI)+1
	22523	"RTN","HMP DSR",139,0 )
	22524	S @HMP@(H MPI)=X
	22525	"RTN","HMP DSR",140,0 )
	22526	Q
	22527	"RTN","HMP DTIU")
	22528	0^76^B8385 9727
	22529	"RTN","HMP DTIU",1,0)
	22530	HMPDTIU ;S LC/MKB,ASM R/RRB - TI U extract; Nov 23, 20 15 18:02:2 0
	22531	"RTN","HMP DTIU",2,0)
	22532	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	22533	"RTN","HMP DTIU",3,0)
	22534	;Per VA D irective 6 402, this routine sh ould not b e modified .
	22535	"RTN","HMP DTIU",4,0)
	22536	;
	22537	"RTN","HMP DTIU",5,0)
	22538	; Externa l Referenc es DBIA#
	22539	"RTN","HMP DTIU",6,0)
	22540	; ------- ---------- -- -----
	22541	"RTN","HMP DTIU",7,0)
	22542	; ^SC( 10040
	22543	"RTN","HMP DTIU",8,0)
	22544	; ^TIU(89 25.1 23 21,5677
	22545	"RTN","HMP DTIU",9,0)
	22546	; ^TIU(89 26.1 5678
	22547	"RTN","HMP DTIU",10,0 )
	22548	; ^VA(200 10060
	22549	"RTN","HMP DTIU",11,0 )
	22550	; DIQ 2056
	22551	"RTN","HMP DTIU",12,0 )
	22552	; RAO7PC1 2043
	22553	"RTN","HMP DTIU",13,0 )
	22554	; TIUCNSL T 5546
	22555	"RTN","HMP DTIU",14,0 )
	22556	; TIUCP 3568
	22557	"RTN","HMP DTIU",15,0 )
	22558	; TIULQ 2693
	22559	"RTN","HMP DTIU",16,0 )
	22560	; TIULX 3058
	22561	"RTN","HMP DTIU",17,0 )
	22562	; TIUSROI 5676
	22563	"RTN","HMP DTIU",18,0 )
	22564	; TIUSRVL O 28 34,2865
	22565	"RTN","HMP DTIU",19,0 )
	22566	; TIUSRVR 1 2944
	22567	"RTN","HMP DTIU",20,0 )
	22568	; XLFSTR 10104
	22569	"RTN","HMP DTIU",21,0 )
	22570	Q
	22571	"RTN","HMP DTIU",22,0 )
	22572	; ------- ----- Get documents from VistA --------- ---
	22573	"RTN","HMP DTIU",23,0 )
	22574	;
	22575	"RTN","HMP DTIU",24,0 )
	22576	EN(DFN,BEG ,END,MAX,I D) ; -- fi nd patient 's documen ts
	22577	"RTN","HMP DTIU",25,0 )
	22578	N HMPITM, HMPN,HMPX, HMPY,HMPCN T
	22579	"RTN","HMP DTIU",26,0 )
	22580	S DFN=+$G (DFN) Q:$G (DFN)<1
	22581	"RTN","HMP DTIU",27,0 )
	22582	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	22583	"RTN","HMP DTIU",28,0 )
	22584	;
	22585	"RTN","HMP DTIU",29,0 )
	22586	; get one document
	22587	"RTN","HMP DTIU",30,0 )
	22588	I $L($G(I D)),ID[";" D G ENQ
	22589	"RTN","HMP DTIU",31,0 )
	22590	. I ID D RPT1^HMPDM C(DFN,ID,. HMPITM),XM L(.HMPITM) Q ;CP
	22591	"RTN","HMP DTIU",32,0 )
	22592	. D RPT1^ HMPDLRA(DF N,ID,.HMPI TM),XML(.H MPITM) Q ;Lab
	22593	"RTN","HMP DTIU",33,0 )
	22594	I $G(ID), ID["-" D G ENQ ;Radio logy
	22595	"RTN","HMP DTIU",34,0 )
	22596	. S (BEG, END)=99999 99.9999-+I D D EN1^RA O7PC1(DFN, BEG,END,"9 9P")
	22597	"RTN","HMP DTIU",35,0 )
	22598	. D RPT1^ HMPDRA(DFN ,ID,.HMPIT M),XML(.HM PITM)
	22599	"RTN","HMP DTIU",36,0 )
	22600	. K ^TMP( $J,"RAE1")
	22601	"RTN","HMP DTIU",37,0 )
	22602	I $G(ID) D EN1(ID,. HMPITM),XM L(.HMPITM) :$D(HMPITM ) G ENQ
	22603	"RTN","HMP DTIU",38,0 )
	22604	;
	22605	"RTN","HMP DTIU",39,0 )
	22606	; get all documents
	22607	"RTN","HMP DTIU",40,0 )
	22608	N CLASS,S UBCLASS,TI TLE,SERVIC E,SUBJECT, NOTSUBJ,ST ATUS,HMPC, CLS,HMPS,C TXT
	22609	"RTN","HMP DTIU",41,0 )
	22610	D SETUP S HMPCNT=0 ;define se arch crite ria
	22611	"RTN","HMP DTIU",42,0 )
	22612	I CLASS=" CP" D RPTS ^HMPDMC(DF N,BEG,END, MAX) Q
	22613	"RTN","HMP DTIU",43,0 )
	22614	I CLASS=" RA" D RPTS ^HMPDRA(DF N,BEG,END, MAX) Q
	22615	"RTN","HMP DTIU",44,0 )
	22616	I CLASS=" LR" D RPTS ^HMPDLRA(D FN,BEG,END ,MAX) Q
	22617	"RTN","HMP DTIU",45,0 )
	22618	F HMPC=1: 1:$L(CLASS ,U) S CLS= $P(CLASS,U ,HMPC) D Q:HMPCNT'< MAX
	22619	"RTN","HMP DTIU",46,0 )
	22620	. F HMPS= 1:1:$L(STA TUS,U) S C TXT=$P(STA TUS,U,HMPS ) D Q:HMP CNT'<MAX
	22621	"RTN","HMP DTIU",47,0 )
	22622	.. D CONT EXT^TIUSRV LO(.HMPY,C LS,CTXT,DF N,BEG,END, ,MAX,,1)
	22623	"RTN","HMP DTIU",48,0 )
	22624	.. S HMPN =0 F S HM PN=$O(@HMP Y@(HMPN)) Q:HMPN<1 D Q:HMPCN T'<MAX
	22625	"RTN","HMP DTIU",49,0 )
	22626	... S HMP X=$G(@HMPY @(HMPN)) Q :'$$MATCH( HMPX,$G(SU BCLASS),$G (SERVICE), $G(SUBJECT ),$G(NOTSU BJ))
	22627	"RTN","HMP DTIU",50,0 )
	22628	... Q:$D( ^TMP("HMPD ",$J,+HMPX )) ;alrea dy include d
	22629	"RTN","HMP DTIU",51,0 )
	22630	... K HMP ITM D EN1( HMPX,.HMPI TM) Q:'$D( HMPITM)
	22631	"RTN","HMP DTIU",52,0 )
	22632	... D XML (.HMPITM) S HMPCNT=H MPCNT+1
	22633	"RTN","HMP DTIU",53,0 )
	22634	.. K @HMP Y
	22635	"RTN","HMP DTIU",54,0 )
	22636	ENQ ; end
	22637	"RTN","HMP DTIU",55,0 )
	22638	K ^TMP("H MPTEXT",$J )
	22639	"RTN","HMP DTIU",56,0 )
	22640	Q
	22641	"RTN","HMP DTIU",57,0 )
	22642	;
	22643	"RTN","HMP DTIU",58,0 )
	22644	EN1(HMPX,D OC) ; -- r eturn a do cument in DOC("attri bute")=val ue
	22645	"RTN","HMP DTIU",59,0 )
	22646	; Expect s DFN, HMP X=IEN^$$RE SOLVE^TIUS RVLO(IEN)
	22647	"RTN","HMP DTIU",60,0 )
	22648	N IEN,X,N AME,HMPTIU ,ES,I,HMPY
	22649	"RTN","HMP DTIU",61,0 )
	22650	K DOC,^TM P("HMPTEXT ",$J)
	22651	"RTN","HMP DTIU",62,0 )
	22652	S IEN=+$G (HMPX) Q:I EN<1 ;inv alid ien
	22653	"RTN","HMP DTIU",63,0 )
	22654	I +HMPX=H MPX D ;ge t data str ing, if ne eded
	22655	"RTN","HMP DTIU",64,0 )
	22656	. N SHOWA DD,DA S SH OWADD=1,DA =+HMPX
	22657	"RTN","HMP DTIU",65,0 )
	22658	. S HMPX= DA_U_$$RES OLVE^TIUSR VLO(DA)
	22659	"RTN","HMP DTIU",66,0 )
	22660	Q:"UNKNOW N"[$P($G(H MPX),U,2) ;null or invalid
	22661	"RTN","HMP DTIU",67,0 )
	22662	S NAME=$P (HMPX,U,2) ;I $P(HMP X,U,14),$P (NAME," ") ="Addendum " Q
	22663	"RTN","HMP DTIU",68,0 )
	22664	S DOC("id ")=IEN,DOC ("localTit le")=NAME
	22665	"RTN","HMP DTIU",69,0 )
	22666	D EXTRACT ^TIULQ(IEN ,"HMPTIU", ,".01:.04; 1501:1508" )
	22667	"RTN","HMP DTIU",70,0 )
	22668	S X=$$GET 1^DIQ(8925 ,IEN_","," .01:1501", "I") I X D
	22669	"RTN","HMP DTIU",71,0 )
	22670	. N IENS, TIU,Y,FNUM
	22671	"RTN","HMP DTIU",72,0 )
	22672	. S IENS= X_"," D GE TS^DIQ(892 6.1,IENS," *","IE","T IU")
	22673	"RTN","HMP DTIU",73,0 )
	22674	. S DOC(" nationalTi tle")=$G(T IU(8926.1, IENS,99.99 ,"E"))_U_$ G(TIU(8926 .1,IENS,.0 1,"E"))
	22675	"RTN","HMP DTIU",74,0 )
	22676	. F I=".0 4^Subject^ 2",".05^Ro le^3",".06 ^Setting^4 ",".07^Ser vice^5",". 08^Type^6" D
	22677	"RTN","HMP DTIU",75,0 )
	22678	.. S Y=+$ G(TIU(8926 .1,IENS,+I ,"I")) Q:Y '>0
	22679	"RTN","HMP DTIU",76,0 )
	22680	.. S FNUM ="8926."_+ $P(I,U,3)
	22681	"RTN","HMP DTIU",77,0 )
	22682	.. S DOC( "nationalT itle"_$P(I ,U,2))=$$V UID^HMPD(Y ,FNUM)_U_$ G(TIU(8926 .1,IENS,+I ,"E"))
	22683	"RTN","HMP DTIU",78,0 )
	22684	S:$G(FILT ER("loinc" )) DOC("lo inc")=$P(F ILTER("loi nc"),U)
	22685	"RTN","HMP DTIU",79,0 )
	22686	S X=+$G(H MPTIU(IEN, .01,"I")), X=$$CATG(X ),(DOC("ty pe"),DOC(" category") )=X
	22687	"RTN","HMP DTIU",80,0 )
	22688	S DOC("do cumentClas s")=$S(X=" LR":"LR LA BORATORY R EPORTS",X= "SR":"SURG ICAL REPOR TS",X="CP" :"CLINICAL PROCEDURE S",X="DS": "DISCHARGE SUMMARY", 1:"PROGRES S NOTES")
	22689	"RTN","HMP DTIU",81,0 )
	22690	S DOC("re ferenceDat eTime")=$P (HMPX,U,3)
	22691	"RTN","HMP DTIU",82,0 )
	22692	S X=$P(HM PX,U,6) D ;S:$L(X) DOC("locat ion")=X
	22693	"RTN","HMP DTIU",83,0 )
	22694	. ; DE281 8, ICR 100 40 for ^SC , this doe sn't handl e duplicat e entries and should be correc ted
	22695	"RTN","HMP DTIU",84,0 )
	22696	. N LOC S LOC=$S($L (X):+$O(^S C("B",X,0) ),1:0)
	22697	"RTN","HMP DTIU",85,0 )
	22698	. S DOC(" facility") =$$FAC^HMP D(LOC)
	22699	"RTN","HMP DTIU",86,0 )
	22700	S X=$P(HM PX,U,7) S: $L(X) DOC( "status")= X
	22701	"RTN","HMP DTIU",87,0 )
	22702	S:$P(HMPX ,U,11) DOC ("images") =+$P(HMPX, U,11)
	22703	"RTN","HMP DTIU",88,0 )
	22704	S:$L($P(H MPX,U,12)) DOC("subj ect")=$P(H MPX,U,12)
	22705	"RTN","HMP DTIU",89,0 )
	22706	; X=$S($P (HMPX,U,13 )[">":"C", $P(HMPX,U, 13)["<":"I ",1:"") ;c omponentTy pe
	22707	"RTN","HMP DTIU",90,0 )
	22708	I $P(HMPX ,U,14)>5 S DOC("pare nt")=$P(HM PX,U,14) ; ID notes
	22709	"RTN","HMP DTIU",91,0 )
	22710	S DOC("en counter")= $G(HMPTIU( IEN,.03,"I "))
	22711	"RTN","HMP DTIU",92,0 )
	22712	S:$G(HMPT EXT) DOC(" content")= $$TEXT(IEN )
	22713	"RTN","HMP DTIU",93,0 )
	22714	; provide rs &/or si gnatures
	22715	"RTN","HMP DTIU",94,0 )
	22716	S X=$P(HM PX,U,5),I= 0 S:X I=I+ 1,DOC("cli nician",I) =+X_U_$P(X ,";",3)_"^ A" ;author
	22717	"RTN","HMP DTIU",95,0 )
	22718	M ES=HMPT IU(IEN) I ES(1501,"I ") D
	22719	"RTN","HMP DTIU",96,0 )
	22720	. S I=I+1
	22721	"RTN","HMP DTIU",97,0 )
	22722	. S DOC(" clinician" ,I)=ES(150 2,"I")_U_E S(1502,"E" )_"^S^"_ES (1501,"I") _U_$$SIG(E S(1502,"I" ))
	22723	"RTN","HMP DTIU",98,0 )
	22724	I ES(1507 ,"I") D ; cosigner
	22725	"RTN","HMP DTIU",99,0 )
	22726	. S I=I+1
	22727	"RTN","HMP DTIU",100, 0)
	22728	. S DOC(" clinician" ,I)=ES(150 8,"I")_U_E S(1508,"E" )_"^C^"_ES (1507,"I") _U_$$SIG(E S(1508,"I" ))
	22729	"RTN","HMP DTIU",101, 0)
	22730	Q
	22731	"RTN","HMP DTIU",102, 0)
	22732	;
	22733	"RTN","HMP DTIU",103, 0)
	22734	CATG(DA) ; -- Return a code fo r document type #892 5.1 DA
	22735	"RTN","HMP DTIU",104, 0)
	22736	N X
	22737	"RTN","HMP DTIU",105, 0)
	22738	D ISCNSLT ^TIUCNSLT( .X,DA) I X Q "CR" ; consult re sult
	22739	"RTN","HMP DTIU",106, 0)
	22740	I $$ISA^T IULX(DA,25 ) Q "A" ; CWAD note/ Allergy
	22741	"RTN","HMP DTIU",107, 0)
	22742	I $$ISA^T IULX(DA,27 ) Q "D" ; CWAD note/ Advance Di rective
	22743	"RTN","HMP DTIU",108, 0)
	22744	I $$ISA^T IULX(DA,30 ) Q "C" ; CWAD note/ Crisis Not e
	22745	"RTN","HMP DTIU",109, 0)
	22746	I $$ISA^T IULX(DA,31 ) Q "W" ; CWAD note/ Clinical W arning
	22747	"RTN","HMP DTIU",110, 0)
	22748	I $$ISA^T IULX(DA,3) Q "PN" ; progress n ote
	22749	"RTN","HMP DTIU",111, 0)
	22750	;
	22751	"RTN","HMP DTIU",112, 0)
	22752	I $$ISA^T IULX(DA,24 4) Q "DS" ; discharge summary
	22753	"RTN","HMP DTIU",113, 0)
	22754	D ISCP^TI UCP(.X,DA) I X Q "CP " ; clinical p rocedure
	22755	"RTN","HMP DTIU",114, 0)
	22756	D ISSURG^ TIUSROI(.X ,DA) I X Q "SR" ; surgery
	22757	"RTN","HMP DTIU",115, 0)
	22758	I $$ISA^T IULX(DA,$$ LR) Q "LR" ; laboratory
	22759	"RTN","HMP DTIU",116, 0)
	22760	Q ""
	22761	"RTN","HMP DTIU",117, 0)
	22762	;
	22763	"RTN","HMP DTIU",118, 0)
	22764	LR() ; -- Return ien of Lab cl ass
	22765	"RTN","HMP DTIU",119, 0)
	22766	N Y S Y=+ $O(^TIU(89 25.1,"B"," LR LABORAT ORY REPORT S",0)) ;D E2818, ICR s 2700 and 5677
	22767	"RTN","HMP DTIU",120, 0)
	22768	I Y>0,$S( $P($G(^TIU (8925.1,Y, 0)),U,4)=" CL":0,$P($ G(^(0)),U, 4)="DC":0, 1:1) S Y=0
	22769	"RTN","HMP DTIU",121, 0)
	22770	Q Y
	22771	"RTN","HMP DTIU",122, 0)
	22772	;
	22773	"RTN","HMP DTIU",123, 0)
	22774	SIG(X) ; - - Return S ignature B lock Name_ Title
	22775	"RTN","HMP DTIU",124, 0)
	22776	N X20,Y S X20=$G(^V A(200,+$G( X),20))
	22777	"RTN","HMP DTIU",125, 0)
	22778	S Y=$P(X2 0,U,2)_" " _$P(X20,U, 3)
	22779	"RTN","HMP DTIU",126, 0)
	22780	Q Y
	22781	"RTN","HMP DTIU",127, 0)
	22782	;
	22783	"RTN","HMP DTIU",128, 0)
	22784	RPT(HMPY,I FN) ; -- R eturn text of docume nt in @HMP Y@(n)
	22785	"RTN","HMP DTIU",129, 0)
	22786	N I,J ;pr otect for calling lo ops
	22787	"RTN","HMP DTIU",130, 0)
	22788	D TGET^TI USRVR1(.HM PY,IFN)
	22789	"RTN","HMP DTIU",131, 0)
	22790	Q
	22791	"RTN","HMP DTIU",132, 0)
	22792	;
	22793	"RTN","HMP DTIU",133, 0)
	22794	TEXT(IFN) ; -- Get d ocument IF N text, re turn temp array name
	22795	"RTN","HMP DTIU",134, 0)
	22796	N HMPY,Y, I,J ;prote ct I&J for calling l oops
	22797	"RTN","HMP DTIU",135, 0)
	22798	S IFN=+$G (IFN) D TG ET^TIUSRVR 1(.HMPY,IF N)
	22799	"RTN","HMP DTIU",136, 0)
	22800	M ^TMP("H MPTEXT",$J ,IFN)=@HMP Y K @HMPY
	22801	"RTN","HMP DTIU",137, 0)
	22802	S Y=$NA(^ TMP("HMPTE XT",$J,IFN ))
	22803	"RTN","HMP DTIU",138, 0)
	22804	Q Y
	22805	"RTN","HMP DTIU",139, 0)
	22806	;
	22807	"RTN","HMP DTIU",140, 0)
	22808	; ------- ----- Retu rn data to middle ti er ------- -----
	22809	"RTN","HMP DTIU",141, 0)
	22810	;
	22811	"RTN","HMP DTIU",142, 0)
	22812	XML(DOC) ; -- Return patient d ocuments a s XML
	22813	"RTN","HMP DTIU",143, 0)
	22814	N ATT,X,Y ,NAMES,TYP E,I
	22815	"RTN","HMP DTIU",144, 0)
	22816	D ADD("<d ocument>") S HMPTOTL =$G(HMPTOT L)+1
	22817	"RTN","HMP DTIU",145, 0)
	22818	S ATT="" F S ATT=$ O(DOC(ATT) ) Q:ATT="" D D:$L( Y) ADD(Y)
	22819	"RTN","HMP DTIU",146, 0)
	22820	. I $O(DO C(ATT,0)) D S Y="" Q ;multip les
	22821	"RTN","HMP DTIU",147, 0)
	22822	.. D ADD( "<"_ATT_"s >")
	22823	"RTN","HMP DTIU",148, 0)
	22824	.. S I=0 F S I=$O( DOC(ATT,I) ) Q:I<1 D
	22825	"RTN","HMP DTIU",149, 0)
	22826	... S X=$ G(DOC(ATT, I)),NAMES= ""
	22827	"RTN","HMP DTIU",150, 0)
	22828	... I ATT ="clinicia n" S NAMES ="code^nam e^role^dat eTime^sign ature^Z"
	22829	"RTN","HMP DTIU",151, 0)
	22830	... S Y=" <"_ATT_" " _$$LOOP_"/ >" D ADD(Y )
	22831	"RTN","HMP DTIU",152, 0)
	22832	.. D ADD( "</"_ATT_" s>")
	22833	"RTN","HMP DTIU",153, 0)
	22834	. S X=$G( DOC(ATT)), Y="" Q:'$L (X)
	22835	"RTN","HMP DTIU",154, 0)
	22836	. I ATT=" content" D S Y="" Q ;text
	22837	"RTN","HMP DTIU",155, 0)
	22838	.. S Y="< content xm l:space='p reserve'>" D ADD(Y)
	22839	"RTN","HMP DTIU",156, 0)
	22840	.. S I=0 F S I=$O( @X@(I)) Q: I<1 S Y=$ $ESC^HMPD( @X@(I)) D ADD(Y)
	22841	"RTN","HMP DTIU",157, 0)
	22842	.. D ADD( "</content >")
	22843	"RTN","HMP DTIU",158, 0)
	22844	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	22845	"RTN","HMP DTIU",159, 0)
	22846	. I $L(X) >1 S NAMES ="code^nam e^Z",Y="<" _ATT_" "_$ $LOOP_"/>"
	22847	"RTN","HMP DTIU",160, 0)
	22848	D ADD("</ document>" )
	22849	"RTN","HMP DTIU",161, 0)
	22850	Q
	22851	"RTN","HMP DTIU",162, 0)
	22852	;
	22853	"RTN","HMP DTIU",163, 0)
	22854	LOOP() ; - - build su b-items st ring from NAMES and X
	22855	"RTN","HMP DTIU",164, 0)
	22856	N STR,P,T AG S STR=" "
	22857	"RTN","HMP DTIU",165, 0)
	22858	F P=1:1 S TAG=$P(NA MES,U,P) Q :TAG="Z" I $L($P(X, U,P)) S ST R=STR_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	22859	"RTN","HMP DTIU",166, 0)
	22860	Q STR
	22861	"RTN","HMP DTIU",167, 0)
	22862	;
	22863	"RTN","HMP DTIU",168, 0)
	22864	ADD(X) ; A dd a line @HMP@(n)=X
	22865	"RTN","HMP DTIU",169, 0)
	22866	S HMPI=$G (HMPI)+1
	22867	"RTN","HMP DTIU",170, 0)
	22868	S @HMP@(H MPI)=X
	22869	"RTN","HMP DTIU",171, 0)
	22870	Q
	22871	"RTN","HMP DTIU",172, 0)
	22872	;
	22873	"RTN","HMP DTIU",173, 0)
	22874	; ------- ----- Get/ apply sear ch criteri a -------- ----
	22875	"RTN","HMP DTIU",174, 0)
	22876	;
	22877	"RTN","HMP DTIU",175, 0)
	22878	SETUP ; -- convert F ILTER("att ribute") = value to TIU criter ia
	22879	"RTN","HMP DTIU",176, 0)
	22880	; Expects : FILTER(" category") = code (s ee $$CATG)
	22881	"RTN","HMP DTIU",177, 0)
	22882	; FILTER(" loinc") = LOINC
	22883	"RTN","HMP DTIU",178, 0)
	22884	; FILTER(" status") = 'all',' completed' ,'unsigned '
	22885	"RTN","HMP DTIU",179, 0)
	22886	; Returns CLASS,[SU BCLASS,TIT LE,SERVICE ,SUBJECT,S TATUS]
	22887	"RTN","HMP DTIU",180, 0)
	22888	;
	22889	"RTN","HMP DTIU",181, 0)
	22890	N LOINC,T YPE,STS,CP
	22891	"RTN","HMP DTIU",182, 0)
	22892	S LOINC=+ $G(FILTER( "loinc")), TYPE=$$UP^ XLFSTR($G( FILTER("ca tegory")))
	22893	"RTN","HMP DTIU",183, 0)
	22894	S CLASS=" 3^244",(SU BCLASS,TIT LE,SERVICE ,SUBJECT,N OTSUBJ,STA TUS)=""
	22895	"RTN","HMP DTIU",184, 0)
	22896	;
	22897	"RTN","HMP DTIU",185, 0)
	22898	; status [default=' complete']
	22899	"RTN","HMP DTIU",186, 0)
	22900	S STS=$$L OW^XLFSTR( $G(FILTER( "status")) )
	22901	"RTN","HMP DTIU",187, 0)
	22902	S STATUS= $S(STS?1"u nsig".E:2, STS="all": "5^2",1:5) ;TIUSRVL O statuses
	22903	"RTN","HMP DTIU",188, 0)
	22904	;
	22905	"RTN","HMP DTIU",189, 0)
	22906	; progres s notes
	22907	"RTN","HMP DTIU",190, 0)
	22908	I TYPE="P N" S CLASS =3 Q
	22909	"RTN","HMP DTIU",191, 0)
	22910	I TYPE="C R"!(LOINC= 11488) S C LASS=3,SUB CLASS=+$$C LASS^TIUCN SLT Q
	22911	"RTN","HMP DTIU",192, 0)
	22912	; LOINC=2 6442 S CLA SS=3,SUBJE CT="^114^" Q ;OB/GYN
	22913	"RTN","HMP DTIU",193, 0)
	22914	I LOINC=3 4117 S CLA SS=3,SERVI CE="^88^" Q ;H&P
	22915	"RTN","HMP DTIU",194, 0)
	22916	I TYPE="C WAD" S CLA SS=3,SUBCL ASS="25^27 ^30^31" Q ;CWAD
	22917	"RTN","HMP DTIU",195, 0)
	22918	I TYPE="C " S CLASS= 3,SUBCLASS =30 Q ;Crisis N ote
	22919	"RTN","HMP DTIU",196, 0)
	22920	I TYPE="W " S CLASS= 3,SUBCLASS =31 Q ;Clinical Warning
	22921	"RTN","HMP DTIU",197, 0)
	22922	I TYPE="A " S CLASS= 3,SUBCLASS =25 Q ;Allergy Note
	22923	"RTN","HMP DTIU",198, 0)
	22924	I TYPE="D "!(LOINC=4 2348) S CL ASS=3,SUBC LASS=27 Q ;Advance Directive
	22925	"RTN","HMP DTIU",199, 0)
	22926	;
	22927	"RTN","HMP DTIU",200, 0)
	22928	; dischar ge summari es
	22929	"RTN","HMP DTIU",201, 0)
	22930	I TYPE="D S"!(LOINC= 18842) S C LASS=244 Q
	22931	"RTN","HMP DTIU",202, 0)
	22932	;
	22933	"RTN","HMP DTIU",203, 0)
	22934	; procedu res
	22935	"RTN","HMP DTIU",204, 0)
	22936	I TYPE="S R"!(LOINC= 29752) S C LASS=+$$CL ASS^TIUSRO I("SURGICA L REPORTS" ) Q
	22937	"RTN","HMP DTIU",205, 0)
	22938	D CPCLASS ^TIUCP(.CP )
	22939	"RTN","HMP DTIU",206, 0)
	22940	I TYPE="C P" S CLASS =$S(STATUS =2:CP,1:"C P") Q ;CLINICA L PROCEDUR ES
	22941	"RTN","HMP DTIU",207, 0)
	22942	I LOINC=2 6441 D Q ;CARDIOL OGY
	22943	"RTN","HMP DTIU",208, 0)
	22944	. S CLASS =CP_"^3"
	22945	"RTN","HMP DTIU",209, 0)
	22946	. S SUBJE CT="^18^14 2^174^",SE RVICE="^75 ^76^115^"
	22947	"RTN","HMP DTIU",210, 0)
	22948	I LOINC=2 7896 D Q ;PULMONA RY
	22949	"RTN","HMP DTIU",211, 0)
	22950	. S CLASS =CP_"^3"
	22951	"RTN","HMP DTIU",212, 0)
	22952	. S SUBJE CT="^23^14 2^",SERVIC E="^75^76^ 115^"
	22953	"RTN","HMP DTIU",213, 0)
	22954	I LOINC=2 7895 D Q ;GASTROE NTEROLOGY
	22955	"RTN","HMP DTIU",214, 0)
	22956	. S CLASS =CP_"^3"
	22957	"RTN","HMP DTIU",215, 0)
	22958	. S SUBJE CT="^20^", SERVICE="^ 75^76^115^ "
	22959	"RTN","HMP DTIU",216, 0)
	22960	I LOINC=2 7897 D Q ;NEUROLO GY
	22961	"RTN","HMP DTIU",217, 0)
	22962	. S CLASS =CP_"^3"
	22963	"RTN","HMP DTIU",218, 0)
	22964	. S SUBJE CT="^44^45 ^52^111^11 2^143^146^ ",SERVICE= "^75^76^11 5^"
	22965	"RTN","HMP DTIU",219, 0)
	22966	I LOINC=2 8619 D Q ;OPHTH/O PTOMETRY
	22967	"RTN","HMP DTIU",220, 0)
	22968	. S CLASS =CP_"^3"
	22969	"RTN","HMP DTIU",221, 0)
	22970	. S SUBJE CT="^13^14 ^103^",SER VICE="^75^ 76^115^"
	22971	"RTN","HMP DTIU",222, 0)
	22972	I LOINC=2 8634 D Q ;MISC/AL L OTHERS
	22973	"RTN","HMP DTIU",223, 0)
	22974	. S CLASS =CP_"^3",S ERVICE="^7 5^76^115^"
	22975	"RTN","HMP DTIU",224, 0)
	22976	. S NOTSU BJ="^18^14 2^174^23^1 42^20^44^4 5^52^111^1 12^143^146 ^13^14^103 ^"
	22977	"RTN","HMP DTIU",225, 0)
	22978	I LOINC=2 8570 D Q ;UNSPECI FIED/ALL
	22979	"RTN","HMP DTIU",226, 0)
	22980	. S CLASS =CP_"^3"
	22981	"RTN","HMP DTIU",227, 0)
	22982	. S SERVI CE="^75^76 ^115^"
	22983	"RTN","HMP DTIU",228, 0)
	22984	;
	22985	"RTN","HMP DTIU",229, 0)
	22986	; patholo gy/lab
	22987	"RTN","HMP DTIU",230, 0)
	22988	I TYPE="L R"!(LOINC= 27898) S C LASS=$S(ST ATUS=2:$$L R,1:"LR") Q
	22989	"RTN","HMP DTIU",231, 0)
	22990	;
	22991	"RTN","HMP DTIU",232, 0)
	22992	; radiolo gy
	22993	"RTN","HMP DTIU",233, 0)
	22994	I TYPE="R A"!(LOINC= 18726) S C LASS="RA" Q
	22995	"RTN","HMP DTIU",234, 0)
	22996	;
	22997	"RTN","HMP DTIU",235, 0)
	22998	; unknown
	22999	"RTN","HMP DTIU",236, 0)
	23000	I $L(TYPE )!LOINC S CLASS=0
	23001	"RTN","HMP DTIU",237, 0)
	23002	Q
	23003	"RTN","HMP DTIU",238, 0)
	23004	;
	23005	"RTN","HMP DTIU",239, 0)
	23006	;DE2818 b egin, chan ged functi on below t o use File Man for ^T IU(8926.1) reference s, ICR 567 8
	23007	"RTN","HMP DTIU",240, 0)
	23008	MATCH(DOC, SBCLSS,SRV C,SBJCT,NT SBJ) ; Boo lean funct ion, Retur n 1 or 0, if documen t matches search cri teria
	23009	"RTN","HMP DTIU",241, 0)
	23010	; DOC - I EN in TIU DOCUMENT f ile (#8925 )
	23011	"RTN","HMP DTIU",242, 0)
	23012	; SBCLSS - subclass
	23013	"RTN","HMP DTIU",243, 0)
	23014	; SRVC - service
	23015	"RTN","HMP DTIU",244, 0)
	23016	; two poi nters to T IU LOINC S UBJECT MAT TER DOMAIN (#8926.2) :
	23017	"RTN","HMP DTIU",245, 0)
	23018	; SBJC T - subjec t to inclu de, NTSUBJ - subject to exclud e
	23019	"RTN","HMP DTIU",246, 0)
	23020	N DA,HMSB JMD,LOCAL, NATL,OK,Y
	23021	"RTN","HMP DTIU",247, 0)
	23022	; Y is th e return v alue
	23023	"RTN","HMP DTIU",248, 0)
	23024	S Y=0,DA= +$G(DOC) G :DA<1 MQ
	23025	"RTN","HMP DTIU",249, 0)
	23026	; include addenda i f pulling only unsig ned items
	23027	"RTN","HMP DTIU",250, 0)
	23028	I $P(DOC, U,2)?1"Add endum ".E, STATUS'=2 G MQ
	23029	"RTN","HMP DTIU",251, 0)
	23030	; TIU uns igned list can inclu de complet ed parent notes
	23031	"RTN","HMP DTIU",252, 0)
	23032	I CTXT=2, $P(DOC,U,7 )'="unsign ed" G MQ
	23033	"RTN","HMP DTIU",253, 0)
	23034	S LOCAL=$ $GET1^DIQ( 8925,DA_", ",.01,"I") ;local Ti tle 8925.1 ien
	23035	"RTN","HMP DTIU",254, 0)
	23036	I $L(SBCL SS) D G:' OK MQ
	23037	"RTN","HMP DTIU",255, 0)
	23038	. N I,X S OK=0
	23039	"RTN","HMP DTIU",256, 0)
	23040	. F I=1:1 :$L(SBCLSS ,U) S X=$P (SBCLSS,U, I) I $$ISA ^TIULX(LOC AL,X) S OK =1 Q
	23041	"RTN","HMP DTIU",257, 0)
	23042	S NATL=+$ $GET1^DIQ( 8925.1,LOC AL_",",150 1,"I") ;Na tl Title 8 926.1 ien
	23043	"RTN","HMP DTIU",258, 0)
	23044	I $L(TITL E) G:TITLE '[(U_+NATL _U) MQ
	23045	"RTN","HMP DTIU",259, 0)
	23046	;S X0=$G( ^TIU(8926. 1,NATL,0))
	23047	"RTN","HMP DTIU",260, 0)
	23048	I $L(SRVC ) G:SRVC'[ (U_$$GET1^ DIQ(8926.1 ,NATL_",", .07,"I")_U ) MQ ;(#. 07) SERVIC E
	23049	"RTN","HMP DTIU",261, 0)
	23050	S HMSBJMD =+$$GET1^D IQ(8926.1, NATL_",",. 07,"I") ; (#.04) SUB JECT MATTE R DOMAIN
	23051	"RTN","HMP DTIU",262, 0)
	23052	I $L(SBJC T) G:SBJCT '[(U_HMSBJ MD_U) MQ
	23053	"RTN","HMP DTIU",263, 0)
	23054	I $L(NTSB J) G:NTSBJ [(U_HMSBJM D_U) MQ
	23055	"RTN","HMP DTIU",264, 0)
	23056	S Y=1
	23057	"RTN","HMP DTIU",265, 0)
	23058	MQ Q Y
	23059	"RTN","HMP DTIU",266, 0)
	23060	;
	23061	"RTN","HMP DTIUX")
	23062	1^172
	23063	"RTN","HMP DVSIT")
	23064	0^78^B9349 6568
	23065	"RTN","HMP DVSIT",1,0 )
	23066	HMPDVSIT ; SLC/MKB,AS MR/RRB - V isit/Encou nter extra ct;8/2/11 15:29
	23067	"RTN","HMP DVSIT",2,0 )
	23068	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	23069	"RTN","HMP DVSIT",3,0 )
	23070	;Per VA D irective 6 402, this routine sh ould not b e modified .
	23071	"RTN","HMP DVSIT",4,0 )
	23072	;
	23073	"RTN","HMP DVSIT",5,0 )
	23074	; Externa l Referenc es DBIA#
	23075	"RTN","HMP DVSIT",6,0 )
	23076	; ------- ---------- -- -----
	23077	"RTN","HMP DVSIT",7,0 )
	23078	; ^AUPNVS IT 2028
	23079	"RTN","HMP DVSIT",8,0 )
	23080	; ^DIC(40 .7 557
	23081	"RTN","HMP DVSIT",9,0 )
	23082	; ^DIC(42 10039
	23083	"RTN","HMP DVSIT",10, 0)
	23084	; ^DIC(45 .7 1154
	23085	"RTN","HMP DVSIT",11, 0)
	23086	; ^DPT( 10035
	23087	"RTN","HMP DVSIT",12, 0)
	23088	; ^SC 10040
	23089	"RTN","HMP DVSIT",13, 0)
	23090	; ^VA(200 10060
	23091	"RTN","HMP DVSIT",14, 0)
	23092	; DGPTFAP I 3157
	23093	"RTN","HMP DVSIT",15, 0)
	23094	; DIC 2051
	23095	"RTN","HMP DVSIT",16, 0)
	23096	; DILFD 2055
	23097	"RTN","HMP DVSIT",17, 0)
	23098	; DIQ 2056
	23099	"RTN","HMP DVSIT",18, 0)
	23100	; ICDCODE 3990
	23101	"RTN","HMP DVSIT",19, 0)
	23102	; ICPTCOD 1995
	23103	"RTN","HMP DVSIT",20, 0)
	23104	; PXAPI,^ TMP("PXKEN C",$J 1894
	23105	"RTN","HMP DVSIT",21, 0)
	23106	; SDOE 2546
	23107	"RTN","HMP DVSIT",22, 0)
	23108	; VADPT 10061
	23109	"RTN","HMP DVSIT",23, 0)
	23110	; VADPT2 325
	23111	"RTN","HMP DVSIT",24, 0)
	23112	; XUAF4 2171
	23113	"RTN","HMP DVSIT",25, 0)
	23114	Q
	23115	"RTN","HMP DVSIT",26, 0)
	23116	; ------- ----- Get encounter( s) from Vi stA ------ ------
	23117	"RTN","HMP DVSIT",27, 0)
	23118	;
	23119	"RTN","HMP DVSIT",28, 0)
	23120	EN(DFN,BEG ,END,MAX,I D) ; -- fi nd patient 's visits and appoin tments
	23121	"RTN","HMP DVSIT",29, 0)
	23122	N HMPCNT, HMPITM,HMP DT,HMPLOC, HMPDA
	23123	"RTN","HMP DVSIT",30, 0)
	23124	S DFN=+$G (DFN) Q:DF N<1
	23125	"RTN","HMP DVSIT",31, 0)
	23126	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	23127	"RTN","HMP DVSIT",32, 0)
	23128	;
	23129	"RTN","HMP DVSIT",33, 0)
	23130	; get one visit
	23131	"RTN","HMP DVSIT",34, 0)
	23132	I $G(ID) D EN1(ID,. HMPITM),XM L(.HMPITM) G ENQ
	23133	"RTN","HMP DVSIT",35, 0)
	23134	;
	23135	"RTN","HMP DVSIT",36, 0)
	23136	; -- get all visits
	23137	"RTN","HMP DVSIT",37, 0)
	23138	I END,END '["." S EN D=END_".24 " ;assume end of day
	23139	"RTN","HMP DVSIT",38, 0)
	23140	S HMPCNT= 0
	23141	"RTN","HMP DVSIT",39, 0)
	23142	;F S IDX =$Q(@IDX,- 1) Q:DFN'= $P(IDX,"," ,2) Q:$P( IDX,",",3) <BEG I $P (IDX,",",5 )["P" D
	23143	"RTN","HMP DVSIT",40, 0)
	23144	S HMPDT=E ND F S HM PDT=$O(^AU PNVSIT("AE T",DFN,HMP DT),-1) Q :HMPDT<BEG D Q:HMP CNT'<MAX ;ICR 2028 DE2818 ASF 11/21/15
	23145	"RTN","HMP DVSIT",41, 0)
	23146	. S HMPLO C=0 F S H MPLOC=$O(^ AUPNVSIT(" AET",DFN,H MPDT,HMPLO C)) Q:HMPL OC<1 D
	23147	"RTN","HMP DVSIT",42, 0)
	23148	.. S HMPD A=0 F S H MPDA=$O(^A UPNVSIT("A ET",DFN,HM PDT,HMPLOC ,"P",HMPDA )) Q:HMPDA <1 D
	23149	"RTN","HMP DVSIT",43, 0)
	23150	... K HMP ITM D EN1( HMPDA,.HMP ITM) Q:'$D (HMPITM)
	23151	"RTN","HMP DVSIT",44, 0)
	23152	... D XML (.HMPITM) S HMPCNT=H MPCNT+1
	23153	"RTN","HMP DVSIT",45, 0)
	23154	ENQ ; end
	23155	"RTN","HMP DVSIT",46, 0)
	23156	K ^TMP("H MPTEXT",$J )
	23157	"RTN","HMP DVSIT",47, 0)
	23158	Q
	23159	"RTN","HMP DVSIT",48, 0)
	23160	;
	23161	"RTN","HMP DVSIT",49, 0)
	23162	ENAA(DFN,B EG,END,MAX ,ID) ; -- find patie nt's visit s and appo intments [ AA]
	23163	"RTN","HMP DVSIT",50, 0)
	23164	N IDT,DA, HMPCNT,HMP ITM
	23165	"RTN","HMP DVSIT",51, 0)
	23166	S DFN=+$G (DFN) Q:DF N<1
	23167	"RTN","HMP DVSIT",52, 0)
	23168	S BEG=$G( BEG,141010 1),END=$G( END,414101 5),MAX=$G( MAX,9999)
	23169	"RTN","HMP DVSIT",53, 0)
	23170	I $G(ID) D EN1(ID,. HMPITM),XM L(.HMPITM) Q ;one v isit
	23171	"RTN","HMP DVSIT",54, 0)
	23172	D IDT S H MPCNT=0
	23173	"RTN","HMP DVSIT",55, 0)
	23174	S IDT=BEG F S IDT= $O(^AUPNVS IT("AA",DF N,IDT)) Q: IDT<1!(IDT >END) D Q:HMPCNT'< MAX ;ICR 2028 DE281 8 ASF 11/2 1/15
	23175	"RTN","HMP DVSIT",56, 0)
	23176	. S DA=0 F S DA=$O (^AUPNVSIT ("AA",DFN, IDT,DA)) Q :DA<1 D
	23177	"RTN","HMP DVSIT",57, 0)
	23178	.. K HMPI TM D EN1(D A,.HMPITM) Q:'$D(HMP ITM)
	23179	"RTN","HMP DVSIT",58, 0)
	23180	.. D XML( .HMPITM) S HMPCNT=HM PCNT+1
	23181	"RTN","HMP DVSIT",59, 0)
	23182	Q
	23183	"RTN","HMP DVSIT",60, 0)
	23184	IDT ; -- i nvert BEG and END da tes for vi sit format :
	23185	"RTN","HMP DVSIT",61, 0)
	23186	; IDT=(9 999999-$P( VDT,"."))_ "."_$P(VDT ,".",2)
	23187	"RTN","HMP DVSIT",62, 0)
	23188	N X S X=B EG
	23189	"RTN","HMP DVSIT",63, 0)
	23190	S BEG=(99 99999-$P(E ND,"."))
	23191	"RTN","HMP DVSIT",64, 0)
	23192	S END=(99 99999-$P(X ,"."))_".2 359"
	23193	"RTN","HMP DVSIT",65, 0)
	23194	Q
	23195	"RTN","HMP DVSIT",66, 0)
	23196	;
	23197	"RTN","HMP DVSIT",67, 0)
	23198	EN1(IEN,VS T) ; -- re turn a vis it in VST( "attribute ")=value
	23199	"RTN","HMP DVSIT",68, 0)
	23200	N X0,X15, X,FAC,LOC, CATG,INPT, DA
	23201	"RTN","HMP DVSIT",69, 0)
	23202	K VST,^TM P("HMPTEXT ",$J)
	23203	"RTN","HMP DVSIT",70, 0)
	23204	S IEN=+$G (IEN) Q:IE N<1 ;inva lid
	23205	"RTN","HMP DVSIT",71, 0)
	23206	D ENCEVEN T^PXAPI(IE N)
	23207	"RTN","HMP DVSIT",72, 0)
	23208	S X0=$G(^ TMP("PXKEN C",$J,IEN, "VST",IEN, 0)),X15=$G (^(150))
	23209	"RTN","HMP DVSIT",73, 0)
	23210	Q:$P(X15, U,3)'="P" Q:$P(X0,U ,7)="E" ; want prima ry, not hi storical
	23211	"RTN","HMP DVSIT",74, 0)
	23212	I $P(X0,U ,7)="H" D ADM(IEN,+X 0,.VST) Q
	23213	"RTN","HMP DVSIT",75, 0)
	23214	S VST("id ")=IEN,VST ("dateTime ")=+X0
	23215	"RTN","HMP DVSIT",76, 0)
	23216	S FAC=+$P (X0,U,6),C ATG=$P(X0, U,7),LOC=+ $P(X0,U,22 )
	23217	"RTN","HMP DVSIT",77, 0)
	23218	S:FAC VST ("facility ")=$$STA^X UAF4(FAC)_ U_$P($$NS^ XUAF4(FAC) ,U)
	23219	"RTN","HMP DVSIT",78, 0)
	23220	S:'FAC VS T("facilit y")=$$FAC^ HMPD(LOC)
	23221	"RTN","HMP DVSIT",79, 0)
	23222	S VST("se rviceCateg ory")=CATG _U_$$CATG( CATG)
	23223	"RTN","HMP DVSIT",80, 0)
	23224	S VST("vi sitString" )=LOC_";"_ +X0_";"_CA TG
	23225	"RTN","HMP DVSIT",81, 0)
	23226	S INPT=$P (X15,U,2) S:INPT="" INPT=$S("H ^I^R^D"[CA TG:1,1:0)
	23227	"RTN","HMP DVSIT",82, 0)
	23228	S X=$$CPT (IEN) S:X VST("type" )=$P($$CPT ^ICPTCOD(X ),U,2,3)
	23229	"RTN","HMP DVSIT",83, 0)
	23230	I 'X S VS T("type")= U_$S('INPT &LOC:$P($G (^SC(LOC,0 )),U)_" VI SIT",1:$$C ATG(CATG)) ;ICR 1004 0 DE2818 A SF 11/21/1 5
	23231	"RTN","HMP DVSIT",84, 0)
	23232	S VST("pa tientClass ")=$S(INPT :"IMP",1:" AMB")
	23233	"RTN","HMP DVSIT",85, 0)
	23234	S X=$P(X0 ,U,8) S:X VST("stopC ode")=$$AM IS(X) I LO C D
	23235	"RTN","HMP DVSIT",86, 0)
	23236	. N L0 S L0=$G(^SC( LOC,0)) ;I CR 10040 D E2818 ASF 11/21/15
	23237	"RTN","HMP DVSIT",87, 0)
	23238	. I 'X S VST("stopC ode")=$$AM IS($P(L0,U ,7))
	23239	"RTN","HMP DVSIT",88, 0)
	23240	. S VST(" location") =$P(L0,U), VST("servi ce")=$$SER V($P(L0,U, 20))
	23241	"RTN","HMP DVSIT",89, 0)
	23242	. S X=$P( L0,U,18) S :X VST("cr editStopCo de")=$$AMI S(X)
	23243	"RTN","HMP DVSIT",90, 0)
	23244	S VST("re ason")=$$P OV(IEN)
	23245	"RTN","HMP DVSIT",91, 0)
	23246	; provide r(s)
	23247	"RTN","HMP DVSIT",92, 0)
	23248	S DA=0 F S DA=$O(^ TMP("PXKEN C",$J,IEN, "PRV",DA)) Q:DA<1 S X0=$G(^(D A,0)) D
	23249	"RTN","HMP DVSIT",93, 0)
	23250	. S VST(" provider", DA)=+X0_U_ $P($G(^VA( 200,+X0,0) ),U)_$S($P (X0,U,4)=" P":"^P^1", 1:"^S^") ; ICR 10060 DE2818 ASF 11/21/15
	23251	"RTN","HMP DVSIT",94, 0)
	23252	; note(s)
	23253	"RTN","HMP DVSIT",95, 0)
	23254	D TIU(IEN )
	23255	"RTN","HMP DVSIT",96, 0)
	23256	K ^TMP("P XKENC",$J, IEN)
	23257	"RTN","HMP DVSIT",97, 0)
	23258	Q
	23259	"RTN","HMP DVSIT",98, 0)
	23260	;
	23261	"RTN","HMP DVSIT",99, 0)
	23262	TIU(VISIT) ; -- add notes to V ST("docume nt")
	23263	"RTN","HMP DVSIT",100 ,0)
	23264	N X,Y,I,H MPX,LT,NT, DA,CNT,HMP Y
	23265	"RTN","HMP DVSIT",101 ,0)
	23266	D FIND^DI C(8925,,.0 1,"QX",+$G (VISIT),," V",,,"HMPX ")
	23267	"RTN","HMP DVSIT",102 ,0)
	23268	S Y="",(I ,CNT)=0
	23269	"RTN","HMP DVSIT",103 ,0)
	23270	F S I=$O (HMPX("DIL IST",1,I)) Q:I<1 D
	23271	"RTN","HMP DVSIT",104 ,0)
	23272	. S LT=$G (HMPX("DIL IST","ID", I,.01)) Q: $P(LT," ") ="Addendum "
	23273	"RTN","HMP DVSIT",105 ,0)
	23274	. S DA=$G (HMPX("DIL IST",2,I))
	23275	"RTN","HMP DVSIT",106 ,0)
	23276	. S NT=$$ GET1^DIQ(8 925,+DA_", ",".01:150 1")
	23277	"RTN","HMP DVSIT",107 ,0)
	23278	. S CNT=C NT+1,VST(" document", CNT)=DA_U_ LT_U_NT
	23279	"RTN","HMP DVSIT",108 ,0)
	23280	. S:$G(HM PTEXT) VST ("document ",CNT,"con tent")=$$T EXT^HMPDTI U(DA)
	23281	"RTN","HMP DVSIT",109 ,0)
	23282	Q
	23283	"RTN","HMP DVSIT",110 ,0)
	23284	;
	23285	"RTN","HMP DVSIT",111 ,0)
	23286	POV(VISIT) ; -- retu rn the pri mary Purpo se of Visi t as ICD^P roviderNar rative
	23287	"RTN","HMP DVSIT",112 ,0)
	23288	N DA,Y,X, X0,ICD S Y =""
	23289	"RTN","HMP DVSIT",113 ,0)
	23290	S DA=0 F S DA=$O(^ TMP("PXKEN C",$J,VISI T,"POV",DA )) Q:DA<1 S X0=$G(^ (DA,0)) I $P(X0,U,12 )="P" D Q :$L(Y)
	23291	"RTN","HMP DVSIT",114 ,0)
	23292	. S X=+$P (X0,U,4),I CD=$$ICD(+ X0)
	23293	"RTN","HMP DVSIT",115 ,0)
	23294	. S Y=ICD _U_$$EXTER NAL^DILFD( 9000010.07 ,.04,,X)
	23295	"RTN","HMP DVSIT",116 ,0)
	23296	Q Y
	23297	"RTN","HMP DVSIT",117 ,0)
	23298	;
	23299	"RTN","HMP DVSIT",118 ,0)
	23300	ICD(IEN) ; -- return code^desc ription fo r ICD code , or "^" i f error
	23301	"RTN","HMP DVSIT",119 ,0)
	23302	N X0,HMPX ,N,I,X,Y S IEN=+$G(I EN)
	23303	"RTN","HMP DVSIT",120 ,0)
	23304	S X0=$$IC DDX^ICDCOD E(IEN) I X 0<0 Q "^"
	23305	"RTN","HMP DVSIT",121 ,0)
	23306	S Y=$P(X0 ,U,2)_U_$P (X0,U,4) ;ICD Code^Dx na me
	23307	"RTN","HMP DVSIT",122 ,0)
	23308	S N=$$ICD D^ICDCODE( $P(Y,U),"H MPX") ;ICD Descripti on
	23309	"RTN","HMP DVSIT",123 ,0)
	23310	I N>0,$L( $G(HMPX(1) )) S $P(Y, U,2)=HMPX( 1)
	23311	"RTN","HMP DVSIT",124 ,0)
	23312	Q Y
	23313	"RTN","HMP DVSIT",125 ,0)
	23314	;
	23315	"RTN","HMP DVSIT",126 ,0)
	23316	CPT(VISIT) ; -- Retu rn CPT cod e of encou nter type
	23317	"RTN","HMP DVSIT",127 ,0)
	23318	N DA,Y,X, X0 S Y=""
	23319	"RTN","HMP DVSIT",128 ,0)
	23320	S DA=0 F S DA=$O(^ TMP("PXKEN C",$J,VISI T,"CPT",DA )) Q:DA<1 S X0=$G(^ (DA,0)) D Q:$L(Y)
	23321	"RTN","HMP DVSIT",129 ,0)
	23322	. S X=$P( X0,U) I X? 1"992"2N S Y=X Q
	23323	"RTN","HMP DVSIT",130 ,0)
	23324	Q Y
	23325	"RTN","HMP DVSIT",131 ,0)
	23326	;
	23327	"RTN","HMP DVSIT",132 ,0)
	23328	AMIS(X) ; -- return the AMIS c ode^name o f Credit S top X
	23329	"RTN","HMP DVSIT",133 ,0)
	23330	N Y,X0 S Y=""
	23331	"RTN","HMP DVSIT",134 ,0)
	23332	S X0=$G(^ DIC(40.7,+ $G(X),0)) S:$L(X0) Y =$P(X0,U,2 )_U_$P(X0, U) ;ICR 55 7 DE2818 A SF 11/21/1 5
	23333	"RTN","HMP DVSIT",135 ,0)
	23334	Q Y
	23335	"RTN","HMP DVSIT",136 ,0)
	23336	;
	23337	"RTN","HMP DVSIT",137 ,0)
	23338	CATG(X) ; -- Return name of vi sit Servic e Category code X
	23339	"RTN","HMP DVSIT",138 ,0)
	23340	N Y S Y=" "
	23341	"RTN","HMP DVSIT",139 ,0)
	23342	I X="A" S Y="AMBULA TORY"
	23343	"RTN","HMP DVSIT",140 ,0)
	23344	I X="H" S Y="HOSPIT ALIZATION"
	23345	"RTN","HMP DVSIT",141 ,0)
	23346	I X="I" S Y="IN HOS PITAL"
	23347	"RTN","HMP DVSIT",142 ,0)
	23348	I X="C" S Y="CHART REVIEW"
	23349	"RTN","HMP DVSIT",143 ,0)
	23350	I X="T" S Y="TELECO MMUNICATIO NS"
	23351	"RTN","HMP DVSIT",144 ,0)
	23352	I X="N" S Y="NOT FO UND"
	23353	"RTN","HMP DVSIT",145 ,0)
	23354	I X="S" S Y="DAY SU RGERY"
	23355	"RTN","HMP DVSIT",146 ,0)
	23356	I X="O" S Y="OBSERV ATION"
	23357	"RTN","HMP DVSIT",147 ,0)
	23358	I X="E" S Y="EVENT (HISTORICA L)"
	23359	"RTN","HMP DVSIT",148 ,0)
	23360	I X="R" S Y="NURSIN G HOME"
	23361	"RTN","HMP DVSIT",149 ,0)
	23362	I X="D" S Y="DAILY HOSPITALIZ ATION DATA "
	23363	"RTN","HMP DVSIT",150 ,0)
	23364	I X="X" S Y="ANCILL ARY PACKAG E DAILY DA TA"
	23365	"RTN","HMP DVSIT",151 ,0)
	23366	Q Y
	23367	"RTN","HMP DVSIT",152 ,0)
	23368	;
	23369	"RTN","HMP DVSIT",153 ,0)
	23370	SERV(FTS) ; -- Retur n #42.4 Se rvice for a Facility Treating Specialty
	23371	"RTN","HMP DVSIT",154 ,0)
	23372	N Y S Y=" ",FTS=+$G( FTS)
	23373	"RTN","HMP DVSIT",155 ,0)
	23374	S Y=$$GET 1^DIQ(45.7 ,FTS_","," 1:3","E")
	23375	"RTN","HMP DVSIT",156 ,0)
	23376	Q Y
	23377	"RTN","HMP DVSIT",157 ,0)
	23378	;
	23379	"RTN","HMP DVSIT",158 ,0)
	23380	ADM(IEN,DA TE,ADM) ; -- return an admissi on in ADM( "attribute ")=value
	23381	"RTN","HMP DVSIT",159 ,0)
	23382	N VAINDT, VADMVT,VAI P,VAIN,VAE RR,HLOC,IC D,I K ADM
	23383	"RTN","HMP DVSIT",160 ,0)
	23384	S IEN=+$G (IEN),DATE =+$G(DATE) Q:IEN<1 Q:DATE<1
	23385	"RTN","HMP DVSIT",161 ,0)
	23386	S VAINDT= DATE D ADM ^VADPT2 Q: VADMVT<1
	23387	"RTN","HMP DVSIT",162 ,0)
	23388	I VADMVT= $G(^DPT(DF N,.105)) D INPT Q ; current in patient IC R 10035 DE 2818 ASF 1 1/21/15
	23389	"RTN","HMP DVSIT",163 ,0)
	23390	S VAIP("E ")=VADMVT D IN5^VADP T Q:'$G(VA IP(1)) ;d eleted
	23391	"RTN","HMP DVSIT",164 ,0)
	23392	S ADM("id ")=IEN,ADM ("patientC lass")="IM P"
	23393	"RTN","HMP DVSIT",165 ,0)
	23394	; ADM("ad mitType")= $P($G(VAIP (4)),U,2)
	23395	"RTN","HMP DVSIT",166 ,0)
	23396	S DATE=+$ G(VAIP(13, 1)),(ADM(" dateTime") ,ADM("arri valDateTim e"))=DATE, I=0
	23397	"RTN","HMP DVSIT",167 ,0)
	23398	S:$G(VAIP (7)) I=I+1 ,ADM("prov ider",I)=V AIP(7)_"^P ^1" ;prima ry
	23399	"RTN","HMP DVSIT",168 ,0)
	23400	S:$G(VAIP (18)) I=I+ 1,ADM("pro vider",I)= VAIP(18)_" ^A" ;atten ding
	23401	"RTN","HMP DVSIT",169 ,0)
	23402	S ADM("sp ecialty")= $P($G(VAIP (8)),U,2)
	23403	"RTN","HMP DVSIT",170 ,0)
	23404	S X=$$SER V(+$G(VAIP (8))),ADM( "service") =X
	23405	"RTN","HMP DVSIT",171 ,0)
	23406	S ICD=$$P OV(IEN) S: 'ICD ICD=$ $PTF(DFN,V AIP(12)) ; PTF>ICD
	23407	"RTN","HMP DVSIT",172 ,0)
	23408	S ADM("re ason")=ICD _U_$G(VAIP (9)) ;ICD code^descr iption^Dx text
	23409	"RTN","HMP DVSIT",173 ,0)
	23410	S HLOC=+$ G(^DIC(42, +$G(VAIP(5 )),44)) ;I CR 10039 D E2818 ASF 11/21/15
	23411	"RTN","HMP DVSIT",174 ,0)
	23412	S:HLOC AD M("locatio n")=$P($G( ^SC(HLOC,0 )),U) ;ICR 10040 DE2 818 ASF 11 /21/15
	23413	"RTN","HMP DVSIT",175 ,0)
	23414	S ADM("fa cility")=$ $FAC^HMPD( +HLOC),ADM ("roomBed" )=$P(VAIP( 6),U,2)
	23415	"RTN","HMP DVSIT",176 ,0)
	23416	S ADM("se rviceCateg ory")="H^H OSPITALIZA TION"
	23417	"RTN","HMP DVSIT",177 ,0)
	23418	S X=$$CPT (IEN),ADM( "type")=$S (X:$P($$CP T^ICPTCOD( X),U,2,3), 1:U_$$CATG ("H"))
	23419	"RTN","HMP DVSIT",178 ,0)
	23420	I $G(VAIP (17)) D
	23421	"RTN","HMP DVSIT",179 ,0)
	23422	. S ADM(" departureD ateTime")= +$G(VAIP(1 7,1))
	23423	"RTN","HMP DVSIT",180 ,0)
	23424	. ; ADM(" dispositio n")=$G(VAI P(17,3)) ; Discharge Mvt Type
	23425	"RTN","HMP DVSIT",181 ,0)
	23426	S ADM("vi sitString" )=HLOC_";" _DATE_";H"
	23427	"RTN","HMP DVSIT",182 ,0)
	23428	D TIU(IEN ) ;notes/s ummary
	23429	"RTN","HMP DVSIT",183 ,0)
	23430	Q
	23431	"RTN","HMP DVSIT",184 ,0)
	23432	;
	23433	"RTN","HMP DVSIT",185 ,0)
	23434	INPT ; -- return cur rent admis sion in AD M("attribu te")=value [from ADM ]
	23435	"RTN","HMP DVSIT",186 ,0)
	23436	K VAINDT D INP^VADP T Q:VAIN(1 )<1
	23437	"RTN","HMP DVSIT",187 ,0)
	23438	S ADM("id ")=IEN,ADM ("patientC lass")="IM P"
	23439	"RTN","HMP DVSIT",188 ,0)
	23440	; ADM("ad mitType")= $P($G(VAIN (8)),U,2)
	23441	"RTN","HMP DVSIT",189 ,0)
	23442	S DATE=+$ G(VAIN(7)) ,(ADM("dat eTime"),AD M("arrival DateTime") )=DATE,I=0
	23443	"RTN","HMP DVSIT",190 ,0)
	23444	S:$G(VAIN (2)) I=I+1 ,ADM("prov ider",I)=V AIN(2)_"^P ^1" ;prima ry
	23445	"RTN","HMP DVSIT",191 ,0)
	23446	S:$G(VAIN (11)) I=I+ 1,ADM("pro vider",I)= VAIN(11)_" ^A" ;atten ding
	23447	"RTN","HMP DVSIT",192 ,0)
	23448	S ADM("sp ecialty")= $P($G(VAIN (3)),U,2)
	23449	"RTN","HMP DVSIT",193 ,0)
	23450	S X=$$SER V(+$G(VAIN (3))),ADM( "service") =X
	23451	"RTN","HMP DVSIT",194 ,0)
	23452	S ICD=$$P OV(IEN) S: 'ICD ICD=$ $PTF(DFN,V AIN(10)) ; PTF>ICD
	23453	"RTN","HMP DVSIT",195 ,0)
	23454	S ADM("re ason")=ICD _U_$G(VAIN (9)) ;ICD code^descr iption^Dx text
	23455	"RTN","HMP DVSIT",196 ,0)
	23456	S HLOC=+$ G(^DIC(42, +$G(VAIN(4 )),44)) ;I CR 10039 D E2818 ASF 11/21/15
	23457	"RTN","HMP DVSIT",197 ,0)
	23458	S:HLOC AD M("locatio n")=$P($G( ^SC(HLOC,0 )),U) ;ICR 10040 DE2 818 ASF 11 /21/15
	23459	"RTN","HMP DVSIT",198 ,0)
	23460	S ADM("fa cility")=$ $FAC^HMPD( +HLOC),ADM ("roomBed" )=$P(VAIN( 5),U,2)
	23461	"RTN","HMP DVSIT",199 ,0)
	23462	S ADM("se rviceCateg ory")="H^H OSPITALIZA TION"
	23463	"RTN","HMP DVSIT",200 ,0)
	23464	S X=$$CPT (IEN),ADM( "type")=$S (X:$P($$CP T^ICPTCOD( X),U,2,3), 1:U_$$CATG ("H"))
	23465	"RTN","HMP DVSIT",201 ,0)
	23466	; ADM("vi sitString" )=HLOC_";" _DATE_";H"
	23467	"RTN","HMP DVSIT",202 ,0)
	23468	D TIU(IEN ) ;notes/s ummary
	23469	"RTN","HMP DVSIT",203 ,0)
	23470	Q
	23471	"RTN","HMP DVSIT",204 ,0)
	23472	;
	23473	"RTN","HMP DVSIT",205 ,0)
	23474	PTF(DFN,PT F) ; -- re turn ICD c ode^descri ption for a PTF reco rd
	23475	"RTN","HMP DVSIT",206 ,0)
	23476	N HMPPTF, N,HMPX
	23477	"RTN","HMP DVSIT",207 ,0)
	23478	D:$G(PTF) RPC^DGPTF API(.HMPPT F,+PTF) I $G(HMPPTF( 0))<1 Q "^ "
	23479	"RTN","HMP DVSIT",208 ,0)
	23480	S Y=$P($G (HMPPTF(1) ),U,3)_U
	23481	"RTN","HMP DVSIT",209 ,0)
	23482	S N=$$ICD D^ICDCODE( Y,"HMPX") ;ICD Descr iption
	23483	"RTN","HMP DVSIT",210 ,0)
	23484	I N>0,$L( $G(HMPX(1) )) S Y=Y_H MPX(1)
	23485	"RTN","HMP DVSIT",211 ,0)
	23486	Q Y
	23487	"RTN","HMP DVSIT",212 ,0)
	23488	;
	23489	"RTN","HMP DVSIT",213 ,0)
	23490	ENC(IEN,EN C) ; -- re turn an en counter in ENC("attr ibute")=va lue
	23491	"RTN","HMP DVSIT",214 ,0)
	23492	N X0,DATE ,HLOC,TYPE ,STS,X,Y K ENC
	23493	"RTN","HMP DVSIT",215 ,0)
	23494	S IEN=+$G (IEN) Q:IE N<1 ;inva lid ien
	23495	"RTN","HMP DVSIT",216 ,0)
	23496	S ENC("id ")="E"_IEN ,X0=$$GETO E^SDOE(IEN ) ;^SCE(IE N,0) node ICR 10040 DE2818 ASF 11/21/15
	23497	"RTN","HMP DVSIT",217 ,0)
	23498	S DATE=+X 0,ENC("dat eTime")=DA TE
	23499	"RTN","HMP DVSIT",218 ,0)
	23500	S HLOC=+$ P(X0,U,4) I HLOC D
	23501	"RTN","HMP DVSIT",219 ,0)
	23502	. S HLOC= HLOC_U_$P( $G(^SC(HLO C,0)),U) ; ICR 10040 DE2818 ASF 11/21/15
	23503	"RTN","HMP DVSIT",220 ,0)
	23504	. S ENC(" location") =$P(HLOC,U ,2)
	23505	"RTN","HMP DVSIT",221 ,0)
	23506	. S X=$$G ET1^DIQ(44 ,+HLOC_"," ,9.5,"I")
	23507	"RTN","HMP DVSIT",222 ,0)
	23508	. I X S E NC("servic e")=$$SERV (X)
	23509	"RTN","HMP DVSIT",223 ,0)
	23510	S ENC("fa cility")=$ $FAC^HMPD( +HLOC)
	23511	"RTN","HMP DVSIT",224 ,0)
	23512	S STS=$$E XTERNAL^DI LFD(409.68 ,.12,,$P(X 0,U,12))
	23513	"RTN","HMP DVSIT",225 ,0)
	23514	S X=$S(ST S?1"INP".E :"IMP",1:" AMB"),ENC( "patientCl ass")=X,TY PE=$E(X)
	23515	"RTN","HMP DVSIT",226 ,0)
	23516	S ENC("ty pe")=U_$S( HLOC:$P(HL OC,U,2)_" VISIT",1:$ $CATG(TYPE ))
	23517	"RTN","HMP DVSIT",227 ,0)
	23518	S ENC("se rviceCateg ory")=TYPE _U_$$CATG( TYPE)
	23519	"RTN","HMP DVSIT",228 ,0)
	23520	S ENC("vi sitString" )=+HLOC_"; "_DATE_";" _TYPE
	23521	"RTN","HMP DVSIT",229 ,0)
	23522	Q
	23523	"RTN","HMP DVSIT",230 ,0)
	23524	;
	23525	"RTN","HMP DVSIT",231 ,0)
	23526	; ------- ----- Retu rn data to middle ti er ------- -----
	23527	"RTN","HMP DVSIT",232 ,0)
	23528	;
	23529	"RTN","HMP DVSIT",233 ,0)
	23530	XML(VISIT) ; -- Retu rn patient visit as XML
	23531	"RTN","HMP DVSIT",234 ,0)
	23532	N ATT,X,Y ,NAMES,I,J
	23533	"RTN","HMP DVSIT",235 ,0)
	23534	D ADD("<v isit>") S HMPTOTL=$G (HMPTOTL)+ 1
	23535	"RTN","HMP DVSIT",236 ,0)
	23536	S ATT="" F S ATT=$ O(VISIT(AT T)) Q:ATT= "" D D:$ L(Y) ADD(Y )
	23537	"RTN","HMP DVSIT",237 ,0)
	23538	. I $O(VI SIT(ATT,0) ) D S Y=" " Q ;mult iples
	23539	"RTN","HMP DVSIT",238 ,0)
	23540	.. D ADD( "<"_ATT_"s >")
	23541	"RTN","HMP DVSIT",239 ,0)
	23542	.. S I=0 F S I=$O( VISIT(ATT, I)) Q:I<1 D
	23543	"RTN","HMP DVSIT",240 ,0)
	23544	... S X=$ G(VISIT(AT T,I)),NAME S=""
	23545	"RTN","HMP DVSIT",241 ,0)
	23546	... I ATT ="document " S NAMES= "id^localT itle^natio nalTitle^Z "
	23547	"RTN","HMP DVSIT",242 ,0)
	23548	... I ATT ="provider " S NAMES= "code^name ^role^prim ary^Z"
	23549	"RTN","HMP DVSIT",243 ,0)
	23550	... S Y=" <"_ATT_" " _$$LOOP ;_ "/>" D ADD (Y)
	23551	"RTN","HMP DVSIT",244 ,0)
	23552	... S X=$ G(VISIT(AT T,I,"conte nt")) I '$ L(X) S Y=Y _"/>" D AD D(Y) Q
	23553	"RTN","HMP DVSIT",245 ,0)
	23554	... S Y=Y _">" D ADD (Y)
	23555	"RTN","HMP DVSIT",246 ,0)
	23556	... S Y=" <content x ml:space=' preserve'> " D ADD(Y)
	23557	"RTN","HMP DVSIT",247 ,0)
	23558	... S J=0 F S J=$O (@X@(J)) Q :J<1 S Y= $$ESC^HMPD (@X@(J)) D ADD(Y)
	23559	"RTN","HMP DVSIT",248 ,0)
	23560	... D ADD ("</conten t>"),ADD(" </"_ATT_"> ")
	23561	"RTN","HMP DVSIT",249 ,0)
	23562	.. D ADD( "</"_ATT_" s>")
	23563	"RTN","HMP DVSIT",250 ,0)
	23564	. S X=$G( VISIT(ATT) ),Y="" Q:' $L(X)
	23565	"RTN","HMP DVSIT",251 ,0)
	23566	. S NAMES ="code^nam e^"_$S(ATT ="reason": "narrative ^",1:"")_" Z"
	23567	"RTN","HMP DVSIT",252 ,0)
	23568	. I X'["^ " S Y="<"_ ATT_" valu e='"_$$ESC ^HMPD(X)_" ' />" Q
	23569	"RTN","HMP DVSIT",253 ,0)
	23570	. I $L(X) >1 S Y="<" _ATT_" "_$ $LOOP_"/>"
	23571	"RTN","HMP DVSIT",254 ,0)
	23572	D ADD("</ visit>")
	23573	"RTN","HMP DVSIT",255 ,0)
	23574	Q
	23575	"RTN","HMP DVSIT",256 ,0)
	23576	;
	23577	"RTN","HMP DVSIT",257 ,0)
	23578	LOOP() ; - - build su b-items st ring from NAMES and X
	23579	"RTN","HMP DVSIT",258 ,0)
	23580	N STR,P,T AG S STR=" "
	23581	"RTN","HMP DVSIT",259 ,0)
	23582	F P=1:1 S TAG=$P(NA MES,U,P) Q :TAG="Z" I $L($P(X, U,P)) S ST R=STR_TAG_ "='"_$$ESC ^HMPD($P(X ,U,P))_"' "
	23583	"RTN","HMP DVSIT",260 ,0)
	23584	Q STR
	23585	"RTN","HMP DVSIT",261 ,0)
	23586	;
	23587	"RTN","HMP DVSIT",262 ,0)
	23588	ADD(X) ; - - Add a li ne @HMP@(n )=X
	23589	"RTN","HMP DVSIT",263 ,0)
	23590	S HMPI=$G (HMPI)+1
	23591	"RTN","HMP DVSIT",264 ,0)
	23592	S @HMP@(H MPI)=X
	23593	"RTN","HMP DVSIT",265 ,0)
	23594	Q
	23595	"RTN","HMP EASU")
	23596	0^79^B2903 6042
	23597	"RTN","HMP EASU",1,0)
	23598	HMPEASU ;S LC/GRR,ASM R/RRB - Se rve VistA reference data as JS ON via RPC ;10/18/12 6:26pm
	23599	"RTN","HMP EASU",2,0)
	23600	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	23601	"RTN","HMP EASU",3,0)
	23602	;Per VA D irective 6 402, this routine sh ould not b e modified .
	23603	"RTN","HMP EASU",4,0)
	23604	;
	23605	"RTN","HMP EASU",5,0)
	23606	Q
	23607	"RTN","HMP EASU",6,0)
	23608	;
	23609	"RTN","HMP EASU",7,0)
	23610	CLASS ; -- USR Class file #893 0
	23611	"RTN","HMP EASU",8,0)
	23612	N PRV S P RV=+$G(HMP LAST)
	23613	"RTN","HMP EASU",9,0)
	23614	S HMPCNT= $$TOTAL^HM PEF("^USR( 8930)")
	23615	"RTN","HMP EASU",10,0 )
	23616	I PRV=0 S PRV=.9
	23617	"RTN","HMP EASU",11,0 )
	23618	I $L(HMPI D) D CLS1( HMPID) Q
	23619	"RTN","HMP EASU",12,0 )
	23620	F S PRV= $O(^USR(89 30,PRV)) Q :PRV'>0 D CLS1(PRV) I HMPMAX, HMPI'<HMPM AX Q
	23621	"RTN","HMP EASU",13,0 )
	23622	I PRV'>0 S HMPFINI= 1
	23623	"RTN","HMP EASU",14,0 )
	23624	Q
	23625	"RTN","HMP EASU",15,0 )
	23626	;
	23627	"RTN","HMP EASU",16,0 )
	23628	CLS1(IEN) ;
	23629	"RTN","HMP EASU",17,0 )
	23630	N $ES,$ET ,ERRMSG
	23631	"RTN","HMP EASU",18,0 )
	23632	S ERRMSG= $$ERRMSG^H MPEF("User Class",IE N)
	23633	"RTN","HMP EASU",19,0 )
	23634	S $ET="D ERRHDLR^HM PDERRH"
	23635	"RTN","HMP EASU",20,0 )
	23636	N HMPV,FL DS,X,Y,INR EC
	23637	"RTN","HMP EASU",21,0 )
	23638	K HMPV S FLDS=".01: .05;1*"
	23639	"RTN","HMP EASU",22,0 )
	23640	D GETS^DI Q(8930,IEN _",",FLDS, "IEN","HMP V")
	23641	"RTN","HMP EASU",23,0 )
	23642	S Y=$NA(H MPV(8930,I EN_","))
	23643	"RTN","HMP EASU",24,0 )
	23644	S INREC(" name")=$G( @Y@(.01,"E "))
	23645	"RTN","HMP EASU",25,0 )
	23646	S INREC(" localId")= IEN,INREC( "uid")=$$S ETUID^HMPU TILS("asu- class",,IE N)
	23647	"RTN","HMP EASU",26,0 )
	23648	S INREC(" abbreviati on")=$G(@Y @(.02,"E") ),INREC("a ctive")=$S ($G(@Y@(.0 3,"I"))=1: "true",1:" false")
	23649	"RTN","HMP EASU",27,0 )
	23650	S INREC(" displayNam e")=$G(@Y@ (.04,"E"))
	23651	"RTN","HMP EASU",28,0 )
	23652	I $D(HMPV ("8930.01" )) D
	23653	"RTN","HMP EASU",29,0 )
	23654	. N IEN2, ID,CNT
	23655	"RTN","HMP EASU",30,0 )
	23656	. S IEN2= "",CNT=0
	23657	"RTN","HMP EASU",31,0 )
	23658	. F S IE N2=$O(HMPV (8930.01,I EN2)) Q:IE N2="" D
	23659	"RTN","HMP EASU",32,0 )
	23660	. . S CNT =CNT+1,INR EC("subCla ss",CNT,"n ame")=HMPV ("8930.01" ,IEN2,".01 ","E")
	23661	"RTN","HMP EASU",33,0 )
	23662	. . S ID= HMPV(8930. 01,IEN2,.0 1,"I"),INR EC("subCla ss",CNT,"u id")=$$SET UID^HMPUTI LS("asu-cl ass",,ID)
	23663	"RTN","HMP EASU",34,0 )
	23664	D ADD^HMP EF("INREC" ) S HMPLAS T=IEN
	23665	"RTN","HMP EASU",35,0 )
	23666	Q
	23667	"RTN","HMP EASU",36,0 )
	23668	;
	23669	"RTN","HMP EASU",37,0 )
	23670	RULE ; -- USR Author ization/Su bscription file #893 0.1
	23671	"RTN","HMP EASU",38,0 )
	23672	N PRV S P RV=+$G(HMP LAST)
	23673	"RTN","HMP EASU",39,0 )
	23674	S HMPCNT= $$TOTAL^HM PEF("^USR( 8930.1)")
	23675	"RTN","HMP EASU",40,0 )
	23676	I PRV=0 S PRV=.9
	23677	"RTN","HMP EASU",41,0 )
	23678	I $L(HMPI D) D RULE1 (HMPID) Q
	23679	"RTN","HMP EASU",42,0 )
	23680	F S PRV= $O(^USR(89 30.1,PRV)) Q:PRV'>0 D RULE1(P RV) I HMPM AX,HMPI'<H MPMAX Q
	23681	"RTN","HMP EASU",43,0 )
	23682	I PRV'>0 S HMPFINI= 1
	23683	"RTN","HMP EASU",44,0 )
	23684	Q
	23685	"RTN","HMP EASU",45,0 )
	23686	;
	23687	"RTN","HMP EASU",46,0 )
	23688	RULE1(IEN) ;
	23689	"RTN","HMP EASU",47,0 )
	23690	N $ES,$ET ,ERRMSG
	23691	"RTN","HMP EASU",48,0 )
	23692	S ERRMSG= $$ERRMSG^H MPEF("ASU Rule",IEN)
	23693	"RTN","HMP EASU",49,0 )
	23694	S $ET="D ERRHDLR^HM PDERRH"
	23695	"RTN","HMP EASU",50,0 )
	23696	N HMPV,FL DS,X,Y,INR EC,DESC
	23697	"RTN","HMP EASU",51,0 )
	23698	K HMPV S FLDS=".01: 1"
	23699	"RTN","HMP EASU",52,0 )
	23700	D GETS^DI Q(8930.1,I EN_",",FLD S,"IEN","H MPV")
	23701	"RTN","HMP EASU",53,0 )
	23702	S Y=$NA(H MPV(8930.1 ,IEN_","))
	23703	"RTN","HMP EASU",54,0 )
	23704	S INREC(" localId")= IEN,INREC( "uid")=$$S ETUID^HMPU TILS("asu- rule",,IEN )
	23705	"RTN","HMP EASU",55,0 )
	23706	S X=$G(@Y @(.01,"I") ) S:X INRE C("docDefU id")=$$SET UID^HMPUTI LS("doc-de f",,X),INR EC("docDef Name")=$G( @Y@(.01,"E "))
	23707	"RTN","HMP EASU",56,0 )
	23708	S X=$G(@Y @(.02,"I") ) S:X INRE C("statusU id")=$$SET UID^HMPUTI LS("doc-st atus",,X), INREC("sta tusName")= $G(@Y@(.02 ,"E"))
	23709	"RTN","HMP EASU",57,0 )
	23710	S X=$G(@Y @(.03,"I") ) S:X INRE C("actionU id")=$$SET UID^HMPUTI LS("doc-ac tion",,X), INREC("act ionName")= $G(@Y@(.03 ,"E"))
	23711	"RTN","HMP EASU",58,0 )
	23712	S X=$G(@Y @(.04,"I") ) S:X INRE C("userCla ssUid")=$$ SETUID^HMP UTILS("asu -class",,X ),INREC("u serClassNa me")=$G(@Y @(.04,"E") )
	23713	"RTN","HMP EASU",59,0 )
	23714	S X=$G(@Y @(.05,"I") ),INREC("i sAnd")=$S( X="&":"tru e",1:"fals e") ;,INRE C("isOr")= $S(X="!":" true",1:"f alse")
	23715	"RTN","HMP EASU",60,0 )
	23716	S X=$G(@Y @(.06,"I") ) S:X INRE C("userRol eUid")=$$S ETUID^HMPU TILS("asu- role",,X), INREC("use rRoleName" )=$G(@Y@(. 06,"E"))
	23717	"RTN","HMP EASU",61,0 )
	23718	I $D(@Y@( 1)) D
	23719	"RTN","HMP EASU",62,0 )
	23720	. N I S I =0 F S I= $O(@Y@(1,I )) Q:I<1 S DESC(I)= @Y@(1,I)
	23721	"RTN","HMP EASU",63,0 )
	23722	. S INREC ("descript ion")=$$ST RING^HMPD( .DESC)
	23723	"RTN","HMP EASU",64,0 )
	23724	D ADD^HMP EF("INREC" ) S HMPLAS T=IEN
	23725	"RTN","HMP EASU",65,0 )
	23726	Q
	23727	"RTN","HMP EASU",66,0 )
	23728	;
	23729	"RTN","HMP EASU",67,0 )
	23730	DEF ; -- T IU Documen t Definiti on file #8 925.1
	23731	"RTN","HMP EASU",68,0 )
	23732	N PRV S P RV=+$G(HMP LAST)
	23733	"RTN","HMP EASU",69,0 )
	23734	S HMPCNT= $$TOTAL^HM PEF("^TIU( 8925.1)")
	23735	"RTN","HMP EASU",70,0 )
	23736	I PRV=0 S PRV=.9
	23737	"RTN","HMP EASU",71,0 )
	23738	I $L(HMPI D) D DEF1( HMPID) Q
	23739	"RTN","HMP EASU",72,0 )
	23740	F S PRV= $O(^TIU(89 25.1,PRV)) Q:PRV'>0 D DEF1(PR V) I HMPMA X,HMPI'<HM PMAX Q ;I CR 2700 DE 2818 ASF 1 1/21/15
	23741	"RTN","HMP EASU",73,0 )
	23742	I PRV'>0 S HMPFINI= 1
	23743	"RTN","HMP EASU",74,0 )
	23744	Q
	23745	"RTN","HMP EASU",75,0 )
	23746	;
	23747	"RTN","HMP EASU",76,0 )
	23748	DEF1(IEN) ;
	23749	"RTN","HMP EASU",77,0 )
	23750	N $ES,$ET ,ERRMSG
	23751	"RTN","HMP EASU",78,0 )
	23752	S ERRMSG= $$ERRMSG^H MPEF("TIU Doc Def",I EN)
	23753	"RTN","HMP EASU",79,0 )
	23754	S $ET="D ERRHDLR^HM PDERRH"
	23755	"RTN","HMP EASU",80,0 )
	23756	N HMPV,FL DS,X,Y,I,I NREC
	23757	"RTN","HMP EASU",81,0 )
	23758	K HMPV S FLDS=".01: .14;1501"
	23759	"RTN","HMP EASU",82,0 )
	23760	D GETS^DI Q(8925.1,I EN_",",FLD S,"IEN","H MPV")
	23761	"RTN","HMP EASU",83,0 )
	23762	S Y=$NA(H MPV(8925.1 ,IEN_","))
	23763	"RTN","HMP EASU",84,0 )
	23764	S INREC(" name")=$G( @Y@(.01,"E "))
	23765	"RTN","HMP EASU",85,0 )
	23766	S INREC(" uid")=$$SE TUID^HMPUT ILS("doc-d ef",,IEN)
	23767	"RTN","HMP EASU",86,0 )
	23768	S INREC(" abbreviati on")=$G(@Y @(.02,"E") )
	23769	"RTN","HMP EASU",87,0 )
	23770	S INREC(" displayNam e")=$G(@Y@ (.03,"E"))
	23771	"RTN","HMP EASU",88,0 )
	23772	S INREC(" typeName") =$G(@Y@(.0 4,"E"))
	23773	"RTN","HMP EASU",89,0 )
	23774	S INREC(" typeUid")= $$SETUID^H MPUTILS("d oc-type",, $G(@Y@(.04 ,"I")))
	23775	"RTN","HMP EASU",90,0 )
	23776	S X=$G(@Y @(.05,"I") ) I X D
	23777	"RTN","HMP EASU",91,0 )
	23778	. S INREC ("ownerUid ")=$$SETUI D^HMPUTILS ("user",,X )
	23779	"RTN","HMP EASU",92,0 )
	23780	. S INREC ("ownerNam e")=$G(@Y@ (.05,"E"))
	23781	"RTN","HMP EASU",93,0 )
	23782	S X=$G(@Y @(.06,"I") ) S:X INRE C("classOw ner")=$$SE TUID^HMPUT ILS("asu-c lass",,X)
	23783	"RTN","HMP EASU",94,0 )
	23784	S X=$G(@Y @(.07,"I") ) I X D
	23785	"RTN","HMP EASU",95,0 )
	23786	. S INREC ("statusUi d")=$$SETU ID^HMPUTIL S("doc-sta tus",,X)
	23787	"RTN","HMP EASU",96,0 )
	23788	. S INREC ("statusNa me")=$G(@Y @(.07,"E") )
	23789	"RTN","HMP EASU",97,0 )
	23790	S X=$G(@Y @(.1,"I")) S:X INREC ("shared") ="true"
	23791	"RTN","HMP EASU",98,0 )
	23792	S X=$G(@Y @(.13,"I") ) S:X INRE C("nationa lStandard" )="true"
	23793	"RTN","HMP EASU",99,0 )
	23794	S X=$G(@Y @(.14,"I") ) S:X INRE C("posting Code")=$$S ETUID^HMPU TILS("doc- posting",, X)
	23795	"RTN","HMP EASU",100, 0)
	23796	S I=0 F S I=$O(^TI U(8925.1,I EN,10,I)) Q:I<1 S X =+$G(^(I,0 )) D ;ICR 2700 DE28 18 ASF 11/ 21/15
	23797	"RTN","HMP EASU",101, 0)
	23798	. S INREC ("item",I, "uid")=$$S ETUID^HMPU TILS("doc- def",,X)
	23799	"RTN","HMP EASU",102, 0)
	23800	. S INREC ("item",I, "name")=$$ GET1^DIQ(8 925.1,X_", ",.01)
	23801	"RTN","HMP EASU",103, 0)
	23802	; nationa l title in fo
	23803	"RTN","HMP EASU",104, 0)
	23804	S X=$G(@Y @(1501,"I" )) I X D ;National Title + at tributes
	23805	"RTN","HMP EASU",105, 0)
	23806	. N IENS, TIU,DA,FNU M,NAME
	23807	"RTN","HMP EASU",106, 0)
	23808	. S IENS= X_"," D GE TS^DIQ(892 6.1,IENS," *","IE","T IU")
	23809	"RTN","HMP EASU",107, 0)
	23810	. S INREC ("national Title","vu id")="urn: va:vuid:"_ $G(TIU(892 6.1,IENS,9 9.99,"E"))
	23811	"RTN","HMP EASU",108, 0)
	23812	. S INREC ("national Title","na me")=$G(TI U(8926.1,I ENS,.01,"E "))
	23813	"RTN","HMP EASU",109, 0)
	23814	. F I=".0 4^Subject^ 2",".05^Ro le^3",".06 ^Setting^4 ",".07^Ser vice^5",". 08^Type^6" D
	23815	"RTN","HMP EASU",110, 0)
	23816	.. S DA=+ $G(TIU(892 6.1,IENS,+ I,"I")) Q: DA'>0
	23817	"RTN","HMP EASU",111, 0)
	23818	.. S FNUM ="8926."_+ $P(I,U,3), NAME=$$LOW ^XLFSTR($P (I,U,2))
	23819	"RTN","HMP EASU",112, 0)
	23820	.. S INRE C("nationa lTitle"_$P (I,U,2),"v uid")="urn :va:vuid:" _$$VUID^HM PD(DA,FNUM )
	23821	"RTN","HMP EASU",113, 0)
	23822	.. S INRE C("nationa lTitle"_$P (I,U,2),"n ame")=$G(T IU(8926.1, IENS,+I,"E "))
	23823	"RTN","HMP EASU",114, 0)
	23824	;
	23825	"RTN","HMP EASU",115, 0)
	23826	D ADD^HMP EF("INREC" ) S HMPLAS T=IEN
	23827	"RTN","HMP EASU",116, 0)
	23828	Q
	23829	"RTN","HMP EF")
	23830	0^80^B8625 4671
	23831	"RTN","HMP EF",1,0)
	23832	HMPEF ;SLC /MKB,ASMR/ RRB,JD,SRG - Serve V istA opera tional dat a as JSON via RPC;No v 24, 2015 16:00:27
	23833	"RTN","HMP EF",2,0)
	23834	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	23835	"RTN","HMP EF",3,0)
	23836	;Per VA D irective 6 402, this routine sh ould not b e modified .
	23837	"RTN","HMP EF",4,0)
	23838	;
	23839	"RTN","HMP EF",5,0)
	23840	; DE2818 - SQA find ings. Newe d L42 and L44 in LOC +1. RRB - 10/30/201 5
	23841	"RTN","HMP EF",6,0)
	23842	;
	23843	"RTN","HMP EF",7,0)
	23844	; ^SC ref erences - IA 10040, HOSPITAL L OCATION fi le (#44)
	23845	"RTN","HMP EF",8,0)
	23846	; ^DIC(42 ) referenc es - IA #1 0039, WARD LOCATION file
	23847	"RTN","HMP EF",9,0)
	23848	Q
	23849	"RTN","HMP EF",10,0)
	23850	;
	23851	"RTN","HMP EF",11,0)
	23852	; The fol lowing var iables can not be ne wed or kil led becaus e they are used
	23853	"RTN","HMP EF",12,0)
	23854	; from up stream by scope (NOT as input parameters ):
	23855	"RTN","HMP EF",13,0)
	23856	; HM PBATCH, HM PFADOM, HM PFLDON, HM PFZTSK, HM PMETA, HMP STMP, LEX( "LIST", an d ZTQUEUED .
	23857	"RTN","HMP EF",14,0)
	23858	GET(HMP,FI LTER) ; -- Return se arch resul ts as JSON in @HMP@( n)
	23859	"RTN","HMP EF",15,0)
	23860	; RPC = H MP GET OPE RATIONAL D ATA
	23861	"RTN","HMP EF",16,0)
	23862	; where F ILTER("dom ain") = n ame of des ired data type (see $$TAG)
	23863	"RTN","HMP EF",17,0)
	23864	; F ILTER("lim it") = m aximum num ber of ite ms to retu rn [opt]
	23865	"RTN","HMP EF",18,0)
	23866	; F ILTER("sta rt") = i en to star t search f rom [opt]
	23867	"RTN","HMP EF",19,0)
	23868	; F ILTER("id" ) = s ingle item id to ret urn [opt]
	23869	"RTN","HMP EF",20,0)
	23870	;
	23871	"RTN","HMP EF",21,0)
	23872	; HMPLAST - last re cord proce ssed
	23873	"RTN","HMP EF",22,0)
	23874	N HMPSYS, TYPE,HMPMA X,HMPI,HMP ID,HMPERR, HMPTN,HMPL AST,HMPCNT ,HMPFINI
	23875	"RTN","HMP EF",23,0)
	23876	S HMP=$NA (^TMP("HMP ",$J)),HMP I=0 K @HMP
	23877	"RTN","HMP EF",24,0)
	23878	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	23879	"RTN","HMP EF",25,0)
	23880	;
	23881	"RTN","HMP EF",26,0)
	23882	; parse & validate input para meters
	23883	"RTN","HMP EF",27,0)
	23884	S TYPE=$P ($G(FILTER ("domain") ),"#") ;,T YPE=$$LOW^ XLFSTR(TYP E)
	23885	"RTN","HMP EF",28,0)
	23886	S HMPMAX= +$G(FILTER ("limit")) ,HMPCNT=0
	23887	"RTN","HMP EF",29,0)
	23888	S HMPLAST =+$G(FILTE R("start") )
	23889	"RTN","HMP EF",30,0)
	23890	S HMPID=$ G(FILTER(" id"))
	23891	"RTN","HMP EF",31,0)
	23892	;
	23893	"RTN","HMP EF",32,0)
	23894	K ^TMP($J ,"HMP ERRO R")
	23895	"RTN","HMP EF",33,0)
	23896	;
	23897	"RTN","HMP EF",34,0)
	23898	; extract data
	23899	"RTN","HMP EF",35,0)
	23900	I TYPE="" S HMPERR= "Missing o r invalid reference type" G GT Q
	23901	"RTN","HMP EF",36,0)
	23902	; * con vert code below to u se $$HANDL E^XUSRB4 f or zero no de in ^XTM P, IA 4770 *
	23903	"RTN","HMP EF",37,0)
	23904	I $D(ZTQU EUED) S HM P=$NA(^XTM P(HMPBATCH ,HMPFZTSK, FILTER("do main"))) K @HMP
	23905	"RTN","HMP EF",38,0)
	23906	I TYPE="n ew",$L($T( EN^HMPEFX) ) D EN^HMP EFX(HMPID, HMPMAX) Q
	23907	"RTN","HMP EF",39,0)
	23908	S HMPTN=$ $TAG(TYPE) Q:'$L(HMP TN) ;D ER R(2) Q
	23909	"RTN","HMP EF",40,0)
	23910	D @HMPTN
	23911	"RTN","HMP EF",41,0)
	23912	;
	23913	"RTN","HMP EF",42,0)
	23914	GTQ ; add item count and termi nating cha racters
	23915	"RTN","HMP EF",43,0)
	23916	N ERROR I $D(^TMP($ J,"HMP ERR OR"))>0 D BUILDERR(. ERROR) S E RROR(1)=ER ROR(1)_"}"
	23917	"RTN","HMP EF",44,0)
	23918	I +$G(FIL TER("noHea d"))=1 D Q
	23919	"RTN","HMP EF",45,0)
	23920	.S @HMP@( "total")=+ $G(HMPI)
	23921	"RTN","HMP EF",46,0)
	23922	.S @HMP@( "last")=HM PLAST
	23923	"RTN","HMP EF",47,0)
	23924	.S @HMP@( "finished" )=+$G(HMPF INI)
	23925	"RTN","HMP EF",48,0)
	23926	.I $L($G( ERROR(1))) >1 S @HMP@ ("error")= ERROR(1)
	23927	"RTN","HMP EF",49,0)
	23928	I '$D(@HM P)!'$G(HMP I) D Q
	23929	"RTN","HMP EF",50,0)
	23930	.I '$D(^T MP($J,"HMP ERROR")) S @HMP@(1) ="""data"" :{""totalI tems"":0," "items"":[ ]}}" Q
	23931	"RTN","HMP EF",51,0)
	23932	.S @HMP@( 1)="""data "":{""tota lItems"":0 ,""items"" :[]},"
	23933	"RTN","HMP EF",52,0)
	23934	.M @HMP@( 2)=ERROR
	23935	"RTN","HMP EF",53,0)
	23936	;
	23937	"RTN","HMP EF",54,0)
	23938	I $D(@HMP ),$G(HMPI) D
	23939	"RTN","HMP EF",55,0)
	23940	. S @HMP@ (.5)="{""a piVersion" ":""1.01"" ,""data"": {""updated "":"""_$$H L7NOW_""", ""currentI temCount"" :"_HMPI
	23941	"RTN","HMP EF",56,0)
	23942	. S:$G(HM PCNT) @HMP @(.5)=@HMP @(.5)_","" totalItems "":"_HMPCN T
	23943	"RTN","HMP EF",57,0)
	23944	. S:$G(HM PLAST) @HM P@(.5)=@HM P@(.5)_"," "last"":"_ HMPLAST
	23945	"RTN","HMP EF",58,0)
	23946	. S @HMP@ (.5)=@HMP@ (.5)_",""i tems"":["
	23947	"RTN","HMP EF",59,0)
	23948	. S HMPI= HMPI+1,@HM P@(HMPI)=$ S($D(^TMP( $J,"HMP ER ROR"))>0:" ]}",1:"]}} ")
	23949	"RTN","HMP EF",60,0)
	23950	I $D(^TMP ($J,"HMP E RROR"))>0 S HMPI=HMP I+1,@HMP@( HMPI,.3)=" ," M @HMP@ (HMPI)=ERR OR ;S HMPI =HMPI+1,@H MP@(HMPI)= "}"
	23951	"RTN","HMP EF",61,0)
	23952	K ^TMP($J ,"HMP ERRO R")
	23953	"RTN","HMP EF",62,0)
	23954	Q
	23955	"RTN","HMP EF",63,0)
	23956	;
	23957	"RTN","HMP EF",64,0)
	23958	BUILDERR(R ESULT) ; error arra y
	23959	"RTN","HMP EF",65,0)
	23960	N CNT,COU NT,DOM,DOM CNT,ERRMSG ,ERROR,FIE LD,MESSAGE ,MSG,MSGCN T,T,TEMP
	23961	"RTN","HMP EF",66,0)
	23962	S COUNT=$ G(^TMP($J, "HMP ERROR ","# of Er rors"))
	23963	"RTN","HMP EF",67,0)
	23964	S MESSAGE ="A mumps error occu rred when extracting data. A t otal of "_ COUNT_" oc curred.\n\ r"
	23965	"RTN","HMP EF",68,0)
	23966	S CNT=1,E RROR("erro r","messag e","\",CNT )="A mumps error occ urred when extractin g patient data. A to tal of "_C OUNT_" occ urred.\n\r "
	23967	"RTN","HMP EF",69,0)
	23968	S MSGCNT= 0 F S MSG CNT=$O(^TM P($J,"HMP ERROR","ER ROR MESSAG E",MSGCNT) ) Q:MSGCNT '>0 D
	23969	"RTN","HMP EF",70,0)
	23970	. S CNT=C NT+1,MESSA GE=MESSAGE _$G(^TMP($ J,"HMP ERR OR","ERROR MESSAGE", MSGCNT))_" \n\r"
	23971	"RTN","HMP EF",71,0)
	23972	S RESULT( 1)="""erro r"":{""mes sage"":"_" """_MESSAG E_""""_"}"
	23973	"RTN","HMP EF",72,0)
	23974	Q
	23975	"RTN","HMP EF",73,0)
	23976	;
	23977	"RTN","HMP EF",74,0)
	23978	TAG(X) ; - - linetag for refere nce domain X
	23979	"RTN","HMP EF",75,0)
	23980	N Y S Y=" HMP",X=$G( X)
	23981	"RTN","HMP EF",76,0)
	23982	; default = HMP Obj ect (vario us types)
	23983	"RTN","HMP EF",77,0)
	23984	I X="loca tion" S Y="LOC"
	23985	"RTN","HMP EF",78,0)
	23986	I X="pt-s elect" S Y="PAT"
	23987	"RTN","HMP EF",79,0)
	23988	I X="pers on" S Y="NP"
	23989	"RTN","HMP EF",80,0)
	23990	I X="user " S Y="NP"
	23991	"RTN","HMP EF",81,0)
	23992	I X="labg roup" S Y="LABG RP"
	23993	"RTN","HMP EF",82,0)
	23994	I X="labp anel" S Y="LABP NL"
	23995	"RTN","HMP EF",83,0)
	23996	I X["orde rable" S Y="OI"
	23997	"RTN","HMP EF",84,0)
	23998	I X["sche dule" S Y="SCHE DULE"
	23999	"RTN","HMP EF",85,0)
	24000	I X["rout e" S Y="ROUT E"
	24001	"RTN","HMP EF",86,0)
	24002	I X["quic k" S Y="QO"
	24003	"RTN","HMP EF",87,0)
	24004	I X="disp layGroup" S Y="ODG"
	24005	"RTN","HMP EF",88,0)
	24006	I X["asu- " S Y="ASU"
	24007	"RTN","HMP EF",89,0)
	24008	I X["doc- " S Y="ASU"
	24009	"RTN","HMP EF",90,0)
	24010	I X="immu nization" S Y="IM MTYPE"
	24011	"RTN","HMP EF",91,0)
	24012	I X="alle rgy-list" S Y="ALLTYPE "
	24013	"RTN","HMP EF",92,0)
	24014	;I X="pro blem-list" S Y="PROB"
	24015	"RTN","HMP EF",93,0)
	24016	I X="sign -symptom" S Y="SIG NS"
	24017	"RTN","HMP EF",94,0)
	24018	I X="vita l-type" S Y="VT YPE"
	24019	"RTN","HMP EF",95,0)
	24020	I X="vita l-qualifie r" S Y="V QUAL"
	24021	"RTN","HMP EF",96,0)
	24022	I X="vita l-category " S Y="V CAT"
	24023	"RTN","HMP EF",97,0)
	24024	I X["clio term" S Y="MDTE RMS"
	24025	"RTN","HMP EF",98,0)
	24026	Q Y
	24027	"RTN","HMP EF",99,0)
	24028	;
	24029	"RTN","HMP EF",100,0)
	24030	ERR(X,VAL) ; return error mes sage
	24031	"RTN","HMP EF",101,0)
	24032	N MSG S MSG="Error "
	24033	"RTN","HMP EF",102,0)
	24034	I X=2 S MSG="Domai n type '"_ $G(VAL)_"' not recog nized"
	24035	"RTN","HMP EF",103,0)
	24036	I X=3 S MSG="UID ' "_$G(VAL)_ "' not fou nd"
	24037	"RTN","HMP EF",104,0)
	24038	I X=99 S MSG="Unkno wn request "
	24039	"RTN","HMP EF",105,0)
	24040	Q MSG
	24041	"RTN","HMP EF",106,0)
	24042	;
	24043	"RTN","HMP EF",107,0)
	24044	ERRMSG(X,V AL) ; -- r eturn erro r message
	24045	"RTN","HMP EF",108,0)
	24046	N Y S Y=" A MUMPS er ror occurr ed while e xtracting "_X_" data "
	24047	"RTN","HMP EF",109,0)
	24048	S:$G(VAL) Y=Y_", ie n "_VAL
	24049	"RTN","HMP EF",110,0)
	24050	Q Y
	24051	"RTN","HMP EF",111,0)
	24052	;
	24053	"RTN","HMP EF",112,0)
	24054	ERRQ ; -- Quit on er ror
	24055	"RTN","HMP EF",113,0)
	24056	Q
	24057	"RTN","HMP EF",114,0)
	24058	;
	24059	"RTN","HMP EF",115,0)
	24060	HL7NOW() ; -- Return current t ime in HL7 format
	24061	"RTN","HMP EF",116,0)
	24062	Q $P($$FM THL7^XLFDT ($$NOW^XLF DT),"-")
	24063	"RTN","HMP EF",117,0)
	24064	;
	24065	"RTN","HMP EF",118,0)
	24066	ALL() ;
	24067	"RTN","HMP EF",119,0)
	24068	Q "locati on;patient ;person;or derable;sc hedule;rou te;quick;d isplayGrou p;asu-clas s;asu-rule ;asu-role; doc-action ;doc-statu s;clioterm ;immunizat ion;allerg y-list;sig n-symptom; vital-type ;vital-qua lifier;vit al-categor y"
	24069	"RTN","HMP EF",120,0)
	24070	;
	24071	"RTN","HMP EF",121,0)
	24072	ADD(ITEM) ; -- add I TEM to @HM P@(HMPI)
	24073	"RTN","HMP EF",122,0)
	24074	N HMPY,HM PERR
	24075	"RTN","HMP EF",123,0)
	24076	I $G(HMPS TMP)]"" S @ITEM@("st ampTime")= HMPSTMP ; US6734
	24077	"RTN","HMP EF",124,0)
	24078	E S @ITE M@("stampT ime")=$$EN ^HMPSTMP(" NOW") ; DE 2616 - mus t add stam pTime to r eceive OPD freshness update fr om ADHOC^H MPUTIL1
	24079	"RTN","HMP EF",125,0)
	24080	D ENCODE^ HMPJSON(IT EM,"HMPY", "HMPERR")
	24081	"RTN","HMP EF",126,0)
	24082	I $D(HMPE RR) D ;re turn ERRor instead o f ITEM
	24083	"RTN","HMP EF",127,0)
	24084	. N HMPTM P,HMPTXT,H MPITM
	24085	"RTN","HMP EF",128,0)
	24086	. M HMPIT M=@ITEM K HMPY
	24087	"RTN","HMP EF",129,0)
	24088	. S HMPTX T(1)="Prob lem encodi ng json ou tput."
	24089	"RTN","HMP EF",130,0)
	24090	. D SETER ROR^HMPUTI LS(.HMPTMP ,.HMPERR,. HMPTXT,.HM PITM)
	24091	"RTN","HMP EF",131,0)
	24092	. K HMPER R D ENCODE ^HMPJSON(" HMPTMP","H MPY","HMPE RR")
	24093	"RTN","HMP EF",132,0)
	24094	I $D(HMPY ) D
	24095	"RTN","HMP EF",133,0)
	24096	. Q:'$D(@ ITEM@("uid "))
	24097	"RTN","HMP EF",134,0)
	24098	. I $G(HM PMETA) D A DD^HMPMETA ($P(HMPFAD OM,"#"),@I TEM@("uid" ),HMPSTMP) Q:HMPMETA =1 ;US673 4,US11019
	24099	"RTN","HMP EF",135,0)
	24100	. I HMPI D COMMA(HM PI)
	24101	"RTN","HMP EF",136,0)
	24102	. ;I HMPI ,'$G(FILTE R("noHead" )) D COMMA (HMPI)
	24103	"RTN","HMP EF",137,0)
	24104	. S HMPI= HMPI+1 M @ HMP@(HMPI) =HMPY
	24105	"RTN","HMP EF",138,0)
	24106	Q
	24107	"RTN","HMP EF",139,0)
	24108	;
	24109	"RTN","HMP EF",140,0)
	24110	COMMA(I) ; -- add co mma betwee n items
	24111	"RTN","HMP EF",141,0)
	24112	I $D(ZTQU EUED) Q
	24113	"RTN","HMP EF",142,0)
	24114	N J S J=+ $O(@HMP@(I ,"A"),-1) ;last sub- node for i tem I
	24115	"RTN","HMP EF",143,0)
	24116	S J=J+1,@ HMP@(I,J)= ","
	24117	"RTN","HMP EF",144,0)
	24118	Q
	24119	"RTN","HMP EF",145,0)
	24120	;
	24121	"RTN","HMP EF",146,0)
	24122	TOTAL(ROOT ) ; -- Ret urn total #items in @ROOT@(n)
	24123	"RTN","HMP EF",147,0)
	24124	Q $P($G(@ ROOT@(0)), U,4)
	24125	"RTN","HMP EF",148,0)
	24126	;
	24127	"RTN","HMP EF",149,0)
	24128	TEST(TYPE, ID,IN) ; - - test GET , write re sults to s creen
	24129	"RTN","HMP EF",150,0)
	24130	N OUT,IDX
	24131	"RTN","HMP EF",151,0)
	24132	S U="^"
	24133	"RTN","HMP EF",152,0)
	24134	S IN("dom ain")=$G(T YPE)
	24135	"RTN","HMP EF",153,0)
	24136	S:$D(ID) IN("id")=I D
	24137	"RTN","HMP EF",154,0)
	24138	D GET(.OU T,.IN)
	24139	"RTN","HMP EF",155,0)
	24140	;
	24141	"RTN","HMP EF",156,0)
	24142	S IDX=OUT
	24143	"RTN","HMP EF",157,0)
	24144	F S IDX= $Q(@IDX) Q :IDX'?1"^T MP(""HMP"" ,"1.N.E Q :+$P(IDX," ,",2)'=$J W !,@IDX
	24145	"RTN","HMP EF",158,0)
	24146	Q
	24147	"RTN","HMP EF",159,0)
	24148	;
	24149	"RTN","HMP EF",160,0)
	24150	; ** Refe rence file searches, using FIL TER("param eter")
	24151	"RTN","HMP EF",161,0)
	24152	;
	24153	"RTN","HMP EF",162,0)
	24154	PAT ;Patie nts
	24155	"RTN","HMP EF",163,0)
	24156	N DFN,PAT ,HMPPOPD
	24157	"RTN","HMP EF",164,0)
	24158	S HMPPOPD =1
	24159	"RTN","HMP EF",165,0)
	24160	S HMPCNT= $$TOTAL("^ DPT")
	24161	"RTN","HMP EF",166,0)
	24162	I $G(HMPI D) S DFN=+ HMPID D LK UP^HMPDJ00 Q
	24163	"RTN","HMP EF",167,0)
	24164	N ERRMSG S ERRMSG=" A mumps er ror occurr ed while e xtracting patients."
	24165	"RTN","HMP EF",168,0)
	24166	S DFN=+$G (HMPLAST) F S DFN=$ O(^DPT(DFN )) Q:DFN<1 D I HMP MAX>0,HMPI '<HMPMAX Q
	24167	"RTN","HMP EF",169,0)
	24168	. N $ES,$ ET
	24169	"RTN","HMP EF",170,0)
	24170	. S $ET=" D ERRHDLR^ HMPDERRH"
	24171	"RTN","HMP EF",171,0)
	24172	. I $P($G (^DPT(DFN, 0)),U)="" Q
	24173	"RTN","HMP EF",172,0)
	24174	. S ERRMS G=$$ERRMSG ("Patient" ,DFN)
	24175	"RTN","HMP EF",173,0)
	24176	. K PAT D LKUP^HMPD J00
	24177	"RTN","HMP EF",174,0)
	24178	. S HMPLA ST=DFN
	24179	"RTN","HMP EF",175,0)
	24180	I DFN<1 S HMPFINI=1
	24181	"RTN","HMP EF",176,0)
	24182	Q
	24183	"RTN","HMP EF",177,0)
	24184	LOC ; Hosp ital Locat ion (#44) and Ward L ocation (# 42) /DE28 18
	24185	"RTN","HMP EF",178,0)
	24186	D LOC^HMP EF1(.HMPFI NI,.HMPFLD ON,$G(HMPM ETA))
	24187	"RTN","HMP EF",179,0)
	24188	Q
	24189	"RTN","HMP EF",180,0)
	24190	;
	24191	"RTN","HMP EF",181,0)
	24192	ACTWRD(IEN ) ;Boolean TRUE if a ctive WARD LOCATION
	24193	"RTN","HMP EF",182,0)
	24194	; IEN - I EN in file 42
	24195	"RTN","HMP EF",183,0)
	24196	S D0=IEN D WIN^DGPM DDCF Q 'X ; SRG: ne ed DBIA
	24197	"RTN","HMP EF",184,0)
	24198	;
	24199	"RTN","HMP EF",185,0)
	24200	ACTLOC(LOC ) ;Boolean TRUE if a ctive hosp ital locat ion
	24201	"RTN","HMP EF",186,0)
	24202	; ^SC - I A 10040
	24203	"RTN","HMP EF",187,0)
	24204	N D0,X I +$G(^SC(LO C,"OOS")) Q 0 ; screen ou t OOS entr y
	24205	"RTN","HMP EF",188,0)
	24206	S D0=+$G( ^SC(LOC,42 )) I D0 D WIN^DGPMDD CF Q 'X ; chk out o f svc ward s
	24207	"RTN","HMP EF",189,0)
	24208	S X=$G(^S C(LOC,"I") ) I +X=0 Q 1 ; no inacti vate date
	24209	"RTN","HMP EF",190,0)
	24210	I DT>$P(X ,U)&($P(X, U,2)=""!(D T<$P(X,U,2 ))) Q 0 ; chk react ivate date
	24211	"RTN","HMP EF",191,0)
	24212	Q 1 ; must stil l be activ e
	24213	"RTN","HMP EF",192,0)
	24214	;
	24215	"RTN","HMP EF",193,0)
	24216	NP ;New Pe rsons
	24217	"RTN","HMP EF",194,0)
	24218	D NP^HMPE F1
	24219	"RTN","HMP EF",195,0)
	24220	Q
	24221	"RTN","HMP EF",196,0)
	24222	;
	24223	"RTN","HMP EF",197,0)
	24224	KEYS(IEN) ;user's ke ys
	24225	"RTN","HMP EF",198,0)
	24226	N HMPKEY, IENS,X,CNT
	24227	"RTN","HMP EF",199,0)
	24228	D GETS^DI Q(200,IEN_ ",","51*", "IE","HMPK EY") S CNT =0
	24229	"RTN","HMP EF",200,0)
	24230	S IENS="" F S IENS =$O(HMPKEY (200.051,I ENS)) Q:IE NS="" D
	24231	"RTN","HMP EF",201,0)
	24232	. S X=$G( HMPKEY(200 .051,IENS, .01,"E")), CNT=CNT+1
	24233	"RTN","HMP EF",202,0)
	24234	. S USER( "vistaKeys ",CNT,"nam e")=X
	24235	"RTN","HMP EF",203,0)
	24236	. S X=$G( HMPKEY(200 .051,IENS, 3,"I"))
	24237	"RTN","HMP EF",204,0)
	24238	. S:X USE R("vistaKe ys",CNT,"r eviewDate" )=$$JSONDT ^HMPUTILS( X)
	24239	"RTN","HMP EF",205,0)
	24240	Q
	24241	"RTN","HMP EF",206,0)
	24242	;
	24243	"RTN","HMP EF",207,0)
	24244	ODG ;
	24245	"RTN","HMP EF",208,0)
	24246	D ADDODG^ HMPCORD4
	24247	"RTN","HMP EF",209,0)
	24248	Q
	24249	"RTN","HMP EF",210,0)
	24250	;
	24251	"RTN","HMP EF",211,0)
	24252	OI ;
	24253	"RTN","HMP EF",212,0)
	24254	D OI^HMPC ORD4("PS^R AP^LRT")
	24255	"RTN","HMP EF",213,0)
	24256	Q
	24257	"RTN","HMP EF",214,0)
	24258	;
	24259	"RTN","HMP EF",215,0)
	24260	PROB ;get problem li st OPD sto re
	24261	"RTN","HMP EF",216,0)
	24262	D PROB^HM PEF1(.HMPF INI,LEX)
	24263	"RTN","HMP EF",217,0)
	24264	Q
	24265	"RTN","HMP EF",218,0)
	24266	;
	24267	"RTN","HMP EF",219,0)
	24268	QO ;
	24269	"RTN","HMP EF",220,0)
	24270	D QO^HMPC ORD4
	24271	"RTN","HMP EF",221,0)
	24272	Q
	24273	"RTN","HMP EF",222,0)
	24274	;
	24275	"RTN","HMP EF",223,0)
	24276	SCHEDULE ;
	24277	"RTN","HMP EF",224,0)
	24278	N RESULT
	24279	"RTN","HMP EF",225,0)
	24280	D ADDSCH^ HMPCORD4
	24281	"RTN","HMP EF",226,0)
	24282	Q
	24283	"RTN","HMP EF",227,0)
	24284	;
	24285	"RTN","HMP EF",228,0)
	24286	ROUTE ;
	24287	"RTN","HMP EF",229,0)
	24288	N RESULT
	24289	"RTN","HMP EF",230,0)
	24290	D ADDROUT E^HMPCORD4
	24291	"RTN","HMP EF",231,0)
	24292	Q
	24293	"RTN","HMP EF",232,0)
	24294	;
	24295	"RTN","HMP EF",233,0)
	24296	HMP ; HMP Objects
	24297	"RTN","HMP EF",234,0)
	24298	N IEN
	24299	"RTN","HMP EF",235,0)
	24300	S HMPCNT= $$TOTAL("^ HMP(800000 .11)")
	24301	"RTN","HMP EF",236,0)
	24302	I $L(HMPI D) D Q
	24303	"RTN","HMP EF",237,0)
	24304	. I HMPID =+HMPID S IEN=HMPID
	24305	"RTN","HMP EF",238,0)
	24306	. E S IE N=+$O(^HMP (800000.11 ,"B",HMPID ,0))
	24307	"RTN","HMP EF",239,0)
	24308	. S ERRMS G=$$ERRMSG ("HMP Obje ct",IEN)
	24309	"RTN","HMP EF",240,0)
	24310	. D:IEN H MP1^HMPDJ0 2(800000.1 1,IEN)
	24311	"RTN","HMP EF",241,0)
	24312	S IEN=+$G (HMPLAST) F S IEN=$ O(^HMP(800 000.11,"C" ,TYPE,IEN) ) Q:IEN<1 D I HMPM AX>0,HMPI' <HMPMAX Q
	24313	"RTN","HMP EF",242,0)
	24314	. S ERRMS G=$$ERRMSG ("HMP Obje ct",IEN)
	24315	"RTN","HMP EF",243,0)
	24316	. D HMP1^ HMPDJ02(80 0000.11,IE N) S HMPLA ST=IEN
	24317	"RTN","HMP EF",244,0)
	24318	I IEN<1 S HMPFINI=1
	24319	"RTN","HMP EF",245,0)
	24320	Q
	24321	"RTN","HMP EF",246,0)
	24322	;
	24323	"RTN","HMP EF",247,0)
	24324	SOURCE(SRC ) ;
	24325	"RTN","HMP EF",248,0)
	24326	N X S X=" "
	24327	"RTN","HMP EF",249,0)
	24328	I SRC["SC (" S X="clini c"
	24329	"RTN","HMP EF",250,0)
	24330	I SRC["DP T(" S X="patie nt"
	24331	"RTN","HMP EF",251,0)
	24332	I SRC["DI C(42" S X="ward"
	24333	"RTN","HMP EF",252,0)
	24334	I SRC["SC TM" S X="pcmm"
	24335	"RTN","HMP EF",253,0)
	24336	I SRC["OR (100.21" S X="cprs"
	24337	"RTN","HMP EF",254,0)
	24338	I SRC["DI C(45.7" S X="speci alty"
	24339	"RTN","HMP EF",255,0)
	24340	I SRC["VA (200" S X="provi der"
	24341	"RTN","HMP EF",256,0)
	24342	I SRC["PX RM(810.4" S X="pxrm"
	24343	"RTN","HMP EF",257,0)
	24344	Q X
	24345	"RTN","HMP EF",258,0)
	24346	;
	24347	"RTN","HMP EF",259,0)
	24348	ASU ; ASU files
	24349	"RTN","HMP EF",260,0)
	24350	N X,RTN S X=$P($G(T YPE),"-",2 )
	24351	"RTN","HMP EF",261,0)
	24352	S RTN=$$U P^XLFSTR(X )_"^HMPEAS U"
	24353	"RTN","HMP EF",262,0)
	24354	I X'="",$ L($T(@RTN) ) D @RTN
	24355	"RTN","HMP EF",263,0)
	24356	Q
	24357	"RTN","HMP EF",264,0)
	24358	;
	24359	"RTN","HMP EF",265,0)
	24360	MDTERMS ; CP Termino logy
	24361	"RTN","HMP EF",266,0)
	24362	D:$L($T(T ERM^HMPMDU TL)) TERM^ HMPMDUTL
	24363	"RTN","HMP EF",267,0)
	24364	Q
	24365	"RTN","HMP EF",268,0)
	24366	LABGRP ;
	24367	"RTN","HMP EF",269,0)
	24368	D SHWCUMR 2^HMPELAB
	24369	"RTN","HMP EF",270,0)
	24370	Q
	24371	"RTN","HMP EF",271,0)
	24372	LABPNL ;
	24373	"RTN","HMP EF",272,0)
	24374	D SHWORPN L^HMPELAB
	24375	"RTN","HMP EF",273,0)
	24376	Q
	24377	"RTN","HMP EF",274,0)
	24378	;
	24379	"RTN","HMP EF",275,0)
	24380	;DE2818, changed re ference to ^VA(201) to a FileM an call
	24381	"RTN","HMP EF",276,0)
	24382	ISPROXY(IE N) ; Boole an functio n, is NEW PERSON ent ry an APPL ICATION PR OXY?
	24383	"RTN","HMP EF",277,0)
	24384	N APP,HMP MSG,HMPUCL S,T,V
	24385	"RTN","HMP EF",278,0)
	24386	; APP - r eturned va lue
	24387	"RTN","HMP EF",279,0)
	24388	; HMPUCLS - user cl ass array
	24389	"RTN","HMP EF",280,0)
	24390	; HMPMSG - FileMan message ar ray
	24391	"RTN","HMP EF",281,0)
	24392	;
	24393	"RTN","HMP EF",282,0)
	24394	D GETS^DI Q(200,IEN_ ",","9.5*" ,"E","HMPU CLS","HMPM SG") ; ge t external format
	24395	"RTN","HMP EF",283,0)
	24396	S APP=0,T ="APPLICAT ION PROXY" ,V="HMPUCL S"
	24397	"RTN","HMP EF",284,0)
	24398	; search returned a rray for v alue equal to T
	24399	"RTN","HMP EF",285,0)
	24400	F S V=$Q (@V) Q:V=" "!APP S:@ V=T APP=1
	24401	"RTN","HMP EF",286,0)
	24402	Q APP
	24403	"RTN","HMP EF",287,0)
	24404	;
	24405	"RTN","HMP EF",288,0)
	24406	IMMTYPE ;i mmunizatio n types
	24407	"RTN","HMP EF",289,0)
	24408	D IMMTYPE ^HMPCORD5
	24409	"RTN","HMP EF",290,0)
	24410	Q
	24411	"RTN","HMP EF",291,0)
	24412	;
	24413	"RTN","HMP EF",292,0)
	24414	SIGNS ;SIG NS/SYMPTON S file
	24415	"RTN","HMP EF",293,0)
	24416	D SIGNS^H MPCORD5
	24417	"RTN","HMP EF",294,0)
	24418	Q
	24419	"RTN","HMP EF",295,0)
	24420	;
	24421	"RTN","HMP EF",296,0)
	24422	ALLTYPE ;a llergy-lis t types
	24423	"RTN","HMP EF",297,0)
	24424	;BL;REMOV E FROM ODS
	24425	"RTN","HMP EF",298,0)
	24426	;D ALLTYP E^HMPCORD5
	24427	"RTN","HMP EF",299,0)
	24428	Q
	24429	"RTN","HMP EF",300,0)
	24430	;
	24431	"RTN","HMP EF",301,0)
	24432	VTYPE ;vit al types
	24433	"RTN","HMP EF",302,0)
	24434	D VTYPE^H MPCORD5
	24435	"RTN","HMP EF",303,0)
	24436	Q
	24437	"RTN","HMP EF",304,0)
	24438	;
	24439	"RTN","HMP EF",305,0)
	24440	VQUAL ;vit al qualifi ers
	24441	"RTN","HMP EF",306,0)
	24442	D VQUAL^H MPCORD5
	24443	"RTN","HMP EF",307,0)
	24444	Q
	24445	"RTN","HMP EF",308,0)
	24446	;
	24447	"RTN","HMP EF",309,0)
	24448	VCAT ;vita l categori es
	24449	"RTN","HMP EF",310,0)
	24450	D VCAT^HM PCORD5
	24451	"RTN","HMP EF",311,0)
	24452	Q
	24453	"RTN","HMP EF",312,0)
	24454	;
	24455	"RTN","HMP EF",313,0)
	24456	FILENAME ; text of f ilenames f or search treeview
	24457	"RTN","HMP EF",314,0)
	24458	;;VA Alle rgies File
	24459	"RTN","HMP EF",315,0)
	24460	;;VA Alle rgies File (Synonyms ) SPACER ONLY - NOT DISPLAYED
	24461	"RTN","HMP EF",316,0)
	24462	;;Nationa l Drug Fil e - Generi c Drug Nam e
	24463	"RTN","HMP EF",317,0)
	24464	;;Nationa l Drug fil e - Trade Name
	24465	"RTN","HMP EF",318,0)
	24466	;;Local D rug File
	24467	"RTN","HMP EF",319,0)
	24468	;;Local D rug File ( Synonyms) SPACER ON LY - NOT D ISPLAYED
	24469	"RTN","HMP EF",320,0)
	24470	;;Drug In gredients File
	24471	"RTN","HMP EF",321,0)
	24472	;;VA Drug Class Fil e
	24473	"RTN","HMP EF",322,0)
	24474	;;
	24475	"RTN","HMP EF1")
	24476	0^147^B362 68404
	24477	"RTN","HMP EF1",1,0)
	24478	HMPEF1 ;SL C/MKB,ASMR /RRB,JD,SR G - Serve VistA oper ational da ta as JSON via RPC;N ov 24, 201 5 13:17:46
	24479	"RTN","HMP EF1",2,0)
	24480	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	24481	"RTN","HMP EF1",3,0)
	24482	;Per VA D irective 6 402, this routine sh ould not b e modified .
	24483	"RTN","HMP EF1",4,0)
	24484	;
	24485	"RTN","HMP EF1",5,0)
	24486	; HMPEF ( cont'd)
	24487	"RTN","HMP EF1",6,0)
	24488	;
	24489	"RTN","HMP EF1",7,0)
	24490	LOC(HMPFIN I,HMPFLDON ,HMPMETA) ; Hospital Location (#44) and Ward Locat ion (#42) /DE2818
	24491	"RTN","HMP EF1",8,0)
	24492	N L42,L44
	24493	"RTN","HMP EF1",9,0)
	24494	;BL;DE218 8 This lin e tag has to make tw o complete passes th rough
	24495	"RTN","HMP EF1",10,0)
	24496	;the two FOR loops. In order to do this it is nec essary to clearly
	24497	"RTN","HMP EF1",11,0)
	24498	;define t he loop we are doing . The file 44 and
	24499	"RTN","HMP EF1",12,0)
	24500	;file 42 loops cann ot be done at the sa me time
	24501	"RTN","HMP EF1",13,0)
	24502	;
	24503	"RTN","HMP EF1",14,0)
	24504	; Need va riables to clearly d efine whic h pass we are on.
	24505	"RTN","HMP EF1",15,0)
	24506	;
	24507	"RTN","HMP EF1",16,0)
	24508	; HMPFLDO N indicate s the loop
	24509	"RTN","HMP EF1",17,0)
	24510	; HMPFLDO N=0 means we are on L44
	24511	"RTN","HMP EF1",18,0)
	24512	; HMPFLDO N=1 means we are on L42
	24513	"RTN","HMP EF1",19,0)
	24514	;
	24515	"RTN","HMP EF1",20,0)
	24516	S HMPCNT= $$TOTAL^HM PEF("^SC") +$$TOTAL^H MPEF("^DIC (42)") ; t otal file counts wil l be inacc urate for location d omain
	24517	"RTN","HMP EF1",21,0)
	24518	;
	24519	"RTN","HMP EF1",22,0)
	24520	;BL/CPC - Handle si ngle locat ion or war d for rest art
	24521	"RTN","HMP EF1",23,0)
	24522	I $G(HMPI D) I $G(HM PID)'["w" D LOC44(HM PID) Q
	24523	"RTN","HMP EF1",24,0)
	24524	I $D(HMPI D) I $G(HM PID)["w" D LOC42($TR (HMPID,"w" ,"")) Q
	24525	"RTN","HMP EF1",25,0)
	24526	;
	24527	"RTN","HMP EF1",26,0)
	24528	;BL/CPC - determine if locati on or ward for resta rt
	24529	"RTN","HMP EF1",27,0)
	24530	I '$G(HMP FLDON) S L 44=+$G(HMP LAST),L42= 0 ; HMPFL DON=0 mean s we are o n L44
	24531	"RTN","HMP EF1",28,0)
	24532	I $G(HMPF LDON) S L4 4=0,L42=+$ G(HMPLAST) ; HMPFL DON=1 mean s we are o n L42
	24533	"RTN","HMP EF1",29,0)
	24534	; ^SC - I A 10040
	24535	"RTN","HMP EF1",30,0)
	24536	I '$G(HMP FLDON) F S L44=$O(^ SC(L44)) Q :L44<1 D LOC44(L44) I HMPMAX> 0,HMPI'<HM PMAX Q ;B L/cpc
	24537	"RTN","HMP EF1",31,0)
	24538	I HMPMAX> 0,HMPI'<HM PMAX Q ;B L/CPC prev ents drop through
	24539	"RTN","HMP EF1",32,0)
	24540	I $G(HMPM ETA)'=1 S HMPFLDON=1 ;BL/cpc m ark locati ons comple te ;US1101 9
	24541	"RTN","HMP EF1",33,0)
	24542	; ^DIC(42 ) - IA 100 39 DE2818
	24543	"RTN","HMP EF1",34,0)
	24544	F S L42= $O(^DIC(42 ,L42)) Q:L 42<1 D LO C42(L42) I HMPMAX>0, HMPI'<HMPM AX Q ;BL/ cpc
	24545	"RTN","HMP EF1",35,0)
	24546	I (L44<1) &(L42<1) S HMPFINI=1 ;BL/cpc - fix boole an error
	24547	"RTN","HMP EF1",36,0)
	24548	Q
	24549	"RTN","HMP EF1",37,0)
	24550	;
	24551	"RTN","HMP EF1",38,0)
	24552	LOC44(IEN) ; get one hospital location
	24553	"RTN","HMP EF1",39,0)
	24554	N $ES,$ET ,ERRMSG
	24555	"RTN","HMP EF1",40,0)
	24556	S ERRMSG= $$ERRMSG^H MPEF("Loca tion",IEN)
	24557	"RTN","HMP EF1",41,0)
	24558	S $ET="D ERRHDLR^HM PDERRH"
	24559	"RTN","HMP EF1",42,0)
	24560	N LOC,X0, X,Y
	24561	"RTN","HMP EF1",43,0)
	24562	; if loca tion is a WARD, igno re because file #42 will be us ed for war ds
	24563	"RTN","HMP EF1",44,0)
	24564	S X0=$G(^ SC(IEN,0)) I $P(X0,U ,3)="W" Q ; ^SC - I A 10040
	24565	"RTN","HMP EF1",45,0)
	24566	S LOC("na me")=$P(X0 ,U)
	24567	"RTN","HMP EF1",46,0)
	24568	S LOC("lo calId")=IE N,LOC("uid ")=$$SETUI D^HMPUTILS ("location ",,IEN)
	24569	"RTN","HMP EF1",47,0)
	24570	S X=$P(X0 ,U,2) S:$L (X) LOC("s hortName") =X S LOC(" type")=$P( X0,U,3)
	24571	"RTN","HMP EF1",48,0)
	24572	S LOC("re fId")=IEN, LOC("oos") =$S(+$G(^S C(IEN,"OOS ")):"true" ,1:"false" )
	24573	"RTN","HMP EF1",49,0)
	24574	S X=+$P(X 0,U,4) I X D
	24575	"RTN","HMP EF1",50,0)
	24576	. S Y=$$N S^XUAF4(X) ,X=$P(Y,U, 2)_U_$P(Y, U)
	24577	"RTN","HMP EF1",51,0)
	24578	. D FACIL ITY^HMPUTI LS(X,"LOC" )
	24579	"RTN","HMP EF1",52,0)
	24580	I '$$ACTL OC^HMPEF(I EN) S LOC( "inactive" )="true"
	24581	"RTN","HMP EF1",53,0)
	24582	D ADD^HMP EF("LOC") S HMPLAST= IEN
	24583	"RTN","HMP EF1",54,0)
	24584	Q
	24585	"RTN","HMP EF1",55,0)
	24586	;
	24587	"RTN","HMP EF1",56,0)
	24588	LOC42(IEN) ; get one ward loca tion
	24589	"RTN","HMP EF1",57,0)
	24590	; IEN - f ile 42 IEN
	24591	"RTN","HMP EF1",58,0)
	24592	; referen ces to ^DI C(42) via IA #10039
	24593	"RTN","HMP EF1",59,0)
	24594	;
	24595	"RTN","HMP EF1",60,0)
	24596	N $ES,$ET ,DIV,ERRMS G
	24597	"RTN","HMP EF1",61,0)
	24598	S ERRMSG= $$ERRMSG^H MPEF("Ward Location" ,IEN)
	24599	"RTN","HMP EF1",62,0)
	24600	S $ET="D ERRHDLR^HM PDERRH"
	24601	"RTN","HMP EF1",63,0)
	24602	N LOC,X,X 0,Y
	24603	"RTN","HMP EF1",64,0)
	24604	S X0=$G(^ DIC(42,IEN ,0))
	24605	"RTN","HMP EF1",65,0)
	24606	S:$G(^DIC (42,IEN,0) )'="" LOC( "name")=$P (^DIC(42,I EN,0),U) ;IA #10039
	24607	"RTN","HMP EF1",66,0)
	24608	S LOC("lo calId")=IE N,LOC("uid ")=$$SETUI D^HMPUTILS ("location ",,"w"_IEN ) ; wards have a "w "
	24609	"RTN","HMP EF1",67,0)
	24610	S LOC("ty pe")="W" ; always ' W' for war d
	24611	"RTN","HMP EF1",68,0)
	24612	S LOC("re fId")=IEN
	24613	"RTN","HMP EF1",69,0)
	24614	S LOC("oo s")="false " ; occasi on of serv ice is alw ays false for ward l ocations
	24615	"RTN","HMP EF1",70,0)
	24616	S DIV=+$P (X0,U,11)
	24617	"RTN","HMP EF1",71,0)
	24618	S X=+$P($ G(^DG(40.8 ,DIV,0)),U ,7) I X D ;ICR 417 DE2818 ASF 11/21/15
	24619	"RTN","HMP EF1",72,0)
	24620	. S Y=$$N S^XUAF4(X) ,X=$P(Y,U, 2)_U_$P(Y, U)
	24621	"RTN","HMP EF1",73,0)
	24622	. D FACIL ITY^HMPUTI LS(X,"LOC" )
	24623	"RTN","HMP EF1",74,0)
	24624	; out-of- service fl ag
	24625	"RTN","HMP EF1",75,0)
	24626	I '$$ACTW RD^HMPEF(I EN) S LOC( "inactive" )="true" ; boolean field only exists if ward is i nactive
	24627	"RTN","HMP EF1",76,0)
	24628	D ADD^HMP EF("LOC") S HMPLAST= IEN
	24629	"RTN","HMP EF1",77,0)
	24630	Q
	24631	"RTN","HMP EF1",78,0)
	24632	;
	24633	"RTN","HMP EF1",79,0)
	24634	NP ;New Pe rsons
	24635	"RTN","HMP EF1",80,0)
	24636	; Variabl es from HM PEF: HMPCN T,HMPID,HM PMAX,HMPI, HMPFINI
	24637	"RTN","HMP EF1",81,0)
	24638	N PRV
	24639	"RTN","HMP EF1",82,0)
	24640	S HMPCNT= $$TOTAL^HM PEF("^VA(2 00)") ; I A 10035
	24641	"RTN","HMP EF1",83,0)
	24642	I $G(HMPI D) D NP1(H MPID) Q
	24643	"RTN","HMP EF1",84,0)
	24644	S PRV=+$G (HMPLAST) ;$S(HMPLAS T:HMPLAST, 1:.9)
	24645	"RTN","HMP EF1",85,0)
	24646	I PRV=0 S PRV=.9
	24647	"RTN","HMP EF1",86,0)
	24648	F S PRV= $O(^VA(200 ,PRV)) Q:P RV<1 D NP 1(PRV) I H MPMAX>0,HM PI'<HMPMAX Q
	24649	"RTN","HMP EF1",87,0)
	24650	I PRV<1 S HMPFINI=1
	24651	"RTN","HMP EF1",88,0)
	24652	Q
	24653	"RTN","HMP EF1",89,0)
	24654	;
	24655	"RTN","HMP EF1",90,0)
	24656	NP1(IEN) ; one person
	24657	"RTN","HMP EF1",91,0)
	24658	N $ES,$ET ,ERRMSG
	24659	"RTN","HMP EF1",92,0)
	24660	S ERRMSG= $$ERRMSG^H MPEF("pers on",IEN)
	24661	"RTN","HMP EF1",93,0)
	24662	S $ET="D ERRHDLR^HM PDERRH"
	24663	"RTN","HMP EF1",94,0)
	24664	N HMPV,FL DS,USER,X, Y
	24665	"RTN","HMP EF1",95,0)
	24666	I $$ISPRO XY^HMPEF(I EN)=1 Q
	24667	"RTN","HMP EF1",96,0)
	24668	K HMPV S FLDS=".01; 4:9.2;9.5* ;19:53.8;6 54.3;.132: .138"
	24669	"RTN","HMP EF1",97,0)
	24670	D GETS^DI Q(200,IEN_ ",",FLDS," IEN","HMPV ")
	24671	"RTN","HMP EF1",98,0)
	24672	S Y=$NA(H MPV(200,IE N_","))
	24673	"RTN","HMP EF1",99,0)
	24674	S USER("n ame")=$G(@ Y@(.01,"E" ))
	24675	"RTN","HMP EF1",100,0 )
	24676	S USER("l ocalId")=I EN,USER("u id")=$$SET UID^HMPUTI LS("user", ,IEN)
	24677	"RTN","HMP EF1",101,0 )
	24678	S:$D(@Y@( 4)) USER(" genderCode ")="urn:va :gender:"_ @Y@(4,"I") ,USER("gen derName")= @Y@(4,"E")
	24679	"RTN","HMP EF1",102,0 )
	24680	S X=+$P($ G(@Y@(5,"I ")),".") S :X USER("d ateOfBirth ")=$$JSOND T^HMPUTILS (X)
	24681	"RTN","HMP EF1",103,0 )
	24682	S X=$G(@Y @(7,"I")) S:$L(X) US ER("disuse r")=$S(X:" true",1:"f alse")
	24683	"RTN","HMP EF1",104,0 )
	24684	S X=$G(@Y @(8,"E")) S:$L(X) US ER("title" )=X
	24685	"RTN","HMP EF1",105,0 )
	24686	S X=$G(@Y @(9,"E")) S:$L(X) US ER("ssn")= X
	24687	"RTN","HMP EF1",106,0 )
	24688	S X=$G(@Y @(9.2,"I") ) S:$L(X) USER("term inated")=$ $JSONDT^HM PUTILS(X)
	24689	"RTN","HMP EF1",107,0 )
	24690	S X=+$G(@ Y@(19,"I") ) S:X USER ("delegate Code")=$$S ETUID^HMPU TILS("user ",,X),USER ("delegate Name")=$G( @Y@(19,"E" ))
	24691	"RTN","HMP EF1",108,0 )
	24692	S X=$G(@Y @(29,"E")) S:$L(X) U SER("servi ce")=X
	24693	"RTN","HMP EF1",109,0 )
	24694	S X=$G(@Y @(53.5,"E" )) S:$L(X) USER("pro viderClass ")=X
	24695	"RTN","HMP EF1",110,0 )
	24696	S X=$G(@Y @(53.6,"E" )) S:$L(X) USER("pro viderType" )=X
	24697	"RTN","HMP EF1",111,0 )
	24698	S X=+$G(@ Y@(654.3," I")) S:X U SER("surro gateCode") =$$SETUID^ HMPUTILS(" user",,X), USER("surr ogateName" )=$G(@Y@(6 54.3,"E"))
	24699	"RTN","HMP EF1",112,0 )
	24700	S X=$G(@Y @(.132,"E" )) S:$L(X) USER("off icePhone") =X
	24701	"RTN","HMP EF1",113,0 )
	24702	S X=$G(@Y @(.133,"E" )) S:$L(X) USER("pho ne3")=X
	24703	"RTN","HMP EF1",114,0 )
	24704	S X=$G(@Y @(.134,"E" )) S:$L(X) USER("pho ne4")=X
	24705	"RTN","HMP EF1",115,0 )
	24706	S X=$G(@Y @(.135,"E" )) S:$L(X) USER("com mercialPho ne")=X
	24707	"RTN","HMP EF1",116,0 )
	24708	S X=$G(@Y @(.136,"E" )) S:$L(X) USER("fax ")=X
	24709	"RTN","HMP EF1",117,0 )
	24710	S X=$G(@Y @(.137,"E" )) S:$L(X) USER("voi cePager")= X
	24711	"RTN","HMP EF1",118,0 )
	24712	S X=$G(@Y @(.138,"E" )) S:$L(X) USER("dig italPager" )=X
	24713	"RTN","HMP EF1",119,0 )
	24714	D KEYS^HM PEF(IEN)
	24715	"RTN","HMP EF1",120,0 )
	24716	D ADD^HMP EF("USER") S HMPLAST =IEN
	24717	"RTN","HMP EF1",121,0 )
	24718	Q
	24719	"RTN","HMP EF1",122,0 )
	24720	;
	24721	"RTN","HMP EF1",123,0 )
	24722	PROB(HMPFI NI,LEX) ;g et problem list OPD store
	24723	"RTN","HMP EF1",124,0 )
	24724	N APP,ORA PP,ORDT,OR ELEM,ORWLS T,IEN,ELEM ENT,PLIST, HMPCNT,HMP LAST,LST
	24725	"RTN","HMP EF1",125,0 )
	24726	S (ORWLST ,ORDT,OREL EM)=""
	24727	"RTN","HMP EF1",126,0 )
	24728	S ORDT=DT
	24729	"RTN","HMP EF1",127,0 )
	24730	S IEN=0,H MPCNT=0
	24731	"RTN","HMP EF1",128,0 )
	24732	S LST=$NA (^TMP("ORL EX",$J))
	24733	"RTN","HMP EF1",129,0 )
	24734	S APP="GM PX"
	24735	"RTN","HMP EF1",130,0 )
	24736	D CONFIG^ LEXSET(APP ,"PLS",ORD T)
	24737	"RTN","HMP EF1",131,0 )
	24738	S (HMPCNT ,HMPLAST)= 0
	24739	"RTN","HMP EF1",132,0 )
	24740	; ^LEX(75 7.01) - IA 1571 DE28 18 ASF 11/ 21/15
	24741	"RTN","HMP EF1",133,0 )
	24742	F S IEN= $O(^LEX(75 7.01,IEN)) Q:IEN=""! (IEN'?1N.N ) D
	24743	"RTN","HMP EF1",134,0 )
	24744	. S ORELE M=$G(^LEX( 757.01,IEN ,0))
	24745	"RTN","HMP EF1",135,0 )
	24746	. Q:'$D(^ LEX(757.01 ,IEN,1))
	24747	"RTN","HMP EF1",136,0 )
	24748	. D LOOK^ LEXA(ORELE M,,1,,ORDT )
	24749	"RTN","HMP EF1",137,0 )
	24750	. S ELEME NT=$G(LEX( "LIST",1))
	24751	"RTN","HMP EF1",138,0 )
	24752	. Q:ELEME NT=""
	24753	"RTN","HMP EF1",139,0 )
	24754	. S ELEME NT=$$LEXXF RM^ORQQPL4 (ELEMENT,O RDT,"GMPX" )
	24755	"RTN","HMP EF1",140,0 )
	24756	. S PLIST ("uid")=$$ SETUID^HMP UTILS("pro blem-list" ,"",IEN)
	24757	"RTN","HMP EF1",141,0 )
	24758	. S PLIST ("lexIen") =$P(ELEMEN T,"^",1)
	24759	"RTN","HMP EF1",142,0 )
	24760	. S PLIST ("lexName" )=$P(ELEME NT,"^",2)
	24761	"RTN","HMP EF1",143,0 )
	24762	. S PLIST ("icd")=$P (ELEMENT," ^",3)
	24763	"RTN","HMP EF1",144,0 )
	24764	. S PLIST ("icdIen") =$P(ELEMEN T,"^",4)
	24765	"RTN","HMP EF1",145,0 )
	24766	. S PLIST ("codeSys" )=$P(ELEME NT,"^",5)
	24767	"RTN","HMP EF1",146,0 )
	24768	. S PLIST ("cCode")= $P(ELEMENT ,"^",6)
	24769	"RTN","HMP EF1",147,0 )
	24770	. S PLIST ("dCode")= $P(ELEMENT ,"^",7)
	24771	"RTN","HMP EF1",148,0 )
	24772	. S PLIST ("impDt")= $P(ELEMENT ,"^",8)
	24773	"RTN","HMP EF1",149,0 )
	24774	. S HMPCN T=HMPCNT+1 D ADD^HMP EF("PLIST" ) S HMPLAS T=HMPCNT
	24775	"RTN","HMP EF1",150,0 )
	24776	. Q
	24777	"RTN","HMP EF1",151,0 )
	24778	S HMPFINI =1
	24779	"RTN","HMP EF1",152,0 )
	24780	Q
	24781	"RTN","HMP EF1",153,0 )
	24782	;
	24783	"RTN","HMP EFSG")
	24784	1^173
	24785	"RTN","HMP EFSP")
	24786	1^174
	24787	"RTN","HMP EFST")
	24788	1^175
	24789	"RTN","HMP EFX")
	24790	0^84^B8398 930
	24791	"RTN","HMP EFX",1,0)
	24792	HMPEFX ;SL C/MKB,ASMR /RRB - Ref erence dat a update;7 /19/12 2:2 6pm
	24793	"RTN","HMP EFX",2,0)
	24794	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	24795	"RTN","HMP EFX",3,0)
	24796	;Per VA D irective 6 402, this routine sh ould not b e modified .
	24797	"RTN","HMP EFX",4,0)
	24798	;
	24799	"RTN","HMP EFX",5,0)
	24800	; Externa l Referenc es DBIA#
	24801	"RTN","HMP EFX",6,0)
	24802	; ------- ---------- -- -----
	24803	"RTN","HMP EFX",7,0)
	24804	; ^DPT 10035
	24805	"RTN","HMP EFX",8,0)
	24806	; MPIF001 2701
	24807	"RTN","HMP EFX",9,0)
	24808	; XLFSTR 10104
	24809	"RTN","HMP EFX",10,0)
	24810	Q
	24811	"RTN","HMP EFX",11,0)
	24812	;
	24813	"RTN","HMP EFX",12,0)
	24814	EN(LAST,MA X) ; -- ge t data fro m ^XTMP("H MPEF-<date >",n)
	24815	"RTN","HMP EFX",13,0)
	24816	;[MAX not used yet]
	24817	"RTN","HMP EFX",14,0)
	24818	N X,Y,HMP TOTL,DOMCN T,TYPE,NAM E,RTN,HMPI D
	24819	"RTN","HMP EFX",15,0)
	24820	S LAST=$G (LAST) D G ETLIST(LAS T)
	24821	"RTN","HMP EFX",16,0)
	24822	G ENQ:$G( ^TMP("HMPX ",$J,0))<1 ;no data
	24823	"RTN","HMP EFX",17,0)
	24824	;
	24825	"RTN","HMP EFX",18,0)
	24826	S (HMPTOT L,DOMCNT)= 0
	24827	"RTN","HMP EFX",19,0)
	24828	S TYPE="" F S TYPE =$O(^TMP(" HMPX",$J,T YPE)) Q:TY PE="" D
	24829	"RTN","HMP EFX",20,0)
	24830	. S NAME= $$LOW^XLFS TR(TYPE)
	24831	"RTN","HMP EFX",21,0)
	24832	. S RTN=$ $TAG^HMPEF (NAME)_"^H MPEF" Q:'$ L($T(@RTN) )
	24833	"RTN","HMP EFX",22,0)
	24834	. S DOMCN T=DOMCNT+1
	24835	"RTN","HMP EFX",23,0)
	24836	. ;
	24837	"RTN","HMP EFX",24,0)
	24838	. N HMP,H MPI
	24839	"RTN","HMP EFX",25,0)
	24840	. S HMP=$ NA(^TMP("H MP",$J,DOM CNT)),HMPI =0,HMPID=" "
	24841	"RTN","HMP EFX",26,0)
	24842	. F S HM PID=$O(^TM P("HMPX",$ J,TYPE,HMP ID)) Q:HMP ID="" D
	24843	"RTN","HMP EFX",27,0)
	24844	.. D @RTN S HMPTOTL =HMPTOTL+1
	24845	"RTN","HMP EFX",28,0)
	24846	. ;
	24847	"RTN","HMP EFX",29,0)
	24848	. I 'HMPI S DOMCNT= DOMCNT-1 Q ;no dat a, or erro r
	24849	"RTN","HMP EFX",30,0)
	24850	. S:DOMCN T>1 @HMP@( .3)=","
	24851	"RTN","HMP EFX",31,0)
	24852	. S @HMP@ (.5)="{""d omainName" ":"""_NAME _""",""tot al"":"_HMP I_",""item s"":["
	24853	"RTN","HMP EFX",32,0)
	24854	. S HMPI= HMPI+1,@HM P@(HMPI)=" ]}"
	24855	"RTN","HMP EFX",33,0)
	24856	;
	24857	"RTN","HMP EFX",34,0)
	24858	ENQ ;
	24859	"RTN","HMP EFX",35,0)
	24860	S Y=$G(^T MP("HMPX", $J,0)) K ^ TMP("HMPX" ,$J)
	24861	"RTN","HMP EFX",36,0)
	24862	I '$G(DOM CNT) S @HM P@(.5)="{" "apiVersio n"":""1.01 "",""data" ":{""lastU pdate"":"" "_LAST_""" ,""totalIt ems"":0,"" items"":[] }}" Q
	24863	"RTN","HMP EFX",37,0)
	24864	;
	24865	"RTN","HMP EFX",38,0)
	24866	S @HMP@(. 5)="{""api Version"": ""1.01""," "data"":{" "lastUpdat e"":"""_Y_ """,""tota lItems"":" _DOMCNT_", ""items"": ["
	24867	"RTN","HMP EFX",39,0)
	24868	S HMPI=DO MCNT I $D( ^TMP($J,"H MP ERROR") ) D
	24869	"RTN","HMP EFX",40,0)
	24870	. N ERROR ,CNT
	24871	"RTN","HMP EFX",41,0)
	24872	. D BUILD ERR^HMPEF( .ERROR)
	24873	"RTN","HMP EFX",42,0)
	24874	. S HMPI= HMPI+1,@HM P@(HMPI)=" ,",CNT=0
	24875	"RTN","HMP EFX",43,0)
	24876	. F S CN T=$O(ERROR (CNT)) Q:C NT'>0 S H MPI=HMPI+1 ,@HMP@(HMP I)=ERROR(C NT)
	24877	"RTN","HMP EFX",44,0)
	24878	. K ^TMP( $J,"HMP ER ROR")
	24879	"RTN","HMP EFX",45,0)
	24880	S HMPI=HM PI+1,@HMP@ (HMPI)="]} }"
	24881	"RTN","HMP EFX",46,0)
	24882	Q
	24883	"RTN","HMP EFX",47,0)
	24884	;
	24885	"RTN","HMP EFX",48,0)
	24886	GETLIST(LA ST) ; -- b uild list of updates for clien t
	24887	"RTN","HMP EFX",49,0)
	24888	; Returns ^TMP("HMP X",$J,0) = last DATE :SEQ inclu ded
	24889	"RTN","HMP EFX",50,0)
	24890	; ^TMP("HMP X",$J,TYPE ,ID)=ACT
	24891	"RTN","HMP EFX",51,0)
	24892	N DATE,SE Q,BEG,END, IDX,X0,DFN ,TYPE,ID,A CT
	24893	"RTN","HMP EFX",52,0)
	24894	K ^TMP("H MPX",$J)
	24895	"RTN","HMP EFX",53,0)
	24896	S DATE=+L AST,SEQ=+$ P(LAST,":" ,2)
	24897	"RTN","HMP EFX",54,0)
	24898	; generat e list ID, and end p oint
	24899	"RTN","HMP EFX",55,0)
	24900	S BEG=$NA (^XTMP("HM PEF-"_DATE ,SEQ)) ;init loop wher e left off
	24901	"RTN","HMP EFX",56,0)
	24902	; END=$Q( ^XTMP("HMP EF-"_(DT+1 ),9999999) ,-1) ;last node
	24903	"RTN","HMP EFX",57,0)
	24904	S END=+$O (^XTMP("HM PEF-"_DT," A"),-1) ;last node
	24905	"RTN","HMP EFX",58,0)
	24906	S ^TMP("H MPX",$J,0) =DT_":"_EN D ;date :seq
	24907	"RTN","HMP EFX",59,0)
	24908	;
	24909	"RTN","HMP EFX",60,0)
	24910	S IDX=BEG F S IDX= $Q(@IDX) Q :$$DONE D
	24911	"RTN","HMP EFX",61,0)
	24912	. S X0=@I DX,TYPE=$P (X0,U),ID= $P(X0,U,2) ,ACT=$P(X0 ,U,3)
	24913	"RTN","HMP EFX",62,0)
	24914	. I TYPE= ""!(ID="") Q ;error
	24915	"RTN","HMP EFX",63,0)
	24916	. S ^TMP( "HMPX",$J, TYPE,ID)=A CT
	24917	"RTN","HMP EFX",64,0)
	24918	Q
	24919	"RTN","HMP EFX",65,0)
	24920	;
	24921	"RTN","HMP EFX",66,0)
	24922	DONE() ; - - Return 1 or 0, if loop has f inished
	24923	"RTN","HMP EFX",67,0)
	24924	I IDX'?1" ^XTMP(""HM PEF-"7N.E Q 1 ;end of ^XTMP
	24925	"RTN","HMP EFX",68,0)
	24926	N D,N S D =+$P(IDX," -",2),N=+$ P(IDX,",", 2)
	24927	"RTN","HMP EFX",69,0)
	24928	; check H MP-DATE su bscript
	24929	"RTN","HMP EFX",70,0)
	24930	I D<DT Q 0 ;pri or day: ke ep going
	24931	"RTN","HMP EFX",71,0)
	24932	I D>DT Q 1 ;nex t day: st op loop
	24933	"RTN","HMP EFX",72,0)
	24934	; D=DT: c heck seque nce# subsc ript
	24935	"RTN","HMP EFX",73,0)
	24936	I N>END Q 1
	24937	"RTN","HMP EFX",74,0)
	24938	Q 0
	24939	"RTN","HMP EHL7")
	24940	0^85^B3570 530
	24941	"RTN","HMP EHL7",1,0)
	24942	HMPEHL7 ;S LC/MJK,ASM R/RRB - HM P HL7 ADT Message Pr ocessor;03 /25/2014 1 6:50:09
	24943	"RTN","HMP EHL7",2,0)
	24944	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	24945	"RTN","HMP EHL7",3,0)
	24946	;Per VA D irective 6 402, this routine sh ould not b e modified .
	24947	"RTN","HMP EHL7",4,0)
	24948	;
	24949	"RTN","HMP EHL7",5,0)
	24950	; DE2818 SQA Findin gs. Chang ed ADT ent ry to acce pt paramet ers ASMR/R RB
	24951	"RTN","HMP EHL7",6,0)
	24952	Q
	24953	"RTN","HMP EHL7",7,0)
	24954	;
	24955	"RTN","HMP EHL7",8,0)
	24956	ADT(HLFS,H LNEXT,HLNO DE,HLQUIT) ; -- main entry poi nt for the following HMP ADT c lient/rout er protoco ls:
	24957	"RTN","HMP EHL7",9,0)
	24958	; - HMP AD T-A04 CLIE NT protoco l
	24959	"RTN","HMP EHL7",10,0 )
	24960	; o su bscribes t o VAFC ADT -A04 SERVE R
	24961	"RTN","HMP EHL7",11,0 )
	24962	; - HMP AD T-A08 CLIE NT protoco l
	24963	"RTN","HMP EHL7",12,0 )
	24964	; o su bscribes t o VAFC ADT -A08 SERVE R
	24965	"RTN","HMP EHL7",13,0 )
	24966	;
	24967	"RTN","HMP EHL7",14,0 )
	24968	; Note: T hese varia bles are p rovided by the VistA HL7 syste m when a
	24969	"RTN","HMP EHL7",15,0 )
	24970	; s ubscriber protocol's ROUTING L OGIC is ca lled:
	24971	"RTN","HMP EHL7",16,0 )
	24972	; - HLNE XT
	24973	"RTN","HMP EHL7",17,0 )
	24974	; - HLQU IT
	24975	"RTN","HMP EHL7",18,0 )
	24976	; - HLNO DE
	24977	"RTN","HMP EHL7",19,0 )
	24978	; - HL(" FS")
	24979	"RTN","HMP EHL7",20,0 )
	24980	; - HL(" ECH")
	24981	"RTN","HMP EHL7",21,0 )
	24982	;
	24983	"RTN","HMP EHL7",22,0 )
	24984	; -- Filt ers ADT/A0 4(registra tion) & A0 8 (patient security level chan ge) events
	24985	"RTN","HMP EHL7",23,0 )
	24986	; Scan s for PID segment an d uses emb edded DFN
	24987	"RTN","HMP EHL7",24,0 )
	24988	; Sets ^XTMP("HM PFS~... fr eshness qu eue
	24989	"RTN","HMP EHL7",25,0 )
	24990	;
	24991	"RTN","HMP EHL7",26,0 )
	24992	NEW DONE, HMPSEG,HMP EVT
	24993	"RTN","HMP EHL7",27,0 )
	24994	SET DONE= 0
	24995	"RTN","HMP EHL7",28,0 )
	24996	FOR XECU TE HLNEXT QUIT:HLQUI T'>0 DO QUIT:DONE
	24997	"RTN","HMP EHL7",29,0 )
	24998	. SET HMP SEG=$EXTRA CT(HLNODE, 1,3)
	24999	"RTN","HMP EHL7",30,0 )
	25000	. ;
	25001	"RTN","HMP EHL7",31,0 )
	25002	. IF HMPS EG="EVN" D O QUIT
	25003	"RTN","HMP EHL7",32,0 )
	25004	. . SET H MPEVT=$PIE CE(HLNODE, HLFS,2)
	25005	"RTN","HMP EHL7",33,0 )
	25006	. . IF HM PEVT="A04" QUIT
	25007	"RTN","HMP EHL7",34,0 )
	25008	. . ; -- 97 reason = sensitiv e patient change occ urred
	25009	"RTN","HMP EHL7",35,0 )
	25010	. . IF HM PEVT="A08" ,$PIECE(HL NODE,HLFS, 5)=97 QUIT
	25011	"RTN","HMP EHL7",36,0 )
	25012	. . ; -- not an eve nt HMP is interested in so don e with mes sage
	25013	"RTN","HMP EHL7",37,0 )
	25014	. . SET D ONE=1
	25015	"RTN","HMP EHL7",38,0 )
	25016	. ; -- PI D segment always com es after E VN segment
	25017	"RTN","HMP EHL7",39,0 )
	25018	. IF HMPS EG'="PID" QUIT
	25019	"RTN","HMP EHL7",40,0 )
	25020	. SET DON E=1
	25021	"RTN","HMP EHL7",41,0 )
	25022	. ; -- HM PEVT shoul d always b e defined at this po int
	25023	"RTN","HMP EHL7",42,0 )
	25024	. IF $G(H MPEVT)="" QUIT
	25025	"RTN","HMP EHL7",43,0 )
	25026	. NEW DFN
	25027	"RTN","HMP EHL7",44,0 )
	25028	. SET DFN =+$PIECE($ PIECE(HLNO DE,HL("FS" ),4),$EXTR ACT(HL("EC H")))
	25029	"RTN","HMP EHL7",45,0 )
	25030	. IF 'DFN QUIT
	25031	"RTN","HMP EHL7",46,0 )
	25032	. DO POST X^HMPEVNT( "pt-select ",DFN_"&"_ HMPEVT) ; Ref File e vent
	25033	"RTN","HMP EHL7",47,0 )
	25034	. IF $DAT A(^HMP(800 000,"AITEM ",DFN)) DO POST^HMPE VNT(DFN,"p atient",DF N)
	25035	"RTN","HMP EHL7",48,0 )
	25036	QUIT
	25037	"RTN","HMP EHL7",49,0 )
	25038	;
	25039	"RTN","HMP ELAB")
	25040	0^86^B7483 676
	25041	"RTN","HMP ELAB",1,0)
	25042	HMPELAB ;S LC/JMC,ASM R/RRB - La b extract utilities; Nov 24, 20 15 13:08:2 3
	25043	"RTN","HMP ELAB",2,0)
	25044	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 1913 ;Build 63
	25045	"RTN","HMP ELAB",3,0)
	25046	;Per VA D irective 6 402, this routine sh ould not b e modified .
	25047	"RTN","HMP ELAB",4,0)
	25048	;
	25049	"RTN","HMP ELAB",5,0)
	25050	Q
	25051	"RTN","HMP ELAB",6,0)
	25052	;
	25053	"RTN","HMP ELAB",7,0)
	25054	SHWORPNL ; Ordering panels (en ds in "pan el")
	25055	"RTN","HMP ELAB",8,0)
	25056	;
	25057	"RTN","HMP ELAB",9,0)
	25058	;DE2818, ICR 2387, fields bei ng read ar e:
	25059	"RTN","HMP ELAB",10,0 )
	25060	; ^LAB(60 ,D0,0)= (# .01) NAME [1F] ^
	25061	"RTN","HMP ELAB",11,0 )
	25062	; ^LAB(60 ,D0,2,0)=^ 60.02P^^ (#200) LAB TEST INCL UDED IN PA NEL
	25063	"RTN","HMP ELAB",12,0 )
	25064	; ^LAB(60 ,D0,2,D1,0 )= (#.01) LAB TEST [ 1P:60] ^ ( #.02) AP M ULTIPLY FA CTOR [2N] ^
	25065	"RTN","HMP ELAB",13,0 )
	25066	;
	25067	"RTN","HMP ELAB",14,0 )
	25068	N X,COUNT ,LABDAT
	25069	"RTN","HMP ELAB",15,0 )
	25070	S X=$NA(^ LAB(60))
	25071	"RTN","HMP ELAB",16,0 )
	25072	F S X=$Q (@X) Q:($Q S(X,1)'=60 )!($QS(X,2 )'=+$QS(X, 2)) D
	25073	"RTN","HMP ELAB",17,0 )
	25074	. I $QS(X ,3)=0 D
	25075	"RTN","HMP ELAB",18,0 )
	25076	. . I $D( LABDAT),CO UNT>0 S HM PCNT=HMPCN T+1 D ADD^ HMPEF("LAB DAT") K LA BDAT
	25077	"RTN","HMP ELAB",19,0 )
	25078	. . S COU NT=0,LABDA T("name")= $P(@X,"^", 1),LABDAT( "uid")=$$S ETUID^HMPU TILS("labp anel","",$ QS(X,2))
	25079	"RTN","HMP ELAB",20,0 )
	25080	. I $QS(X ,3)=2,$QS( X,4)>0 D
	25081	"RTN","HMP ELAB",21,0 )
	25082	. . S LAB DAT("labs" ,$QS(X,4), "id")=@X,L ABDAT("lab s",$QS(X,4 ),"name")= $P(^LAB(60 ,+@X,0),"^ ",1),COUNT =COUNT+1
	25083	"RTN","HMP ELAB",22,0 )
	25084	I $D(LABD AT),COUNT> 0 S HMPCNT =HMPCNT+1 D ADD^HMPE F("LABDAT" ) K LABDAT
	25085	"RTN","HMP ELAB",23,0 )
	25086	S HMPFINI =1
	25087	"RTN","HMP ELAB",24,0 )
	25088	Q
	25089	"RTN","HMP ELAB",25,0 )
	25090	;
	25091	"RTN","HMP ELAB",26,0 )
	25092	SHWCUMR2 ; All Cumul ative Repo rts and th e labs the y point to (for UI p ick on lab s view)
	25093	"RTN","HMP ELAB",27,0 )
	25094	;
	25095	"RTN","HMP ELAB",28,0 )
	25096	;DE2818, fields be ing read a re:
	25097	"RTN","HMP ELAB",29,0 )
	25098	;^LAB(64. 5,D0,0)= ( #.01) NAME [1F] ^
	25099	"RTN","HMP ELAB",30,0 )
	25100	;^LAB(64. 5,D0,1,0)= ^64.51^^ (#10) MAJO R HEADER
	25101	"RTN","HMP ELAB",31,0 )
	25102	;^LAB(64. 5,D0,1,D1, 0)= (#.01) MAJOR HEA DER [1F] ^ (#5) MEDI CAL CENTER [2F] ^
	25103	"RTN","HMP ELAB",32,0 )
	25104	;^LAB(64. 5,D0,1,D1, 1,0)=^64.5 2I^^ (#10 ) MINOR HE ADER
	25105	"RTN","HMP ELAB",33,0 )
	25106	;^LAB(64. 5,D0,1,D1, 1,D2,0)= ( #.01) MINO R HEADER [ 1F] ^ (#1) PROFILE S ITE/SPECIM EN [2P:61] ^ (#2) TY PE OF DISP LAY [3S] ^ (#3)
	25107	"RTN","HMP ELAB",34,0 )
	25108	; ==>LO CALE FIELD [4S] ^
	25109	"RTN","HMP ELAB",35,0 )
	25110	;^LAB(64. 5,D0,1,D1, 1,D2,1,0)= ^64.53IP^^ (#10) LA B TEST
	25111	"RTN","HMP ELAB",36,0 )
	25112	;^LAB(64. 5,D0,1,D1, 1,D2,1,D3, 0)= (#.01) LAB TEST [1P:60] ^ (#1) TEST FIELD LENG TH [2N] ^ (#2) PRINT TEST NAME [3F] ^ (# 3) TEST
	25113	"RTN","HMP ELAB",37,0 )
	25114	; = =>PRINT CO DE [4F] ^ (#4) TEST LOCATION [ 5F] ^ (#5) DECIMAL P LACES [6N] ^
	25115	"RTN","HMP ELAB",38,0 )
	25116	; and
	25117	"RTN","HMP ELAB",39,0 )
	25118	;
	25119	"RTN","HMP ELAB",40,0 )
	25120	;^LAB(60, D0,0)= (#. 01) NAME [ 1F] ^
	25121	"RTN","HMP ELAB",41,0 )
	25122	;
	25123	"RTN","HMP ELAB",42,0 )
	25124	N X,LASTS UB,LASTLAB ,LABDAT
	25125	"RTN","HMP ELAB",43,0 )
	25126	S LASTSUB =0,LASTLAB =0,X=$NA(^ LAB(64.5,1 ,1))
	25127	"RTN","HMP ELAB",44,0 )
	25128	F S X=$Q (@X) Q:($Q S(X,4)="B" )!($QS(X,3 )'=1)!($QS (X,2)'=1)! ($QS(X,1)' =64.5) D
	25129	"RTN","HMP ELAB",45,0 )
	25130	. I $QS(X ,5)=0 D
	25131	"RTN","HMP ELAB",46,0 )
	25132	. . I $D( LABDAT) S HMPCNT=HMP CNT+1 D AD D^HMPEF("L ABDAT") K LABDAT
	25133	"RTN","HMP ELAB",47,0 )
	25134	. . S LAS TSUB=0,LAS TLAB=0,LAB DAT("name" )=$P(@X,"^ ",1)
	25135	"RTN","HMP ELAB",48,0 )
	25136	. I $QS(X ,7)=0 S LA STSUB=LAST SUB+1,LAST LAB=0,LABD AT("uid")= $$SETUID^H MPUTILS("l abgroup",, $QS(X,4)), LABDAT("gr oups",LAST SUB,"name" )=$P(@X,"^ ",1)
	25137	"RTN","HMP ELAB",49,0 )
	25138	. I $QS(X ,9)=0 D
	25139	"RTN","HMP ELAB",50,0 )
	25140	. . S LAS TLAB=LASTL AB+1
	25141	"RTN","HMP ELAB",51,0 )
	25142	. . S LAB DAT("group s",LASTSUB ,"labs",LA STLAB,"nam e")=$P(^LA B(60,$P(@X ,"^",1),0) ,"^",1)
	25143	"RTN","HMP ELAB",52,0 )
	25144	. . S LAB DAT("group s",LASTSUB ,"labs",LA STLAB,"id" )=$P(@X,"^ ",1)
	25145	"RTN","HMP ELAB",53,0 )
	25146	I $D(LABD AT) S HMPC NT=HMPCNT+ 1 D ADD^HM PEF("LABDA T") K LABD AT
	25147	"RTN","HMP ELAB",54,0 )
	25148	S HMPFINI =1
	25149	"RTN","HMP ELAB",55,0 )
	25150	Q
	25151	"RTN","HMP ELAB",56,0 )
	25152	LABPNL ; L ab orderin g panels
	25153	"RTN","HMP ELAB",57,0 )
	25154	; {name:p anelName,u id:panelUi d,labs:[{i d:labIEN,n ame:labNam e},...]}
	25155	"RTN","HMP ELAB",58,0 )
	25156	N IEN
	25157	"RTN","HMP ELAB",59,0 )
	25158	F S IEN= $O(^LAB(60 ,IEN)) Q:' IEN D
	25159	"RTN","HMP ELAB",60,0 )
	25160	. N X0,LA B
	25161	"RTN","HMP ELAB",61,0 )
	25162	. S X0=$G (^LAB(60,I EN,0))
	25163	"RTN","HMP ELAB",62,0 )
	25164	. Q:"IB"' [$P(X0,U,3 ) ; not for or dering
	25165	"RTN","HMP ELAB",63,0 )
	25166	. Q:'$O(^ LAB(60,IEN ,2,0)) ; not panel
	25167	"RTN","HMP ELAB",64,0 )
	25168	. S LAB(" name")=$P( X0,U)
	25169	"RTN","HMP ELAB",65,0 )
	25170	. S LAB(" uid")=$$SE TUID^HMPUT ILS("labpa nel","",IE N)
	25171	"RTN","HMP ELAB",66,0 )
	25172	. ; recur sively exp and to ind ividual te sts
	25173	"RTN","HMP ELAB",67,0 )
	25174	. D ADD^H MPEF("LAB" )
	25175	"RTN","HMP ELAB",68,0 )
	25176	I 'IEN S HMPFINI=1
	25177	"RTN","HMP ELAB",69,0 )
	25178	Q
	25179	"RTN","HMP ELAB",70,0 )
	25180	;
	25181	"RTN","HMP ELAB",71,0 )
	25182	;DE2818, code below removed a s it does nothing
	25183	"RTN","HMP ELAB",72,0 )
	25184	;LABGRP ; Lab group s on cumul ative repo rt
	25185	"RTN","HMP ELAB",73,0 )
	25186	; {name:g roupName,u id:groupUi d,labs:[{n ame:labNam e,id:labIE N},...]}
	25187	"RTN","HMP ELAB",74,0 )
	25188	;F S IEN =$O(^LAB(6 0,IEN)) Q: 'IEN D
	25189	"RTN","HMP ELAB",75,0 )
	25190	;. Q
	25191	"RTN","HMP ELAB",76,0 )
	25192	;Q
	25193	"RTN","HMP ENSZ")
	25194	1^176
	25195	"RTN","HMP ENSZ1")
	25196	1^177
	25197	"RTN","HMP EQ")
	25198	0^89^B2710 1202
	25199	"RTN","HMP EQ",1,0)
	25200	HMPEQ ;SLC /MJK,ASMR/ RRB - HMP Freshness Utilities; 02-JUL-201 4
	25201	"RTN","HMP EQ",2,0)
	25202	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	25203	"RTN","HMP EQ",3,0)
	25204	;Per VA D irective 6 402, this routine sh ould not b e modified .
	25205	"RTN","HMP EQ",4,0)
	25206	;
	25207	"RTN","HMP EQ",5,0)
	25208	Q
	25209	"RTN","HMP EQ",6,0)
	25210	;
	25211	"RTN","HMP EQ",7,0)
	25212	EN ; -- go to event queue view er (conven ience tag)
	25213	"RTN","HMP EQ",8,0)
	25214	D EN^HMPE QLM
	25215	"RTN","HMP EQ",9,0)
	25216	Q
	25217	"RTN","HMP EQ",10,0)
	25218	;
	25219	"RTN","HMP EQ",11,0)
	25220	EVTS(DATA, PARAMS) ; -- return events for server's last strea m in inver se sequenc e # order
	25221	"RTN","HMP EQ",12,0)
	25222	; input: PARAMS("se rver") := ien of 800 000
	25223	"RTN","HMP EQ",13,0)
	25224	; "fi lter") := event stat e filter [ P:process ed \| W:wai ting ]
	25225	"RTN","HMP EQ",14,0)
	25226	; "do main") := domain of interest o r "ALL'
	25227	"RTN","HMP EQ",15,0)
	25228	; "dfn") := dfn of des ired patie nt
	25229	"RTN","HMP EQ",16,0)
	25230	; "max") := max number events to return
	25231	"RTN","HMP EQ",17,0)
	25232	;
	25233	"RTN","HMP EQ",18,0)
	25234	; output: @DATA@("s tream") := name of s tream for server
	25235	"RTN","HMP EQ",19,0)
	25236	; " count") := number of events re turned
	25237	"RTN","HMP EQ",20,0)
	25238	; "events ",<n>,"seq uence") := sequence # / node i n stream f or event
	25239	"RTN","HMP EQ",21,0)
	25240	; "ev ents",<n>, "node") := event nod e for sequ ence
	25241	"RTN","HMP EQ",22,0)
	25242	;
	25243	"RTN","HMP EQ",23,0)
	25244	N STREAM, DOMAIN,FIL TER,PAT,SE Q,MAX,CNT, X
	25245	"RTN","HMP EQ",24,0)
	25246	S STREAM= $$LSTREAM^ HMPDJFSM(+ $G(PARAMS( "server")) )
	25247	"RTN","HMP EQ",25,0)
	25248	S DOMAIN= $G(PARAMS( "domain"))
	25249	"RTN","HMP EQ",26,0)
	25250	S FILTER= $G(PARAMS( "filter"))
	25251	"RTN","HMP EQ",27,0)
	25252	S PAT=+$G (PARAMS("d fn"))
	25253	"RTN","HMP EQ",28,0)
	25254	S MAX=$G( PARAMS("ma x"),10)
	25255	"RTN","HMP EQ",29,0)
	25256	S CNT=0
	25257	"RTN","HMP EQ",30,0)
	25258	S SEQ=" "
	25259	"RTN","HMP EQ",31,0)
	25260	F S SEQ= $O(^XTMP(S TREAM,SEQ) ,-1) Q:'SE Q S X=^(S EQ) D Q:C NT=MAX
	25261	"RTN","HMP EQ",32,0)
	25262	. I DOMAI N'="ALL",D OMAIN'=$P( X,"^",2) Q
	25263	"RTN","HMP EQ",33,0)
	25264	. ; quit if waiting and want processed
	25265	"RTN","HMP EQ",34,0)
	25266	. I FILTE R["P",'$P( X,"^",6) Q
	25267	"RTN","HMP EQ",35,0)
	25268	. ; quit if process ed and wan t waiting
	25269	"RTN","HMP EQ",36,0)
	25270	. I FILTE R["W",'$P( X,"^",6) Q
	25271	"RTN","HMP EQ",37,0)
	25272	. ; quit if not pat ient desir ed
	25273	"RTN","HMP EQ",38,0)
	25274	. I PAT,P AT'=+X Q
	25275	"RTN","HMP EQ",39,0)
	25276	. S CNT=C NT+1
	25277	"RTN","HMP EQ",40,0)
	25278	. S @DATA @("events" ,CNT,"sequ ence")=SEQ
	25279	"RTN","HMP EQ",41,0)
	25280	. S @DATA @("events" ,CNT,"node ")=X
	25281	"RTN","HMP EQ",42,0)
	25282	;
	25283	"RTN","HMP EQ",43,0)
	25284	S @DATA@( "stream")= STREAM
	25285	"RTN","HMP EQ",44,0)
	25286	S @DATA@( "count")=C NT
	25287	"RTN","HMP EQ",45,0)
	25288	Q
	25289	"RTN","HMP EQ",46,0)
	25290	;
	25291	"RTN","HMP EQ",47,0)
	25292	GETEVTS(RE T,PARAMS) ; -- get e vents for server's l ast stream in invers e sequence # order
	25293	"RTN","HMP EQ",48,0)
	25294	; RPC: HM PM EVT QUE GET EVTS (future)
	25295	"RTN","HMP EQ",49,0)
	25296	N HMPDATA ,HMPERR
	25297	"RTN","HMP EQ",50,0)
	25298	S HMPDATA =$NA(^TMP( "HMPM EVT QUE GET EV TS",$J))
	25299	"RTN","HMP EQ",51,0)
	25300	K @HMPDAT A
	25301	"RTN","HMP EQ",52,0)
	25302	D EVTS(HM PDATA,.PAR AMS)
	25303	"RTN","HMP EQ",53,0)
	25304	D ENCODE^ HMPJSON(HM PDATA,RET, "HMPERR")
	25305	"RTN","HMP EQ",54,0)
	25306	K @HMPDAT A
	25307	"RTN","HMP EQ",55,0)
	25308	Q
	25309	"RTN","HMP EQ",56,0)
	25310	;
	25311	"RTN","HMP EQ",57,0)
	25312	SRVS(DATA) ; -- loop thru & so rt by serv er names a nd return summary fr eshness qu eue info f or each
	25313	"RTN","HMP EQ",58,0)
	25314	; output: @D ATA@("serv ers",<n>," name") := serve r name
	25315	"RTN","HMP EQ",59,0)
	25316	; "serv er",<n>,"l astUpdate" ) := date server las t updated
	25317	"RTN","HMP EQ",60,0)
	25318	; "serv er",<n>,"r epeated") := how m any times updated
	25319	"RTN","HMP EQ",61,0)
	25320	; "serv er",<n>,"s tream") := strea m name
	25321	"RTN","HMP EQ",62,0)
	25322	; "serv er",<n>,"q ueueEnd") := curre nt end of queue
	25323	"RTN","HMP EQ",63,0)
	25324	; "server", <n>,"extra cts",<n>," domain") := domai n name
	25325	"RTN","HMP EQ",64,0)
	25326	; "server", <n>,"extra cts",<n>," tasks") := tasks waiting t o be proce ssed
	25327	"RTN","HMP EQ",65,0)
	25328	; "server", <n>,"extra cts",<n>," waiting") := how m any second s waiting
	25329	"RTN","HMP EQ",66,0)
	25330	; "server", <n>,"extra cts",<n>," lastCount" ) := last count retr ieved or < finished>
	25331	"RTN","HMP EQ",67,0)
	25332	;
	25333	"RTN","HMP EQ",68,0)
	25334	N HMPSRVN M,HMPCNT,I EN
	25335	"RTN","HMP EQ",69,0)
	25336	S HMPSRVN M=""
	25337	"RTN","HMP EQ",70,0)
	25338	S HMPCNT= 0
	25339	"RTN","HMP EQ",71,0)
	25340	F S HMPS RVNM=$O(^H MP(800000, "B",HMPSRV NM)) Q:HMP SRVNM="" S IEN=$O(^ (HMPSRVNM, "")) D
	25341	"RTN","HMP EQ",72,0)
	25342	. S HMPCN T=HMPCNT+1
	25343	"RTN","HMP EQ",73,0)
	25344	. D SRV($ NA(@DATA@( "servers", HMPCNT)),I EN)
	25345	"RTN","HMP EQ",74,0)
	25346	Q
	25347	"RTN","HMP EQ",75,0)
	25348	;
	25349	"RTN","HMP EQ",76,0)
	25350	SRV(DATA,S RV) ; -- p rocess one server
	25351	"RTN","HMP EQ",77,0)
	25352	N X0,ROOT ,BATCH,STR EAM,SRVNM, TASK,TASKS ,ENDQ,EXTR ACT,CNT
	25353	"RTN","HMP EQ",78,0)
	25354	S X0=$G(^ HMP(800000 ,SRV,0))
	25355	"RTN","HMP EQ",79,0)
	25356	Q:X0=""
	25357	"RTN","HMP EQ",80,0)
	25358	S SRVNM=$ P(X0,"^")
	25359	"RTN","HMP EQ",81,0)
	25360	S @DATA@( "name")=$P (X0,"^")
	25361	"RTN","HMP EQ",82,0)
	25362	S @DATA@( "lastUpdat e")=$P(X0, "^",2)
	25363	"RTN","HMP EQ",83,0)
	25364	S @DATA@( "repeated" )=$P(X0,"^ ",4)
	25365	"RTN","HMP EQ",84,0)
	25366	S STREAM= $$LSTREAM^ HMPDJFSM(S RV)
	25367	"RTN","HMP EQ",85,0)
	25368	S @DATA@( "stream")= STREAM
	25369	"RTN","HMP EQ",86,0)
	25370	S @DATA@( "queueEnd" )=$S($D(^X TMP(STREAM )):$P(STRE AM,"~",3)_ "-"_$G(^XT MP(STREAM, "last")),1 :"")
	25371	"RTN","HMP EQ",87,0)
	25372	;
	25373	"RTN","HMP EQ",88,0)
	25374	; -- loop thru extr acts for t his server
	25375	"RTN","HMP EQ",89,0)
	25376	S ROOT="H MPFX~"_SRV NM_"~"
	25377	"RTN","HMP EQ",90,0)
	25378	S BATCH=R OOT
	25379	"RTN","HMP EQ",91,0)
	25380	S CNT=0
	25381	"RTN","HMP EQ",92,0)
	25382	F S BATC H=$O(^XTMP (BATCH)) Q :$E(BATCH, 1,$L(ROOT) )'=ROOT D
	25383	"RTN","HMP EQ",93,0)
	25384	. S CNT=C NT+1
	25385	"RTN","HMP EQ",94,0)
	25386	. S @DATA @("extract s",CNT,"do main")=$P( BATCH,"~", 3)
	25387	"RTN","HMP EQ",95,0)
	25388	. S TASK= 0,TASKS=""
	25389	"RTN","HMP EQ",96,0)
	25390	. F S TA SK=$O(^XTM P(BATCH,0, "task",TAS K)) Q:'TAS K S TASKS =TASKS_$S( $L(TASKS): ",",1:"")_ TASK
	25391	"RTN","HMP EQ",97,0)
	25392	. S @DATA @("extract s",CNT,"ta sks")=TASK S
	25393	"RTN","HMP EQ",98,0)
	25394	. I '$D(^ XTMP(BATCH ,0,"wait") ) S @DATA@ ("extracts ",CNT,"wai ting")=$$W AIT^HMPDJF SM(BATCH) Q
	25395	"RTN","HMP EQ",99,0)
	25396	. S @DATA @("extract s",CNT,"la stCount")= $$LOBJ^HMP DJFSM(BATC H,TASK)
	25397	"RTN","HMP EQ",100,0)
	25398	Q
	25399	"RTN","HMP EQ",101,0)
	25400	;
	25401	"RTN","HMP EQ",102,0)
	25402	GETSRVS(RE T) ; -- ge t summary freshness event queu e info for all serve rs
	25403	"RTN","HMP EQ",103,0)
	25404	; RPC: HM PM EVT QUE GET SVRS (future)
	25405	"RTN","HMP EQ",104,0)
	25406	N HMPDATA ,HMPERR
	25407	"RTN","HMP EQ",105,0)
	25408	S HMPDATA =$NA(^TMP( "HMPM EVT QUE GET SV RS",$J))
	25409	"RTN","HMP EQ",106,0)
	25410	K @HMPDAT A
	25411	"RTN","HMP EQ",107,0)
	25412	D SRVS(HM PDATA)
	25413	"RTN","HMP EQ",108,0)
	25414	D ENCODE^ HMPJSON(HM PDATA,RET, "HMPERR")
	25415	"RTN","HMP EQ",109,0)
	25416	K @HMPDAT A
	25417	"RTN","HMP EQ",110,0)
	25418	Q
	25419	"RTN","HMP EQ",111,0)
	25420	;
	25421	"RTN","HMP EQ",112,0)
	25422	GLBS(DATA) ; -- retu rn summary info on H MP related temp glob als
	25423	"RTN","HMP EQ",113,0)
	25424	; output: @HMPDATA@ ( "xtmp Nodes",<n> ,"server") := se rver name
	25425	"RTN","HMP EQ",114,0)
	25426	; "xtmp Nodes",<n> ,"rootNode ") := ^X TMP root n ode for se rver/strea m
	25427	"RTN","HMP EQ",115,0)
	25428	; "xtmp Nodes",<n> ,"lastNode ") := la st sequenc e in root structure
	25429	"RTN","HMP EQ",116,0)
	25430	;
	25431	"RTN","HMP EQ",117,0)
	25432	; "tmpJ obNodes",< n>,"rootNo de") := ro ot ^TMP("H MP*",$J) n ode
	25433	"RTN","HMP EQ",118,0)
	25434	; "tmpJ obNodes",< n>,"lastNo de") := la st sequenc e in root structure
	25435	"RTN","HMP EQ",119,0)
	25436	;
	25437	"RTN","HMP EQ",120,0)
	25438	; "jobT mpNodes",< n>,"rootNo de") := ro ot ^TMP($J ,"HMP*") n ode
	25439	"RTN","HMP EQ",121,0)
	25440	; "jobT mpNodes",< n>,"lastNo de") := la st sequenc e in root structure
	25441	"RTN","HMP EQ",122,0)
	25442	;
	25443	"RTN","HMP EQ",123,0)
	25444	N HMPX,CN T,J,Y,RNOD E
	25445	"RTN","HMP EQ",124,0)
	25446	S HMPX="V PQ~"
	25447	"RTN","HMP EQ",125,0)
	25448	S CNT=0
	25449	"RTN","HMP EQ",126,0)
	25450	F S HMPX =$O(^XTMP( HMPX)) Q:$ E(HMPX,1,3 )'="HMP" D
	25451	"RTN","HMP EQ",127,0)
	25452	. S CNT=C NT+1
	25453	"RTN","HMP EQ",128,0)
	25454	. S @DATA @("xtmpNod es",CNT,"s erver")=$P (HMPX,"~", 2)
	25455	"RTN","HMP EQ",129,0)
	25456	. S @DATA @("xtmpNod es",CNT,"r ootNode")= "^XTMP(""" _HMPX_""") "
	25457	"RTN","HMP EQ",130,0)
	25458	. S Y=$O( ^XTMP(HMPX ," "),-1)
	25459	"RTN","HMP EQ",131,0)
	25460	. S:'$L(Y ) Y=$O(^XT MP(HMPX,"" ),-1)
	25461	"RTN","HMP EQ",132,0)
	25462	. S @DATA @("xtmpNod es",CNT,"l astNode")= Y
	25463	"RTN","HMP EQ",133,0)
	25464	;
	25465	"RTN","HMP EQ",134,0)
	25466	S HMPX="V PQ~"
	25467	"RTN","HMP EQ",135,0)
	25468	S CNT=0
	25469	"RTN","HMP EQ",136,0)
	25470	F S HMPX =$O(^TMP(H MPX)) Q:$E (HMPX,1,3) '="HMP" D
	25471	"RTN","HMP EQ",137,0)
	25472	. S J=0
	25473	"RTN","HMP EQ",138,0)
	25474	. F S J= $O(^TMP(HM PX,J)) Q:' J D
	25475	"RTN","HMP EQ",139,0)
	25476	. . ; -- don't incl ude this r eport's ^T MP
	25477	"RTN","HMP EQ",140,0)
	25478	. . S RNO DE="^TMP(" ""_HMPX_"" ","_J_")"
	25479	"RTN","HMP EQ",141,0)
	25480	. . I RNO DE=DATA,J= $J Q
	25481	"RTN","HMP EQ",142,0)
	25482	. . S CNT =CNT+1
	25483	"RTN","HMP EQ",143,0)
	25484	. . S @DA TA@("tmpJo bNodes",CN T,"rootNod e")=RNODE
	25485	"RTN","HMP EQ",144,0)
	25486	. . S Y=$ O(^TMP(HMP X,J," "),- 1)
	25487	"RTN","HMP EQ",145,0)
	25488	. . S:'$L (Y) Y=$O(^ TMP(HMPX,J ,""),-1)
	25489	"RTN","HMP EQ",146,0)
	25490	. . S @DA TA@("tmpJo bNodes",CN T,"lastNod e")=Y
	25491	"RTN","HMP EQ",147,0)
	25492	;
	25493	"RTN","HMP EQ",148,0)
	25494	S (J,CNT) =0
	25495	"RTN","HMP EQ",149,0)
	25496	F S J=$O (^TMP(J)) Q:'J D
	25497	"RTN","HMP EQ",150,0)
	25498	. S HMPX= "VPQ~"
	25499	"RTN","HMP EQ",151,0)
	25500	. F S HM PX=$O(^TMP (J,HMPX)) Q:$E(HMPX, 1,3)'="HMP " D
	25501	"RTN","HMP EQ",152,0)
	25502	. . S CNT =CNT+1
	25503	"RTN","HMP EQ",153,0)
	25504	. . S @DA TA@("jobTm pNodes",CN T,"rootNod e")="^TMP( "_J_","""_ HMPX_""")"
	25505	"RTN","HMP EQ",154,0)
	25506	. . S Y=$ O(^TMP(J,H MPX," "),- 1)
	25507	"RTN","HMP EQ",155,0)
	25508	. . S:'$L (Y) Y=$O(^ TMP(J,HMPX ,""),-1)
	25509	"RTN","HMP EQ",156,0)
	25510	. . S @DA TA@("jobTm pNodes",CN T,"lastNod e")=Y
	25511	"RTN","HMP EQ",157,0)
	25512	;
	25513	"RTN","HMP EQ",158,0)
	25514	Q
	25515	"RTN","HMP EQ",159,0)
	25516	;
	25517	"RTN","HMP EQ",160,0)
	25518	GETGLBS(RE T) ; -- ge t summary info on HM P related temp globa ls
	25519	"RTN","HMP EQ",161,0)
	25520	; RPC: HM PM EVT QUE GET GLBS (future)
	25521	"RTN","HMP EQ",162,0)
	25522	N HMPDATA ,HMPERR
	25523	"RTN","HMP EQ",163,0)
	25524	S HMPDATA =$NA(^TMP( "HMPM EVT QUE GET GL BS",$J))
	25525	"RTN","HMP EQ",164,0)
	25526	K @HMPDAT A
	25527	"RTN","HMP EQ",165,0)
	25528	D GLBS(HM PDATA)
	25529	"RTN","HMP EQ",166,0)
	25530	D ENCODE^ HMPJSON(HM PDATA,RET, "HMPERR")
	25531	"RTN","HMP EQ",167,0)
	25532	K @HMPDAT A
	25533	"RTN","HMP EQ",168,0)
	25534	Q
	25535	"RTN","HMP EQ",169,0)
	25536	;
	25537	"RTN","HMP EQ",170,0)
	25538	NOROWS(MSG ) ; -- add standard text lines to indica te no rows to displa y
	25539	"RTN","HMP EQ",171,0)
	25540	S VALMCNT =1
	25541	"RTN","HMP EQ",172,0)
	25542	S @VALMAR @(VALMCNT, 0)=""
	25543	"RTN","HMP EQ",173,0)
	25544	S VALMCNT =2
	25545	"RTN","HMP EQ",174,0)
	25546	S @VALMAR @(VALMCNT, 0)=" o "_MSG
	25547	"RTN","HMP EQ",175,0)
	25548	D CNTRL^V ALM10(VALM CNT,2,78,I OINHI,IOIN ORM)
	25549	"RTN","HMP EQ",176,0)
	25550	Q
	25551	"RTN","HMP EQ",177,0)
	25552	;
	25553	"RTN","HMP EQLM")
	25554	0^90^B1136 76837
	25555	"RTN","HMP EQLM",1,0)
	25556	HMPEQLM ;S LC/MJK,ASM R/RRB - Ev ent Queue Manager;30 -JUN-2014
	25557	"RTN","HMP EQLM",2,0)
	25558	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	25559	"RTN","HMP EQLM",3,0)
	25560	;Per VA D irective 6 402, this routine sh ould not b e modified .
	25561	"RTN","HMP EQLM",4,0)
	25562	;
	25563	"RTN","HMP EQLM",5,0)
	25564	Q
	25565	"RTN","HMP EQLM",6,0)
	25566	;
	25567	"RTN","HMP EQLM",7,0)
	25568	EN ; -- ma in entry p oint for H MPM EVT QU E MGR
	25569	"RTN","HMP EQLM",8,0)
	25570	N HMPSRV, HMPCSTRM,H MPDOM,HMPF IL,HMPWAIT ,HMPDFN,HM PLIM
	25571	"RTN","HMP EQLM",9,0)
	25572	;
	25573	"RTN","HMP EQLM",10,0 )
	25574	D DFLTS
	25575	"RTN","HMP EQLM",11,0 )
	25576	;
	25577	"RTN","HMP EQLM",12,0 )
	25578	S HMPSRV= $$GETSRV($ G(HMPSRV))
	25579	"RTN","HMP EQLM",13,0 )
	25580	Q:$G(HMPS RV)<1
	25581	"RTN","HMP EQLM",14,0 )
	25582	;
	25583	"RTN","HMP EQLM",15,0 )
	25584	S:$G(HMPD OM)="" HMP DOM="ALL"
	25585	"RTN","HMP EQLM",16,0 )
	25586	S:$G(HMPF IL)="" HMP FIL="A"
	25587	"RTN","HMP EQLM",17,0 )
	25588	D EN^VALM ("HMPM EVT QUE MGR")
	25589	"RTN","HMP EQLM",18,0 )
	25590	Q
	25591	"RTN","HMP EQLM",19,0 )
	25592	;
	25593	"RTN","HMP EQLM",20,0 )
	25594	HDR ; -- h eader code
	25595	"RTN","HMP EQLM",21,0 )
	25596	N X,SRV0, SRVNM,LAST UP,REPEAT, FILLER K VALMHDR
	25597	"RTN","HMP EQLM",22,0 )
	25598	S $P(FILL ER," ",80) =" "
	25599	"RTN","HMP EQLM",23,0 )
	25600	S SRV0=$G (^HMP(8000 00,+$G(HMP SRV),0))
	25601	"RTN","HMP EQLM",24,0 )
	25602	S SRVNM=$ P(SRV0,"^" ),LASTUP=$ P(SRV0,"^" ,2),REPEAT =$P(SRV0," ^",4)
	25603	"RTN","HMP EQLM",25,0 )
	25604	S X=" Server: "_SRVNM_$ E(FILLER,1 ,30-$L(SRV NM))_"Last Update: " _LASTUP
	25605	"RTN","HMP EQLM",26,0 )
	25606	S:REPEAT X=X_" x"_R EPEAT
	25607	"RTN","HMP EQLM",27,0 )
	25608	S VALMHDR (1)=X
	25609	"RTN","HMP EQLM",28,0 )
	25610	S X=$E(FI LLER,1,44) _"End of Q ueue: "
	25611	"RTN","HMP EQLM",29,0 )
	25612	S X=X_$S( HMPCSTRM]" ":$P(HMPCS TRM,"~",3) _"-"_$G(^X TMP(HMPCST RM,"last") ),1:"n/a")
	25613	"RTN","HMP EQLM",30,0 )
	25614	S VALMHDR (2)=X
	25615	"RTN","HMP EQLM",31,0 )
	25616	S VALMHDR (3)=" Las t Stream: "_HMPCSTRM
	25617	"RTN","HMP EQLM",32,0 )
	25618	S X="Even t Filters: "
	25619	"RTN","HMP EQLM",33,0 )
	25620	S X=X_"St ate="_$S(H MPFIL="A": "All",HMPF IL="W":"Wa iting",1:" Processed" )
	25621	"RTN","HMP EQLM",34,0 )
	25622	S X=X_" Domain="_ HMPDOM_$S( HMPDOM="AL L"!(HMPDOM ["sync"):" ",1:$S($G( ^XTMP("HMP -off",HMPD OM)):" (st opped)",1: " (active) "))
	25623	"RTN","HMP EQLM",35,0 )
	25624	S X=X_" Max="_HMP LIM
	25625	"RTN","HMP EQLM",36,0 )
	25626	S X=X_$S( $G(HMPDFN) :" Patie nt="_HMPDF N,1:"")
	25627	"RTN","HMP EQLM",37,0 )
	25628	S VALMHDR (4)=X
	25629	"RTN","HMP EQLM",38,0 )
	25630	Q
	25631	"RTN","HMP EQLM",39,0 )
	25632	;
	25633	"RTN","HMP EQLM",40,0 )
	25634	INIT ; -- init varia bles and l ist array
	25635	"RTN","HMP EQLM",41,0 )
	25636	S:'$G(HMP LIM) HMPLI M=$$LIMIT
	25637	"RTN","HMP EQLM",42,0 )
	25638	D BUILD
	25639	"RTN","HMP EQLM",43,0 )
	25640	D HDR
	25641	"RTN","HMP EQLM",44,0 )
	25642	D MSG
	25643	"RTN","HMP EQLM",45,0 )
	25644	Q
	25645	"RTN","HMP EQLM",46,0 )
	25646	;
	25647	"RTN","HMP EQLM",47,0 )
	25648	BUILD ; -- build lis t
	25649	"RTN","HMP EQLM",48,0 )
	25650	N SEQ,SEQ NODE,X,PAR AMS,HMPEVT S,HMPCNT
	25651	"RTN","HMP EQLM",49,0 )
	25652	S HMPEVTS =$NA(^TMP( "HMPM EVT QUE MGR",$ J))
	25653	"RTN","HMP EQLM",50,0 )
	25654	K @HMPEVT S
	25655	"RTN","HMP EQLM",51,0 )
	25656	;
	25657	"RTN","HMP EQLM",52,0 )
	25658	S PARAMS( "server")= HMPSRV
	25659	"RTN","HMP EQLM",53,0 )
	25660	S PARAMS( "domain")= HMPDOM
	25661	"RTN","HMP EQLM",54,0 )
	25662	S PARAMS( "filter")= HMPFIL
	25663	"RTN","HMP EQLM",55,0 )
	25664	S PARAMS( "dfn")=$G( HMPDFN)
	25665	"RTN","HMP EQLM",56,0 )
	25666	S PARAMS( "max")=HMP LIM
	25667	"RTN","HMP EQLM",57,0 )
	25668	;
	25669	"RTN","HMP EQLM",58,0 )
	25670	D EVTS^HM PEQ(HMPEVT S,.PARAMS)
	25671	"RTN","HMP EQLM",59,0 )
	25672	S HMPCSTR M=$G(@HMPE VTS@("stre am"),"** No Stream Found * *")
	25673	"RTN","HMP EQLM",60,0 )
	25674	;
	25675	"RTN","HMP EQLM",61,0 )
	25676	S HMPWAIT =0
	25677	"RTN","HMP EQLM",62,0 )
	25678	D KILL
	25679	"RTN","HMP EQLM",63,0 )
	25680	S (VALMCN T,HMPCNT)= 0
	25681	"RTN","HMP EQLM",64,0 )
	25682	S HMPI=0 F S HMPI= $O(@HMPEVT S@("events ",HMPI)) Q :'HMPI D
	25683	"RTN","HMP EQLM",65,0 )
	25684	. S SEQNO DE=$G(@HMP EVTS@("eve nts",HMPI, "node"))
	25685	"RTN","HMP EQLM",66,0 )
	25686	. S SEQ=$ G(@HMPEVTS @("events" ,HMPI,"seq uence"))
	25687	"RTN","HMP EQLM",67,0 )
	25688	. S HMPCN T=HMPCNT+1
	25689	"RTN","HMP EQLM",68,0 )
	25690	. S X=""
	25691	"RTN","HMP EQLM",69,0 )
	25692	. S X=$$S ETFLD^VALM 1($J(HMPCN T,3),X,"ID ")
	25693	"RTN","HMP EQLM",70,0 )
	25694	. I '$P(S EQNODE,"^" ,6) S HMPW AIT=1,X=$$ SETFLD^VAL M1("*",X," STATE")
	25695	"RTN","HMP EQLM",71,0 )
	25696	. S X=$$S ETFLD^VALM 1($J(SEQ,5 ),X,"SEQ")
	25697	"RTN","HMP EQLM",72,0 )
	25698	. S X=$$S ETFLD^VALM 1(SEQNODE, X,"NODE")
	25699	"RTN","HMP EQLM",73,0 )
	25700	. D SET(X ,SEQNODE)
	25701	"RTN","HMP EQLM",74,0 )
	25702	;
	25703	"RTN","HMP EQLM",75,0 )
	25704	I VALMCNT =0 D NOROW S^HMPEQ("N o events t o display for specif ied criter ia")
	25705	"RTN","HMP EQLM",76,0 )
	25706	K VALMBG
	25707	"RTN","HMP EQLM",77,0 )
	25708	S VALMBG= 1
	25709	"RTN","HMP EQLM",78,0 )
	25710	K @HMPEVT S
	25711	"RTN","HMP EQLM",79,0 )
	25712	Q
	25713	"RTN","HMP EQLM",80,0 )
	25714	;
	25715	"RTN","HMP EQLM",81,0 )
	25716	SET(X,IDX) ; -- set the ListMa n array an d indexes
	25717	"RTN","HMP EQLM",82,0 )
	25718	K VALMCNT
	25719	"RTN","HMP EQLM",83,0 )
	25720	S VALMCNT =VALMCNT+1
	25721	"RTN","HMP EQLM",84,0 )
	25722	S @VALMAR @(VALMCNT, 0)=X
	25723	"RTN","HMP EQLM",85,0 )
	25724	S @VALMAR @("IDX",VA LMCNT,HMPC NT)=IDX
	25725	"RTN","HMP EQLM",86,0 )
	25726	S @VALMAR @("ENTRY", HMPCNT)=ID X
	25727	"RTN","HMP EQLM",87,0 )
	25728	Q
	25729	"RTN","HMP EQLM",88,0 )
	25730	;
	25731	"RTN","HMP EQLM",89,0 )
	25732	KILL ; -- kill off b uild data
	25733	"RTN","HMP EQLM",90,0 )
	25734	K @VALMAR
	25735	"RTN","HMP EQLM",91,0 )
	25736	; clean u p video co ntrol data
	25737	"RTN","HMP EQLM",92,0 )
	25738	D KILL^VA LM10()
	25739	"RTN","HMP EQLM",93,0 )
	25740	Q
	25741	"RTN","HMP EQLM",94,0 )
	25742	;
	25743	"RTN","HMP EQLM",95,0 )
	25744	MSG ; -- s et default message
	25745	"RTN","HMP EQLM",96,0 )
	25746	K VALMSG
	25747	"RTN","HMP EQLM",97,0 )
	25748	S VALMSG= $S(HMPWAIT :" * wai ting to be processed ",1:"")
	25749	"RTN","HMP EQLM",98,0 )
	25750	Q
	25751	"RTN","HMP EQLM",99,0 )
	25752	;
	25753	"RTN","HMP EQLM",100, 0)
	25754	HELP ; -- help code
	25755	"RTN","HMP EQLM",101, 0)
	25756	S X="?" D DISP^XQOR M1 W !!
	25757	"RTN","HMP EQLM",102, 0)
	25758	Q
	25759	"RTN","HMP EQLM",103, 0)
	25760	;
	25761	"RTN","HMP EQLM",104, 0)
	25762	EXIT ; -- exit code
	25763	"RTN","HMP EQLM",105, 0)
	25764	; -- save user crit eria fro 7 days
	25765	"RTN","HMP EQLM",106, 0)
	25766	Q:'$G(DUZ )
	25767	"RTN","HMP EQLM",107, 0)
	25768	N NODE,X
	25769	"RTN","HMP EQLM",108, 0)
	25770	S NODE="H MPM EVT QU E MGR"
	25771	"RTN","HMP EQLM",109, 0)
	25772	K ^DISV(D UZ,NODE)
	25773	"RTN","HMP EQLM",110, 0)
	25774	F X="HMPS RV","HMPDO M","HMPFIL ","HMPDFN" ,"HMPLIM" I $G(@X)]" " S ^DISV( DUZ,NODE,X )=@X
	25775	"RTN","HMP EQLM",111, 0)
	25776	Q
	25777	"RTN","HMP EQLM",112, 0)
	25778	;
	25779	"RTN","HMP EQLM",113, 0)
	25780	DFLTS ; -- get user defaults
	25781	"RTN","HMP EQLM",114, 0)
	25782	Q:'$G(DUZ )
	25783	"RTN","HMP EQLM",115, 0)
	25784	N NODE,X
	25785	"RTN","HMP EQLM",116, 0)
	25786	S NODE="H MPM EVT QU E MGR"
	25787	"RTN","HMP EQLM",117, 0)
	25788	Q:'$D(^DI SV(DUZ,NOD E))
	25789	"RTN","HMP EQLM",118, 0)
	25790	S X=0 F S X=$O(^DI SV(DUZ,NOD E,X)) Q:X= "" S @X=^ (X)
	25791	"RTN","HMP EQLM",119, 0)
	25792	Q
	25793	"RTN","HMP EQLM",120, 0)
	25794	;
	25795	"RTN","HMP EQLM",121, 0)
	25796	EXPND ; -- expand co de
	25797	"RTN","HMP EQLM",122, 0)
	25798	Q
	25799	"RTN","HMP EQLM",123, 0)
	25800	;
	25801	"RTN","HMP EQLM",124, 0)
	25802	REFRESH ; -- refresh display
	25803	"RTN","HMP EQLM",125, 0)
	25804	; protoco l: HMPM EV T QUE REFR ESH
	25805	"RTN","HMP EQLM",126, 0)
	25806	D WAIT^DI CD
	25807	"RTN","HMP EQLM",127, 0)
	25808	D BUILD
	25809	"RTN","HMP EQLM",128, 0)
	25810	D HDR
	25811	"RTN","HMP EQLM",129, 0)
	25812	D MSG
	25813	"RTN","HMP EQLM",130, 0)
	25814	S VALMBCK ="R"
	25815	"RTN","HMP EQLM",131, 0)
	25816	Q
	25817	"RTN","HMP EQLM",132, 0)
	25818	;
	25819	"RTN","HMP EQLM",133, 0)
	25820	CS ; -- ch ange serve r
	25821	"RTN","HMP EQLM",134, 0)
	25822	; protoco l: HMPM EV T QUE CHAN GE SERVER
	25823	"RTN","HMP EQLM",135, 0)
	25824	D FULL^VA LM1
	25825	"RTN","HMP EQLM",136, 0)
	25826	N SRV
	25827	"RTN","HMP EQLM",137, 0)
	25828	S SRV=$$G ETSRV^HMPD JFSM()
	25829	"RTN","HMP EQLM",138, 0)
	25830	I +SRV>0 S HMPSRV=+ SRV
	25831	"RTN","HMP EQLM",139, 0)
	25832	D REFRESH
	25833	"RTN","HMP EQLM",140, 0)
	25834	Q
	25835	"RTN","HMP EQLM",141, 0)
	25836	;
	25837	"RTN","HMP EQLM",142, 0)
	25838	CD ; -- ch ange domai n
	25839	"RTN","HMP EQLM",143, 0)
	25840	; protoco l: HMPM EV T QUE CHAN GE DOMAIN
	25841	"RTN","HMP EQLM",144, 0)
	25842	N DIR,Y,X ,DOMAINS,I ,LIST,Y
	25843	"RTN","HMP EQLM",145, 0)
	25844	D FULL^VA LM1
	25845	"RTN","HMP EQLM",146, 0)
	25846	D EVNTYPS ^HMPDJFSM( .LIST)
	25847	"RTN","HMP EQLM",147, 0)
	25848	S I=0 F S I=$O(LIS T(I)) Q:'I S Y(LIST (I))=""
	25849	"RTN","HMP EQLM",148, 0)
	25850	F X="sync Noop","syn cDomain"," syncError" ,"syncStar t","syncDo ne" S Y(X) =""
	25851	"RTN","HMP EQLM",149, 0)
	25852	S X="",I= 0
	25853	"RTN","HMP EQLM",150, 0)
	25854	F S X=$O (Y(X)) Q:X ="" S I=I +1 S DOMAI NS(I)=X
	25855	"RTN","HMP EQLM",151, 0)
	25856	S DOMAINS (999)="ALL "
	25857	"RTN","HMP EQLM",152, 0)
	25858	S X="S^"
	25859	"RTN","HMP EQLM",153, 0)
	25860	S I=0 F S I=$O(DOM AINS(I)) Q :I="" S X =X_I_":"_$ G(DOMAINS( I))_";"
	25861	"RTN","HMP EQLM",154, 0)
	25862	S DIR(0)= X
	25863	"RTN","HMP EQLM",155, 0)
	25864	S DIR("A" )="Select Domain"
	25865	"RTN","HMP EQLM",156, 0)
	25866	S DIR("B" )="ALL"
	25867	"RTN","HMP EQLM",157, 0)
	25868	D ^DIR
	25869	"RTN","HMP EQLM",158, 0)
	25870	I +Y>0 S HMPDOM=$G( DOMAINS(+Y ))
	25871	"RTN","HMP EQLM",159, 0)
	25872	D REFRESH
	25873	"RTN","HMP EQLM",160, 0)
	25874	Q
	25875	"RTN","HMP EQLM",161, 0)
	25876	;
	25877	"RTN","HMP EQLM",162, 0)
	25878	LIMIT() ; -- get fre shness eve nts displa y limit
	25879	"RTN","HMP EQLM",163, 0)
	25880	; -- set high testi ng in orde r to see m any event types
	25881	"RTN","HMP EQLM",164, 0)
	25882	Q $S($$PR OD^XUPROD( ):10,1:200 )
	25883	"RTN","HMP EQLM",165, 0)
	25884	;
	25885	"RTN","HMP EQLM",166, 0)
	25886	FILTER ; - - allows u ser to fil ter list
	25887	"RTN","HMP EQLM",167, 0)
	25888	; protoco l: HMPM EV T QUE FILT ER
	25889	"RTN","HMP EQLM",168, 0)
	25890	N DIR,Y,X
	25891	"RTN","HMP EQLM",169, 0)
	25892	D FULL^VA LM1
	25893	"RTN","HMP EQLM",170, 0)
	25894	S X="S^"
	25895	"RTN","HMP EQLM",171, 0)
	25896	S X=X_"A: All events ;"
	25897	"RTN","HMP EQLM",172, 0)
	25898	S X=X_"P: Processed events;"
	25899	"RTN","HMP EQLM",173, 0)
	25900	S X=X_"W: Waiting to be proces sed events "
	25901	"RTN","HMP EQLM",174, 0)
	25902	S DIR(0)= X
	25903	"RTN","HMP EQLM",175, 0)
	25904	S DIR("A" )="Select Event Stat e"
	25905	"RTN","HMP EQLM",176, 0)
	25906	S DIR("B" )="All eve nts"
	25907	"RTN","HMP EQLM",177, 0)
	25908	D ^DIR
	25909	"RTN","HMP EQLM",178, 0)
	25910	I Y="P" S HMPFIL=Y
	25911	"RTN","HMP EQLM",179, 0)
	25912	I Y="W" S HMPFIL=Y
	25913	"RTN","HMP EQLM",180, 0)
	25914	I Y="A" S HMPFIL=Y
	25915	"RTN","HMP EQLM",181, 0)
	25916	D REFRESH
	25917	"RTN","HMP EQLM",182, 0)
	25918	Q
	25919	"RTN","HMP EQLM",183, 0)
	25920	;
	25921	"RTN","HMP EQLM",184, 0)
	25922	SELPT ; se lect patie nt
	25923	"RTN","HMP EQLM",185, 0)
	25924	; protoco l" HMPM EV T QUE SELE CT PATIENT
	25925	"RTN","HMP EQLM",186, 0)
	25926	D FULL^VA LM1
	25927	"RTN","HMP EQLM",187, 0)
	25928	N Y,DIC
	25929	"RTN","HMP EQLM",188, 0)
	25930	S DIC="^D PT("
	25931	"RTN","HMP EQLM",189, 0)
	25932	S DIC(0)= "AEMQ"
	25933	"RTN","HMP EQLM",190, 0)
	25934	D ^DIC
	25935	"RTN","HMP EQLM",191, 0)
	25936	S HMPDFN= $S(+Y>0:+Y ,1:"")
	25937	"RTN","HMP EQLM",192, 0)
	25938	D REFRESH
	25939	"RTN","HMP EQLM",193, 0)
	25940	Q
	25941	"RTN","HMP EQLM",194, 0)
	25942	;
	25943	"RTN","HMP EQLM",195, 0)
	25944	CM ; chang e max
	25945	"RTN","HMP EQLM",196, 0)
	25946	; protoco l: HMPM EV T QUE CHAN GE MAX LIS TED
	25947	"RTN","HMP EQLM",197, 0)
	25948	D FULL^VA LM1
	25949	"RTN","HMP EQLM",198, 0)
	25950	N DIR
	25951	"RTN","HMP EQLM",199, 0)
	25952	S DIR(0)= "N^10:1000 :0"
	25953	"RTN","HMP EQLM",200, 0)
	25954	S DIR("B" )=$$LIMIT
	25955	"RTN","HMP EQLM",201, 0)
	25956	S DIR("A" )="Set Lim it: "
	25957	"RTN","HMP EQLM",202, 0)
	25958	D ^DIR
	25959	"RTN","HMP EQLM",203, 0)
	25960	I +Y>0 S HMPLIM=+Y
	25961	"RTN","HMP EQLM",204, 0)
	25962	D REFRESH
	25963	"RTN","HMP EQLM",205, 0)
	25964	Q
	25965	"RTN","HMP EQLM",206, 0)
	25966	;
	25967	"RTN","HMP EQLM",207, 0)
	25968	DETAIL ; - - detailed display
	25969	"RTN","HMP EQLM",208, 0)
	25970	; protoco l: HMPM EV T QUE DISP LAY DETAIL S
	25971	"RTN","HMP EQLM",209, 0)
	25972	N HMPI,VA LMY,HMPDAS H,POST,DOM AIN,HMPREF ,HMPDATA
	25973	"RTN","HMP EQLM",210, 0)
	25974	S $P(HMPD ASH,"=",80 )=""
	25975	"RTN","HMP EQLM",211, 0)
	25976	D FULL^VA LM1
	25977	"RTN","HMP EQLM",212, 0)
	25978	D EN^VALM 2(XQORNOD( 0),"OS")
	25979	"RTN","HMP EQLM",213, 0)
	25980	S HMPI=+$ O(VALMY("" ))
	25981	"RTN","HMP EQLM",214, 0)
	25982	I HMPI>0 D
	25983	"RTN","HMP EQLM",215, 0)
	25984	. S HMPRE F="HMPDATA "
	25985	"RTN","HMP EQLM",216, 0)
	25986	. S POST= $G(@VALMAR @("ENTRY", HMPI))
	25987	"RTN","HMP EQLM",217, 0)
	25988	. W !!,HM PDASH
	25989	"RTN","HMP EQLM",218, 0)
	25990	. W !!,"P osted Even t Data: ", POST
	25991	"RTN","HMP EQLM",219, 0)
	25992	. I $P(PO ST,"^",5) D
	25993	"RTN","HMP EQLM",220, 0)
	25994	. . K HMP DATA
	25995	"RTN","HMP EQLM",221, 0)
	25996	. . S HMP DATA(1,"la bel")="Add ed To Stre am"
	25997	"RTN","HMP EQLM",222, 0)
	25998	. . S HMP DATA(1,"va lue")=$$GE TIME($P(HM PCSTRM,"~" ,3),$P(POS T,"^",5))
	25999	"RTN","HMP EQLM",223, 0)
	26000	. . D REN DER
	26001	"RTN","HMP EQLM",224, 0)
	26002	. ;
	26003	"RTN","HMP EQLM",225, 0)
	26004	. I $P(PO ST,"^",6) D
	26005	"RTN","HMP EQLM",226, 0)
	26006	. . K HMP DATA
	26007	"RTN","HMP EQLM",227, 0)
	26008	. . S HMP DATA(1,"la bel")="Pro cessed Tim e"
	26009	"RTN","HMP EQLM",228, 0)
	26010	. . S HMP DATA(1,"va lue")=$$GE TIME($P(HM PCSTRM,"~" ,3),$P(POS T,"^",6))
	26011	"RTN","HMP EQLM",229, 0)
	26012	. . I $P( POST,"^",6 )<$P(POST, "^",5) D
	26013	"RTN","HMP EQLM",230, 0)
	26014	. . . S H MPDATA(2," label")=""
	26015	"RTN","HMP EQLM",231, 0)
	26016	. . . S H MPDATA(2," value")=" - ti me before 'add' time means pro cessed on a differen t date"
	26017	"RTN","HMP EQLM",232, 0)
	26018	. . D REN DER
	26019	"RTN","HMP EQLM",233, 0)
	26020	. ;
	26021	"RTN","HMP EQLM",234, 0)
	26022	. ; -- do main info parsing an d display
	26023	"RTN","HMP EQLM",235, 0)
	26024	. S DOMAI N=$P(POST, "^",2)
	26025	"RTN","HMP EQLM",236, 0)
	26026	. ;
	26027	"RTN","HMP EQLM",237, 0)
	26028	. I +POST D PAT(HMP REF,+POST) ,RENDER
	26029	"RTN","HMP EQLM",238, 0)
	26030	. I 'POST ,DOMAIN="p atient"!(D OMAIN="pt- select") D PAT(HMPRE F,+$P(POST ,"^",3)),R ENDER
	26031	"RTN","HMP EQLM",239, 0)
	26032	. ;
	26033	"RTN","HMP EQLM",240, 0)
	26034	. I DOMAI N="med"!(D OMAIN="ord er") D MED (HMPREF,+$ P(POST,"^" ,3)),RENDE R
	26035	"RTN","HMP EQLM",241, 0)
	26036	. I DOMAI N="consult " D CONSUL T(HMPREF,+ $P(POST,"^ ",3)),REND ER
	26037	"RTN","HMP EQLM",242, 0)
	26038	. ; -- TO DO: Need t o understa nd HL7-typ e messages parsed in XQOR^HMPE VNT
	26039	"RTN","HMP EQLM",243, 0)
	26040	. ;I DOMA IN="docume nt" D TIU( +$P(POST," ^",3))
	26041	"RTN","HMP EQLM",244, 0)
	26042	. ;I DOMA IN="lab" D LAB()
	26043	"RTN","HMP EQLM",245, 0)
	26044	. ;I DOMA IN="image" D IMAGE()
	26045	"RTN","HMP EQLM",246, 0)
	26046	. ;
	26047	"RTN","HMP EQLM",247, 0)
	26048	. I DOMAI N="visit" D
	26049	"RTN","HMP EQLM",248, 0)
	26050	. . N IEN
	26051	"RTN","HMP EQLM",249, 0)
	26052	. . S IEN =$P(POST," ^",3)
	26053	"RTN","HMP EQLM",250, 0)
	26054	. . I $E( IEN)="H" D ADM(HMPRE F,+$E(IEN, 2,999)),RE NDER Q
	26055	"RTN","HMP EQLM",251, 0)
	26056	. . D VIS IT(HMPREF, +IEN),REND ER
	26057	"RTN","HMP EQLM",252, 0)
	26058	. ;
	26059	"RTN","HMP EQLM",253, 0)
	26060	. I DOMAI N="appoint ment" D AP PT(HMPREF, $P(POST,"^ ",3)),REND ER
	26061	"RTN","HMP EQLM",254, 0)
	26062	. ;
	26063	"RTN","HMP EQLM",255, 0)
	26064	. I DOMAI N="user" D USER(HMPR EF,+$P(POS T,"^",3)), RENDER
	26065	"RTN","HMP EQLM",256, 0)
	26066	. ;
	26067	"RTN","HMP EQLM",257, 0)
	26068	. I DOMAI N="roster" D ROSTER( HMPREF,+$P (POST,"^", 3)),RENDER
	26069	"RTN","HMP EQLM",258, 0)
	26070	. ;
	26071	"RTN","HMP EQLM",259, 0)
	26072	. ; -- HM P PATIENT OBJECT (#8 00000.1) d omains
	26073	"RTN","HMP EQLM",260, 0)
	26074	. I DOMAI N="auxilia ry" D AUX( HMPREF,+$P (POST,"^", 3)),RENDER
	26075	"RTN","HMP EQLM",261, 0)
	26076	. I DOMAI N="diagnos is" D DIAG (HMPREF,+$ P(POST,"^" ,3)),RENDE R
	26077	"RTN","HMP EQLM",262, 0)
	26078	. I DOMAI N="roadtri p" D ROAD( HMPREF,+$P (POST,"^", 3)),RENDER
	26079	"RTN","HMP EQLM",263, 0)
	26080	. I DOMAI N="task" D TASK(HMPR EF,+$P(POS T,"^",3)), RENDER
	26081	"RTN","HMP EQLM",264, 0)
	26082	. ;
	26083	"RTN","HMP EQLM",265, 0)
	26084	. W !!,HM PDASH
	26085	"RTN","HMP EQLM",266, 0)
	26086	. D PAUSE ^VALM1
	26087	"RTN","HMP EQLM",267, 0)
	26088	;
	26089	"RTN","HMP EQLM",268, 0)
	26090	K VALMBCK
	26091	"RTN","HMP EQLM",269, 0)
	26092	S VALMBCK ="R"
	26093	"RTN","HMP EQLM",270, 0)
	26094	Q
	26095	"RTN","HMP EQLM",271, 0)
	26096	;
	26097	"RTN","HMP EQLM",272, 0)
	26098	GETIME(DAT E,SECS) ; -- get tim e
	26099	"RTN","HMP EQLM",273, 0)
	26100	N X
	26101	"RTN","HMP EQLM",274, 0)
	26102	S X=$$FMT H^XLFDT(DA TE),$P(X," ,",2)=SECS
	26103	"RTN","HMP EQLM",275, 0)
	26104	Q $P($$HT E^XLFDT(X, "S"),"@",2 )
	26105	"RTN","HMP EQLM",276, 0)
	26106	;
	26107	"RTN","HMP EQLM",277, 0)
	26108	PAT(HMPZ,D FN) ; -- g et patient info
	26109	"RTN","HMP EQLM",278, 0)
	26110	N VA,HMPY ,VAROOT
	26111	"RTN","HMP EQLM",279, 0)
	26112	S VAROOT= "HMPY"
	26113	"RTN","HMP EQLM",280, 0)
	26114	D DEM^VAD PT
	26115	"RTN","HMP EQLM",281, 0)
	26116	K @HMPZ
	26117	"RTN","HMP EQLM",282, 0)
	26118	S @HMPZ@( 1,"label") ="Patient Short ID"
	26119	"RTN","HMP EQLM",283, 0)
	26120	S @HMPZ@( 1,"value") =$G(VA("BI D"))
	26121	"RTN","HMP EQLM",284, 0)
	26122	Q
	26123	"RTN","HMP EQLM",285, 0)
	26124	;
	26125	"RTN","HMP EQLM",286, 0)
	26126	MED(HMPZ,O RDER) ; -- display o rder info
	26127	"RTN","HMP EQLM",287, 0)
	26128	N IEN,ORD ABLE,CNT
	26129	"RTN","HMP EQLM",288, 0)
	26130	K @HMPZ
	26131	"RTN","HMP EQLM",289, 0)
	26132	S (CNT,IE N)=0
	26133	"RTN","HMP EQLM",290, 0)
	26134	F S IEN= $O(^OR(100 ,+$G(ORDER ),.1,IEN)) Q:'IEN S ORDABLE=+ $G(^(IEN,0 )) D
	26135	"RTN","HMP EQLM",291, 0)
	26136	. S CNT=C NT+1
	26137	"RTN","HMP EQLM",292, 0)
	26138	. S @HMPZ @(CNT,"lab el")="Orde rable"
	26139	"RTN","HMP EQLM",293, 0)
	26140	. S @HMPZ @(CNT,"val ue")=$P($G (^ORD(101. 43,ORDABLE ,0)),"^")
	26141	"RTN","HMP EQLM",294, 0)
	26142	Q
	26143	"RTN","HMP EQLM",295, 0)
	26144	;
	26145	"RTN","HMP EQLM",296, 0)
	26146	TIU(HMPZ,I EN) ; -- g et TIU doc ument type
	26147	"RTN","HMP EQLM",297, 0)
	26148	K @HMPZ
	26149	"RTN","HMP EQLM",298, 0)
	26150	S @HMPZ@( 1,"label") ="Document Type"
	26151	"RTN","HMP EQLM",299, 0)
	26152	S @HMPZ@( 1,"value") =$$GET1^DI Q(8925.1,+ $$GET1^DIQ (8925,IEN_ ",",.01)_" ,",.01)
	26153	"RTN","HMP EQLM",300, 0)
	26154	Q
	26155	"RTN","HMP EQLM",301, 0)
	26156	;
	26157	"RTN","HMP EQLM",302, 0)
	26158	USER(HMPZ, IEN) ; -- get user n ame
	26159	"RTN","HMP EQLM",303, 0)
	26160	K @HMPZ
	26161	"RTN","HMP EQLM",304, 0)
	26162	S @HMPZ@( 1,"label") ="User"
	26163	"RTN","HMP EQLM",305, 0)
	26164	S @HMPZ@( 1,"value") =$$GET1^DI Q(200,IEN_ ",",.01)
	26165	"RTN","HMP EQLM",306, 0)
	26166	Q
	26167	"RTN","HMP EQLM",307, 0)
	26168	;
	26169	"RTN","HMP EQLM",308, 0)
	26170	ROSTER(HMP Z,IEN) ; - - get rost er name
	26171	"RTN","HMP EQLM",309, 0)
	26172	K @HMPZ
	26173	"RTN","HMP EQLM",310, 0)
	26174	S @HMPZ@( 1,"label") ="Roster"
	26175	"RTN","HMP EQLM",311, 0)
	26176	S @HMPZ@( 1,"value") =$$GET1^DI Q(800001.2 ,IEN_",",. 01)
	26177	"RTN","HMP EQLM",312, 0)
	26178	Q
	26179	"RTN","HMP EQLM",313, 0)
	26180	;
	26181	"RTN","HMP EQLM",314, 0)
	26182	; -- TODO : is this real or ju st a dev a nomaly
	26183	"RTN","HMP EQLM",315, 0)
	26184	AUX(HMPZ,I EN) ; -- g et auxilia ry uid
	26185	"RTN","HMP EQLM",316, 0)
	26186	K @HMPZ
	26187	"RTN","HMP EQLM",317, 0)
	26188	S @HMPZ@( 1,"label") ="Auxiliar y UID"
	26189	"RTN","HMP EQLM",318, 0)
	26190	S @HMPZ@( 1,"value") =$$GET1^DI Q(800000.1 ,IEN_",",. 01)
	26191	"RTN","HMP EQLM",319, 0)
	26192	Q
	26193	"RTN","HMP EQLM",320, 0)
	26194	;
	26195	"RTN","HMP EQLM",321, 0)
	26196	; -- TODO : is this real or ju st a dev a nomaly
	26197	"RTN","HMP EQLM",322, 0)
	26198	DIAG(HMPZ, IEN) ; -- get diagno sis uid
	26199	"RTN","HMP EQLM",323, 0)
	26200	K @HMPZ
	26201	"RTN","HMP EQLM",324, 0)
	26202	S @HMPZ@( 1,"label") ="Diagnosi s UID"
	26203	"RTN","HMP EQLM",325, 0)
	26204	S @HMPZ@( 1,"value") =$$GET1^DI Q(800000.1 ,IEN_",",. 01)
	26205	"RTN","HMP EQLM",326, 0)
	26206	Q
	26207	"RTN","HMP EQLM",327, 0)
	26208	;
	26209	"RTN","HMP EQLM",328, 0)
	26210	; -- TODO : is this real or ju st a dev a nomaly
	26211	"RTN","HMP EQLM",329, 0)
	26212	ROAD(HMPZ, IEN) ; -- get roadtr ip uid
	26213	"RTN","HMP EQLM",330, 0)
	26214	K @HMPZ
	26215	"RTN","HMP EQLM",331, 0)
	26216	S @HMPZ@( 1,"label") ="Road Tri p UID"
	26217	"RTN","HMP EQLM",332, 0)
	26218	S @HMPZ@( 1,"value") =$$GET1^DI Q(800000.1 ,IEN_",",. 01)
	26219	"RTN","HMP EQLM",333, 0)
	26220	Q
	26221	"RTN","HMP EQLM",334, 0)
	26222	;
	26223	"RTN","HMP EQLM",335, 0)
	26224	TASK(HMPZ, IEN) ; -- get task u id
	26225	"RTN","HMP EQLM",336, 0)
	26226	K @HMPZ
	26227	"RTN","HMP EQLM",337, 0)
	26228	S @HMPZ@( 1,"label") ="Task UID "
	26229	"RTN","HMP EQLM",338, 0)
	26230	S @HMPZ@( 1,"value") =$$GET1^DI Q(800000.1 ,IEN_",",. 01)
	26231	"RTN","HMP EQLM",339, 0)
	26232	Q
	26233	"RTN","HMP EQLM",340, 0)
	26234	;
	26235	"RTN","HMP EQLM",341, 0)
	26236	CONSULT(HM PZ,IEN) ; -- get con sult date
	26237	"RTN","HMP EQLM",342, 0)
	26238	K @HMPZ
	26239	"RTN","HMP EQLM",343, 0)
	26240	S @HMPZ@( 1,"label") ="Consult Date/Time"
	26241	"RTN","HMP EQLM",344, 0)
	26242	S @HMPZ@( 1,"value") =$$GET1^DI Q(123,IEN_ ",",.01)
	26243	"RTN","HMP EQLM",345, 0)
	26244	Q
	26245	"RTN","HMP EQLM",346, 0)
	26246	;
	26247	"RTN","HMP EQLM",347, 0)
	26248	VISIT(HMPZ ,IEN) ; -- get visit date/time
	26249	"RTN","HMP EQLM",348, 0)
	26250	K @HMPZ
	26251	"RTN","HMP EQLM",349, 0)
	26252	S @HMPZ@( 1,"label") ="Visit da te/time"
	26253	"RTN","HMP EQLM",350, 0)
	26254	S @HMPZ@( 1,"value") =$$GET1^DI Q(9000010, IEN_",",.0 1)
	26255	"RTN","HMP EQLM",351, 0)
	26256	Q
	26257	"RTN","HMP EQLM",352, 0)
	26258	;
	26259	"RTN","HMP EQLM",353, 0)
	26260	ADM(HMPZ,I EN) ; -- g et admissi on date/ti me
	26261	"RTN","HMP EQLM",354, 0)
	26262	K @HMPZ
	26263	"RTN","HMP EQLM",355, 0)
	26264	S @HMPZ@( 1,"label") ="Admissio n date/tim e"
	26265	"RTN","HMP EQLM",356, 0)
	26266	S @HMPZ@( 1,"value") =$$GET1^DI Q(405,IEN_ ",",.01)
	26267	"RTN","HMP EQLM",357, 0)
	26268	Q
	26269	"RTN","HMP EQLM",358, 0)
	26270	;
	26271	"RTN","HMP EQLM",359, 0)
	26272	APPT(HMPZ, MAP) ; -- get appoin tment data /time and clinic
	26273	"RTN","HMP EQLM",360, 0)
	26274	N IENS
	26275	"RTN","HMP EQLM",361, 0)
	26276	S IENS=+$ P(MAP,";", 3)_","_+$P (MAP,";",2 )_","
	26277	"RTN","HMP EQLM",362, 0)
	26278	K @HMPZ
	26279	"RTN","HMP EQLM",363, 0)
	26280	S @HMPZ@( 1,"label") ="Appointm ent date/t ime"
	26281	"RTN","HMP EQLM",364, 0)
	26282	S @HMPZ@( 1,"value") =$$GET1^DI Q(2.98,IEN S,.001)
	26283	"RTN","HMP EQLM",365, 0)
	26284	S @HMPZ@( 2,"label") ="Clinic"
	26285	"RTN","HMP EQLM",366, 0)
	26286	S @HMPZ@( 2,"value") =$$GET1^DI Q(2.98,IEN S,.01)
	26287	"RTN","HMP EQLM",367, 0)
	26288	Q
	26289	"RTN","HMP EQLM",368, 0)
	26290	;
	26291	"RTN","HMP EQLM",369, 0)
	26292	RENDER ; - - write in fo
	26293	"RTN","HMP EQLM",370, 0)
	26294	N I
	26295	"RTN","HMP EQLM",371, 0)
	26296	S I=0 F S I=$O(HMP DATA(I)) Q :'I W !," o ",$G( HMPDATA(I, "label")), ": ",$G(HM PDATA(I,"v alue"))
	26297	"RTN","HMP EQLM",372, 0)
	26298	Q
	26299	"RTN","HMP EQLM",373, 0)
	26300	;
	26301	"RTN","HMP EQLM",374, 0)
	26302	SHOWHMPN ; -- show H MP global nodes
	26303	"RTN","HMP EQLM",375, 0)
	26304	; protoco l: HMPM EV T QUE SHOW TEMP GLOB ALS
	26305	"RTN","HMP EQLM",376, 0)
	26306	D FULL^VA LM1
	26307	"RTN","HMP EQLM",377, 0)
	26308	D EN^HMPE QLM2($G(HM PSRV))
	26309	"RTN","HMP EQLM",378, 0)
	26310	D REFRESH
	26311	"RTN","HMP EQLM",379, 0)
	26312	Q
	26313	"RTN","HMP EQLM",380, 0)
	26314	;
	26315	"RTN","HMP EQLM",381, 0)
	26316	FSHRPT ; - - show ove rall fresh ness repor t
	26317	"RTN","HMP EQLM",382, 0)
	26318	; protoco l: HMPM EV T QUE FRES HNESS REPO RT
	26319	"RTN","HMP EQLM",383, 0)
	26320	D FULL^VA LM1
	26321	"RTN","HMP EQLM",384, 0)
	26322	D EN^HMPE QLM1($G(HM PSRV))
	26323	"RTN","HMP EQLM",385, 0)
	26324	D REFRESH
	26325	"RTN","HMP EQLM",386, 0)
	26326	Q
	26327	"RTN","HMP EQLM",387, 0)
	26328	;
	26329	"RTN","HMP EQLM",388, 0)
	26330	EMERSTOP ; -- stop f reshness
	26331	"RTN","HMP EQLM",389, 0)
	26332	; protoco l: HMPM EV T QUE EMER GENCY STOP (not dist ributed)
	26333	"RTN","HMP EQLM",390, 0)
	26334	D FULL^VA LM1
	26335	"RTN","HMP EQLM",391, 0)
	26336	;D EMERST OP^HMPDJFS M
	26337	"RTN","HMP EQLM",392, 0)
	26338	D REFRESH
	26339	"RTN","HMP EQLM",393, 0)
	26340	Q
	26341	"RTN","HMP EQLM",394, 0)
	26342	;
	26343	"RTN","HMP EQLM",395, 0)
	26344	RSTRTFR ; -- re-star t freshnes s
	26345	"RTN","HMP EQLM",396, 0)
	26346	; protoco l: HMPM EV T QUE REST ART FRESHN ESS (not d istributed )
	26347	"RTN","HMP EQLM",397, 0)
	26348	D FULL^VA LM1
	26349	"RTN","HMP EQLM",398, 0)
	26350	;D RSTRTF R^HMPDJFSM
	26351	"RTN","HMP EQLM",399, 0)
	26352	D REFRESH
	26353	"RTN","HMP EQLM",400, 0)
	26354	Q
	26355	"RTN","HMP EQLM",401, 0)
	26356	;
	26357	"RTN","HMP EQLM",402, 0)
	26358	GETSRV(DFL T) ; Retur n the IEN for the se rver to mo nitor
	26359	"RTN","HMP EQLM",403, 0)
	26360	N DIC,Y
	26361	"RTN","HMP EQLM",404, 0)
	26362	S DIC="^H MP(800000, ",DIC(0)=" AEMQ",DIC( "A")="Sele ct HMP ser ver instan ce: "
	26363	"RTN","HMP EQLM",405, 0)
	26364	I $G(DFLT ) S DIC("B ")=$P($G(^ HMP(800000 ,$G(DFLT), 0)),"^")
	26365	"RTN","HMP EQLM",406, 0)
	26366	D ^DIC
	26367	"RTN","HMP EQLM",407, 0)
	26368	Q +Y
	26369	"RTN","HMP EQLM",408, 0)
	26370	;
	26371	"RTN","HMP EQLM1")
	26372	0^91^B7071 509
	26373	"RTN","HMP EQLM1",1,0 )
	26374	HMPEQLM1 ; SLC/MJK,AS MR/RRB - H MP Freshne ss Report; 02-JUL-201 4
	26375	"RTN","HMP EQLM1",2,0 )
	26376	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	26377	"RTN","HMP EQLM1",3,0 )
	26378	;Per VA D irective 6 402, this routine sh ould not b e modified .
	26379	"RTN","HMP EQLM1",4,0 )
	26380	;
	26381	"RTN","HMP EQLM1",5,0 )
	26382	Q
	26383	"RTN","HMP EQLM1",6,0 )
	26384	;
	26385	"RTN","HMP EQLM1",7,0 )
	26386	EN(HMPSRV) ; -- main entry poi nt for HMP M EVT QUE FRESHNESS REPORT
	26387	"RTN","HMP EQLM1",8,0 )
	26388	D EN^VALM ("HMPM EVT QUE FRESH NESS REPOR T")
	26389	"RTN","HMP EQLM1",9,0 )
	26390	Q
	26391	"RTN","HMP EQLM1",10, 0)
	26392	;
	26393	"RTN","HMP EQLM1",11, 0)
	26394	HDR ; -- h eader code
	26395	"RTN","HMP EQLM1",12, 0)
	26396	Q
	26397	"RTN","HMP EQLM1",13, 0)
	26398	;
	26399	"RTN","HMP EQLM1",14, 0)
	26400	INIT ; -- init varia bles and l ist array
	26401	"RTN","HMP EQLM1",15, 0)
	26402	N IEN,SRV NM,HMPDATA ,SEQ,X
	26403	"RTN","HMP EQLM1",16, 0)
	26404	;
	26405	"RTN","HMP EQLM1",17, 0)
	26406	D KILL
	26407	"RTN","HMP EQLM1",18, 0)
	26408	S VALMCNT =0
	26409	"RTN","HMP EQLM1",19, 0)
	26410	;
	26411	"RTN","HMP EQLM1",20, 0)
	26412	; -- show current s erver and then the r est
	26413	"RTN","HMP EQLM1",21, 0)
	26414	I +$G(HMP SRV) D SRV ^HMPEQ("HM PDATA",+HM PSRV),SRV( .HMPDATA)
	26415	"RTN","HMP EQLM1",22, 0)
	26416	D SET(" ")
	26417	"RTN","HMP EQLM1",23, 0)
	26418	;
	26419	"RTN","HMP EQLM1",24, 0)
	26420	; -- loop & sort th ru defined HMP serve rs
	26421	"RTN","HMP EQLM1",25, 0)
	26422	K HMPDATA
	26423	"RTN","HMP EQLM1",26, 0)
	26424	S HMPDATA =$NA(^TMP( "HMP FRESH NESS RPT", $J))
	26425	"RTN","HMP EQLM1",27, 0)
	26426	K @HMPDAT A
	26427	"RTN","HMP EQLM1",28, 0)
	26428	D SRVS^HM PEQ(HMPDAT A)
	26429	"RTN","HMP EQLM1",29, 0)
	26430	S SEQ=0
	26431	"RTN","HMP EQLM1",30, 0)
	26432	F S SEQ= $O(@HMPDAT A@("server s",SEQ)) Q :'SEQ d
	26433	"RTN","HMP EQLM1",31, 0)
	26434	. M X=@HM PDATA@("se rvers",SEQ ) D SRV(.X )
	26435	"RTN","HMP EQLM1",32, 0)
	26436	;
	26437	"RTN","HMP EQLM1",33, 0)
	26438	I VALMCNT =0 D NOROW S^HMPEQ("N o HMP serv er informa tion to di splay")
	26439	"RTN","HMP EQLM1",34, 0)
	26440	S VALMBG= 1
	26441	"RTN","HMP EQLM1",35, 0)
	26442	S VALMSG= "* updates waiting"
	26443	"RTN","HMP EQLM1",36, 0)
	26444	K @HMPDAT A
	26445	"RTN","HMP EQLM1",37, 0)
	26446	Q
	26447	"RTN","HMP EQLM1",38, 0)
	26448	;
	26449	"RTN","HMP EQLM1",39, 0)
	26450	SRV(SRV) ; -- proces s one serv er
	26451	"RTN","HMP EQLM1",40, 0)
	26452	N X,SEQ
	26453	"RTN","HMP EQLM1",41, 0)
	26454	S X=""
	26455	"RTN","HMP EQLM1",42, 0)
	26456	S X=$$SET FLD^VALM1( $G(SRV("na me")),X,"S ERVER")
	26457	"RTN","HMP EQLM1",43, 0)
	26458	S X=$$SET FLD^VALM1( $G(SRV("la stUpdate") ),X,"LAST" )
	26459	"RTN","HMP EQLM1",44, 0)
	26460	S X=$$SET FLD^VALM1( $S($G(SRV( "repeated" )):" x"_$G (SRV("repe ated")),1: ""),X,"REP EATED")
	26461	"RTN","HMP EQLM1",45, 0)
	26462	S X=$$SET FLD^VALM1( $G(SRV("qu eueEnd")), X,"END")
	26463	"RTN","HMP EQLM1",46, 0)
	26464	I $G(SRV( "lastUpdat e")),$G(SR V("lastUpd ate"))'=$G (SRV("queu eEnd")) S X=$$SETFLD ^VALM1("*" ,X,"BEHIND ")
	26465	"RTN","HMP EQLM1",47, 0)
	26466	D SET(X)
	26467	"RTN","HMP EQLM1",48, 0)
	26468	D FLDCTRL ^VALM10(VA LMCNT,"SER VER",IOINH I,IOINORM)
	26469	"RTN","HMP EQLM1",49, 0)
	26470	;
	26471	"RTN","HMP EQLM1",50, 0)
	26472	I '$D(SRV ("extracts ")) Q
	26473	"RTN","HMP EQLM1",51, 0)
	26474	; -- loop thru extr acts for t his server
	26475	"RTN","HMP EQLM1",52, 0)
	26476	D SET($J( "Extract I nformation :",25))
	26477	"RTN","HMP EQLM1",53, 0)
	26478	S SEQ=0
	26479	"RTN","HMP EQLM1",54, 0)
	26480	F S SEQ= $O(SRV("ex tracts",SE Q)) Q:'SEQ D
	26481	"RTN","HMP EQLM1",55, 0)
	26482	. S X=$J( $G(SRV("ex tracts",SE Q,"domain" )),15)
	26483	"RTN","HMP EQLM1",56, 0)
	26484	. S X=X_" Task( s): "_$G(S RV("extrac ts",SEQ,"t asks"))
	26485	"RTN","HMP EQLM1",57, 0)
	26486	. D SET(X )
	26487	"RTN","HMP EQLM1",58, 0)
	26488	. I $G(SR V("extract s",SEQ,"wa iting")) D SET($J("W aiting: ", 29)_$G(SRV ("extracts ",SEQ,"wai ting"))_" seconds") Q
	26489	"RTN","HMP EQLM1",59, 0)
	26490	. D SET($ J("Extract ing: "_$G( SRV("extra cts",SEQ," lastCount" )),40))
	26491	"RTN","HMP EQLM1",60, 0)
	26492	Q
	26493	"RTN","HMP EQLM1",61, 0)
	26494	;
	26495	"RTN","HMP EQLM1",62, 0)
	26496	SET(X,BOLD ) ; -- add line
	26497	"RTN","HMP EQLM1",63, 0)
	26498	S VALMCNT =VALMCNT+1
	26499	"RTN","HMP EQLM1",64, 0)
	26500	S @VALMAR @(VALMCNT, 0)=X
	26501	"RTN","HMP EQLM1",65, 0)
	26502	Q
	26503	"RTN","HMP EQLM1",66, 0)
	26504	;
	26505	"RTN","HMP EQLM1",67, 0)
	26506	KILL ; -- kill off b uild data
	26507	"RTN","HMP EQLM1",68, 0)
	26508	K @VALMAR
	26509	"RTN","HMP EQLM1",69, 0)
	26510	; clean u p video co ntrol data
	26511	"RTN","HMP EQLM1",70, 0)
	26512	D KILL^VA LM10()
	26513	"RTN","HMP EQLM1",71, 0)
	26514	Q
	26515	"RTN","HMP EQLM1",72, 0)
	26516	;
	26517	"RTN","HMP EQLM1",73, 0)
	26518	HELP ; -- help code
	26519	"RTN","HMP EQLM1",74, 0)
	26520	S X="?" D DISP^XQOR M1 W !!
	26521	"RTN","HMP EQLM1",75, 0)
	26522	Q
	26523	"RTN","HMP EQLM1",76, 0)
	26524	;
	26525	"RTN","HMP EQLM1",77, 0)
	26526	EXIT ; -- exit code
	26527	"RTN","HMP EQLM1",78, 0)
	26528	Q
	26529	"RTN","HMP EQLM1",79, 0)
	26530	;
	26531	"RTN","HMP EQLM1",80, 0)
	26532	EXPND ; -- expand co de
	26533	"RTN","HMP EQLM1",81, 0)
	26534	Q
	26535	"RTN","HMP EQLM1",82, 0)
	26536	;
	26537	"RTN","HMP EQLM2")
	26538	0^92^B3277 771
	26539	"RTN","HMP EQLM2",1,0 )
	26540	HMPEQLM2 ; SLC/MJK,AS MR/RRB - H MP Tempora ry Global Lister;01- JUL-2014
	26541	"RTN","HMP EQLM2",2,0 )
	26542	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	26543	"RTN","HMP EQLM2",3,0 )
	26544	;Per VA D irective 6 402, this routine sh ould not b e modified .
	26545	"RTN","HMP EQLM2",4,0 )
	26546	;
	26547	"RTN","HMP EQLM2",5,0 )
	26548	Q
	26549	"RTN","HMP EQLM2",6,0 )
	26550	;
	26551	"RTN","HMP EQLM2",7,0 )
	26552	EN(HMPSRV) ; -- main entry poi nt for HMP M EVT QUE GLOBALS
	26553	"RTN","HMP EQLM2",8,0 )
	26554	D EN^VALM ("HMPM EVT QUE GLOBA LS")
	26555	"RTN","HMP EQLM2",9,0 )
	26556	Q
	26557	"RTN","HMP EQLM2",10, 0)
	26558	;
	26559	"RTN","HMP EQLM2",11, 0)
	26560	HDR ; -- h eader code
	26561	"RTN","HMP EQLM2",12, 0)
	26562	Q
	26563	"RTN","HMP EQLM2",13, 0)
	26564	;
	26565	"RTN","HMP EQLM2",14, 0)
	26566	INIT ; -- init varia bles and l ist array
	26567	"RTN","HMP EQLM2",15, 0)
	26568	N SRVNM,H MPDATA,X,S EQ,TYPE
	26569	"RTN","HMP EQLM2",16, 0)
	26570	K HMPDATA
	26571	"RTN","HMP EQLM2",17, 0)
	26572	S HMPDATA =$NA(^TMP( "HMP TEMP GLOBALS RP T",$J))
	26573	"RTN","HMP EQLM2",18, 0)
	26574	K @HMPDAT A
	26575	"RTN","HMP EQLM2",19, 0)
	26576	D GLBS^HM PEQ(HMPDAT A)
	26577	"RTN","HMP EQLM2",20, 0)
	26578	;
	26579	"RTN","HMP EQLM2",21, 0)
	26580	D KILL
	26581	"RTN","HMP EQLM2",22, 0)
	26582	S VALMCNT =0
	26583	"RTN","HMP EQLM2",23, 0)
	26584	;
	26585	"RTN","HMP EQLM2",24, 0)
	26586	; -- just get selec ted server info if d efined
	26587	"RTN","HMP EQLM2",25, 0)
	26588	S SRVNM=$ S('$G(HMPS RV):"",1:$ P($G(^HMP( 800000,+$G (HMPSRV),0 )),"^"))
	26589	"RTN","HMP EQLM2",26, 0)
	26590	S SEQ=0 F S SEQ=$O (@HMPDATA@ ("xtmpNode s",SEQ)) Q :'SEQ D
	26591	"RTN","HMP EQLM2",27, 0)
	26592	. M X=@HM PDATA@("xt mpNodes",S EQ) D:$G(X ("server") )=SRVNM GL B(.X)
	26593	"RTN","HMP EQLM2",28, 0)
	26594	;
	26595	"RTN","HMP EQLM2",29, 0)
	26596	S TYPE="" F S TYPE =$O(@HMPDA TA@(TYPE)) Q:TYPE="" D
	26597	"RTN","HMP EQLM2",30, 0)
	26598	. D SET(" ")
	26599	"RTN","HMP EQLM2",31, 0)
	26600	. S SEQ=0 F S SEQ= $O(@HMPDAT A@(TYPE,SE Q)) Q:'SEQ D
	26601	"RTN","HMP EQLM2",32, 0)
	26602	. . M X=@ HMPDATA@(T YPE,SEQ) D GLB(.X)
	26603	"RTN","HMP EQLM2",33, 0)
	26604	;
	26605	"RTN","HMP EQLM2",34, 0)
	26606	I VALMCNT =0 D NOROW S^HMPEQ("N o globals to display ")
	26607	"RTN","HMP EQLM2",35, 0)
	26608	S VALMBG= 1
	26609	"RTN","HMP EQLM2",36, 0)
	26610	K @HMPDAT A
	26611	"RTN","HMP EQLM2",37, 0)
	26612	Q
	26613	"RTN","HMP EQLM2",38, 0)
	26614	;
	26615	"RTN","HMP EQLM2",39, 0)
	26616	GLB(GLB) ; --
	26617	"RTN","HMP EQLM2",40, 0)
	26618	S X=""
	26619	"RTN","HMP EQLM2",41, 0)
	26620	S X=$$SET FLD^VALM1( $$DOTS($G( GLB("rootN ode"))),X, "SUBSCRIPT ")
	26621	"RTN","HMP EQLM2",42, 0)
	26622	S X=$$SET FLD^VALM1( $G(GLB("la stNode")), X,"LAST")
	26623	"RTN","HMP EQLM2",43, 0)
	26624	D SET(X)
	26625	"RTN","HMP EQLM2",44, 0)
	26626	Q
	26627	"RTN","HMP EQLM2",45, 0)
	26628	;
	26629	"RTN","HMP EQLM2",46, 0)
	26630	SET(X) ; - - add line
	26631	"RTN","HMP EQLM2",47, 0)
	26632	S VALMCNT =VALMCNT+1
	26633	"RTN","HMP EQLM2",48, 0)
	26634	S @VALMAR @(VALMCNT, 0)=X
	26635	"RTN","HMP EQLM2",49, 0)
	26636	Q
	26637	"RTN","HMP EQLM2",50, 0)
	26638	;
	26639	"RTN","HMP EQLM2",51, 0)
	26640	DOTS(Z) ; -- use dot s
	26641	"RTN","HMP EQLM2",52, 0)
	26642	N DOTS
	26643	"RTN","HMP EQLM2",53, 0)
	26644	S $P(DOTS ,". ",20 )=""
	26645	"RTN","HMP EQLM2",54, 0)
	26646	Q Z_$E(DO TS,$L(Z),6 5)
	26647	"RTN","HMP EQLM2",55, 0)
	26648	;
	26649	"RTN","HMP EQLM2",56, 0)
	26650	KILL ; -- kill off b uild data
	26651	"RTN","HMP EQLM2",57, 0)
	26652	K @VALMAR
	26653	"RTN","HMP EQLM2",58, 0)
	26654	; clean u p video co ntrol data
	26655	"RTN","HMP EQLM2",59, 0)
	26656	D KILL^VA LM10()
	26657	"RTN","HMP EQLM2",60, 0)
	26658	Q
	26659	"RTN","HMP EQLM2",61, 0)
	26660	;
	26661	"RTN","HMP EQLM2",62, 0)
	26662	HELP ; -- help code
	26663	"RTN","HMP EQLM2",63, 0)
	26664	S X="?" D DISP^XQOR M1 W !!
	26665	"RTN","HMP EQLM2",64, 0)
	26666	Q
	26667	"RTN","HMP EQLM2",65, 0)
	26668	;
	26669	"RTN","HMP EQLM2",66, 0)
	26670	EXIT ; -- exit code
	26671	"RTN","HMP EQLM2",67, 0)
	26672	Q
	26673	"RTN","HMP EQLM2",68, 0)
	26674	;
	26675	"RTN","HMP EQLM2",69, 0)
	26676	EXPND ; -- expand co de
	26677	"RTN","HMP EQLM2",70, 0)
	26678	Q
	26679	"RTN","HMP EQLM2",71, 0)
	26680	;
	26681	"RTN","HMP EVNT")
	26682	0^93^B1294 13290
	26683	"RTN","HMP EVNT",1,0)
	26684	HMPEVNT ;S LC/MKB,ASM R/JD,RRB - - VistA ev ent listen ers;Oct 29 , 2015 08: 04:30
	26685	"RTN","HMP EVNT",2,0)
	26686	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	26687	"RTN","HMP EVNT",3,0)
	26688	;Per VA D irective 6 402, this routine sh ould not b e modified .
	26689	"RTN","HMP EVNT",4,0)
	26690	;
	26691	"RTN","HMP EVNT",5,0)
	26692	; DE2818 - SQA find ings.
	26693	"RTN","HMP EVNT",6,0)
	26694	; 1) Corre ct unkille d variable s by modif ying line tags to ac cept varia bles as
	26695	"RTN","HMP EVNT",7,0)
	26696	; paramete rs and mod ifying ass ociated pr otocol rou tine calls to pass v ariables
	26697	"RTN","HMP EVNT",8,0)
	26698	; as param eters. RRB - 10/28/2 015
	26699	"RTN","HMP EVNT",9,0)
	26700	;
	26701	"RTN","HMP EVNT",10,0 )
	26702	; Externa l Referenc es DBIA#
	26703	"RTN","HMP EVNT",11,0 )
	26704	; ------- ---------- -- -----
	26705	"RTN","HMP EVNT",12,0 )
	26706	; DG FIEL D MONITOR 3344
	26707	"RTN","HMP EVNT",13,0 )
	26708	; DGPM MO VEMENT EVE NTS 1181
	26709	"RTN","HMP EVNT",14,0 )
	26710	; GMRA EN TERED IN E RROR 1467
	26711	"RTN","HMP EVNT",15,0 )
	26712	; GMRA SI GN-OFF ON DATA 1469
	26713	"RTN","HMP EVNT",16,0 )
	26714	; GMRC EV SEND OR 3140
	26715	"RTN","HMP EVNT",17,0 )
	26716	; LR70 CH EVSEND OR 6087
	26717	"RTN","HMP EVNT",18,0 )
	26718	; MDC OBS ERVATION U PDATE 6084
	26719	"RTN","HMP EVNT",19,0 )
	26720	; PS EVSE ND OR 2415
	26721	"RTN","HMP EVNT",20,0 )
	26722	; PSB EVS END HMP 6085
	26723	"RTN","HMP EVNT",21,0 )
	26724	; PXK VIS IT DATA EV ENT 1298
	26725	"RTN","HMP EVNT",22,0 )
	26726	; RA EVSE ND OR 6086
	26727	"RTN","HMP EVNT",23,0 )
	26728	; SDAM AP POINTMENT EVENTS 1320
	26729	"RTN","HMP EVNT",24,0 )
	26730	; ^AUPNVS IT 2028
	26731	"RTN","HMP EVNT",25,0 )
	26732	; ^DPT 10035
	26733	"RTN","HMP EVNT",26,0 )
	26734	; ^OR(100 5771
	26735	"RTN","HMP EVNT",27,0 )
	26736	; DIQ 2056
	26737	"RTN","HMP EVNT",28,0 )
	26738	; GMVUTL 5046
	26739	"RTN","HMP EVNT",29,0 )
	26740	; TIUSRVL O 2834
	26741	"RTN","HMP EVNT",30,0 )
	26742	; VADPT 10061
	26743	"RTN","HMP EVNT",31,0 )
	26744	; VASITE 10112
	26745	"RTN","HMP EVNT",32,0 )
	26746	; XLFDT 10103
	26747	"RTN","HMP EVNT",33,0 )
	26748	; XTHC10 5515
	26749	"RTN","HMP EVNT",34,0 )
	26750	Q
	26751	"RTN","HMP EVNT",35,0 )
	26752	;
	26753	"RTN","HMP EVNT",36,0 )
	26754	DG(DGDA,DG FIELD,DGFI LE) ; -- D G FIELD MO NITOR prot ocol liste ner /DE28 18
	26755	"RTN","HMP EVNT",37,0 )
	26756	Q:$G(DGFI LE)'=2 ;Pati ent file o nly
	26757	"RTN","HMP EVNT",38,0 )
	26758	N DFN S D FN=+$G(DGD A)
	26759	"RTN","HMP EVNT",39,0 )
	26760	; operati onal pt-se lect - *s6 8 BEGIN
	26761	"RTN","HMP EVNT",40,0 )
	26762	I "^.01^. 02^.03^.09 ^.101^.351 ^.361^"[(U _+$G(DGFIE LD)_U) D
	26763	"RTN","HMP EVNT",41,0 )
	26764	. ; -- if patient e ntry has b een delete d, delete pt-select object
	26765	"RTN","HMP EVNT",42,0 )
	26766	. I $G(DG FIELD)=".0 1",'$D(^DP T(DFN)) D POSTX("pt- select",DF N,"@") Q ; *s68 - E ND
	26767	"RTN","HMP EVNT",43,0 )
	26768	. D POSTX ("pt-selec t",DFN_"&" _$G(DGFIEL D))
	26769	"RTN","HMP EVNT",44,0 )
	26770	; subscri bed patien t
	26771	"RTN","HMP EVNT",45,0 )
	26772	I $D(^HMP (800000,"A ITEM",DFN) ),$$FLD(+$ G(DGFIELD) ) D POST(D FN,"patien t",DFN)
	26773	"RTN","HMP EVNT",46,0 )
	26774	Q
	26775	"RTN","HMP EVNT",47,0 )
	26776	;
	26777	"RTN","HMP EVNT",48,0 )
	26778	FLD(X) ; - -Return 1 or 0, if X is a fiel d tracked by HMP
	26779	"RTN","HMP EVNT",49,0 )
	26780	S X=U_+$G (X)_U
	26781	"RTN","HMP EVNT",50,0 )
	26782	I "^.01^. 02^.03^.05 ^.08^.09^. 351^.361^. 364^"[X Q 1 ;demograph ic
	26783	"RTN","HMP EVNT",51,0 )
	26784	I "^.111^ .1112^.112 ^.113^.114 ^.115^.131 ^.132^.134 ^"[X Q 1 ;addr/phon e
	26785	"RTN","HMP EVNT",52,0 )
	26786	I "^.211^ .212^.213^ .214^.216^ .217^.218^ .219^"[X Q 1 ;NOK
	26787	"RTN","HMP EVNT",53,0 )
	26788	I "^.301^ .302^1901^ .32102^.32 103^.32201 ^.5295^"[X Q 1 ;serv conn
	26789	"RTN","HMP EVNT",54,0 )
	26790	;New fiel ds. JD - 9/24/15
	26791	"RTN","HMP EVNT",55,0 )
	26792	I "^.133^ "[X Q 1 ;email add ress
	26793	"RTN","HMP EVNT",56,0 )
	26794	I "^.1211 ^.1212^.12 13^.1214^. 1215^.1216 ^"[X Q 1 ;temporary address
	26795	"RTN","HMP EVNT",57,0 )
	26796	I "^.331^ .332^.333^ .334^.335^ .336^.337^ .338^.339^ .33011^"[X Q 1 ;eme rgency con tact addr/ phone
	26797	"RTN","HMP EVNT",58,0 )
	26798	I "^.215^ .21011^"[X Q 1 ;NOK addr line 3 and work phon e
	26799	"RTN","HMP EVNT",59,0 )
	26800	I "^.3731 ^"[X Q 1 ;service c onnected c onditions
	26801	"RTN","HMP EVNT",60,0 )
	26802	I "^.18^3 ^8^16^"[X Q 1 ;insurance
	26803	"RTN","HMP EVNT",61,0 )
	26804	Q 0
	26805	"RTN","HMP EVNT",62,0 )
	26806	;
	26807	"RTN","HMP EVNT",63,0 )
	26808	DGPM(DGPMA ,DGPMDA,DG PMP,DGPMT) ; -- DGPM MOVEMENT EVENTS pro tocol list ener /DE2 818
	26809	"RTN","HMP EVNT",64,0 )
	26810	; [exp ects DFN,D GPM* varia bles]
	26811	"RTN","HMP EVNT",65,0 )
	26812	N ADM,ACT S ADM=DGP MDA
	26813	"RTN","HMP EVNT",66,0 )
	26814	I DGPMT'= 1 S ADM=$S (DGPMA:$P( DGPMA,U,14 ),1:$P(DGP MP,U,14)) Q:ADM<1
	26815	"RTN","HMP EVNT",67,0 )
	26816	S ACT=$S( DGPMA:"",1 :"@")
	26817	"RTN","HMP EVNT",68,0 )
	26818	I $D(^HMP (800000,"A ITEM",DFN) ) D POST(D FN,"visit" ,"H"_ADM,A CT)
	26819	"RTN","HMP EVNT",69,0 )
	26820	; update roster(s) if current movement
	26821	"RTN","HMP EVNT",70,0 )
	26822	N ADMX,MV TX,PREV,NE W,OLD,WARD
	26823	"RTN","HMP EVNT",71,0 )
	26824	S ADMX=$Q (^DGPM("AT ID1",DFN)) Q:$QS(ADM X,4)'=ADM
	26825	"RTN","HMP EVNT",72,0 )
	26826	S MVTX=$Q (^DGPM("AP MV",DFN,AD M)) Q:$QS( MVTX,5)'=D GPMDA
	26827	"RTN","HMP EVNT",73,0 )
	26828	S PREV=$G (DGPMP) I 'PREV,DGPM T'=1 D ;p revious or edited mv t
	26829	"RTN","HMP EVNT",74,0 )
	26830	. S MVTX= $Q(@MVTX) Q:DFN'=$QS (MVTX,2) Q:ADM'=$QS (MVTX,3)
	26831	"RTN","HMP EVNT",75,0 )
	26832	. S PREV= $G(^DGPM(+ $QS(MVTX,5 ),0))
	26833	"RTN","HMP EVNT",76,0 )
	26834	S NEW=$P( DGPMA,U,6) ,OLD=$P(PR EV,U,6)
	26835	"RTN","HMP EVNT",77,0 )
	26836	I NEW'=OL D F WARD=N EW,OLD I W ARD D
	26837	"RTN","HMP EVNT",78,0 )
	26838	. S I=0 F S I=$O(^ HMPROSTR(" AD",WARD_" ;DIC(42,", I)) Q:I<1 D POSTX(" roster",I)
	26839	"RTN","HMP EVNT",79,0 )
	26840	Q
	26841	"RTN","HMP EVNT",80,0 )
	26842	;-find vi sit# for c orrespondi ng admissi on [not us ed]
	26843	"RTN","HMP EVNT",81,0 )
	26844	N ADM,PTF ,IDT,ID,AC T
	26845	"RTN","HMP EVNT",82,0 )
	26846	I DGPMA S ADM=+DGPM A,PTF=+$P( DGPMA,U,16 )
	26847	"RTN","HMP EVNT",83,0 )
	26848	E S ADM= +DGPMP,PTF =+$P(DGPMP ,U,16)
	26849	"RTN","HMP EVNT",84,0 )
	26850	I DGPMT'= 1 D Q:ADM <1
	26851	"RTN","HMP EVNT",85,0 )
	26852	. N VAIP S VAIP("E" )=DGPMDA
	26853	"RTN","HMP EVNT",86,0 )
	26854	. D IN5^V ADPT S ADM =+VAIP(13, 1),PTF=+VA IP(12)
	26855	"RTN","HMP EVNT",87,0 )
	26856	S IDT=999 9999-$P(AD M,".") S:A DM["." IDT =IDT_"."_$ P(ADM,".", 2)
	26857	"RTN","HMP EVNT",88,0 )
	26858	S ID=+$O( ^AUPNVSIT( "AAH",DFN, IDT,0)) Q: 'ID
	26859	"RTN","HMP EVNT",89,0 )
	26860	S ACT=$S( DGPMA:"",1 :"@")
	26861	"RTN","HMP EVNT",90,0 )
	26862	D POST(DF N,"visit", ID,ACT)
	26863	"RTN","HMP EVNT",91,0 )
	26864	; POST(DF N,"ptf",PT F,ACT):DGP MT=3
	26865	"RTN","HMP EVNT",92,0 )
	26866	Q
	26867	"RTN","HMP EVNT",93,0 )
	26868	;
	26869	"RTN","HMP EVNT",94,0 )
	26870	NEWINPT() ; -- is DF N newly ad mitted?
	26871	"RTN","HMP EVNT",95,0 )
	26872	N Y S Y=0
	26873	"RTN","HMP EVNT",96,0 )
	26874	I DGPMT=1 ,DGPMA,'DG PMP,+$G(^D PT(DFN,.10 5))=DGPMDA S Y=1 ;ne w admissio n
	26875	"RTN","HMP EVNT",97,0 )
	26876	Q Y
	26877	"RTN","HMP EVNT",98,0 )
	26878	;
	26879	"RTN","HMP EVNT",99,0 )
	26880	PCMMT(SCPT TMAF,SCPTT MB4) ; -- SCMC PATIE NT TEAM CH ANGES prot ocol liste ner /DE281 8
	26881	"RTN","HMP EVNT",100, 0)
	26882	I '$P($G( SCPTTMB4), U,8),'$P($ G(SCPTTMAF ),U,8) Q ;not pc ch ange
	26883	"RTN","HMP EVNT",101, 0)
	26884	N DFN S D FN=$S($G(S CPTTMAF):+ SCPTTMAF,1 :+$G(SCPTT MB4)) Q:'D FN
	26885	"RTN","HMP EVNT",102, 0)
	26886	D POST(DF N,"patient ",DFN)
	26887	"RTN","HMP EVNT",103, 0)
	26888	Q
	26889	"RTN","HMP EVNT",104, 0)
	26890	;
	26891	"RTN","HMP EVNT",105, 0)
	26892	PCMMTP(SCP TTPAF,SCPT TPB4) ; -- SCMC PATI ENT TEAM P OSITION CH ANGES prot ocol liste ner /DE281 8
	26893	"RTN","HMP EVNT",106, 0)
	26894	I '$P($G( SCPTTPB4), U,5),'$P($ G(SCPTTPAF ),U,5) Q ;not pc ch ange
	26895	"RTN","HMP EVNT",107, 0)
	26896	N TM,DFN
	26897	"RTN","HMP EVNT",108, 0)
	26898	S TM=$S($ G(SCPTTPAF ):+SCPTTPA F,1:+$G(SC PTTPB4)) Q :'TM
	26899	"RTN","HMP EVNT",109, 0)
	26900	;DE2818
	26901	"RTN","HMP EVNT",110, 0)
	26902	S DFN=$$G ET1^DIQ(40 4.42,+TM_" ,",.01,"I" ) ;ICR 19 22
	26903	"RTN","HMP EVNT",111, 0)
	26904	D POST(DF N,"patient ",DFN)
	26905	"RTN","HMP EVNT",112, 0)
	26906	Q
	26907	"RTN","HMP EVNT",113, 0)
	26908	;
	26909	"RTN","HMP EVNT",114, 0)
	26910	SDAM(SDATA ) ; -- SDA M APPOINTM ENT EVENTS protocol listener / DE2818
	26911	"RTN","HMP EVNT",115, 0)
	26912	I $G(SDAT A) D Q ; appointmen ts
	26913	"RTN","HMP EVNT",116, 0)
	26914	. N DFN,D ATE,HLOC,S TS,REASON, PROV
	26915	"RTN","HMP EVNT",117, 0)
	26916	. S DFN=+ $P(SDATA,U ,2) Q:DFN< 1
	26917	"RTN","HMP EVNT",118, 0)
	26918	. Q:'$D(^ HMP(800000 ,"AITEM",D FN))
	26919	"RTN","HMP EVNT",119, 0)
	26920	. S DATE= +$P(SDATA, U,3),HLOC= +$P(SDATA, U,4),(PROV ,REASON)=" "
	26921	"RTN","HMP EVNT",120, 0)
	26922	. ;I SDAM EVT=1 K DI R S DIR(0) ="F^3:20", DIR("A")=" Enter Reas on for App ointment: ",DIR("?") ="Answer m ust be 2-2 0 characte rs" D ^DIR S REASON= Y
	26923	"RTN","HMP EVNT",121, 0)
	26924	. ;I SDAM EVT=1 K DI C S DIC="^ VA(200,",D IC("A")="S elect Pati ent's Prov ider: ",DI C(0)="AEQ" ,D="AK.PRO VIDER" D I X^DIC S PR OV=$P(Y,"^ ",1,2)
	26925	"RTN","HMP EVNT",122, 0)
	26926	. D POST( DFN,"appoi ntment","A ;"_DATE_"; "_HLOC_";" _REASON_"; "_$TR($P(P ROV,U,1,2) ,"^",";"))
	26927	"RTN","HMP EVNT",123, 0)
	26928	Q
	26929	"RTN","HMP EVNT",124, 0)
	26930	;
	26931	"RTN","HMP EVNT",125, 0)
	26932	PCE ; -- P XK VISIT D ATA EVENT protocol l istener
	26933	"RTN","HMP EVNT",126, 0)
	26934	N IEN,PX0 A,PX0B,DFN ,DA,ACT
	26935	"RTN","HMP EVNT",127, 0)
	26936	S IEN=+$O (^TMP("PXK CO",$J,0)) Q:IEN<1
	26937	"RTN","HMP EVNT",128, 0)
	26938	S PX0A=$G (^TMP("PXK CO",$J,IEN ,"VST",IEN ,0,"AFTER" )),PX0B=$G (^("BEFORE "))
	26939	"RTN","HMP EVNT",129, 0)
	26940	S DFN=$S( $L(PX0A):+ $P(PX0A,U, 5),1:+$P(P X0B,U,5))
	26941	"RTN","HMP EVNT",130, 0)
	26942	Q:DFN<1 Q:'$D(^HMP (800000,"A ITEM",DFN) )
	26943	"RTN","HMP EVNT",131, 0)
	26944	; Visit f ile
	26945	"RTN","HMP EVNT",132, 0)
	26946	S ACT=$S( PX0A="":"@ ",1:"")
	26947	"RTN","HMP EVNT",133, 0)
	26948	D POST(DF N,"visit", IEN,ACT)
	26949	"RTN","HMP EVNT",134, 0)
	26950	; check V -files
	26951	"RTN","HMP EVNT",135, 0)
	26952	F SUB="HF ","IMM","X AM","CPT", "PED","POV ","SK" D
	26953	"RTN","HMP EVNT",136, 0)
	26954	. S DA=0 F S DA=$O (^TMP("PXK CO",$J,IEN ,SUB,DA)) Q:DA<1 D
	26955	"RTN","HMP EVNT",137, 0)
	26956	.. S ACT= $S($G(^TMP ("PXKCO",$ J,IEN,SUB, DA,0,"AFTE R"))="":"@ ",1:"")
	26957	"RTN","HMP EVNT",138, 0)
	26958	.. D POST (DFN,$$NAM E(SUB),DA, ACT)
	26959	"RTN","HMP EVNT",139, 0)
	26960	Q
	26961	"RTN","HMP EVNT",140, 0)
	26962	;
	26963	"RTN","HMP EVNT",141, 0)
	26964	NAME(X) ; -- return object nam e for V-fi les
	26965	"RTN","HMP EVNT",142, 0)
	26966	N Y S Y=" "
	26967	"RTN","HMP EVNT",143, 0)
	26968	I X="HF" S Y="fact or"
	26969	"RTN","HMP EVNT",144, 0)
	26970	I X="IMM" S Y="immu nization"
	26971	"RTN","HMP EVNT",145, 0)
	26972	I X="XAM" S Y="exam "
	26973	"RTN","HMP EVNT",146, 0)
	26974	I X="CPT" S Y="cpt"
	26975	"RTN","HMP EVNT",147, 0)
	26976	I X="PED" S Y="educ ation"
	26977	"RTN","HMP EVNT",148, 0)
	26978	I X="POV" S Y="pov"
	26979	"RTN","HMP EVNT",149, 0)
	26980	I X="SK" S Y="skin "
	26981	"RTN","HMP EVNT",150, 0)
	26982	Q Y
	26983	"RTN","HMP EVNT",151, 0)
	26984	;
	26985	"RTN","HMP EVNT",152, 0)
	26986	ZPCE ; -- old PXK VI SIT DATA E VENT proto col listen er [not in use]
	26987	"RTN","HMP EVNT",153, 0)
	26988	N IEN,PX0 ,PX150,DFN ,DA
	26989	"RTN","HMP EVNT",154, 0)
	26990	S IEN=+$O (^TMP("PXK CO",$J,0)) Q:IEN<1
	26991	"RTN","HMP EVNT",155, 0)
	26992	S PX0=$G( ^TMP("PXKC O",$J,IEN, "VST",IEN, 0,"AFTER") ) Q:$P(PX0 ,U,7)="E"
	26993	"RTN","HMP EVNT",156, 0)
	26994	I PX0="" D POST(DFN ,"visit",I EN,"@") Q ;deleted
	26995	"RTN","HMP EVNT",157, 0)
	26996	S PX150=$ G(^TMP("PX KCO",$J,IE N,"VST",IE N,150,"AFT ER")) Q:$P (PX150,U,3 )'="P"
	26997	"RTN","HMP EVNT",158, 0)
	26998	S DFN=+$P (PX0,U,5) Q:DFN<1 Q :'$D(^HMP( 800000,"AI TEM",DFN))
	26999	"RTN","HMP EVNT",159, 0)
	27000	D POST(DF N,"visit", IEN)
	27001	"RTN","HMP EVNT",160, 0)
	27002	S DA=0 F S DA=$O(^ TMP("PXKCO ",$J,IEN," IMM",DA)) Q:DA<1 D POST(DFN," immunizati on",DA)
	27003	"RTN","HMP EVNT",161, 0)
	27004	S DA=0 F S DA=$O(^ TMP("PXKCO ",$J,IEN," HF",DA)) Q :DA<1 D P OST(DFN,"f actor",DA)
	27005	"RTN","HMP EVNT",162, 0)
	27006	Q
	27007	"RTN","HMP EVNT",163, 0)
	27008	;
	27009	"RTN","HMP EVNT",164, 0)
	27010	XQOR(MSG) ; -- messa ging liste ner (updat e meds, la bs, xrays, consults)
	27011	"RTN","HMP EVNT",165, 0)
	27012	N HMPMSG, HMPPKG,MSH ,ORC,DFN
	27013	"RTN","HMP EVNT",166, 0)
	27014	S HMPMSG= $S($L($G(M SG)):MSG,1 :"MSG") Q: '$O(@HMPMS G@(0))
	27015	"RTN","HMP EVNT",167, 0)
	27016	S MSH=0 F S MSH=$O (@HMPMSG@( MSH)) Q:MS H'>0 Q:$E (@HMPMSG@( MSH),1,3)= "MSH"
	27017	"RTN","HMP EVNT",168, 0)
	27018	Q:'MSH Q :'$L($G(@H MPMSG@(MSH )))
	27019	"RTN","HMP EVNT",169, 0)
	27020	S HMPPKG= $$TYPE($P( @HMPMSG@(M SH),"\|",3) ) Q:'$L(H MPPKG)
	27021	"RTN","HMP EVNT",170, 0)
	27022	S DFN=$$P ID Q:DFN<1 Q:'$D(^H MP(800000, "AITEM",DF N))
	27023	"RTN","HMP EVNT",171, 0)
	27024	S ORC=MSH F S ORC= $O(@HMPMSG @(+ORC)) Q :ORC'>0 I $E(@HMPMS G@(ORC),1, 3)="ORC" D
	27025	"RTN","HMP EVNT",172, 0)
	27026	. N ORDCN TRL,PKGIFN ,ORIFN
	27027	"RTN","HMP EVNT",173, 0)
	27028	. S ORC=O RC_U_@HMPM SG@(ORC),O RDCNTRL=$T R($P(ORC," \|",2),"@", "P")
	27029	"RTN","HMP EVNT",174, 0)
	27030	. ; QUIT if action failed, co nversion, purge, or backdoor v erify/new
	27031	"RTN","HMP EVNT",175, 0)
	27032	. I ORDCN TRL["U"!(" DE^ZC^ZP^Z R^ZV^SN"[O RDCNTRL) Q
	27033	"RTN","HMP EVNT",176, 0)
	27034	. S ORIFN =+$P($P(OR C,"\|",3),U ),PKGIFN=$ P($P(ORC," \|",4),U)
	27035	"RTN","HMP EVNT",177, 0)
	27036	. ; if or der has a parent, us e parent# and update entire or der
	27037	"RTN","HMP EVNT",178, 0)
	27038	. S ORIFN =$S($P($G( ^OR(100,OR IFN,3)),U, 9):$P(^(3) ,U,9),1:OR IFN)
	27039	"RTN","HMP EVNT",179, 0)
	27040	. I $$RES ULT D ;up date ancil lary domai ns
	27041	"RTN","HMP EVNT",180, 0)
	27042	.. D POST (DFN,HMPPK G,PKGIFN)
	27043	"RTN","HMP EVNT",181, 0)
	27044	.. D:HMPP KG="image" POST(DFN, "document" ,PKGIFN)
	27045	"RTN","HMP EVNT",182, 0)
	27046	.. I HMPP KG="lab",P KGIFN'["CH ",'$$LRTIU (DFN,PKGIF N) D POST( DFN,"docum ent",$P(PK GIFN,";",4 ,5))
	27047	"RTN","HMP EVNT",183, 0)
	27048	. I ORIFN ,ORDCNTRL' ="ZD" D ; update ord er(s)
	27049	"RTN","HMP EVNT",184, 0)
	27050	.. D POST (DFN,"orde r",ORIFN)
	27051	"RTN","HMP EVNT",185, 0)
	27052	.. N ORIG S ORIG=+$ P($G(^OR(1 00,ORIFN,3 )),U,5)
	27053	"RTN","HMP EVNT",186, 0)
	27054	.. I ORIG D POST(DF N,"order", ORIG) ;nee d fwd ptrs , sig flds
	27055	"RTN","HMP EVNT",187, 0)
	27056	Q
	27057	"RTN","HMP EVNT",188, 0)
	27058	;
	27059	"RTN","HMP EVNT",189, 0)
	27060	RESULT() ; -- Return 1 or 0, i f message broadcasts a result
	27061	"RTN","HMP EVNT",190, 0)
	27062	; [may mo dify PKGIF N for use in POST]
	27063	"RTN","HMP EVNT",191, 0)
	27064	N Y S Y=0
	27065	"RTN","HMP EVNT",192, 0)
	27066	I HMPPKG= "consult" S Y=1,PKGI FN=+PKGIFN G RQ
	27067	"RTN","HMP EVNT",193, 0)
	27068	I HMPPKG= "med" S Y=1,PKGI FN=ORIFN G RQ
	27069	"RTN","HMP EVNT",194, 0)
	27070	I HMPPKG= "lab" S:ORDCNTRL ="RE"&($L( PKGIFN,";" )>3) Y=1 G RQ
	27071	"RTN","HMP EVNT",195, 0)
	27072	I HMPPKG= "image" S:PKGIFN[" ~" Y=1,PKG IFN=$TR($P (PKGIFN,"~ ",2,3),"~" ,"-") G RQ
	27073	"RTN","HMP EVNT",196, 0)
	27074	RQ Q Y
	27075	"RTN","HMP EVNT",197, 0)
	27076	;
	27077	"RTN","HMP EVNT",198, 0)
	27078	LRTIU(DFN, ORPK) ; -- Return 1 or 0, if L R report i s in TIU
	27079	"RTN","HMP EVNT",199, 0)
	27080	I $G(DFN) <1!'$L($G( ORPK)) Q 0
	27081	"RTN","HMP EVNT",200, 0)
	27082	I ORPK["C H"!(ORPK[" MI") Q 0
	27083	"RTN","HMP EVNT",201, 0)
	27084	N SUB,IDT ,LRDFN
	27085	"RTN","HMP EVNT",202, 0)
	27086	S SUB=$P( ORPK,";",4 ),IDT=+$P( ORPK,";",5 ),LRDFN=+$ G(^DPT(+DF N,"LR"))
	27087	"RTN","HMP EVNT",203, 0)
	27088	I $O(^LR( LRDFN,SUB, IDT,.05,0) ) Q 1
	27089	"RTN","HMP EVNT",204, 0)
	27090	Q 0
	27091	"RTN","HMP EVNT",205, 0)
	27092	;
	27093	"RTN","HMP EVNT",206, 0)
	27094	NA(MSG) ; -- messagi ng listene r (new bac kdoor orde rs)
	27095	"RTN","HMP EVNT",207, 0)
	27096	N HMPMSG, HMPPKG,MSH ,ORC,DFN
	27097	"RTN","HMP EVNT",208, 0)
	27098	S HMPMSG= $S($L($G(M SG)):MSG,1 :"MSG") Q: '$O(@HMPMS G@(0))
	27099	"RTN","HMP EVNT",209, 0)
	27100	S MSH=0 F S MSH=$O (@HMPMSG@( MSH)) Q:MS H'>0 Q:$E (@HMPMSG@( MSH),1,3)= "MSH"
	27101	"RTN","HMP EVNT",210, 0)
	27102	Q:'MSH Q :'$L($G(@H MPMSG@(MSH )))
	27103	"RTN","HMP EVNT",211, 0)
	27104	S HMPPKG= $$TYPE($P( @HMPMSG@(M SH),"\|",5) ) Q:'$L(H MPPKG)
	27105	"RTN","HMP EVNT",212, 0)
	27106	S DFN=$$P ID Q:DFN<1 Q:'$D(^H MP(800000, "AITEM",DF N))
	27107	"RTN","HMP EVNT",213, 0)
	27108	S ORC=MSH F S ORC= $O(@HMPMSG @(+ORC)) Q :ORC'>0 I $E(@HMPMS G@(ORC),1, 3)="ORC" D
	27109	"RTN","HMP EVNT",214, 0)
	27110	. N ORDCN TRL,ORIFN
	27111	"RTN","HMP EVNT",215, 0)
	27112	. S ORC=O RC_U_@HMPM SG@(ORC),O RDCNTRL=$T R($P(ORC," \|",2),"@", "P")
	27113	"RTN","HMP EVNT",216, 0)
	27114	. Q:ORDCN TRL'="NA"
	27115	"RTN","HMP EVNT",217, 0)
	27116	. S ORIFN =+$P($P(OR C,"\|",3),U ) D POST(D FN,"order" ,ORIFN)
	27117	"RTN","HMP EVNT",218, 0)
	27118	. I HMPPK G="med" D POST(DFN,H MPPKG,ORIF N)
	27119	"RTN","HMP EVNT",219, 0)
	27120	Q
	27121	"RTN","HMP EVNT",220, 0)
	27122	;
	27123	"RTN","HMP EVNT",221, 0)
	27124	TYPE(NAME) ; -- Retu rns type n ame for XM L
	27125	"RTN","HMP EVNT",222, 0)
	27126	I NAME="L ABORATORY" Q "lab"
	27127	"RTN","HMP EVNT",223, 0)
	27128	I NAME="P HARMACY" Q "med"
	27129	"RTN","HMP EVNT",224, 0)
	27130	I NAME="C ONSULTS" Q "consu lt"
	27131	"RTN","HMP EVNT",225, 0)
	27132	I NAME="P ROCEDURES" Q "consu lt"
	27133	"RTN","HMP EVNT",226, 0)
	27134	I NAME="R ADIOLOGY" Q "image "
	27135	"RTN","HMP EVNT",227, 0)
	27136	I NAME="I MAGING" Q "image "
	27137	"RTN","HMP EVNT",228, 0)
	27138	I NAME="O RDER ENTRY " Q "order "
	27139	"RTN","HMP EVNT",229, 0)
	27140	I NAME="D IETETICS" Q "diet"
	27141	"RTN","HMP EVNT",230, 0)
	27142	Q ""
	27143	"RTN","HMP EVNT",231, 0)
	27144	;
	27145	"RTN","HMP EVNT",232, 0)
	27146	PID() ; -- Returns p atient fro m PID segm ent in cur rent msg
	27147	"RTN","HMP EVNT",233, 0)
	27148	N I,SEG,Y S I=MSH
	27149	"RTN","HMP EVNT",234, 0)
	27150	F S I=$O (@HMPMSG@( I)) Q:I'>0 S SEG=$E (@HMPMSG@( I),1,3) Q: SEG="ORC" I SEG="PI D" D Q
	27151	"RTN","HMP EVNT",235, 0)
	27152	. S Y=+$P (@HMPMSG@( I),"\|",4)
	27153	"RTN","HMP EVNT",236, 0)
	27154	.;I '$D(^ DPT(Y,0)) S:$L($P(@H MPMSG@(I), "\|",5)) Y= +$P(@HMPMS G@(I),"\|", 5) ;alt ID for Lab
	27155	"RTN","HMP EVNT",237, 0)
	27156	Q Y
	27157	"RTN","HMP EVNT",238, 0)
	27158	;
	27159	"RTN","HMP EVNT",239, 0)
	27160	PV1() ; -- Returns p atient cla ss from PV 1 segment in current msg
	27161	"RTN","HMP EVNT",240, 0)
	27162	N I,SEG,Y S I=MSH,Y =""
	27163	"RTN","HMP EVNT",241, 0)
	27164	F S I=$O (@HMPMSG@( I)) Q:I'>0 S SEG=$E (@HMPMSG@( I),1,3) Q: SEG="ORC" I SEG="PV 1" D Q
	27165	"RTN","HMP EVNT",242, 0)
	27166	. S Y=$P( @HMPMSG@(I ),"\|",3)
	27167	"RTN","HMP EVNT",243, 0)
	27168	I Y="",$G (ORIFN) S Y=$$GET1^D IQ(100,+OR IFN_",",10 ,"I")
	27169	"RTN","HMP EVNT",244, 0)
	27170	Q Y
	27171	"RTN","HMP EVNT",245, 0)
	27172	;
	27173	"RTN","HMP EVNT",246, 0)
	27174	GMRA(ACT) ; -- GMRA SIGN-OFF O N DATA pro tocol list ener
	27175	"RTN","HMP EVNT",247, 0)
	27176	; also GMRA ENTER ED IN ERRO R [ACT=@]
	27177	"RTN","HMP EVNT",248, 0)
	27178	N DFN,IEN
	27179	"RTN","HMP EVNT",249, 0)
	27180	S DFN=+$G (GMRAPA(0) ),IEN=+$G( GMRAPA)
	27181	"RTN","HMP EVNT",250, 0)
	27182	D POST(DF N,"allergy ",IEN,$G(A CT))
	27183	"RTN","HMP EVNT",251, 0)
	27184	Q
	27185	"RTN","HMP EVNT",252, 0)
	27186	;
	27187	"RTN","HMP EVNT",253, 0)
	27188	GMPL(DFN,I EN) ; -- G MPL EVENT protocol l istener
	27189	"RTN","HMP EVNT",254, 0)
	27190	S DFN=+$G (DFN),IEN= +$G(IEN)
	27191	"RTN","HMP EVNT",255, 0)
	27192	;N ACT S ACT=$S($P( $G(^AUPNPR OB(IEN,1)) ,U,2)="H": "@",1:"")
	27193	"RTN","HMP EVNT",256, 0)
	27194	D POST(DF N,"problem ",IEN) ;,A CT)
	27195	"RTN","HMP EVNT",257, 0)
	27196	Q
	27197	"RTN","HMP EVNT",258, 0)
	27198	;
	27199	"RTN","HMP EVNT",259, 0)
	27200	GMRV(DFN,I EN,ERR) ; -- Vital M easurement file #120 .5 AHMP in dex
	27201	"RTN","HMP EVNT",260, 0)
	27202	S DFN=+$G (DFN),IEN= +$G(IEN)
	27203	"RTN","HMP EVNT",261, 0)
	27204	N ACT S A CT=$S($G(E RR):"@",1: "")
	27205	"RTN","HMP EVNT",262, 0)
	27206	D POST(DF N,"vital", IEN,ACT)
	27207	"RTN","HMP EVNT",263, 0)
	27208	Q
	27209	"RTN","HMP EVNT",264, 0)
	27210	;
	27211	"RTN","HMP EVNT",265, 0)
	27212	MDC(OBS) ; -- MDC OB SERVATION UPDATE pro tocol list ener
	27213	"RTN","HMP EVNT",266, 0)
	27214	N DFN,ID, ACT
	27215	"RTN","HMP EVNT",267, 0)
	27216	S DFN=+$G (OBS("PATI ENT_ID","I ")) Q:DFN< 1
	27217	"RTN","HMP EVNT",268, 0)
	27218	S ID=$G(O BS("OBS_ID ","I")) Q: '$L(ID)
	27219	"RTN","HMP EVNT",269, 0)
	27220	S ACT=$S( '$G(OBS("S TATUS","I" )):"@",1:" ")
	27221	"RTN","HMP EVNT",270, 0)
	27222	D POST(DF N,"obs",ID ,ACT)
	27223	"RTN","HMP EVNT",271, 0)
	27224	I $G(OBS( "DOMAIN"," VITALS")) D POST(DFN ,"vital",I D,ACT)
	27225	"RTN","HMP EVNT",272, 0)
	27226	Q
	27227	"RTN","HMP EVNT",273, 0)
	27228	;
	27229	"RTN","HMP EVNT",274, 0)
	27230	CP(DFN,ID, ACT) ; -- CP Transac tion file #702 AHMP index
	27231	"RTN","HMP EVNT",275, 0)
	27232	S DFN=+$G (DFN),ID=$ G(ID)
	27233	"RTN","HMP EVNT",276, 0)
	27234	D POST(DF N,"procedu re",ID,$G( ACT))
	27235	"RTN","HMP EVNT",277, 0)
	27236	Q
	27237	"RTN","HMP EVNT",278, 0)
	27238	;
	27239	"RTN","HMP EVNT",279, 0)
	27240	SR(DFN,IEN ,ACT) ; -- Surgery [ SROERR] up date
	27241	"RTN","HMP EVNT",280, 0)
	27242	S DFN=+$G (DFN),IEN= +$G(IEN)
	27243	"RTN","HMP EVNT",281, 0)
	27244	D POST(DF N,"surgery ",IEN,$G(A CT))
	27245	"RTN","HMP EVNT",282, 0)
	27246	Q
	27247	"RTN","HMP EVNT",283, 0)
	27248	;*s68 - B EGINS
	27249	"RTN","HMP EVNT",284, 0)
	27250	TIU(DFN,IE N) ; -- TI U Document file #892 5 AHMP ind ex
	27251	"RTN","HMP EVNT",285, 0)
	27252	N ACT,STS ,DAD
	27253	"RTN","HMP EVNT",286, 0)
	27254	S DFN=+$G (DFN),IEN= +$G(IEN),A CT=""
	27255	"RTN","HMP EVNT",287, 0)
	27256	S STS=$G( X(2)),DAD= $G(X(3)) ; X = FM dat a array fo r index
	27257	"RTN","HMP EVNT",288, 0)
	27258	S:DAD IEN =DAD I 'DA D D ; if addendu m, repull entire not e
	27259	"RTN","HMP EVNT",289, 0)
	27260	. I STS=1 5 S ACT="@ " ; retracted
	27261	"RTN","HMP EVNT",290, 0)
	27262	. I $G(X2 (1))="" S ACT="@" ; deleted (n ew title = null)
	27263	"RTN","HMP EVNT",291, 0)
	27264	D POST(DF N,"documen t",IEN,ACT )
	27265	"RTN","HMP EVNT",292, 0)
	27266	Q
	27267	"RTN","HMP EVNT",293, 0)
	27268	; Depreca ted calls
	27269	"RTN","HMP EVNT",294, 0)
	27270	DOCDEF ;
	27271	"RTN","HMP EVNT",295, 0)
	27272	DOCITEM ;
	27273	"RTN","HMP EVNT",296, 0)
	27274	USR ;
	27275	"RTN","HMP EVNT",297, 0)
	27276	Q
	27277	"RTN","HMP EVNT",298, 0)
	27278	; *s68 - END
	27279	"RTN","HMP EVNT",299, 0)
	27280	PSB(PSBIEN ) ; -- HMP PSB EVENT S protocol listener (BCMA) /DE 2818
	27281	"RTN","HMP EVNT",300, 0)
	27282	N IEN,DFN ,ORPK,TYPE ,ORIFN
	27283	"RTN","HMP EVNT",301, 0)
	27284	S IEN=$S( $P($G(PSBI EN),",",2) '="":+$P(P SBIEN,",", 2),$G(PSBI EN)="+1":+ $G(PSBIEN( 1)),1:+$G( PSBIEN))
	27285	"RTN","HMP EVNT",302, 0)
	27286	S DFN=+$G (^PSB(53.7 9,IEN,0)), ORPK=$P($G (^(.1)),U)
	27287	"RTN","HMP EVNT",303, 0)
	27288	Q:DFN<1 Q:ORPK<1 S TYPE=$S( ORPK["V":" IV",ORPK[" U":5,1:"") Q:TYPE=""
	27289	"RTN","HMP EVNT",304, 0)
	27290	S ORIFN=+ $P($G(^PS( 55,DFN,TYP E,+ORPK,0) ),U,21)
	27291	"RTN","HMP EVNT",305, 0)
	27292	D:ORIFN P OST(DFN,"m ed",ORIFN)
	27293	"RTN","HMP EVNT",306, 0)
	27294	Q
	27295	"RTN","HMP EVNT",307, 0)
	27296	;
	27297	"RTN","HMP EVNT",308, 0)
	27298	XU(IEN,ACT ) ; -- XU USER ADD/C HANGE/TERM INATE opti on listene r
	27299	"RTN","HMP EVNT",309, 0)
	27300	S IEN=+$G (IEN) Q:IE N<1
	27301	"RTN","HMP EVNT",310, 0)
	27302	D POSTX(" user",IEN, $G(ACT))
	27303	"RTN","HMP EVNT",311, 0)
	27304	Q
	27305	"RTN","HMP EVNT",312, 0)
	27306	;
	27307	"RTN","HMP EVNT",313, 0)
	27308	POST(DFN,T YPE,ID,ACT ) ; -- tra ck updated patient d ata
	27309	"RTN","HMP EVNT",314, 0)
	27310	S DFN=+$G (DFN),TYPE =$G(TYPE), ID=$G(ID)
	27311	"RTN","HMP EVNT",315, 0)
	27312	Q:DFN<1 Q:TYPE="" Q:ID="" ;incomple te request
	27313	"RTN","HMP EVNT",316, 0)
	27314	Q:$G(^XTM P("HMP-off ",TYPE)) ;domain t urned 'off '
	27315	"RTN","HMP EVNT",317, 0)
	27316	Q:'$D(^HM P(800000," AITEM",DFN )) ;patie nt not sub scribed to
	27317	"RTN","HMP EVNT",318, 0)
	27318	N HMPDT S HMPDT="HM P-"_DT
	27319	"RTN","HMP EVNT",319, 0)
	27320	;S ^XTMP( HMPDT,$$NE XT)=DFN_U_ TYPE_U_ID_ U_$G(ACT)
	27321	"RTN","HMP EVNT",320, 0)
	27322	N NODES
	27323	"RTN","HMP EVNT",321, 0)
	27324	D POST^HM PDJFS(DFN, TYPE,ID,$G (ACT),"",. NODES)
	27325	"RTN","HMP EVNT",322, 0)
	27326	Q
	27327	"RTN","HMP EVNT",323, 0)
	27328	;
	27329	"RTN","HMP EVNT",324, 0)
	27330	POSTX(TYPE ,ID,ACT) ; -- track updated re ference it ems
	27331	"RTN","HMP EVNT",325, 0)
	27332	S TYPE=$G (TYPE),ID= $G(ID)
	27333	"RTN","HMP EVNT",326, 0)
	27334	Q:TYPE="" Q:ID="" ;incomple te request
	27335	"RTN","HMP EVNT",327, 0)
	27336	Q:$G(^XTM P("HMP-off ",TYPE)) ;domain t urned 'off '
	27337	"RTN","HMP EVNT",328, 0)
	27338	N HMPDT S HMPDT="HM P-"_DT ;"H MPEF-"_DT
	27339	"RTN","HMP EVNT",329, 0)
	27340	;S ^XTMP( HMPDT,$$NE XT)=U_TYPE _U_ID_U_$G (ACT)
	27341	"RTN","HMP EVNT",330, 0)
	27342	N NODES
	27343	"RTN","HMP EVNT",331, 0)
	27344	D POST^HM PDJFS("OPD ",TYPE,ID, $G(ACT),"" ,.NODES)
	27345	"RTN","HMP EVNT",332, 0)
	27346	Q
	27347	"RTN","HMP EVNT",333, 0)
	27348	;
	27349	"RTN","HMP EVNT",334, 0)
	27350	NEXT() ; - - Return n ext sequen tial numbe r in ^XTMP (HMPDT,n)
	27351	"RTN","HMP EVNT",335, 0)
	27352	L +^XTMP( HMPDT):5 ; I'$T ??
	27353	"RTN","HMP EVNT",336, 0)
	27354	N Y S Y=+ $O(^XTMP(H MPDT,"A"), -1)+1
	27355	"RTN","HMP EVNT",337, 0)
	27356	I '$D(^XT MP(HMPDT,0 )) S ^(0)= $$FMADD^XL FDT(DT,3)_ U_DT_"^HMP Updates"
	27357	"RTN","HMP EVNT",338, 0)
	27358	L -^XTMP( HMPDT)
	27359	"RTN","HMP EVNT",339, 0)
	27360	Q Y
	27361	"RTN","HMP EVNT",340, 0)
	27362	;
	27363	"RTN","HMP EVNT",341, 0)
	27364	HTTP(URL,D FN,TYPE,ID ) ; -- sen d message that TYPE/ ID has bee n updated [not in us e]
	27365	"RTN","HMP EVNT",342, 0)
	27366	N DIV,X,H MPX
	27367	"RTN","HMP EVNT",343, 0)
	27368	S DFN=+$G (DFN) Q:DF N<1 ;pati ent req'd
	27369	"RTN","HMP EVNT",344, 0)
	27370	S DIV=$P( $$SITE^VAS ITE,U,3) ; station nu mber
	27371	"RTN","HMP EVNT",345, 0)
	27372	S URL=$G( URL)_"?div ision="_DI V_"&dfn="_ +$G(DFN)
	27373	"RTN","HMP EVNT",346, 0)
	27374	I $L($G(T YPE)) S UR L=URL_"&ty pe="_TYPE
	27375	"RTN","HMP EVNT",347, 0)
	27376	I $L($G(I D)) S UR L=URL_"&id ="_ID
	27377	"RTN","HMP EVNT",348, 0)
	27378	S ^XTMP(" HMP",DFN," HTTP")=$H
	27379	"RTN","HMP EVNT",349, 0)
	27380	S X=$$GET URL^XTHC10 (URL,,"HMP X")
	27381	"RTN","HMP EVNT",350, 0)
	27382	; I X>200 = ERROR
	27383	"RTN","HMP EVNT",351, 0)
	27384	Q
	27385	"RTN","HMP FPTC")
	27386	0^94^B1538 2684
	27387	"RTN","HMP FPTC",1,0)
	27388	HMPFPTC ;S LC/MKB,AGP ,ASMR/RRB - Patient look-up Ut ilities at Facility; Nov 04, 20 15 18:37:3 9
	27389	"RTN","HMP FPTC",2,0)
	27390	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	27391	"RTN","HMP FPTC",3,0)
	27392	;Per VA D irective 6 402, this routine sh ould not b e modified .
	27393	"RTN","HMP FPTC",4,0)
	27394	;
	27395	"RTN","HMP FPTC",5,0)
	27396	Q
	27397	"RTN","HMP FPTC",6,0)
	27398	;
	27399	"RTN","HMP FPTC",7,0)
	27400	CHKS(HMPZ, DFN) ; per form patie nt select checks
	27401	"RTN","HMP FPTC",8,0)
	27402	;
	27403	"RTN","HMP FPTC",9,0)
	27404	N ACCESS, CHKS,CNT,D EATHDT,ERR ,I,IEN,STR ,X,HMPY
	27405	"RTN","HMP FPTC",10,0 )
	27406	; check f or sensiti ve record
	27407	"RTN","HMP FPTC",11,0 )
	27408	S STR="pa tientCheck s"
	27409	"RTN","HMP FPTC",12,0 )
	27410	S ACCESS= 0
	27411	"RTN","HMP FPTC",13,0 )
	27412	D PTSEC^D GSEC4(.HMP Y,DFN) ;I A #3027
	27413	"RTN","HMP FPTC",14,0 )
	27414	S ACCESS= 1
	27415	"RTN","HMP FPTC",15,0 )
	27416	I HMPY(1) >0 D
	27417	"RTN","HMP FPTC",16,0 )
	27418	.S CHKS(" sensitive" ,"dfn")=DF N
	27419	"RTN","HMP FPTC",17,0 )
	27420	.S ACCESS =(HMPY(1)< 3)
	27421	"RTN","HMP FPTC",18,0 )
	27422	.S CHKS(" sensitive" ,"mayAcces s")=$S(ACC ESS=1:"tru e",1:"fals e")
	27423	"RTN","HMP FPTC",19,0 )
	27424	.S CHKS(" sensitive" ,"logAcces s")=$S(HMP Y(1)>1:"tr ue",1:"fal se")
	27425	"RTN","HMP FPTC",20,0 )
	27426	.S CNT=2, X=""
	27427	"RTN","HMP FPTC",21,0 )
	27428	.F S CNT =$O(HMPY(C NT)) Q:CNT '>0 S X=X _$C(13)_$C (10)_$G(HM PY(CNT))
	27429	"RTN","HMP FPTC",22,0 )
	27430	.S CHKS(" sensitive" ,"text")=X
	27431	"RTN","HMP FPTC",23,0 )
	27432	;
	27433	"RTN","HMP FPTC",24,0 )
	27434	; check f or decease d patient, DE2818 ch anged from direct gl obal refer ence
	27435	"RTN","HMP FPTC",25,0 )
	27436	D TOP^HMP XGDPT("DEA THDT",DFN, .351,"E")
	27437	"RTN","HMP FPTC",26,0 )
	27438	D:$L($G(D EATHDT(2,D FN,.351,"E ")))
	27439	"RTN","HMP FPTC",27,0 )
	27440	. S CHKS( "deceased" ,"text")=" This patie nt died on "_DEATHDT (2,DFN,.35 1,"E")_"." _$C(13)_$C (10)_" Do you wish t o continue ?"
	27441	"RTN","HMP FPTC",28,0 )
	27442	;
	27443	"RTN","HMP FPTC",29,0 )
	27444	; check f or similar patients
	27445	"RTN","HMP FPTC",30,0 )
	27446	K HMPY
	27447	"RTN","HMP FPTC",31,0 )
	27448	N MSG,SIM ,SIMPAT,TE XT S MSG=0 ,SIM=0
	27449	"RTN","HMP FPTC",32,0 )
	27450	D GUIBS5A ^DPTLK6(.H MPY,DFN) ;IA #3593
	27451	"RTN","HMP FPTC",33,0 )
	27452	I HMPY(1) >0 D
	27453	"RTN","HMP FPTC",34,0 )
	27454	.S TEXT=" "
	27455	"RTN","HMP FPTC",35,0 )
	27456	.S I=1 F S I=$O(HM PY(I)) Q:' I S X=HMP Y(I) D
	27457	"RTN","HMP FPTC",36,0 )
	27458	.. S SIM= SIM+1
	27459	"RTN","HMP FPTC",37,0 )
	27460	.. I $E(X )=0 S TEXT =$S($L(TEX T):TEXT_$C (13)_$C(10 )_$P(X,U,2 ),1:$P(X,U ,2))
	27461	"RTN","HMP FPTC",38,0 )
	27462	.. I $E(X )=1 D
	27463	"RTN","HMP FPTC",39,0 )
	27464	... ;S CH KS("simila r",SIM,"df n")=$P(X,U ,2)
	27465	"RTN","HMP FPTC",40,0 )
	27466	... ;S CH KS("simila r",SIM,"na me")=$P(X, U,3)
	27467	"RTN","HMP FPTC",41,0 )
	27468	... ;S CH KS("simila r",SIM,"do b")=$$FMTE ^XLFDT($P( X,U,4),"D" )
	27469	"RTN","HMP FPTC",42,0 )
	27470	... ;S CH KS("simila r",SIM,"ss n")=$P(X,U ,5)
	27471	"RTN","HMP FPTC",43,0 )
	27472	... S SIM PAT="Patie nt Name: " _$P(X,U,3) _" Date of Birth: "_ $$FMTE^XLF DT($P(X,U, 4),"D")_" SSN: "_$P( X,U,5)
	27473	"RTN","HMP FPTC",44,0 )
	27474	... S TEX T=TEXT_$C( 13)_$C(10) _SIMPAT
	27475	"RTN","HMP FPTC",45,0 )
	27476	.S CHKS(" similar"," text")=TEX T
	27477	"RTN","HMP FPTC",46,0 )
	27478	;
	27479	"RTN","HMP FPTC",47,0 )
	27480	; possibl y check me ans test: GUIMTD^DPT LK6
	27481	"RTN","HMP FPTC",48,0 )
	27482	; possibl y check le gacy data: I $L($T(H XDATA^A7RD PAGU)...
	27483	"RTN","HMP FPTC",49,0 )
	27484	;
	27485	"RTN","HMP FPTC",50,0 )
	27486	I ACCESS D PRF(DFN, .CHKS)
	27487	"RTN","HMP FPTC",51,0 )
	27488	S ERR(0)= ""
	27489	"RTN","HMP FPTC",52,0 )
	27490	;S HMP=$$ ENCODE^HMP JSON("CHKS ","ERR")
	27491	"RTN","HMP FPTC",53,0 )
	27492	D ENCODE^ HMPJSON("C HKS","HMPZ ","ERR")
	27493	"RTN","HMP FPTC",54,0 )
	27494	Q
	27495	"RTN","HMP FPTC",55,0 )
	27496	;
	27497	"RTN","HMP FPTC",56,0 )
	27498	PRF(DFN,CH KS) ; get Patient Re cord Flags
	27499	"RTN","HMP FPTC",57,0 )
	27500	N HMPY,ED I,PRF,N,X
	27501	"RTN","HMP FPTC",58,0 )
	27502	Q:$$GETAC T^DGPFAPI( DFN,"HMPY" )'>0
	27503	"RTN","HMP FPTC",59,0 )
	27504	S EDI=0 F S EDI=$O (HMPY(EDI) ) Q:EDI<1 K PRF D
	27505	"RTN","HMP FPTC",60,0 )
	27506	. S CHKS( "patientRe cordFlags" ,EDI,"assi gnmentStat us")="Acti ve"
	27507	"RTN","HMP FPTC",61,0 )
	27508	. S CHKS( "patientRe cordFlags" ,EDI,"assi gnTS")=$$J SONDT^HMPU TILS($P($G (HMPY(EDI, "ASSIGNDT" )),U))
	27509	"RTN","HMP FPTC",62,0 )
	27510	. S CHKS( "patientRe cordFlags" ,EDI,"appr oved")=$P( $G(HMPY(ED I,"APPRVBY ")),U,2)
	27511	"RTN","HMP FPTC",63,0 )
	27512	. S CHKS( "patientRe cordFlags" ,EDI,"next ReviewDT") =$$JSONDT^ HMPUTILS($ P($G(HMPY( EDI,"REVIE WDT")),U))
	27513	"RTN","HMP FPTC",64,0 )
	27514	. S CHKS( "patientRe cordFlags" ,EDI,"name ")=$P($G(H MPY(EDI,"F LAG")),U,2 )
	27515	"RTN","HMP FPTC",65,0 )
	27516	. S CHKS( "patientRe cordFlags" ,EDI,"type ")=$P($G(H MPY(EDI,"F LAGTYPE")) ,U,2)
	27517	"RTN","HMP FPTC",66,0 )
	27518	. S CHKS( "patientRe cordFlags" ,EDI,"cate gory")=$P( $G(HMPY(ED I,"CATEGOR Y")),U,2)
	27519	"RTN","HMP FPTC",67,0 )
	27520	. S CHKS( "patientRe cordFlags" ,EDI,"owne rSite")=$P ($G(HMPY(E DI,"OWNER" )),U,2)
	27521	"RTN","HMP FPTC",68,0 )
	27522	. S CHKS( "patientRe cordFlags" ,EDI,"orig inatingSit e")=$P($G( HMPY(EDI," ORIGSITE") ),U,2)
	27523	"RTN","HMP FPTC",69,0 )
	27524	. S N=1,X =$G(HMPY(E DI,"NARR", 1,0))
	27525	"RTN","HMP FPTC",70,0 )
	27526	. F S N= $O(HMPY(ED I,"NARR",N )) Q:N<1 S X=X_$C(1 3)_$C(10)_ $G(HMPY(ED I,"NARR",N ,0))
	27527	"RTN","HMP FPTC",71,0 )
	27528	. S CHKS( "patientRe cordFlags" ,EDI,"text ")=X
	27529	"RTN","HMP FPTC",72,0 )
	27530	Q
	27531	"RTN","HMP FPTC",73,0 )
	27532	;
	27533	"RTN","HMP FPTC",74,0 )
	27534	LOG(HMPZ,D FN) ; Make entry in security l og for sen sitive pat ient acces s
	27535	"RTN","HMP FPTC",75,0 )
	27536	N ERR,RES ULTS,HMPY, X
	27537	"RTN","HMP FPTC",76,0 )
	27538	D NOTICE^ DGSEC4(.HM PY,DFN) ;I A #3027
	27539	"RTN","HMP FPTC",77,0 )
	27540	S X=$S(HM PY:"ok",1: "fail")
	27541	"RTN","HMP FPTC",78,0 )
	27542	S RESULTS ("result") =X
	27543	"RTN","HMP FPTC",79,0 )
	27544	;S HMP=$$ ENCODE^HMP JSON("RESU LTS","ERR" )
	27545	"RTN","HMP FPTC",80,0 )
	27546	D ENCODE^ HMPJSON("R ESULTS","H MPZ","ERR" )
	27547	"RTN","HMP FPTC",81,0 )
	27548	Q
	27549	"RTN","HMP FPTC",82,0 )
	27550	;
	27551	"RTN","HMP FPTC",83,0 )
	27552	ENROS(HMPZ ,DFNARRAY) ;PROCESS PATIENTS F ROM A ROST ER
	27553	"RTN","HMP FPTC",84,0 )
	27554	N DFN S D FN=0
	27555	"RTN","HMP FPTC",85,0 )
	27556	F S DFN= $O(DFNARRA Y(DFN)) Q: DFN'>0 D CHKS(.HMPZ ,DFN)
	27557	"RTN","HMP FPTC",86,0 )
	27558	Q
	27559	"RTN","HMP FPTC",87,0 )
	27560	;
	27561	"RTN","HMP FPTC",88,0 )
	27562	TEST ;
	27563	"RTN","HMP FPTC",89,0 )
	27564	K EDPSITE
	27565	"RTN","HMP FPTC",90,0 )
	27566	S EDPSITE =$$IEN^XUA F4(442),NA ME="doe,jo hn"
	27567	"RTN","HMP FPTC",91,0 )
	27568	D CHKS(1, "",NAME)
	27569	"RTN","HMP FPTC",92,0 )
	27570	;N PID S EDPSITE=$$ IEN^XUAF4( 442)
	27571	"RTN","HMP FPTC",93,0 )
	27572	;R "DFN:" ,PID Q:PID ="" W !
	27573	"RTN","HMP FPTC",94,0 )
	27574	;D CHK(1, PID,$P(^DP T(PID,0),U ))
	27575	"RTN","HMP FPTC",95,0 )
	27576	N I S I=0 F S I=$O (EDPXML(I) ) Q:'I W !,EDPXML(I )
	27577	"RTN","HMP FPTC",96,0 )
	27578	K EDPXML
	27579	"RTN","HMP FPTC",97,0 )
	27580	Q
	27581	"RTN","HMP FPTC",98,0 )
	27582	TEST1 ;
	27583	"RTN","HMP FPTC",99,0 )
	27584	S EDPSITE =$$IEN^XUA F4(442),NA ME="doe,jo hn"
	27585	"RTN","HMP FPTC",100, 0)
	27586	D CHKS(1, "",NAME)
	27587	"RTN","HMP FPTC",101, 0)
	27588	;
	27589	"RTN","HMP FPTC",102, 0)
	27590	;DO LATER ? -- link ed progres s notes
	27591	"RTN","HMP FPTC",103, 0)
	27592	;D GETTIT LE^TIUPRF2 (.EDPT,DFN ,EDI),GETN OTES^TIUPR F2(.EDPN,D FN,EDPT,1)
	27593	"RTN","HMP FPTC",104, 0)
	27594	;I $O(EDP N(0)) D
	27595	"RTN","HMP FPTC",105, 0)
	27596	;. D XML^ EDPX("<not es>")
	27597	"RTN","HMP FPTC",106, 0)
	27598	;. S N=0 F S N=$O( EDPN(N)) Q :N<1 K PN S X=EDPN( N) D
	27599	"RTN","HMP FPTC",107, 0)
	27600	;.. S PN( "id")=+X,P N("action" )=$P(X,U,2 ),PN("auth or")=$P(X, U,4)
	27601	"RTN","HMP FPTC",108, 0)
	27602	;.. S PN( "noteTS")= 9999999-N
	27603	"RTN","HMP FPTC",109, 0)
	27604	;.. D TGE T^TIUSRVR1 (.EDPX,+X)
	27605	"RTN","HMP FPTC",110, 0)
	27606	;.. S X=$ $XMLA^EDPX ("note",.P N),X=$TR(X ,"/") D XM L^EDPX(X)
	27607	"RTN","HMP FPTC",111, 0)
	27608	;.. S I=1 ,X=$G(@EDP X@(1))
	27609	"RTN","HMP FPTC",112, 0)
	27610	;.. F S I=$O(@EDPX @(I)) Q:I< 1 S X=X_$ C(13,10)_$ G(@EDPX@(I ))
	27611	"RTN","HMP FPTC",113, 0)
	27612	;.. S X=" <text>"_$$ ESC^EDPX(X )_"</text> " D XML^ED PX(X)
	27613	"RTN","HMP FPTC",114, 0)
	27614	;.. D XML ^EDPX("</n ote>")
	27615	"RTN","HMP FPTC",115, 0)
	27616	;. D XML^ EDPX("</no tes>")
	27617	"RTN","HMP HTTP")
	27618	0^95^B1463 1122
	27619	"RTN","HMP HTTP",1,0)
	27620	HMPHTTP ;S LC/MKB,ASM R/RRB - HT TP interfa ce;9/25/20 15 10:14
	27621	"RTN","HMP HTTP",2,0)
	27622	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	27623	"RTN","HMP HTTP",3,0)
	27624	;Per VA D irective 6 402, this routine sh ould not b e modified .
	27625	"RTN","HMP HTTP",4,0)
	27626	;
	27627	"RTN","HMP HTTP",5,0)
	27628	; Externa l Referenc es DBIA#
	27629	"RTN","HMP HTTP",6,0)
	27630	; ------- ---------- -- -----
	27631	"RTN","HMP HTTP",7,0)
	27632	; %ZTLOAD 10063
	27633	"RTN","HMP HTTP",8,0)
	27634	; DIR 10026
	27635	"RTN","HMP HTTP",9,0)
	27636	; VASITE 10112
	27637	"RTN","HMP HTTP",10,0 )
	27638	; XLFCRC 3156
	27639	"RTN","HMP HTTP",11,0 )
	27640	; XLFUTL 2622
	27641	"RTN","HMP HTTP",12,0 )
	27642	; XPAR 2263
	27643	"RTN","HMP HTTP",13,0 )
	27644	; XTHC10 5515
	27645	"RTN","HMP HTTP",14,0 )
	27646	; XUPARAM 2541
	27647	"RTN","HMP HTTP",15,0 )
	27648	Q
	27649	"RTN","HMP HTTP",16,0 )
	27650	;
	27651	"RTN","HMP HTTP",17,0 )
	27652	EN ; -- ma nage the b ackground job
	27653	"RTN","HMP HTTP",18,0 )
	27654	N ZTSK,ST S
	27655	"RTN","HMP HTTP",19,0 )
	27656	S ZTSK=+$ G(^XTMP("H MP","ZTSK" )),STS=$$S TS
	27657	"RTN","HMP HTTP",20,0 )
	27658	W !,?24," --- HMP Pa tient Data Monitor - --"
	27659	"RTN","HMP HTTP",21,0 )
	27660	W !!,"Tas k"_$S(ZTSK :" #"_ZTSK ,1:"")_" i s "_$P(STS ,U,2)_".", !
	27661	"RTN","HMP HTTP",22,0 )
	27662	;
	27663	"RTN","HMP HTTP",23,0 )
	27664	I ZTSK,+S TS=1!(+STS =2) D:$$ST OP Q
	27665	"RTN","HMP HTTP",24,0 )
	27666	. N X S X =$$ASKSTOP ^%ZTLOAD(Z TSK)
	27667	"RTN","HMP HTTP",25,0 )
	27668	. W !,$P( X,U,2),!
	27669	"RTN","HMP HTTP",26,0 )
	27670	;
	27671	"RTN","HMP HTTP",27,0 )
	27672	I $$START D
	27673	"RTN","HMP HTTP",28,0 )
	27674	. W !!,"S tarting HM P Patient Data Monit or ... " D QUE
	27675	"RTN","HMP HTTP",29,0 )
	27676	. I $G(ZT SK) W "tas k #"_ZTSK_ " started. ",!
	27677	"RTN","HMP HTTP",30,0 )
	27678	. E W !, "ERROR: ta sk NOT cre ated. Try again lat er.",!
	27679	"RTN","HMP HTTP",31,0 )
	27680	. S ^XTMP ("HMP","ZT SK")=$G(ZT SK)
	27681	"RTN","HMP HTTP",32,0 )
	27682	Q
	27683	"RTN","HMP HTTP",33,0 )
	27684	;
	27685	"RTN","HMP HTTP",34,0 )
	27686	STS() ; -- get the s tatus of Z TSK
	27687	"RTN","HMP HTTP",35,0 )
	27688	D STAT^%Z TLOAD
	27689	"RTN","HMP HTTP",36,0 )
	27690	N Y S Y=+ $G(ZTSK(1) )_U_$G(ZTS K(2))
	27691	"RTN","HMP HTTP",37,0 )
	27692	Q Y
	27693	"RTN","HMP HTTP",38,0 )
	27694	;
	27695	"RTN","HMP HTTP",39,0 )
	27696	STOP() ; - - stop the task?
	27697	"RTN","HMP HTTP",40,0 )
	27698	N X,Y,DIR
	27699	"RTN","HMP HTTP",41,0 )
	27700	S DIR("A" )="Do you want to st op the dat a monitor? ",DIR(0)= "YA",DIR(" B")="NO"
	27701	"RTN","HMP HTTP",42,0 )
	27702	S DIR("?" ,1)="Enter YES to st op or canc el the dat a monitor; please re start ASAP !"
	27703	"RTN","HMP HTTP",43,0 )
	27704	S DIR("?" ,3)="This job must b e running in the bac kground fo r AViVA to be notifi ed"
	27705	"RTN","HMP HTTP",44,0 )
	27706	S DIR("?" )="when ne w patient data is av ailable.", DIR("?",2) =" "
	27707	"RTN","HMP HTTP",45,0 )
	27708	D ^DIR S: Y<1 Y=0
	27709	"RTN","HMP HTTP",46,0 )
	27710	Q Y
	27711	"RTN","HMP HTTP",47,0 )
	27712	;
	27713	"RTN","HMP HTTP",48,0 )
	27714	START() ; -- [re]sta rt the tas k?
	27715	"RTN","HMP HTTP",49,0 )
	27716	N X,Y,DIR
	27717	"RTN","HMP HTTP",50,0 )
	27718	S DIR(0)= "YA",DIR(" B")="YES"
	27719	"RTN","HMP HTTP",51,0 )
	27720	S DIR("A" )="Do you want to "_ $S(STS:"re ",1:"")_"s tart the d ata monito r? "
	27721	"RTN","HMP HTTP",52,0 )
	27722	S DIR("?" ,1)="Enter YES to "_ $S(STS:"re ",1:"")_"s tart the H MP Patient Data Moni tor."
	27723	"RTN","HMP HTTP",53,0 )
	27724	S DIR("?" ,3)="This job must b e running in the bac kground fo r AViVA to be notifi ed"
	27725	"RTN","HMP HTTP",54,0 )
	27726	S DIR("?" )="when ne w patient data is av ailable.", DIR("?",2) =" "
	27727	"RTN","HMP HTTP",55,0 )
	27728	D ^DIR S: Y<1 Y=0
	27729	"RTN","HMP HTTP",56,0 )
	27730	Q Y
	27731	"RTN","HMP HTTP",57,0 )
	27732	;
	27733	"RTN","HMP HTTP",58,0 )
	27734	QUE ; -- c reate the background task: ret urns ZTSK
	27735	"RTN","HMP HTTP",59,0 )
	27736	N IO,IOP, ZTRTN,ZTDE SC,ZTDTH,Z TIO,ZTUCI, ZTCPU,ZTPR I,ZTKIL,ZT SYNC,ZTSAV E,%ZIS
	27737	"RTN","HMP HTTP",60,0 )
	27738	S %ZIS="0 H",IOP="NU LL" D ^%ZI S I POP W !,"Null De vice Not F ound" Q
	27739	"RTN","HMP HTTP",61,0 )
	27740	S ZTDESC= "HMP new d ata monito r for AViV A",ZTDTH=$ H,ZTIO=""
	27741	"RTN","HMP HTTP",62,0 )
	27742	S ZTRTN=" POKE^HMPHT TP" K ZTSK
	27743	"RTN","HMP HTTP",63,0 )
	27744	D ^%ZTLOA D
	27745	"RTN","HMP HTTP",64,0 )
	27746	Q
	27747	"RTN","HMP HTTP",65,0 )
	27748	;
	27749	"RTN","HMP HTTP",66,0 )
	27750	POKE ; -- background job to po ke the cli ent when n ew data is available
	27751	"RTN","HMP HTTP",67,0 )
	27752	; ^XTMP(" HMP",DFN,T YPE,ID) = new data s ince last update
	27753	"RTN","HMP HTTP",68,0 )
	27754	N DIV,ID, DFN,DATA,I OP,X,DA,TO KEN,NEW K ZTSTOP,ZTR EQ
	27755	"RTN","HMP HTTP",69,0 )
	27756	S IOP="NU LL" D ^%ZI S
	27757	"RTN","HMP HTTP",70,0 )
	27758	S ID=(+$H )+$P($H,", ",2)
	27759	"RTN","HMP HTTP",71,0 )
	27760	S DFN=0 F S DFN=$O (^XTMP("HM P",DFN)) Q :DFN<1 I $D(^(DFN)) >9 D
	27761	"RTN","HMP HTTP",72,0 )
	27762	. L +^XTM P("HMP",DF N):5 Q:'$T ;try aga in next cy cle
	27763	"RTN","HMP HTTP",73,0 )
	27764	. K DATA M DATA=^XT MP("HMP",D FN)
	27765	"RTN","HMP HTTP",74,0 )
	27766	. S X=$G( ^XTMP("HMP ",DFN)) K ^(DFN) S ^ (DFN)=X ;c lear list, keep subs cription
	27767	"RTN","HMP HTTP",75,0 )
	27768	. L -^XTM P("HMP",DF N)
	27769	"RTN","HMP HTTP",76,0 )
	27770	. ; add t o list for URL
	27771	"RTN","HMP HTTP",77,0 )
	27772	. S DA=0 F S DA=$O (^HMP(8000 00,"ADFN", DFN,DA)) Q :DA<1 D
	27773	"RTN","HMP HTTP",78,0 )
	27774	.. S TOKE N=DA_"~"_I D,NEW(TOKE N)=""
	27775	"RTN","HMP HTTP",79,0 )
	27776	.. M ^XTM P("HMPX",T OKEN,DFN)= DATA
	27777	"RTN","HMP HTTP",80,0 )
	27778	D SEND(.N EW)
	27779	"RTN","HMP HTTP",81,0 )
	27780	I $$S^%ZT LOAD S ZTS TOP=1,ZTRE Q="@" Q
	27781	"RTN","HMP HTTP",82,0 )
	27782	D HANG S ZTREQ="" ; re-queue
	27783	"RTN","HMP HTTP",83,0 )
	27784	Q
	27785	"RTN","HMP HTTP",84,0 )
	27786	;
	27787	"RTN","HMP HTTP",85,0 )
	27788	SEND(LIST) ; send ea ch list ID to its UR L
	27789	"RTN","HMP HTTP",86,0 )
	27790	N SYS,ID, DA,URL,X
	27791	"RTN","HMP HTTP",87,0 )
	27792	S SYS=$$S YS
	27793	"RTN","HMP HTTP",88,0 )
	27794	; DIV=$P( $$SITE^VAS ITE,U,3) ; station#
	27795	"RTN","HMP HTTP",89,0 )
	27796	S ID="" F S ID=$O( LIST(ID)) Q:ID="" D
	27797	"RTN","HMP HTTP",90,0 )
	27798	. S DA=+I D,URL=$G(^ HMP(800000 ,DA,.1)) Q :URL=""
	27799	"RTN","HMP HTTP",91,0 )
	27800	. S URL=U RL_"?vista Id="_SYS_" &id="_ID
	27801	"RTN","HMP HTTP",92,0 )
	27802	. S X=$$G ETURL^XTHC 10(URL,,"H MPX") ;I X >200 = ERR OR
	27803	"RTN","HMP HTTP",93,0 )
	27804	Q
	27805	"RTN","HMP HTTP",94,0 )
	27806	;
	27807	"RTN","HMP HTTP",95,0 )
	27808	SYS() ; -- return ha shed syste m name
	27809	"RTN","HMP HTTP",96,0 )
	27810	Q $$BASE^ XLFUTL($$C RC16^XLFCR C($$KSP^XU PARAM("WHE RE")),10,1 6)
	27811	"RTN","HMP HTTP",97,0 )
	27812	;
	27813	"RTN","HMP HTTP",98,0 )
	27814	HANG ; -- wait #seco nds
	27815	"RTN","HMP HTTP",99,0 )
	27816	N X S X=$ $GET^XPAR( "ALL","HMP TASK WAIT TIME") S: 'X X=99
	27817	"RTN","HMP HTTP",100, 0)
	27818	H X
	27819	"RTN","HMP HTTP",101, 0)
	27820	Q
	27821	"RTN","HMP HTTP",102, 0)
	27822	;
	27823	"RTN","HMP HTTP",103, 0)
	27824	KILL ; -- kill/reset ^HMP(8000 00) for te sting
	27825	"RTN","HMP HTTP",104, 0)
	27826	K ^HMP(80 0000)
	27827	"RTN","HMP HTTP",105, 0)
	27828	S ^HMP(80 0000,0)="H MP SUBSCRI PTION^8000 00^^"
	27829	"RTN","HMP HTTP",106, 0)
	27830	Q
	27831	"RTN","HMP IDX")
	27832	0^96^B2980 358
	27833	"RTN","HMP IDX",1,0)
	27834	HMPIDX ;SL C/MKB,ASMR /RRB,SRG - Create HM P triggers ;Feb 01, 2 016 14:22: 27
	27835	"RTN","HMP IDX",2,0)
	27836	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	27837	"RTN","HMP IDX",3,0)
	27838	;Per VA D irective 6 402, this routine sh ould not b e modified .
	27839	"RTN","HMP IDX",4,0)
	27840	;
	27841	"RTN","HMP IDX",5,0)
	27842	Q
	27843	"RTN","HMP IDX",6,0)
	27844	;
	27845	"RTN","HMP IDX",7,0)
	27846	;DE2818 d ocumentati on:
	27847	"RTN","HMP IDX",8,0)
	27848	; CREIXN ^DDMOD - I CR 2916
	27849	"RTN","HMP IDX",9,0)
	27850	; EN^XPA R - ICR 22 63
	27851	"RTN","HMP IDX",10,0)
	27852	;
	27853	"RTN","HMP IDX",11,0)
	27854	EN ; -- cr eate index triggers
	27855	"RTN","HMP IDX",12,0)
	27856	; Other i ndexes are created i n HMP 2.0 PREREQUISI TE BUNDLE patches
	27857	"RTN","HMP IDX",13,0)
	27858	; Problem s -- GMPL* 2*36 provi des protoc ol event
	27859	"RTN","HMP IDX",14,0)
	27860	; CLiO -- MD2 38 provide s protocol event
	27861	"RTN","HMP IDX",15,0)
	27862	; TIU -- TIU2 106 provi des index event
	27863	"RTN","HMP IDX",16,0)
	27864	D GMRV ;Vitals
	27865	"RTN","HMP IDX",17,0)
	27866	;
	27867	"RTN","HMP IDX",18,0)
	27868	D EN^XPAR ("PKG.VIRT UAL PATIEN T RECORD", "HMP TASK WAIT TIME" ,1,99)
	27869	"RTN","HMP IDX",19,0)
	27870	;S ^XTMP( "HMP",0)=" 3991231^31 10101^HMP Patient Da ta Monitor "
	27871	"RTN","HMP IDX",20,0)
	27872	Q
	27873	"RTN","HMP IDX",21,0)
	27874	;
	27875	"RTN","HMP IDX",22,0)
	27876	GMRV ; -- create AHM P index on GMRV Meas urement fi le #120.5
	27877	"RTN","HMP IDX",23,0)
	27878	; DE3640: quit if i ndex alrea dy exists, as deleti on of old index by D IKCR will take a lon g time
	27879	"RTN","HMP IDX",24,0)
	27880	Q:$O(^DD( "IX","BB", 120.5,"AHM P",0))
	27881	"RTN","HMP IDX",25,0)
	27882	N HMPX,HM PY
	27883	"RTN","HMP IDX",26,0)
	27884	S HMPX("F ILE")=120. 5,HMPX("NA ME")="AHMP "
	27885	"RTN","HMP IDX",27,0)
	27886	S HMPX("T YPE")="MU" ,HMPX("USE ")="A"
	27887	"RTN","HMP IDX",28,0)
	27888	S HMPX("E XECUTION") ="R",HMPX( "ACTIVITY" )=""
	27889	"RTN","HMP IDX",29,0)
	27890	S HMPX("S HORT DESCR ")="Event for HMP"
	27891	"RTN","HMP IDX",30,0)
	27892	S HMPX("D ESCR",1)=" This index invokes a HMP event point whe n vitals a re modifie d."
	27893	"RTN","HMP IDX",31,0)
	27894	S HMPX("D ESCR",2)=" No actual cross-refe rence node s are set or killed. "
	27895	"RTN","HMP IDX",32,0)
	27896	S HMPX("S ET")="Q:$D (DIU(0))!( $G(XDRDVAL F)=1) D G MRV^HMPEVN T(X,DA,$G( X(3)))"
	27897	"RTN","HMP IDX",33,0)
	27898	S HMPX("K ILL")="Q", HMPX("WHOL E KILL")=" Q"
	27899	"RTN","HMP IDX",34,0)
	27900	S HMPX("V AL",1)=.02 ;Patient
	27901	"RTN","HMP IDX",35,0)
	27902	S HMPX("V AL",2)=1.2 ;Rate
	27903	"RTN","HMP IDX",36,0)
	27904	S HMPX("V AL",3)=2 ;Entered in Error
	27905	"RTN","HMP IDX",37,0)
	27906	D CREIXN^ DDMOD(.HMP X,"",.HMPY ) ;HMPY=ie n^name of index
	27907	"RTN","HMP IDX",38,0)
	27908	Q
	27909	"RTN","HMP IDX",39,0)
	27910	;
	27911	"RTN","HMP JSON")
	27912	0^97^B1163 2331
	27913	"RTN","HMP JSON",1,0)
	27914	HMPJSON ;S LC/KCM,ASM R/RRB - De code/Encod e JSON;9/2 5/2015 10: 15
	27915	"RTN","HMP JSON",2,0)
	27916	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	27917	"RTN","HMP JSON",3,0)
	27918	;Per VA D irective 6 402, this routine sh ould not b e modified .
	27919	"RTN","HMP JSON",4,0)
	27920	;
	27921	"RTN","HMP JSON",5,0)
	27922	Q
	27923	"RTN","HMP JSON",6,0)
	27924	;
	27925	"RTN","HMP JSON",7,0)
	27926	; Note: Since the routines u se closed array refe rences, VV ROOT and V VERR
	27927	"RTN","HMP JSON",8,0)
	27928	; are used t o reduce r isk of nam ing confli cts on the closed ar ray.
	27929	"RTN","HMP JSON",9,0)
	27930	;
	27931	"RTN","HMP JSON",10,0 )
	27932	DECODE(VVJ SON,VVROOT ,VVERR) ; Set JSON object int o closed a rray ref V VROOT
	27933	"RTN","HMP JSON",11,0 )
	27934	; Example s: D DECOD E^HMPJSON( "MYJSON"," LOCALVAR", "LOCALERR" )
	27935	"RTN","HMP JSON",12,0 )
	27936	; D DECOD E^HMPJSON( "^MYJSON(1 )","^GLO(9 9)","^TMP( $J)")
	27937	"RTN","HMP JSON",13,0 )
	27938	;
	27939	"RTN","HMP JSON",14,0 )
	27940	; VVJSON: string/ar ray contai ning seria lized JSON object
	27941	"RTN","HMP JSON",15,0 )
	27942	; VVROOT: closed ar ray refere nce for M representa tion of ob ject
	27943	"RTN","HMP JSON",16,0 )
	27944	; VVERR: contains error mess ages, defa ults to ^T MP("HMPJER R",$J)
	27945	"RTN","HMP JSON",17,0 )
	27946	;
	27947	"RTN","HMP JSON",18,0 )
	27948	; VVIDX : points t o next cha racter in JSON strin g to proce ss
	27949	"RTN","HMP JSON",19,0 )
	27950	; VVSTACK : manages stack of s ubscripts
	27951	"RTN","HMP JSON",20,0 )
	27952	; VHMPOP : true if next strin g is prope rty name, otherwise treat as v alue
	27953	"RTN","HMP JSON",21,0 )
	27954	;
	27955	"RTN","HMP JSON",22,0 )
	27956	G DIRECT^ HMPJSOND
	27957	"RTN","HMP JSON",23,0 )
	27958	;
	27959	"RTN","HMP JSON",24,0 )
	27960	ENCODE(VVR OOT,VVJSON ,VVERR) ; VVROOT (M structure) --> VVJSO N (array o f strings)
	27961	"RTN","HMP JSON",25,0 )
	27962	; Example s: D ENCO DE^HMPJSON ("^GLO(99, 2)","^TMP( $J)")
	27963	"RTN","HMP JSON",26,0 )
	27964	; D ENCO DE^HMPJSON ("LOCALVAR ","MYJSON" ,"LOCALERR ")
	27965	"RTN","HMP JSON",27,0 )
	27966	;
	27967	"RTN","HMP JSON",28,0 )
	27968	; VVROOT: closed ar ray refere nce for M representa tion of ob ject
	27969	"RTN","HMP JSON",29,0 )
	27970	; VVJSON: destinati on variabl e for the string arr ay formatt ed as JSON
	27971	"RTN","HMP JSON",30,0 )
	27972	; VVERR: contains error mess ages, defa ults to ^T MP("HMPJER R",$J)
	27973	"RTN","HMP JSON",31,0 )
	27974	;
	27975	"RTN","HMP JSON",32,0 )
	27976	G DIRECT^ HMPJSONE
	27977	"RTN","HMP JSON",33,0 )
	27978	;
	27979	"RTN","HMP JSON",34,0 )
	27980	;
	27981	"RTN","HMP JSON",35,0 )
	27982	ESC(X) ; E scape stri ng for JSO N
	27983	"RTN","HMP JSON",36,0 )
	27984	Q $$ESC^H MPJSONE(X)
	27985	"RTN","HMP JSON",37,0 )
	27986	;
	27987	"RTN","HMP JSON",38,0 )
	27988	UES(X) ; U nescape JS ON string
	27989	"RTN","HMP JSON",39,0 )
	27990	Q $$UES^H MPJSOND(X)
	27991	"RTN","HMP JSON",40,0 )
	27992	;
	27993	"RTN","HMP JSON",41,0 )
	27994	ERRX(ID,VA L) ; Set t he appropr iate error message
	27995	"RTN","HMP JSON",42,0 )
	27996	; switch (ID) -- XE RRX ends s tatement
	27997	"RTN","HMP JSON",43,0 )
	27998	N ERRMSG
	27999	"RTN","HMP JSON",44,0 )
	28000	;
	28001	"RTN","HMP JSON",45,0 )
	28002	; Decode Error Mess ages
	28003	"RTN","HMP JSON",46,0 )
	28004	;
	28005	"RTN","HMP JSON",47,0 )
	28006	I ID="STL {" S ERRMS G="Stack t oo large f or new obj ect." G XE RRX
	28007	"RTN","HMP JSON",48,0 )
	28008	I ID="SUF }" S ERRMS G="Stack U nderflow - extra } f ound" G XE RRX
	28009	"RTN","HMP JSON",49,0 )
	28010	I ID="STL [" S ERRMS G="Stack t oo large f or new arr ay." G XER RX
	28011	"RTN","HMP JSON",50,0 )
	28012	I ID="SUF ]" S ERRMS G="Stack U nderflow - extra ] f ound." G X ERRX
	28013	"RTN","HMP JSON",51,0 )
	28014	I ID="OBM " S ERRMSG ="Array mi smatch - e xpected ] got }." G XERRX
	28015	"RTN","HMP JSON",52,0 )
	28016	I ID="ARM " S ERRMSG ="Object m ismatch - expected } got ]." G XERRX
	28017	"RTN","HMP JSON",53,0 )
	28018	I ID="MPN " S ERRMSG ="Missing property n ame." G XE RRX
	28019	"RTN","HMP JSON",54,0 )
	28020	I ID="EXT " S ERRMSG ="Expected true, got "_VAL G X ERRX
	28021	"RTN","HMP JSON",55,0 )
	28022	I ID="EXF " S ERRMSG ="Expected false, go t "_VAL G XERRX
	28023	"RTN","HMP JSON",56,0 )
	28024	I ID="EXN " S ERRMSG ="Expected null, got "_VAL G X ERRX
	28025	"RTN","HMP JSON",57,0 )
	28026	I ID="TKN " S ERRMSG ="Unable t o identify type of t oken, valu e was "_VA L G XERRX
	28027	"RTN","HMP JSON",58,0 )
	28028	I ID="SCT " S ERRMSG ="Stack mi smatch - e xit stack level was "_VAL G X ERRX
	28029	"RTN","HMP JSON",59,0 )
	28030	I ID="EIQ " S ERRMSG ="Close qu ote not fo und before end of in put." G XE RRX
	28031	"RTN","HMP JSON",60,0 )
	28032	I ID="EIU " S ERRMSG ="Unexpect ed end of input whil e unescapi ng." G XER RX
	28033	"RTN","HMP JSON",61,0 )
	28034	I ID="RSB " S ERRMSG ="Reverse search for \ past be ginning of input." G XERRX
	28035	"RTN","HMP JSON",62,0 )
	28036	I ID="ORN " S ERRMSG ="Overrun while scan ning name. " G XERRX
	28037	"RTN","HMP JSON",63,0 )
	28038	I ID="OR# " S ERRMSG ="Overrun while scan ning numbe r." G XERR X
	28039	"RTN","HMP JSON",64,0 )
	28040	I ID="ORB " S ERRMSG ="Overrun while scan ning boole an." G XER RX
	28041	"RTN","HMP JSON",65,0 )
	28042	I ID="ESC " S ERRMSG ="Escaped character not recogn ized"_VAL G XERRX
	28043	"RTN","HMP JSON",66,0 )
	28044	;
	28045	"RTN","HMP JSON",67,0 )
	28046	; Encode Error Mess ages
	28047	"RTN","HMP JSON",68,0 )
	28048	;
	28049	"RTN","HMP JSON",69,0 )
	28050	I ID="SOB " S ERRMSG ="Unable t o serializ e node as object, va lue was "_ VAL G XERR X
	28051	"RTN","HMP JSON",70,0 )
	28052	I ID="SAR " S ERRMSG ="Unable t o serializ e node as array, val ue was "_V AL G XERRX
	28053	"RTN","HMP JSON",71,0 )
	28054	S ERRMSG= "Unspecifi ed error " _ID_" "_$G (VAL)
	28055	"RTN","HMP JSON",72,0 )
	28056	XERRX ; en d switch
	28057	"RTN","HMP JSON",73,0 )
	28058	S @VVERR@ (0)=$G(@VV ERR@(0))+1
	28059	"RTN","HMP JSON",74,0 )
	28060	S @VVERR@ (@VVERR@(0 ))=ERRMSG
	28061	"RTN","HMP JSON",75,0 )
	28062	S VVERROR S=VVERRORS +1
	28063	"RTN","HMP JSON",76,0 )
	28064	Q
	28065	"RTN","HMP JSOND")
	28066	0^98^B7168 8388
	28067	"RTN","HMP JSOND",1,0 )
	28068	HMPJSOND ; SLC/KCM,AS MR/RRB - D ecode JSON ;9/25/2015 10:16
	28069	"RTN","HMP JSOND",2,0 )
	28070	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	28071	"RTN","HMP JSOND",3,0 )
	28072	;Per VA D irective 6 402, this routine sh ould not b e modified .
	28073	"RTN","HMP JSOND",4,0 )
	28074	;
	28075	"RTN","HMP JSOND",5,0 )
	28076	Q
	28077	"RTN","HMP JSOND",6,0 )
	28078	;
	28079	"RTN","HMP JSOND",7,0 )
	28080	DECODE(VVJ SON,VVROOT ,VVERR) ; Set JSON o bject into closed ar ray ref VV ROOT
	28081	"RTN","HMP JSOND",8,0 )
	28082	;
	28083	"RTN","HMP JSOND",9,0 )
	28084	DIRECT ; T AG for use by DECODE ^HMPJSON
	28085	"RTN","HMP JSOND",10, 0)
	28086	;
	28087	"RTN","HMP JSOND",11, 0)
	28088	; Example s: D DECOD E^HMPJSON( "MYJSON"," LOCALVAR", "LOCALERR" )
	28089	"RTN","HMP JSOND",12, 0)
	28090	; D DECOD E^HMPJSON( "^MYJSON(1 )","^GLO(9 9)","^TMP( $J)")
	28091	"RTN","HMP JSOND",13, 0)
	28092	;
	28093	"RTN","HMP JSOND",14, 0)
	28094	; VVJSON: string/ar ray contai ning seria lized JSON object
	28095	"RTN","HMP JSOND",15, 0)
	28096	; VVROOT: closed ar ray refere nce for M representa tion of ob ject
	28097	"RTN","HMP JSOND",16, 0)
	28098	; VVERR: contains error mess ages, defa ults to ^T MP("HMPJER R",$J)
	28099	"RTN","HMP JSOND",17, 0)
	28100	;
	28101	"RTN","HMP JSOND",18, 0)
	28102	; VVIDX : points t o next cha racter in JSON strin g to proce ss
	28103	"RTN","HMP JSOND",19, 0)
	28104	; VVSTACK : manages stack of s ubscripts
	28105	"RTN","HMP JSOND",20, 0)
	28106	; VHMPOP : true if next strin g is prope rty name, otherwise treat as v alue
	28107	"RTN","HMP JSOND",21, 0)
	28108	;
	28109	"RTN","HMP JSOND",22, 0)
	28110	N VVMAX S VVMAX=400 0 ; limit document l ines to 40 00 charact ers
	28111	"RTN","HMP JSOND",23, 0)
	28112	S VVERR=$ G(VVERR,"^ TMP(""HMPJ ERR"",$J)" )
	28113	"RTN","HMP JSOND",24, 0)
	28114	; If a si mple strin g is passe d in, move it to an temp array (VVINPUT)
	28115	"RTN","HMP JSOND",25, 0)
	28116	; so that the proce ssing is c onsistentl y on an ar ray.
	28117	"RTN","HMP JSOND",26, 0)
	28118	I $D(@VVJ SON)=1 N V VINPUT S V VINPUT(1)= @VVJSON,VV JSON="VVIN PUT"
	28119	"RTN","HMP JSOND",27, 0)
	28120	S VVROOT= $NA(@VVROO T@("Z")),V VROOT=$E(V VROOT,1,$L (VVROOT)-4 ) ; make o pen array ref
	28121	"RTN","HMP JSOND",28, 0)
	28122	N VVLINE, VVIDX,VVST ACK,VHMPOP ,VVTYPE,VV ERRORS
	28123	"RTN","HMP JSOND",29, 0)
	28124	S VVLINE= $O(@VVJSON @("")),VVI DX=1,VVSTA CK=0,VHMPO P=0,VVERRO RS=0
	28125	"RTN","HMP JSOND",30, 0)
	28126	F S VVTY PE=$$NXTKN () Q:VVTYP E="" D I VVERRORS Q
	28127	"RTN","HMP JSOND",31, 0)
	28128	. I VVTYP E="{" S VV STACK=VVST ACK+1,VVST ACK(VVSTAC K)="",VHMP OP=1 D:VVS TACK>64 ER RX("STL{") Q
	28129	"RTN","HMP JSOND",32, 0)
	28130	. I VVTYP E="}" D Q UIT
	28131	"RTN","HMP JSOND",33, 0)
	28132	. . I +VV STACK(VVST ACK)=VVSTA CK(VVSTACK ),VVSTACK( VVSTACK) D ERRX("OBM ") ; Numer ic and tru e only
	28133	"RTN","HMP JSOND",34, 0)
	28134	. . S VVS TACK=VVSTA CK-1 D:VVS TACK<0 ERR X("SUF}")
	28135	"RTN","HMP JSOND",35, 0)
	28136	. I VVTYP E="[" S VV STACK=VVST ACK+1,VVST ACK(VVSTAC K)=1 D:VVS TACK>64 ER RX("STL[") Q
	28137	"RTN","HMP JSOND",36, 0)
	28138	. I VVTYP E="]" D:'V VSTACK(VVS TACK) ERRX ("ARM") S VVSTACK=VV STACK-1 D: VVSTACK<0 ERRX("SUF] ") Q
	28139	"RTN","HMP JSOND",37, 0)
	28140	. I VVTYP E="," D Q
	28141	"RTN","HMP JSOND",38, 0)
	28142	. . I +VV STACK(VVST ACK)=VVSTA CK(VVSTACK ),VVSTACK( VVSTACK) S VVSTACK(V VSTACK)=VV STACK(VVST ACK)+1 ; VEN/SMH - next in ar ray
	28143	"RTN","HMP JSOND",39, 0)
	28144	. . E S VHMPOP=1 ; or ne xt propert y name
	28145	"RTN","HMP JSOND",40, 0)
	28146	. I VVTYP E=":" S VH MPOP=0 D:' $L($G(VVST ACK(VVSTAC K))) ERRX( "MPN") Q
	28147	"RTN","HMP JSOND",41, 0)
	28148	. I VVTYP E="""" D Q
	28149	"RTN","HMP JSOND",42, 0)
	28150	. . I VHM POP S VVST ACK(VVSTAC K)=$$NAMPA RS() I 1
	28151	"RTN","HMP JSOND",43, 0)
	28152	. . E D ADDSTR
	28153	"RTN","HMP JSOND",44, 0)
	28154	. S VVTYP E=$TR(VVTY PE,"TFN"," tfn")
	28155	"RTN","HMP JSOND",45, 0)
	28156	. I VVTYP E="t" D SE TBOOL("t") Q
	28157	"RTN","HMP JSOND",46, 0)
	28158	. I VVTYP E="f" D SE TBOOL("f") Q
	28159	"RTN","HMP JSOND",47, 0)
	28160	. I VVTYP E="n" D SE TBOOL("n") Q
	28161	"RTN","HMP JSOND",48, 0)
	28162	. I "0123 456789+-.e E"[VVTYPE D SETNUM(V VTYPE) Q ;S @$$CURN ODE()=$$NU MPARS(VVTY PE) Q
	28163	"RTN","HMP JSOND",49, 0)
	28164	. D ERRX( "TKN",VVTY PE)
	28165	"RTN","HMP JSOND",50, 0)
	28166	I VVSTACK '=0 D ERRX ("SCT",VVS TACK)
	28167	"RTN","HMP JSOND",51, 0)
	28168	Q
	28169	"RTN","HMP JSOND",52, 0)
	28170	NXTKN() ; Move the p ointers to the begin ning of th e next tok en
	28171	"RTN","HMP JSOND",53, 0)
	28172	N VVDONE, VVEOF,VVTO KEN
	28173	"RTN","HMP JSOND",54, 0)
	28174	S VVDONE= 0,VVEOF=0 F D Q:VV DONE!VVEOF ; eat sp aces & new lines unt il next vi sible char
	28175	"RTN","HMP JSOND",55, 0)
	28176	. I VVIDX >$L(@VVJSO N@(VVLINE) ) S VVLINE =$O(@VVJSO N@(VVLINE) ),VVIDX=1 I 'VVLINE S VVEOF=1 Q
	28177	"RTN","HMP JSOND",56, 0)
	28178	. I $A(@V VJSON@(VVL INE),VVIDX )>32 S VVD ONE=1 Q
	28179	"RTN","HMP JSOND",57, 0)
	28180	. S VVIDX =VVIDX+1
	28181	"RTN","HMP JSOND",58, 0)
	28182	Q:VVEOF " " ; we're at the en d of input
	28183	"RTN","HMP JSOND",59, 0)
	28184	S VVTOKEN =$E(@VVJSO N@(VVLINE) ,VVIDX),VV IDX=VVIDX+ 1
	28185	"RTN","HMP JSOND",60, 0)
	28186	Q VVTOKEN
	28187	"RTN","HMP JSOND",61, 0)
	28188	;
	28189	"RTN","HMP JSOND",62, 0)
	28190	ADDSTR ; A dd string value to c urrent nod e, escapin g text alo ng the way
	28191	"RTN","HMP JSOND",63, 0)
	28192	; Expects VVLINE,VV IDX to ref erence tha t starting point of the index
	28193	"RTN","HMP JSOND",64, 0)
	28194	; TODO: a dd a mecha nism to sp ecify name s that sho uld not be escaped
	28195	"RTN","HMP JSOND",65, 0)
	28196	; j ust store as ":")= a nd ":",n)=
	28197	"RTN","HMP JSOND",66, 0)
	28198	;
	28199	"RTN","HMP JSOND",67, 0)
	28200	; Happy p ath -- we find the e nd quote i n the same line
	28201	"RTN","HMP JSOND",68, 0)
	28202	N VVEND,V VX
	28203	"RTN","HMP JSOND",69, 0)
	28204	S VVEND=$ F(@VVJSON@ (VVLINE)," """,VVIDX)
	28205	"RTN","HMP JSOND",70, 0)
	28206	I VVEND,( $E(@VVJSON @(VVLINE), VVEND-2)'= "\") D SET STR QUIT ;normal
	28207	"RTN","HMP JSOND",71, 0)
	28208	I VVEND,$ $ISCLOSEQ( VVLINE) D SETSTR QUI T ;close quote prec eded by es caped \
	28209	"RTN","HMP JSOND",72, 0)
	28210	;
	28211	"RTN","HMP JSOND",73, 0)
	28212	; Less ha ppy path - - first qu ote wasn't close quo te
	28213	"RTN","HMP JSOND",74, 0)
	28214	N VVDONE, VVTLINE
	28215	"RTN","HMP JSOND",75, 0)
	28216	S VVDONE= 0,VVTLINE= VVLINE ; V VTLINE for temporary increment of VVLINE
	28217	"RTN","HMP JSOND",76, 0)
	28218	F D Q:V VDONE Q:V VERRORS
	28219	"RTN","HMP JSOND",77, 0)
	28220	. ;if no quote on c urrent lin e advance line, scan again
	28221	"RTN","HMP JSOND",78, 0)
	28222	. I 'VVEN D S VVTLIN E=VVTLINE+ 1,VVEND=1 I '$D(@VVJ SON@(VVTLI NE)) D ERR X("EIQ") Q
	28223	"RTN","HMP JSOND",79, 0)
	28224	. S VVEND =$F(@VVJSO N@(VVTLINE ),"""",VVE ND)
	28225	"RTN","HMP JSOND",80, 0)
	28226	. Q:'VVEN D ; conti nue on to next line if no quot e found on this one
	28227	"RTN","HMP JSOND",81, 0)
	28228	. I (VVEN D>2),($E(@ VVJSON@(VV TLINE),VVE ND-2)'="\" ) S VVDONE =1 Q ; fo und quote position
	28229	"RTN","HMP JSOND",82, 0)
	28230	. S VVDON E=$$ISCLOS EQ(VVTLINE ) ; see if this is a n escaped quote or c losing quo te
	28231	"RTN","HMP JSOND",83, 0)
	28232	Q:VVERROR S
	28233	"RTN","HMP JSOND",84, 0)
	28234	; unescap e from VVI DX to VVEN D, using \ -extension nodes as necessary
	28235	"RTN","HMP JSOND",85, 0)
	28236	D UESEXT
	28237	"RTN","HMP JSOND",86, 0)
	28238	; now we need to mo ve VVLINE and VVIDX to next pa rsing poin t
	28239	"RTN","HMP JSOND",87, 0)
	28240	S VVLINE= VVTLINE,VV IDX=VVEND
	28241	"RTN","HMP JSOND",88, 0)
	28242	Q
	28243	"RTN","HMP JSOND",89, 0)
	28244	SETSTR ; S et simple string val ue from wi thin same line
	28245	"RTN","HMP JSOND",90, 0)
	28246	; expects VVJSON, V VLINE, VVI NX, VVEND
	28247	"RTN","HMP JSOND",91, 0)
	28248	N VVX
	28249	"RTN","HMP JSOND",92, 0)
	28250	S VVX=$E( @VVJSON@(V VLINE),VVI DX,VVEND-2 ),VVIDX=VV END
	28251	"RTN","HMP JSOND",93, 0)
	28252	S @$$CURN ODE()=$$UE S(VVX)
	28253	"RTN","HMP JSOND",94, 0)
	28254	; "\s" no de indicat es value i s really a string in case valu e
	28255	"RTN","HMP JSOND",95, 0)
	28256	; co llates as numeric or equals bo olean keyw ords
	28257	"RTN","HMP JSOND",96, 0)
	28258	I VVX']]$ C(1) S @$$ CURNODE()@ ("\s")=""
	28259	"RTN","HMP JSOND",97, 0)
	28260	I VVX="tr ue"!(VVX=" false")!(V VX="null") S @$$CURN ODE()@("\s ")=""
	28261	"RTN","HMP JSOND",98, 0)
	28262	I VVIDX>$ L(@VVJSON@ (VVLINE)) S VVLINE=V VLINE+1,VV IDX=1
	28263	"RTN","HMP JSOND",99, 0)
	28264	Q
	28265	"RTN","HMP JSOND",100 ,0)
	28266	UESEXT ; u nescape fr om VVLINE, VVIDX to V VTLINE,VVE ND & exten d (\) if n ecessary
	28267	"RTN","HMP JSOND",101 ,0)
	28268	; expects VVLINE,VV IDX,VVTLIN E,VVEND
	28269	"RTN","HMP JSOND",102 ,0)
	28270	N VVI,VVY ,VVSTART,V VSTOP,VVDO NE,VVBUF,V VNODE,VVMO RE,VVTO
	28271	"RTN","HMP JSOND",103 ,0)
	28272	S VVNODE= $$CURNODE( ),VVBUF="" ,VVMORE=0, VVSTOP=VVE ND-2
	28273	"RTN","HMP JSOND",104 ,0)
	28274	S VVI=VVI DX,VVY=VVL INE,VVDONE =0
	28275	"RTN","HMP JSOND",105 ,0)
	28276	F D Q:V VDONE Q:V VERRORS
	28277	"RTN","HMP JSOND",106 ,0)
	28278	. S VVSTA RT=VVI,VVI =$F(@VVJSO N@(VVY),"\ ",VVI)
	28279	"RTN","HMP JSOND",107 ,0)
	28280	. ; if we are on th e last lin e, don't e xtract pas t VVSTOP
	28281	"RTN","HMP JSOND",108 ,0)
	28282	. I (VVY= VVTLINE) S VVTO=$S(' VVI:VVSTOP ,VVI>VVSTO P:VVSTOP,1 :VVI-2) I 1
	28283	"RTN","HMP JSOND",109 ,0)
	28284	. E S VV TO=$S('VVI :99999,1:V VI-2)
	28285	"RTN","HMP JSOND",110 ,0)
	28286	. D ADDBU F($E(@VVJS ON@(VVY),V VSTART,VVT O))
	28287	"RTN","HMP JSOND",111 ,0)
	28288	. I (VVY' <VVTLINE), (('VVI)!(V VI>VVSTOP) ) S VVDONE =1 QUIT ; now past close quot e
	28289	"RTN","HMP JSOND",112 ,0)
	28290	. I 'VVI S VVY=VVY+ 1,VVI=1 QU IT ; noth ing escape d, go to n ext line
	28291	"RTN","HMP JSOND",113 ,0)
	28292	. I VVI>$ L(@VVJSON@ (VVY)) S V VY=VVY+1,V VI=1 I '$D (@VVJSON@( VVY)) D ER RX("EIU")
	28293	"RTN","HMP JSOND",114 ,0)
	28294	. N VVTGT S VVTGT=$ E(@VVJSON@ (VVY),VVI)
	28295	"RTN","HMP JSOND",115 ,0)
	28296	. I VVTGT ="u" D I 1
	28297	"RTN","HMP JSOND",116 ,0)
	28298	. . N VVT GTC S VVTG TC=$E(@VVJ SON@(VVY), VVI+1,VVI+ 4),VVI=VVI +4
	28299	"RTN","HMP JSOND",117 ,0)
	28300	. . I $L( VVTGTC)<4 S VVY=VVY+ 1,VVI=4-$L (VVTGTC),V VTGTC=VVTG TC_$E(@VVJ SON@(VVY), 1,VVI)
	28301	"RTN","HMP JSOND",118 ,0)
	28302	. . D ADD BUF($C($$D EC^XLFUTL( VVTGTC,16) ))
	28303	"RTN","HMP JSOND",119 ,0)
	28304	. E D AD DBUF($$REA LCHAR(VVTG T))
	28305	"RTN","HMP JSOND",120 ,0)
	28306	. S VVI=V VI+1
	28307	"RTN","HMP JSOND",121 ,0)
	28308	. I (VVY' <VVTLINE), (VVI>VVSTO P) S VVDON E=1 ; VVI incremente d past sto p
	28309	"RTN","HMP JSOND",122 ,0)
	28310	Q:VVERROR S
	28311	"RTN","HMP JSOND",123 ,0)
	28312	D SAVEBUF
	28313	"RTN","HMP JSOND",124 ,0)
	28314	Q
	28315	"RTN","HMP JSOND",125 ,0)
	28316	ADDBUF(VVX ) ; add bu ffer of ch aracters t o destinat ion
	28317	"RTN","HMP JSOND",126 ,0)
	28318	; expects VVBUF,VVM AX,VVNODE, VVMORE to be defined
	28319	"RTN","HMP JSOND",127 ,0)
	28320	; used di rectly by ADDSTR
	28321	"RTN","HMP JSOND",128 ,0)
	28322	I $L(VVX) +$L(VVBUF) >VVMAX D S AVEBUF
	28323	"RTN","HMP JSOND",129 ,0)
	28324	S VVBUF=V VBUF_VVX
	28325	"RTN","HMP JSOND",130 ,0)
	28326	Q
	28327	"RTN","HMP JSOND",131 ,0)
	28328	SAVEBUF ; write out buffer to destinatio n
	28329	"RTN","HMP JSOND",132 ,0)
	28330	; expects VVBUF,VVM AX,VVNODE, VVMORE to be defined
	28331	"RTN","HMP JSOND",133 ,0)
	28332	; used di rectly by ADDSTR,ADD BUF
	28333	"RTN","HMP JSOND",134 ,0)
	28334	I VVMORE S @VVNODE@ ("\",VVMOR E)=VVBUF
	28335	"RTN","HMP JSOND",135 ,0)
	28336	I 'VVMORE S @VVNODE =VVBUF I $ L(VVBUF)<1 9,+$E(VVBU F,1,18) S @VVNODE@(" \s")=""
	28337	"RTN","HMP JSOND",136 ,0)
	28338	S VVMORE= VVMORE+1,V VBUF=""
	28339	"RTN","HMP JSOND",137 ,0)
	28340	Q
	28341	"RTN","HMP JSOND",138 ,0)
	28342	ISCLOSEQ(V VBLINE) ; return tru e if this is a closi ng, rather than esca ped, quote
	28343	"RTN","HMP JSOND",139 ,0)
	28344	; expects
	28345	"RTN","HMP JSOND",140 ,0)
	28346	; VVJSO N: lines o f the JSON encoded s tring
	28347	"RTN","HMP JSOND",141 ,0)
	28348	; VVID X: points to 1st cha racter of the segmen t
	28349	"RTN","HMP JSOND",142 ,0)
	28350	; VVLIN E: points to the lin e in which the segme nt starts
	28351	"RTN","HMP JSOND",143 ,0)
	28352	; VVEN D: points to 1st cha racter aft er the " ( may be pas t the end of the lin e)
	28353	"RTN","HMP JSOND",144 ,0)
	28354	; used di rectly by ADDSTR
	28355	"RTN","HMP JSOND",145 ,0)
	28356	N VVBS,VV BIDX,VVBDO NE
	28357	"RTN","HMP JSOND",146 ,0)
	28358	S VVBS=0, VVBIDX=VVE ND-2,VVBDO NE=0 ; VVB IDX starts at 1st ch aracter be fore quote
	28359	"RTN","HMP JSOND",147 ,0)
	28360	; count t he backsla shes prece ding the q uote (odd number mea ns the quo te was esc aped)
	28361	"RTN","HMP JSOND",148 ,0)
	28362	F D Q:V VBDONE!VVE RRORS
	28363	"RTN","HMP JSOND",149 ,0)
	28364	. I VVBID X<1 D Q ; when VVB IDX<1 go b ack a line
	28365	"RTN","HMP JSOND",150 ,0)
	28366	. . S VVB LINE=VVBLI NE-1 I VVB LINE<VVLIN E D ERRX(" RSB") Q
	28367	"RTN","HMP JSOND",151 ,0)
	28368	. . S VVB IDX=$L(@VV JSON@(VVBL INE))
	28369	"RTN","HMP JSOND",152 ,0)
	28370	. I $E(@V VJSON@(VVB LINE),VVBI DX)'="\" S VVBDONE=1 Q
	28371	"RTN","HMP JSOND",153 ,0)
	28372	. S VVBS= VVBS+1,VVB IDX=VVBIDX -1
	28373	"RTN","HMP JSOND",154 ,0)
	28374	Q VVBS#2= 0 ; VVBS is even if this is a close quo te
	28375	"RTN","HMP JSOND",155 ,0)
	28376	;
	28377	"RTN","HMP JSOND",156 ,0)
	28378	NAMPARS() ; Return p arsed name , advancin g index pa st the clo se quote
	28379	"RTN","HMP JSOND",157 ,0)
	28380	; -- This assumes n o embedded quotes ar e in the n ame itself --
	28381	"RTN","HMP JSOND",158 ,0)
	28382	N VVEND,V VDONE,VVNA ME
	28383	"RTN","HMP JSOND",159 ,0)
	28384	S VVDONE= 0,VVNAME=" "
	28385	"RTN","HMP JSOND",160 ,0)
	28386	F D Q:V VDONE Q:V VERRORS
	28387	"RTN","HMP JSOND",161 ,0)
	28388	. S VVEND =$F(@VVJSO N@(VVLINE) ,"""",VVID X)
	28389	"RTN","HMP JSOND",162 ,0)
	28390	. I VVEND S VVNAME= VVNAME_$E( @VVJSON@(V VLINE),VVI DX,VVEND-2 ),VVIDX=VV END,VVDONE =1
	28391	"RTN","HMP JSOND",163 ,0)
	28392	. I 'VVEN D S VVNAME =VVNAME_$E (@VVJSON@( VVLINE),VV IDX,$L(@VV JSON@(VVLI NE)))
	28393	"RTN","HMP JSOND",164 ,0)
	28394	. I 'VVEN D!(VVEND>$ L(@VVJSON@ (VVLINE))) S VVLINE= VVLINE+1,V VIDX=1 I ' $D(@VVJSON @(VVLINE)) D ERRX("O RN")
	28395	"RTN","HMP JSOND",165 ,0)
	28396	; prepend quote if label coll ates as nu meric -- a ssumes no quotes in label
	28397	"RTN","HMP JSOND",166 ,0)
	28398	I VVNAME' ]]$C(1) S VVNAME=""" """_VVNAME
	28399	"RTN","HMP JSOND",167 ,0)
	28400	Q VVNAME
	28401	"RTN","HMP JSOND",168 ,0)
	28402	;
	28403	"RTN","HMP JSOND",169 ,0)
	28404	SETNUM(VVD IGIT) ; Se t numeric along with any neces sary modif ier
	28405	"RTN","HMP JSOND",170 ,0)
	28406	N VVX
	28407	"RTN","HMP JSOND",171 ,0)
	28408	S VVX=$$N UMPARS(VVD IGIT)
	28409	"RTN","HMP JSOND",172 ,0)
	28410	S @$$CURN ODE()=+VVX
	28411	"RTN","HMP JSOND",173 ,0)
	28412	; if nume ric is exp onent, "0. nnn" or "- 0.nnn" sto re origina l string
	28413	"RTN","HMP JSOND",174 ,0)
	28414	I +VVX'=V VX S @$$CU RNODE()@(" \n")=VVX
	28415	"RTN","HMP JSOND",175 ,0)
	28416	Q
	28417	"RTN","HMP JSOND",176 ,0)
	28418	NUMPARS(VV DIGIT) ; R eturn pars ed number, advancing index pas t end of n umber
	28419	"RTN","HMP JSOND",177 ,0)
	28420	; VVIDX i nitially r eferences the second digit
	28421	"RTN","HMP JSOND",178 ,0)
	28422	N VVDONE, VVNUM
	28423	"RTN","HMP JSOND",179 ,0)
	28424	S VVDONE= 0,VVNUM=VV DIGIT
	28425	"RTN","HMP JSOND",180 ,0)
	28426	F D Q:V VDONE Q:V VERRORS
	28427	"RTN","HMP JSOND",181 ,0)
	28428	. I '("01 23456789+- .eE"[$E(@V VJSON@(VVL INE),VVIDX )) S VVDON E=1 Q
	28429	"RTN","HMP JSOND",182 ,0)
	28430	. S VVNUM =VVNUM_$E( @VVJSON@(V VLINE),VVI DX)
	28431	"RTN","HMP JSOND",183 ,0)
	28432	. S VVIDX =VVIDX+1 I VVIDX>$L( @VVJSON@(V VLINE)) S VVLINE=VVL INE+1,VVID X=1 I '$D( @VVJSON@(V VLINE)) D ERRX("OR#" )
	28433	"RTN","HMP JSOND",184 ,0)
	28434	Q VVNUM
	28435	"RTN","HMP JSOND",185 ,0)
	28436	;
	28437	"RTN","HMP JSOND",186 ,0)
	28438	SETBOOL(VV LTR) ; Par se and set boolean v alue, adva ncing inde x past end of value
	28439	"RTN","HMP JSOND",187 ,0)
	28440	N VVDONE, VVBOOL,VVX
	28441	"RTN","HMP JSOND",188 ,0)
	28442	S VVDONE= 0,VVBOOL=V VLTR
	28443	"RTN","HMP JSOND",189 ,0)
	28444	F D Q:V VDONE Q:V VERRORS
	28445	"RTN","HMP JSOND",190 ,0)
	28446	. S VVX=$ TR($E(@VVJ SON@(VVLIN E),VVIDX), "TRUEFALSN ","truefal sn")
	28447	"RTN","HMP JSOND",191 ,0)
	28448	. I '("tr uefalsn"[V VX) S VVDO NE=1 Q
	28449	"RTN","HMP JSOND",192 ,0)
	28450	. S VVBOO L=VVBOOL_V VX
	28451	"RTN","HMP JSOND",193 ,0)
	28452	. S VVIDX =VVIDX+1 I VVIDX>$L( @VVJSON@(V VLINE)) S VVLINE=VVL INE+1,VVID X=1 I '$D( @VVJSON@(V VLINE)) D ERRX("ORB" )
	28453	"RTN","HMP JSOND",194 ,0)
	28454	I VVLTR=" t",(VVBOOL '="true") D ERRX("EX T",VVTYPE)
	28455	"RTN","HMP JSOND",195 ,0)
	28456	I VVLTR=" f",(VVBOOL '="false") D ERRX("E XF",VVTYPE )
	28457	"RTN","HMP JSOND",196 ,0)
	28458	I VVLTR=" n",(VVBOOL '="null") D ERRX("EX N",VVTYPE)
	28459	"RTN","HMP JSOND",197 ,0)
	28460	S @$$CURN ODE()=VVBO OL
	28461	"RTN","HMP JSOND",198 ,0)
	28462	Q
	28463	"RTN","HMP JSOND",199 ,0)
	28464	;
	28465	"RTN","HMP JSOND",200 ,0)
	28466	OSETBOOL(V VX) ; set a value an d incremen t VVIDX
	28467	"RTN","HMP JSOND",201 ,0)
	28468	S @$$CURN ODE()=VVX
	28469	"RTN","HMP JSOND",202 ,0)
	28470	S VVIDX=V VIDX+$L(VV X)-1
	28471	"RTN","HMP JSOND",203 ,0)
	28472	N VVDIFF S VVDIFF=V VIDX-$L(@V VJSON@(VVL INE)) ; i n case VVI DX moves t o next lin e
	28473	"RTN","HMP JSOND",204 ,0)
	28474	I VVDIFF> 0 S VVLINE =VVLINE+1, VVIDX=VVDI FF I '$D(@ VVJSON@(VV LINE)) D E RRX("ORB")
	28475	"RTN","HMP JSOND",205 ,0)
	28476	Q
	28477	"RTN","HMP JSOND",206 ,0)
	28478	CURNODE() ; Return a global/lo cal variab le name ba sed on VVS TACK
	28479	"RTN","HMP JSOND",207 ,0)
	28480	; Expects VVSTACK t o be defin ed already
	28481	"RTN","HMP JSOND",208 ,0)
	28482	N VVI,VVS UBS
	28483	"RTN","HMP JSOND",209 ,0)
	28484	S VVSUBS= ""
	28485	"RTN","HMP JSOND",210 ,0)
	28486	F VVI=1:1 :VVSTACK S :VVI>1 VVS UBS=VVSUBS _"," D
	28487	"RTN","HMP JSOND",211 ,0)
	28488	. I VVSTA CK(VVI)=+V VSTACK(VVI ) S VVSUBS =VVSUBS_VV STACK(VVI) ; VEN/SMH Fix pseud o array bu g.
	28489	"RTN","HMP JSOND",212 ,0)
	28490	. E S VV SUBS=VVSUB S_""""_VVS TACK(VVI)_ """"
	28491	"RTN","HMP JSOND",213 ,0)
	28492	Q VVROOT_ VVSUBS_")"
	28493	"RTN","HMP JSOND",214 ,0)
	28494	;
	28495	"RTN","HMP JSOND",215 ,0)
	28496	UES(X) ; U nescape JS ON string
	28497	"RTN","HMP JSOND",216 ,0)
	28498	; copy se gments fro m START to POS-2 (ri ght before \)
	28499	"RTN","HMP JSOND",217 ,0)
	28500	; transla te target character (which is at $F posi tion)
	28501	"RTN","HMP JSOND",218 ,0)
	28502	N POS,Y,S TART
	28503	"RTN","HMP JSOND",219 ,0)
	28504	S POS=0,Y =""
	28505	"RTN","HMP JSOND",220 ,0)
	28506	F S STAR T=POS+1 D Q:START>$ L(X)
	28507	"RTN","HMP JSOND",221 ,0)
	28508	. S POS=$ F(X,"\",ST ART) ; fin d next pos ition
	28509	"RTN","HMP JSOND",222 ,0)
	28510	. I 'POS S Y=Y_$E(X ,START,$L( X)),POS=$L (X) Q
	28511	"RTN","HMP JSOND",223 ,0)
	28512	. ; other wise handl e escaped char
	28513	"RTN","HMP JSOND",224 ,0)
	28514	. N TGT
	28515	"RTN","HMP JSOND",225 ,0)
	28516	. S TGT=$ E(X,POS),Y =Y_$E(X,ST ART,POS-2)
	28517	"RTN","HMP JSOND",226 ,0)
	28518	. I TGT=" u" S Y=Y_$ C($$DEC^XL FUTL($E(X, POS+1,POS+ 4),16)),PO S=POS+4 Q
	28519	"RTN","HMP JSOND",227 ,0)
	28520	. S Y=Y_$ $REALCHAR( TGT)
	28521	"RTN","HMP JSOND",228 ,0)
	28522	Q Y
	28523	"RTN","HMP JSOND",229 ,0)
	28524	;
	28525	"RTN","HMP JSOND",230 ,0)
	28526	REALCHAR(C ) ; Return actual ch aracter fr om escaped
	28527	"RTN","HMP JSOND",231 ,0)
	28528	I C="""" Q """"
	28529	"RTN","HMP JSOND",232 ,0)
	28530	I C="/" Q "/"
	28531	"RTN","HMP JSOND",233 ,0)
	28532	I C="\" Q "\"
	28533	"RTN","HMP JSOND",234 ,0)
	28534	I C="b" Q $C(8)
	28535	"RTN","HMP JSOND",235 ,0)
	28536	I C="f" Q $C(12)
	28537	"RTN","HMP JSOND",236 ,0)
	28538	I C="n" Q $C(10)
	28539	"RTN","HMP JSOND",237 ,0)
	28540	I C="r" Q $C(13)
	28541	"RTN","HMP JSOND",238 ,0)
	28542	I C="t" Q $C(9)
	28543	"RTN","HMP JSOND",239 ,0)
	28544	I C="u" ; case cover ed above i n $$DEC^XL FUTL calls
	28545	"RTN","HMP JSOND",240 ,0)
	28546	;otherwis e
	28547	"RTN","HMP JSOND",241 ,0)
	28548	I $L($G(V VERR)) D E RRX("ESC", C)
	28549	"RTN","HMP JSOND",242 ,0)
	28550	Q C
	28551	"RTN","HMP JSOND",243 ,0)
	28552	;
	28553	"RTN","HMP JSOND",244 ,0)
	28554	ERRX(ID,VA L) ; Set t he appropr iate error message
	28555	"RTN","HMP JSOND",245 ,0)
	28556	D ERRX^HM PJSON(ID,$ G(VAL))
	28557	"RTN","HMP JSOND",246 ,0)
	28558	Q
	28559	"RTN","HMP JSONE")
	28560	0^99^B2750 6711
	28561	"RTN","HMP JSONE",1,0 )
	28562	HMPJSONE ; SLC/KCM,AS MR/RRB - E ncode JSON ;9/25/2015 10:17
	28563	"RTN","HMP JSONE",2,0 )
	28564	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	28565	"RTN","HMP JSONE",3,0 )
	28566	;Per VA D irective 6 402, this routine sh ould not b e modified .
	28567	"RTN","HMP JSONE",4,0 )
	28568	;
	28569	"RTN","HMP JSONE",5,0 )
	28570	Q
	28571	"RTN","HMP JSONE",6,0 )
	28572	;
	28573	"RTN","HMP JSONE",7,0 )
	28574	ENCODE(VVR OOT,VVJSON ,VVERR) ; VVROOT (M structure) --> VVJSO N (array o f strings)
	28575	"RTN","HMP JSONE",8,0 )
	28576	;
	28577	"RTN","HMP JSONE",9,0 )
	28578	DIRECT ; T AG for use by ENCODE ^HMPJSON
	28579	"RTN","HMP JSONE",10, 0)
	28580	;
	28581	"RTN","HMP JSONE",11, 0)
	28582	; Example s: D ENCO DE^HMPJSON ("^GLO(99, 2)","^TMP( $J)")
	28583	"RTN","HMP JSONE",12, 0)
	28584	; D ENCO DE^HMPJSON ("LOCALVAR ","MYJSON" ,"LOCALERR ")
	28585	"RTN","HMP JSONE",13, 0)
	28586	;
	28587	"RTN","HMP JSONE",14, 0)
	28588	; VVROOT: closed ar ray refere nce for M representa tion of ob ject
	28589	"RTN","HMP JSONE",15, 0)
	28590	; VVJSON: destinati on variabl e for the string arr ay formatt ed as JSON
	28591	"RTN","HMP JSONE",16, 0)
	28592	; VVERR: contains error mess ages, defa ults to ^T MP("HMPJER R",$J)
	28593	"RTN","HMP JSONE",17, 0)
	28594	;
	28595	"RTN","HMP JSONE",18, 0)
	28596	S VVERR=$ G(VVERR,"^ TMP(""HMPJ ERR"",$J)" )
	28597	"RTN","HMP JSONE",19, 0)
	28598	I '$L($G( VVROOT)) ; set error info
	28599	"RTN","HMP JSONE",20, 0)
	28600	I '$L($G( VVJSON)) ; set error info
	28601	"RTN","HMP JSONE",21, 0)
	28602	N VVLINE, VVMAX,VVER RORS
	28603	"RTN","HMP JSONE",22, 0)
	28604	S VVLINE= 1,VVMAX=40 00,VVERROR S=0 ; 96 more bytes of wiggle room
	28605	"RTN","HMP JSONE",23, 0)
	28606	S @VVJSON @(VVLINE)= ""
	28607	"RTN","HMP JSONE",24, 0)
	28608	D SEROBJ( VVROOT)
	28609	"RTN","HMP JSONE",25, 0)
	28610	Q
	28611	"RTN","HMP JSONE",26, 0)
	28612	;
	28613	"RTN","HMP JSONE",27, 0)
	28614	SEROBJ(VVR OOT) ; Ser ialize int o a JSON o bject
	28615	"RTN","HMP JSONE",28, 0)
	28616	N VVFIRST ,VVSUB,VVN XT
	28617	"RTN","HMP JSONE",29, 0)
	28618	S @VVJSON @(VVLINE)= @VVJSON@(V VLINE)_"{"
	28619	"RTN","HMP JSONE",30, 0)
	28620	S VVFIRST =1
	28621	"RTN","HMP JSONE",31, 0)
	28622	S VVSUB=" " F S VVS UB=$O(@VVR OOT@(VVSUB )) Q:VVSUB ="" D
	28623	"RTN","HMP JSONE",32, 0)
	28624	. S:'VVFI RST @VVJSO N@(VVLINE) =@VVJSON@( VVLINE)_", " S VVFIRS T=0
	28625	"RTN","HMP JSONE",33, 0)
	28626	. ; get t he name pa rt
	28627	"RTN","HMP JSONE",34, 0)
	28628	. D SERNA ME(VVSUB)
	28629	"RTN","HMP JSONE",35, 0)
	28630	. ; if th is is a va lue, seria lize it
	28631	"RTN","HMP JSONE",36, 0)
	28632	. I $$ISV ALUE(VVROO T,VVSUB) D SERVAL(VV ROOT,VVSUB ) Q
	28633	"RTN","HMP JSONE",37, 0)
	28634	. ; other wise navig ate to the next chil d object o r array
	28635	"RTN","HMP JSONE",38, 0)
	28636	. I $D(@V VROOT@(VVS UB))=10 S VVNXT=$O(@ VVROOT@(VV SUB,"")) D Q
	28637	"RTN","HMP JSONE",39, 0)
	28638	. . ; Nee d to check if numeri c represen tation mat ches strin g represen tation to decide if it is an a rray
	28639	"RTN","HMP JSONE",40, 0)
	28640	. . I +VV NXT=VVNXT D SERARY($ NA(@VVROOT @(VVSUB))) I 1
	28641	"RTN","HMP JSONE",41, 0)
	28642	. . E D SEROBJ($NA (@VVROOT@( VVSUB)))
	28643	"RTN","HMP JSONE",42, 0)
	28644	. D ERRX( "SOB",VVSU B) ; shou ld quit lo op before here
	28645	"RTN","HMP JSONE",43, 0)
	28646	S @VVJSON @(VVLINE)= @VVJSON@(V VLINE)_"}"
	28647	"RTN","HMP JSONE",44, 0)
	28648	Q
	28649	"RTN","HMP JSONE",45, 0)
	28650	SERARY(VVR OOT) ; Ser ialize int o a JSON a rray
	28651	"RTN","HMP JSONE",46, 0)
	28652	N VVFIRST ,VVI,VVNXT
	28653	"RTN","HMP JSONE",47, 0)
	28654	S @VVJSON @(VVLINE)= @VVJSON@(V VLINE)_"["
	28655	"RTN","HMP JSONE",48, 0)
	28656	S VVFIRST =1
	28657	"RTN","HMP JSONE",49, 0)
	28658	S VVI=0 F S VVI=$O (@VVROOT@( VVI)) Q:'V VI D
	28659	"RTN","HMP JSONE",50, 0)
	28660	. S:'VVFI RST @VVJSO N@(VVLINE) =@VVJSON@( VVLINE)_", " S VVFIRS T=0
	28661	"RTN","HMP JSONE",51, 0)
	28662	. I $$ISV ALUE(VVROO T,VVI) D S ERVAL(VVRO OT,VVI) Q ; write v alue
	28663	"RTN","HMP JSONE",52, 0)
	28664	. I $D(@V VROOT@(VVI ))=10 S VV NXT=$O(@VV ROOT@(VVI, "")) D Q
	28665	"RTN","HMP JSONE",53, 0)
	28666	. . ; Nee d to check if numeri c represen tation mat ches strin g represen tation to decide if it is an a rray
	28667	"RTN","HMP JSONE",54, 0)
	28668	. . I +VV NXT=VVNXT D SERARY($ NA(@VVROOT @(VVI))) I 1
	28669	"RTN","HMP JSONE",55, 0)
	28670	. . E D SEROBJ($NA (@VVROOT@( VVI)))
	28671	"RTN","HMP JSONE",56, 0)
	28672	. D ERRX( "SAR",VVI) ; should quit loop before he re
	28673	"RTN","HMP JSONE",57, 0)
	28674	S @VVJSON @(VVLINE)= @VVJSON@(V VLINE)_"]"
	28675	"RTN","HMP JSONE",58, 0)
	28676	Q
	28677	"RTN","HMP JSONE",59, 0)
	28678	SERNAME(VV SUB) ; Ser ialize the object na me into JS ON string
	28679	"RTN","HMP JSONE",60, 0)
	28680	I $E(VVSU B)="""" S VVSUB=$E(V VSUB,2,$L( VVSUB)) ; quote indi cates nume ric label
	28681	"RTN","HMP JSONE",61, 0)
	28682	I ($L(VVS UB)+$L(@VV JSON@(VVLI NE)))>VVMA X S VVLINE =VVLINE+1, @VVJSON@(V VLINE)=""
	28683	"RTN","HMP JSONE",62, 0)
	28684	S @VVJSON @(VVLINE)= @VVJSON@(V VLINE)_""" "_VVSUB_"" ""_":"
	28685	"RTN","HMP JSONE",63, 0)
	28686	Q
	28687	"RTN","HMP JSONE",64, 0)
	28688	SERVAL(VVR OOT,VVSUB) ; Seriali ze X into appropriat e JSON rep resentatio n
	28689	"RTN","HMP JSONE",65, 0)
	28690	N VVX,VVI ,VVDONE
	28691	"RTN","HMP JSONE",66, 0)
	28692	; if the node is al ready in J SON format , just add it
	28693	"RTN","HMP JSONE",67, 0)
	28694	I $D(@VVR OOT@(VVSUB ,":")) D QUIT ; <- - jump out here if p reformatte d
	28695	"RTN","HMP JSONE",68, 0)
	28696	. S VVX=$ G(@VVROOT@ (VVSUB,":" )) D:$L(VV X) CONCAT
	28697	"RTN","HMP JSONE",69, 0)
	28698	. S VVI=0 F S VVI= $O(@VVROOT @(VVSUB,": ",VVI)) Q: 'VVI S VV X=@VVROOT@ (VVSUB,":" ,VVI) D CO NCAT
	28699	"RTN","HMP JSONE",70, 0)
	28700	;
	28701	"RTN","HMP JSONE",71, 0)
	28702	S VVX=$G( @VVROOT@(V VSUB)),VVD ONE=0
	28703	"RTN","HMP JSONE",72, 0)
	28704	; handle the numeri c, boolean , and null types
	28705	"RTN","HMP JSONE",73, 0)
	28706	I $D(@VVR OOT@(VVSUB ,"\n")) S: $L(@VVROOT @(VVSUB,"\ n")) VVX=@ VVROOT@(VV SUB,"\n") D CONCAT Q UIT ; whe n +X'=X
	28707	"RTN","HMP JSONE",74, 0)
	28708	I '$D(@VV ROOT@(VVSU B,"\s")),$ L(VVX) D QUIT:VVDON E
	28709	"RTN","HMP JSONE",75, 0)
	28710	. I VVX'] ]$C(1) S V VX=$$JNUM( VVX) D CON CAT S VVDO NE=1 QUIT
	28711	"RTN","HMP JSONE",76, 0)
	28712	. I VVX=" true"!(VVX ="false")! (VVX="null ") D CONCA T S VVDONE =1 QUIT
	28713	"RTN","HMP JSONE",77, 0)
	28714	; otherwi se treat i t as a str ing type
	28715	"RTN","HMP JSONE",78, 0)
	28716	S VVX=""" "_$$ESC(VV X) ; open quote
	28717	"RTN","HMP JSONE",79, 0)
	28718	D CONCAT
	28719	"RTN","HMP JSONE",80, 0)
	28720	I $D(@VVR OOT@(VVSUB ,"\")) D ; handle c ontinuatio n nodes
	28721	"RTN","HMP JSONE",81, 0)
	28722	. S VVI=0 F S VVI= $O(@VVROOT @(VVSUB,"\ ",VVI)) Q: 'VVI D
	28723	"RTN","HMP JSONE",82, 0)
	28724	. . S VVX =$$ESC(@VV ROOT@(VVSU B,"\",VVI) )
	28725	"RTN","HMP JSONE",83, 0)
	28726	. . D CON CAT
	28727	"RTN","HMP JSONE",84, 0)
	28728	S VVX=""" " D CONCAT ; clos e quote
	28729	"RTN","HMP JSONE",85, 0)
	28730	Q
	28731	"RTN","HMP JSONE",86, 0)
	28732	CONCAT ; c ome here t o concaten ate to JSO N string
	28733	"RTN","HMP JSONE",87, 0)
	28734	I ($L(VVX )+$L(@VVJS ON@(VVLINE )))>VVMAX S VVLINE=V VLINE+1,@V VJSON@(VVL INE)=""
	28735	"RTN","HMP JSONE",88, 0)
	28736	S @VVJSON @(VVLINE)= @VVJSON@(V VLINE)_VVX
	28737	"RTN","HMP JSONE",89, 0)
	28738	Q
	28739	"RTN","HMP JSONE",90, 0)
	28740	ISVALUE(VV ROOT,VVSUB ) ; Return true if t his is a v alue node
	28741	"RTN","HMP JSONE",91, 0)
	28742	I $D(@VVR OOT@(VVSUB ))#2 Q 1
	28743	"RTN","HMP JSONE",92, 0)
	28744	N VVX S V VX=$O(@VVR OOT@(VVSUB ,""))
	28745	"RTN","HMP JSONE",93, 0)
	28746	Q:VVX="\" 1 ; word processin g continua tion node
	28747	"RTN","HMP JSONE",94, 0)
	28748	Q:VVX=":" 1 ; pre- formatted JSON node
	28749	"RTN","HMP JSONE",95, 0)
	28750	Q 0
	28751	"RTN","HMP JSONE",96, 0)
	28752	;
	28753	"RTN","HMP JSONE",97, 0)
	28754	NUMERIC(X) ; Return true if th e numeric
	28755	"RTN","HMP JSONE",98, 0)
	28756	I $L(X)>1 8 Q 0 ; strin g (too lon g for nume ric)
	28757	"RTN","HMP JSONE",99, 0)
	28758	I X=0 Q 1 ; numer ic (value is zero)
	28759	"RTN","HMP JSONE",100 ,0)
	28760	I +X=0 Q 0 ; strin g
	28761	"RTN","HMP JSONE",101 ,0)
	28762	I $E(X,1) ="." Q 0 ; not a JSON numb er (althou gh numeric in M)
	28763	"RTN","HMP JSONE",102 ,0)
	28764	I $E(X,1, 2)="-." Q 0 ; not a JSON numb er
	28765	"RTN","HMP JSONE",103 ,0)
	28766	I +X=X Q 1 ; numer ic
	28767	"RTN","HMP JSONE",104 ,0)
	28768	I X?1"0." 1.n Q 1 ; posit ive fracti on
	28769	"RTN","HMP JSONE",105 ,0)
	28770	I X?1"-0. "1.N Q 1 ; negat ive fracti on
	28771	"RTN","HMP JSONE",106 ,0)
	28772	S X=$TR(X ,"e","E")
	28773	"RTN","HMP JSONE",107 ,0)
	28774	I X?.1"-" 1.N.1".".N 1"E".1"+"1 .N Q 1 ; {-}99{.99} E{+}99
	28775	"RTN","HMP JSONE",108 ,0)
	28776	I X?.1"-" 1.N.1".".N 1"E-"1.N Q 1 ; {-}99{.99} E-99
	28777	"RTN","HMP JSONE",109 ,0)
	28778	Q 0
	28779	"RTN","HMP JSONE",110 ,0)
	28780	;
	28781	"RTN","HMP JSONE",111 ,0)
	28782	ESC(X) ; E scape stri ng for JSO N
	28783	"RTN","HMP JSONE",112 ,0)
	28784	N Y,I,PAI R,FROM,TO
	28785	"RTN","HMP JSONE",113 ,0)
	28786	S Y=X
	28787	"RTN","HMP JSONE",114 ,0)
	28788	F PAIR="\ \","""""", "//",$C(8, 98),$C(12, 102),$C(10 ,110),$C(1 3,114),$C( 9,116) D
	28789	"RTN","HMP JSONE",115 ,0)
	28790	. S FROM= $E(PAIR),T O=$E(PAIR, 2)
	28791	"RTN","HMP JSONE",116 ,0)
	28792	. S X=Y,Y =$P(X,FROM ) F I=2:1: $L(X,FROM) S Y=Y_"\" _TO_$P(X,F ROM,I)
	28793	"RTN","HMP JSONE",117 ,0)
	28794	I Y?.E1.C .E S X=Y,Y ="" F I=1: 1:$L(X) S FROM=$A(X, I) D
	28795	"RTN","HMP JSONE",118 ,0)
	28796	. ; skip NUL charac ter, other wise encod e ctrl-cha r
	28797	"RTN","HMP JSONE",119 ,0)
	28798	. I FROM< 32 Q:FROM= 0 S Y=Y_$ $UCODE(FRO M) Q
	28799	"RTN","HMP JSONE",120 ,0)
	28800	. I FROM> 126,(FROM< 160) S Y=Y _$$UCODE(F ROM) Q
	28801	"RTN","HMP JSONE",121 ,0)
	28802	. S Y=Y_$ E(X,I)
	28803	"RTN","HMP JSONE",122 ,0)
	28804	Q Y
	28805	"RTN","HMP JSONE",123 ,0)
	28806	;
	28807	"RTN","HMP JSONE",124 ,0)
	28808	JNUM(N) ; Return JSO N represen tation of a number
	28809	"RTN","HMP JSONE",125 ,0)
	28810	I N'<1 Q N
	28811	"RTN","HMP JSONE",126 ,0)
	28812	I N'>-1 Q N
	28813	"RTN","HMP JSONE",127 ,0)
	28814	I N>0 Q " 0"_N
	28815	"RTN","HMP JSONE",128 ,0)
	28816	I N<0 Q " -0"_$P(N," -",2,9)
	28817	"RTN","HMP JSONE",129 ,0)
	28818	Q N
	28819	"RTN","HMP JSONE",130 ,0)
	28820	;
	28821	"RTN","HMP JSONE",131 ,0)
	28822	UCODE(C) ; Return \u 00nn repre sentation of decimal character value
	28823	"RTN","HMP JSONE",132 ,0)
	28824	N H S H=" 0000"_$$CN V^XLFUTL(C ,16)
	28825	"RTN","HMP JSONE",133 ,0)
	28826	Q "\u"_$E (H,$L(H)-3 ,$L(H))
	28827	"RTN","HMP JSONE",134 ,0)
	28828	;
	28829	"RTN","HMP JSONE",135 ,0)
	28830	ERRX(ID,VA L) ; Set t he appropr iate error message
	28831	"RTN","HMP JSONE",136 ,0)
	28832	D ERRX^HM PJSON(ID,$ G(VAL))
	28833	"RTN","HMP JSONE",137 ,0)
	28834	Q
	28835	"RTN","HMP LIST")
	28836	0^100^B628 46538
	28837	"RTN","HMP LIST",1,0)
	28838	HMPLIST ;H OIFO/DP,AS MR/RRB - L ist Manage r;02 Nov 2 012
	28839	"RTN","HMP LIST",2,0)
	28840	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	28841	"RTN","HMP LIST",3,0)
	28842	;Per VA D irective 6 402, this routine sh ould not b e modified .
	28843	"RTN","HMP LIST",4,0)
	28844	;
	28845	"RTN","HMP LIST",5,0)
	28846	Q
	28847	"RTN","HMP LIST",6,0)
	28848	;
	28849	"RTN","HMP LIST",7,0)
	28850	EN(TARGET, NAME,FORMA T,PARAMS) ; OlD sKOo L entry po int
	28851	"RTN","HMP LIST",8,0)
	28852	Kill @TAR GET
	28853	"RTN","HMP LIST",9,0)
	28854	New HMPLI ST,HMPROOT ,HMPXECUTE
	28855	"RTN","HMP LIST",10,0 )
	28856	If NAME=" *" Do
	28857	"RTN","HMP LIST",11,0 )
	28858	. Do ALL( TARGET)
	28859	"RTN","HMP LIST",12,0 )
	28860	Else Do
	28861	"RTN","HMP LIST",13,0 )
	28862	. Set HMP LIST=$$LIS T(NAME) If 'HMPLIST Set Y=$$AD D("-1^No S uch List ' "_NAME_"'" ) Quit
	28863	"RTN","HMP LIST",14,0 )
	28864	. If $Pie ce(HMPLIST ,U,3)=0 Do ; Static list
	28865	"RTN","HMP LIST",15,0 )
	28866	. . Set X =$$GET1^DI Q(800000.2 ,+HMPLIST_ ",",.9,"", TARGET)
	28867	"RTN","HMP LIST",16,0 )
	28868	. Else S et HMPXECU TE=$$GET1^ DIQ(800000 .2,HMPLIST _",",.11," I") Xecute :HMPXECUTE ]"" HMPXEC UTE
	28869	"RTN","HMP LIST",17,0 )
	28870	. Set @TA RGET@(0)=N AME_U_$Ord er(@TARGET @(""),-1)_ U_$$COLS(+ HMPLIST)
	28871	"RTN","HMP LIST",18,0 )
	28872	; Process alternate format be fore leavi ng
	28873	"RTN","HMP LIST",19,0 )
	28874	Set FORMA T=$Get(FOR MAT,"DEFAU LT")
	28875	"RTN","HMP LIST",20,0 )
	28876	Do @$Sele ct(FORMAT= "XML":"XML ",FORMAT=" JSON":"JSO N",FORMAT= "DEFAULT": "DEFAULT", 1:"UNKNOWN ")
	28877	"RTN","HMP LIST",21,0 )
	28878	Quit
	28879	"RTN","HMP LIST",22,0 )
	28880	;
	28881	"RTN","HMP LIST",23,0 )
	28882	RPC(RESULT ,NAME,FORM AT,PARAMS) ; Accesse d via HMP LIST Remot e Procedur e
	28883	"RTN","HMP LIST",24,0 )
	28884	Set RESUL T=$Name(^T MP($J)) Ki ll @RESULT
	28885	"RTN","HMP LIST",25,0 )
	28886	If $Data( PARAMS) Do EN(RESULT ,NAME,$Get (FORMAT,"D EFAULT"),. PARAMS)
	28887	"RTN","HMP LIST",26,0 )
	28888	Else Do EN(RESULT, NAME,$Get( FORMAT,"DE FAULT"))
	28889	"RTN","HMP LIST",27,0 )
	28890	Quit
	28891	"RTN","HMP LIST",28,0 )
	28892	;
	28893	"RTN","HMP LIST",29,0 )
	28894	VALUE(NAME ,ID) ; Ret urn the it em from a list by ID
	28895	"RTN","HMP LIST",30,0 )
	28896	New HMPLI ST
	28897	"RTN","HMP LIST",31,0 )
	28898	Set HMPLI ST=$$LIST( NAME) If ' HMPLIST Qu it "^No Su ch List"
	28899	"RTN","HMP LIST",32,0 )
	28900	For X=0:0 Set X=$Or der(^HMPD( 800000.2,+ HMPLIST,9, X)) Quit:' X Quit:$P iece(^(X,0 ),U)=ID
	28901	"RTN","HMP LIST",33,0 )
	28902	Quit $Sel ect(X:^HMP D(800000.2 ,+HMPLIST, 9,X,0),1:" ^No Such I D")
	28903	"RTN","HMP LIST",34,0 )
	28904	;
	28905	"RTN","HMP LIST",35,0 )
	28906	EDIT ; Edi t a list d efinition
	28907	"RTN","HMP LIST",36,0 )
	28908	New DDSFI LE,DA,DR
	28909	"RTN","HMP LIST",37,0 )
	28910	Do HOME^% ZIS Write @IOF
	28911	"RTN","HMP LIST",38,0 )
	28912	Set DDSFI LE=800000. 2,DR="[HMP LIST]"
	28913	"RTN","HMP LIST",39,0 )
	28914	Do ^DDS
	28915	"RTN","HMP LIST",40,0 )
	28916	Quit
	28917	"RTN","HMP LIST",41,0 )
	28918	;
	28919	"RTN","HMP LIST",42,0 )
	28920	DISPLAY ; Display a list defin ition
	28921	"RTN","HMP LIST",43,0 )
	28922	New DIC,H MP,BY,FR,T O,FLDS
	28923	"RTN","HMP LIST",44,0 )
	28924	Set DIC=8 00000.2,DI C(0)="AEQM ",DIC("A") ="Select L ist Defini tion to Di splay: " D o ^DIC Qui t:+Y<1
	28925	"RTN","HMP LIST",45,0 )
	28926	Set BY="@ NUMBER",FR =+Y,TO=+Y, FLDS="[HMP LIST DISP LAY]" Do E N1^DIP
	28927	"RTN","HMP LIST",46,0 )
	28928	Quit
	28929	"RTN","HMP LIST",47,0 )
	28930	;
	28931	"RTN","HMP LIST",48,0 )
	28932	DEFAULT ; Just retur n as is, a simple ar ray
	28933	"RTN","HMP LIST",49,0 )
	28934	Quit
	28935	"RTN","HMP LIST",50,0 )
	28936	;
	28937	"RTN","HMP LIST",51,0 )
	28938	UNKNOWN ; You've got no idea, and neithe r do I
	28939	"RTN","HMP LIST",52,0 )
	28940	Quit
	28941	"RTN","HMP LIST",53,0 )
	28942	;
	28943	"RTN","HMP LIST",54,0 )
	28944	JSON ; Con vert @TARG ET@(1..n) to JSON
	28945	"RTN","HMP LIST",55,0 )
	28946	New HMPCO LS,HMPX,HM PY
	28947	"RTN","HMP LIST",56,0 )
	28948	Set HMPCO LS=$Piece( @TARGET@(0 ),U,3),HMP X=@TARGET@ (0)
	28949	"RTN","HMP LIST",57,0 )
	28950	Set @TARG ET@(0)="{ name : """ _$Piece(HM PX,U,1)_"" ", count : """_$Piec e(HMPX,U,2 )_""""_$Se lect($Orde r(@TARGET@ (0)):", [" ,1:"}")
	28951	"RTN","HMP LIST",58,0 )
	28952	For X=0:0 Set X=$Or der(@TARGE T@(X)) Qui t:'X Do
	28953	"RTN","HMP LIST",59,0 )
	28954	. Set HMP X=@TARGET@ (X),HMPY=" { "
	28955	"RTN","HMP LIST",60,0 )
	28956	. For Y=1 :1:$Length (HMPCOLS," ;") Set HM PY=HMPY_"" ""_$Piece( HMPCOLS,"; ",Y)_""":" ""_$Piece( HMPX,U,Y)_ """"_$Sele ct(Y<$Leng th(HMPCOLS ,";"):", " ,1:" ")
	28957	"RTN","HMP LIST",61,0 )
	28958	. Set HMP Y=HMPY_"}"
	28959	"RTN","HMP LIST",62,0 )
	28960	. If $Ord er(@TARGET @(X)) Set @TARGET@(X )=HMPY_"," Quit
	28961	"RTN","HMP LIST",63,0 )
	28962	. Set @TA RGET@(X)=H MPY
	28963	"RTN","HMP LIST",64,0 )
	28964	Set @TARG ET@($Order (@TARGET@( ""),-1)+1) ="]}"
	28965	"RTN","HMP LIST",65,0 )
	28966	Quit
	28967	"RTN","HMP LIST",66,0 )
	28968	;
	28969	"RTN","HMP LIST",67,0 )
	28970	XML ; Conv ert @TARGE T@(1..n) t o XML
	28971	"RTN","HMP LIST",68,0 )
	28972	New HMPCO LD,HMPX,HM PY
	28973	"RTN","HMP LIST",69,0 )
	28974	Set HMPCO LS=$Piece( @TARGET@(0 ),U,3)
	28975	"RTN","HMP LIST",70,0 )
	28976	For X=0:0 Set X=$Or der(@TARGE T@(X)) Qui t:'X Do
	28977	"RTN","HMP LIST",71,0 )
	28978	. Set HMP X=@TARGET@ (X),HMPY=" <item "
	28979	"RTN","HMP LIST",72,0 )
	28980	. For Y=1 :1:$Length (HMPCOLS," ;") Set HM PY=HMPY_$P iece(HMPCO LS,";",Y)_ "="""_$Pie ce(HMPX,U, Y)_""" "
	28981	"RTN","HMP LIST",73,0 )
	28982	. Set HMP Y=HMPY_"/> "
	28983	"RTN","HMP LIST",74,0 )
	28984	. Set @TA RGET@(X)=H MPY
	28985	"RTN","HMP LIST",75,0 )
	28986	Set HMPX= @TARGET@(0 )
	28987	"RTN","HMP LIST",76,0 )
	28988	Set @TARG ET@(0)="<l ist name=" ""_$Piece( HMPX,U,1)_ """ count= """_$Piece (HMPX,U,2) _""">"
	28989	"RTN","HMP LIST",77,0 )
	28990	Set @TARG ET@($Order (@TARGET@( ""),-1)+1) ="</list>"
	28991	"RTN","HMP LIST",78,0 )
	28992	Quit
	28993	"RTN","HMP LIST",79,0 )
	28994	;
	28995	"RTN","HMP LIST",80,0 )
	28996	XMLSAFE(X) ; Transfo rm X into XML safe d ata
	28997	"RTN","HMP LIST",81,0 )
	28998	; Strip o ff the spa ces and ma ke life ea sier
	28999	"RTN","HMP LIST",82,0 )
	29000	For Quit :$Extract( X)'=" " S et X=$Extr act(X,2,$L ength(X))
	29001	"RTN","HMP LIST",83,0 )
	29002	For Quit :$Extract( X,$Length( X))'=" " Set X=$Ext ract(X,1,$ Length(X)- 1)
	29003	"RTN","HMP LIST",84,0 )
	29004	Set X=$$T RNSLT(X,"& ","&")
	29005	"RTN","HMP LIST",85,0 )
	29006	Set X=$$T RNSLT(X,"< ","<")
	29007	"RTN","HMP LIST",86,0 )
	29008	Set X=$$T RNSLT(X,"> ",">")
	29009	"RTN","HMP LIST",87,0 )
	29010	Set X=$$T RNSLT(X,"' ","'" )
	29011	"RTN","HMP LIST",88,0 )
	29012	Set X=$$T RNSLT(X,"" "","" ")
	29013	"RTN","HMP LIST",89,0 )
	29014	Set X=$$T RNSLT(X,": ",":")
	29015	"RTN","HMP LIST",90,0 )
	29016	Quit X
	29017	"RTN","HMP LIST",91,0 )
	29018	;
	29019	"RTN","HMP LIST",92,0 )
	29020	JSONSAFE(X ) ; Transf orm X into JSON safe data
	29021	"RTN","HMP LIST",93,0 )
	29022	; Strip t he spaces
	29023	"RTN","HMP LIST",94,0 )
	29024	For Quit :$Extract( X)'=" " S et X=$Extr act(X,2,$L ength(X))
	29025	"RTN","HMP LIST",95,0 )
	29026	For Quit :$Extract( X,$Length( X))'=" " Set X=$Ext ract(X,1,$ Length(X)- 1)
	29027	"RTN","HMP LIST",96,0 )
	29028	Set X=$$T RNSLT(X,"" "","\""")
	29029	"RTN","HMP LIST",97,0 )
	29030	Quit X
	29031	"RTN","HMP LIST",98,0 )
	29032	;
	29033	"RTN","HMP LIST",99,0 )
	29034	TRNSLT(X,X 1,X2) ; Tr anslate ev ery Y to Z in X
	29035	"RTN","HMP LIST",100, 0)
	29036	New Y
	29037	"RTN","HMP LIST",101, 0)
	29038	Quit:X'[X 1 X ; Not hing to tr anslate
	29039	"RTN","HMP LIST",102, 0)
	29040	Set Y="" For Quit: X="" Do
	29041	"RTN","HMP LIST",103, 0)
	29042	. If X[X1 Set Y=Y_$ Piece(X,X1 )_X2,X=$Pi ece(X,X1,2 ,250) Quit
	29043	"RTN","HMP LIST",104, 0)
	29044	. Set Y=Y _X,X=""
	29045	"RTN","HMP LIST",105, 0)
	29046	Quit Y
	29047	"RTN","HMP LIST",106, 0)
	29048	;
	29049	"RTN","HMP LIST",107, 0)
	29050	LIST(NAME) ; Return List by na me
	29051	"RTN","HMP LIST",108, 0)
	29052	Set X=$$F IND1^DIC(8 00000.2,," KX",NAME) Quit:X<1 X
	29053	"RTN","HMP LIST",109, 0)
	29054	Quit X_U_ ^HMPD(8000 00.2,X,0)
	29055	"RTN","HMP LIST",110, 0)
	29056	;
	29057	"RTN","HMP LIST",111, 0)
	29058	ALL(RETURN ) ; Return All lists in RETURN ()
	29059	"RTN","HMP LIST",112, 0)
	29060	Kill @RET URN
	29061	"RTN","HMP LIST",113, 0)
	29062	Do LIST^D IC(800000. 2,,"@;.01; .02","P")
	29063	"RTN","HMP LIST",114, 0)
	29064	For X=0:0 Set X=$Or der(^TMP(" DILIST",$J ,X)) Quit: 'X Set @R ETURN@(X)= ^TMP("DILI ST",$J,X,0 )
	29065	"RTN","HMP LIST",115, 0)
	29066	Set @RETU RN@(0)="AL L LISTS^"_ +$Order(@R ETURN@("") ,-1)_"^ID; name;type"
	29067	"RTN","HMP LIST",116, 0)
	29068	Kill ^TMP ("DILIST", $J)
	29069	"RTN","HMP LIST",117, 0)
	29070	Quit
	29071	"RTN","HMP LIST",118, 0)
	29072	;
	29073	"RTN","HMP LIST",119, 0)
	29074	COLS(LIST) ; Return the col na mes (ID^Na me) + any custom col specs
	29075	"RTN","HMP LIST",120, 0)
	29076	New RESUL T,X,Y
	29077	"RTN","HMP LIST",121, 0)
	29078	Set RESUL T="ID;name "
	29079	"RTN","HMP LIST",122, 0)
	29080	For X=0:0 Set X=$Or der(^HMPD( 800000.2,+ LIST,2,X)) Quit:'X Set Y=^(X, 0) Do
	29081	"RTN","HMP LIST",123, 0)
	29082	. Set $Pi ece(RESULT ,";",$Piec e(Y,U,2))= $Piece(Y,U ,1)
	29083	"RTN","HMP LIST",124, 0)
	29084	Quit RESU LT
	29085	"RTN","HMP LIST",125, 0)
	29086	;
	29087	"RTN","HMP LIST",126, 0)
	29088	CODE(LIST) ; Return Generation Code for a list
	29089	"RTN","HMP LIST",127, 0)
	29090	Quit $Get (^HMPD(800 000.2,+LIS T,.11))
	29091	"RTN","HMP LIST",128, 0)
	29092	;
	29093	"RTN","HMP LIST",129, 0)
	29094	SET(DD,FLD ) ; Build a list fro m a Set Of Codes DD and Field number com bination
	29095	"RTN","HMP LIST",130, 0)
	29096	Kill @TAR GET
	29097	"RTN","HMP LIST",131, 0)
	29098	Quit:$$GE T1^DID(DD, FLD,,"TYPE ")'="SET"
	29099	"RTN","HMP LIST",132, 0)
	29100	Set X=$$G ET1^DID(DD ,FLD,,"POI NTER")
	29101	"RTN","HMP LIST",133, 0)
	29102	For Y=1:1 :$Length(X ,";")-1 Se t @TARGET@ (Y)=$Trans late($Piec e(X,";",Y) ,":","^")
	29103	"RTN","HMP LIST",134, 0)
	29104	Quit
	29105	"RTN","HMP LIST",135, 0)
	29106	;
	29107	"RTN","HMP LIST",136, 0)
	29108	REBUILD(NA ME) ;
	29109	"RTN","HMP LIST",137, 0)
	29110	New LIST, ALL,CODE,F DA,HMPFDA, HMPX
	29111	"RTN","HMP LIST",138, 0)
	29112	;
	29113	"RTN","HMP LIST",139, 0)
	29114	If NAME=" ?" Do Qui t
	29115	"RTN","HMP LIST",140, 0)
	29116	. Set DIC =800000.2, DIC(0)="AE QMZ",DIC(" A")="Rebui ld List: " ,DIC("S")= "I '$P(^(0 ),U,2)"
	29117	"RTN","HMP LIST",141, 0)
	29118	. Do ^DIC Do:+Y REB UILD(Y(0,0 ))
	29119	"RTN","HMP LIST",142, 0)
	29120	;
	29121	"RTN","HMP LIST",143, 0)
	29122	If +NAME= NAME Do Q uit ; Reb uild all f or a DD nu mber
	29123	"RTN","HMP LIST",144, 0)
	29124	. For HMP X=0:0 Set HMPX=$Orde r(^HMPD(80 0000.2,"AD D",NAME,HM PX)) Quit: 'HMPX Do REBUILD($P iece(^HMPD (800000.2, HMPX,0),U) )
	29125	"RTN","HMP LIST",145, 0)
	29126	;
	29127	"RTN","HMP LIST",146, 0)
	29128	If NAME=" *" Do Qui t ; Rebui ld all
	29129	"RTN","HMP LIST",147, 0)
	29130	. For HMP X=0:0 Set HMPX=$Orde r(^HMPD(80 0000.2,HMP X)) Quit:' HMPX Do R EBUILD($Pi ece(^HMPD( 800000.2,H MPX,0),U))
	29131	"RTN","HMP LIST",148, 0)
	29132	;
	29133	"RTN","HMP LIST",149, 0)
	29134	Set LIST= $$LIST(NAM E) Quit:+L IST<1 ; N o Such Lis t
	29135	"RTN","HMP LIST",150, 0)
	29136	;
	29137	"RTN","HMP LIST",151, 0)
	29138	If $Piece (LIST,U,2) Quit ; D ynamic lis t - fired every time
	29139	"RTN","HMP LIST",152, 0)
	29140	Set CODE= $$CODE(LIS T) Quit:CO DE="" ; N o rebuild code, must be manual
	29141	"RTN","HMP LIST",153, 0)
	29142	;
	29143	"RTN","HMP LIST",154, 0)
	29144	Set TARGE T=$Name(^T MP($J))
	29145	"RTN","HMP LIST",155, 0)
	29146	Set FDA=$ Name(HMPFD A(800000.2 ,(+LIST)_" ,"))
	29147	"RTN","HMP LIST",156, 0)
	29148	Kill @TAR GET
	29149	"RTN","HMP LIST",157, 0)
	29150	Xecute CO DE
	29151	"RTN","HMP LIST",158, 0)
	29152	Set @FDA@ (.09)="NOW "
	29153	"RTN","HMP LIST",159, 0)
	29154	Set @FDA@ (.9)=TARGE T
	29155	"RTN","HMP LIST",160, 0)
	29156	Do FILE^D IE("E","HM PFDA")
	29157	"RTN","HMP LIST",161, 0)
	29158	Quit
	29159	"RTN","HMP LIST",162, 0)
	29160	;
	29161	"RTN","HMP LIST",163, 0)
	29162	DQ ; Calle d via Task man to bui ld any lis t that has expired
	29163	"RTN","HMP LIST",164, 0)
	29164	New HMPNO W,HMPLIST, HMPMIN
	29165	"RTN","HMP LIST",165, 0)
	29166	Kill HMPN EXT
	29167	"RTN","HMP LIST",166, 0)
	29168	; Nothing set to re fresh auto matically
	29169	"RTN","HMP LIST",167, 0)
	29170	Quit:'$Or der(^HMPD( 800000.2," AREFRESH", 0))
	29171	"RTN","HMP LIST",168, 0)
	29172	Do NOW^%D TC Set HMP NOW=%
	29173	"RTN","HMP LIST",169, 0)
	29174	For HMPLI ST=0:0 Set HMPLIST=$ Order(^HMP D(800000.2 ,HMPLIST)) Quit:'HMP LIST Do:' $Piece(^HM PD(800000. 2,HMPLIST, 0),U,2) ; Not Dynam ic
	29175	"RTN","HMP LIST",170, 0)
	29176	. Quit:'$ Piece(^HMP D(800000.2 ,HMPLIST,0 ),U,8) ; Doesn't ha ve a refre sh limit
	29177	"RTN","HMP LIST",171, 0)
	29178	. New $ES TACK,$ETRA P Set $ETR AP="D ERR^ HMPLIST" ; Will prev ent a list error fro m craterin g the enti re build
	29179	"RTN","HMP LIST",172, 0)
	29180	. Set HMP MIN=$Piece (^HMPD(800 000.2,HMPL IST,0),U,8 )
	29181	"RTN","HMP LIST",173, 0)
	29182	. Set HMP LAST=$$GET 1^DIQ(8000 00.2,HMPLI ST_",",.09 ,"I")
	29183	"RTN","HMP LIST",174, 0)
	29184	. Set HMP NEXT=$$FMA DD^XLFDT(H MPLAST,0,0 ,HMPMIN,0)
	29185	"RTN","HMP LIST",175, 0)
	29186	. Quit:HM PNEXT>HMPN OW
	29187	"RTN","HMP LIST",176, 0)
	29188	. Quit:($ $FMADD^XLF DT(HMPNOW, 0,0,HMPMIN *-1,0)<$Pi ece(^HMPD( 800000.2,H MPLIST,0), U,9)) ; N ot yet sta le :)
	29189	"RTN","HMP LIST",177, 0)
	29190	. Do REBU ILD($Piece (^HMPD(800 000.2,HMPL IST,0),U))
	29191	"RTN","HMP LIST",178, 0)
	29192	; Get the shortest refresh th reshold an d reschedu le for tha t
	29193	"RTN","HMP LIST",179, 0)
	29194	Set HMPNE XT=$$FMADD ^XLFDT(+$E xtract(HMP NOW,1,12), 0,0,$Order (^HMPD(800 000.2,"ARE FRESH",0)) ,0)
	29195	"RTN","HMP LIST",180, 0)
	29196	Kill ZTRE Q
	29197	"RTN","HMP LIST",181, 0)
	29198	Set ZTREQ =$$FMTH^XL FDT(HMPNEX T)
	29199	"RTN","HMP LIST",182, 0)
	29200	Quit
	29201	"RTN","HMP LIST",183, 0)
	29202	;
	29203	"RTN","HMP LIST",184, 0)
	29204	ADD(X) ; A dds an ite m to the l ist automa tically
	29205	"RTN","HMP LIST",185, 0)
	29206	Set @TARG ET@($Order (@TARGET@( ""),-1)+1) =X
	29207	"RTN","HMP LIST",186, 0)
	29208	Quit $Ord er(@TARGET @(""),-1)
	29209	"RTN","HMP LIST",187, 0)
	29210	;
	29211	"RTN","HMP LIST",188, 0)
	29212	WARDS ; Ge t list of wards, cli nics and n on-stops
	29213	"RTN","HMP LIST",189, 0)
	29214	Do LOC("W ")
	29215	"RTN","HMP LIST",190, 0)
	29216	Quit
	29217	"RTN","HMP LIST",191, 0)
	29218	;
	29219	"RTN","HMP LIST",192, 0)
	29220	CLINICS ; Get Active Clinics
	29221	"RTN","HMP LIST",193, 0)
	29222	Do LOC("N C")
	29223	"RTN","HMP LIST",194, 0)
	29224	Quit
	29225	"RTN","HMP LIST",195, 0)
	29226	;
	29227	"RTN","HMP LIST",196, 0)
	29228	LOC(TYPES) ; Build l ist of loc ations by type
	29229	"RTN","HMP LIST",197, 0)
	29230	New HMPDT ,HMPNOW
	29231	"RTN","HMP LIST",198, 0)
	29232	Do NOW^%D TC Set HMP NOW=%
	29233	"RTN","HMP LIST",199, 0)
	29234	For X=0:0 Set X=$Or der(^SC(X) ) Quit:'X Do:TYPES[ $Piece(^(X ,0),U,3) ;DE2818 IC R 10040 AS F 11/16/15
	29235	"RTN","HMP LIST",200, 0)
	29236	. Set HMP DT=$Get(^S C(X,"I"),U ) ; Deacti vation and Reactivat ion dates
	29237	"RTN","HMP LIST",201, 0)
	29238	. If +HMP DT Quit:(+ HMPDT<HMPN OW&('$Piec e(HMPDT,U, 2)))!(+HMP DT<HMPNOW& ($Piece(HM PDT,U,2)>H MPNOW))
	29239	"RTN","HMP LIST",202, 0)
	29240	. Set Y=$ $ADD^HMPLI ST(X_U_$Pi ece(^SC(X, 0),U,1,3)) ; Full ta g^rtn used for demon stration p urposes
	29241	"RTN","HMP LIST",203, 0)
	29242	Quit
	29243	"RTN","HMP LIST",204, 0)
	29244	;
	29245	"RTN","HMP LIST",205, 0)
	29246	INPT ; Reb uild the i npatient l ist
	29247	"RTN","HMP LIST",206, 0)
	29248	Do LIST^D IC(2,,"@;. 01;.02;.03 ;.09;.1;.1 01","P",,, ,"CN")
	29249	"RTN","HMP LIST",207, 0)
	29250	For X=0:0 Set X=$Or der(^TMP(" DILIST",$J ,X)) Quit: 'X Set Y= $$ADD(^(X, 0))
	29251	"RTN","HMP LIST",208, 0)
	29252	Do CLEAN^ DILF
	29253	"RTN","HMP LIST",209, 0)
	29254	Quit
	29255	"RTN","HMP LIST",210, 0)
	29256	;
	29257	"RTN","HMP LIST",211, 0)
	29258	ERR ; This is the ap plication specific e rror trap for the DQ loop
	29259	"RTN","HMP LIST",212, 0)
	29260	Do ^%ZTER ; record the error
	29261	"RTN","HMP LIST",213, 0)
	29262	Do UNWIND ^%ZTER ; u nwind the stack, ret urn to cal ler.
	29263	"RTN","HMP LIST",214, 0)
	29264	Quit
	29265	"RTN","HMP LIST",215, 0)
	29266	;
	29267	"RTN","HMP MDUTL")
	29268	0^101^B533 81465
	29269	"RTN","HMP MDUTL",1,0 )
	29270	HMPMDUTL ; DSS/BLJ,AS MR/RRB - F ileMan JSO N utilitie s for HMP; 4 November 2015 @16: 51:35
	29271	"RTN","HMP MDUTL",2,0 )
	29272	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	29273	"RTN","HMP MDUTL",3,0 )
	29274	;Per VA D irective 6 402, this routine sh ould not b e modified .
	29275	"RTN","HMP MDUTL",4,0 )
	29276	;
	29277	"RTN","HMP MDUTL",5,0 )
	29278	;DE2818 S QA finding s Newed HM PCNT, HMPF INI, HMPLA ST, TERMCH LD, TERMUN IT, and TE RMQUAL ASM R/RRB
	29279	"RTN","HMP MDUTL",6,0 )
	29280	;
	29281	"RTN","HMP MDUTL",7,0 )
	29282	Q
	29283	"RTN","HMP MDUTL",8,0 )
	29284	;
	29285	"RTN","HMP MDUTL",9,0 )
	29286	EN Q ; On ly call vi a linetag.
	29287	"RTN","HMP MDUTL",10, 0)
	29288	TERM ; Ret rieves lis t of terms
	29289	"RTN","HMP MDUTL",11, 0)
	29290	; NOTE: This tag w ill NOT su pport page d retrieve s unless n ecessary.
	29291	"RTN","HMP MDUTL",12, 0)
	29292	; Do not e xpect them .
	29293	"RTN","HMP MDUTL",13, 0)
	29294	;
	29295	"RTN","HMP MDUTL",14, 0)
	29296	; DE2818 SQA findi ngs HMPCNT , HMPFINI, HMPLAST
	29297	"RTN","HMP MDUTL",15, 0)
	29298	;
	29299	"RTN","HMP MDUTL",16, 0)
	29300	; Gets t erminology .
	29301	"RTN","HMP MDUTL",17, 0)
	29302	N HMPFIN I,TERMIENS ,TERMCNT,X
	29303	"RTN","HMP MDUTL",18, 0)
	29304	D LIST^D IC("704.10 1",,,,,,,, "I $P(^(0) ,U,5)=1")
	29305	"RTN","HMP MDUTL",19, 0)
	29306	M TERMIE NS=^TMP("D ILIST",$J, 2)
	29307	"RTN","HMP MDUTL",20, 0)
	29308	S TERMCN T=$P($G(^T MP("DILIST ",$J,0)),U ,1)
	29309	"RTN","HMP MDUTL",21, 0)
	29310	K ^TMP(" DILIST",$J )
	29311	"RTN","HMP MDUTL",22, 0)
	29312	;
	29313	"RTN","HMP MDUTL",23, 0)
	29314	F X=0:0 S X=$O(TER MIENS(X)) Q:'X D
	29315	"RTN","HMP MDUTL",24, 0)
	29316	. N HMPC NT,HMPLAST ,RESULT
	29317	"RTN","HMP MDUTL",25, 0)
	29318	. ; term
	29319	"RTN","HMP MDUTL",26, 0)
	29320	. D ONET ERM($G(TER MIENS(X)), "RESULT")
	29321	"RTN","HMP MDUTL",27, 0)
	29322	. ;
	29323	"RTN","HMP MDUTL",28, 0)
	29324	. D ADD^ HMPEF("RES ULT")
	29325	"RTN","HMP MDUTL",29, 0)
	29326	. S HMPC NT=X,HMPLA ST=X
	29327	"RTN","HMP MDUTL",30, 0)
	29328	I 'X S H MPFINI=1
	29329	"RTN","HMP MDUTL",31, 0)
	29330	Q
	29331	"RTN","HMP MDUTL",32, 0)
	29332	ONETERM(ID ,TARGET) ; load one term
	29333	"RTN","HMP MDUTL",33, 0)
	29334	Q:+ID<1 ; Validat e integer/ id.
	29335	"RTN","HMP MDUTL",34, 0)
	29336	N $ES,$E T,ERRMSG
	29337	"RTN","HMP MDUTL",35, 0)
	29338	S ERRMSG =$$ERRMSG^ HMPEF("CLi O Term",ID )
	29339	"RTN","HMP MDUTL",36, 0)
	29340	S $ET="D ERRHDLR^H MPDERRH"
	29341	"RTN","HMP MDUTL",37, 0)
	29342	N TERM,T RM,TERMTYP E
	29343	"RTN","HMP MDUTL",38, 0)
	29344	;
	29345	"RTN","HMP MDUTL",39, 0)
	29346	D GETS^D IQ("704.10 1",ID_",", "*","IE"," TERM")
	29347	"RTN","HMP MDUTL",40, 0)
	29348	N TRM S TRM=$NA(TE RM(704.101 ,""_ID_"," ))
	29349	"RTN","HMP MDUTL",41, 0)
	29350	S @TARGE T@("id")=$ G(@TRM@(.0 1,"E"))
	29351	"RTN","HMP MDUTL",42, 0)
	29352	S @TARGE T@("uid")= "urn:va:cl ioterminol ogy:"_$G(@ TARGET@("i d"))
	29353	"RTN","HMP MDUTL",43, 0)
	29354	S @TARGE T@("term") =$$SANITIZ E($G(@TRM@ (.02,"E")) )
	29355	"RTN","HMP MDUTL",44, 0)
	29356	S @TARGE T@("abbrev iation")=$ $SANITIZE( $G(@TRM@(. 03,"E")))
	29357	"RTN","HMP MDUTL",45, 0)
	29358	S @TARGE T@("displa yName")=$$ SANITIZE($ G(@TRM@(.0 4,"E")))
	29359	"RTN","HMP MDUTL",46, 0)
	29360	; Get Te rm Type
	29361	"RTN","HMP MDUTL",47, 0)
	29362	S TERMTY PE=$$SANIT IZE($G(@TR M@(.05,"I" )))
	29363	"RTN","HMP MDUTL",48, 0)
	29364	D TERMTY PE(TERMTYP E,.TARGET)
	29365	"RTN","HMP MDUTL",49, 0)
	29366	;
	29367	"RTN","HMP MDUTL",50, 0)
	29368	S @TARGE T@("dataTy pe")=$$SAN ITIZE($G(@ TRM@(.06," I")))
	29369	"RTN","HMP MDUTL",51, 0)
	29370	S @TARGE T@("valueT ype")=$$SA NITIZE($G( @TRM@(.07, "I")))
	29371	"RTN","HMP MDUTL",52, 0)
	29372	S @TARGE T@("active ")=$$SANIT IZE($G(@TR M@(.09,"E" )))
	29373	"RTN","HMP MDUTL",53, 0)
	29374	S @TARGE T@("descri ption")=$$ SANITIZE($ G(@TRM@(.1 ,"E")))
	29375	"RTN","HMP MDUTL",54, 0)
	29376	S @TARGE T@("helpTe xt")=$$SAN ITIZE($G(@ TRM@(.2,"E ")))
	29377	"RTN","HMP MDUTL",55, 0)
	29378	S @TARGE T@("boolea nValueTrue ")=$$SANIT IZE($G(@TR M@(.31,"E" )))
	29379	"RTN","HMP MDUTL",56, 0)
	29380	S @TARGE T@("boolea nValueFals e")=$$SANI TIZE($G(@T RM@(.32,"E ")))
	29381	"RTN","HMP MDUTL",57, 0)
	29382	S @TARGE T@("multiS electPickl ist")=$$SA NITIZE($G( @TRM@(.33, "E")))
	29383	"RTN","HMP MDUTL",58, 0)
	29384	S @TARGE T@("VUID") ="urn:va:v uid:"_$$SA NITIZE($G( @TRM@(99.9 9,"E")))
	29385	"RTN","HMP MDUTL",59, 0)
	29386	; term - > child te rms
	29387	"RTN","HMP MDUTL",60, 0)
	29388	;
	29389	"RTN","HMP MDUTL",61, 0)
	29390	; NOTE: As coded, the initia l load is a function of DFN. B ut this lo ad
	29391	"RTN","HMP MDUTL",62, 0)
	29392	; is a func tion of UI D. May bec ome normed either to UID or IF N.
	29393	"RTN","HMP MDUTL",63, 0)
	29394	;
	29395	"RTN","HMP MDUTL",64, 0)
	29396	D TERMCH LD($G(@TRM @(.01,"E") ),.TARGET)
	29397	"RTN","HMP MDUTL",65, 0)
	29398	;
	29399	"RTN","HMP MDUTL",66, 0)
	29400	; term - > unit pai r
	29401	"RTN","HMP MDUTL",67, 0)
	29402	D TERMUN IT($G(@TRM @(.01,"E") ),.TARGET)
	29403	"RTN","HMP MDUTL",68, 0)
	29404	;
	29405	"RTN","HMP MDUTL",69, 0)
	29406	; term - > qualifie r pair
	29407	"RTN","HMP MDUTL",70, 0)
	29408	;
	29409	"RTN","HMP MDUTL",71, 0)
	29410	D TERMQU AL($G(@TRM @(.01,"E") ),.TARGET, ID)
	29411	"RTN","HMP MDUTL",72, 0)
	29412	;
	29413	"RTN","HMP MDUTL",73, 0)
	29414	; NOTE: As coded, term -> un it convers ions are n ot retriev ed.
	29415	"RTN","HMP MDUTL",74, 0)
	29416	; That will be part o f future d evelopment .
	29417	"RTN","HMP MDUTL",75, 0)
	29418	;
	29419	"RTN","HMP MDUTL",76, 0)
	29420	K TERMTY PE,TRM
	29421	"RTN","HMP MDUTL",77, 0)
	29422	Q
	29423	"RTN","HMP MDUTL",78, 0)
	29424	;
	29425	"RTN","HMP MDUTL",79, 0)
	29426	TERMTYPE(I D,TARGET) ; Load ter m types.
	29427	"RTN","HMP MDUTL",80, 0)
	29428	;
	29429	"RTN","HMP MDUTL",81, 0)
	29430	; TARGET is passed by refere nce.
	29431	"RTN","HMP MDUTL",82, 0)
	29432	;
	29433	"RTN","HMP MDUTL",83, 0)
	29434	Q:+ID<1 ; Validat e for dire ct IFN loo kup.
	29435	"RTN","HMP MDUTL",84, 0)
	29436	N TERMTY PE
	29437	"RTN","HMP MDUTL",85, 0)
	29438	D GETS^D IQ("704.10 2",ID_",", "*","E","T ERMTYPE") ;ICR 5748 DE2818 ASF 11/25/15
	29439	"RTN","HMP MDUTL",86, 0)
	29440	N HMPNAM E S HMPNAM E=$T(TTFLD S+1)
	29441	"RTN","HMP MDUTL",87, 0)
	29442	;
	29443	"RTN","HMP MDUTL",88, 0)
	29444	N HMPEPL AC S HMPEP LAC("""")= "\"""
	29445	"RTN","HMP MDUTL",89, 0)
	29446	S @TARGE T@("termTy pe",$P(HMP NAME,";",3 ))=ID
	29447	"RTN","HMP MDUTL",90, 0)
	29448	S @TARGE T@("termTy pe",$P(HMP NAME,";",4 ))=$$SANIT IZE($$REPL ACE^XLFSTR (TERMTYPE( "704.102", ID_",",.01 ,"E"),.HMP EPLAC)) ;I CR 5748 DE 2818 ASF 1 1/25/15
	29449	"RTN","HMP MDUTL",91, 0)
	29450	S @TARGE T@("termTy pe",$P(HMP NAME,";",5 ))=$$SANIT IZE($$REPL ACE^XLFSTR (TERMTYPE( "704.102", ID_",",.02 ,"E"),.HMP EPLAC))
	29451	"RTN","HMP MDUTL",92, 0)
	29452	S @TARGE T@("termTy pe",$P(HMP NAME,";",6 ))=$$SANIT IZE($$REPL ACE^XLFSTR (TERMTYPE( "704.102", ID_",",.03 ,"E"),.HMP EPLAC))
	29453	"RTN","HMP MDUTL",93, 0)
	29454	K TERMTY PE
	29455	"RTN","HMP MDUTL",94, 0)
	29456	Q
	29457	"RTN","HMP MDUTL",95, 0)
	29458	TERMCHLD(I D,TARGET) ;Loads chi ld terms f or a term
	29459	"RTN","HMP MDUTL",96, 0)
	29460	;
	29461	"RTN","HMP MDUTL",97, 0)
	29462	;DE2818 SQA findin gs Newed T ERMCHLD
	29463	"RTN","HMP MDUTL",98, 0)
	29464	N MSGROO T,TERMCHLD
	29465	"RTN","HMP MDUTL",99, 0)
	29466	S MSGROO T="TERMCHL D("""_ID_" "")"
	29467	"RTN","HMP MDUTL",100 ,0)
	29468	D FIND^D IC("704.10 6",,".02E; .03I;.04I; .05E;.06E; .07E;.08E; .09E","M", ID,,,,,MSG ROOT)
	29469	"RTN","HMP MDUTL",101 ,0)
	29470	; Check to see if we actuall y have any children.
	29471	"RTN","HMP MDUTL",102 ,0)
	29472	I +$P(TE RMCHLD(ID, "DILIST",0 ),U,1)<1 K @MSGROOT Q
	29473	"RTN","HMP MDUTL",103 ,0)
	29474	N X F X= 0:0 S X=($ O(TERMCHLD (ID,"DILIS T","ID",X) )) Q:'X D
	29475	"RTN","HMP MDUTL",104 ,0)
	29476	. ; .01 is the Ter m ID
	29477	"RTN","HMP MDUTL",105 ,0)
	29478	. S @TAR GET@("term Child",X," childOrder ")=$$SANIT IZE($G(TER MCHLD(ID," DILIST","I D",X,.02)) )
	29479	"RTN","HMP MDUTL",106 ,0)
	29480	. ; .03 is the Chi ld ID
	29481	"RTN","HMP MDUTL",107 ,0)
	29482	. N CHIL D S CHILD= $NA(@TARGE T@("termCh ild",X,"ch ildTerm"))
	29483	"RTN","HMP MDUTL",108 ,0)
	29484	. D ONET ERM($G(TER MCHLD(ID," DILIST","I D",X,.03)) ,.CHILD)
	29485	"RTN","HMP MDUTL",109 ,0)
	29486	. S @TAR GET@("term Child",X," valueType" )=$$SANITI ZE($G(TERM CHLD(ID,"D ILIST","ID ",X,.05)))
	29487	"RTN","HMP MDUTL",110 ,0)
	29488	. S @TAR GET@("term Child",X," valueDelim iter")=$$S ANITIZE($G (TERMCHLD( ID,"DILIST ","ID",X,. 06)))
	29489	"RTN","HMP MDUTL",111 ,0)
	29490	. S @TAR GET@("term Child",X," valueStart ")=$$SANIT IZE($G(TER MCHLD(ID," DILIST","I D",X,.07)) )
	29491	"RTN","HMP MDUTL",112 ,0)
	29492	. S @TAR GET@("term Child",X," valueStop" )=$$SANITI ZE($G(TERM CHLD(ID,"D ILIST","ID ",X,.08)))
	29493	"RTN","HMP MDUTL",113 ,0)
	29494	. S @TAR GET@("term Child",X," descriptio n")=$$SANI TIZE($G(TE RMCHLD(ID, "DILIST"," ID",X,.09) ))
	29495	"RTN","HMP MDUTL",114 ,0)
	29496	K @MSGRO OT
	29497	"RTN","HMP MDUTL",115 ,0)
	29498	Q
	29499	"RTN","HMP MDUTL",116 ,0)
	29500	TERMUNIT(I D,TARGET) ;Loads Uni ts for a t erm.
	29501	"RTN","HMP MDUTL",117 ,0)
	29502	;
	29503	"RTN","HMP MDUTL",118 ,0)
	29504	;DE2818 S QA finding s Newed TE RMUNIT
	29505	"RTN","HMP MDUTL",119 ,0)
	29506	N MSGROOT ,TERMUNIT
	29507	"RTN","HMP MDUTL",120 ,0)
	29508	S MSGROOT ="TERMUNIT ("""_ID_"" ")"
	29509	"RTN","HMP MDUTL",121 ,0)
	29510	D FIND^DI C("704.105 ",,".02I;. 03E;.04E;. 05E;.06E;. 07E","M",I D,,,,,MSGR OOT)
	29511	"RTN","HMP MDUTL",122 ,0)
	29512	; Check t o see if w e actually have any children.
	29513	"RTN","HMP MDUTL",123 ,0)
	29514	I +$P(TER MUNIT(ID," DILIST",0) ,U,1)<1 K @MSGROOT Q
	29515	"RTN","HMP MDUTL",124 ,0)
	29516	N X F X=0 :0 S X=($O (TERMUNIT( ID,"DILIST ","ID",X)) ) Q:'X D
	29517	"RTN","HMP MDUTL",125 ,0)
	29518	. ; .01 i s the Term ID
	29519	"RTN","HMP MDUTL",126 ,0)
	29520	. ; .02 i s the Unit ID
	29521	"RTN","HMP MDUTL",127 ,0)
	29522	. N UNIT S UNIT=$NA (@TARGET@( "units",X, "unitTerm" ))
	29523	"RTN","HMP MDUTL",128 ,0)
	29524	. D ONETE RM($G(TERM UNIT(ID,"D ILIST","ID ",X,.02)), .UNIT)
	29525	"RTN","HMP MDUTL",129 ,0)
	29526	. S @TARG ET@("units ",X,"minVa lue")=$$SA NITIZE($G( TERMUNIT(I D,"DILIST" ,"ID",X,.0 3)))
	29527	"RTN","HMP MDUTL",130 ,0)
	29528	. S @TARG ET@("units ",X,"maxVa lue")=$$SA NITIZE($G( TERMUNIT(I D,"DILIST" ,"ID",X,.0 4)))
	29529	"RTN","HMP MDUTL",131 ,0)
	29530	. S @TARG ET@("units ",X,"decPr ecision")= $$SANITIZE ($G(TERMUN IT(ID,"DIL IST","ID", X,.05)))
	29531	"RTN","HMP MDUTL",132 ,0)
	29532	. S @TARG ET@("units ",X,"refLo w")=$$SANI TIZE($G(TE RMUNIT(ID, "DILIST"," ID",X,.06) ))
	29533	"RTN","HMP MDUTL",133 ,0)
	29534	. S @TARG ET@("units ",X,"refHi gh")=$$SAN ITIZE($G(T ERMUNIT(ID ,"DILIST", "ID",X,.07 )))
	29535	"RTN","HMP MDUTL",134 ,0)
	29536	K @MSGROO T
	29537	"RTN","HMP MDUTL",135 ,0)
	29538	Q
	29539	"RTN","HMP MDUTL",136 ,0)
	29540	TERMQUAL(I D,TARGET,I FN) ;Loads Qualifier s for a te rm
	29541	"RTN","HMP MDUTL",137 ,0)
	29542	;
	29543	"RTN","HMP MDUTL",138 ,0)
	29544	;DE2818 S QA finding s Newed TE RQUAL
	29545	"RTN","HMP MDUTL",139 ,0)
	29546	N MSGROOT ,TERMQUAL
	29547	"RTN","HMP MDUTL",140 ,0)
	29548	S MSGROOT ="TERMQUAL ("""_ID_"" ")"
	29549	"RTN","HMP MDUTL",141 ,0)
	29550	D FIND^DI C("704.103 ",,".02E;. 03I;.04E", "M",ID,,,, ,MSGROOT)
	29551	"RTN","HMP MDUTL",142 ,0)
	29552	; Check t o see if w e actually have any qualifiers .
	29553	"RTN","HMP MDUTL",143 ,0)
	29554	I +$P(TER MQUAL(ID," DILIST",0) ,U,1)<1 K @MSGROOT Q
	29555	"RTN","HMP MDUTL",144 ,0)
	29556	N X F X=0 :0 S X=($O (TERMQUAL( ID,"DILIST ","ID",X)) ) Q:'X D
	29557	"RTN","HMP MDUTL",145 ,0)
	29558	. ; .01 i s the Term ID
	29559	"RTN","HMP MDUTL",146 ,0)
	29560	. ; .03 i s the Qual ifier ID
	29561	"RTN","HMP MDUTL",147 ,0)
	29562	. N QUAL S QUAL=$NA (@TARGET@( "qualifier s",X,"qual Term"))
	29563	"RTN","HMP MDUTL",148 ,0)
	29564	. ; blj 2 8 Feb 2014 : bandaid to prevent recursive calls if someone ha s messed u p the stru cture of t he TERM_QU ALIFIER fi le.
	29565	"RTN","HMP MDUTL",149 ,0)
	29566	. I IFN'= $G(TERMQUA L(ID,"DILI ST","ID",X ,.03)) D O NETERM($G( TERMQUAL(I D,"DILIST" ,"ID",X,.0 3)),.QUAL)
	29567	"RTN","HMP MDUTL",150 ,0)
	29568	. S @TARG ET@("quali fiers",X," qualOrder" )=$$SANITI ZE($G(TERM QUAL(ID,"D ILIST","ID ",X,.02)))
	29569	"RTN","HMP MDUTL",151 ,0)
	29570	. S @TARG ET@("quali fiers",X," ranking")= $$SANITIZE ($G(TERMQU AL(ID,"DIL IST","ID", X,.04)))
	29571	"RTN","HMP MDUTL",152 ,0)
	29572	K @MSGROO T
	29573	"RTN","HMP MDUTL",153 ,0)
	29574	Q
	29575	"RTN","HMP MDUTL",154 ,0)
	29576	SANITIZE(V ALUE) ; Ma kes sure v alues are formatted correctly.
	29577	"RTN","HMP MDUTL",155 ,0)
	29578	I +VALUE' =VALUE Q V ALUE
	29579	"RTN","HMP MDUTL",156 ,0)
	29580	I VALUE?1 ".".N S VA LUE="0"_VA LUE
	29581	"RTN","HMP MDUTL",157 ,0)
	29582	I VALUE?1 "-.".N S V ALUE="-0"_ $E(VALUE,2 ,$LENGTH(V ALUE))
	29583	"RTN","HMP MDUTL",158 ,0)
	29584	Q VALUE
	29585	"RTN","HMP MDUTL",159 ,0)
	29586	;
	29587	"RTN","HMP MDUTL",160 ,0)
	29588	GENGUID() ;
	29589	"RTN","HMP MDUTL",161 ,0)
	29590	N X,AB
	29591	"RTN","HMP MDUTL",162 ,0)
	29592	S X="",AB =$R(4),AB= $S(AB=0:"8 ",AB=1:"9" ,AB=2:"A", 1:"B")
	29593	"RTN","HMP MDUTL",163 ,0)
	29594	F S X=X_ $$BASE^XLF UTL($R(16) ,10,16) Q: $L(X)>31
	29595	"RTN","HMP MDUTL",164 ,0)
	29596	S X="{"_$ E(X,1,8)_" -"_$E(X,9, 12)_"-"_"4 "_$E(X,14, 16)_"-"_AB _$E(X,18,2 0)_"-"_$E( X,21,32)_" }"
	29597	"RTN","HMP MDUTL",165 ,0)
	29598	Q X
	29599	"RTN","HMP MDUTL",166 ,0)
	29600	TRMFLDS ;F ields for terminolog y
	29601	"RTN","HMP MDUTL",167 ,0)
	29602	;;.01;id
	29603	"RTN","HMP MDUTL",168 ,0)
	29604	;;.02;te rm
	29605	"RTN","HMP MDUTL",169 ,0)
	29606	;;.03;ab breviation
	29607	"RTN","HMP MDUTL",170 ,0)
	29608	;;.04;di splayName
	29609	"RTN","HMP MDUTL",171 ,0)
	29610	;;.05;te rmType
	29611	"RTN","HMP MDUTL",172 ,0)
	29612	;;.06;da taType
	29613	"RTN","HMP MDUTL",173 ,0)
	29614	;;.07;va lueType
	29615	"RTN","HMP MDUTL",174 ,0)
	29616	;;.09;ac tive
	29617	"RTN","HMP MDUTL",175 ,0)
	29618	;;.1;des cription
	29619	"RTN","HMP MDUTL",176 ,0)
	29620	;;.2;hel pText;
	29621	"RTN","HMP MDUTL",177 ,0)
	29622	;;.31;bo oleanValue True
	29623	"RTN","HMP MDUTL",178 ,0)
	29624	;;.32;bo oleanValue False;
	29625	"RTN","HMP MDUTL",179 ,0)
	29626	;;.33;mu ltiSelectP icklist
	29627	"RTN","HMP MDUTL",180 ,0)
	29628	;;99.99; VUID
	29629	"RTN","HMP MDUTL",181 ,0)
	29630	;;***
	29631	"RTN","HMP MDUTL",182 ,0)
	29632	TTFLDS ;Fi elds for T erm Typea
	29633	"RTN","HMP MDUTL",183 ,0)
	29634	;;id;typ e;xmlTag;V UID
	29635	"RTN","HMP META")
	29636	0^102^B122 279349
	29637	"RTN","HMP META",1,0)
	29638	HMPMETA ;S LC/PJH,ASM R/RRB - Ut ility to c ollect Dom ains, UID' s and stam ptimes for a patient ;8/14/13 11:22
	29639	"RTN","HMP META",2,0)
	29640	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	29641	"RTN","HMP META",3,0)
	29642	;Per VA D irective 6 402, this routine sh ould not b e modified .
	29643	"RTN","HMP META",4,0)
	29644	;
	29645	"RTN","HMP META",5,0)
	29646	Q
	29647	"RTN","HMP META",6,0)
	29648	; New rou tine for U S6734
	29649	"RTN","HMP META",7,0)
	29650	;
	29651	"RTN","HMP META",8,0)
	29652	ADD(HMPDMN M,HMPUID,H MPSTMP) ; Build arra y for meta stamp - ca lled from HMPDJ0* ro utines
	29653	"RTN","HMP META",9,0)
	29654	I ($G(HMP UID)="")!( $G(HMPDMNM )="") Q
	29655	"RTN","HMP META",10,0 )
	29656	;For quic k orders t he JDS dom ain is 'qo '
	29657	"RTN","HMP META",11,0 )
	29658	S:HMPDMNM ="quick" H MPDMNM="qo "
	29659	"RTN","HMP META",12,0 )
	29660	S ^TMP("H MPMETA",$J ,HMPDMNM,H MPUID)=HMP STMP
	29661	"RTN","HMP META",13,0 )
	29662	;unit tes ts use fol lowing nod es
	29663	"RTN","HMP META",14,0 )
	29664	S ^TMP("H MPMETA",$J ,HMPDMNM)= $G(^TMP("H MPMETA",$J ,HMPDMNM)) +1
	29665	"RTN","HMP META",15,0 )
	29666	S ^TMP("H MPMETA",$J ,"PATIENT" )=$G(^TMP( "HMPMETA", $J,"PATIEN T"))+1
	29667	"RTN","HMP META",16,0 )
	29668	Q
	29669	"RTN","HMP META",17,0 )
	29670	;
	29671	"RTN","HMP META",18,0 )
	29672	DONE(HMPFD FN,HMPBATC H) ; Check if metast amp compil e is compl ete
	29673	"RTN","HMP META",19,0 )
	29674	;For pati ents this will alway s be true since all patient do mains comp iled by on e task
	29675	"RTN","HMP META",20,0 )
	29676	Q:+$G(HMP FDFN) 1
	29677	"RTN","HMP META",21,0 )
	29678	;For OPD requires t o check th at all dom ain compil es are com pleted
	29679	"RTN","HMP META",22,0 )
	29680	N HMPDOM, HMPCOMP
	29681	"RTN","HMP META",23,0 )
	29682	S HMPDOM= "",HMPCOMP =1 F S HM PDOM=$O(^X TMP(HMPBAT CH,0,"MSTA ",HMPDOM)) Q:HMPDOM= "" D Q:' HMPCOMP
	29683	"RTN","HMP META",24,0 )
	29684	.S:$G(^XT MP(HMPBATC H,0,"MSTA" ,HMPDOM))= 0 HMPCOMP= 0
	29685	"RTN","HMP META",25,0 )
	29686	Q HMPCOMP
	29687	"RTN","HMP META",26,0 )
	29688	;
	29689	"RTN","HMP META",27,0 )
	29690	OPD(HMPFHM P) ;Check if OPD met astamp is ready to c ollect
	29691	"RTN","HMP META",28,0 )
	29692	Q $S($$DO NE("OPD"," HMPFX~"_HM PFHMP_"~OP D"):1,1:0)
	29693	"RTN","HMP META",29,0 )
	29694	;
	29695	"RTN","HMP META",30,0 )
	29696	INIT(HMPBA TCH,HMPFDF N,ARGS) ; Set metast amp status as in pro gress
	29697	"RTN","HMP META",31,0 )
	29698	N DOMAINS
	29699	"RTN","HMP META",32,0 )
	29700	; set up domains to extract
	29701	"RTN","HMP META",33,0 )
	29702	D @($S(HM PFDFN="OPD ":"OPDOMS" ,1:"PTDOMS ")_"^HMPDJ FSD(.DOMAI NS)")
	29703	"RTN","HMP META",34,0 )
	29704	I $G(ARGS ("domains" ))'="" D
	29705	"RTN","HMP META",35,0 )
	29706	. S I=""
	29707	"RTN","HMP META",36,0 )
	29708	. F I=1:1 Q:'$D(DOM AINS(I)) D
	29709	"RTN","HMP META",37,0 )
	29710	.. I ARGS ("domains" )'[DOMAINS (I) K DOMA INS(I)
	29711	"RTN","HMP META",38,0 )
	29712	N HMPDOM, I
	29713	"RTN","HMP META",39,0 )
	29714	F I=1:1 S HMPDOM=$G (DOMAINS(I )) Q:HMPDO M="" S ^X TMP(HMPBAT CH,0,"MSTA ",HMPDOM)= 0
	29715	"RTN","HMP META",40,0 )
	29716	Q
	29717	"RTN","HMP META",41,0 )
	29718	;
	29719	"RTN","HMP META",42,0 )
	29720	UPD(HMPDOM ) ; Update metastamp domain as complete
	29721	"RTN","HMP META",43,0 )
	29722	S ^XTMP(H MPBATCH,0, "MSTA",HMP DOM)=1
	29723	"RTN","HMP META",44,0 )
	29724	Q
	29725	"RTN","HMP META",45,0 )
	29726	;
	29727	"RTN","HMP META",46,0 )
	29728	MERGE1(HMP BATCH,HMPD OM) ; US11 019 Merge a single d omain
	29729	"RTN","HMP META",47,0 )
	29730	M ^XTMP(H MPBATCH,0, "META",HMP DOM)=^TMP( "HMPMETA", $J,HMPDOM)
	29731	"RTN","HMP META",48,0 )
	29732	K ^TMP("H MPMETA",$J ,HMPDOM)
	29733	"RTN","HMP META",49,0 )
	29734	Q
	29735	"RTN","HMP META",50,0 )
	29736	;
	29737	"RTN","HMP META",51,0 )
	29738	MERGE(HMPB ATCH) ; Me rge metast amp data i nto XTMP a nd mark do main compl ete in met astamp
	29739	"RTN","HMP META",52,0 )
	29740	;Formatti ng of meta stamp into JSON form at by HMPM ETA goes h ere when r eady
	29741	"RTN","HMP META",53,0 )
	29742	N HMPDOM
	29743	"RTN","HMP META",54,0 )
	29744	S HMPDOM= "PATIENT"
	29745	"RTN","HMP META",55,0 )
	29746	F S HMPD OM=$O(^TMP ("HMPMETA" ,$J,HMPDOM )) Q:HMPDO M="" D
	29747	"RTN","HMP META",56,0 )
	29748	.M ^XTMP( HMPBATCH,0 ,"META",HM PDOM)=^TMP ("HMPMETA" ,$J,HMPDOM )
	29749	"RTN","HMP META",57,0 )
	29750	K ^TMP("H MPMETA",$J )
	29751	"RTN","HMP META",58,0 )
	29752	Q
	29753	"RTN","HMP META",59,0 )
	29754	;
	29755	"RTN","HMP META",60,0 )
	29756	METAPT(A,H MPCDOM) ; MetaStamp for patien t data (wi thin its o wn syncSta rt chunk). ;US11019 a dded secon d paramete r
	29757	"RTN","HMP META",61,0 )
	29758	; --Input parameter
	29759	"RTN","HMP META",62,0 )
	29760	; A = "^^ HMPFX~hmp- developmen t-box~"<DF N> (e.g. ^ ^HMPFX~hmp -developme nt-box~3)
	29761	"RTN","HMP META",63,0 )
	29762	; HMPCDOM = Single domain US1 1019
	29763	"RTN","HMP META",64,0 )
	29764	;
	29765	"RTN","HMP META",65,0 )
	29766	; --Expec ts
	29767	"RTN","HMP META",66,0 )
	29768	; DOMSIZE ,OFFSET,HM PFCNT ;US1 1019 comme nt added n ot variabl es
	29769	"RTN","HMP META",67,0 )
	29770	;
	29771	"RTN","HMP META",68,0 )
	29772	; --Local variables
	29773	"RTN","HMP META",69,0 )
	29774	; HMPA = "HMPFX~hmp -developme nt-box~"<D FN>
	29775	"RTN","HMP META",70,0 )
	29776	; HMPB = ZTASK# --> ^XTMP(HMP A,<ZTASK#>
	29777	"RTN","HMP META",71,0 )
	29778	; HMPC = Domain (e. g. "allerg y") --> ^X TMP(HMPA,H MPB,<Domai n>
	29779	"RTN","HMP META",72,0 )
	29780	; HMPD = Counter (s equential number) -- > ^XTMP(HM PA,HMPB,HM PC,<Counte r>
	29781	"RTN","HMP META",73,0 )
	29782	; HMPN = Subscript --> ^XTMP( HMPA,HMPB, HMPC,HMPD, <Subscript >
	29783	"RTN","HMP META",74,0 )
	29784	; HMPE = ^XTMP(HMPA ,HMPB,HMPC ,HMPD,HMPN )
	29785	"RTN","HMP META",75,0 )
	29786	; HMPF = Domain id (e.g. the "C877:3:75 1" part of "urn:va:a llergy:C87 7:3:751"
	29787	"RTN","HMP META",76,0 )
	29788	; HMPID = pid --> < site-hash> ;DFN (e.g. C877;3)
	29789	"RTN","HMP META",77,0 )
	29790	; HMPZ1 = DFN
	29791	"RTN","HMP META",78,0 )
	29792	; HMPP = $$PIDS^HMP DJFS(HMPZ1 ) --> JSO N construc t containi ng pid, sy stemId, lo calId, icn
	29793	"RTN","HMP META",79,0 )
	29794	; HMPQ = " (double quote lite ral)
	29795	"RTN","HMP META",80,0 )
	29796	; HMPT = The "total " node fro m ^XTMP -- > ^XTMP(HM PA,HMPB,HM PC,"total" )
	29797	"RTN","HMP META",81,0 )
	29798	; HMPX = JSON const ruct for t he entire metaStamp
	29799	"RTN","HMP META",82,0 )
	29800	; HMPW = Event time Stamp
	29801	"RTN","HMP META",83,0 )
	29802	; HMPY = $$EN^HMPST MP("NOW")
	29803	"RTN","HMP META",84,0 )
	29804	; HMPZ = Counter fo r breaking up the la rge nodes into sub-n odes in ^T MP
	29805	"RTN","HMP META",85,0 )
	29806	;
	29807	"RTN","HMP META",86,0 )
	29808	I '$D(U) S U="^"
	29809	"RTN","HMP META",87,0 )
	29810	N HMPA,HM PB,HMPC,HM PC1,HMPD,H MPE,HMPF,H MPID,HMPM, HMPN
	29811	"RTN","HMP META",88,0 )
	29812	N HMPP,HM PQ,HMPT,HM PW,HMPX,HM PY,HMPZ,HM PZ1
	29813	"RTN","HMP META",89,0 )
	29814	S HMPA=$P (A,U,3),HM PB=$O(^XTM P(HMPA,0)) ,HMPZ1=$P( HMPA,"~",3 )
	29815	"RTN","HMP META",90,0 )
	29816	S HMPE="" ,HMPQ="""" ,HMPZ=0 ;U S11019
	29817	"RTN","HMP META",91,0 )
	29818	S HMPC=$G (HMPCDOM) ;US11019
	29819	"RTN","HMP META",92,0 )
	29820	S HMPP=$$ PIDS^HMPDJ FS(HMPZ1)
	29821	"RTN","HMP META",93,0 )
	29822	S HMPY=$$ EN^HMPSTMP ("NOW")
	29823	"RTN","HMP META",94,0 )
	29824	S HMPX=", ""metaStam p"":"_"{"" icn"":"""_ $$GETICN^M PIF001(HMP Z1)_""""_" ,"
	29825	"RTN","HMP META",95,0 )
	29826	S HMPX=HM PX_"""stam pTime"":"" "_HMPY_""" "_",""sour ceMetaStam p"":"_"{"
	29827	"RTN","HMP META",96,0 )
	29828	S HMPID=$ TR($P($P(H MPP,"pid", 2),","),"" ":")
	29829	"RTN","HMP META",97,0 )
	29830	S HMPX=HM PX_""""_$P (HMPID,";" )_""""_":{ "
	29831	"RTN","HMP META",98,0 )
	29832	S HMPX=HM PX_"""pid" ":"""_HMPI D_""""_","
	29833	"RTN","HMP META",99,0 )
	29834	S HMPX=HM PX_"""loca lId"":"""_ $P(HMPID," ;",2)_"""" _","
	29835	"RTN","HMP META",100, 0)
	29836	S HMPX=HM PX_"""stam pTime"":"" "_HMPY_""" "_","
	29837	"RTN","HMP META",101, 0)
	29838	S HMPX=HM PX_"""doma inMetaStam p"""_":"_" {"
	29839	"RTN","HMP META",102, 0)
	29840	;Scan Dom ains
	29841	"RTN","HMP META",103, 0)
	29842	D:HMPC'=" " I HMPC= "" F S HM PC=$O(^XTM P(HMPA,0," META",HMPC )) Q:HMPC' ]"" D ;U S11019 all ow process by single domain
	29843	"RTN","HMP META",104, 0)
	29844	.S HMPX=H MPX_""""_H MPC_""""_" :{"
	29845	"RTN","HMP META",105, 0)
	29846	.S HMPX=H MPX_"""dom ain"":"""_ HMPC_""""_ ","
	29847	"RTN","HMP META",106, 0)
	29848	.S HMPX=H MPX_"""sta mpTime"":" ""_HMPY_"" ""_","
	29849	"RTN","HMP META",107, 0)
	29850	.S HMPD=0
	29851	"RTN","HMP META",108, 0)
	29852	.S HMPX=H MPX_"""eve ntMetaStam p"""_":"_" {" ; Patie nt data
	29853	"RTN","HMP META",109, 0)
	29854	.N HMPU,H MPS S HMPU =""
	29855	"RTN","HMP META",110, 0)
	29856	.I $O(^XT MP(HMPA,0, "META",HMP C,HMPU))=" " S HMPX=H MPX_"}" ;U S11019 - c ater for z ero entrie s
	29857	"RTN","HMP META",111, 0)
	29858	.F S HMP U=$O(^XTMP (HMPA,0,"M ETA",HMPC, HMPU)) Q:H MPU']"" D
	29859	"RTN","HMP META",112, 0)
	29860	..N VAR0, VAR1
	29861	"RTN","HMP META",113, 0)
	29862	..S HMPS= $G(^XTMP(H MPA,0,"MET A",HMPC,HM PU)),VAR0= $P(HMPU,": ",3),VAR1= $P(HMPU,": ",4,99)
	29863	"RTN","HMP META",114, 0)
	29864	..I $L(HM PX)>20000 S HMPZ=HMP Z+1,^TMP(" HMPF",$J,H MPFCNT,.3, HMPZ)=HMPX ,HMPX=""
	29865	"RTN","HMP META",115, 0)
	29866	..S HMPX= HMPX_"""ur n:va:"_VAR 0_":"_VAR1 _""""_":{"
	29867	"RTN","HMP META",116, 0)
	29868	..S HMPX= HMPX_"""st ampTime"": """_HMPS_" """_"}"
	29869	"RTN","HMP META",117, 0)
	29870	..S HMPX= HMPX_$S($O (^XTMP(HMP A,0,"META" ,HMPC,HMPU ))="":"}", 1:",")
	29871	"RTN","HMP META",118, 0)
	29872	.S HMPX=H MPX_"},"
	29873	"RTN","HMP META",119, 0)
	29874	.I $L(HMP X)>20000 S HMPZ=HMPZ +1,^TMP("H MPF",$J,HM PFCNT,.3,H MPZ)=HMPX, HMPX=""
	29875	"RTN","HMP META",120, 0)
	29876	I $L(HMPX )>0 D
	29877	"RTN","HMP META",121, 0)
	29878	.S HMPZ=H MPZ+1
	29879	"RTN","HMP META",122, 0)
	29880	.S HMPX=$ E(HMPX,1,$ L(HMPX)-1) _"}}}}" D
	29881	"RTN","HMP META",123, 0)
	29882	..I $E(HM PX,$L(HMPX ))="{" S H MPX=HMPX_" ""seq"":"_ OFFSET_"," "total"":" _DOMSIZE
	29883	"RTN","HMP META",124, 0)
	29884	..E S HM PX=HMPX_", ""seq"":"_ OFFSET_"," "total"":" _DOMSIZE
	29885	"RTN","HMP META",125, 0)
	29886	.S HMPX=H MPX_",""ob ject"":"
	29887	"RTN","HMP META",126, 0)
	29888	.S ^TMP(" HMPF",$J,H MPFCNT,.3, HMPZ)=HMPX
	29889	"RTN","HMP META",127, 0)
	29890	Q
	29891	"RTN","HMP META",128, 0)
	29892	;
	29893	"RTN","HMP META",129, 0)
	29894	METAOP(A) ; MetaStam p for oper ational da ta (within its own s yncStart c hunk)
	29895	"RTN","HMP META",130, 0)
	29896	; A = HMP FX~hmp-dev elopment-b ox~OPD
	29897	"RTN","HMP META",131, 0)
	29898	; --Local variables
	29899	"RTN","HMP META",132, 0)
	29900	; HMPA = "HMPFX~hmp -developme nt-box~"<D FN>
	29901	"RTN","HMP META",133, 0)
	29902	; HMPB = ZTASK# --> ^XTMP(HMP A,<ZTASK#>
	29903	"RTN","HMP META",134, 0)
	29904	; HMPC = Domain (e. g. "allerg y") --> ^X TMP(HMPA,H MPB,<Domai n>
	29905	"RTN","HMP META",135, 0)
	29906	; HMPD = Counter (s equential number) -- > ^XTMP(HM PA,HMPB,HM PC,<Counte r>
	29907	"RTN","HMP META",136, 0)
	29908	; HMPN = Subscript --> ^XTMP( HMPA,HMPB, HMPC,HMPD, <Subscript >
	29909	"RTN","HMP META",137, 0)
	29910	; HMPE = ^XTMP(HMPA ,HMPB,HMPC ,HMPD,HMPN )
	29911	"RTN","HMP META",138, 0)
	29912	; HMPF = Domain id (e.g. the "C877:3:75 1" part of "urn:va:a llergy:C87 7:3:751"
	29913	"RTN","HMP META",139, 0)
	29914	; HMPID = pid --> < site-hash> ;DFN (e.g. C877;3)
	29915	"RTN","HMP META",140, 0)
	29916	; HMPZ1 = DFN
	29917	"RTN","HMP META",141, 0)
	29918	; HMPP = $$PIDS^HMP DJFS(HMPZ1 ) --> JSO N construc t containi ng pid, sy stemId, lo calId, icn
	29919	"RTN","HMP META",142, 0)
	29920	; HMPQ = " (double quote lite ral)
	29921	"RTN","HMP META",143, 0)
	29922	; HMPT = The "total " node fro m ^XTMP -- > ^XTMP(HM PA,HMPB,HM PC,"total" )
	29923	"RTN","HMP META",144, 0)
	29924	; HMPX = JSON const ruct for t he entire metaStamp
	29925	"RTN","HMP META",145, 0)
	29926	; HMPW = Event time Stamp
	29927	"RTN","HMP META",146, 0)
	29928	; HMPY = $$EN^HMPST MP("NOW")
	29929	"RTN","HMP META",147, 0)
	29930	; HMPZ = Counter fo r breaking up the la rge nodes into sub-n odes in ^T MP
	29931	"RTN","HMP META",148, 0)
	29932	;
	29933	"RTN","HMP META",149, 0)
	29934	;
	29935	"RTN","HMP META",150, 0)
	29936	I '$D(U) S U="^"
	29937	"RTN","HMP META",151, 0)
	29938	N HMPA,HM PJ,HMPQ,HM PSEP,HMPZ, HMPDAT,HMP DAT1,HMPDO M,HMPDOM1, HMPEVT,HMP X,HMPTOT,H MPTSK,HMPM OR,HMPLAS, HMPMOR,HMP LAS
	29939	"RTN","HMP META",152, 0)
	29940	S HMPA=$P (A,U,3),HM PQ="""",HM PZ=0,HMPSE P=","""
	29941	"RTN","HMP META",153, 0)
	29942	S HMPCNT= $G(HMPCNT) +1,HMPJ=$P (HMPA,"~", 1,2)_"~OPD "
	29943	"RTN","HMP META",154, 0)
	29944	S HMPSEP= HMPQ
	29945	"RTN","HMP META",155, 0)
	29946	S HMPTSK= $O(^XTMP(A ,0)),HMPY= $$EN^HMPST MP("NOW"), HMPID=$$SY S^HMPUTILS
	29947	"RTN","HMP META",156, 0)
	29948	S HMPX="{ ""collecti on"":"""_" OPDsyncSta rt"_""""_" ,"
	29949	"RTN","HMP META",157, 0)
	29950	S HMPX=HM PX_"""meta Stamp"":"_ "{"
	29951	"RTN","HMP META",158, 0)
	29952	S HMPX=HM PX_"""stam pTime"":"" "_HMPY_""" "_",""sour ceMetaStam p"":"_"{"
	29953	"RTN","HMP META",159, 0)
	29954	S HMPX=HM PX_""""_$P (HMPID,";" )_""""_":{ "
	29955	"RTN","HMP META",160, 0)
	29956	S HMPX=HM PX_"""stam pTime"":"" "_HMPY_""" "_","
	29957	"RTN","HMP META",161, 0)
	29958	S HMPX=HM PX_"""doma inMetaStam p"""_":"_" {"
	29959	"RTN","HMP META",162, 0)
	29960	;Scan Dom ains
	29961	"RTN","HMP META",163, 0)
	29962	S HMPC=""
	29963	"RTN","HMP META",164, 0)
	29964	F S HMPC =$O(^XTMP( HMPA,0,"ME TA",HMPC)) Q:HMPC']" " D
	29965	"RTN","HMP META",165, 0)
	29966	.S HMPX=H MPX_""""_H MPC_""""_" :{"
	29967	"RTN","HMP META",166, 0)
	29968	.S HMPX=H MPX_"""dom ain"":"""_ HMPC_""""_ ","
	29969	"RTN","HMP META",167, 0)
	29970	.S HMPX=H MPX_"""sta mpTime"":" ""_HMPY_"" ""_","
	29971	"RTN","HMP META",168, 0)
	29972	.S HMPD=0
	29973	"RTN","HMP META",169, 0)
	29974	.S HMPX=H MPX_"""ite mMetaStamp """_":"_"{ " ; Patien t data
	29975	"RTN","HMP META",170, 0)
	29976	.N HMPU,H MPS S HMPU =""
	29977	"RTN","HMP META",171, 0)
	29978	.F S HMP U=$O(^XTMP (HMPA,0,"M ETA",HMPC, HMPU)) Q:H MPU']"" D
	29979	"RTN","HMP META",172, 0)
	29980	..N VAR0, VAR1
	29981	"RTN","HMP META",173, 0)
	29982	..S HMPS= $G(^XTMP(H MPA,0,"MET A",HMPC,HM PU)),VAR0= $P(HMPU,": ",3),VAR1= $P(HMPU,": ",4,99)
	29983	"RTN","HMP META",174, 0)
	29984	..I $L(HM PX)>20000 S HMPZ=HMP Z+1,^TMP(" HMPF",$J,H MPFCNT,.3, HMPZ)=HMPX ,HMPX=""
	29985	"RTN","HMP META",175, 0)
	29986	..S HMPX= HMPX_"""ur n:va:"_VAR 0_":"_VAR1 _""""_":{"
	29987	"RTN","HMP META",176, 0)
	29988	..S HMPX= HMPX_"""st ampTime"": """_HMPS_" """_"}"
	29989	"RTN","HMP META",177, 0)
	29990	..S HMPX= HMPX_$S($O (^XTMP(HMP A,0,"META" ,HMPC,HMPU ))="":"}", 1:",")
	29991	"RTN","HMP META",178, 0)
	29992	.S HMPX=H MPX_"},"
	29993	"RTN","HMP META",179, 0)
	29994	.I $L(HMP X)>20000 S HMPZ=HMPZ +1,^TMP("H MPF",$J,HM PFCNT,.3,H MPZ)=HMPX, HMPX=""
	29995	"RTN","HMP META",180, 0)
	29996	I $L(HMPX )>0 D
	29997	"RTN","HMP META",181, 0)
	29998	.S HMPZ=H MPZ+1
	29999	"RTN","HMP META",182, 0)
	30000	.S HMPX=$ E(HMPX,1,$ L(HMPX)-1) _"}}}}},{"
	30001	"RTN","HMP META",183, 0)
	30002	.S ^TMP(" HMPF",$J,H MPFCNT,.3, HMPZ)=HMPX
	30003	"RTN","HMP META",184, 0)
	30004	Q
	30005	"RTN","HMP META",185, 0)
	30006	;
	30007	"RTN","HMP META",186, 0)
	30008	STATUS(STO P,HMPFHMP) ; Set HMP GLOBAL US AGE MONITO R status
	30009	"RTN","HMP META",187, 0)
	30010	Q:$G(STOP )="" Q:$G (HMPFHMP)= ""
	30011	"RTN","HMP META",188, 0)
	30012	N HMPFLG, HMPSTMP,HM PSRV
	30013	"RTN","HMP META",189, 0)
	30014	S HMPSRV= $O(^HMP(80 0000,"B",H MPFHMP,"") ) Q:'HMPSR V
	30015	"RTN","HMP META",190, 0)
	30016	S HMPFLG= $P($G(^HMP (800000,HM PSRV,0)),U ,5),HMPSTM P=$P($G(^H MP(800000, HMPSRV,0)) ,U,6)
	30017	"RTN","HMP META",191, 0)
	30018	;If stopp ed and alr eady flagg ed as stop ped do not hing
	30019	"RTN","HMP META",192, 0)
	30020	I STOP,HM PFLG Q
	30021	"RTN","HMP META",193, 0)
	30022	;If stopp ed but not flagged a s stopped set flag a nd timesta mp
	30023	"RTN","HMP META",194, 0)
	30024	I STOP,'H MPFLG D SE T(STOP,HMP SRV) Q
	30025	"RTN","HMP META",195, 0)
	30026	;If runni ng and fla gged as st opped flag as runnin g
	30027	"RTN","HMP META",196, 0)
	30028	I 'STOP,H MPFLG D SE T(STOP,HMP SRV) Q
	30029	"RTN","HMP META",197, 0)
	30030	;No actio n needed i f running and not fl agged as s top
	30031	"RTN","HMP META",198, 0)
	30032	Q
	30033	"RTN","HMP META",199, 0)
	30034	;
	30035	"RTN","HMP META",200, 0)
	30036	SET(STOP,H MPSRV) ; F lag set/re set, Stamp time set
	30037	"RTN","HMP META",201, 0)
	30038	Q:'$G(HMP SRV)
	30039	"RTN","HMP META",202, 0)
	30040	L +^HMP(8 00000,HMPS RV,0):5 E Q
	30041	"RTN","HMP META",203, 0)
	30042	S $P(^HMP (800000,HM PSRV,0),U, 5,6)=STOP_ U_$$NOW^XL FDT
	30043	"RTN","HMP META",204, 0)
	30044	L -^HMP(8 00000,HMPS RV,0)
	30045	"RTN","HMP META",205, 0)
	30046	Q
	30047	"RTN","HMP META",206, 0)
	30048	;
	30049	"RTN","HMP META",207, 0)
	30050	CHECK(HMPF HMP) ; Che ck status and send H MP GLOBAL USAGE MONI TOR messag e if appro priate
	30051	"RTN","HMP META",208, 0)
	30052	; Input H MPFHMP - s erver name
	30053	"RTN","HMP META",209, 0)
	30054	Q:$G(HMPF HMP)=""
	30055	"RTN","HMP META",210, 0)
	30056	N HMPFLG, HMPSTMP,HM PDIFF,HMPS RV
	30057	"RTN","HMP META",211, 0)
	30058	S HMPSRV= $O(^HMP(80 0000,"B",H MPFHMP,"") ) Q:'HMPSR V
	30059	"RTN","HMP META",212, 0)
	30060	S HMPFLG= $P($G(^HMP (800000,HM PSRV,0)),U ,5)
	30061	"RTN","HMP META",213, 0)
	30062	;No actio n required if status is not se t
	30063	"RTN","HMP META",214, 0)
	30064	I HMPFLG= "" Q
	30065	"RTN","HMP META",215, 0)
	30066	;Get stam ptime
	30067	"RTN","HMP META",216, 0)
	30068	S HMPSTMP =$P($G(^HM P(800000,H MPSRV,0)), U,6) Q:HMP STMP=""
	30069	"RTN","HMP META",217, 0)
	30070	;If stamp time < fiv e minutes ago no act ion
	30071	"RTN","HMP META",218, 0)
	30072	I $$FMDIF F^XLFDT($$ NOW^XLFDT, HMPSTMP,2) <300 Q
	30073	"RTN","HMP META",219, 0)
	30074	;Otherwis e send mes sage
	30075	"RTN","HMP META",220, 0)
	30076	D:HMPFLG MESNOK
	30077	"RTN","HMP META",221, 0)
	30078	D:'HMPFLG MESOK
	30079	"RTN","HMP META",222, 0)
	30080	;Clear DI SK USAGE S TATUS and DISK USAGE STATUS TI ME in subs cription f ile
	30081	"RTN","HMP META",223, 0)
	30082	L +^HMP(8 00000,HMPS RV,0):5 E Q
	30083	"RTN","HMP META",224, 0)
	30084	S $P(^HMP (800000,HM PSRV,0),U, 5,6)=""
	30085	"RTN","HMP META",225, 0)
	30086	L -^HMP(8 00000,HMPS RV,0):5
	30087	"RTN","HMP META",226, 0)
	30088	Q
	30089	"RTN","HMP META",227, 0)
	30090	;
	30091	"RTN","HMP META",228, 0)
	30092	MESNOK ; M ail Messag e if space limit on XTMP is br eached
	30093	"RTN","HMP META",229, 0)
	30094	;
	30095	"RTN","HMP META",230, 0)
	30096	N MAX,RCT ,SIZE,XMSU BJ,XMBODY, XMDUZ,XMTO ,XMZ
	30097	"RTN","HMP META",231, 0)
	30098	;Determin e estimate d usage of XTMP
	30099	"RTN","HMP META",232, 0)
	30100	S SIZE=$J ($P($$GETS IZE^HMPUTI LS(),",")/ 1000000,2, 2)
	30101	"RTN","HMP META",233, 0)
	30102	S MAX=$J( $$GETMAX^H MPDJFSP()/ 1000000,2, 2)
	30103	"RTN","HMP META",234, 0)
	30104	;Construc t Mail Mes sage
	30105	"RTN","HMP META",235, 0)
	30106	S RCT(1)= "Alert: eH MP usage o f global ^ XTMP has e xceeded "_ MAX_" Mb f or more th an 5 minut es."
	30107	"RTN","HMP META",236, 0)
	30108	S RCT(2)= " "
	30109	"RTN","HMP META",237, 0)
	30110	S RCT(3)= " eH MP subscri bing is pa used."
	30111	"RTN","HMP META",238, 0)
	30112	S RCT(4)= " "
	30113	"RTN","HMP META",239, 0)
	30114	S RCT(5)= " eH MP usage o f global ^ XTMP is "_ SIZE_" Mb. "
	30115	"RTN","HMP META",240, 0)
	30116	S RCT(6)= " "
	30117	"RTN","HMP META",241, 0)
	30118	S RCT(7)= " Di sk space c heck at "_ $$FMTE^XLF DT($$NOW^X LFDT)
	30119	"RTN","HMP META",242, 0)
	30120	S RCT(8)= " " ;Send warning to IRM VistA mail grou p
	30121	"RTN","HMP META",243, 0)
	30122	S XMSUBJ= "HMP GLOBA L USAGE MO NITOR",XMB ODY="RCT", XMDUZ="",X MTO("HMP I RM GROUP") =""
	30123	"RTN","HMP META",244, 0)
	30124	S XMDUZ=. 5,XMDUZ(0) ="@"
	30125	"RTN","HMP META",245, 0)
	30126	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,,.XMZ)
	30127	"RTN","HMP META",246, 0)
	30128	Q
	30129	"RTN","HMP META",247, 0)
	30130	;
	30131	"RTN","HMP META",248, 0)
	30132	MESOK ; Ma il Message if space limit on X TMP return s to norma l
	30133	"RTN","HMP META",249, 0)
	30134	;
	30135	"RTN","HMP META",250, 0)
	30136	N MAX,RCT ,XMSUBJ,XM BODY,XMDUZ ,XMTO,XMZ
	30137	"RTN","HMP META",251, 0)
	30138	S MAX=$J( $$GETMAX^H MPDJFSP()/ 1000000,2, 2)
	30139	"RTN","HMP META",252, 0)
	30140	;Construc t Mail Mes sage
	30141	"RTN","HMP META",253, 0)
	30142	S RCT(1)= "Alert: eH MP usage o f global ^ XTMP has b een below "_MAX_" Mb . for more than 5 mi nutes."
	30143	"RTN","HMP META",254, 0)
	30144	S RCT(2)= " "
	30145	"RTN","HMP META",255, 0)
	30146	S RCT(3)= " eH MP subscri bing is re started."
	30147	"RTN","HMP META",256, 0)
	30148	S RCT(4)= " "
	30149	"RTN","HMP META",257, 0)
	30150	S RCT(5)= " Di sk space c heck at "_ $$FMTE^XLF DT($$NOW^X LFDT)
	30151	"RTN","HMP META",258, 0)
	30152	S RCT(6)= " "
	30153	"RTN","HMP META",259, 0)
	30154	;Send mes sage to IR M VistA ma il group
	30155	"RTN","HMP META",260, 0)
	30156	S XMSUBJ= "HMP GLOBA L USAGE MO NITOR",XMB ODY="RCT", XMDUZ="",X MTO("IRM G ROUP")=""
	30157	"RTN","HMP META",261, 0)
	30158	S XMDUZ=. 5,XMDUZ(0) ="@"
	30159	"RTN","HMP META",262, 0)
	30160	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,,.XMZ)
	30161	"RTN","HMP META",263, 0)
	30162	Q
	30163	"RTN","HMP META",264, 0)
	30164	;
	30165	"RTN","HMP META",265, 0)
	30166	;Followin g tags use d by VPRJT T0 unit te st routine s
	30167	"RTN","HMP META",266, 0)
	30168	;-------- ---------- ---------- ---------- ---------- -
	30169	"RTN","HMP META",267, 0)
	30170	EN(HMPFDFN ) ;Build X TMP for pa tient
	30171	"RTN","HMP META",268, 0)
	30172	I $G(HMPF DFN)="" D MES^XPDUTL ("No patie nt specifi ed, call a s D EN^HMP META(DFN)" ) Q
	30173	"RTN","HMP META",269, 0)
	30174	N ARGS,DO MAINS,HMPS RV,NEWSUB, HMPFERR,HM PBATCH,HMP STMP,SEQNO DE,ZTSK,ZT QUEUED
	30175	"RTN","HMP META",270, 0)
	30176	;Select d omains to compile
	30177	"RTN","HMP META",271, 0)
	30178	;OPD doma ins
	30179	"RTN","HMP META",272, 0)
	30180	;asu-clas s#asu-rule #category# charttab#d isplaygrou p#doc-def# labgroup#l abpanel#lo cation#ord erable#pag e#pt-selec t#
	30181	"RTN","HMP META",273, 0)
	30182	;personph oto#pointo fcare#quic k#roster#r oute#sched ule#team#t eampositio n#user#use rtabprefs# viewdefdef #
	30183	"RTN","HMP META",274, 0)
	30184	;viewdefd efcoldefco nfigtempla te#immuniz ation-list #allergy-l ist#signss ymptoms-li st#vitalty pes-list#
	30185	"RTN","HMP META",275, 0)
	30186	;vitalqua lifier-lis t#vitalcat egory-list
	30187	"RTN","HMP META",276, 0)
	30188	;Patient domains
	30189	"RTN","HMP META",277, 0)
	30190	;allergy# vital#prob lem#order# treatment# patient#co nsult#proc edure#obs# visit#appo intment#pt f#med#lab#
	30191	"RTN","HMP META",278, 0)
	30192	;image#su rgery#docu ment#mh#
	30193	"RTN","HMP META",279, 0)
	30194	;Patient PCE domain s
	30195	"RTN","HMP META",280, 0)
	30196	;auxiliar y#diagnosi s#factor#i mmunizatio n#task#vit al#exam#cp t#educatio n#pov#skin
	30197	"RTN","HMP META",281, 0)
	30198	;S ARGS(" domains")= "allergy#a su-class"
	30199	"RTN","HMP META",282, 0)
	30200	;
	30201	"RTN","HMP META",283, 0)
	30202	;Modify S EQNODE to extract re quired pat ient
	30203	"RTN","HMP META",284, 0)
	30204	S SEQNODE =HMPFDFN_" ^syncStart ^HMPFX~hmp -developme nt-box~"_H MPFDFN_"^^ 64671"
	30205	"RTN","HMP META",285, 0)
	30206	S HMPBATC H=$P(SEQNO DE,U,3),HM PSRV=$P(HM PBATCH,"~" ,2)
	30207	"RTN","HMP META",286, 0)
	30208	S HMPSRV( "ien")=$O( ^HMP(80000 0,"B",HMPS RV,0)) Q:' HMPSRV("ie n")
	30209	"RTN","HMP META",287, 0)
	30210	;Unsubscr ibe patien t and clea r cache
	30211	"RTN","HMP META",288, 0)
	30212	D UNSUB(H MPFDFN,HMP SRV("ien") ) K ^XTMP( HMPBATCH)
	30213	"RTN","HMP META",289, 0)
	30214	;Clear me tastamp ar ray
	30215	"RTN","HMP META",290, 0)
	30216	K ^TMP("H MPMETA",$J )
	30217	"RTN","HMP META",291, 0)
	30218	; set up domains to extract
	30219	"RTN","HMP META",292, 0)
	30220	D @($S(HM PFDFN="OPD ":"OPDOMS" ,1:"PTDOMS ")_"^HMPDJ FSD(.DOMAI NS)")
	30221	"RTN","HMP META",293, 0)
	30222	;Clear un wanted dom ains
	30223	"RTN","HMP META",294, 0)
	30224	I $G(ARGS ("domains" ))'="" N I F I=1:1 Q :'$D(DOMAI NS(I)) K: ARGS("doma ins")'[DOM AINS(I) DO MAINS(I)
	30225	"RTN","HMP META",295, 0)
	30226	;
	30227	"RTN","HMP META",296, 0)
	30228	; see if this is ne w subscrip tion and t ask extrac t if new
	30229	"RTN","HMP META",297, 0)
	30230	D SETPAT^ HMPDJFSP(H MPFDFN,HMP SRV,.NEWSU B) Q:$G(HM PFERR) ""
	30231	"RTN","HMP META",298, 0)
	30232	;For oper ational da ta set sta mptime as time subsc ription pl aced
	30233	"RTN","HMP META",299, 0)
	30234	S:HMPFDFN ="OPD" HMP STMP=$$JSO NDT^HMPUTI LS($$NOW^X LFDT)
	30235	"RTN","HMP META",300, 0)
	30236	I NEWSUB D Q:$G(HM PFERR) ""
	30237	"RTN","HMP META",301, 0)
	30238	. I HMPFD FN="OPD" D ; queue each opera tional dom ain
	30239	"RTN","HMP META",302, 0)
	30240	. . S I=" " F S I=$ O(DOMAINS( I)) Q:'I D
	30241	"RTN","HMP META",303, 0)
	30242	. . . N H MPFDOM
	30243	"RTN","HMP META",304, 0)
	30244	. . . S H MPFDOM(1)= DOMAINS(I)
	30245	"RTN","HMP META",305, 0)
	30246	. . . D Q UINIT(HMPB ATCH,HMPFD FN,.HMPFDO M)
	30247	"RTN","HMP META",306, 0)
	30248	. E D ; queue all domains f or patient
	30249	"RTN","HMP META",307, 0)
	30250	. . N HMP FDOM
	30251	"RTN","HMP META",308, 0)
	30252	. . M HMP FDOM=DOMAI NS
	30253	"RTN","HMP META",309, 0)
	30254	. . ; if patients e xtracts ar e held (ve rsion mism atch), put DFN on wa it list
	30255	"RTN","HMP META",310, 0)
	30256	. . I $G( ^XTMP("HMP FS~"_HMPSR V("ien")," waiting")) S ^XTMP(" HMPFS~"_HM PSRV("ien" ),"waiting ",HMPFDFN) ="" QUIT
	30257	"RTN","HMP META",311, 0)
	30258	. . ; oth erwise que ue patient
	30259	"RTN","HMP META",312, 0)
	30260	. . D QUI NIT(HMPBAT CH,HMPFDFN ,.HMPFDOM)
	30261	"RTN","HMP META",313, 0)
	30262	Q
	30263	"RTN","HMP META",314, 0)
	30264	;
	30265	"RTN","HMP META",315, 0)
	30266	QUINIT(HMP BATCH,HMPF DFN,HMPFDO M) ; Queue the initi al extract s for a pa tient
	30267	"RTN","HMP META",316, 0)
	30268	; HMPBATC H="HMPFX~h mpsrvid~df n" exampl e: HMPFX~h mpXYZ~229
	30269	"RTN","HMP META",317, 0)
	30270	; HMPFDOM (n)="domai nName"
	30271	"RTN","HMP META",318, 0)
	30272	;
	30273	"RTN","HMP META",319, 0)
	30274	; ^XTMP(" HMPFX~hmps rvid~dfn", 0)=expires ^created^H MP Patient Extract
	30275	"RTN","HMP META",320, 0)
	30276	; , 0,"status" ,domain)=0 :waiting;1 :ready
	30277	"RTN","HMP META",321, 0)
	30278	; , 0,"task",t askIen)=""
	30279	"RTN","HMP META",322, 0)
	30280	; , taskIen,do main,... ( extract da ta)
	30281	"RTN","HMP META",323, 0)
	30282	;
	30283	"RTN","HMP META",324, 0)
	30284	; only do ne once wh en beginni ng the bat ch, no mat ter how ma ny tasked jobs
	30285	"RTN","HMP META",325, 0)
	30286	L +^XTMP( HMPBATCH): 5 E D SET ERR^HMPDJF S("Cannot lock batch :"_HMPBATC H) QUIT
	30287	"RTN","HMP META",326, 0)
	30288	I '$D(^XT MP(HMPBATC H)) D
	30289	"RTN","HMP META",327, 0)
	30290	. D NEWXT MP^HMPDJFS (HMPBATCH, 2,"HMP Pat ient Extra ct")
	30291	"RTN","HMP META",328, 0)
	30292	. I $G(AR GS("jobId" ))]"" S ^X TMP(HMPBAT CH,"JOBID" )=ARGS("jo bId") ;US 3907
	30293	"RTN","HMP META",329, 0)
	30294	. I $G(AR GS("rootJo bId"))]"" S ^XTMP(HM PBATCH,"RO OTJOBID")= ARGS("root JobId") ; US3907
	30295	"RTN","HMP META",330, 0)
	30296	. S ^XTMP (HMPBATCH, 0,"time")= $H
	30297	"RTN","HMP META",331, 0)
	30298	. D SETMA RK^HMPDJFS P("Start", HMPFDFN,HM PBATCH) ; sends full demograph ics
	30299	"RTN","HMP META",332, 0)
	30300	L -^XTMP( HMPBATCH)
	30301	"RTN","HMP META",333, 0)
	30302	;
	30303	"RTN","HMP META",334, 0)
	30304	; set up the domain s to be do ne by this task
	30305	"RTN","HMP META",335, 0)
	30306	N I S I=0 F S I=$O (HMPFDOM(I )) Q:'I D SETDOM^HM PDJFSP("st atus",HMPF DOM(I),0)
	30307	"RTN","HMP META",336, 0)
	30308	;
	30309	"RTN","HMP META",337, 0)
	30310	;Call com pile in fo reground
	30311	"RTN","HMP META",338, 0)
	30312	S ZTSK=$J ,^XTMP(HMP BATCH,0,"t ask",ZTSK) =$H,ZTQUEU ED="1" D D QINIT^HMPD JFSP U 0
	30313	"RTN","HMP META",339, 0)
	30314	Q
	30315	"RTN","HMP META",340, 0)
	30316	;
	30317	"RTN","HMP META",341, 0)
	30318	UNSUB(DFN, SRV) ;Unsu bscribe
	30319	"RTN","HMP META",342, 0)
	30320	;Operatio nal Data s ubscriptio n
	30321	"RTN","HMP META",343, 0)
	30322	I DFN="OP D" D UPDOP D^HMPDJFSP (SRV,"@") Q
	30323	"RTN","HMP META",344, 0)
	30324	;Patient subscripti on
	30325	"RTN","HMP META",345, 0)
	30326	N DA,DIK
	30327	"RTN","HMP META",346, 0)
	30328	S DA=DFN, DA(1)=SRV
	30329	"RTN","HMP META",347, 0)
	30330	S DIK="^H MP(800000, "_DA(1)_", 1,"
	30331	"RTN","HMP META",348, 0)
	30332	D ^DIK
	30333	"RTN","HMP META",349, 0)
	30334	Q
	30335	"RTN","HMP P2I")
	30336	1^178
	30337	"RTN","HMP P3I")
	30338	0^104^B129 333471
	30339	"RTN","HMP P3I",1,0)
	30340	HMPP3I ;SL C/AGP,ASMR /RRB,ASF,S RG - HMP p atch 3 pos t install ; Jan 21, 2015 16:50 :00
	30341	"RTN","HMP P3I",2,0)
	30342	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Oc t 10, 2014 ;Build 63
	30343	"RTN","HMP P3I",3,0)
	30344	;Per VA D irective 6 402, this routine sh ould not b e modified .
	30345	"RTN","HMP P3I",4,0)
	30346	;
	30347	"RTN","HMP P3I",5,0)
	30348	; ^XTV(89 89.51 - IC R 2992
	30349	"RTN","HMP P3I",6,0)
	30350	; ^XTV(89 89.5 - ICR 2682
	30351	"RTN","HMP P3I",7,0)
	30352	;
	30353	"RTN","HMP P3I",8,0)
	30354	Q
	30355	"RTN","HMP P3I",9,0)
	30356	;
	30357	"RTN","HMP P3I",10,0)
	30358	ENV ; -- e nvironment check to prevent pr oduction i nstallatio n
	30359	"RTN","HMP P3I",11,0)
	30360	N XPDABOR T ; DE281 8 SQA find ings ASMR/ RRB
	30361	"RTN","HMP P3I",12,0)
	30362	I $$PROD^ XUPROD D
	30363	"RTN","HMP P3I",13,0)
	30364	.W !,"Pro duction ac count inst allation i s not perm itted at t his time."
	30365	"RTN","HMP P3I",14,0)
	30366	.W !!,"Pl ease verif y the targ et install ation acco unt is a n on-product ion accoun t."
	30367	"RTN","HMP P3I",15,0)
	30368	.W !!,"** * INSTALLA TION ABORT ED! ***"
	30369	"RTN","HMP P3I",16,0)
	30370	.S XPDABO RT=1
	30371	"RTN","HMP P3I",17,0)
	30372	Q
	30373	"RTN","HMP P3I",18,0)
	30374	;
	30375	"RTN","HMP P3I",19,0)
	30376	PRE ; -- c lean out H MP SUBSCRI PTION and ^XTMP("HMP ") entries for testi ng
	30377	"RTN","HMP P3I",20,0)
	30378	N HMPDT S HMPDT="HM P-1111111"
	30379	"RTN","HMP P3I",21,0)
	30380	F S HMPD T=$O(^XTMP (HMPDT)) Q :HMPDT'?1" HMP-"7N K ^XTMP(HMP DT)
	30381	"RTN","HMP P3I",22,0)
	30382	S HMPDT=" HMPEF-1111 111"
	30383	"RTN","HMP P3I",23,0)
	30384	F S HMPD T=$O(^XTMP (HMPDT)) Q :HMPDT'?1" HMPEF-"7N K ^XTMP(H MPDT)
	30385	"RTN","HMP P3I",24,0)
	30386	K ^XTMP(" HMP"),^TMP ("HMPX")
	30387	"RTN","HMP P3I",25,0)
	30388	;I $$VERC MP($$VERSR V(),"0.7-S 54")>0 D ; if curre nt < S54
	30389	"RTN","HMP P3I",26,0)
	30390	;. K ^HMP (800000)
	30391	"RTN","HMP P3I",27,0)
	30392	;. S ^HMP (800000,0) ="HMP SUBS CRIPTION^8 00000^^"
	30393	"RTN","HMP P3I",28,0)
	30394	;D CLEARP AR
	30395	"RTN","HMP P3I",29,0)
	30396	;D TASKCO NV
	30397	"RTN","HMP P3I",30,0)
	30398	D ADDRSRC ; add res ource for throttling extract t asks
	30399	"RTN","HMP P3I",31,0)
	30400	S ^XTMP(" HMP-LAST-S CHEMA",0)= $$HTFM^XLF DT(+$H+7)_ U_$$HTFM^X LFDT(+$H)_ U_"JSON sc hema befor e install"
	30401	"RTN","HMP P3I",32,0)
	30402	S ^XTMP(" HMP-LAST-S CHEMA",1)= +$P($$GET^ XPAR("PKG" ,"HMP JSON SCHEMA"), ".")
	30403	"RTN","HMP P3I",33,0)
	30404	Q
	30405	"RTN","HMP P3I",34,0)
	30406	;
	30407	"RTN","HMP P3I",35,0)
	30408	CLEARPAR ;
	30409	"RTN","HMP P3I",36,0)
	30410	N ENT,ERR OR,INST,LI ST,PAR,TYP E,X,UID
	30411	"RTN","HMP P3I",37,0)
	30412	;S PAR="" F S PAR= $O(^XTV(89 89.51,"B", "HMP PARAM ETERS","") ) I PAR>0 Q
	30413	"RTN","HMP P3I",38,0)
	30414	S PAR=$O( ^XTV(8989. 51,"B","HM P PARAMETE RS","")) Q :PAR'>0
	30415	"RTN","HMP P3I",39,0)
	30416	S X="" F S X=$O(^X TV(8989.5, "AC",PAR,X )) Q:X="" D
	30417	"RTN","HMP P3I",40,0)
	30418	.S TYPE=$ S(X["VA":" USR",X["DI C":"SYS",1 :"") I TYP E="" Q
	30419	"RTN","HMP P3I",41,0)
	30420	.S ENT=TY PE_".`"_+X
	30421	"RTN","HMP P3I",42,0)
	30422	.S UID="" F S UID= $O(^XTV(89 89.5,"AC", PAR,X,UID) ) Q:UID="" D
	30423	"RTN","HMP P3I",43,0)
	30424	..D DEL^X PAR(ENT,"H MP PARAMET ERS",UID,. ERROR)
	30425	"RTN","HMP P3I",44,0)
	30426	Q
	30427	"RTN","HMP P3I",45,0)
	30428	;
	30429	"RTN","HMP P3I",46,0)
	30430	; VERSRV and VERCMP are also in HMPUTIL S, but not until aft er the ins tall
	30431	"RTN","HMP P3I",47,0)
	30432	; of this patch (HM P23), so they are reproduced here.
	30433	"RTN","HMP P3I",48,0)
	30434	;
	30435	"RTN","HMP P3I",49,0)
	30436	VERSRV() ; Return server ver sion of op tion name
	30437	"RTN","HMP P3I",50,0)
	30438	N HMPLST, VAL
	30439	"RTN","HMP P3I",51,0)
	30440	D FIND^DI C(19,"",1, "X","HMP U I CONTEXT" ,1,,,,"HMP LST")
	30441	"RTN","HMP P3I",52,0)
	30442	S VAL=$G( HMPLST("DI LIST","ID" ,1,1))
	30443	"RTN","HMP P3I",53,0)
	30444	Q $$UP^XL FSTR($P(VA L,"version ",2))
	30445	"RTN","HMP P3I",54,0)
	30446	;
	30447	"RTN","HMP P3I",55,0)
	30448	VERCMP(CUR ,VAL) ; Re turns 1 if CUR<VAL, -1 if CUR> VAL, 0 if equal
	30449	"RTN","HMP P3I",56,0)
	30450	N CURMAJO R,CURMINOR ,CURSNAP,V ALMAJOR,VA LMINOR,VAL SNAP
	30451	"RTN","HMP P3I",57,0)
	30452	S CURMAJO R=$P(CUR," -"),CURMIN OR=$P(CUR, "-",2),CUR SNAP=$E($P (CUR,"-",3 ),1,4)="SN AP"
	30453	"RTN","HMP P3I",58,0)
	30454	S VALMAJO R=$P(VAL," -"),VALMIN OR=$P(VAL, "-",2),VAL SNAP=$E($P (VAL,"-",3 ),1,4)="SN AP"
	30455	"RTN","HMP P3I",59,0)
	30456	I $E(VALM INOR)="P" S VALMINOR =$E(VALMIN OR,2,99) ; "P"il ot version s (old)
	30457	"RTN","HMP P3I",60,0)
	30458	I $E(CURM INOR)="P" S CURMINOR =$E(VALMIN OR,2,99)
	30459	"RTN","HMP P3I",61,0)
	30460	I $E(VALM INOR)="S" S VALMINOR =$E(VALMIN OR,2,99)*1 0 ; "S"pr int versio ns
	30461	"RTN","HMP P3I",62,0)
	30462	I $E(CURM INOR)="S" S CURMINOR =$E(CURMIN OR,2,99)*1 0
	30463	"RTN","HMP P3I",63,0)
	30464	Q:VALMAJO R>CURMAJOR 1 Q:VAL MAJOR<CURM AJOR -1 ; compare m ajor versi ons
	30465	"RTN","HMP P3I",64,0)
	30466	Q:VALMINO R>CURMINOR 1 Q:VAL MINOR<CURM INOR -1 ; compare m inor versi ons
	30467	"RTN","HMP P3I",65,0)
	30468	Q:(CURSNA P&'VALSNAP ) 1 Q:(VA LSNAP&'CUR SNAP) -1 ; "SNAPSHOT " < releas ed
	30469	"RTN","HMP P3I",66,0)
	30470	Q 0
	30471	"RTN","HMP P3I",67,0)
	30472	;
	30473	"RTN","HMP P3I",68,0)
	30474	;
	30475	"RTN","HMP P3I",69,0)
	30476	POST ; -- set up new Tx data
	30477	"RTN","HMP P3I",70,0)
	30478	;D CREATE US
	30479	"RTN","HMP P3I",71,0)
	30480	N HMPLVER
	30481	"RTN","HMP P3I",72,0)
	30482	S HMPLVER =$$VERSRV( )
	30483	"RTN","HMP P3I",73,0)
	30484	D VERSION
	30485	"RTN","HMP P3I",74,0)
	30486	D EN^HMPI DX
	30487	"RTN","HMP P3I",75,0)
	30488	D OBJCNT
	30489	"RTN","HMP P3I",76,0)
	30490	I $$VERCM P(HMPLVER, "0.7-S58") >0 D PARPI D ; if cu rrent < S5 8
	30491	"RTN","HMP P3I",77,0)
	30492	I $G(^XTM P("HMP-LAS T-SCHEMA", 1))<2 D CV TPAT,CVTSE L ; if ex isting sch ema < 2.0
	30493	"RTN","HMP P3I",78,0)
	30494	K ^XTMP(" HMP-LAST-S CHEMA")
	30495	"RTN","HMP P3I",79,0)
	30496	;D CREATE ^HMPAP1 ; BL;V5-6 Pr otocols no w attached via KIDs build not post routi ne
	30497	"RTN","HMP P3I",80,0)
	30498	D POST^HM PPRXY2
	30499	"RTN","HMP P3I",81,0)
	30500	D DISABLE ^HMPZ0218 ;BL;US5021
	30501	"RTN","HMP P3I",82,0)
	30502	D POST^HM P0311P
	30503	"RTN","HMP P3I",83,0)
	30504	D POST^HM P0311Q ;DE 2393 - Sub scribe HMP ADT CLIEN T P'cols t o VAFC ATD SERVERS
	30505	"RTN","HMP P3I",84,0)
	30506	D SETPARM S ;US7724 - set thro ttling par ameter val ues
	30507	"RTN","HMP P3I",85,0)
	30508	D MENUADD ;NEED TO ADD HMP X U EVENTS O PTION to m enu XU USE R ADD
	30509	"RTN","HMP P3I",86,0)
	30510	Q
	30511	"RTN","HMP P3I",87,0)
	30512	;
	30513	"RTN","HMP P3I",88,0)
	30514	VERSION ; -- update V# paramet er
	30515	"RTN","HMP P3I",89,0)
	30516	D PUT^XPA R("PKG","H MP VERSION ",1,"2.00" )
	30517	"RTN","HMP P3I",90,0)
	30518	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME") I HM PSYS'=$$SY S^HMPUTILS D PUT^XPA R("SYS","H MP SYSTEM NAME",1,$$ SYS^HMPUTI LS) ;ASF 1 2/19/15
	30519	"RTN","HMP P3I",91,0)
	30520	Q
	30521	"RTN","HMP P3I",92,0)
	30522	;
	30523	"RTN","HMP P3I",93,0)
	30524	OBJCNT ; - - create c ount index for HMP O BJECT file
	30525	"RTN","HMP P3I",94,0)
	30526	Q:$D(^HMP (800000.11 ,"ACNT"))
	30527	"RTN","HMP P3I",95,0)
	30528	N DIK,DA
	30529	"RTN","HMP P3I",96,0)
	30530	S DIK="^H MP(800000. 11,"
	30531	"RTN","HMP P3I",97,0)
	30532	S DIK(1)= ".03^ACNT"
	30533	"RTN","HMP P3I",98,0)
	30534	D ENALL^D IK
	30535	"RTN","HMP P3I",99,0)
	30536	Q
	30537	"RTN","HMP P3I",100,0 )
	30538	CREATEUS ;
	30539	"RTN","HMP P3I",101,0 )
	30540	N DIV,FDA ,IC,IEN,IE NS,NAME,SE R,HMPERR
	30541	"RTN","HMP P3I",102,0 )
	30542	;do not c reate the user if th e patch is already i nstalled o r if the u ser is alr eady creat ed
	30543	"RTN","HMP P3I",103,0 )
	30544	I $$PATCH ^XPDUTL("H MP1.03") Q
	30545	"RTN","HMP P3I",104,0 )
	30546	D EN^DDIO L("Creatin g HMP Sync User")
	30547	"RTN","HMP P3I",105,0 )
	30548	;
	30549	"RTN","HMP P3I",106,0 )
	30550	S NAME="H MP,USER SY NC"
	30551	"RTN","HMP P3I",107,0 )
	30552	S IEN=$$C REATE^XUSA P(NAME,"", "HMP SYNCH RONIZATION CONTEXT")
	30553	"RTN","HMP P3I",108,0 )
	30554	I IEN=0 D EN^DDIOL( "User alre ady exists ") Q
	30555	"RTN","HMP P3I",109,0 )
	30556	I IEN<0 D EN^DDIOL( "Cannot cr eate user" ) Q
	30557	"RTN","HMP P3I",110,0 )
	30558	S IENS="? "_IEN_","
	30559	"RTN","HMP P3I",111,0 )
	30560	S DIV=$$A SK(4) I DI V'>0 D EN^ DDIOL("A d ivision ne eds to be selected." ) Q
	30561	"RTN","HMP P3I",112,0 )
	30562	S SER=$$A SK(49) I S ER'>0 D EN ^DDIOL("A service ne eds to be selected." ) Q
	30563	"RTN","HMP P3I",113,0 )
	30564	S FDA(200 ,IENS,.01) =NAME
	30565	"RTN","HMP P3I",114,0 )
	30566	S FDA(200 ,IENS,7.2) =1
	30567	"RTN","HMP P3I",115,0 )
	30568	S FDA(200 ,IENS,29)= $P(SER,U)
	30569	"RTN","HMP P3I",116,0 )
	30570	S FDA(200 ,IENS,200. 04)=1
	30571	"RTN","HMP P3I",117,0 )
	30572	S FDA(200 ,IENS,200. 1)=99999
	30573	"RTN","HMP P3I",118,0 )
	30574	;S FDA(20 0.03,"?+2, "_IENS,.01 )="HMP SYN CHRONIZATI ON CONTEXT "
	30575	"RTN","HMP P3I",119,0 )
	30576	;S FDA(20 0.03,"?+3, "_IENS,.01 )="HMP UI CONTEXT"
	30577	"RTN","HMP P3I",120,0 )
	30578	S FDA(200 .02,"?+4," _IENS,.01) =$P(DIV,U)
	30579	"RTN","HMP P3I",121,0 )
	30580	S FDA(200 .02,"?+4," _IENS,1)=1
	30581	"RTN","HMP P3I",122,0 )
	30582	D UPDATE^ DIE("","FD A","","HMP ERR")
	30583	"RTN","HMP P3I",123,0 )
	30584	I $D(HMPE RR) D Q
	30585	"RTN","HMP P3I",124,0 )
	30586	.D EN^DDI OL("Update failed, U PDATE^DIE returned t he followi ng error m essage.")
	30587	"RTN","HMP P3I",125,0 )
	30588	.S IC="HM PERR"
	30589	"RTN","HMP P3I",126,0 )
	30590	.F S IC= $Q(@IC) Q: IC="" W ! ,IC,"=",@I C
	30591	"RTN","HMP P3I",127,0 )
	30592	.D EN^DDI OL("Examin e the abov e error me ssage for the reason .")
	30593	"RTN","HMP P3I",128,0 )
	30594	.H 2
	30595	"RTN","HMP P3I",129,0 )
	30596	D EN^DDIO L("Add ACC ESS/VERIFY codes to the "_NAME )
	30597	"RTN","HMP P3I",130,0 )
	30598	Q
	30599	"RTN","HMP P3I",131,0 )
	30600	;
	30601	"RTN","HMP P3I",132,0 )
	30602	ASK(FILENU M) ;
	30603	"RTN","HMP P3I",133,0 )
	30604	N DIC,Y
	30605	"RTN","HMP P3I",134,0 )
	30606	S DIC=FIL ENUM,DIC(0 )="AEQMZ", DIC("A")=" Select "_$ S(FILENUM= 4:"divisio n: ",1:"se rvice/sect ion: ")
	30607	"RTN","HMP P3I",135,0 )
	30608	I FILENUM =4 S DIC(" S")="S DIN UM=X K:$S( $D(^XUSEC( ""XUMGR"", DUZ)):0,'$ $TF^XUAF4( X):1,1:0) X,DINUM"
	30609	"RTN","HMP P3I",136,0 )
	30610	D ^DIC
	30611	"RTN","HMP P3I",137,0 )
	30612	Q Y
	30613	"RTN","HMP P3I",138,0 )
	30614	;
	30615	"RTN","HMP P3I",139,0 )
	30616	TASKCONV ;
	30617	"RTN","HMP P3I",140,0 )
	30618	N COLL,I, IEN,NODE,P AT,TEMP,UI D,UPDATE,H MPY
	30619	"RTN","HMP P3I",141,0 )
	30620	K ^TMP($J ,"HMPY"),^ TMP($J,"HM PTEMP")
	30621	"RTN","HMP P3I",142,0 )
	30622	S HMPY=$N A(^TMP($J, "HMPY")),T EMP=$NA(^T MP($J,"HMP TEMP"))
	30623	"RTN","HMP P3I",143,0 )
	30624	S PAT=0 F S PAT=$O (^HMP(8000 00.1,"C",P AT)) Q:PAT '>0 D
	30625	"RTN","HMP P3I",144,0 )
	30626	.S IEN=0 F S IEN=$ O(^HMP(800 000.1,"C", PAT,"task" ,IEN)) Q:I EN'>0 D
	30627	"RTN","HMP P3I",145,0 )
	30628	..S NODE= $G(^HMP(80 0000.1,IEN ,0))
	30629	"RTN","HMP P3I",146,0 )
	30630	..S UID=$ P(NODE,U) I UID="" Q
	30631	"RTN","HMP P3I",147,0 )
	30632	..S UPDAT E=0
	30633	"RTN","HMP P3I",148,0 )
	30634	..S I=0 F S I=$O(^ HMP(800000 .1,IEN,1,I )) Q:I<1 S X=$G(^(I ,0)),HMPY( I)=X
	30635	"RTN","HMP P3I",149,0 )
	30636	..D DECOD E^HMPJSON( "HMPY","TE MP","ERROR ")
	30637	"RTN","HMP P3I",150,0 )
	30638	..I $D(ER ROR) D EN^ DDIOL("Err or in deco ding JSON Object") Q
	30639	"RTN","HMP P3I",151,0 )
	30640	..K HMPY, ^TMP($J,"H MPY")
	30641	"RTN","HMP P3I",152,0 )
	30642	..I $G(@T EMP@("assi gnToCode") )'="" S @T EMP@("crea tedByCode" )=@TEMP@(" assignToCo de"),UPDAT E=1 K @TEM P@("assign ToCode")
	30643	"RTN","HMP P3I",153,0 )
	30644	..I $G(@T EMP@("assi gnToName") )'="" S @T EMP@("crea tedByName" )=@TEMP@(" assignToNa me"),UPDAT E=1 K @TEM P@("assign ToName")
	30645	"RTN","HMP P3I",154,0 )
	30646	..I $G(@T EMP@("owne rName"))'= "" S UPDAT E=1 K @TEM P@("ownerN ame")
	30647	"RTN","HMP P3I",155,0 )
	30648	..I $G(@T EMP@("owne rCode"))'= "" S UPDAT E=1 K @TEM P@("ownerC ode")
	30649	"RTN","HMP P3I",156,0 )
	30650	..I UPDAT E=0 Q
	30651	"RTN","HMP P3I",157,0 )
	30652	..;
	30653	"RTN","HMP P3I",158,0 )
	30654	..S HMPY= $NA(^TMP($ J,"HMPY"))
	30655	"RTN","HMP P3I",159,0 )
	30656	..D ENCOD E^HMPJSON( "TEMP","HM PY","ERROR ")
	30657	"RTN","HMP P3I",160,0 )
	30658	..I $D(ER ROR) D EN^ DDIOL("Err or in enco ding JSON Object") Q
	30659	"RTN","HMP P3I",161,0 )
	30660	..D EN^DD IOL("Updat ing task u id: "_UID)
	30661	"RTN","HMP P3I",162,0 )
	30662	..D PUT^H MPDJ1(.HMP ,PAT,"task ",.HMPY)
	30663	"RTN","HMP P3I",163,0 )
	30664	K ^TMP($J ,"HMPY"),^ TMP($J,"HM PTEMP")
	30665	"RTN","HMP P3I",164,0 )
	30666	Q
	30667	"RTN","HMP P3I",165,0 )
	30668	ADDRSRC ; Add resour ce device
	30669	"RTN","HMP P3I",166,0 )
	30670	N RNAME,R DESC,RSLOT ,RTYPE,RIE N
	30671	"RTN","HMP P3I",167,0 )
	30672	S RNAME=" HMP EXTRAC T RESOURCE "
	30673	"RTN","HMP P3I",168,0 )
	30674	S RDESC=" Controls t he number of HMP ext ract jobs that run s imultaneou sly."
	30675	"RTN","HMP P3I",169,0 )
	30676	S RSLOT=1 0
	30677	"RTN","HMP P3I",170,0 )
	30678	S RTYPE=" P-OTHER"
	30679	"RTN","HMP P3I",171,0 )
	30680	S RIEN=$$ RES^XUDHSE T(RNAME,RN AME,RSLOT, RDESC,RTYP E)
	30681	"RTN","HMP P3I",172,0 )
	30682	Q
	30683	"RTN","HMP P3I",173,0 )
	30684	CVTPAT ; r esend all the patien t objects
	30685	"RTN","HMP P3I",174,0 )
	30686	D BMES^XP DUTL("Upda ting HMP p atient obj ects")
	30687	"RTN","HMP P3I",175,0 )
	30688	N HMPIEN, DFN,CNT
	30689	"RTN","HMP P3I",176,0 )
	30690	K ^TMP("H MPCVT",$J)
	30691	"RTN","HMP P3I",177,0 )
	30692	S CNT=0
	30693	"RTN","HMP P3I",178,0 )
	30694	S HMPIEN= 0 F S HMP IEN=$O(^HM P(800000,H MPIEN)) Q: 'HMPIEN D
	30695	"RTN","HMP P3I",179,0 )
	30696	. S DFN=0 F S DFN= $O(^HMP(80 0000,HMPIE N,1,DFN)) Q:'DFN D
	30697	"RTN","HMP P3I",180,0 )
	30698	. . Q:$D( ^TMP("HMPC VT",$J,DFN ))
	30699	"RTN","HMP P3I",181,0 )
	30700	. . D POS T^HMPDJFS( DFN,"patie nt",DFN,"" ,"")
	30701	"RTN","HMP P3I",182,0 )
	30702	. . S ^TM P("HMPCVT" ,$J,DFN)=" "
	30703	"RTN","HMP P3I",183,0 )
	30704	. . S CNT =CNT+1 I ' (CNT#1000) D MES^XPD UTL(" "_C NT_" patie nt objects converted ")
	30705	"RTN","HMP P3I",184,0 )
	30706	K ^TMP("H MPCVT",$J)
	30707	"RTN","HMP P3I",185,0 )
	30708	Q
	30709	"RTN","HMP P3I",186,0 )
	30710	CVTSEL ; r esend all patient se lection ob jects
	30711	"RTN","HMP P3I",187,0 )
	30712	N HMPIEN
	30713	"RTN","HMP P3I",188,0 )
	30714	D BMES^XP DUTL("Upda ting patie nt select objects")
	30715	"RTN","HMP P3I",189,0 )
	30716	S HMPIEN= 0 F S HMP IEN=$O(^HM P(800000,H MPIEN)) Q: 'HMPIEN D
	30717	"RTN","HMP P3I",190,0 )
	30718	. Q:$P(^H MP(800000, HMPIEN,0), U,3)'=2 ; operation al sync no t complete d
	30719	"RTN","HMP P3I",191,0 )
	30720	. N HMPSR V,BATCH,DO MAINS,HMPF ERR
	30721	"RTN","HMP P3I",192,0 )
	30722	. S HMPSR V=$P(^HMP( 800000,HMP IEN,0),U)
	30723	"RTN","HMP P3I",193,0 )
	30724	. S BATCH ="HMPFX~"_ HMPSRV_"~O PD"
	30725	"RTN","HMP P3I",194,0 )
	30726	. S DOMAI NS(1)="pt- select"
	30727	"RTN","HMP P3I",195,0 )
	30728	. D QUINI T^HMPDJFSP (BATCH,"OP D",.DOMAIN S)
	30729	"RTN","HMP P3I",196,0 )
	30730	. I $D(HM PFERR) D M ES^XPDUTL( "Error tas king pt-se lect objec ts for ser ver "_HMPS RV)
	30731	"RTN","HMP P3I",197,0 )
	30732	Q
	30733	"RTN","HMP P3I",198,0 )
	30734	PARPID ; L oop thru H MP PARAMET ERS and sw itch ICN t o qualifie d DFN
	30735	"RTN","HMP P3I",199,0 )
	30736	N PAR,ENT ,UID,HMPWP ,HMPERR,I, HMPSYS
	30737	"RTN","HMP P3I",200,0 )
	30738	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	30739	"RTN","HMP P3I",201,0 )
	30740	S PAR=$O( ^XTV(8989. 51,"B","HM P PARAMETE RS","")) Q :PAR'>0
	30741	"RTN","HMP P3I",202,0 )
	30742	S ENT="" F S ENT=$ O(^XTV(898 9.5,"AC",P AR,ENT)) Q :ENT="" D
	30743	"RTN","HMP P3I",203,0 )
	30744	. S UID=" " F S UID =$O(^XTV(8 989.5,"AC" ,PAR,ENT,U ID)) Q:UID ="" D ;I NST=UID
	30745	"RTN","HMP P3I",204,0 )
	30746	. . I $P( UID,":",6, 7)'="HMP U SER PREF:0 " Q
	30747	"RTN","HMP P3I",205,0 )
	30748	. . N HMP WP,HMPERR, JSON,OBJ,E RR,DFN,RSL T
	30749	"RTN","HMP P3I",206,0 )
	30750	. . D GET WP^XPAR(.H MPWP,ENT,P AR,UID,.HM PERR)
	30751	"RTN","HMP P3I",207,0 )
	30752	. . I +HM PERR D WRE RR(UID,$P( HMPERR,U,2 ,99)) Q
	30753	"RTN","HMP P3I",208,0 )
	30754	. . I $D( HMPWP)<10 Q ; no JSON foun d
	30755	"RTN","HMP P3I",209,0 )
	30756	. . S I=0 F S I=$O (HMPWP(I)) Q:'I S J SON(I)=HMP WP(I,0)
	30757	"RTN","HMP P3I",210,0 )
	30758	. . D DEC ODE^HMPJSO N("JSON"," OBJ","ERR" )
	30759	"RTN","HMP P3I",211,0 )
	30760	. . I $D( ERR) D WRE RR(UID,"Er ror decodi ng JSON") Q
	30761	"RTN","HMP P3I",212,0 )
	30762	. . I '$L ($G(OBJ("c pe.context .patient") )) Q ; no thing ther e
	30763	"RTN","HMP P3I",213,0 )
	30764	. . I OBJ ("cpe.cont ext.patien t")[";" Q ; al ready DFN
	30765	"RTN","HMP P3I",214,0 )
	30766	. . S DFN =$$GETDFN^ MPIF001(OB J("cpe.con text.patie nt"))
	30767	"RTN","HMP P3I",215,0 )
	30768	. . I DFN <1 D WRERR (UID,"Erro r converti ng ICN: "_ $P(DFN,U,2 )) Q
	30769	"RTN","HMP P3I",216,0 )
	30770	. . S OBJ ("cpe.cont ext.patien t")=HMPSYS _";"_DFN
	30771	"RTN","HMP P3I",217,0 )
	30772	. . K JSO N
	30773	"RTN","HMP P3I",218,0 )
	30774	. . D ENC ODE^HMPJSO N("OBJ","J SON","ERR" )
	30775	"RTN","HMP P3I",219,0 )
	30776	. . I $D( ERR) D WRE RR(UID,"Er ror encodi ng JSON") Q
	30777	"RTN","HMP P3I",220,0 )
	30778	. . D PUT BYUID^HMPP ARAM(.RSLT ,UID,.JSON )
	30779	"RTN","HMP P3I",221,0 )
	30780	Q
	30781	"RTN","HMP P3I",222,0 )
	30782	WRERR(UID, MSG) ; Wri te out err or (from p ost-init i n KIDS bui ld)
	30783	"RTN","HMP P3I",223,0 )
	30784	D MES^XPD UTL("Error : "_MSG_" for UID "_ UID)
	30785	"RTN","HMP P3I",224,0 )
	30786	Q
	30787	"RTN","HMP P3I",225,0 )
	30788	;
	30789	"RTN","HMP P3I",226,0 )
	30790	SETPARMS ; -- set va rious XPAR parameter values US7724
	30791	"RTN","HMP P3I",227,0 )
	30792	;
	30793	"RTN","HMP P3I",228,0 )
	30794	; -- add/ edit lates t domain o bject aver age size i n bytes
	30795	"RTN","HMP P3I",229,0 )
	30796	D BMES^XP DUTL(" Add ing domain object av erage size s to HMP D OMAIN SIZE S paramete r...")
	30797	"RTN","HMP P3I",230,0 )
	30798	D PTADD
	30799	"RTN","HMP P3I",231,0 )
	30800	D ODCADD
	30801	"RTN","HMP P3I",232,0 )
	30802	;
	30803	"RTN","HMP P3I",233,0 )
	30804	; -- set to 100 meg abytes if not curren tly define d
	30805	"RTN","HMP P3I",234,0 )
	30806	I $$GET^X PAR("SYS", "HMP EXTRA CT DISK SI ZE LIMIT", 1,"Q")="" D
	30807	"RTN","HMP P3I",235,0 )
	30808	. D EN^XP AR("SYS"," HMP EXTRAC T DISK SIZ E LIMIT",1 ,100)
	30809	"RTN","HMP P3I",236,0 )
	30810	;
	30811	"RTN","HMP P3I",237,0 )
	30812	; -- set to 10 seco nds if not currently defined
	30813	"RTN","HMP P3I",238,0 )
	30814	I $$GET^X PAR("SYS", "HMP EXTRA CT TASK RE QUEUE SECS ",1,"Q")=" " D
	30815	"RTN","HMP P3I",239,0 )
	30816	. D EN^XP AR("SYS"," HMP EXTRAC T TASK REQ UEUE SECS" ,1,10)
	30817	"RTN","HMP P3I",240,0 )
	30818	Q
	30819	"RTN","HMP P3I",241,0 )
	30820	;
	30821	"RTN","HMP P3I",242,0 )
	30822	PTADD ; -- add patie nt domain average si zes
	30823	"RTN","HMP P3I",243,0 )
	30824	N I,X,DOM AIN,SIZE,E RR
	30825	"RTN","HMP P3I",244,0 )
	30826	S I=0 F S I=I+1,X= $P($T(PTDO M+I),";;", 2) Q:X="zz zzz" D
	30827	"RTN","HMP P3I",245,0 )
	30828	. S DOMAI N=$P(X,";" ,1),SIZE=$ P(X,";",2)
	30829	"RTN","HMP P3I",246,0 )
	30830	. D PUT^X PAR("PKG", "HMP DOMAI N SIZES",D OMAIN,SIZE ,.ERR)
	30831	"RTN","HMP P3I",247,0 )
	30832	. I $G(ER R) D BMES^ XPDUTL("Er ror: "_ERR )
	30833	"RTN","HMP P3I",248,0 )
	30834	D MES^XPD UTL(" o patient d omain size s added")
	30835	"RTN","HMP P3I",249,0 )
	30836	Q
	30837	"RTN","HMP P3I",250,0 )
	30838	;
	30839	"RTN","HMP P3I",251,0 )
	30840	ODCADD ; - - add OPD domain ave rage sizes
	30841	"RTN","HMP P3I",252,0 )
	30842	N I,X,DOM AIN,SIZE,E RR
	30843	"RTN","HMP P3I",253,0 )
	30844	S I=0 F S I=I+1,X= $P($T(ODCD OM+I),";;" ,2) Q:X="z zzzz" D
	30845	"RTN","HMP P3I",254,0 )
	30846	. S DOMAI N=$P(X,";" ,1),SIZE=$ P(X,";",2)
	30847	"RTN","HMP P3I",255,0 )
	30848	. D PUT^X PAR("PKG", "HMP DOMAI N SIZES",D OMAIN,SIZE ,.ERR)
	30849	"RTN","HMP P3I",256,0 )
	30850	. I $G(ER R) D BMES^ XPDUTL("Er ror: "_ERR )
	30851	"RTN","HMP P3I",257,0 )
	30852	D MES^XPD UTL(" o operation al domain sizes adde d")
	30853	"RTN","HMP P3I",258,0 )
	30854	Q
	30855	"RTN","HMP P3I",259,0 )
	30856	;
	30857	"RTN","HMP P3I",260,0 )
	30858	MENUADD ; BL;Post pr ocessor to add optio n HMP XU E VENTS to O ption XU U SER ADD
	30859	"RTN","HMP P3I",261,0 )
	30860	N XUMENU, HMPMENU,FD A,QFLG,X
	30861	"RTN","HMP P3I",262,0 )
	30862	;Get IEN of XU USER ADD
	30863	"RTN","HMP P3I",263,0 )
	30864	S XUMENU= "",XUMENU= $O(^DIC(19 ,"B","XU U SER ADD",X UMENU))
	30865	"RTN","HMP P3I",264,0 )
	30866	Q:XUMENU= ""
	30867	"RTN","HMP P3I",265,0 )
	30868	;Get IEN of HMP XU EVENTS
	30869	"RTN","HMP P3I",266,0 )
	30870	S HMPMENU ="",HMPMEN U=$O(^DIC( 19,"B","HM P XU EVENT S",HMPMENU ))
	30871	"RTN","HMP P3I",267,0 )
	30872	Q:HMPMENU =""
	30873	"RTN","HMP P3I",268,0 )
	30874	;Check if already i nstalled
	30875	"RTN","HMP P3I",269,0 )
	30876	S X=0,QFL G=0
	30877	"RTN","HMP P3I",270,0 )
	30878	F S X=$O (^DIC(19,X UMENU,10,X )) Q:X'=+X D
	30879	"RTN","HMP P3I",271,0 )
	30880	. I $P(^D IC(19,XUME NU,10,X,0) ,"^",1)=HM PMENU S QF LG=1
	30881	"RTN","HMP P3I",272,0 )
	30882	Q:QFLG ; If HMPMENU found sil ently quit
	30883	"RTN","HMP P3I",273,0 )
	30884	;Now inse rt new men u item HMP MENU, into
	30885	"RTN","HMP P3I",274,0 )
	30886	; file 19 .01 field .01
	30887	"RTN","HMP P3I",275,0 )
	30888	S FDA(1,1 9.01,"+1," _XUMENU_", ",.01)=HMP MENU
	30889	"RTN","HMP P3I",276,0 )
	30890	D UPDATE^ DIE("","FD A(1)",""," HMPERR")
	30891	"RTN","HMP P3I",277,0 )
	30892	I $D(HMPE RR) D Q
	30893	"RTN","HMP P3I",278,0 )
	30894	.D EN^DDI OL("XU USE R ADD menu not updat ed, UPDATE ^DIE retur ned the fo llowing er ror messag e.")
	30895	"RTN","HMP P3I",279,0 )
	30896	.S IC="HM PERR"
	30897	"RTN","HMP P3I",280,0 )
	30898	.F S IC= $Q(@IC) Q: IC="" W ! ,IC,"=",@I C
	30899	"RTN","HMP P3I",281,0 )
	30900	.D EN^DDI OL("Examin e the abov e error me ssage for the reason .") Q
	30901	"RTN","HMP P3I",282,0 )
	30902	;
	30903	"RTN","HMP P3I",283,0 )
	30904	PTDOM ; pa tient doma ins
	30905	"RTN","HMP P3I",284,0 )
	30906	;;allergy ;690
	30907	"RTN","HMP P3I",285,0 )
	30908	;;appoint ment;742
	30909	"RTN","HMP P3I",286,0 )
	30910	;;auxilia ry;749
	30911	"RTN","HMP P3I",287,0 )
	30912	;;consult ;545
	30913	"RTN","HMP P3I",288,0 )
	30914	;;cpt;487
	30915	"RTN","HMP P3I",289,0 )
	30916	;;diagnos is;331
	30917	"RTN","HMP P3I",290,0 )
	30918	;;documen t;3993
	30919	"RTN","HMP P3I",291,0 )
	30920	;;educati on;415
	30921	"RTN","HMP P3I",292,0 )
	30922	;;exam;33 8
	30923	"RTN","HMP P3I",293,0 )
	30924	;;factor; 550
	30925	"RTN","HMP P3I",294,0 )
	30926	;;image;1 038
	30927	"RTN","HMP P3I",295,0 )
	30928	;;immuniz ation;550
	30929	"RTN","HMP P3I",296,0 )
	30930	;;lab;123 1
	30931	"RTN","HMP P3I",297,0 )
	30932	;;med;534 0
	30933	"RTN","HMP P3I",298,0 )
	30934	;;mh;4827
	30935	"RTN","HMP P3I",299,0 )
	30936	;;obs;754
	30937	"RTN","HMP P3I",300,0 )
	30938	;;order;9 99
	30939	"RTN","HMP P3I",301,0 )
	30940	;;patient ;3294
	30941	"RTN","HMP P3I",302,0 )
	30942	;;pov;450
	30943	"RTN","HMP P3I",303,0 )
	30944	;;problem ;756
	30945	"RTN","HMP P3I",304,0 )
	30946	;;procedu re;278
	30947	"RTN","HMP P3I",305,0 )
	30948	;;ptf;397
	30949	"RTN","HMP P3I",306,0 )
	30950	;;roadtri p;370
	30951	"RTN","HMP P3I",307,0 )
	30952	;;skin;38 8
	30953	"RTN","HMP P3I",308,0 )
	30954	;;surgery ;852
	30955	"RTN","HMP P3I",309,0 )
	30956	;;task;40 1
	30957	"RTN","HMP P3I",310,0 )
	30958	;;treatme nt;1071
	30959	"RTN","HMP P3I",311,0 )
	30960	;;visit;9 11
	30961	"RTN","HMP P3I",312,0 )
	30962	;;vital;4 62
	30963	"RTN","HMP P3I",313,0 )
	30964	;;zzzzz
	30965	"RTN","HMP P3I",314,0 )
	30966	;
	30967	"RTN","HMP P3I",315,0 )
	30968	ODCDOM ; o perational domains
	30969	"RTN","HMP P3I",316,0 )
	30970	;;asu-cla ss;226
	30971	"RTN","HMP P3I",317,0 )
	30972	;;asu-rul e;509
	30973	"RTN","HMP P3I",318,0 )
	30974	;;categor y;117
	30975	"RTN","HMP P3I",319,0 )
	30976	;;chartta b;991
	30977	"RTN","HMP P3I",320,0 )
	30978	;;doc-def ;381
	30979	"RTN","HMP P3I",321,0 )
	30980	;;labgrou p;737
	30981	"RTN","HMP P3I",322,0 )
	30982	;;labpane l;267
	30983	"RTN","HMP P3I",323,0 )
	30984	;;locatio n;278
	30985	"RTN","HMP P3I",324,0 )
	30986	;;orderab le;773
	30987	"RTN","HMP P3I",325,0 )
	30988	;;page;90 1
	30989	"RTN","HMP P3I",326,0 )
	30990	;;personp hoto;15445
	30991	"RTN","HMP P3I",327,0 )
	30992	;;pointof care;241
	30993	"RTN","HMP P3I",328,0 )
	30994	;;pt-sele ct;419
	30995	"RTN","HMP P3I",329,0 )
	30996	;;qo;97
	30997	"RTN","HMP P3I",330,0 )
	30998	;;roster; 3862
	30999	"RTN","HMP P3I",331,0 )
	31000	;;route;1 57
	31001	"RTN","HMP P3I",332,0 )
	31002	;;schedul e;116
	31003	"RTN","HMP P3I",333,0 )
	31004	;;syncerr or;18323
	31005	"RTN","HMP P3I",334,0 )
	31006	;;syncsta tus;1207
	31007	"RTN","HMP P3I",335,0 )
	31008	;;team;81 2
	31009	"RTN","HMP P3I",336,0 )
	31010	;;teampos ition;533
	31011	"RTN","HMP P3I",337,0 )
	31012	;;user;63 9
	31013	"RTN","HMP P3I",338,0 )
	31014	;;usertab prefs;3029
	31015	"RTN","HMP P3I",339,0 )
	31016	;;viewdef def;5742
	31017	"RTN","HMP P3I",340,0 )
	31018	;;viewdef defcoldefc onfigtempl ate;440
	31019	"RTN","HMP P3I",341,0 )
	31020	;;HMPupda te;128
	31021	"RTN","HMP P3I",342,0 )
	31022	;;zzzzz
	31023	"RTN","HMP PANEL")
	31024	1^179
	31025	"RTN","HMP PARAM")
	31026	0^106^B165 41840
	31027	"RTN","HMP PARAM",1,0 )
	31028	HMPPARAM ; SLC/AGP,AS MR/RRB - P arameter r outine. ; 8/16/12 7: 09pm
	31029	"RTN","HMP PARAM",2,0 )
	31030	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	31031	"RTN","HMP PARAM",3,0 )
	31032	;Per VA D irective 6 402, this routine sh ould not b e modified .
	31033	"RTN","HMP PARAM",4,0 )
	31034	;
	31035	"RTN","HMP PARAM",5,0 )
	31036	; DE2818 - SQA find ings. Newe d HMPAR in GETPARAM +1. RRB - 10/27/201 5
	31037	"RTN","HMP PARAM",6,0 )
	31038	; Externa l Referenc es DBIA#
	31039	"RTN","HMP PARAM",7,0 )
	31040	; ------- ---------- -- -----
	31041	"RTN","HMP PARAM",8,0 )
	31042	; ^XTV(89 89.51 2992
	31043	"RTN","HMP PARAM",9,0 )
	31044	;
	31045	"RTN","HMP PARAM",10, 0)
	31046	Q
	31047	"RTN","HMP PARAM",11, 0)
	31048	;
	31049	"RTN","HMP PARAM",12, 0)
	31050	BLDENT(UID ,ENTITY) ;
	31051	"RTN","HMP PARAM",13, 0)
	31052	;urn:va:p aram:F484: 1120:HMP U SER PREF
	31053	"RTN","HMP PARAM",14, 0)
	31054	;urn:va:p aram:F484: 1120:HMP R OSTER PREF :13
	31055	"RTN","HMP PARAM",15, 0)
	31056	;urn:va:p aram:F484: SYS:HMP US ER PREF
	31057	"RTN","HMP PARAM",16, 0)
	31058	S ENTITY( "uid")=UID
	31059	"RTN","HMP PARAM",17, 0)
	31060	I +$P(UID ,":",5)>0 D Q
	31061	"RTN","HMP PARAM",18, 0)
	31062	.S ENTITY ("entity") ="USR"
	31063	"RTN","HMP PARAM",19, 0)
	31064	.S ENTITY ("entityId ")=$P(UID, ":",5)
	31065	"RTN","HMP PARAM",20, 0)
	31066	S ENTITY( "entity")= "SYS"
	31067	"RTN","HMP PARAM",21, 0)
	31068	Q
	31069	"RTN","HMP PARAM",22, 0)
	31070	;
	31071	"RTN","HMP PARAM",23, 0)
	31072	BUILDUID(V ALUES,TYPE ,ID) ;
	31073	"RTN","HMP PARAM",24, 0)
	31074	N DOMAIN
	31075	"RTN","HMP PARAM",25, 0)
	31076	S DOMAIN= $$BASE^XLF UTL($$CRC1 6^XLFCRC($ $KSP^XUPAR AM("WHERE" )),10,16)
	31077	"RTN","HMP PARAM",26, 0)
	31078	S VALUES( "uid")="ur n:va:"_TYP E_":"_DOMA IN_":"_ID
	31079	"RTN","HMP PARAM",27, 0)
	31080	Q
	31081	"RTN","HMP PARAM",28, 0)
	31082	;
	31083	"RTN","HMP PARAM",29, 0)
	31084	DELPARAM(R ESULT,UID) ;
	31085	"RTN","HMP PARAM",30, 0)
	31086	N ARRAY,E NT,ENTITY, ENTVALUE,E RR,STR,HMP ERR
	31087	"RTN","HMP PARAM",31, 0)
	31088	D BLDENT( UID,.ARRAY )
	31089	"RTN","HMP PARAM",32, 0)
	31090	;delete o ld paramet er
	31091	"RTN","HMP PARAM",33, 0)
	31092	S ENTITY= ARRAY("ent ity")
	31093	"RTN","HMP PARAM",34, 0)
	31094	S ENTVALU E=ARRAY("e ntityId")
	31095	"RTN","HMP PARAM",35, 0)
	31096	S ENT=$S( $G(ENTVALU E)>0:ENTIT Y_".`"_ENT VALUE,1:EN TITY)
	31097	"RTN","HMP PARAM",36, 0)
	31098	I $G(ARRA Y("uid"))= "" Q
	31099	"RTN","HMP PARAM",37, 0)
	31100	I $G(ENT) ="" Q
	31101	"RTN","HMP PARAM",38, 0)
	31102	D DEL^XPA R(ENT,"HMP PARAMETER S",ARRAY(" uid"),.HMP ERR)
	31103	"RTN","HMP PARAM",39, 0)
	31104	Q
	31105	"RTN","HMP PARAM",40, 0)
	31106	;
	31107	"RTN","HMP PARAM",41, 0)
	31108	GETALPAR(J SONRES,ENT ITY,ENTVAL UE,RETVALU E) ;
	31109	"RTN","HMP PARAM",42, 0)
	31110	N CNT,DEC ODE,ENT,GE TVAL,INST, PARAM,RESU LT,HMPERR, HMPLIST
	31111	"RTN","HMP PARAM",43, 0)
	31112	S ENT=$S( $G(ENTVALU E)'="":ENT ITY_".`"_E NTVALUE,1: ENTITY)
	31113	"RTN","HMP PARAM",44, 0)
	31114	D GETLST^ XPAR(.HMPL IST,ENT,"H MP PARAMET ERS","I")
	31115	"RTN","HMP PARAM",45, 0)
	31116	I HMPLIST =0 Q
	31117	"RTN","HMP PARAM",46, 0)
	31118	S GETVAL= $S(RETVALU E="true":1 ,1:0)
	31119	"RTN","HMP PARAM",47, 0)
	31120	I GETVAL= 0 D Q
	31121	"RTN","HMP PARAM",48, 0)
	31122	.S CNT=0, INST="" F S INST=$O (HMPLIST(I NST)) Q:IN ST="" S J SONRES(CNT )=INST,CNT =CNT+1
	31123	"RTN","HMP PARAM",49, 0)
	31124	S CNT=0,I NST="" F S INST=$O( HMPLIST(IN ST)) Q:INS T="" D
	31125	"RTN","HMP PARAM",50, 0)
	31126	.S CNT=CN T+1
	31127	"RTN","HMP PARAM",51, 0)
	31128	.S RESULT ("params", CNT,"uid") =INST
	31129	"RTN","HMP PARAM",52, 0)
	31130	.D GETPAR AM(.PARAM, "HMP PARAM ETERS",ENT ITY,ENTVAL UE,INST)
	31131	"RTN","HMP PARAM",53, 0)
	31132	.I '$D(PA RAM) Q
	31133	"RTN","HMP PARAM",54, 0)
	31134	.M RESULT ("params", CNT,"value ",":")=PAR AM
	31135	"RTN","HMP PARAM",55, 0)
	31136	.K PARAM
	31137	"RTN","HMP PARAM",56, 0)
	31138	I '$D(RES ULT) Q ""
	31139	"RTN","HMP PARAM",57, 0)
	31140	S RESULT( "success") ="true"
	31141	"RTN","HMP PARAM",58, 0)
	31142	D ENCODE^ HMPJSON("R ESULT","JS ONRES","HM PERR")
	31143	"RTN","HMP PARAM",59, 0)
	31144	I $D(HMPE RR) K JSON RES S TXT( 1)="Proble m encoding results t o json for mat." D SE TERROR(.RE SULT,.HMPE RR,.TXT,.J SONRES) Q
	31145	"RTN","HMP PARAM",60, 0)
	31146	Q
	31147	"RTN","HMP PARAM",61, 0)
	31148	;
	31149	"RTN","HMP PARAM",62, 0)
	31150	GETPARAM(R ESULT,NAME ,ENTITY,EN TVALUE,INS T) ; Get v alue for a param
	31151	"RTN","HMP PARAM",63, 0)
	31152	N CNT,ENT ,FORMAT,IE N,HMPAR,HM PPAR,HMPER R
	31153	"RTN","HMP PARAM",64, 0)
	31154	;S IEN=$O (^XTV(8989 .51,"B",NA ME,"")) Q: IEN'>0
	31155	"RTN","HMP PARAM",65, 0)
	31156	S FORMAT= "I"
	31157	"RTN","HMP PARAM",66, 0)
	31158	;D BLDLST ^XPAREDIT( .HMPPAR,IE N
	31159	"RTN","HMP PARAM",67, 0)
	31160	S ENT=$S( $G(ENTVALU E)'="":ENT ITY_".`"_E NTVALUE,1: ENTITY)
	31161	"RTN","HMP PARAM",68, 0)
	31162	D GETWP^X PAR(.HMPAR ,ENT,NAME, INST,.HMPE RR)
	31163	"RTN","HMP PARAM",69, 0)
	31164	S CNT=0 F S CNT=$O (HMPAR(CNT )) Q:CNT'> 0 D
	31165	"RTN","HMP PARAM",70, 0)
	31166	.S RESULT (CNT)=HMPA R(CNT,0)
	31167	"RTN","HMP PARAM",71, 0)
	31168	Q
	31169	"RTN","HMP PARAM",72, 0)
	31170	;
	31171	"RTN","HMP PARAM",73, 0)
	31172	GETBYUID(R ESULT,UID) ;
	31173	"RTN","HMP PARAM",74, 0)
	31174	N ENTITY
	31175	"RTN","HMP PARAM",75, 0)
	31176	D BLDENT( UID,.ENTIT Y)
	31177	"RTN","HMP PARAM",76, 0)
	31178	D GETPARA M(.RESULT, "HMP PARAM ETERS",$G( ENTITY("en tity")),$G (ENTITY("e ntityId")) ,$G(ENTITY ("uid")))
	31179	"RTN","HMP PARAM",77, 0)
	31180	;I $D(RES ULT)<10 S RESULT(0)= "{}"
	31181	"RTN","HMP PARAM",78, 0)
	31182	Q
	31183	"RTN","HMP PARAM",79, 0)
	31184	;
	31185	"RTN","HMP PARAM",80, 0)
	31186	PARSEJSN(V ALUE,ARRAY ,ERR) ;
	31187	"RTN","HMP PARAM",81, 0)
	31188	N ERROR,J SON,TXT
	31189	"RTN","HMP PARAM",82, 0)
	31190	D DECODE^ HMPJSON("V ALUE","ARR AY","ERROR ")
	31191	"RTN","HMP PARAM",83, 0)
	31192	I $D(ERR) K ARRAY S TXT(1)="P roblem dec oding json value." D SETERROR( .VALUE,.ER ROR,.TXT,. ERR) Q 0
	31193	"RTN","HMP PARAM",84, 0)
	31194	Q 1
	31195	"RTN","HMP PARAM",85, 0)
	31196	;
	31197	"RTN","HMP PARAM",86, 0)
	31198	PUTPARAM(R ESULT,VALU E,ENTARR) ;
	31199	"RTN","HMP PARAM",87, 0)
	31200	N CNT,ENT ,ENTITY,EN TVALUE,ERR ,STR,HMPER R,X
	31201	"RTN","HMP PARAM",88, 0)
	31202	I $D(ENTA RR)<10 I $ $PARSEJSN( .VALUE,.EN TARR,.ERR) =0 M RESUL T=ERR Q
	31203	"RTN","HMP PARAM",89, 0)
	31204	;delete o ld paramet er
	31205	"RTN","HMP PARAM",90, 0)
	31206	S ENTITY= ENTARR("en tity")
	31207	"RTN","HMP PARAM",91, 0)
	31208	S ENTVALU E=ENTARR(" entityId")
	31209	"RTN","HMP PARAM",92, 0)
	31210	S ENT=$S( $G(ENTVALU E)>0:ENTIT Y_".`"_ENT VALUE,1:EN TITY)
	31211	"RTN","HMP PARAM",93, 0)
	31212	D DEL^XPA R(ENT,"HMP PARAMETER S",ENTARR( "uid"),.HM PERR)
	31213	"RTN","HMP PARAM",94, 0)
	31214	S CNT=$O( VALUE(""), -1) I CNT= "" S STR(1 ,0)=VALUE
	31215	"RTN","HMP PARAM",95, 0)
	31216	I CNT>0 F X=0:1:CNT S STR(X+1 ,0)=VALUE( X)
	31217	"RTN","HMP PARAM",96, 0)
	31218	D PUT^XPA R(ENT,"HMP PARAMETER S",ENTARR( "uid"),.ST R,.HMPERR)
	31219	"RTN","HMP PARAM",97, 0)
	31220	S RESULT( 0)="{""suc cess"":""t rue""}"
	31221	"RTN","HMP PARAM",98, 0)
	31222	Q
	31223	"RTN","HMP PARAM",99, 0)
	31224	;
	31225	"RTN","HMP PARAM",100 ,0)
	31226	PUTBYUID(R ESULT,UID, VALUE) ;
	31227	"RTN","HMP PARAM",101 ,0)
	31228	N ENTITY
	31229	"RTN","HMP PARAM",102 ,0)
	31230	D BLDENT( UID,.ENTIT Y)
	31231	"RTN","HMP PARAM",103 ,0)
	31232	D PUTPARA M(.RESULT, .VALUE,.EN TITY)
	31233	"RTN","HMP PARAM",104 ,0)
	31234	Q
	31235	"RTN","HMP PARAM",105 ,0)
	31236	;
	31237	"RTN","HMP PARAM",106 ,0)
	31238	SETERROR(I NPDATA,ERR ORMSG,TXT, OUTPUT) ;
	31239	"RTN","HMP PARAM",107 ,0)
	31240	N ERRARR
	31241	"RTN","HMP PARAM",108 ,0)
	31242	D SETERRO R^HMPUTILS (.ERRARR,. ERRORMSG,. TXT,.INPDA TA)
	31243	"RTN","HMP PARAM",109 ,0)
	31244	D ENCODE^ HMPJSON("E RRARR","OU TPUT","ERR OR")
	31245	"RTN","HMP PARAM",110 ,0)
	31246	Q
	31247	"RTN","HMP PATS")
	31248	0^107^B311 6859
	31249	"RTN","HMP PATS",1,0)
	31250	HMPPATS ;S LC/MKB,ASM R/RRB,SRG - Patient Management Utilities ;Nov 16, 2015 19:11 :53
	31251	"RTN","HMP PATS",2,0)
	31252	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	31253	"RTN","HMP PATS",3,0)
	31254	;Per VA D irective 6 402, this routine sh ould not b e modified .
	31255	"RTN","HMP PATS",4,0)
	31256	;
	31257	"RTN","HMP PATS",5,0)
	31258	; Externa l Referenc es DBIA#
	31259	"RTN","HMP PATS",6,0)
	31260	; ------- ---------- -- -----
	31261	"RTN","HMP PATS",7,0)
	31262	; ^SC 10040
	31263	"RTN","HMP PATS",8,0)
	31264	; DICN 10009
	31265	"RTN","HMP PATS",9,0)
	31266	; SDAMA30 1 4433
	31267	"RTN","HMP PATS",10,0 )
	31268	; XLFDT 10103
	31269	"RTN","HMP PATS",11,0 )
	31270	; XPAR 2263
	31271	"RTN","HMP PATS",12,0 )
	31272	Q
	31273	"RTN","HMP PATS",13,0 )
	31274	;
	31275	"RTN","HMP PATS",14,0 )
	31276	APPT ; -- Return pat ients w/ap pointments tomorrow
	31277	"RTN","HMP PATS",15,0 )
	31278	; OPT = H MP APPOINT MENTS
	31279	"RTN","HMP PATS",16,0 )
	31280	N NOW,NOW 1,HMPX,HMP L,HMPN,DFN ,DA,TOKEN, NEW,X
	31281	"RTN","HMP PATS",17,0 )
	31282	S NOW=$$N OW^XLFDT,N OW1=$$FMAD D^XLFDT(NO W,1)
	31283	"RTN","HMP PATS",18,0 )
	31284	S HMPX(1) =NOW_";"_N OW1 ;next 24hours
	31285	"RTN","HMP PATS",19,0 )
	31286	S HMPX("F LDS")=1,HM PX("SORT") ="P",HMPX( 3)="R;I;NT "
	31287	"RTN","HMP PATS",20,0 )
	31288	; ck para meter for desired lo cation(s): HMPX(2)=" loc1;loc2; ...;loc#"
	31289	"RTN","HMP PATS",21,0 )
	31290	D GETLST^ XPAR(.HMPL ,"ALL","HM P LOCATION S") I +$G( HMPL) D
	31291	"RTN","HMP PATS",22,0 )
	31292	. ;DE2818 , ^SC refe rence - IC R 10040, c hanged loo p below to begin at 1
	31293	"RTN","HMP PATS",23,0 )
	31294	. F I=1:1 :+HMPL S X =+$G(HMPL( I)) S:$D(^ SC(X,0)) H MPX(2)=HMP X(2)_";"_X
	31295	"RTN","HMP PATS",24,0 )
	31296	S HMPN=$$ SDAPI^SDAM A301(.HMPX ) Q:HMPN<1
	31297	"RTN","HMP PATS",25,0 )
	31298	S DFN=0 F S DFN=$O (^TMP($J," SDAMA301", DFN)) Q:DF N<1 D
	31299	"RTN","HMP PATS",26,0 )
	31300	. S DA=0 F S DA=$O (^HMP(8000 00,DA)) Q: DA<1 I $P ($G(^(DA,0 )),U,2) D
	31301	"RTN","HMP PATS",27,0 )
	31302	.. Q:$D(^ HMP(800000 ,"ADFN",DF N,DA)) ;a lready sub scribed
	31303	"RTN","HMP PATS",28,0 )
	31304	.. S TOKE N=DA_"~"_N OW,NEW(TOK EN)=""
	31305	"RTN","HMP PATS",29,0 )
	31306	.. S ^XTM P("HMPX",T OKEN,DFN)= ""
	31307	"RTN","HMP PATS",30,0 )
	31308	I $D(NEW) D SEND^HM PHTTP(.NEW ) ;send po ke to each URL with list TOKEN
	31309	"RTN","HMP PATS",31,0 )
	31310	Q
	31311	"RTN","HMP PATS",32,0 )
	31312	;
	31313	"RTN","HMP PATS",33,0 )
	31314	FIND(ID) ; -- Return ien of sy stem ID in ^HMP
	31315	"RTN","HMP PATS",34,0 )
	31316	N DA,DO,D IC,X,Y
	31317	"RTN","HMP PATS",35,0 )
	31318	I $G(ID)= "" Q 0 ;error
	31319	"RTN","HMP PATS",36,0 )
	31320	S DA=+$O( ^HMP(80000 0,"B",ID,0 )) I DA<1 D ;add
	31321	"RTN","HMP PATS",37,0 )
	31322	. S DIC=" ^HMP(80000 0,",DIC(0) ="F",X=ID
	31323	"RTN","HMP PATS",38,0 )
	31324	. D FILE^ DICN S DA= +Y
	31325	"RTN","HMP PATS",39,0 )
	31326	Q DA
	31327	"RTN","HMP PATS",40,0 )
	31328	;
	31329	"RTN","HMP PDL")
	31330	0^139^B237 90480
	31331	"RTN","HMP PDL",1,0)
	31332	HMPPDL ;AS MR/PB - Ge t a users default pa tient list for HMP ; 07/31/201 5
	31333	"RTN","HMP PDL",2,0)
	31334	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Ju l 31, 2015 ;Build 63
	31335	"RTN","HMP PDL",3,0)
	31336	;Per VA D irective 6 402, this routine sh ould not b e modified .
	31337	"RTN","HMP PDL",4,0)
	31338	;
	31339	"RTN","HMP PDL",5,0)
	31340	; Externa l Referenc es DB IA#
	31341	"RTN","HMP PDL",6,0)
	31342	; ------- ---------- ---------- ---
	31343	"RTN","HMP PDL",7,0)
	31344	; $$BROK ER^XWBLID 2 190
	31345	"RTN","HMP PDL",8,0)
	31346	; $$GET^ XPAR 2 263
	31347	"RTN","HMP PDL",9,0)
	31348	; CLINPT S2^ORQPTQ2 4 207
	31349	"RTN","HMP PDL",10,0)
	31350	; BYWARD ^ORWPT 4 904
	31351	"RTN","HMP PDL",11,0)
	31352	; PROVPT S^ORQPTQ2 4 207
	31353	"RTN","HMP PDL",12,0)
	31354	; SPECPT S^ORQPTQ2 4 207
	31355	"RTN","HMP PDL",13,0)
	31356	; $$UP^X LFSTR 10 104
	31357	"RTN","HMP PDL",14,0)
	31358	; $$FMTE ^XLDFT 10 103
	31359	"RTN","HMP PDL",15,0)
	31360	; $$GET1 ^DIQ 2 056
	31361	"RTN","HMP PDL",16,0)
	31362	;
	31363	"RTN","HMP PDL",17,0)
	31364	Q
	31365	"RTN","HMP PDL",18,0)
	31366	;
	31367	"RTN","HMP PDL",19,0)
	31368	DEFLIST(Y, DUZ) ; ret urn curren t user's d efault pat ient list
	31369	"RTN","HMP PDL",20,0)
	31370	I $$BROKE R^XWBLIB S Y=$NA(^TM P("OR",$J, "PATIENTS" )) ; GUI = global. ICR 2190
	31371	"RTN","HMP PDL",21,0)
	31372	I '$$BROK ER^XWBLIB S ^TMP("OR ",$J,"PATI ENTS",0)=" " ;ICR 21 90
	31373	"RTN","HMP PDL",22,0)
	31374	Q:'$D(DUZ ) ;DUZ is required in order t o get the list of pa tients for the user
	31375	"RTN","HMP PDL",23,0)
	31376	N FROM,IE N,BEG,END, API,ORSRV, ORQDAT,ORQ CNT,ORGUI
	31377	"RTN","HMP PDL",24,0)
	31378	;S ORSRV= $G(^VA(200 ,DUZ,5)) I +ORSRV>0 S ORSRV=$P (ORSRV,U) ; get the users Netw ork Identi fier for t he user
	31379	"RTN","HMP PDL",25,0)
	31380	S ORSRV=$ $GET1^DIQ( 200,DUZ_", ",29,"I") ; get the users Netw ork Identi fier for t he user I CR 2056
	31381	"RTN","HMP PDL",26,0)
	31382	S FROM=$$ GET^XPAR(" USR^SRV.`" _+$G(ORSRV ),"ORLP DE FAULT LIST SOURCE",1 ,"Q") ; ge ts the use rs default preferenc e for pati ent list s ource. ICR 2263
	31383	"RTN","HMP PDL",27,0)
	31384	;FROM - T :Team/Pers onal List, W:Ward Li st, C:Clin ic List, P :Provider List, S:Sp ecialty Li st; M:Comb ination Li st.
	31385	"RTN","HMP PDL",28,0)
	31386	;FROM mus t be defin ed
	31387	"RTN","HMP PDL",29,0)
	31388	Q:'$L($G( FROM))
	31389	"RTN","HMP PDL",30,0)
	31390	I FROM="T " S IEN=$$ GET^XPAR(" USR^SRV.`" _+$G(ORSRV ),"ORLP DE FAULT TEAM ",1,"Q") D :+$G(IEN)> 0 TEAMPTS^ ORQPTQ1(.Y ,IEN) ;re turns the list of pa tients ass igned to a team. IC R 2263
	31391	"RTN","HMP PDL",31,0)
	31392	I FROM="W " S IEN=$$ GET^XPAR(" USR^SRV.`" _+$G(ORSRV ),"ORLP DE FAULT WARD ",1,"Q") D :+$G(IEN)> 0 BYWARD^O RWPT(.Y,IE N) ;retur ns the lis t of patie nts on a w ard ICR 4 904 ICR 22 63
	31393	"RTN","HMP PDL",32,0)
	31394	I FROM="P " S IEN=$$ GET^XPAR(" USR^SRV.`" _+$G(ORSRV ),"ORLP DE FAULT PROV IDER",1,"Q ") D:+$G(I EN)>0 PROV PTS^ORQPTQ 2(.Y,IEN) ;returns the list o f patients assigned to a provi der ICR 4 207 ICR 22 63
	31395	"RTN","HMP PDL",33,0)
	31396	I FROM="S " S IEN=$$ GET^XPAR(" USR^SRV.`" _+$G(ORSRV ),"ORLP DE FAULT SPEC IALTY",1," Q") D:+$G( IEN)>0 SPE CPTS^ORQPT Q2(.Y,IEN) ;returns the list of patient s assigned to a spec ialty ICR 4207 ICR 2263
	31397	"RTN","HMP PDL",34,0)
	31398	I FROM="C " D
	31399	"RTN","HMP PDL",35,0)
	31400	.S API="O RLP DEFAUL T CLINIC " _$$UP^XLFS TR($$DOW^X LFDT(DT)), IEN=$$GET^ XPAR("USR^ SRV.`"_+$G (ORSRV),AP I,1,"Q") I +$G(IEN)> 0 D ;retu rns a list of patien ts for the clinic ba sed on the user's de fault star t and end dates ICR 2263, ICR 10104
	31401	"RTN","HMP PDL",36,0)
	31402	..S BEG=$ $UP^XLFSTR ($$GET^XPA R("USR^SRV .`"_+$G(OR SRV)_"^DIV ^SYS^PKG", "ORLP DEFA ULT CLINIC START DAT E",1,"E")) ;returns the user' s default start date ICR 2263, ICR 1010 4
	31403	"RTN","HMP PDL",37,0)
	31404	..I BEG=" T+0" S BEG =$$FMTE^XL FDT(DT,BEG ) ;ICR 10 103
	31405	"RTN","HMP PDL",38,0)
	31406	..S END=$ $UP^XLFSTR ($$GET^XPA R("USR^SRV .`"_+$G(OR SRV)_"^DIV ^SYS^PKG", "ORLP DEFA ULT CLINIC STOP DATE ",1,"E")) ;returns the user's default e nd date I CR 2263, ICR 10104
	31407	"RTN","HMP PDL",39,0)
	31408	..I END=" T+0" S END =$$FMTE^XL FDT(DT,END ) ;ICR 10 103
	31409	"RTN","HMP PDL",40,0)
	31410	..D CLINP TS2^ORQPTQ 2(.Y,+$G(I EN),BEG,EN D) ;return s the pati ent list I CR 4207
	31411	"RTN","HMP PDL",41,0)
	31412	;The code below wil l pull a l ist of pat ients for the user b ased on th e combinat ions of li sts set up for the u ser in
	31413	"RTN","HMP PDL",42,0)
	31414	;OR(100.2 4, OE/RR P T SEL COMB O FILE. Th is file st ores the u sers combi nations us e to pull a combined list of p atients fr om multipl e files.
	31415	"RTN","HMP PDL",43,0)
	31416	;The COMB INATION IT EM multipl e stores t he file's IEN and th e file roo t for the files that store the patient l ist.
	31417	"RTN","HMP PDL",44,0)
	31418	;The user can creat e lists fr om the WAR D LOCATION S (#42), N EW PERSON (#200), FA CILITY TRE ATING SPEC IALTY (#45 .7), OE/RR LIST (#10 1.21) and the HOSPIT AL LOCATIO N(#44)
	31419	"RTN","HMP PDL",45,0)
	31420	;or any c ombination s of these files. Ea ch list is stored in a separat e row in t he COMBINA TION ITEM multiple. The code
	31421	"RTN","HMP PDL",46,0)
	31422	;loops th rough this multiple and the pu lls the li sts based on the ent ries.
	31423	"RTN","HMP PDL",47,0)
	31424	I FROM="M " D
	31425	"RTN","HMP PDL",48,0)
	31426	.;S IEN=$ D(^OR(100. 24,DUZ,0)) I +$G(IEN )>0 S IEN= DUZ D
	31427	"RTN","HMP PDL",49,0)
	31428	.S IEN=$$ GET1^DIQ(1 00.24,DUZ_ ",",.01,"I ") I +$G(I EN)>0 S IE N=DUZ D ;ICR 2056
	31429	"RTN","HMP PDL",50,0)
	31430	..S BEG=$ $UP^XLFSTR ($$GET^XPA R("USR^SRV .`"_+$G(OR SRV)_"^DIV ^SYS^PKG", "ORLP DEFA ULT CLINIC START DAT E",1,"E")) ;returns the user' s default start date ICR 10104
	31431	"RTN","HMP PDL",51,0)
	31432	..I BEG=" T+0" S BEG =$$FMTE^XL FDT(DT,BEG )
	31433	"RTN","HMP PDL",52,0)
	31434	..S END=$ $UP^XLFSTR ($$GET^XPA R("USR^SRV .`"_+$G(OR SRV)_"^DIV ^SYS^PKG", "ORLP DEFA ULT CLINIC STOP DATE ",1,"E")) ;returns the user's default e nd date IC R 10104
	31435	"RTN","HMP PDL",53,0)
	31436	..I END=" T+0" S END =$$FMTE^XL FDT(DT,END )
	31437	"RTN","HMP PDL",54,0)
	31438	..D COMBP TS^ORQPTQ6 (0,+$G(IEN ),BEG,END) ; first p arameter " 0"= GUI RP C call. Re turns the lists pati ents for e ach entry in the COM BINATION I TEM multip le
	31439	"RTN","HMP PDL",55,0)
	31440	I ($$BROK ER^XWBLIB) &(FROM'="M ") D ; Co mbinations already w ritten to global. IC R 2190
	31441	"RTN","HMP PDL",56,0)
	31442	.S ORQDAT ="",ORQCNT =0
	31443	"RTN","HMP PDL",57,0)
	31444	.F S ORQ CNT=$O(Y(O RQCNT)) Q: ORQCNT="" S ORQDAT= Y(ORQCNT) D
	31445	"RTN","HMP PDL",58,0)
	31446	..S ^TMP( "OR",$J,"P ATIENTS",O RQCNT,0)=O RQDAT
	31447	"RTN","HMP PDL",59,0)
	31448	I ('$$BRO KER^XWBLIB ) S Y=FROM _";"_+$G(I EN)_";"_$G (BEG)_";"_ $G(END) ; ICR 2190
	31449	"RTN","HMP PDL",60,0)
	31450	Q
	31451	"RTN","HMP PI")
	31452	1^180
	31453	"RTN","HMP PRODC")
	31454	1^181
	31455	"RTN","HMP PRXY2")
	31456	0^110^B169 33808
	31457	"RTN","HMP PRXY2",1,0 )
	31458	HMPPRXY2 ; ASMR/JCH,P B - Post-I nstall Rou tine to Cr eate HMP U ser ; 02/0 1/16 11:56
	31459	"RTN","HMP PRXY2",2,0 )
	31460	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Fe b 03, 2015 ;Build 63
	31461	"RTN","HMP PRXY2",3,0 )
	31462	;Per VA D irective 6 402, this routine sh ould not b e modified .
	31463	"RTN","HMP PRXY2",4,0 )
	31464	;
	31465	"RTN","HMP PRXY2",5,0 )
	31466	;Jan 29, 2016 - PB added code to add th e APPLICAT ION PROXY user class to the HM P,APPLILCA TION PROXY proxy acc ount
	31467	"RTN","HMP PRXY2",6,0 )
	31468	Q
	31469	"RTN","HMP PRXY2",7,0 )
	31470	;
	31471	"RTN","HMP PRXY2",8,0 )
	31472	POST ; Ent ry point f or post in stall
	31473	"RTN","HMP PRXY2",9,0 )
	31474	D BMES^XP DUTL(" St arting pos t-install" )
	31475	"RTN","HMP PRXY2",10, 0)
	31476	D ADDUSR
	31477	"RTN","HMP PRXY2",11, 0)
	31478	Q
	31479	"RTN","HMP PRXY2",12, 0)
	31480	;
	31481	"RTN","HMP PRXY2",13, 0)
	31482	ADDUSR() ; FileMan c alls to ad d user, up date field s, update sub-files
	31483	"RTN","HMP PRXY2",14, 0)
	31484	N DIC ; D IC(0) is r equired by the LAGYO code atta ched to NA ME (#.01) field in N EW PERSON (#200) fi le (see be low)
	31485	"RTN","HMP PRXY2",15, 0)
	31486	; NEW PE RSON (#200 file : ^DD (200,.01," LAYGO",1,0 )="D LAYGO ^XUA4A7"
	31487	"RTN","HMP PRXY2",16, 0)
	31488	; Routin e XUA4A7 : LA YGO ;Ca lled from ^DD(200,.0 1,"LAYGO", 1,0)
	31489	"RTN","HMP PRXY2",17, 0)
	31490	; Q:D IC(0)'["E"
	31491	"RTN","HMP PRXY2",18, 0)
	31492	N FDA ; T he name of the root of a VA Fi leMan Data Array, wh ich descri bes the en tries to a dd to the database.
	31493	"RTN","HMP PRXY2",19, 0)
	31494	N ERR ; A rray conta ining erro r messages .
	31495	"RTN","HMP PRXY2",20, 0)
	31496	N HMPERTX T ; Array containing generic u ser messag e text ind icating fi elds/files that were not updat ed
	31497	"RTN","HMP PRXY2",21, 0)
	31498	N USRIEN ; The Inte rnal Entry Number (I EN) of the
	31499	"RTN","HMP PRXY2",22, 0)
	31500	N FDAIEN ; The IEN of HMP,APP LICATION P ROXY user found in t he NEW PER SON (#200) file
	31501	"RTN","HMP PRXY2",23, 0)
	31502	N HMPERR ; The full reference to each E RR error n ode, inclu ding the a rray with subscripts and data (i.e., ERR ("DIERR",1 ,"TEXT")=" Error Mess age")
	31503	"RTN","HMP PRXY2",24, 0)
	31504	;
	31505	"RTN","HMP PRXY2",25, 0)
	31506	; Add new user to ^ VA(200
	31507	"RTN","HMP PRXY2",26, 0)
	31508	S DIC(0)= "" ; Defin e DIC(0) s o DD(200,. 01,"LAGYO" code does n't blow u p (LAYGO^X UA4A7)
	31509	"RTN","HMP PRXY2",27, 0)
	31510	S FDA(200 ,"?+1,",.0 1)="HMP,AP PLICATION PROXY"
	31511	"RTN","HMP PRXY2",28, 0)
	31512	D UPDATE^ DIE("E","F DA","FDAIE N","ERR")
	31513	"RTN","HMP PRXY2",29, 0)
	31514	; Quit if user not added
	31515	"RTN","HMP PRXY2",30, 0)
	31516	S USRIEN= $G(FDAIEN( 1))
	31517	"RTN","HMP PRXY2",31, 0)
	31518	I '$G(USR IEN) D Q
	31519	"RTN","HMP PRXY2",32, 0)
	31520	.D BMES^X PDUTL("HMP ,APPLICATI ON PROXY u ser not ad ded")
	31521	"RTN","HMP PRXY2",33, 0)
	31522	.I $D(ERR ) D ERROUT (.ERR)
	31523	"RTN","HMP PRXY2",34, 0)
	31524	;
	31525	"RTN","HMP PRXY2",35, 0)
	31526	S HMPERTX T=$S($G(FD AIEN(1,0)) ="?":"User HMP,APPLI CATION PRO XY already on file." ,$G(FDAIEN (1,0))="+" :"User HMP ,APPLICATI ON PROXY a dded",1:"" )
	31527	"RTN","HMP PRXY2",36, 0)
	31528	D BMES^XP DUTL(HMPER TXT)
	31529	"RTN","HMP PRXY2",37, 0)
	31530	;
	31531	"RTN","HMP PRXY2",38, 0)
	31532	; Add fie lds for ne w user fil e entry
	31533	"RTN","HMP PRXY2",39, 0)
	31534	K FDA,ERR
	31535	"RTN","HMP PRXY2",40, 0)
	31536	S FDA(200 ,USRIEN_", ",1)="PU" ; Ini tials
	31537	"RTN","HMP PRXY2",41, 0)
	31538	S FDA(200 ,USRIEN_", ",7.2)="Y"
	31539	"RTN","HMP PRXY2",42, 0)
	31540	S FDA(200 ,USRIEN_", ",20.2)="H MPPROXY US ER" ; Sig nature Blo ck
	31541	"RTN","HMP PRXY2",43, 0)
	31542	S FDA(200 ,USRIEN_", ",101.01)= "NO" ; Res trict Pati ent Select ion
	31543	"RTN","HMP PRXY2",44, 0)
	31544	S FDA(200 ,USRIEN_", ",201)="XM USER" ; Primary Me nu Option
	31545	"RTN","HMP PRXY2",45, 0)
	31546	D FILE^DI E("E","FDA ","ERR")
	31547	"RTN","HMP PRXY2",46, 0)
	31548	;
	31549	"RTN","HMP PRXY2",47, 0)
	31550	; displa y progress (Data is refiled ea ch time po st-install is run - updated me ssage will display e ach time)
	31551	"RTN","HMP PRXY2",48, 0)
	31552	K HMPERTX T
	31553	"RTN","HMP PRXY2",49, 0)
	31554	S HMPERTX T(1)="The following HMP,APPLIC ATION PROX Y fields w ere "_$S($ D(ERR):"NO T updated: ",1:"upda ted: ")
	31555	"RTN","HMP PRXY2",50, 0)
	31556	S HMPERTX T(2)="INIT IALS, ACCE SS CODE, S IGNATURE B LOCK, REST RICT PATIE NT SELECTI ON, PRIMAR Y MENU OPT ION"
	31557	"RTN","HMP PRXY2",51, 0)
	31558	D BMES^XP DUTL(.HMPE RTXT)
	31559	"RTN","HMP PRXY2",52, 0)
	31560	;
	31561	"RTN","HMP PRXY2",53, 0)
	31562	; If fail ure, provi de details
	31563	"RTN","HMP PRXY2",54, 0)
	31564	I $D(ERR) D ERROUT( .ERR)
	31565	"RTN","HMP PRXY2",55, 0)
	31566	;
	31567	"RTN","HMP PRXY2",56, 0)
	31568	; Update sub-files for new us er file en try
	31569	"RTN","HMP PRXY2",57, 0)
	31570	K FDA,ERR
	31571	"RTN","HMP PRXY2",58, 0)
	31572	S FDA(200 .051,"?+1, "_USRIEN_" ,",.01)="H MP ADMIN"
	31573	"RTN","HMP PRXY2",59, 0)
	31574	S FDA(200 .051,"?+2, "_USRIEN_" ,",.01)="P ROVIDER"
	31575	"RTN","HMP PRXY2",60, 0)
	31576	S FDA(200 .010113,"? +3,"_USRIE N_",",.01) ="COR"
	31577	"RTN","HMP PRXY2",61, 0)
	31578	S FDA(200 .03,"?+5," _USRIEN_", ",.01)="HM P UI CONTE XT"
	31579	"RTN","HMP PRXY2",62, 0)
	31580	S FDA(200 .03,"?+6," _USRIEN_", ",.01)="HM P SYNCHRON IZATION CO NTEXT"
	31581	"RTN","HMP PRXY2",63, 0)
	31582	D UPDATE^ DIE("E","F DA",,"ERR" )
	31583	"RTN","HMP PRXY2",64, 0)
	31584	;
	31585	"RTN","HMP PRXY2",65, 0)
	31586	; It's an all or no thing tran saction - display pr ogress (Da ta is refi led each t ime post-i nstall is run - upda ted messag e will dis play each time)
	31587	"RTN","HMP PRXY2",66, 0)
	31588	K HMPERTX T
	31589	"RTN","HMP PRXY2",67, 0)
	31590	S HMPERTX T(1)="The following sub-files for user H MP,APPLICA TION PROXY were "_$S ($D(ERR):" NOT update d: ",1:"up dated: ")
	31591	"RTN","HMP PRXY2",68, 0)
	31592	S HMPERTX T(2)=" KE YS, CPRS T AB, SECOND ARY MENU O PTIONS"
	31593	"RTN","HMP PRXY2",69, 0)
	31594	D BMES^XP DUTL(.HMPE RTXT)
	31595	"RTN","HMP PRXY2",70, 0)
	31596	;
	31597	"RTN","HMP PRXY2",71, 0)
	31598	; If fail ure, provi de details
	31599	"RTN","HMP PRXY2",72, 0)
	31600	I $D(ERR) D ERROUT( .ERR)
	31601	"RTN","HMP PRXY2",73, 0)
	31602	;
	31603	"RTN","HMP PRXY2",74, 0)
	31604	;JAN 29, 2016 - PB - Add User Class, AP PLICATION PROXY to t he HMP,APP LICATION P ROXY accou nt
	31605	"RTN","HMP PRXY2",75, 0)
	31606	;get poin ters for c lasses in file 201
	31607	"RTN","HMP PRXY2",76, 0)
	31608	K FDA,ERR
	31609	"RTN","HMP PRXY2",77, 0)
	31610	S FDA(200 .07,"?+1," _USRIEN_", ",.01)="AP PLICATION PROXY"
	31611	"RTN","HMP PRXY2",78, 0)
	31612	S FDA(200 .07,"?+1," _USRIEN_", ",2)="1"
	31613	"RTN","HMP PRXY2",79, 0)
	31614	D UPDATE^ DIE("E","F DA",,"ERR" )
	31615	"RTN","HMP PRXY2",80, 0)
	31616	;if user class, APP LICATION P ROXY is no t added no tify users
	31617	"RTN","HMP PRXY2",81, 0)
	31618	K HMPERTX T
	31619	"RTN","HMP PRXY2",82, 0)
	31620	S HMPERTX T(1)="The following sub-files for user H MP,APPLICA TION PROXY were "_$S ($D(ERR):" NOT update d: ",1:"up dated: ")
	31621	"RTN","HMP PRXY2",83, 0)
	31622	S HMPERTX T(2)=" Us er Class - APPLICATI ON PROXY"
	31623	"RTN","HMP PRXY2",84, 0)
	31624	D BMES^XP DUTL(.HMPE RTXT)
	31625	"RTN","HMP PRXY2",85, 0)
	31626	Q
	31627	"RTN","HMP PRXY2",86, 0)
	31628	;end chan ges to add user clas ses to the HMP,APPLI CATION PRO XY proxy u ser accoun t.
	31629	"RTN","HMP PRXY2",87, 0)
	31630	;
	31631	"RTN","HMP PRXY2",88, 0)
	31632	ERROUT(ERR ) ; Output ERR array
	31633	"RTN","HMP PRXY2",89, 0)
	31634	D BMES^XP DUTL("Erro r Details: ")
	31635	"RTN","HMP PRXY2",90, 0)
	31636	S HMPERR= "ERR(""DIE RR"")" F S HMPERR=$ Q(@HMPERR) Q:HMPERR= "" D MES^ XPDUTL(HMP ERR_"="_@H MPERR)
	31637	"RTN","HMP PRXY2",91, 0)
	31638	Q
	31639	"RTN","HMP PTDEM")
	31640	0^111^B126 65908
	31641	"RTN","HMP PTDEM",1,0 )
	31642	HMPPTDEM ;ASMR/EJK, JD - File Patient De mographic Informatio n passed v ia RPC ; 0 9/16/2014
	31643	"RTN","HMP PTDEM",2,0 )
	31644	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Oc t 10, 2014 ;Build 63
	31645	"RTN","HMP PTDEM",3,0 )
	31646	;Per VA D irective 6 402, this routine sh ould not b e modified .
	31647	"RTN","HMP PTDEM",4,0 )
	31648	;
	31649	"RTN","HMP PTDEM",5,0 )
	31650	; RPC = H MP WRITEBA CK PT DEM
	31651	"RTN","HMP PTDEM",6,0 )
	31652	;
	31653	"RTN","HMP PTDEM",7,0 )
	31654	; * NOT ES *
	31655	"RTN","HMP PTDEM",8,0 )
	31656	; Return variable m ust be an ARRAY
	31657	"RTN","HMP PTDEM",9,0 )
	31658	; A succe ss MUST be sent as a 1
	31659	"RTN","HMP PTDEM",10, 0)
	31660	; A failu re may tak e any form
	31661	"RTN","HMP PTDEM",11, 0)
	31662	; ***** ****
	31663	"RTN","HMP PTDEM",12, 0)
	31664	;
	31665	"RTN","HMP PTDEM",13, 0)
	31666	Q ;Must come in at a tag.
	31667	"RTN","HMP PTDEM",14, 0)
	31668	;
	31669	"RTN","HMP PTDEM",15, 0)
	31670	FILE(RSP,H MPDEM) ;Fi le Patient Demograph ic informa tion.
	31671	"RTN","HMP PTDEM",16, 0)
	31672	;Inbound data layou t:
	31673	"RTN","HMP PTDEM",17, 0)
	31674	; "^" del imited
	31675	"RTN","HMP PTDEM",18, 0)
	31676	; Piece 1 : DFN
	31677	"RTN","HMP PTDEM",19, 0)
	31678	; Piece 2 : Home Pho ne Number - ^DD(2,.1 31 - ^DPT( DFN,.13) p iece 1
	31679	"RTN","HMP PTDEM",20, 0)
	31680	; Piece 3 : Cell Pho ne Number - ^DD(2,.1 34 - ^DPT( DFN,.13) p iece 4
	31681	"RTN","HMP PTDEM",21, 0)
	31682	; Piece 4 : Work Pho ne Number - ^DD(2,.1 32 - ^DPT( DFN,.13) p iece 2
	31683	"RTN","HMP PTDEM",22, 0)
	31684	; Piece 5 : Emergenc y Phone Nu mber - ^DD (2,.339 - ^DPT(DFN,. 33) piece 9
	31685	"RTN","HMP PTDEM",23, 0)
	31686	; Piece 6 : NOK Phon e Number - ^DD(2,.21 9 - ^DPT(D FN,.21) pi ece 9
	31687	"RTN","HMP PTDEM",24, 0)
	31688	;
	31689	"RTN","HMP PTDEM",25, 0)
	31690	; If a pi ece contai ns -1, it means DELE TE it
	31691	"RTN","HMP PTDEM",26, 0)
	31692	; If a pi ece is nul l, it mean s LEAVE it ALONE
	31693	"RTN","HMP PTDEM",27, 0)
	31694	; If a pi ece is not -1 and no t null, it means UPD ATE it
	31695	"RTN","HMP PTDEM",28, 0)
	31696	;
	31697	"RTN","HMP PTDEM",29, 0)
	31698	;D BEFORE ; testin g ONLY
	31699	"RTN","HMP PTDEM",30, 0)
	31700	D PROC
	31701	"RTN","HMP PTDEM",31, 0)
	31702	;D AFTER ; testing ONLY
	31703	"RTN","HMP PTDEM",32, 0)
	31704	Q
	31705	"RTN","HMP PTDEM",33, 0)
	31706	;
	31707	"RTN","HMP PTDEM",34, 0)
	31708	PROC ;
	31709	"RTN","HMP PTDEM",35, 0)
	31710	N HMPDFN, HMPHPN,HMP CPN,HMPWPN ,HMPEPN,HM PNPN,RSPCN T
	31711	"RTN","HMP PTDEM",36, 0)
	31712	N HMPER,H MPX
	31713	"RTN","HMP PTDEM",37, 0)
	31714	K HMPX
	31715	"RTN","HMP PTDEM",38, 0)
	31716	S RSPCNT= 0,HMPER=""
	31717	"RTN","HMP PTDEM",39, 0)
	31718	S HMPDFN= $P(HMPDEM, "^",1)
	31719	"RTN","HMP PTDEM",40, 0)
	31720	S HMPHPN= $P(HMPDEM, "^",2)
	31721	"RTN","HMP PTDEM",41, 0)
	31722	S HMPCPN= $P(HMPDEM, "^",3)
	31723	"RTN","HMP PTDEM",42, 0)
	31724	S HMPWPN= $P(HMPDEM, "^",4)
	31725	"RTN","HMP PTDEM",43, 0)
	31726	S HMPEPN= $P(HMPDEM, "^",5)
	31727	"RTN","HMP PTDEM",44, 0)
	31728	S HMPNPN= $P(HMPDEM, "^",6)
	31729	"RTN","HMP PTDEM",45, 0)
	31730	S DA=HMPD FN
	31731	"RTN","HMP PTDEM",46, 0)
	31732	K RSP
	31733	"RTN","HMP PTDEM",47, 0)
	31734	S RSP(0)= 1 ;"Writeb ack was su ccessful" ; default to good n ews!
	31735	"RTN","HMP PTDEM",48, 0)
	31736	I HMPDFN' ]"" S RSP( 0)="No DFN " Q
	31737	"RTN","HMP PTDEM",49, 0)
	31738	I '$D(^DP T(HMPDFN)) S RSP(0)= "Patient d oes not ex ist. DFN: "_HMPDFN Q ;ICR 10 035 DE2818 ASF 11/12 /15
	31739	"RTN","HMP PTDEM",50, 0)
	31740	I $$GET1^ DIQ(2,HMPD FN_",",.33 1)']"",HMP EPN]"" S R SP(0)="Set ting EM CO PH w/o EM CO Name" Q
	31741	"RTN","HMP PTDEM",51, 0)
	31742	I $$GET1^ DIQ(2,HMPD FN_",",.21 1)']"",HMP NPN]"" S R SP(0)="Set ting NOK P H w/o NOK Name" Q
	31743	"RTN","HMP PTDEM",52, 0)
	31744	S HMPX(2, DA_",",.13 1)=$S(HMPH PN=-1:"",H MPHPN="":$ $GET1^DIQ( 2,HMPDFN_" ,",.131),1 :HMPHPN)
	31745	"RTN","HMP PTDEM",53, 0)
	31746	S HMPX(2, DA_",",.13 2)=$S(HMPW PN=-1:"",H MPWPN="":$ $GET1^DIQ( 2,HMPDFN_" ,",.132),1 :HMPWPN)
	31747	"RTN","HMP PTDEM",54, 0)
	31748	S HMPX(2, DA_",",.13 4)=$S(HMPC PN=-1:"",H MPCPN="":$ $GET1^DIQ( 2,HMPDFN_" ,",.134),1 :HMPCPN)
	31749	"RTN","HMP PTDEM",55, 0)
	31750	S HMPX(2, DA_",",.21 9)=$S(HMPN PN=-1:"",H MPNPN="":$ $GET1^DIQ( 2,HMPDFN_" ,",.219),1 :HMPNPN)
	31751	"RTN","HMP PTDEM",56, 0)
	31752	S HMPX(2, DA_",",.33 9)=$S(HMPE PN=-1:"",H MPEPN="":$ $GET1^DIQ( 2,HMPDFN_" ,",.339),1 :HMPEPN)
	31753	"RTN","HMP PTDEM",57, 0)
	31754	D UPDATE^ DIE(,"HMPX ",,"HMPER" )
	31755	"RTN","HMP PTDEM",58, 0)
	31756	I HMPER]" " S RSP(0) =HMPER
	31757	"RTN","HMP PTDEM",59, 0)
	31758	Q
	31759	"RTN","HMP PTDEM",60, 0)
	31760	BEFORE ;
	31761	"RTN","HMP PTDEM",61, 0)
	31762	S DFN=$P( HMPDEM,"^" ,1)
	31763	"RTN","HMP PTDEM",62, 0)
	31764	K HPN,CPN ,WPN,EPN,N PN,PTNAME
	31765	"RTN","HMP PTDEM",63, 0)
	31766	S (HPN,CP N,WPN,EPN, NPN)=""
	31767	"RTN","HMP PTDEM",64, 0)
	31768	S PTNAME= $$GET1^DIQ (2,DFN_"," ,.01,"E")
	31769	"RTN","HMP PTDEM",65, 0)
	31770	S HPN=$$G ET1^DIQ(2, DFN_",",.1 31,"E")
	31771	"RTN","HMP PTDEM",66, 0)
	31772	S CPN=$$G ET1^DIQ(2, DFN_",",.1 34,"E")
	31773	"RTN","HMP PTDEM",67, 0)
	31774	S WPN=$$G ET1^DIQ(2, DFN_",",.1 32,"E")
	31775	"RTN","HMP PTDEM",68, 0)
	31776	S EPN=$$G ET1^DIQ(2, DFN_",",.3 39,"E")
	31777	"RTN","HMP PTDEM",69, 0)
	31778	S NPN=$$G ET1^DIQ(2, DFN_",",.2 19,"E")
	31779	"RTN","HMP PTDEM",70, 0)
	31780	U 0 W "Pa tient: "_P TNAME,!
	31781	"RTN","HMP PTDEM",71, 0)
	31782	U 0 W "Be fore execu ting input string:", !
	31783	"RTN","HMP PTDEM",72, 0)
	31784	U 0 W ?5, "Home Phon e: "_HPN,!
	31785	"RTN","HMP PTDEM",73, 0)
	31786	U 0 W ?5, "Cell Phon e: "_CPN,!
	31787	"RTN","HMP PTDEM",74, 0)
	31788	U 0 W ?5, "Work Phon e: "_WPN,!
	31789	"RTN","HMP PTDEM",75, 0)
	31790	U 0 W ?5, "Emergency Phone: "_ EPN,!
	31791	"RTN","HMP PTDEM",76, 0)
	31792	U 0 W ?5, "NOK Phone : "_NPN,!!
	31793	"RTN","HMP PTDEM",77, 0)
	31794	Q
	31795	"RTN","HMP PTDEM",78, 0)
	31796	AFTER ;
	31797	"RTN","HMP PTDEM",79, 0)
	31798	S (HPN,CP N,WPN,EPN, NPN)=""
	31799	"RTN","HMP PTDEM",80, 0)
	31800	S PTNAME= $$GET1^DIQ (2,DFN_"," ,.01,"E")
	31801	"RTN","HMP PTDEM",81, 0)
	31802	S HPN=$$G ET1^DIQ(2, DFN_",",.1 31,"E")
	31803	"RTN","HMP PTDEM",82, 0)
	31804	S CPN=$$G ET1^DIQ(2, DFN_",",.1 34,"E")
	31805	"RTN","HMP PTDEM",83, 0)
	31806	S WPN=$$G ET1^DIQ(2, DFN_",",.1 32,"E")
	31807	"RTN","HMP PTDEM",84, 0)
	31808	S EPN=$$G ET1^DIQ(2, DFN_",",.3 39,"E")
	31809	"RTN","HMP PTDEM",85, 0)
	31810	S NPN=$$G ET1^DIQ(2, DFN_",",.2 19,"E")
	31811	"RTN","HMP PTDEM",86, 0)
	31812	U 0 W "Af ter execut ing input string:",!
	31813	"RTN","HMP PTDEM",87, 0)
	31814	U 0 W "Pa tient: "_P TNAME,!
	31815	"RTN","HMP PTDEM",88, 0)
	31816	U 0 W ?5, "Home Phon e: "_HPN,!
	31817	"RTN","HMP PTDEM",89, 0)
	31818	U 0 W ?5, "Cell Phon e: "_CPN,!
	31819	"RTN","HMP PTDEM",90, 0)
	31820	U 0 W ?5, "Work Phon e: "_WPN,!
	31821	"RTN","HMP PTDEM",91, 0)
	31822	U 0 W ?5, "Emergency Phone: "_ EPN,!
	31823	"RTN","HMP PTDEM",92, 0)
	31824	U 0 W ?5, "NOK Phone : "_NPN
	31825	"RTN","HMP PTDEM",93, 0)
	31826	Q
	31827	"RTN","HMP PXPR1")
	31828	1^182
	31829	"RTN","HMP PXRM")
	31830	0^113^B145 31240
	31831	"RTN","HMP PXRM",1,0)
	31832	HMPPXRM ;S LC/AGP,ASM R/RRB - Cl inical Rem inders rou tine. ; 8/ 16/12 7:09 pm
	31833	"RTN","HMP PXRM",2,0)
	31834	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	31835	"RTN","HMP PXRM",3,0)
	31836	;Per VA D irective 6 402, this routine sh ould not b e modified .
	31837	"RTN","HMP PXRM",4,0)
	31838	;
	31839	"RTN","HMP PXRM",5,0)
	31840	Q
	31841	"RTN","HMP PXRM",6,0)
	31842	;
	31843	"RTN","HMP PXRM",7,0)
	31844	EVALLIST(R ESULT,PT,U SER,LOC) ;
	31845	"RTN","HMP PXRM",8,0)
	31846	N CNT,NUM ,RIEN,TMP, UID,HMPTMP ,HMPSYS
	31847	"RTN","HMP PXRM",9,0)
	31848	N DUEDATE ,I,J,LASTD ONE,NAME,N ODE,STATUS ,TXT
	31849	"RTN","HMP PXRM",10,0 )
	31850	;S USER=$ P(USERUID, ":",5)
	31851	"RTN","HMP PXRM",11,0 )
	31852	D GETLIST ^ORQQPX(.H MPTMP,LOC)
	31853	"RTN","HMP PXRM",12,0 )
	31854	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	31855	"RTN","HMP PXRM",13,0 )
	31856	S CNT=0,N UM=0 F S CNT=$O(HMP TMP(CNT)) Q:CNT'>0 D
	31857	"RTN","HMP PXRM",14,0 )
	31858	.S RIEN=$ G(HMPTMP(C NT)) I RIE N'>0 Q
	31859	"RTN","HMP PXRM",15,0 )
	31860	.;begin f ix DE 2818 ICR 6113 ASF 11/16
	31861	"RTN","HMP PXRM",16,0 )
	31862	.;S NAME= "" S NAME= $P($G(^PXD (811.9,RIE N,0)),U,3)
	31863	"RTN","HMP PXRM",17,0 )
	31864	.;I NAME= "" S NAME= $P($G(^PXD (811.9,RIE N,0)),U)
	31865	"RTN","HMP PXRM",18,0 )
	31866	.S NAME=$ $GET1^DIQ( 811.9,REIN _",",1.2)
	31867	"RTN","HMP PXRM",19,0 )
	31868	.I NAME=" " S NAME=$ $GET1^DIQ( 811.9,REIN _",",.01)
	31869	"RTN","HMP PXRM",20,0 )
	31870	.; end DE 2818 fix
	31871	"RTN","HMP PXRM",21,0 )
	31872	.S UID="u rn:va:pxrm :"_HMPSYS_ ":"_RIEN
	31873	"RTN","HMP PXRM",22,0 )
	31874	.S NUM=NU M+1,TMP("r eminders", NUM,"uid") =UID,TMP(" reminders" ,NUM,"name ")=NAME
	31875	"RTN","HMP PXRM",23,0 )
	31876	.K ^TMP(" PXRHM",$J)
	31877	"RTN","HMP PXRM",24,0 )
	31878	.D MAIN^P XRM(PT,RIE N,5) ; 5 returns all remin der info
	31879	"RTN","HMP PXRM",25,0 )
	31880	.S I=1,TX T=""
	31881	"RTN","HMP PXRM",26,0 )
	31882	.S NAME=" ",NAME=$O( ^TMP("PXRH M",$J,RIEN ,NAME)) Q: NAME="" D
	31883	"RTN","HMP PXRM",27,0 )
	31884	..S NODE= $G(^TMP("P XRHM",$J,R IEN,NAME))
	31885	"RTN","HMP PXRM",28,0 )
	31886	..S STATU S=$P(NODE, U),DUEDATE =$$JSONDT^ HMPUTILS($ P(NODE,U,2 )),LASTDON E=$$JSONDT ^HMPUTILS( $P(NODE,U, 3))
	31887	"RTN","HMP PXRM",29,0 )
	31888	..S J=0 F S J=$O(^ TMP("PXRHM ",$J,RIEN, NAME,"TXT" ,J)) Q:J=" " D
	31889	"RTN","HMP PXRM",30,0 )
	31890	...S TXT= $G(TXT)_^T MP("PXRHM" ,$J,RIEN,N AME,"TXT", J)_$C(13)_ $C(10),I=I +1
	31891	"RTN","HMP PXRM",31,0 )
	31892	.K ^TMP(" PXRHM",$J)
	31893	"RTN","HMP PXRM",32,0 )
	31894	.S TMP("r eminders", NUM,"statu s")=STATUS
	31895	"RTN","HMP PXRM",33,0 )
	31896	.S TMP("r eminders", NUM,"dueDa te")=DUEDA TE
	31897	"RTN","HMP PXRM",34,0 )
	31898	.S TMP("r eminders", NUM,"lastD one")=LAST DONE
	31899	"RTN","HMP PXRM",35,0 )
	31900	.S TMP("r eminders", NUM,"clini calMainten ance")=TXT
	31901	"RTN","HMP PXRM",36,0 )
	31902	S TMP("su ccess")="t rue"
	31903	"RTN","HMP PXRM",37,0 )
	31904	D ENCODE^ HMPJSON("T MP","RESUL T","ERROR" )
	31905	"RTN","HMP PXRM",38,0 )
	31906	I $D(ERRO R) D SETER ROR(.TMP,. ERROR,.RES ULT)
	31907	"RTN","HMP PXRM",39,0 )
	31908	Q
	31909	"RTN","HMP PXRM",40,0 )
	31910	;
	31911	"RTN","HMP PXRM",41,0 )
	31912	EVALREM(RE SULT,PT,UI D) ;return detail fo r a pt's c linical re minder
	31913	"RTN","HMP PXRM",42,0 )
	31914	K ^TMP("P XRHM",$J)
	31915	"RTN","HMP PXRM",43,0 )
	31916	N DUEDATE ,I,J,LASTD ONE,NAME,N ODE,RIEN,S TATUS,TMP, TXT
	31917	"RTN","HMP PXRM",44,0 )
	31918	S RIEN=$P (UID,":",5 )
	31919	"RTN","HMP PXRM",45,0 )
	31920	D MAIN^PX RM(PT,RIEN ,5) ; 5 returns all remind er info
	31921	"RTN","HMP PXRM",46,0 )
	31922	S I=1,TXT =""
	31923	"RTN","HMP PXRM",47,0 )
	31924	S NAME="" ,NAME=$O(^ TMP("PXRHM ",$J,RIEN, NAME)) Q:N AME="" D
	31925	"RTN","HMP PXRM",48,0 )
	31926	.S NODE=$ G(^TMP("PX RHM",$J,RI EN,NAME))
	31927	"RTN","HMP PXRM",49,0 )
	31928	.S STATUS =$P(NODE,U ),DUEDATE= $$JSONDT^H MPUTILS($P (NODE,U,2) ),LASTDONE =$$JSONDT^ HMPUTILS($ P(NODE,U,3 ))
	31929	"RTN","HMP PXRM",50,0 )
	31930	.S J=0 F S J=$O(^T MP("PXRHM" ,$J,RIEN,N AME,"TXT", J)) Q:J="" D
	31931	"RTN","HMP PXRM",51,0 )
	31932	..S TXT=$ G(TXT)_^TM P("PXRHM", $J,RIEN,NA ME,"TXT",J )_$C(13)_$ C(10),I=I+ 1
	31933	"RTN","HMP PXRM",52,0 )
	31934	K ^TMP("P XRHM",$J)
	31935	"RTN","HMP PXRM",53,0 )
	31936	S TMP("ui d")=UID
	31937	"RTN","HMP PXRM",54,0 )
	31938	S TMP("st atus")=STA TUS
	31939	"RTN","HMP PXRM",55,0 )
	31940	S TMP("du eDate")=DU EDATE
	31941	"RTN","HMP PXRM",56,0 )
	31942	S TMP("la stDone")=L ASTDONE
	31943	"RTN","HMP PXRM",57,0 )
	31944	S TMP("cl inicalMain tenance")= TXT
	31945	"RTN","HMP PXRM",58,0 )
	31946	S TMP("su ccess")="t rue"
	31947	"RTN","HMP PXRM",59,0 )
	31948	D ENCODE^ HMPJSON("T MP","RESUL T","ERROR" )
	31949	"RTN","HMP PXRM",60,0 )
	31950	I $D(ERRO R) D SETER ROR(.TMP,. ERROR,.RES ULT)
	31951	"RTN","HMP PXRM",61,0 )
	31952	Q
	31953	"RTN","HMP PXRM",62,0 )
	31954	;
	31955	"RTN","HMP PXRM",63,0 )
	31956	REMLIST(RE SULT,USERU ID,LOC) ;
	31957	"RTN","HMP PXRM",64,0 )
	31958	N CNT,NUM ,RIEN,TMP, UID,USER,H MPTMP,HMPS YS
	31959	"RTN","HMP PXRM",65,0 )
	31960	S USER=$P (USERUID," :",5)
	31961	"RTN","HMP PXRM",66,0 )
	31962	D GETLIST ^ORQQPX(.H MPTMP,LOC)
	31963	"RTN","HMP PXRM",67,0 )
	31964	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	31965	"RTN","HMP PXRM",68,0 )
	31966	S CNT=0,N UM=0 F S CNT=$O(HMP TMP(CNT)) Q:CNT'>0 D
	31967	"RTN","HMP PXRM",69,0 )
	31968	.S RIEN=$ G(HMPTMP(C NT)) I RIE N'>0 Q
	31969	"RTN","HMP PXRM",70,0 )
	31970	.;begin f ix DE 2818 ICR 6113 ASF 11/16
	31971	"RTN","HMP PXRM",71,0 )
	31972	.;S NAME= "" S NAME= $P($G(^PXD (811.9,RIE N,0)),U,3)
	31973	"RTN","HMP PXRM",72,0 )
	31974	.;I NAME= "" S NAME= $P($G(^PXD (811.9,RIE N,0)),U)
	31975	"RTN","HMP PXRM",73,0 )
	31976	.S NAME=$ $GET1^DIQ( 811.9,REIN _",",1.2)
	31977	"RTN","HMP PXRM",74,0 )
	31978	.I NAME=" " S NAME=$ $GET1^DIQ( 811.9,REIN _",",.01)
	31979	"RTN","HMP PXRM",75,0 )
	31980	.; end DE 2818 fix
	31981	"RTN","HMP PXRM",76,0 )
	31982	.S UID="u rn:va:pxrm :"_HMPSYS_ ":"_RIEN
	31983	"RTN","HMP PXRM",77,0 )
	31984	.S NUM=NU M+1,TMP("r eminders", NUM,"uid") =UID,TMP(" reminders" ,NUM,"name ")=NAME
	31985	"RTN","HMP PXRM",78,0 )
	31986	S TMP("su ccess")="t rue"
	31987	"RTN","HMP PXRM",79,0 )
	31988	D ENCODE^ HMPJSON("T MP","RESUL T","ERROR" )
	31989	"RTN","HMP PXRM",80,0 )
	31990	I $D(ERRO R) D SETER ROR(.TMP,. ERROR,.RES ULT)
	31991	"RTN","HMP PXRM",81,0 )
	31992	Q
	31993	"RTN","HMP PXRM",82,0 )
	31994	;
	31995	"RTN","HMP PXRM",83,0 )
	31996	SETERROR(I NPDATA,ERR ORMSG,OUTP UT) ;
	31997	"RTN","HMP PXRM",84,0 )
	31998	N ERRARR, TXT
	31999	"RTN","HMP PXRM",85,0 )
	32000	S TXT(1)= "Problem e ncoding js on output"
	32001	"RTN","HMP PXRM",86,0 )
	32002	D SETERRO R^HMPUTILS (.ERRARR,. ERRORMSG,. TXT,.INPDA TA)
	32003	"RTN","HMP PXRM",87,0 )
	32004	D ENCODE^ HMPJSON("E RRARR","OU TPUT","ERR OR")
	32005	"RTN","HMP PXRM",88,0 )
	32006	Q
	32007	"RTN","HMP PXRM",89,0 )
	32008	;
	32009	"RTN","HMP ROS2")
	32010	1^183
	32011	"RTN","HMP ROS3")
	32012	1^184
	32013	"RTN","HMP ROS4")
	32014	1^185
	32015	"RTN","HMP ROS5")
	32016	1^186
	32017	"RTN","HMP ROS6")
	32018	1^187
	32019	"RTN","HMP ROS7")
	32020	1^188
	32021	"RTN","HMP ROS8")
	32022	0^149^B821 43309
	32023	"RTN","HMP ROS8",1,0)
	32024	HMPROS8 ;S LC/AGP,ASM R/RRB - Ge t CPRS Use r Default Roster Lis t ; 6/11/1 4 8:38pm
	32025	"RTN","HMP ROS8",2,0)
	32026	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;AU G 17, 2011 ;Build 63
	32027	"RTN","HMP ROS8",3,0)
	32028	;Per VA D irective 6 402, this routine sh ould not b e modified .
	32029	"RTN","HMP ROS8",4,0)
	32030	;
	32031	"RTN","HMP ROS8",5,0)
	32032	Q
	32033	"RTN","HMP ROS8",6,0)
	32034	;
	32035	"RTN","HMP ROS8",7,0)
	32036	BLDSORT(NO DE,SRC,SOR T,SEQ) ; e mulate TSt ringList S ort found in CPRS
	32037	"RTN","HMP ROS8",8,0)
	32038	; append separator to ensure string sor t (rather than numer ic)
	32039	"RTN","HMP ROS8",9,0)
	32040	; append SEQ to avo id droppin g node whe re SORTKEY is duplic ated
	32041	"RTN","HMP ROS8",10,0 )
	32042	; SORT: A:Alphabet ic;R:Room/ Bed;P:Appo intment Da te;T:Termi nal Digit; S:Source
	32043	"RTN","HMP ROS8",11,0 )
	32044	I $E(NODE )=U QUIT ; i.e., "^ No patient s found"
	32045	"RTN","HMP ROS8",12,0 )
	32046	N SORTKEY ,S
	32047	"RTN","HMP ROS8",13,0 )
	32048	S NODE=$G (NODE),S=" "
	32049	"RTN","HMP ROS8",14,0 )
	32050	S SORTKEY =$P(NODE,U ,2)_S_SEQ ; default alphabetic by name
	32051	"RTN","HMP ROS8",15,0 )
	32052	I SRC="C" ,(SORT="P" ) S SORTKE Y=$P(NODE, U,4)_S_SEQ
	32053	"RTN","HMP ROS8",16,0 )
	32054	I SRC="M" D
	32055	"RTN","HMP ROS8",17,0 )
	32056	.I SORT=" S" S SORTK EY=$P(NODE ,U,3)_S_$P (NODE,U,8) _S_$P(NODE ,U,2)_S_SE Q
	32057	"RTN","HMP ROS8",18,0 )
	32058	.I SORT=" P" S SORTK EY=$P(NODE ,U,8)_S_$P (NODE,U,2) _S_SEQ
	32059	"RTN","HMP ROS8",19,0 )
	32060	.I SORT=" T" S SORTK EY=$P(NODE ,U,5)_S_SE Q
	32061	"RTN","HMP ROS8",20,0 )
	32062	I SRC="W" ,(SORT="R" ) S SORTKE Y=$P(NODE, U,3)_S_$P( NODE,U,2)_ S_SEQ
	32063	"RTN","HMP ROS8",21,0 )
	32064	I '$L(SOR TKEY) S SO RTKEY=S_SE Q
	32065	"RTN","HMP ROS8",22,0 )
	32066	S ^TMP("H MPSORT",$J ,$P(SRC,U, 2)_":"_SOR T,SORTKEY) =NODE
	32067	"RTN","HMP ROS8",23,0 )
	32068	Q
	32069	"RTN","HMP ROS8",24,0 )
	32070	;
	32071	"RTN","HMP ROS8",25,0 )
	32072	CHKPAT(PAT IENTS,SERV ER) ;
	32073	"RTN","HMP ROS8",26,0 )
	32074	N ARGS,OU T,PAT,STAT US
	32075	"RTN","HMP ROS8",27,0 )
	32076	S ARGS("c ommand")=" putPtSubsc ription"
	32077	"RTN","HMP ROS8",28,0 )
	32078	S ARGS("s erver")=SE RVER
	32079	"RTN","HMP ROS8",29,0 )
	32080	S PAT="" F S PAT=$ O(PATIENTS (PAT)) Q:P AT'>0 D
	32081	"RTN","HMP ROS8",30,0 )
	32082	.S STATUS =$G(^HMP(8 00000,"AIT EM",PAT,SE RVER))
	32083	"RTN","HMP ROS8",31,0 )
	32084	.I STATUS '="",STATU S>0 Q
	32085	"RTN","HMP ROS8",32,0 )
	32086	.S ARGS(" localId")= PAT
	32087	"RTN","HMP ROS8",33,0 )
	32088	.D API^HM PDJFS(.OUT ,.ARGS)
	32089	"RTN","HMP ROS8",34,0 )
	32090	Q
	32091	"RTN","HMP ROS8",35,0 )
	32092	;
	32093	"RTN","HMP ROS8",36,0 )
	32094	GETDLIST(R ESULT,SERV ER) ;
	32095	"RTN","HMP ROS8",37,0 )
	32096	N APPT,AR RAY,DFN,CN T,ERROR,GB L,GSOURCE, ISOUT,LIST IEN,LROOT, NAME,NODE, PATIENTS
	32097	"RTN","HMP ROS8",38,0 )
	32098	N PATTYPE ,PATUID,PI D,ROOM,ROO T,SOURCE,S OURCETYPE, TYPE,TYPEI ,HMPSRC,HM PSORT,HMPO UT
	32099	"RTN","HMP ROS8",39,0 )
	32100	N XOBDATA S XOBDATA (0)=1
	32101	"RTN","HMP ROS8",40,0 )
	32102	N XWBOS S XWBOS(0)= 1
	32103	"RTN","HMP ROS8",41,0 )
	32104	K ^TMP("O R",$J)
	32105	"RTN","HMP ROS8",42,0 )
	32106	S HMPSRC= $$LSTSRC(D UZ)
	32107	"RTN","HMP ROS8",43,0 )
	32108	S LISTIEN =$P(HMPSRC ,U,2),HMPS RC=$P(HMPS RC,U)
	32109	"RTN","HMP ROS8",44,0 )
	32110	D DEFSORT ^ORQPTQ11( .HMPSORT)
	32111	"RTN","HMP ROS8",45,0 )
	32112	D DEFLIST ^ORQPTQ11( .HMPOUT)
	32113	"RTN","HMP ROS8",46,0 )
	32114	S GSOURCE =$S(LISTIE N>0:$$STGS RCE(HMPSRC ,LISTIEN), 1:"")
	32115	"RTN","HMP ROS8",47,0 )
	32116	K ^TMP("H MPRESULT", $J),^TMP(" HMPTEMP",$ J),^TMP("H MPSORT",$J )
	32117	"RTN","HMP ROS8",48,0 )
	32118	S CNT=0 F S CNT=$O (^TMP("OR" ,$J,"PATIE NTS",CNT)) Q:CNT'>0 D
	32119	"RTN","HMP ROS8",49,0 )
	32120	.S NODE=$ G(^TMP("OR ",$J,"PATI ENTS",CNT, 0))
	32121	"RTN","HMP ROS8",50,0 )
	32122	.D BLDSOR T(NODE,HMP SRC,HMPSOR T,CNT)
	32123	"RTN","HMP ROS8",51,0 )
	32124	K ^TMP("O R",$J)
	32125	"RTN","HMP ROS8",52,0 )
	32126	D SRTSRC( HMPSORT,HM PSRC,$P($$ FDEFSRC^OR QPTQ11(DUZ ),U,2))
	32127	"RTN","HMP ROS8",53,0 )
	32128	S GBL=$NA (^TMP("HMP SORT",$J)) ,CNT=0,LRO OT=$L(GBL) -1,ROOT=$E (GBL,1,LRO OT)
	32129	"RTN","HMP ROS8",54,0 )
	32130	F S GBL= $Q(@GBL) Q :$E(GBL,1, LROOT)'=RO OT D
	32131	"RTN","HMP ROS8",55,0 )
	32132	.S NODE=@ GBL
	32133	"RTN","HMP ROS8",56,0 )
	32134	.S CNT=CN T+1
	32135	"RTN","HMP ROS8",57,0 )
	32136	.S DFN=$P (NODE,U),R OOM=$G(^DP T(DFN,.101 )) ;ICR 10 035 DE2818 ASF 11/12 /15
	32137	"RTN","HMP ROS8",58,0 )
	32138	.S PATIEN TS(DFN)=""
	32139	"RTN","HMP ROS8",59,0 )
	32140	.S PID=$$ PID^HMPDJF S(DFN)
	32141	"RTN","HMP ROS8",60,0 )
	32142	.S PATTYP E=$P(NODE, U,9)
	32143	"RTN","HMP ROS8",61,0 )
	32144	.S APPT=$ S(HMPSRC=" M":$P(NODE ,U,8),1:$P (NODE,U,4) ),TYPE=$P( NODE,U,3), TYPEI=$P(N ODE,U,7)
	32145	"RTN","HMP ROS8",62,0 )
	32146	.S SOURCE =$S($G(GSO URCE)'="": GSOURCE,1: $$GTSOURCE (TYPE,TYPE I))
	32147	"RTN","HMP ROS8",63,0 )
	32148	.S ISOUT= $S(PATTYPE ="OPT":1,1 :0)
	32149	"RTN","HMP ROS8",64,0 )
	32150	.I $P(NOD E,U,3)'="" S ^TMP("H MPTEMP",$J ,"data","p atients",C NT,"source DisplayNam e")=$P(NOD E,U,3)
	32151	"RTN","HMP ROS8",65,0 )
	32152	.S ^TMP(" HMPTEMP",$ J,"data"," patients", CNT,"pid") =PID
	32153	"RTN","HMP ROS8",66,0 )
	32154	.S ^TMP(" HMPTEMP",$ J,"data"," patients", CNT,"patie ntType")=$ S(PATTYPE= "OPT":"Out patient",1 :"Inpatien t")
	32155	"RTN","HMP ROS8",67,0 )
	32156	.I $G(APP T)'="" D S ETAPPT(SOU RCE,APPT,D FN,CNT)
	32157	"RTN","HMP ROS8",68,0 )
	32158	.;S ^TMP( "HMPTEMP", $J,"data", "patients" ,CNT,"appo intment")= $$JSONDT^H MPUTILS(AP PT)
	32159	"RTN","HMP ROS8",69,0 )
	32160	.I $G(ROO M)'=""!(PA TTYPE'="OP T") D STIN P(DFN,CNT, ROOM)
	32161	"RTN","HMP ROS8",70,0 )
	32162	.;S ^TMP( "HMPTEMP", $J,"data", "patients" ,CNT,"room Bed")=ROOM
	32163	"RTN","HMP ROS8",71,0 )
	32164	.D STPTSR C(SOURCE,C NT)
	32165	"RTN","HMP ROS8",72,0 )
	32166	;
	32167	"RTN","HMP ROS8",73,0 )
	32168	GETDLSTX ;
	32169	"RTN","HMP ROS8",74,0 )
	32170	D ENCODE^ HMPJSON($N A(^TMP("HM PTEMP",$J) ),"RESULT" ,"ERROR")
	32171	"RTN","HMP ROS8",75,0 )
	32172	I SERVER' ="" D CHKP AT(.PATIEN TS,SERVER)
	32173	"RTN","HMP ROS8",76,0 )
	32174	K ^TMP("H MPSORT",$J )
	32175	"RTN","HMP ROS8",77,0 )
	32176	K ^TMP("H MPTEMP",$J )
	32177	"RTN","HMP ROS8",78,0 )
	32178	Q
	32179	"RTN","HMP ROS8",79,0 )
	32180	;
	32181	"RTN","HMP ROS8",80,0 )
	32182	SETAPPT(SO URCE,APPT, DFN,CNT) ;
	32183	"RTN","HMP ROS8",81,0 )
	32184	N LOC,UID ,X
	32185	"RTN","HMP ROS8",82,0 )
	32186	S ^TMP("H MPTEMP",$J ,"data","p atients",C NT,"appoin tment")=$$ JSONDT^HMP UTILS(APPT )
	32187	"RTN","HMP ROS8",83,0 )
	32188	S UID=$P( SOURCE,U,2 ),LOC=$P($ G(UID),":" ,5) I LOC' >0 Q
	32189	"RTN","HMP ROS8",84,0 )
	32190	S X="A;"_ APPT_";"_+ LOC
	32191	"RTN","HMP ROS8",85,0 )
	32192	S ^TMP("H MPTEMP",$J ,"data","p atients",C NT,"appoin tmentUid") =$$SETUID^ HMPUTILS(" appointmen t",DFN,X)
	32193	"RTN","HMP ROS8",86,0 )
	32194	Q
	32195	"RTN","HMP ROS8",87,0 )
	32196	;
	32197	"RTN","HMP ROS8",88,0 )
	32198	STINP(DFN, CNT,ROOM) ;
	32199	"RTN","HMP ROS8",89,0 )
	32200	N LOC,NOD E,UID,VAIN ,WIEN
	32201	"RTN","HMP ROS8",90,0 )
	32202	I ROOM'=" " S ^TMP(" HMPTEMP",$ J,"data"," patients", CNT,"roomB ed")=ROOM
	32203	"RTN","HMP ROS8",91,0 )
	32204	D INP^VAD PT I $G(VA IN(1))="" D KVA^VADP T Q
	32205	"RTN","HMP ROS8",92,0 )
	32206	S ^TMP("H MPTEMP",$J ,"data","p atients",C NT,"admiss ionUid")=$ $SETUID^HM PUTILS("vi sit",DFN," H"_VAIN(1) )
	32207	"RTN","HMP ROS8",93,0 )
	32208	S WIEN=+$ G(VAIN(4)) I WIEN'>0 D KVA^VAD PT Q
	32209	"RTN","HMP ROS8",94,0 )
	32210	S LOC=+$G (^DIC(42,W IEN,44)) ; ICR 10040 DE2818 ASF 11/12/15
	32211	"RTN","HMP ROS8",95,0 )
	32212	S NODE=$P ($G(^SC(+L OC,0)),U,1 ,2) ;ICR 1 0040 DE281 8 ASF 11/1 2/15
	32213	"RTN","HMP ROS8",96,0 )
	32214	S ^TMP("H MPTEMP",$J ,"data","p atients",C NT,"locati onUid")=$$ SETUID^HMP UTILS("loc ation","", LOC,"")
	32215	"RTN","HMP ROS8",97,0 )
	32216	I $P(NODE ,U)'="" S ^TMP("HMPT EMP",$J,"d ata","pati ents",CNT, "locationN ame")=$P(N ODE,U)
	32217	"RTN","HMP ROS8",98,0 )
	32218	I $P(NODE ,U,2)'="" S ^TMP("HM PTEMP",$J, "data","pa tients",CN T,"locatio nShortName ")=$P(NODE ,U,2)
	32219	"RTN","HMP ROS8",99,0 )
	32220	D KVA^VAD PT
	32221	"RTN","HMP ROS8",100, 0)
	32222	Q
	32223	"RTN","HMP ROS8",101, 0)
	32224	;
	32225	"RTN","HMP ROS8",102, 0)
	32226	STPTSRC(SO URCE,CNT) ;
	32227	"RTN","HMP ROS8",103, 0)
	32228	N UID,VAI N
	32229	"RTN","HMP ROS8",104, 0)
	32230	S UID=$P( SOURCE,U,2 )
	32231	"RTN","HMP ROS8",105, 0)
	32232	S ^TMP("H MPTEMP",$J ,"data","p atients",C NT,"source Uid")=UID
	32233	"RTN","HMP ROS8",106, 0)
	32234	I UID'["l ocation" Q
	32235	"RTN","HMP ROS8",107, 0)
	32236	S ^TMP("H MPTEMP",$J ,"data","p atients",C NT,"locati onUid")=UI D
	32237	"RTN","HMP ROS8",108, 0)
	32238	I $P(SOUR CE,U,3)'=" " S ^TMP(" HMPTEMP",$ J,"data"," patients", CNT,"sourc eName")=$P (SOURCE,U, 3),^TMP("H MPTEMP",$J ,"data","p atients",C NT,"locati onName")=$ P(SOURCE,U ,3)
	32239	"RTN","HMP ROS8",109, 0)
	32240	I $P(SOUR CE,U,4)'=" " S ^TMP(" HMPTEMP",$ J,"data"," patients", CNT,"sourc eShortName ")=$P(SOUR CE,U,4),^T MP("HMPTEM P",$J,"dat a","patien ts",CNT,"l ocationSho rtName")=$ P(SOURCE,U ,4)
	32241	"RTN","HMP ROS8",110, 0)
	32242	Q
	32243	"RTN","HMP ROS8",111, 0)
	32244	;
	32245	"RTN","HMP ROS8",112, 0)
	32246	LSTSRC(ADU Z) ; Retur n type of list sourc e
	32247	"RTN","HMP ROS8",113, 0)
	32248	; T:TeamL ist, W:War d List, P: Provider L ist, S:Spe cialty Lis t, C:Clini c List, M: Combinatio n
	32249	"RTN","HMP ROS8",114, 0)
	32250	N FROM,IE N,SRV
	32251	"RTN","HMP ROS8",115, 0)
	32252	S:'$G(ADU Z) ADUZ=DU Z
	32253	"RTN","HMP ROS8",116, 0)
	32254	S SRV=$G( ^VA(200,AD UZ,5)) I + SRV>0 S SR V=$P(SRV,U ) ;ICR 100 60 DE2818 ASF 11/12/ 15
	32255	"RTN","HMP ROS8",117, 0)
	32256	S FROM=$$ GET^XPAR(" USR.`"_ADU Z_"^SRV.`" _+$G(SRV), "ORLP DEFA ULT LIST S OURCE",1," Q")
	32257	"RTN","HMP ROS8",118, 0)
	32258	I FROM="M " Q FROM
	32259	"RTN","HMP ROS8",119, 0)
	32260	I FROM="T " S IEN=$$ GET^XPAR(" USR^SRV.`" _+$G(SRV), "ORLP DEFA ULT TEAM", 1,"Q") Q F ROM_U_+$G( IEN)
	32261	"RTN","HMP ROS8",120, 0)
	32262	I FROM="W " S IEN=$$ GET^XPAR(" USR^SRV.`" _+$G(SRV), "ORLP DEFA ULT WARD", 1,"Q") Q F ROM_U_+$G( IEN)
	32263	"RTN","HMP ROS8",121, 0)
	32264	I FROM="P " S IEN=$$ GET^XPAR(" USR^SRV.`" _+$G(SRV), "ORLP DEFA ULT PROVID ER",1,"Q") Q FROM_U_ +$G(IEN)
	32265	"RTN","HMP ROS8",122, 0)
	32266	I FROM="S " S IEN=$$ GET^XPAR(" USR^SRV.`" _+$G(SRV), "ORLP DEFA ULT SPECIA LTY",1,"Q" ) Q FROM_U _+$G(IEN)
	32267	"RTN","HMP ROS8",123, 0)
	32268	I FROM="C " S API="O RLP DEFAUL T CLINIC " _$$UP^XLFS TR($$DOW^X LFDT(DT)), IEN=$$GET^ XPAR("USR^ SRV.`"_+$G (ORSRV),AP I,1,"Q") Q FROM_U_+$ G(IEN)
	32269	"RTN","HMP ROS8",124, 0)
	32270	Q FROM
	32271	"RTN","HMP ROS8",125, 0)
	32272	;
	32273	"RTN","HMP ROS8",126, 0)
	32274	GETCLIST(R ESULT,SERV ER,ID,STAR T,END) ;
	32275	"RTN","HMP ROS8",127, 0)
	32276	N APPT,CN T,DFN,ITR, NODE,PATIE NTS,PID,SO URCE,TEMP, ERROR,HMPA RRAY,HMPSO RT,S
	32277	"RTN","HMP ROS8",128, 0)
	32278	K ^TMP("H MPTEMP",$J )
	32279	"RTN","HMP ROS8",129, 0)
	32280	D DEFSORT ^ORQPTQ11( .HMPSORT)
	32281	"RTN","HMP ROS8",130, 0)
	32282	D CLINPTS 2^ORQPTQ2( .HMPARRAY, ID,START,E ND)
	32283	"RTN","HMP ROS8",131, 0)
	32284	S SOURCE= $$GTSOURCE ("Cl",ID)
	32285	"RTN","HMP ROS8",132, 0)
	32286	S S=" " ; separator for sort
	32287	"RTN","HMP ROS8",133, 0)
	32288	S CNT=0 F S CNT=$O (HMPARRAY( CNT)) Q:CN T'>0 D
	32289	"RTN","HMP ROS8",134, 0)
	32290	. S NODE= $G(HMPARRA Y(CNT))
	32291	"RTN","HMP ROS8",135, 0)
	32292	. Q:$E(NO DE)=U ; i .e., "^No appointmen ts"
	32293	"RTN","HMP ROS8",136, 0)
	32294	. I HMPSO RT="P" S T EMP($P(NOD E,U,4)_S_C NT)=NODE Q
	32295	"RTN","HMP ROS8",137, 0)
	32296	. S TEMP( $P(NODE,U, 2)_S_$P(NO DE,U,4)_S_ CNT)=NODE
	32297	"RTN","HMP ROS8",138, 0)
	32298	S CNT=0,I TR="" F S ITR=$O(TE MP(ITR)) Q :ITR="" D
	32299	"RTN","HMP ROS8",139, 0)
	32300	. S NODE= TEMP(ITR), CNT=CNT+1
	32301	"RTN","HMP ROS8",140, 0)
	32302	. S DFN=$ P(NODE,U), APPT=$P(NO DE,U,4)
	32303	"RTN","HMP ROS8",141, 0)
	32304	. S PATIE NTS(DFN)=" ",PID=$$PI D^HMPDJFS( DFN)
	32305	"RTN","HMP ROS8",142, 0)
	32306	. S ^TMP( "HMPTEMP", $J,"data", "patients" ,CNT,"pid" )=PID
	32307	"RTN","HMP ROS8",143, 0)
	32308	. S ^TMP( "HMPTEMP", $J,"data", "patients" ,CNT,"pati entType")= $S($P(NODE ,U,9)="OPT ":"Outpati ent",1:"In patient")
	32309	"RTN","HMP ROS8",144, 0)
	32310	. I $G(AP PT)'="" D SETAPPT(SO URCE,APPT, DFN,CNT)
	32311	"RTN","HMP ROS8",145, 0)
	32312	. ;S ^TMP ("HMPTEMP" ,$J,"data" ,"patients ",CNT,"app ointment") =$$JSONDT^ HMPUTILS(A PPT)
	32313	"RTN","HMP ROS8",146, 0)
	32314	D SRTSRC( HMPSORT,"C ",$P($G(^S C(ID,0)),U )) ;ICR 10 040 DE2818 ASF 11/12 /15
	32315	"RTN","HMP ROS8",147, 0)
	32316	D ENCODE^ HMPJSON($N A(^TMP("HM PTEMP",$J) ),"RESULT" ,"ERROR")
	32317	"RTN","HMP ROS8",148, 0)
	32318	;I SERVER '="" D CHK PAT(.PATIE NTS,SERVER ) ; S68-JCH
	32319	"RTN","HMP ROS8",149, 0)
	32320	Q
	32321	"RTN","HMP ROS8",150, 0)
	32322	;
	32323	"RTN","HMP ROS8",151, 0)
	32324	GTSOURCE(T YPE,INT) ;
	32325	"RTN","HMP ROS8",152, 0)
	32326	N REC,RES ULT,SPEC,S PECTYPE,UI D
	32327	"RTN","HMP ROS8",153, 0)
	32328	S SPEC=$P (TYPE," ")
	32329	"RTN","HMP ROS8",154, 0)
	32330	S SPECTYP E=$S(SPEC= "Cl":"Clin ic",SPEC=" Wd":"Ward" ,SPEC="Sp" :"Treating Specality ",SPEC="Pr ":"Provide r",SPEC="T m":"OR Tea m",1:SPEC)
	32331	"RTN","HMP ROS8",155, 0)
	32332	I SPECTYP E=SPEC Q S PEC_U_""
	32333	"RTN","HMP ROS8",156, 0)
	32334	I SPECTYP E="Ward" S REC=+$G(^ DIC(42,INT ,44)) I RE C'=INT S I NT=REC ;IC R 10039 DE 2818 ASF 1 1/12/15
	32335	"RTN","HMP ROS8",157, 0)
	32336	S UID=$$S ETUID^HMPU TILS($S(SP EC="Cl":"l ocation",S PEC="Wd":" location", SPEC="Sp": "treatingS pecialty", SPEC="Pr": "provider" ,SPEC="Tm" :"orTeam", 1:SPEC),"" ,INT,"")
	32337	"RTN","HMP ROS8",158, 0)
	32338	S RESULT= SPECTYPE_U _UID
	32339	"RTN","HMP ROS8",159, 0)
	32340	I UID["lo cation" S RESULT=RES ULT_U_$P($ G(^SC(+INT ,0)),U,1,2 )
	32341	"RTN","HMP ROS8",160, 0)
	32342	Q RESULT
	32343	"RTN","HMP ROS8",161, 0)
	32344	;
	32345	"RTN","HMP ROS8",162, 0)
	32346	STGSRCE(SP EC,INT) ;
	32347	"RTN","HMP ROS8",163, 0)
	32348	N REC,RES ULT,SPECTY PE,UID
	32349	"RTN","HMP ROS8",164, 0)
	32350	;T:TeamLi st, W:Ward List, P:P rovider Li st, S:Spec ialty List , C:Clinic List, M:C ombination
	32351	"RTN","HMP ROS8",165, 0)
	32352	S RESULT= ""
	32353	"RTN","HMP ROS8",166, 0)
	32354	I "TWPSC" '[SPEC Q R ESULT
	32355	"RTN","HMP ROS8",167, 0)
	32356	S SPECTYP E=$S(SPEC= "C":"Clini c",SPEC="W ":"Ward",S PEC="S":"T reating Sp ecality",S PEC="P":"P rovider",S PEC="T":"O R Team",1: SPEC) I SP ECTYPE=SPE C Q RESULT
	32357	"RTN","HMP ROS8",168, 0)
	32358	I SPECTYP E="Ward" S REC=+$G(^ DIC(42,INT ,44)) I RE C'=INT S I NT=REC ;IC R 10039 DE 2818 ASF 1 1/12/15
	32359	"RTN","HMP ROS8",169, 0)
	32360	S UID=$$S ETUID^HMPU TILS($S(SP EC="C":"lo cation",SP EC="W":"lo cation",SP EC="S":"tr eatingSpec ialty",SPE C="P":"pro vider",SPE C="T":"orT eam",1:SPE C),"",INT, "")
	32361	"RTN","HMP ROS8",170, 0)
	32362	S RESULT= SPECTYPE_U _UID
	32363	"RTN","HMP ROS8",171, 0)
	32364	I UID["lo cation" S RESULT=RES ULT_U_$P($ G(^SC(+INT ,0)),U,1,2 ) ;ICR 100 60 DE2818 ASF 11/12/ 15
	32365	"RTN","HMP ROS8",172, 0)
	32366	Q RESULT
	32367	"RTN","HMP ROS8",173, 0)
	32368	;
	32369	"RTN","HMP ROS8",174, 0)
	32370	GETWLIST(R ESULT,SERV ER,ID) ;
	32371	"RTN","HMP ROS8",175, 0)
	32372	N CNT,DFN ,ITR,NODE, PATIENTS,P ID,ROOM,TE MP,WARD,ER ROR,HMPARR AY,HMPSORT
	32373	"RTN","HMP ROS8",176, 0)
	32374	K ^TMP("H MPTEMP",$J )
	32375	"RTN","HMP ROS8",177, 0)
	32376	D DEFSORT ^ORQPTQ11( .HMPSORT)
	32377	"RTN","HMP ROS8",178, 0)
	32378	D BYWARD^ ORWPT(.HMP ARRAY,ID)
	32379	"RTN","HMP ROS8",179, 0)
	32380	S CNT=0 F S CNT=$O (HMPARRAY( CNT)) Q:CN T'>0 D
	32381	"RTN","HMP ROS8",180, 0)
	32382	. S NODE= $G(HMPARRA Y(CNT))
	32383	"RTN","HMP ROS8",181, 0)
	32384	. Q:$E(NO DE)=U ; i .e., "^No patients f ound"
	32385	"RTN","HMP ROS8",182, 0)
	32386	. I HMPSO RT="R" S T EMP($P(NOD E,U,3)_" " _CNT)=NODE Q
	32387	"RTN","HMP ROS8",183, 0)
	32388	. S TEMP( $P(NODE,U, 2)_" "_CNT )=NODE
	32389	"RTN","HMP ROS8",184, 0)
	32390	S ITR="", CNT=0 F S ITR=$O(TE MP(ITR)) Q :ITR="" D
	32391	"RTN","HMP ROS8",185, 0)
	32392	.S NODE=T EMP(ITR),C NT=CNT+1
	32393	"RTN","HMP ROS8",186, 0)
	32394	.S DFN=$P (NODE,U),R OOM=$P(NOD E,U,3)
	32395	"RTN","HMP ROS8",187, 0)
	32396	.S PATIEN TS(DFN)="" ,PID=$$PID ^HMPDJFS(D FN)
	32397	"RTN","HMP ROS8",188, 0)
	32398	.S ^TMP(" HMPTEMP",$ J,"data"," patients", CNT,"pid") =PID
	32399	"RTN","HMP ROS8",189, 0)
	32400	.D STINP( DFN,CNT,RO OM)
	32401	"RTN","HMP ROS8",190, 0)
	32402	.;S ^TMP( "HMPTEMP", $J,"data", "patients" ,CNT,"room Bed")=ROOM
	32403	"RTN","HMP ROS8",191, 0)
	32404	D SRTSRC( HMPSORT,"W ",$P($G(^D IC(42,ID,0 )),U)) ;IC R 10039 DE 2818 ASF 1 1/12/15
	32405	"RTN","HMP ROS8",192, 0)
	32406	D ENCODE^ HMPJSON($N A(^TMP("HM PTEMP",$J) ),"RESULT" ,"ERROR")
	32407	"RTN","HMP ROS8",193, 0)
	32408	;I SERVER '="" D CHK PAT(.PATIE NTS,SERVER ) ; S68-JCH
	32409	"RTN","HMP ROS8",194, 0)
	32410	Q
	32411	"RTN","HMP ROS8",195, 0)
	32412	SRTSRC(SOR T,SRCTYPE, SRCNAME) ; Set sort type, sour ce type, s ource name
	32413	"RTN","HMP ROS8",196, 0)
	32414	S ^TMP("H MPTEMP",$J ,"data","d efaultPati entListSou rceType")= SRCTYPE
	32415	"RTN","HMP ROS8",197, 0)
	32416	S ^TMP("H MPTEMP",$J ,"data","d efaultPati entListSou rceName")= SRCNAME
	32417	"RTN","HMP ROS8",198, 0)
	32418	S ^TMP("H MPTEMP",$J ,"data","d efaultPati entListSou rceSort")= SORT
	32419	"RTN","HMP ROS8",199, 0)
	32420	Q
	32421	"RTN","HMP SR")
	32422	1^189
	32423	"RTN","HMP STMP")
	32424	0^122^B704 61106
	32425	"RTN","HMP STMP",1,0)
	32426	HMPSTMP ;A SMR/JD,BL - MetaStam p ;Feb 01, 2016 12:1 0
	32427	"RTN","HMP STMP",2,0)
	32428	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	32429	"RTN","HMP STMP",3,0)
	32430	;Per VA D irective 6 402, this routine sh ould not b e modified .
	32431	"RTN","HMP STMP",4,0)
	32432	;
	32433	"RTN","HMP STMP",5,0)
	32434	; Returns the most recent dat e/time
	32435	"RTN","HMP STMP",6,0)
	32436	; JD - 6/ 5/15 - Add ed code to the DOC s ection to consider t he attachm ent date
	32437	"RTN","HMP STMP",7,0)
	32438	; as one of the dates if it exists
	32439	"RTN","HMP STMP",8,0)
	32440	Q
	32441	"RTN","HMP STMP",9,0)
	32442	;
	32443	"RTN","HMP STMP",10,0 )
	32444	EN(A) ; ex trinsic fu nction, us ed to crea te "stampT ime" or "l astUpdateT ime" subsc ript in ar rays
	32445	"RTN","HMP STMP",11,0 )
	32446	K B
	32447	"RTN","HMP STMP",12,0 )
	32448	N C
	32449	"RTN","HMP STMP",13,0 )
	32450	; A is ei ther "now" or a doma in name (p er PTDOMS^ HMPDJFSD)
	32451	"RTN","HMP STMP",14,0 )
	32452	; B is th e return v alue (stam pTime)
	32453	"RTN","HMP STMP",15,0 )
	32454	S C=$$UP^ XLFSTR(A)
	32455	"RTN","HMP STMP",16,0 )
	32456	I C="NOW" G NOW
	32457	"RTN","HMP STMP",17,0 )
	32458	I C="ADM" G ADM
	32459	"RTN","HMP STMP",18,0 )
	32460	I C="ALLE RGY" G ALL
	32461	"RTN","HMP STMP",19,0 )
	32462	I C="AUXI LIARY" G A UX
	32463	"RTN","HMP STMP",20,0 )
	32464	I C="APPO INTMENT" G APP
	32465	"RTN","HMP STMP",21,0 )
	32466	I C="DIAG NOSIS" G D IA
	32467	"RTN","HMP STMP",22,0 )
	32468	I C="DOCU MENT" G DO C
	32469	"RTN","HMP STMP",23,0 )
	32470	I C="FACT OR" G FAC
	32471	"RTN","HMP STMP",24,0 )
	32472	I C="IMMU NIZATION" G IMM
	32473	"RTN","HMP STMP",25,0 )
	32474	I C="LAB" G LAB
	32475	"RTN","HMP STMP",26,0 )
	32476	I C="MED" G MED
	32477	"RTN","HMP STMP",27,0 )
	32478	I C="OBS" G OBS
	32479	"RTN","HMP STMP",28,0 )
	32480	I C="ORDE R" G ORD
	32481	"RTN","HMP STMP",29,0 )
	32482	I C="PROB LEM" G PRO
	32483	"RTN","HMP STMP",30,0 )
	32484	I C="PROC EDURE" G P RC
	32485	"RTN","HMP STMP",31,0 )
	32486	I C="CONS ULT" G CON
	32487	"RTN","HMP STMP",32,0 )
	32488	I C="IMAG E" G IMA
	32489	"RTN","HMP STMP",33,0 )
	32490	I C="SURG ERY" G SUR
	32491	"RTN","HMP STMP",34,0 )
	32492	I C="TASK " G TAS
	32493	"RTN","HMP STMP",35,0 )
	32494	I C="VISI T" G VIS
	32495	"RTN","HMP STMP",36,0 )
	32496	I C="VITA L" G VIT
	32497	"RTN","HMP STMP",37,0 )
	32498	I C="PTF" G PTF
	32499	"RTN","HMP STMP",38,0 )
	32500	I C="EXAM " G EXA
	32501	"RTN","HMP STMP",39,0 )
	32502	I C="CPT" G CPT
	32503	"RTN","HMP STMP",40,0 )
	32504	I C="EDUC ATION" G E DU
	32505	"RTN","HMP STMP",41,0 )
	32506	I C="POV" G POV
	32507	"RTN","HMP STMP",42,0 )
	32508	I C="SKIN " G SKI
	32509	"RTN","HMP STMP",43,0 )
	32510	I C="TREA TMENT" G T RE
	32511	"RTN","HMP STMP",44,0 )
	32512	I C="MH" G MH
	32513	"RTN","HMP STMP",45,0 )
	32514	;
	32515	"RTN","HMP STMP",46,0 )
	32516	;DE2818, changed co de to fall through i nstead of "Q B", whi ch would b e undefine d at this point
	32517	"RTN","HMP STMP",47,0 )
	32518	;fall thr ough to NO W
	32519	"RTN","HMP STMP",48,0 )
	32520	NOW ;
	32521	"RTN","HMP STMP",49,0 )
	32522	; Set sta mp time in YYYYMMDDH HMMSS form at (FMTHL7 will retu rn time zo ne)
	32523	"RTN","HMP STMP",50,0 )
	32524	S B=$P($$ FMTHL7^XLF DT($$NOW^X LFDT),"-")
	32525	"RTN","HMP STMP",51,0 )
	32526	S B=$E(B_ "000000",1 ,14) ; Ne ed padding to force YYYYMMDDHH MMSS preci sion
	32527	"RTN","HMP STMP",52,0 )
	32528	Q B
	32529	"RTN","HMP STMP",53,0 )
	32530	ADM ; Admi ssions (th ese are vi sits whose ID starts with an " H"). JD - January 2 6, 2015
	32531	"RTN","HMP STMP",54,0 )
	32532	K DATA
	32533	"RTN","HMP STMP",55,0 )
	32534	S DATE(1) =$G(ADM("d ateTime"))
	32535	"RTN","HMP STMP",56,0 )
	32536	S DATE(2) =$G(ADM("s tay","disc hargeDateT ime"))
	32537	"RTN","HMP STMP",57,0 )
	32538	;DETERMIN E WHICH ON E IS NEWER
	32539	"RTN","HMP STMP",58,0 )
	32540	Q $$FINDN EW(.DATE)
	32541	"RTN","HMP STMP",59,0 )
	32542	ALL ; Alle rgy ; rhl 20141231
	32543	"RTN","HMP STMP",60,0 )
	32544	K DATE
	32545	"RTN","HMP STMP",61,0 )
	32546	S DATE(1) =$G(REAC(" entered"))
	32547	"RTN","HMP STMP",62,0 )
	32548	S DATE(2) =$G(REAC(" verified") )
	32549	"RTN","HMP STMP",63,0 )
	32550	; dates in observa tions arra y
	32551	"RTN","HMP STMP",64,0 )
	32552	N I,J
	32553	"RTN","HMP STMP",65,0 )
	32554	S J="",J= $O(DATE(J) ,-1)
	32555	"RTN","HMP STMP",66,0 )
	32556	S I=0
	32557	"RTN","HMP STMP",67,0 )
	32558	F S I=$O (REAC("obs ervations" ,I)) Q:I=" " D
	32559	"RTN","HMP STMP",68,0 )
	32560	. I $G(RE AC("observ ations",I, "date"))]" " S J=J+1, DATE(J)=RE AC("observ ations",I, "date")
	32561	"RTN","HMP STMP",69,0 )
	32562	; dates in comment array
	32563	"RTN","HMP STMP",70,0 )
	32564	N I,J
	32565	"RTN","HMP STMP",71,0 )
	32566	S J="",J= $O(DATE(J) ,-1)
	32567	"RTN","HMP STMP",72,0 )
	32568	S I=0
	32569	"RTN","HMP STMP",73,0 )
	32570	F S I=$O (REAC("com ments",I)) Q:I="" D
	32571	"RTN","HMP STMP",74,0 )
	32572	. I $G(RE AC("commen ts",I,"ent ered"))]"" S J=J+1,D ATE(J)=REA C("comment s",I,"ente red")
	32573	"RTN","HMP STMP",75,0 )
	32574	;DETERMIN E WHICH ON E IS NEWER
	32575	"RTN","HMP STMP",76,0 )
	32576	Q $$FINDN EW(.DATE)
	32577	"RTN","HMP STMP",77,0 )
	32578	AUX ; Auxi liary
	32579	"RTN","HMP STMP",78,0 )
	32580	Q ""
	32581	"RTN","HMP STMP",79,0 )
	32582	K DATE
	32583	"RTN","HMP STMP",80,0 )
	32584	;S DATE(1 )=$G(
	32585	"RTN","HMP STMP",81,0 )
	32586	;DETERMIN E WHICH ON E IS NEWER
	32587	"RTN","HMP STMP",82,0 )
	32588	Q $$FINDN EW(.DATE)
	32589	"RTN","HMP STMP",83,0 )
	32590	APP ; Appo intment
	32591	"RTN","HMP STMP",84,0 )
	32592	K DATE
	32593	"RTN","HMP STMP",85,0 )
	32594	S DATE(1) =$G(APPT(" dateTime") )
	32595	"RTN","HMP STMP",86,0 )
	32596	S DATE(2) =$G(APPT(" checkIn"))
	32597	"RTN","HMP STMP",87,0 )
	32598	S DATE(3) =$G(APPT(" checkOut") )
	32599	"RTN","HMP STMP",88,0 )
	32600	;DETERMIN E WHICH ON E IS NEWER
	32601	"RTN","HMP STMP",89,0 )
	32602	Q $$FINDN EW(.DATE)
	32603	"RTN","HMP STMP",90,0 )
	32604	DIA ; Diag nosis
	32605	"RTN","HMP STMP",91,0 )
	32606	Q ""
	32607	"RTN","HMP STMP",92,0 )
	32608	K DATE
	32609	"RTN","HMP STMP",93,0 )
	32610	;S DATE(1 )=$G(
	32611	"RTN","HMP STMP",94,0 )
	32612	;DETERMIN E WHICH ON E IS NEWER
	32613	"RTN","HMP STMP",95,0 )
	32614	Q $$FINDN EW(.DATE)
	32615	"RTN","HMP STMP",96,0 )
	32616	DOC ; Docu ment
	32617	"RTN","HMP STMP",97,0 )
	32618	N AUDDT
	32619	"RTN","HMP STMP",98,0 )
	32620	S AUDDT=" " ; Audit trail dat e/time
	32621	"RTN","HMP STMP",99,0 )
	32622	K DATE
	32623	"RTN","HMP STMP",100, 0)
	32624	S DATE(1) =$G(DOC("r eferenceDa teTime"))
	32625	"RTN","HMP STMP",101, 0)
	32626	S DATE(2) =$G(DOC("e ntered"))
	32627	"RTN","HMP STMP",102, 0)
	32628	;DE2818, ^TIU(8925. 5) referen ces - ICR 6279
	32629	"RTN","HMP STMP",103, 0)
	32630	; Find th e most rec ent audit trail entr y for the document
	32631	"RTN","HMP STMP",104, 0)
	32632	S:$G(DOC( "localId") ) AUDDT=$O (^TIU(8925 .5,"B",DOC ("localId" ),""),-1)
	32633	"RTN","HMP STMP",105, 0)
	32634	; Get the audit tra il date/ti me
	32635	"RTN","HMP STMP",106, 0)
	32636	S:AUDDT A UDDT=$P($G (^TIU(8925 .5,AUDDT,3 )),"^",2)
	32637	"RTN","HMP STMP",107, 0)
	32638	S:AUDDT D ATE(3)=$$J SONDT^HMPU TILS(AUDDT )
	32639	"RTN","HMP STMP",108, 0)
	32640	;go throu gh HMPDJ a rray
	32641	"RTN","HMP STMP",109, 0)
	32642	N I,II,J
	32643	"RTN","HMP STMP",110, 0)
	32644	S J=""
	32645	"RTN","HMP STMP",111, 0)
	32646	S J=$O(DA TE(J),-1)
	32647	"RTN","HMP STMP",112, 0)
	32648	S I=0
	32649	"RTN","HMP STMP",113, 0)
	32650	F S I=$O (DOC("text ",I)) Q:I= "" D
	32651	"RTN","HMP STMP",114, 0)
	32652	. I $G(DO C("text",I ,"dateTime "))]"" S J =J+1,DATE( J)=DOC("te xt",I,"dat eTime")
	32653	"RTN","HMP STMP",115, 0)
	32654	. S II=0 F S II=$O (DOC("text ",I,"clini cians",II) ) Q:II="" D
	32655	"RTN","HMP STMP",116, 0)
	32656	. . I $G( DOC("text" ,I,"clinic ians",II," signedDate Time"))]"" S J=J+1,D ATE(J)=DOC ("text",I, "clinician s",II,"sig nedDateTim e")
	32657	"RTN","HMP STMP",117, 0)
	32658	;DETERMIN E WHICH ON E IS NEWER
	32659	"RTN","HMP STMP",118, 0)
	32660	Q $$FINDN EW(.DATE)
	32661	"RTN","HMP STMP",119, 0)
	32662	FAC ; Fact or
	32663	"RTN","HMP STMP",120, 0)
	32664	K DATE
	32665	"RTN","HMP STMP",121, 0)
	32666	S DATE(1) =$G(PCE("e ntered"))
	32667	"RTN","HMP STMP",122, 0)
	32668	;DETERMIN E WHICH ON E IS NEWER
	32669	"RTN","HMP STMP",123, 0)
	32670	Q $$FINDN EW(.DATE)
	32671	"RTN","HMP STMP",124, 0)
	32672	IMM ; Immu nization
	32673	"RTN","HMP STMP",125, 0)
	32674	K DATE
	32675	"RTN","HMP STMP",126, 0)
	32676	S DATE(1) =$G(PCE("a dministere dDateTime" ))
	32677	"RTN","HMP STMP",127, 0)
	32678	;DETERMIN E WHICH ON E IS NEWER
	32679	"RTN","HMP STMP",128, 0)
	32680	Q $$FINDN EW(.DATE)
	32681	"RTN","HMP STMP",129, 0)
	32682	LAB ; Lab
	32683	"RTN","HMP STMP",130, 0)
	32684	K DATE
	32685	"RTN","HMP STMP",131, 0)
	32686	S DATE(1) =$G(LAB("o bserved"))
	32687	"RTN","HMP STMP",132, 0)
	32688	S DATE(2) =$G(LAB("r esulted"))
	32689	"RTN","HMP STMP",133, 0)
	32690	;DETERMIN E WHICH ON E IS NEWER
	32691	"RTN","HMP STMP",134, 0)
	32692	Q $$FINDN EW(.DATE)
	32693	"RTN","HMP STMP",135, 0)
	32694	MED ; Med
	32695	"RTN","HMP STMP",136, 0)
	32696	K DATE
	32697	"RTN","HMP STMP",137, 0)
	32698	S DATE(1) =$G(MED("o rders",1," ordered"))
	32699	"RTN","HMP STMP",138, 0)
	32700	S DATE(2) =$G(MED("o verallStar t"))
	32701	"RTN","HMP STMP",139, 0)
	32702	S DATE(3) =$G(MED("o verallStop "))
	32703	"RTN","HMP STMP",140, 0)
	32704	S DATE(4) =$G(MED("s topped"))
	32705	"RTN","HMP STMP",141, 0)
	32706	S DATE(5) =$G(MED("l astFilled" ))
	32707	"RTN","HMP STMP",142, 0)
	32708	;go throu gh value a rray
	32709	"RTN","HMP STMP",143, 0)
	32710	N I,J
	32711	"RTN","HMP STMP",144, 0)
	32712	S J="",J= $O(DATE(J) ,-1)
	32713	"RTN","HMP STMP",145, 0)
	32714	S I=0
	32715	"RTN","HMP STMP",146, 0)
	32716	F S I=$O (MED("dosa ges",I)) Q :I="" D
	32717	"RTN","HMP STMP",147, 0)
	32718	. I $G(ME D("dosages ",I,"start "))]"" S J =J+1,DATE( J)=MED("do sages",I," start")
	32719	"RTN","HMP STMP",148, 0)
	32720	. I $G(ME D("dosages ",I,"stop" ))]"" S J= J+1,DATE(J )=MED("dos ages",I,"s top")
	32721	"RTN","HMP STMP",149, 0)
	32722	S J="",J= $O(DATE(J) ,-1)
	32723	"RTN","HMP STMP",150, 0)
	32724	S I=0
	32725	"RTN","HMP STMP",151, 0)
	32726	F S I=$O (MED("fill s",I)) Q:I ="" D
	32727	"RTN","HMP STMP",152, 0)
	32728	. I $G(ME D("fills", I,"dispens eDate"))]" " S J=J+1, DATE(J)=ME D("fills", I,"dispens eDate")
	32729	"RTN","HMP STMP",153, 0)
	32730	. I $G(ME D("fills", I,"release Date"))]"" S J=J+1,D ATE(J)=MED ("fills",I ,"releaseD ate")
	32731	"RTN","HMP STMP",154, 0)
	32732	;DETERMIN E WHICH ON E IS NEWER
	32733	"RTN","HMP STMP",155, 0)
	32734	Q $$FINDN EW(.DATE)
	32735	"RTN","HMP STMP",156, 0)
	32736	OBS ; Obs ; rhl 2014 1231
	32737	"RTN","HMP STMP",157, 0)
	32738	K DATE
	32739	"RTN","HMP STMP",158, 0)
	32740	S DATE(1) =$G(CLIO(" entered"))
	32741	"RTN","HMP STMP",159, 0)
	32742	S DATE(2) =$G(CLIO(" observed") )
	32743	"RTN","HMP STMP",160, 0)
	32744	S DATE(3) =$G(CLIO(" setStart") )
	32745	"RTN","HMP STMP",161, 0)
	32746	S DATE(4) =$G(CLIO(" setStop"))
	32747	"RTN","HMP STMP",162, 0)
	32748	;DETERMIN E WHICH ON E IS NEWER
	32749	"RTN","HMP STMP",163, 0)
	32750	Q $$FINDN EW(.DATE)
	32751	"RTN","HMP STMP",164, 0)
	32752	ORD ; Orde r ; RHL 20 141231
	32753	"RTN","HMP STMP",165, 0)
	32754	K DATE
	32755	"RTN","HMP STMP",166, 0)
	32756	S DATE(1) =$G(ORDER( "entered") )
	32757	"RTN","HMP STMP",167, 0)
	32758	;S DATE(2 )=$G(ORDER ("start"))
	32759	"RTN","HMP STMP",168, 0)
	32760	;S DATE(3 )=$G(ORDER ("stop"))
	32761	"RTN","HMP STMP",169, 0)
	32762	;these ar e dates in signature /verificat ion dates
	32763	"RTN","HMP STMP",170, 0)
	32764	I $G(ORDE R("clinici ans")) D
	32765	"RTN","HMP STMP",171, 0)
	32766	. N I,J
	32767	"RTN","HMP STMP",172, 0)
	32768	. S J="", J=$O(DATE( J),-1)
	32769	"RTN","HMP STMP",173, 0)
	32770	. S I=0
	32771	"RTN","HMP STMP",174, 0)
	32772	. F S I= $O(ORDER(" clinicians ",I)) Q:I= "" D
	32773	"RTN","HMP STMP",175, 0)
	32774	. . I $G( ORDER("cli nicians",I ,"signedDa teTime"))] "" S J=J+1 ,DATE(J)=O RDER("clin icians",I, "signedDat eTime")
	32775	"RTN","HMP STMP",176, 0)
	32776	;DETERMIN E WHICH ON E IS NEWER
	32777	"RTN","HMP STMP",177, 0)
	32778	Q $$FINDN EW(.DATE)
	32779	"RTN","HMP STMP",178, 0)
	32780	PRO ; Prob lem
	32781	"RTN","HMP STMP",179, 0)
	32782	K DATE
	32783	"RTN","HMP STMP",180, 0)
	32784	S DATE(1) =$G(PROB(" entered"))
	32785	"RTN","HMP STMP",181, 0)
	32786	S DATE(2) =$G(PROB(" updated"))
	32787	"RTN","HMP STMP",182, 0)
	32788	S DATE(3) =$G(PROB(" onset"))
	32789	"RTN","HMP STMP",183, 0)
	32790	S DATE(4) =$G(PROB(" resolved") )
	32791	"RTN","HMP STMP",184, 0)
	32792	;these ar e dates in possible comments
	32793	"RTN","HMP STMP",185, 0)
	32794	N I,J
	32795	"RTN","HMP STMP",186, 0)
	32796	S J="",J= $O(DATE(J) ,-1)
	32797	"RTN","HMP STMP",187, 0)
	32798	S I=0
	32799	"RTN","HMP STMP",188, 0)
	32800	F S I=$O (PROB("com ments",I)) Q:I="" D
	32801	"RTN","HMP STMP",189, 0)
	32802	. I $G(PR OB("commen ts",I,"ent ered"))]"" S J=J+1,D ATE(J)=PRO B("comment s",I,"ente red")
	32803	"RTN","HMP STMP",190, 0)
	32804	;DETERMIN E WHICH ON E IS NEWER
	32805	"RTN","HMP STMP",191, 0)
	32806	Q $$FINDN EW(.DATE)
	32807	"RTN","HMP STMP",192, 0)
	32808	PRC ; Proc edure
	32809	"RTN","HMP STMP",193, 0)
	32810	K DATE
	32811	"RTN","HMP STMP",194, 0)
	32812	S DATE(1) =$G(PROC(" dateTime") )
	32813	"RTN","HMP STMP",195, 0)
	32814	S DATE(2) =$G(PROC(" requested" ))
	32815	"RTN","HMP STMP",196, 0)
	32816	;DETERMIN E WHICH ON E IS NEWER
	32817	"RTN","HMP STMP",197, 0)
	32818	Q $$FINDN EW(.DATE)
	32819	"RTN","HMP STMP",198, 0)
	32820	CON ; Cons ult
	32821	"RTN","HMP STMP",199, 0)
	32822	K DATE
	32823	"RTN","HMP STMP",200, 0)
	32824	S DATE(1) =$G(CONS(" dateTime") )
	32825	"RTN","HMP STMP",201, 0)
	32826	S DATE(2) =$G(CONS(" earliestDa te"))
	32827	"RTN","HMP STMP",202, 0)
	32828	S DATE(3) =$G(ACT("e ntered"))
	32829	"RTN","HMP STMP",203, 0)
	32830	S DATE(4) =$G(ACT("d ateTime"))
	32831	"RTN","HMP STMP",204, 0)
	32832	;DETERMIN E WHICH ON E IS NEWER
	32833	"RTN","HMP STMP",205, 0)
	32834	Q $$FINDN EW(.DATE)
	32835	"RTN","HMP STMP",206, 0)
	32836	IMA ; Imag e ; RHL 20 150102
	32837	"RTN","HMP STMP",207, 0)
	32838	K DATE
	32839	"RTN","HMP STMP",208, 0)
	32840	S DATE(1) =$G(EXAM(" dateTime") )
	32841	"RTN","HMP STMP",209, 0)
	32842	;DETERMIN E WHICH ON E IS NEWER
	32843	"RTN","HMP STMP",210, 0)
	32844	Q $$FINDN EW(.DATE)
	32845	"RTN","HMP STMP",211, 0)
	32846	SUR ; Surg ery ; RHL 20150102
	32847	"RTN","HMP STMP",212, 0)
	32848	K DATE
	32849	"RTN","HMP STMP",213, 0)
	32850	S DATE(1) =$G(SURG(" dateTime") )
	32851	"RTN","HMP STMP",214, 0)
	32852	;DETERMIN E WHICH ON E IS NEWER
	32853	"RTN","HMP STMP",215, 0)
	32854	Q $$FINDN EW(.DATE)
	32855	"RTN","HMP STMP",216, 0)
	32856	TAS ; Task
	32857	"RTN","HMP STMP",217, 0)
	32858	Q ""
	32859	"RTN","HMP STMP",218, 0)
	32860	K DATE
	32861	"RTN","HMP STMP",219, 0)
	32862	;S DATE(1 )=$G(
	32863	"RTN","HMP STMP",220, 0)
	32864	;DETERMIN E WHICH ON E IS NEWER
	32865	"RTN","HMP STMP",221, 0)
	32866	Q $$FINDN EW(.DATE)
	32867	"RTN","HMP STMP",222, 0)
	32868	VIS ; Visi t
	32869	"RTN","HMP STMP",223, 0)
	32870	K DATE
	32871	"RTN","HMP STMP",224, 0)
	32872	S DATE(1) =$G(VST("d ateTime"))
	32873	"RTN","HMP STMP",225, 0)
	32874	S DATE(2) =$G(VST("c heckOut"))
	32875	"RTN","HMP STMP",226, 0)
	32876	;DETERMIN E WHICH ON E IS NEWER
	32877	"RTN","HMP STMP",227, 0)
	32878	Q $$FINDN EW(.DATE)
	32879	"RTN","HMP STMP",228, 0)
	32880	VIT ; Vita l
	32881	"RTN","HMP STMP",229, 0)
	32882	K DATE
	32883	"RTN","HMP STMP",230, 0)
	32884	S DATE(1) =$G(VIT("o bserved"))
	32885	"RTN","HMP STMP",231, 0)
	32886	S DATE(2) =$G(VIT("r esulted"))
	32887	"RTN","HMP STMP",232, 0)
	32888	;DETERMIN E WHICH ON E IS NEWER
	32889	"RTN","HMP STMP",233, 0)
	32890	Q $$FINDN EW(.DATE)
	32891	"RTN","HMP STMP",234, 0)
	32892	PTF ; Ptf ; RHL 2015 0102
	32893	"RTN","HMP STMP",235, 0)
	32894	K DATE
	32895	"RTN","HMP STMP",236, 0)
	32896	S DATE(1) =$G(PTF("a rrivalDate Time"))
	32897	"RTN","HMP STMP",237, 0)
	32898	S DATE(2) =$G(PTF("d ischargeDa teTime"))
	32899	"RTN","HMP STMP",238, 0)
	32900	;DETERMIN E WHICH ON E IS NEWER
	32901	"RTN","HMP STMP",239, 0)
	32902	Q $$FINDN EW(.DATE)
	32903	"RTN","HMP STMP",240, 0)
	32904	EXA ; Exam
	32905	"RTN","HMP STMP",241, 0)
	32906	K DATE
	32907	"RTN","HMP STMP",242, 0)
	32908	S DATE(1) =$G(PCE("e ntered"))
	32909	"RTN","HMP STMP",243, 0)
	32910	;DETERMIN E WHICH ON E IS NEWER
	32911	"RTN","HMP STMP",244, 0)
	32912	Q $$FINDN EW(.DATE)
	32913	"RTN","HMP STMP",245, 0)
	32914	CPT ; CPT
	32915	"RTN","HMP STMP",246, 0)
	32916	K DATE
	32917	"RTN","HMP STMP",247, 0)
	32918	S DATE(1) =$G(PCE("e ntered"))
	32919	"RTN","HMP STMP",248, 0)
	32920	;DETERMIN E WHICH ON E IS NEWER
	32921	"RTN","HMP STMP",249, 0)
	32922	Q $$FINDN EW(.DATE)
	32923	"RTN","HMP STMP",250, 0)
	32924	EDU ; Educ ation
	32925	"RTN","HMP STMP",251, 0)
	32926	K DATE
	32927	"RTN","HMP STMP",252, 0)
	32928	S DATE(1) =$G(PCE("e ntered"))
	32929	"RTN","HMP STMP",253, 0)
	32930	;DETERMIN E WHICH ON E IS NEWER
	32931	"RTN","HMP STMP",254, 0)
	32932	Q $$FINDN EW(.DATE)
	32933	"RTN","HMP STMP",255, 0)
	32934	POV ; Pov
	32935	"RTN","HMP STMP",256, 0)
	32936	K DATE
	32937	"RTN","HMP STMP",257, 0)
	32938	S DATE(1) =$G(PCE("e ntered"))
	32939	"RTN","HMP STMP",258, 0)
	32940	;DETERMIN E WHICH ON E IS NEWER
	32941	"RTN","HMP STMP",259, 0)
	32942	Q $$FINDN EW(.DATE)
	32943	"RTN","HMP STMP",260, 0)
	32944	SKI ; Skin
	32945	"RTN","HMP STMP",261, 0)
	32946	K DATE
	32947	"RTN","HMP STMP",262, 0)
	32948	S DATE(1) =$G(PCE("e ntered"))
	32949	"RTN","HMP STMP",263, 0)
	32950	S DATE(2) =$G(PCE("d ateRead"))
	32951	"RTN","HMP STMP",264, 0)
	32952	;DETERMIN E WHICH ON E IS NEWER
	32953	"RTN","HMP STMP",265, 0)
	32954	Q $$FINDN EW(.DATE)
	32955	"RTN","HMP STMP",266, 0)
	32956	TRE ; Trea tment ; RH L 20150102
	32957	"RTN","HMP STMP",267, 0)
	32958	K DATE
	32959	"RTN","HMP STMP",268, 0)
	32960	S DATE(1) =$G(NTX("e ntered"))
	32961	"RTN","HMP STMP",269, 0)
	32962	S DATE(2) =$G(NTX("s tart"))
	32963	"RTN","HMP STMP",270, 0)
	32964	S DATE(3) =$G(NTX("s top"))
	32965	"RTN","HMP STMP",271, 0)
	32966	;these ar e dates in signature /verificat ion dates; is this u sed for NT X orders
	32967	"RTN","HMP STMP",272, 0)
	32968	I $G(NTX( "clinician s")) D
	32969	"RTN","HMP STMP",273, 0)
	32970	. N I,J
	32971	"RTN","HMP STMP",274, 0)
	32972	. S J="", J=$O(DATE( J),-1)
	32973	"RTN","HMP STMP",275, 0)
	32974	. S I=0
	32975	"RTN","HMP STMP",276, 0)
	32976	. F S I= $O(NTX("cl inicians", I)) Q:I="" D
	32977	"RTN","HMP STMP",277, 0)
	32978	. . I $G( NTX("clini cians",I," signedDate Time"))]"" S J=J+1,D ATE(J)=NTX ("clinicia ns",I,"sig nedDateTim e")
	32979	"RTN","HMP STMP",278, 0)
	32980	;DETERMIN E WHICH ON E IS NEWER
	32981	"RTN","HMP STMP",279, 0)
	32982	Q $$FINDN EW(.DATE)
	32983	"RTN","HMP STMP",280, 0)
	32984	MH ; Mh ; RHL 2015 0103
	32985	"RTN","HMP STMP",281, 0)
	32986	K DATE
	32987	"RTN","HMP STMP",282, 0)
	32988	S DATE(1) =$G(MH("ad ministered DateTime") )
	32989	"RTN","HMP STMP",283, 0)
	32990	;DETERMIN E WHICH ON E IS NEWER
	32991	"RTN","HMP STMP",284, 0)
	32992	Q $$FINDN EW(.DATE)
	32993	"RTN","HMP STMP",285, 0)
	32994	FINDNEW(DA TE) ; fun ction, fin d the late st date fr om DATE ar ray
	32995	"RTN","HMP STMP",286, 0)
	32996	;DATE arr ay has fol lowing for mat DATE(1 )=DATE DAT E(2)=DATE
	32997	"RTN","HMP STMP",287, 0)
	32998	N ADATE,C OMDATE,NDA TE,X
	32999	"RTN","HMP STMP",288, 0)
	33000	; Jan 28, 2016, DE3 519;bl set date for comparison , now plus 60 second s padded w ith zeroes , no time zone offse t
	33001	"RTN","HMP STMP",289, 0)
	33002	S NDATE=$ E($P($$FMT HL7^XLFDT( $$FMADD^XL FDT($$NOW^ XLFDT,0,0, 0,60)),"-" )_"000000" ,1,14)
	33003	"RTN","HMP STMP",290, 0)
	33004	S X=0,COM DATE=0 ; initialize starting date to ze ro
	33005	"RTN","HMP STMP",291, 0)
	33006	F S X=$O (DATE(X)) Q:'X D:$E (DATE(X),7 ,8) ; eva luate only if precis e date. DE 3548
	33007	"RTN","HMP STMP",292, 0)
	33008	. S ADATE =$E(DATE(X )_"000000" ,1,14) ; N eed paddin g down to the second (YYYYMMDD HHMM). JD- 1/23/15
	33009	"RTN","HMP STMP",293, 0)
	33010	. I ADATE >NDATE Q ; DE3519;b l prevent future dat e/times in lastUpdat eTime
	33011	"RTN","HMP STMP",294, 0)
	33012	. I ADATE >COMDATE S COMDATE=A DATE
	33013	"RTN","HMP STMP",295, 0)
	33014	I 'COMDAT E S COMDAT E=$E($P($$ FMTHL7^XLF DT($$NOW^X LFDT),"-") _"000000", 1,14)
	33015	"RTN","HMP STMP",296, 0)
	33016	Q COMDATE
	33017	"RTN","HMP STMP",297, 0)
	33018	;
	33019	"RTN","HMP TFU2")
	33020	0^123^B400 86168
	33021	"RTN","HMP TFU2",1,0)
	33022	HMPTFU2 ;A SMR/JCH - Utilities for the Tr eating Fac ility file 391.91 ; 02/05/15 1 5:25
	33023	"RTN","HMP TFU2",2,0)
	33024	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Fe b 05, 2015 ;Build 63
	33025	"RTN","HMP TFU2",3,0)
	33026	;Per VA D irective 6 402, this routine sh ould not b e modified .
	33027	"RTN","HMP TFU2",4,0)
	33028	;
	33029	"RTN","HMP TFU2",5,0)
	33030	; Referen ce to ^DGC N(391.91 i s NOT curr ently supp orted; see ICR #2911 for an ex isting Pri vate ICR b etween
	33031	"RTN","HMP TFU2",6,0)
	33032	; Regist ration and CIRN that would mee t the need s of this routine, o r provide an example for a new ICR.
	33033	"RTN","HMP TFU2",7,0)
	33034	;
	33035	"RTN","HMP TFU2",8,0)
	33036	Q
	33037	"RTN","HMP TFU2",9,0)
	33038	;
	33039	"RTN","HMP TFU2",10,0 )
	33040	TFL(LIST,P T) ;for th is PT [pat ient] (eit her DFN, I CN or EDIP I) return the list o f treating facilitie s
	33041	"RTN","HMP TFU2",11,0 )
	33042	; CALLED FROM RPC H MP LOCAL G ET CORRESP ONDINGIDS
	33043	"RTN","HMP TFU2",12,0 )
	33044	; PT valu es : Sou rce ID^Sou rce ID Typ e^Assignin g Authorit y^Assignin g Facility
	33045	"RTN","HMP TFU2",13,0 )
	33046	; ICN ex ample: 1 008520438V 882204^NI^ USVHA^200M
	33047	"RTN","HMP TFU2",14,0 )
	33048	; DFN ex ample: 1 00000511^P I^USVHA^50 0
	33049	"RTN","HMP TFU2",15,0 )
	33050	; EDIPI example: 8 52043888^N I^USDOD^20 0DOD
	33051	"RTN","HMP TFU2",16,0 )
	33052	;
	33053	"RTN","HMP TFU2",17,0 )
	33054	; SOURCE ID: S OURCE ID i s the uniq ue system assigned i dentifier at the ide ntified fa cility for the
	33055	"RTN","HMP TFU2",18,0 )
	33056	; p atient rec ord. The value of S OURCE ID v aries, dep ending on the source facility.
	33057	"RTN","HMP TFU2",19,0 )
	33058	; I f SOURCE I D is from the Master Patient I ndex, the value is t he Integra tion
	33059	"RTN","HMP TFU2",20,0 )
	33060	; C ontrol Num ber (ICN). If SOURC E ID is fr om the Dep artment of Defense ( DOD), the
	33061	"RTN","HMP TFU2",21,0 )
	33062	; v alue is th e Electron ic Data In terchange Personal I dentifier (EDIPI), w hich is
	33063	"RTN","HMP TFU2",22,0 )
	33064	; t heir equiv alent of a n ICN. In the future , SOURCE I D may come from othe r sources
	33065	"RTN","HMP TFU2",23,0 )
	33066	; d ue to addi tional ini tiatives.
	33067	"RTN","HMP TFU2",24,0 )
	33068	;
	33069	"RTN","HMP TFU2",25,0 )
	33070	; SOURCE ID TYPE: S OURCE ID T YPE define s the data source fo r the TREA TING FACIL ITY LIST f ile (#391. 91) entry.
	33071	"RTN","HMP TFU2",26,0 )
	33072	; T he source ID type is a referen ce to the HL7 Table 0203, Iden tifier Typ e, and the VA
	33073	"RTN","HMP TFU2",27,0 )
	33074	; I dentity Ma nagement u ser define d values: NI (Nation al Identif ier), PI ( Patient Id entifier)
	33075	"RTN","HMP TFU2",28,0 )
	33076	;
	33077	"RTN","HMP TFU2",29,0 )
	33078	; Return:
	33079	"RTN","HMP TFU2",30,0 )
	33080	; This wi ll return the ICN an d the list of treati ng facilit ies in the following format:
	33081	"RTN","HMP TFU2",31,0 )
	33082	; RESUL T(n)=Id^Id Type^Assig ningFacili ty^Assigni ngAuthorit y^IdStatus
	33083	"RTN","HMP TFU2",32,0 )
	33084	; Exa mples:
	33085	"RTN","HMP TFU2",33,0 )
	33086	; RE SULT(1)="1 011232151V 598646^NI^ 200M^A"
	33087	"RTN","HMP TFU2",34,0 )
	33088	; RE SULT(2)="7 168937^PI^ 91E3^USVHA ^A"
	33089	"RTN","HMP TFU2",35,0 )
	33090	; RE SULT(3)="8 52043888^N I^200DOD^U SDOD^A"
	33091	"RTN","HMP TFU2",36,0 )
	33092	;
	33093	"RTN","HMP TFU2",37,0 )
	33094	; ID STAT US: I D STATUS s upports jo int VA/DoD medical c enters, Ve teran's Re cord Manag ement (VRM ), and Vir tual
	33095	"RTN","HMP TFU2",38,0 )
	33096	; L ifetime El ectronic R ecord (VLE R) initiat ives. Thi s field al lows the c apture of resolved
	33097	"RTN","HMP TFU2",39,0 )
	33098	; d uplicate e vents and exposes th e related identifier and ident ifier stat us to the consuming
	33099	"RTN","HMP TFU2",40,0 )
	33100	; a pplication s. A value of ""A"" indicates that the p atient rec ord is an active rec ord on
	33101	"RTN","HMP TFU2",41,0 )
	33102	; t he identif ying syste m (e.g., V AMC or DoD ). A value of "H" in dicates th at the pat ient
	33103	"RTN","HMP TFU2",42,0 )
	33104	; r ecord was identified as part o f a duplic ate pair, has been m erged, and is no lon ger active
	33105	"RTN","HMP TFU2",43,0 )
	33106	; o n the iden tifying sy stem (e.g. , VAMC or DoD).
	33107	"RTN","HMP TFU2",44,0 )
	33108	;
	33109	"RTN","HMP TFU2",45,0 )
	33110	N X,ICN,D FN,EDIPI,A SSIGN,ID,S ITE,TYPE,S ITEIEN,TFI EN
	33111	"RTN","HMP TFU2",46,0 )
	33112	;
	33113	"RTN","HMP TFU2",47,0 )
	33114	; Master Patient In dex (MPI) must be in stalled to continue
	33115	"RTN","HMP TFU2",48,0 )
	33116	S X="MPIF 001" X ^%Z OSF("TEST" ) I '$T S LIST(1)="- 1^MPI Not Installed" Q
	33117	"RTN","HMP TFU2",49,0 )
	33118	;
	33119	"RTN","HMP TFU2",50,0 )
	33120	K LIST ; Clear "ret urn" varia ble
	33121	"RTN","HMP TFU2",51,0 )
	33122	;
	33123	"RTN","HMP TFU2",52,0 )
	33124	; what do we have
	33125	"RTN","HMP TFU2",53,0 )
	33126	S TYPE=$P (PT,"^",2) ; SOURCE ID TYPE
	33127	"RTN","HMP TFU2",54,0 )
	33128	S SITE=$P (PT,"^",4) ;
	33129	"RTN","HMP TFU2",55,0 )
	33130	S ID=$P(P T,"^")
	33131	"RTN","HMP TFU2",56,0 )
	33132	S ASSIGN= $P(PT,"^", 3)
	33133	"RTN","HMP TFU2",57,0 )
	33134	; check i nput data
	33135	"RTN","HMP TFU2",58,0 )
	33136	I ID']"" S LIST(1)= "-1^Id is not define d." Q
	33137	"RTN","HMP TFU2",59,0 )
	33138	I TYPE'=" NI",TYPE'= "PI" S LIS T(1)="-1^I nvalid Id Type." Q
	33139	"RTN","HMP TFU2",60,0 )
	33140	I ASSIGN' ="USVHA",A SSIGN'="US DOD" S LIS T(1)="-1^I nvalid Ass igning Aut hority." Q
	33141	"RTN","HMP TFU2",61,0 )
	33142	I SITE']" " S LIST(1 )="-1^Miss ing Assign ing Facili ty." Q
	33143	"RTN","HMP TFU2",62,0 )
	33144	; find th e ien for the statio n number
	33145	"RTN","HMP TFU2",63,0 )
	33146	S SITEIEN =$O(^DIC(4 ,"D",SITE, 0))
	33147	"RTN","HMP TFU2",64,0 )
	33148	I 'SITEIE N S LIST(1 )="-1^Assi gning Faci lity is no t defined in databas e." Q
	33149	"RTN","HMP TFU2",65,0 )
	33150	;
	33151	"RTN","HMP TFU2",66,0 )
	33152	I TYPE="P I",ASSIGN= "USVHA" S DFN=ID
	33153	"RTN","HMP TFU2",67,0 )
	33154	I TYPE="N I",ASSIGN= "USVHA",SI TE="200M" S ICN=ID
	33155	"RTN","HMP TFU2",68,0 )
	33156	I TYPE="N I",ASSIGN= "USDOD",SI TE="200DOD " S EDIPI= ID
	33157	"RTN","HMP TFU2",69,0 )
	33158	I $D(ICN) S DFN=$$G ETDFN^MPIF 001(ICN) D Q:$D(LIS T(1))
	33159	"RTN","HMP TFU2",70,0 )
	33160	. I +DFN< 0 S LIST(1 )="-1^ICN is not kno wn" Q
	33161	"RTN","HMP TFU2",71,0 )
	33162	. S SITEI EN=$$IEN^X UAF4($P($$ SITE^VASIT E,"^",3))
	33163	"RTN","HMP TFU2",72,0 )
	33164	;
	33165	"RTN","HMP TFU2",73,0 )
	33166	I $D(DFN) S ICN=$$G ETICN^MPIF 001(DFN)
	33167	"RTN","HMP TFU2",74,0 )
	33168	; DFN sho uld be def ined, but ICN may no t.
	33169	"RTN","HMP TFU2",75,0 )
	33170	;Use new xref AISS appropriat ely to ret rieve DFN from EDIPI
	33171	"RTN","HMP TFU2",76,0 )
	33172	I $D(EDIP I)=""!(ASS IGN="")!(T YPE="")!(S ITEIEN="") S LIST(1) ="-1^Insuf ficient da ta" Q
	33173	"RTN","HMP TFU2",77,0 )
	33174	I $D(EDIP I),'$D(^DG CN(391.91, "AISS",EDI PI,ASSIGN, TYPE,SITEI EN)) D Q
	33175	"RTN","HMP TFU2",78,0 )
	33176	. S LIST( 1)="-1^EDI PI Record is unknown at this f acility"
	33177	"RTN","HMP TFU2",79,0 )
	33178	I $D(EDIP I),$D(^DGC N(391.91," AISS",EDIP I,ASSIGN,T YPE,SITEIE N)) D
	33179	"RTN","HMP TFU2",80,0 )
	33180	.S EN=$O( ^DGCN(391. 91,"AISS", EDIPI,ASSI GN,TYPE,SI TEIEN,0))
	33181	"RTN","HMP TFU2",81,0 )
	33182	.S DFN=$P ($G(^DGCN( 391.91,EN, 0)),"^")
	33183	"RTN","HMP TFU2",82,0 )
	33184	;
	33185	"RTN","HMP TFU2",83,0 )
	33186	; if ICN is not def ined, it i s OK, but DFN should be define d
	33187	"RTN","HMP TFU2",84,0 )
	33188	; bad inp ut, such a s Id^NI^US VHA^123
	33189	"RTN","HMP TFU2",85,0 )
	33190	I '$G(DFN ) S LIST(1 )="-1^Inva lid input" Q
	33191	"RTN","HMP TFU2",86,0 )
	33192	; check D FN and Sit e to be ma tching an entry in f ile #391.9 1
	33193	"RTN","HMP TFU2",87,0 )
	33194	I '$O(^DG CN(391.91, "APAT",DFN ,SITEIEN,0 )) D Q
	33195	"RTN","HMP TFU2",88,0 )
	33196	. S LIST( 1)="-1^Id as '"_ID_" '"_" is no t in datab ase"
	33197	"RTN","HMP TFU2",89,0 )
	33198	; DFN sho uld be def ined, but ICN may no t.
	33199	"RTN","HMP TFU2",90,0 )
	33200	S X=$$QUE RYTF($P($G (ICN),"V") ,"LIST")
	33201	"RTN","HMP TFU2",91,0 )
	33202	I $P(X,U) ="1" S LIS T(1)="-1"_ U_$P(X,U,2 ) Q
	33203	"RTN","HMP TFU2",92,0 )
	33204	Q
	33205	"RTN","HMP TFU2",93,0 )
	33206	;
	33207	"RTN","HMP TFU2",94,0 )
	33208	GETICN(EDI PI) ;retur n the ICN when EDIPI is passed
	33209	"RTN","HMP TFU2",95,0 )
	33210	N EN,DFN, ICN,IEN
	33211	"RTN","HMP TFU2",96,0 )
	33212	S IEN=$$I EN^XUAF4(" 200DOD")
	33213	"RTN","HMP TFU2",97,0 )
	33214	I 'IEN Q "-1^Unknow n Assignin g Facility ."
	33215	"RTN","HMP TFU2",98,0 )
	33216	I '$D(^DG CN(391.91, "ASCR",EDI PI,IEN)) Q "-1^EDIPI Record is unknown a t this fac ility"
	33217	"RTN","HMP TFU2",99,0 )
	33218	I $D(^DGC N(391.91," ASCR",EDIP I,IEN)) D
	33219	"RTN","HMP TFU2",100, 0)
	33220	.S EN=$O( ^DGCN(391. 91,"ASCR", EDIPI,$$IE N^XUAF4("2 00DOD"),"" ))
	33221	"RTN","HMP TFU2",101, 0)
	33222	.S DFN=$P ($G(^DGCN( 391.91,EN, 0)),"^")
	33223	"RTN","HMP TFU2",102, 0)
	33224	.I DFN'=" " S ICN=$$ GETICN^MPI F001(DFN)
	33225	"RTN","HMP TFU2",103, 0)
	33226	.I DFN="" S ICN="-1 ^No Site R ecord asso ciated wit h this ent ry"
	33227	"RTN","HMP TFU2",104, 0)
	33228	Q ICN
	33229	"RTN","HMP TFU2",105, 0)
	33230	;
	33231	"RTN","HMP TFU2",106, 0)
	33232	QUERYTF(PA T,ARY) ;a query for Treating F acility.
	33233	"RTN","HMP TFU2",107, 0)
	33234	;INPUT PAT - The patient's ICN
	33235	"RTN","HMP TFU2",108, 0)
	33236	; ARY - The array in w hich to re turn the T reating fa cility inf o.
	33237	"RTN","HMP TFU2",109, 0)
	33238	;OUTPUT A list of the Treati ng Facilit ies in the array pro vided from
	33239	"RTN","HMP TFU2",110, 0)
	33240	; the parame ter. It w ill be in the struct ure of x(1 ), x(2) et c.
	33241	"RTN","HMP TFU2",111, 0)
	33242	; Ex X( 1)=<ID> ^ <ID TYPE> ^ <Assigni ng Authori ty> ^ <Ass igning Fac ility> ^ < ID Status>
	33243	"RTN","HMP TFU2",112, 0)
	33244	;
	33245	"RTN","HMP TFU2",113, 0)
	33246	; This is also a fu nction cal l. If the re is an e rror then "1^error d escription " will be returned.
	33247	"RTN","HMP TFU2",114, 0)
	33248	; If no d ata is fou nd the arr ay will no t be popul ated and " 1^error de scription" will be r eturned.
	33249	"RTN","HMP TFU2",115, 0)
	33250	;
	33251	"RTN","HMP TFU2",116, 0)
	33252	N PDFN,HM PER,LP,CTR
	33253	"RTN","HMP TFU2",117, 0)
	33254	;
	33255	"RTN","HMP TFU2",118, 0)
	33256	; ICN is not requir ed
	33257	"RTN","HMP TFU2",119, 0)
	33258	I ('$D(AR Y)) S HMPE R="1^Param eter missi ng." G QUE RYTFQ
	33259	"RTN","HMP TFU2",120, 0)
	33260	S HMPER=0 ,CTR=1
	33261	"RTN","HMP TFU2",121, 0)
	33262	S X="MPIF 001" X ^%Z OSF("TEST" ) I '$T G QUERYTFQ
	33263	"RTN","HMP TFU2",122, 0)
	33264	S PDFN=$G (DFN)
	33265	"RTN","HMP TFU2",123, 0)
	33266	I '$G(PDF N) S HMPER ="1^DFN is not defin ed." G QUE RYTFQ
	33267	"RTN","HMP TFU2",124, 0)
	33268	;SET FIRS T ENTRY TO BE THE IC N - FULL I CN - PAT I S NOT THE ICN
	33269	"RTN","HMP TFU2",125, 0)
	33270	S @ARY@(C TR)=$$GETI CN^MPIF001 (PDFN)_"^N I^200M^USV HA^A"
	33271	"RTN","HMP TFU2",126, 0)
	33272	;**856 - MVI 1371 ( ckn)
	33273	"RTN","HMP TFU2",127, 0)
	33274	;Loop thr ough all T FIENs for site
	33275	"RTN","HMP TFU2",128, 0)
	33276	;F LP=0:0 S LP=$O(^ DGCN(391.9 1,"APAT",P DFN,LP)) Q :'LP S TF IEN=$O(^(L P,"")) D S ET(TFIEN,A RY,.CTR)
	33277	"RTN","HMP TFU2",129, 0)
	33278	F LP=0:0 S LP=$O(^D GCN(391.91 ,"APAT",PD FN,LP)) Q: 'LP D
	33279	"RTN","HMP TFU2",130, 0)
	33280	.S TFIEN= 0 F S TFI EN=$O(^DGC N(391.91," APAT",PDFN ,LP,TFIEN) ) Q:'TFIEN D
	33281	"RTN","HMP TFU2",131, 0)
	33282	..D SET(T FIEN,ARY,. CTR)
	33283	"RTN","HMP TFU2",132, 0)
	33284	I $D(@ARY )'>9 S HMP ER="1^Coul d not find Treating Facilities "
	33285	"RTN","HMP TFU2",133, 0)
	33286	QUERYTFQ Q HMPER
	33287	"RTN","HMP TFU2",134, 0)
	33288	;
	33289	"RTN","HMP TFU2",135, 0)
	33290	SET(TFIEN, ARY,CTR) ; This sets the array with the t reating fa cility lis t.
	33291	"RTN","HMP TFU2",136, 0)
	33292	; Ex AR Y(1)=<ID> ^ <ID TYPE > ^ <Assig ning Facil ity> ^ <As signing Au thority> ^ <ID Statu s>
	33293	"RTN","HMP TFU2",137, 0)
	33294	N DGCN,IN STIEN,SOUR CE,EN,SDFN ,STATUS,SI TEN,ID,IDT YPE,SITE,A SSAUTH,FOU ND,NODE,NO DE0,NODE2
	33295	"RTN","HMP TFU2",138, 0)
	33296	S DGCN(0) =$G(^DGCN( 391.91,TFI EN,0)),SIT EN=""
	33297	"RTN","HMP TFU2",139, 0)
	33298	;
	33299	"RTN","HMP TFU2",140, 0)
	33300	S INSTIEN =$P($G(DGC N(0)),"^", 2) ; TREA TING FACIL ITY LIST ( #391.91) I NSTITUTION field (#. 02)
	33301	"RTN","HMP TFU2",141, 0)
	33302	I INSTIEN '="" S SIT EN=$$STA^X UAF4(INSTI EN) ; STAT ION from I nstitution IEN
	33303	"RTN","HMP TFU2",142, 0)
	33304	S ID=$P(D GCN(0),"^" ) ; ID=P atient DFN field (#. 01)
	33305	"RTN","HMP TFU2",143, 0)
	33306	;
	33307	"RTN","HMP TFU2",144, 0)
	33308	S NODE2=$ G(^DGCN(39 1.91,TFIEN ,2))
	33309	"RTN","HMP TFU2",145, 0)
	33310	S SDFN=$P (NODE2,"^" ,2) ; SDFN ="SOURCE I D"
	33311	"RTN","HMP TFU2",146, 0)
	33312	S STATUS= $P(NODE2," ^",3) ; ST ATUS="IDEN TIFIER STA TUS"
	33313	"RTN","HMP TFU2",147, 0)
	33314	S ASSAUTH =$P(NODE2, "^") ; Ass igning Aut hority
	33315	"RTN","HMP TFU2",148, 0)
	33316	;
	33317	"RTN","HMP TFU2",149, 0)
	33318	S NODE0=$ G(^DGCN(39 1.91,TFIEN ,0))
	33319	"RTN","HMP TFU2",150, 0)
	33320	S IDTYPE= $P(NODE0," ^",9) ; SO URCE ID TY PE
	33321	"RTN","HMP TFU2",151, 0)
	33322	;
	33323	"RTN","HMP TFU2",152, 0)
	33324	I SITEN=" 200DOD"!(S ITEN["200N ") S IDTYP E="NI"
	33325	"RTN","HMP TFU2",153, 0)
	33326	I SITEN=" 200DOD" S ASSAUTH="U SDOD"
	33327	"RTN","HMP TFU2",154, 0)
	33328	I IDTYPE= "" S IDTYP E="PI"
	33329	"RTN","HMP TFU2",155, 0)
	33330	I ASSAUTH ="" S ASSA UTH="USVHA "
	33331	"RTN","HMP TFU2",156, 0)
	33332	I SITEN[" 200N"&(IDT YPE="NI")& (ASSAUTH=" USVHA") S ASSAUTH=""
	33333	"RTN","HMP TFU2",157, 0)
	33334	I IDTYPE= "PI" S SIT EN=$$TF2SI TEN(TFIEN) Q:SITEN=" "
	33335	"RTN","HMP TFU2",158, 0)
	33336	;
	33337	"RTN","HMP TFU2",159, 0)
	33338	; If VA I nternal Pa tient ID, get site h ash from d omain asso ciated wit h Treating Facility
	33339	"RTN","HMP TFU2",160, 0)
	33340	S NODE0=$ G(^DGCN(39 1.91,TFIEN ,0))
	33341	"RTN","HMP TFU2",161, 0)
	33342	S NODE2=$ G(^DGCN(39 1.91,TFIEN ,2))
	33343	"RTN","HMP TFU2",162, 0)
	33344	S SDFN=$P (NODE2,"^" ,2),STATUS =$P(NODE2, "^",3),IDT YPE=$P(NOD E0,"^",9)
	33345	"RTN","HMP TFU2",163, 0)
	33346	; DE2345 - MBS 9/15 /2015; Onl y return a ctive entr ies
	33347	"RTN","HMP TFU2",164, 0)
	33348	I STATUS' ="A" Q
	33349	"RTN","HMP TFU2",165, 0)
	33350	S ASSAUTH =$P(NODE2, "^")
	33351	"RTN","HMP TFU2",166, 0)
	33352	I SITEN=" 200DOD"!(S ITEN["200N ") S IDTYP E="NI"
	33353	"RTN","HMP TFU2",167, 0)
	33354	I SITEN=" 200DOD" S ASSAUTH="U SDOD"
	33355	"RTN","HMP TFU2",168, 0)
	33356	I IDTYPE= "" S IDTYP E="PI"
	33357	"RTN","HMP TFU2",169, 0)
	33358	I ASSAUTH ="" S ASSA UTH="USVHA "
	33359	"RTN","HMP TFU2",170, 0)
	33360	I SITEN[" 200N"&(IDT YPE="NI")& (ASSAUTH=" USVHA") S ASSAUTH=""
	33361	"RTN","HMP TFU2",171, 0)
	33362	I SDFN'=" " S CTR=CT R+1,@ARY@( CTR)=SDFN_ "^"_IDTYPE _"^"_SITEN _"^"_ASSAU TH_"^"_STA TUS,FOUND= 1
	33363	"RTN","HMP TFU2",172, 0)
	33364	Q
	33365	"RTN","HMP TFU2",173, 0)
	33366	TF2SITEN(T FIEN) ;Fin d the DOMA IN associa ted with t he TREATIN G FACILITY and retur n the stat ion number .
	33367	"RTN","HMP TFU2",174, 0)
	33368	;Currentl y, our tes t systems' station n umbers are not set u p for loca l DOMAINs. This woul d result i n these
	33369	"RTN","HMP TFU2",175, 0)
	33370	;entries failing al l the time , thus bre aking exis ting behav ior. For t he time be ing, we wi ll default to
	33371	"RTN","HMP TFU2",176, 0)
	33372	;the old behavior i f we canno t locate a station n umber as a temporary measure. In the fut ure, we ne ed to
	33373	"RTN","HMP TFU2",177, 0)
	33374	;fix the test syste ms to set up the sta tion numbe rs correct ly, and th en change this code to return
	33375	"RTN","HMP TFU2",178, 0)
	33376	;an empty string if the DOMAI N could no t be resol ved.
	33377	"RTN","HMP TFU2",179, 0)
	33378	S SITEN=" "
	33379	"RTN","HMP TFU2",180, 0)
	33380	;S SITEN= $$SYS^HMPU TILS ;<--N OT DEAD CO DE
	33381	"RTN","HMP TFU2",181, 0)
	33382	Q:'+$G(TF IEN) ""
	33383	"RTN","HMP TFU2",182, 0)
	33384	Q:'$D(^DG CN(391.91, TFIEN)) ""
	33385	"RTN","HMP TFU2",183, 0)
	33386	;Get stat ion number from Inst itution fi le (pointe d to from Treating F acility Li st)
	33387	"RTN","HMP TFU2",184, 0)
	33388	N INSTNUM ,STNNUM,DO NE,I
	33389	"RTN","HMP TFU2",185, 0)
	33390	S INSTNUM =$P($G(^DG CN(391.91, TFIEN,0)), U,2) Q:'+I NSTNUM SIT EN
	33391	"RTN","HMP TFU2",186, 0)
	33392	S STNNUM= $P($G(^DIC (4,INSTNUM ,99)),U) Q :'+STNNUM SITEN
	33393	"RTN","HMP TFU2",187, 0)
	33394	;DE2345 - MBS 9/15/ 2015; Do n ot return entries wi th station numbers=+ 200
	33395	"RTN","HMP TFU2",188, 0)
	33396	I STNNUM? 1"200".A Q ""
	33397	"RTN","HMP TFU2",189, 0)
	33398	;Domain f ile doesn' t have an x-ref on s tation num ber, so we have to b rute-force it
	33399	"RTN","HMP TFU2",190, 0)
	33400	S (I,DONE )=0 F S I =$O(^DIC(4 .2,I)) Q:' +I D Q:D ONE
	33401	"RTN","HMP TFU2",191, 0)
	33402	. I $P(^D IC(4.2,I,0 ),U,13)=ST NNUM S SIT EN=$$BASE^ XLFUTL($$C RC16^XLFCR C($P(^DIC( 4.2,I,0),U )),10,16), DONE=1
	33403	"RTN","HMP TFU2",192, 0)
	33404	Q SITEN
	33405	"RTN","HMP TFU2",193, 0)
	33406	;
	33407	"RTN","HMP TOOLS")
	33408	0^1^B11387 818
	33409	"RTN","HMP TOOLS",1,0 )
	33410	HMPTOOLS ; ASMR/JD - More HMP u tilities ; 9/25/15 1 0:59am
	33411	"RTN","HMP TOOLS",2,0 )
	33412	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	33413	"RTN","HMP TOOLS",3,0 )
	33414	;Per VA D irective 6 402, this routine sh ould not b e modified .
	33415	"RTN","HMP TOOLS",4,0 )
	33416	;
	33417	"RTN","HMP TOOLS",5,0 )
	33418	Q
	33419	"RTN","HMP TOOLS",6,0 )
	33420	;
	33421	"RTN","HMP TOOLS",7,0 )
	33422	CHKXTMP(RS LT) ; RPC( HMP CHKXTM P) to retu rn the sta te of ^XTM P data
	33423	"RTN","HMP TOOLS",8,0 )
	33424	; RSLT - Return arr ay:
	33425	"RTN","HMP TOOLS",9,0 )
	33426	; "There are a total o f xxx pati ents in qu eue. yyy Complete zzz Stagin g"
	33427	"RTN","HMP TOOLS",10, 0)
	33428	; Where xxx, yyy, and z zz are zer o or great er.
	33429	"RTN","HMP TOOLS",11, 0)
	33430	; NOTE: If x xx is zero , then the sentence after "que ue." will NOT be dis played
	33431	"RTN","HMP TOOLS",12, 0)
	33432	;
	33433	"RTN","HMP TOOLS",13, 0)
	33434	; Goes th rough ^XTM P and figu res out th e total nu mber of pa tients, ho w many
	33435	"RTN","HMP TOOLS",14, 0)
	33436	; have co mpleted da ta staging , and how many are s till stagi ng.
	33437	"RTN","HMP TOOLS",15, 0)
	33438	; There i s code to allow a bi t more inf ormation t han reques ted to be stored
	33439	"RTN","HMP TOOLS",16, 0)
	33440	; in a gl obal (^TMP ("FINDSTAT US",$J)) f or future needs (e.g . Complete /staging
	33441	"RTN","HMP TOOLS",17, 0)
	33442	; is brok en down by domain). * This currently commented out *.
	33443	"RTN","HMP TOOLS",18, 0)
	33444	;
	33445	"RTN","HMP TOOLS",19, 0)
	33446	; ^XTMP(" HMPFX~<ser ver id>~DF N",0,"stat us",<domai n>)=STATUS , where ST ATUS=1 mea ns
	33447	"RTN","HMP TOOLS",20, 0)
	33448	; data is completel y staged a nd 0 means data is b eing stage d but not complete y et.
	33449	"RTN","HMP TOOLS",21, 0)
	33450	;
	33451	"RTN","HMP TOOLS",22, 0)
	33452	; GLB = ^TMP("FI NDSTATUS", $J) (FUTU RE USE)
	33453	"RTN","HMP TOOLS",23, 0)
	33454	; HMPBAT = "HMPFX~< sever id>~ DFN"
	33455	"RTN","HMP TOOLS",24, 0)
	33456	; HMPCM = Number o f patients who have completed staging
	33457	"RTN","HMP TOOLS",25, 0)
	33458	; HMPCMP = Number o f domains that have completed staging fo r a patien t
	33459	"RTN","HMP TOOLS",26, 0)
	33460	; HMPCNT = Domain s tatus (1 = complete; 0 = stagi ng)
	33461	"RTN","HMP TOOLS",27, 0)
	33462	; HMPDFN = Patient IEN
	33463	"RTN","HMP TOOLS",28, 0)
	33464	; HMPDOM = Patient domain (e. g. lab, me d, allergy , etc.)
	33465	"RTN","HMP TOOLS",29, 0)
	33466	; HMPST = Number o f patients who are s till in th e staging state
	33467	"RTN","HMP TOOLS",30, 0)
	33468	; HMPSTG = Number o f domains that are s till stagi ng for a p atient
	33469	"RTN","HMP TOOLS",31, 0)
	33470	; HMPT = HMPCM+HM PST
	33471	"RTN","HMP TOOLS",32, 0)
	33472	;
	33473	"RTN","HMP TOOLS",33, 0)
	33474	N GLB,HMP BAT,HMPCM, HMPCMP,HMP CNT,HMPDFN ,HMPDOM,HM PST,HMPSTG ,HMPT
	33475	"RTN","HMP TOOLS",34, 0)
	33476	;S GLB=$N A(^TMP("FI NDSTATUS", $J))
	33477	"RTN","HMP TOOLS",35, 0)
	33478	;K @GLB
	33479	"RTN","HMP TOOLS",36, 0)
	33480	S HMPBAT= "HMPFX",(H MPCM,HMPST )=0
	33481	"RTN","HMP TOOLS",37, 0)
	33482	F S HMPB AT=$O(^XTM P(HMPBAT)) Q:$E(HMPB AT,1,5)'=" HMPFX" D
	33483	"RTN","HMP TOOLS",38, 0)
	33484	.S HMPDOM ="",HMPDFN =$P(HMPBAT ,"~",3),(H MPCMP,HMPS TG)=0
	33485	"RTN","HMP TOOLS",39, 0)
	33486	.I HMPDFN '=+HMPDFN Q ; Patie nts ONLY!
	33487	"RTN","HMP TOOLS",40, 0)
	33488	.F S HMP DOM=$O(^XT MP(HMPBAT, 0,"status" ,HMPDOM)) Q:HMPDOM'] "" D
	33489	"RTN","HMP TOOLS",41, 0)
	33490	..S HMPCN T=^XTMP(HM PBAT,0,"st atus",HMPD OM)
	33491	"RTN","HMP TOOLS",42, 0)
	33492	..I HMPCN T=1 D
	33493	"RTN","HMP TOOLS",43, 0)
	33494	...S HMPC MP=HMPCMP+ 1
	33495	"RTN","HMP TOOLS",44, 0)
	33496	...;S @GL B@(HMPDFN, HMPDOM)="C omplete"
	33497	"RTN","HMP TOOLS",45, 0)
	33498	..I HMPCN T'=1 D
	33499	"RTN","HMP TOOLS",46, 0)
	33500	...S HMPS TG=HMPSTG+ 1
	33501	"RTN","HMP TOOLS",47, 0)
	33502	...;S @GL B@(HMPDFN, HMPDOM)="S taging"
	33503	"RTN","HMP TOOLS",48, 0)
	33504	.I HMPSTG >0 D
	33505	"RTN","HMP TOOLS",49, 0)
	33506	..S HMPST =HMPST+1
	33507	"RTN","HMP TOOLS",50, 0)
	33508	..;S @GLB @(HMPDFN)= "Staging"
	33509	"RTN","HMP TOOLS",51, 0)
	33510	.I HMPSTG '>0 D
	33511	"RTN","HMP TOOLS",52, 0)
	33512	..S HMPCM =HMPCM+1
	33513	"RTN","HMP TOOLS",53, 0)
	33514	..;S @GLB @(HMPDFN)= "Complete"
	33515	"RTN","HMP TOOLS",54, 0)
	33516	S HMPT=HM PCM+HMPST
	33517	"RTN","HMP TOOLS",55, 0)
	33518	K RSLT
	33519	"RTN","HMP TOOLS",56, 0)
	33520	S RSLT(1) ="There ar e a total of "_HMPT_ " patient" _$S(HMPT=1 :"",1:"s") _" in queu e."
	33521	"RTN","HMP TOOLS",57, 0)
	33522	I HMPCM>0 S RSLT(1) =RSLT(1)_" "_HMPCM_ " Complete "
	33523	"RTN","HMP TOOLS",58, 0)
	33524	I HMPST>0 S RSLT(1) =RSLT(1)_" "_HMPST_ " Staging"
	33525	"RTN","HMP TOOLS",59, 0)
	33526	Q
	33527	"RTN","HMP TOOLS",60, 0)
	33528	;
	33529	"RTN","HMP TOOLS",61, 0)
	33530	MON ; Moni tor the pr ogress of ^XTMP grow th. JD - 6/11/15
	33531	"RTN","HMP TOOLS",62, 0)
	33532	N DONE,SI ZE,RES
	33533	"RTN","HMP TOOLS",63, 0)
	33534	D HOME^%Z IS
	33535	"RTN","HMP TOOLS",64, 0)
	33536	S DONE=-1
	33537	"RTN","HMP TOOLS",65, 0)
	33538	F Q:DONE '=-1 D
	33539	"RTN","HMP TOOLS",66, 0)
	33540	.S SIZE=+ $P($P($$GE TSIZE(),U) /1000+.5," .")
	33541	"RTN","HMP TOOLS",67, 0)
	33542	.W @IOF," eHMP usage of ^XTMP = "_SIZE_" kilo byt e(s)"
	33543	"RTN","HMP TOOLS",68, 0)
	33544	.D CHKXTM P(.RES)
	33545	"RTN","HMP TOOLS",69, 0)
	33546	.W !!,RES (1)
	33547	"RTN","HMP TOOLS",70, 0)
	33548	.W !!,"Hi t any key to exit th e monitor"
	33549	"RTN","HMP TOOLS",71, 0)
	33550	.X "R *DO NE:2"
	33551	"RTN","HMP TOOLS",72, 0)
	33552	Q
	33553	"RTN","HMP TOOLS",73, 0)
	33554	;
	33555	"RTN","HMP TOOLS",74, 0)
	33556	SIZE(RSLT) ; calcula te the siz e of XTMP global
	33557	"RTN","HMP TOOLS",75, 0)
	33558	S RSLT(1) =$P($$GETS IZE(),"^")
	33559	"RTN","HMP TOOLS",76, 0)
	33560	Q
	33561	"RTN","HMP TOOLS",77, 0)
	33562	;
	33563	"RTN","HMP TOOLS",78, 0)
	33564	GETSIZE(HM PMODE,HMPS RVN) ; -- returns cu rrent aggr egate extr act size f or extract s waiting to be sent to HMP se rvers
	33565	"RTN","HMP TOOLS",79, 0)
	33566	; input: HMPMODE := [ estimat e - use es timated do main avera ge sizes ( default) \|
	33567	"RTN","HMP TOOLS",80, 0)
	33568	; actual - walk tho ugh object nodes to calculate using $LEN GTH ]
	33569	"RTN","HMP TOOLS",81, 0)
	33570	; HMPSRVN := name of H MP server [optional - defaults to all HM P servers]
	33571	"RTN","HMP TOOLS",82, 0)
	33572	; returns : total si ze in byte s ^ object count
	33573	"RTN","HMP TOOLS",83, 0)
	33574	;
	33575	"RTN","HMP TOOLS",84, 0)
	33576	; -- loop thru extr acts for s erver(s)
	33577	"RTN","HMP TOOLS",85, 0)
	33578	N ROOT,BA TCH,TASK,D OMAIN,OBJS ,OBJCNT,OB JSIZES,TOT AL
	33579	"RTN","HMP TOOLS",86, 0)
	33580	S (OBJCNT ,TOTAL)=0
	33581	"RTN","HMP TOOLS",87, 0)
	33582	S ROOT="H MPFX~"_$S( $G(HMPSRVN )]"":HMPSR VN_"~",1:" ")
	33583	"RTN","HMP TOOLS",88, 0)
	33584	S BATCH=R OOT
	33585	"RTN","HMP TOOLS",89, 0)
	33586	F S BATC H=$O(^XTMP (BATCH)) Q :$E(BATCH, 1,$L(ROOT) )'=ROOT D
	33587	"RTN","HMP TOOLS",90, 0)
	33588	. S TASK= 0 F S TAS K=$O(^XTMP (BATCH,TAS K)) Q:'TAS K D
	33589	"RTN","HMP TOOLS",91, 0)
	33590	. . S DOM AIN="" F S DOMAIN=$ O(^XTMP(BA TCH,TASK,D OMAIN)) Q: DOMAIN="" D
	33591	"RTN","HMP TOOLS",92, 0)
	33592	. . . S O BJS=+$O(^X TMP(BATCH, TASK,DOMAI N," "),-1)
	33593	"RTN","HMP TOOLS",93, 0)
	33594	. . . S O BJCNT=OBJC NT+OBJS
	33595	"RTN","HMP TOOLS",94, 0)
	33596	. . . S T OTAL=TOTAL +$$WALK(BA TCH,TASK,D OMAIN) Q
	33597	"RTN","HMP TOOLS",95, 0)
	33598	. . . S T OTAL=TOTAL +(OBJS*$G( OBJSIZES($ P(DOMAIN," #")),1000) )
	33599	"RTN","HMP TOOLS",96, 0)
	33600	Q TOTAL_" ^"_OBJCNT
	33601	"RTN","HMP TOOLS",97, 0)
	33602	;
	33603	"RTN","HMP TOOLS",98, 0)
	33604	WALK(BATCH ,TASK,DOMA IN) ; -- w alk throug h domain o bjectS in task to ge t actual s ize
	33605	"RTN","HMP TOOLS",99, 0)
	33606	N OBJ,SIZ E,NODE
	33607	"RTN","HMP TOOLS",100 ,0)
	33608	S (OBJ,SI ZE)=0
	33609	"RTN","HMP TOOLS",101 ,0)
	33610	F S OBJ= $O(^XTMP(B ATCH,TASK, DOMAIN,OBJ )) Q:'OBJ D
	33611	"RTN","HMP TOOLS",102 ,0)
	33612	. S NODE= 0 F S NOD E=$O(^XTMP (BATCH,TAS K,DOMAIN,O BJ,NODE)) Q:'NODE S SIZE=SIZE +$L($G(^(N ODE)))
	33613	"RTN","HMP TOOLS",103 ,0)
	33614	Q SIZE
	33615	"RTN","HMP TRPC")
	33616	1^190
	33617	"RTN","HMP TRPC1")
	33618	1^191
	33619	"RTN","HMP UPD")
	33620	0^126^B251 23694
	33621	"RTN","HMP UPD",1,0)
	33622	HMPUPD ;SL C/MKB,ASMR /RRB - Upd ate local data ;11/1 3/13 2:11p m
	33623	"RTN","HMP UPD",2,0)
	33624	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	33625	"RTN","HMP UPD",3,0)
	33626	;Per VA D irective 6 402, this routine sh ould not b e modified .
	33627	"RTN","HMP UPD",4,0)
	33628	;
	33629	"RTN","HMP UPD",5,0)
	33630	Q
	33631	"RTN","HMP UPD",6,0)
	33632	;
	33633	"RTN","HMP UPD",7,0)
	33634	PHONE(HMP, JSON) ; RP C = HMP PU T PHONE
	33635	"RTN","HMP UPD",8,0)
	33636	Q
	33637	"RTN","HMP UPD",9,0)
	33638	PUT(HMP,DF N,CMD,JSON ) ; -- upd ate phone numbers
	33639	"RTN","HMP UPD",10,0)
	33640	; RPC = H MP PUT DEM OGRAPHICS
	33641	"RTN","HMP UPD",11,0)
	33642	;
	33643	"RTN","HMP UPD",12,0)
	33644	N ARRAY,H MPERR,ERR, HOME,CELL, WORK,NOK,E CON,X,OK,H MPSYS
	33645	"RTN","HMP UPD",13,0)
	33646	S HMPSYS= $$GET^XPAR ("SYS","HM P SYSTEM N AME")
	33647	"RTN","HMP UPD",14,0)
	33648	D DECODE^ HMPJSON("J SON","ARRA Y","HMPERR ")
	33649	"RTN","HMP UPD",15,0)
	33650	I $D(HMPE RR) D G P Q
	33651	"RTN","HMP UPD",16,0)
	33652	. K ARRAY N HMPTMP, HMPTXT
	33653	"RTN","HMP UPD",17,0)
	33654	. S HMPTX T(1)="Prob lem decodi ng json in put."
	33655	"RTN","HMP UPD",18,0)
	33656	. D SETER ROR^HMPUTI LS(.HMPTMP ,.HMPERR,. HMPTXT,.JS ON)
	33657	"RTN","HMP UPD",19,0)
	33658	. K HMPER R D ENCODE ^HMPJSON(" HMPTMP","A RRAY","HMP ERR")
	33659	"RTN","HMP UPD",20,0)
	33660	. S HMP(. 5)="{""api Version"": ""1.01""," "error"":{ "
	33661	"RTN","HMP UPD",21,0)
	33662	. M HMP(1 )=ARRAY
	33663	"RTN","HMP UPD",22,0)
	33664	. S HMP(2 )="}}"
	33665	"RTN","HMP UPD",23,0)
	33666	;
	33667	"RTN","HMP UPD",24,0)
	33668	S DFN=+$G (DFN) I DF N<1 S ERR= $$ERR(1,DF N) G PHQ
	33669	"RTN","HMP UPD",25,0)
	33670	S CMD=$G( CMD) ;can only updat e phone#
	33671	"RTN","HMP UPD",26,0)
	33672	N HMPX,HM PDR,I,J S (HMPDR,HOM E,CELL,WOR K,NOK,ECON )=""
	33673	"RTN","HMP UPD",27,0)
	33674	D VAL("ol d")
	33675	"RTN","HMP UPD",28,0)
	33676	S I="" F S I=$O(AR RAY("telec om",I)) Q: I<1 D
	33677	"RTN","HMP UPD",29,0)
	33678	. I $G(AR RAY("telec om",I,"use "))="H" D Q
	33679	"RTN","HMP UPD",30,0)
	33680	.. S HOME =$G(ARRAY( "telecom", I,"value") )
	33681	"RTN","HMP UPD",31,0)
	33682	.. I HOME =HOME("old ") S HOME= "" Q ;no c hange
	33683	"RTN","HMP UPD",32,0)
	33684	.. I "@"[ HOME S:$L( HOME("old" )) HOME="@ " Q ;dele te
	33685	"RTN","HMP UPD",33,0)
	33686	.. S HOME =$$FORMAT( HOME),ARRA Y("telecom ",I,"value ")=HOME
	33687	"RTN","HMP UPD",34,0)
	33688	. I $G(AR RAY("telec om",I,"use "))="MC" D Q
	33689	"RTN","HMP UPD",35,0)
	33690	.. S CELL =$G(ARRAY( "telecom", I,"value") )
	33691	"RTN","HMP UPD",36,0)
	33692	.. I CELL =CELL("old ") S CELL= "" Q ;no c hange
	33693	"RTN","HMP UPD",37,0)
	33694	.. I "@"[ CELL S:$L( CELL("old" )) CELL="@ " Q ;dele te
	33695	"RTN","HMP UPD",38,0)
	33696	.. S CELL =$$FORMAT( CELL),ARRA Y("telecom ",I,"value ")=CELL
	33697	"RTN","HMP UPD",39,0)
	33698	. I $G(AR RAY("telec om",I,"use "))="WP" D Q
	33699	"RTN","HMP UPD",40,0)
	33700	.. S WORK =$G(ARRAY( "telecom", I,"value") )
	33701	"RTN","HMP UPD",41,0)
	33702	.. I WORK =WORK("old ") S WORK= "" Q ;no c hange
	33703	"RTN","HMP UPD",42,0)
	33704	.. I "@"[ WORK S:$L( WORK("old" )) WORK="@ " Q ;dele te
	33705	"RTN","HMP UPD",43,0)
	33706	.. S WORK =$$FORMAT( WORK),ARRA Y("telecom ",I,"value ")=WORK
	33707	"RTN","HMP UPD",44,0)
	33708	S I="" F S I=$O(AR RAY("conta ct",I)) Q: I<1 D
	33709	"RTN","HMP UPD",45,0)
	33710	. S X=$P( $G(ARRAY(" contact",I ,"typeCode ")),":",4) Q:X="" ; NOK or ECO N
	33711	"RTN","HMP UPD",46,0)
	33712	. S J="" F S J=$O( ARRAY("con tact",I,"t elecom",J) ) Q:J<1 D
	33713	"RTN","HMP UPD",47,0)
	33714	.. Q:$G(A RRAY("cont act",I,"te lecom",J," use"))'="H "
	33715	"RTN","HMP UPD",48,0)
	33716	.. S @X=$ G(ARRAY("c ontact",I, "telecom", J,"value") )
	33717	"RTN","HMP UPD",49,0)
	33718	.. I @X=@ X@("old") S @X="" Q ;no change
	33719	"RTN","HMP UPD",50,0)
	33720	.. I "@"[ @X S:$L(@X @("old")) @X="@" Q ;delete
	33721	"RTN","HMP UPD",51,0)
	33722	.. S @X=$ $FORMAT(@X ),ARRAY("c ontact",I, "telecom", J,"value") =@X
	33723	"RTN","HMP UPD",52,0)
	33724	.. ; X="N OK" S NOK= $$FORMAT(N OK),ARRAY( "contact", I,"telecom ",J,"value ")=NOK
	33725	"RTN","HMP UPD",53,0)
	33726	;
	33727	"RTN","HMP UPD",54,0)
	33728	S:$L(HOME ) HMPX(.13 1)=HOME,HM PDR=".131"
	33729	"RTN","HMP UPD",55,0)
	33730	S:$L(CELL ) HMPX(.13 4)=CELL,HM PDR=HMPDR_ $S($L(HMPD R):";",1:" ")_".134"
	33731	"RTN","HMP UPD",56,0)
	33732	S:$L(WORK ) HMPX(.13 2)=WORK,HM PDR=HMPDR_ $S($L(HMPD R):";",1:" ")_".132"
	33733	"RTN","HMP UPD",57,0)
	33734	S:$L(ECON ) HMPX(.33 9)=ECON,HM PDR=HMPDR_ $S($L(HMPD R):";",1:" ")_".339"
	33735	"RTN","HMP UPD",58,0)
	33736	S:$L(NOK) HMPX(.219 )=NOK,HMPD R=HMPDR_$S ($L(HMPDR) :";",1:"") _".219"
	33737	"RTN","HMP UPD",59,0)
	33738	I '$O(HMP X(0)) S ER R=$$ERR(3) G PHQ
	33739	"RTN","HMP UPD",60,0)
	33740	D EDIT^VA FCPTED(DFN ,"HMPX",HM PDR)
	33741	"RTN","HMP UPD",61,0)
	33742	S X=$G(^D PT(DFN,.13 )),OK=1 D ;check gl obal ;ICR 10035 DE28 18 ASF 11/ 12/15
	33743	"RTN","HMP UPD",62,0)
	33744	. I $L(HO ME),$S(HOM E="@":$L($ P(X,U)),1: (HMPX(.131 )'=$P(X,U) )) S OK=0
	33745	"RTN","HMP UPD",63,0)
	33746	. I $L(CE LL),$S(CEL L="@":$L($ P(X,U,4)), 1:(HMPX(.1 34)'=$P(X, U,4))) S O K=0
	33747	"RTN","HMP UPD",64,0)
	33748	. I $L(WO RK),$S(WOR K="@":$L($ P(X,U,2)), 1:(HMPX(.1 32)'=$P(X, U,2))) S O K=0
	33749	"RTN","HMP UPD",65,0)
	33750	. I $L(EC ON) S X=$G (^DPT(DFN, .33)) I $S (ECON="@": $L($P(X,U, 9)),1:(HMP X(.339)'=$ P(X,U,9))) S OK=0 ;I CR 10035 D E2818 ASF 11/12/15
	33751	"RTN","HMP UPD",66,0)
	33752	. I $L(NO K) S X=$G( ^DPT(DFN,. 21)) I $S( NOK="@":$L ($P(X,U,9) ),1:(HMPX( .219)'=$P( X,U,9))) S OK=0 ;ICR 10035 DE2 818 ASF 11 /12/15
	33753	"RTN","HMP UPD",67,0)
	33754	S:'OK ERR =$$ERR(5)
	33755	"RTN","HMP UPD",68,0)
	33756	;
	33757	"RTN","HMP UPD",69,0)
	33758	PHQ ; add item count and termi nating cha racters
	33759	"RTN","HMP UPD",70,0)
	33760	I $D(ERR) S HMP(1)= "{""apiVer sion"":""1 .01"",""er ror"":{""m essage"":" ""_ERR_""" },""succes s"":false} " G PQ
	33761	"RTN","HMP UPD",71,0)
	33762	; HMP="{" "apiVersio n"":""1.01 "",""data" ":{""updat ed"":"_""" "_$$HL7NOW _""""_","" localId"": """_DFN_"" "},""succe ss"":true} "
	33763	"RTN","HMP UPD",72,0)
	33764	D POSTX^H MPEVNT("pa tient",DFN )
	33765	"RTN","HMP UPD",73,0)
	33766	D ENCODE^ HMPJSON("A RRAY","HMP ","HMPERR" )
	33767	"RTN","HMP UPD",74,0)
	33768	I $D(HMPE RR) D G P Q
	33769	"RTN","HMP UPD",75,0)
	33770	. K HMP N HMPTMP,HM PTXT
	33771	"RTN","HMP UPD",76,0)
	33772	. S HMPTX T(1)="Prob lem encodi ng json ou tput."
	33773	"RTN","HMP UPD",77,0)
	33774	. D SETER ROR^HMPUTI LS(.HMPTMP ,.HMPERR,. HMPTXT,.AR RAY)
	33775	"RTN","HMP UPD",78,0)
	33776	. K HMPER R D ENCODE ^HMPJSON(" HMPTMP","H MP","HMPER R")
	33777	"RTN","HMP UPD",79,0)
	33778	. S HMP(. 5)="{""api Version"": ""1.01""," "error"":{ ",HMP(99)= "}}"
	33779	"RTN","HMP UPD",80,0)
	33780	S HMP(.5) ="{""apiVe rsion"":"" 1.01"",""p arams"":{" _$$SYS^HMP DJ_"},""su ccess"":tr ue,"
	33781	"RTN","HMP UPD",81,0)
	33782	S HMP(.6) ="""data"" :{""update d"":"""_$$ HL7NOW^HMP DJ_""",""t otalItems" ":1,""item s"":["
	33783	"RTN","HMP UPD",82,0)
	33784	S HMP(99) ="]}}"
	33785	"RTN","HMP UPD",83,0)
	33786	PQ ; exit
	33787	"RTN","HMP UPD",84,0)
	33788	K ^TMP($J ,"HMP")
	33789	"RTN","HMP UPD",85,0)
	33790	M ^TMP($J ,"HMP")=HM P
	33791	"RTN","HMP UPD",86,0)
	33792	K HMP S H MP=$NA(^TM P($J,"HMP" ))
	33793	"RTN","HMP UPD",87,0)
	33794	Q
	33795	"RTN","HMP UPD",88,0)
	33796	;
	33797	"RTN","HMP UPD",89,0)
	33798	FORMAT(X) ; -- enfor ce (xxx)xx x-xxxx pho ne format
	33799	"RTN","HMP UPD",90,0)
	33800	S X=$G(X) I X?1"("3 N1")"3N1"- "4N.E Q X
	33801	"RTN","HMP UPD",91,0)
	33802	N P,N,I,Y S P=""
	33803	"RTN","HMP UPD",92,0)
	33804	F I=1:1:$ L(X) S N=$ E(X,I) I N =+N S P=P_ N
	33805	"RTN","HMP UPD",93,0)
	33806	S:$L(P)<1 0 P=$E("00 00000000", 1,10-$L(P) )_P
	33807	"RTN","HMP UPD",94,0)
	33808	S Y=$S(P: "("_$E(P,1 ,3)_")"_$E (P,4,6)_"- "_$E(P,7,1 0),1:"")
	33809	"RTN","HMP UPD",95,0)
	33810	Q Y
	33811	"RTN","HMP UPD",96,0)
	33812	;
	33813	"RTN","HMP UPD",97,0)
	33814	HL7NOW() ; -- Return current t ime in HL7 format
	33815	"RTN","HMP UPD",98,0)
	33816	Q $P($$FM THL7^XLFDT ($$NOW^XLF DT),"-")
	33817	"RTN","HMP UPD",99,0)
	33818	;
	33819	"RTN","HMP UPD",100,0 )
	33820	ERR(X,VAL) ; -- retu rn error m essage
	33821	"RTN","HMP UPD",101,0 )
	33822	N MSG S MSG="Error "
	33823	"RTN","HMP UPD",102,0 )
	33824	I X=1 S MSG="Patie nt with df n '"_$G(VA L)_"' not found"
	33825	"RTN","HMP UPD",103,0 )
	33826	I X=2 S MSG="Domai n type '"_ $G(VAL)_"' not recog nized"
	33827	"RTN","HMP UPD",104,0 )
	33828	I X=3 S MSG="Data not change d"
	33829	"RTN","HMP UPD",105,0 )
	33830	I X=4 S MSG="Unabl e to creat e new obje ct"
	33831	"RTN","HMP UPD",106,0 )
	33832	I X=5 S MSG="Updat e failed"
	33833	"RTN","HMP UPD",107,0 )
	33834	I X=99 S MSG="Unkno wn request "
	33835	"RTN","HMP UPD",108,0 )
	33836	Q MSG
	33837	"RTN","HMP UPD",109,0 )
	33838	;
	33839	"RTN","HMP UPD",110,0 )
	33840	VAL(SUB) ; -- pull v alues from ^DPT
	33841	"RTN","HMP UPD",111,0 )
	33842	N X S X=$ G(^DPT(DFN ,.13)) ;IC R 10035 DE 2818 ASF 1 1/12/15
	33843	"RTN","HMP UPD",112,0 )
	33844	S HOME(SU B)=$P(X,U) ,CELL(SUB) =$P(X,U,4) ,WORK(SUB) =$P(X,U,2)
	33845	"RTN","HMP UPD",113,0 )
	33846	S X=$G(^D PT(DFN,.33 )),ECON(SU B)=$P(X,U, 9) ;ICR 10 035 DE2818 ASF 11/12 /15
	33847	"RTN","HMP UPD",114,0 )
	33848	S X=$G(^D PT(DFN,.21 )),NOK(SUB )=$P(X,U,9 ) ;ICR 100 35 DE2818 ASF 11/12/ 15
	33849	"RTN","HMP UPD",115,0 )
	33850	Q
	33851	"RTN","HMP UTIL1")
	33852	0^127^B427 64058
	33853	"RTN","HMP UTIL1",1,0 )
	33854	HMPUTIL1 ; SLC/AGP,AS MR/RRB,CPC - HMP uti lities rou tine ; Jan 29, 2016 13:09:59
	33855	"RTN","HMP UTIL1",2,0 )
	33856	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	33857	"RTN","HMP UTIL1",3,0 )
	33858	;Per VA D irective 6 402, this routine sh ould not b e modified .
	33859	"RTN","HMP UTIL1",4,0 )
	33860	;
	33861	"RTN","HMP UTIL1",5,0 )
	33862	Q
	33863	"RTN","HMP UTIL1",6,0 )
	33864	;
	33865	"RTN","HMP UTIL1",7,0 )
	33866	; ADHOC s ubroutine refactored for DE178 8
	33867	"RTN","HMP UTIL1",8,0 )
	33868	ADHOC(HMPD MINP,HMPFC NT,DFN) ; Add syncSt art metast amp and sy ncStatus t o unsolici ted update s
	33869	"RTN","HMP UTIL1",9,0 )
	33870	Q:($G(HMP DMINP)="") !($G(DFN)= "") ; dom ain and DF N required
	33871	"RTN","HMP UTIL1",10, 0)
	33872	; HMPFCNT = count o f objects, passed by ref.
	33873	"RTN","HMP UTIL1",11, 0)
	33874	; expects HMPFSTR ( set in HMP DJFSG) is ^XTMP fres hness stre am subscri pt
	33875	"RTN","HMP UTIL1",12, 0)
	33876	; the hea ding from APIHDR^HMP DJFSG is i n ^TMP("HM PF",$J) al ready
	33877	"RTN","HMP UTIL1",13, 0)
	33878	; the JSO N built he re is plac ed inside a JSON arr ay, with a '[' after the headi ng
	33879	"RTN","HMP UTIL1",14, 0)
	33880	;
	33881	"RTN","HMP UTIL1",15, 0)
	33882	N HMPA4JS N,HMPDAT,H MPDMTOT,HM PDOM,HMPID ,HMPJSERR, HMPJSON,HM PSUB,I,J,L STLN,QTE,S UB,X,Y,DEL JSON
	33883	"RTN","HMP UTIL1",16, 0)
	33884	N HMPJSNS Y
	33885	"RTN","HMP UTIL1",17, 0)
	33886	; HMPA4JS N, HMPJSON , HMPJSERR - used fo r JSON enc oder
	33887	"RTN","HMP UTIL1",18, 0)
	33888	; HMPA4JS N - array to encode
	33889	"RTN","HMP UTIL1",19, 0)
	33890	; HMPJSON - JSON re sult
	33891	"RTN","HMP UTIL1",20, 0)
	33892	; HMPJSER R - error text from encoder
	33893	"RTN","HMP UTIL1",21, 0)
	33894	; QTE - " character
	33895	"RTN","HMP UTIL1",22, 0)
	33896	; HMPJSNS Y - The sy stem id va lue for th e JSON Enc oder, If f ully numer ic it need s a " prep ended
	33897	"RTN","HMP UTIL1",23, 0)
	33898	S HMPDAT( "DELDATE") ="",QTE=$C (34)
	33899	"RTN","HMP UTIL1",24, 0)
	33900	S HMPDMTO T=0 ; dom ain total
	33901	"RTN","HMP UTIL1",25, 0)
	33902	; Save de lete date/ time for l ater use.
	33903	"RTN","HMP UTIL1",26, 0)
	33904	I $G(ACT) ="@" D
	33905	"RTN","HMP UTIL1",27, 0)
	33906	.S Y=$$FM TH^XLFDT($ P(HMPFSTRM ,"~",3)) ; Get the date from fresh stre am (HMPFS~ <server>~< date>)
	33907	"RTN","HMP UTIL1",28, 0)
	33908	.S Y=$$HT FM^XLFDT($ P(Y,",")_" ,"_$G(ARGS ("hmp-fst" ),0)) ; A dd delete time store d in ARGS( "hmp-fst")
	33909	"RTN","HMP UTIL1",29, 0)
	33910	.S HMPDAT ("DELDATE" )=$$JSONDT ^HMPUTILS( Y) ; dele te date/ti me into JS ON format
	33911	"RTN","HMP UTIL1",30, 0)
	33912	.S DELJSO N="{""pid" ":"""_$$PI D^HMPDJFS( DFN)_"""," "removed"" :""true"", ""stampTim e"":"_$$JS ONDT^HMPUT ILS(Y)_"," "uid"":""" _$G(HMP97) _"""}"
	33913	"RTN","HMP UTIL1",31, 0)
	33914	;
	33915	"RTN","HMP UTIL1",32, 0)
	33916	S HMPA4JS N=$NA(^TMP ($J,"ARRAY 4JSON")) K @HMPA4JSN ; data ar ray for JS ON
	33917	"RTN","HMP UTIL1",33, 0)
	33918	S HMPJSON =$NA(^TMP( $J,"JSONRE SULT")) K @HMPJSON ; JSON res ult
	33919	"RTN","HMP UTIL1",34, 0)
	33920	;
	33921	"RTN","HMP UTIL1",35, 0)
	33922	S HMPDAT( "STAMPTIME ")=$$EN^HM PSTMP("NOW "),HMPID=$ $SYS^HMPUT ILS,HMPJSN SY=$S(+HMP ID=HMPID:" """_HMPID, 1:HMPID)
	33923	"RTN","HMP UTIL1",36, 0)
	33924	;
	33925	"RTN","HMP UTIL1",37, 0)
	33926	D:DFN'="O PD" ; get PID data for patien t
	33927	"RTN","HMP UTIL1",38, 0)
	33928	.N ITM,VA L ; $$PID S returns: ,"pid":"9 E4B;3","sy stemId":"9 E4B","loca lId":"3"," icn":"1020 7V420718"
	33929	"RTN","HMP UTIL1",39, 0)
	33930	.S Y=$$PI DS^HMPDJFS (DFN) ; p arse Y, re move quote s save val ues in HMP ID('item')
	33931	"RTN","HMP UTIL1",40, 0)
	33932	.F J=2:1: $L(Y,",") S X=$P(Y," ,",J),ITM= $TR($P(X," :"),QTE),V AL=$TR($P( X,":",2),Q TE) S:ITM] "" HMPID(I TM)=VAL
	33933	"RTN","HMP UTIL1",41, 0)
	33934	;
	33935	"RTN","HMP UTIL1",42, 0)
	33936	; transfo rm domain name for q uick order s to match the uid
	33937	"RTN","HMP UTIL1",43, 0)
	33938	S HMPDOM= HMPDMINP I HMPDOM="q uick" S HM PDOM="qo"
	33939	"RTN","HMP UTIL1",44, 0)
	33940	;
	33941	"RTN","HMP UTIL1",45, 0)
	33942	; stamp t ime put in to HMPDAT( "STAMPTIME ")
	33943	"RTN","HMP UTIL1",46, 0)
	33944	S HMPSUB= ""
	33945	"RTN","HMP UTIL1",47, 0)
	33946	S HMPDAT( "STAMPTIME ")=""
	33947	"RTN","HMP UTIL1",48, 0)
	33948	F S HMPS UB=$O(^TMP ("HMP",$J, HMPSUB)) Q :'HMPSUB D
	33949	"RTN","HMP UTIL1",49, 0)
	33950	.N DONE,H MPN,NEXT,S RCH,HMPDAT P ;cpc 201 5/10/21
	33951	"RTN","HMP UTIL1",50, 0)
	33952	.S SRCH=" ""uid"""_" :"_""""_"u rn:va:"_HM PDOM_":"
	33953	"RTN","HMP UTIL1",51, 0)
	33954	.; Search back from last reco rd - but i nclude sta rt of next to cover crossovers
	33955	"RTN","HMP UTIL1",52, 0)
	33956	.S HMPDAT ="" ;cpc 2 015/10/21
	33957	"RTN","HMP UTIL1",53, 0)
	33958	.S HMPN=" ",HMPDAT(" UID")="",D ONE=""
	33959	"RTN","HMP UTIL1",54, 0)
	33960	.F S HMP N=$O(^TMP( "HMP",$J,H MPSUB,HMPN ),-1) Q:'H MPN D Q: DONE
	33961	"RTN","HMP UTIL1",55, 0)
	33962	..S HMPDA TP=$E(HMPD AT,1,100) ;cpc 2015/ 10/21
	33963	"RTN","HMP UTIL1",56, 0)
	33964	..S HMPDA T=$G(^TMP( "HMP",$J,H MPSUB,HMPN )) Q:HMPDA T="null"!' $L(HMPDAT)
	33965	"RTN","HMP UTIL1",57, 0)
	33966	..S HMPDA T=HMPDAT_H MPDATP ;cp c 2015/10/ 21 - look for crosso ver data
	33967	"RTN","HMP UTIL1",58, 0)
	33968	..;Search for last occurrence of uid in record (t his will b e parent)
	33969	"RTN","HMP UTIL1",59, 0)
	33970	..I '$G(H MPDAT(HMPS UB,"UID")) ,$F(HMPDAT ,SRCH) F I =2:1 S NEX T=$P($P(HM PDAT,SRCH, I),QTE) Q: NEXT="" S HMPDAT(HM PSUB,"UID" )=NEXT ;cp c 2015/10/ 21
	33971	"RTN","HMP UTIL1",60, 0)
	33972	..;BL;CPC Extract s tamptime i f present (patient d ata ONLY)
	33973	"RTN","HMP UTIL1",61, 0)
	33974	..;cpc 20 15/10/09 - condition alize test s
	33975	"RTN","HMP UTIL1",62, 0)
	33976	..I '$G(H MPDAT(HMPS UB,"STAMPT IME")),$F( HMPDAT,"st ampTime") D ;cpc 20 15/10/21
	33977	"RTN","HMP UTIL1",63, 0)
	33978	...S HMPD AT(HMPSUB, "STAMPTIME ")=$P($P(H MPDAT,"""s tampTime"" :",2),",")
	33979	"RTN","HMP UTIL1",64, 0)
	33980	...;Keep the latest stamptime so that w e can use it for the overall m etastamp
	33981	"RTN","HMP UTIL1",65, 0)
	33982	...I HMPD AT(HMPSUB, "STAMPTIME ")>HMPDAT( "STAMPTIME ") S HMPDA T("STAMPTI ME")=HMPDA T(HMPSUB," STAMPTIME" )
	33983	"RTN","HMP UTIL1",66, 0)
	33984	..;Patien t data req uires both UID and s tampTime t o be compl ete
	33985	"RTN","HMP UTIL1",67, 0)
	33986	..S:$G(HM PDAT(HMPSU B,"UID"))& $G(HMPDAT( HMPSUB,"ST AMPTIME")) DONE=1
	33987	"RTN","HMP UTIL1",68, 0)
	33988	..;cpc 20 15/10/09 - end
	33989	"RTN","HMP UTIL1",69, 0)
	33990	;
	33991	"RTN","HMP UTIL1",70, 0)
	33992	; HMP97 i s uid, SET in FRESHI TM^HMPDJFS G
	33993	"RTN","HMP UTIL1",71, 0)
	33994	I $G(ACT) ="@" S HMP DAT("UID") =$P($G(HMP 97),":",4, 99)
	33995	"RTN","HMP UTIL1",72, 0)
	33996	;
	33997	"RTN","HMP UTIL1",73, 0)
	33998	S @HMPA4J SN@("colle ction")=$S (DFN="OPD" :"OPDsyncS tart",1:"s yncStart")
	33999	"RTN","HMP UTIL1",74, 0)
	34000	I DFN="OP D" S @HMPA 4JSN@("sys temId")=$P (HMPID,";" ) ; set sy stemId for OPD
	34001	"RTN","HMP UTIL1",75, 0)
	34002	S X="" F S X=$O(HM PID(X)) Q: X="" S @H MPA4JSN@(X )=HMPID(X) ; add pi d, systemI d, localId , icn
	34003	"RTN","HMP UTIL1",76, 0)
	34004	;
	34005	"RTN","HMP UTIL1",77, 0)
	34006	; build m etastamp c omponents
	34007	"RTN","HMP UTIL1",78, 0)
	34008	S SUB="me taStamp"
	34009	"RTN","HMP UTIL1",79, 0)
	34010	S X="" F S X=$O(HM PID(X)) Q: X="" S @H MPA4JSN@(S UB,X)=HMPI D(X) ; ad d pid, sys temId, loc alId, icn
	34011	"RTN","HMP UTIL1",80, 0)
	34012	S @HMPA4J SN@(SUB,"s tampTime") =HMPDAT("S TAMPTIME")
	34013	"RTN","HMP UTIL1",81, 0)
	34014	;
	34015	"RTN","HMP UTIL1",82, 0)
	34016	S SUB(1)= "sourceMet aStamp",X= ""
	34017	"RTN","HMP UTIL1",83, 0)
	34018	F S X=$O (HMPID(X)) Q:X="" S @HMPA4JSN @(SUB,SUB( 1),HMPID,X )=HMPID(X) ; add pi d, systemI d, localId , icn
	34019	"RTN","HMP UTIL1",84, 0)
	34020	S @HMPA4J SN@(SUB,SU B(1),HMPJS NSY,"stamp Time")=HMP DAT("STAMP TIME")
	34021	"RTN","HMP UTIL1",85, 0)
	34022	;
	34023	"RTN","HMP UTIL1",86, 0)
	34024	S SUB(2)= "domainMet aStamp"
	34025	"RTN","HMP UTIL1",87, 0)
	34026	S @HMPA4J SN@(SUB,SU B(1),HMPJS NSY,SUB(2) ,HMPDOM,"d omain")=HM PDOM
	34027	"RTN","HMP UTIL1",88, 0)
	34028	S @HMPA4J SN@(SUB,SU B(1),HMPJS NSY,SUB(2) ,HMPDOM,"s tampTime") =$S($L($G( HMPDAT("DE LDATE"))): HMPDAT("DE LDATE"),1: HMPDAT("ST AMPTIME"))
	34029	"RTN","HMP UTIL1",89, 0)
	34030	;
	34031	"RTN","HMP UTIL1",90, 0)
	34032	; Loop th rough HMPS UB to gene rate the e ventMetast amp
	34033	"RTN","HMP UTIL1",91, 0)
	34034	S SUB(3)= $S(DFN="OP D":"itemMe taStamp",1 :"eventMet aStamp"),H MPSUB="" ; cpc 2015/1 0/22
	34035	"RTN","HMP UTIL1",92, 0)
	34036	F S HMPS UB=$O(HMPD AT(HMPSUB) ) Q:'HMPSU B D
	34037	"RTN","HMP UTIL1",93, 0)
	34038	.S SUB(4) ="urn:va:" _HMPDOM_": "_$S($G(AC T)="@":HMP DAT("UID") ,1:HMPDAT( HMPSUB,"UI D")) ;CPC won't exis t for dele tion
	34039	"RTN","HMP UTIL1",94, 0)
	34040	.S @HMPA4 JSN@(SUB,S UB(1),HMPJ SNSY,SUB(2 ),HMPDOM,S UB(3),SUB( 4),"stampT ime")=$S($ L($G(HMPDA T("DELDATE "))):HMPDA T("DELDATE "),1:HMPDA T(HMPSUB," STAMPTIME" ))
	34041	"RTN","HMP UTIL1",95, 0)
	34042	;
	34043	"RTN","HMP UTIL1",96, 0)
	34044	D ENCODE^ HMPJSON(HM PA4JSN,HMP JSON,"HMPJ SERR")
	34045	"RTN","HMP UTIL1",97, 0)
	34046	I $D(HMPJ SERR) S $E C=",JSON e ncode erro r in unsol icited upd ate," Q
	34047	"RTN","HMP UTIL1",98, 0)
	34048	; find la st line of JSON
	34049	"RTN","HMP UTIL1",99, 0)
	34050	S LSTLN=0 F J=1:1 Q :'$D(@HMPJ SON@(J)) S LSTLN=J
	34051	"RTN","HMP UTIL1",100 ,0)
	34052	; Merge i n data sec tion from FRESHITM^H MPDJFSG
	34053	"RTN","HMP UTIL1",101 ,0)
	34054	; Add a c omma after the syncS tart Messa ge for the actual da ta
	34055	"RTN","HMP UTIL1",102 ,0)
	34056	S @HMPJSO N@(LSTLN,. 3)=","
	34057	"RTN","HMP UTIL1",103 ,0)
	34058	S HMPSUB= ""
	34059	"RTN","HMP UTIL1",104 ,0)
	34060	;
	34061	"RTN","HMP UTIL1",105 ,0)
	34062	; do the merge
	34063	"RTN","HMP UTIL1",106 ,0)
	34064	F S HMPS UB=$O(^TMP ("HMP",$J, HMPSUB)) Q :'HMPSUB D
	34065	"RTN","HMP UTIL1",107 ,0)
	34066	.N HMPX,H MPDATA
	34067	"RTN","HMP UTIL1",108 ,0)
	34068	.S LSTLN= LSTLN+1
	34069	"RTN","HMP UTIL1",109 ,0)
	34070	.; If it is patient data add the wrappe r with pid
	34071	"RTN","HMP UTIL1",110 ,0)
	34072	.I DFN'=" OPD" S @HM PJSON@(LST LN,.4)="{" "collectio n"":"""_HM PDOM_""""_ $$PIDS^HMP DJFS(DFN)_ ",""seq"": 1,""total" ":1,""obje ct"":"_$S( $G(ACT)="@ ":DELJSON, 1:"")
	34073	"RTN","HMP UTIL1",111 ,0)
	34074	.; If it is operati onal data add the wr apper with out pid
	34075	"RTN","HMP UTIL1",112 ,0)
	34076	.I DFN="O PD",$G(ACT )="@" S @H MPJSON@(LS TLN,.4)="{ ""collecti on"":"""_H MPDOM_""", ""seq"":1, ""total"": 1,""object "":"_DELJS ON ;;US564 7
	34077	"RTN","HMP UTIL1",113 ,0)
	34078	.; If it is operati onal data and to be deleted
	34079	"RTN","HMP UTIL1",114 ,0)
	34080	.I DFN="O PD",$G(ACT )'="@" D ;US5859
	34081	"RTN","HMP UTIL1",115 ,0)
	34082	..S @HMPJ SON@(LSTLN ,.4)="{""c ollection" ":"""_HMPD OM_""",""s eq"":1,""t otal"":1," "object"": "
	34083	"RTN","HMP UTIL1",116 ,0)
	34084	..S HMPX= """stampTi me"":"_QTE _$S($L($G( HMPDAT("DE LDATE"))): HMPDAT("DE LDATE"),1: HMPDAT("ST AMPTIME")) _QTE_","
	34085	"RTN","HMP UTIL1",117 ,0)
	34086	..S HMPDA TA=^TMP("H MP",$J,HMP SUB,1)
	34087	"RTN","HMP UTIL1",118 ,0)
	34088	..S ^TMP( "HMP",$J,H MPSUB,1)=" {"_HMPX_$P (HMPDATA," {",2,999)
	34089	"RTN","HMP UTIL1",119 ,0)
	34090	.M @HMPJS ON@(LSTLN) =^TMP("HMP ",$J,HMPSU B)
	34091	"RTN","HMP UTIL1",120 ,0)
	34092	.; Close the wrappe r
	34093	"RTN","HMP UTIL1",121 ,0)
	34094	.S HMPCLF LG=1
	34095	"RTN","HMP UTIL1",122 ,0)
	34096	.; Add th e closing brace for the wrappe r
	34097	"RTN","HMP UTIL1",123 ,0)
	34098	.S @HMPJS ON@(LSTLN+ 1,.1)="}"
	34099	"RTN","HMP UTIL1",124 ,0)
	34100	.; Increm ent the do main total
	34101	"RTN","HMP UTIL1",125 ,0)
	34102	.S HMPDMT OT=HMPDMTO T+1
	34103	"RTN","HMP UTIL1",126 ,0)
	34104	;
	34105	"RTN","HMP UTIL1",127 ,0)
	34106	S HMPFCNT =$G(HMPFCN T)+1
	34107	"RTN","HMP UTIL1",128 ,0)
	34108	M ^TMP("H MPF",$J,HM PFCNT)=@HM PJSON
	34109	"RTN","HMP UTIL1",129 ,0)
	34110	; need a comma if m ore than o ne item
	34111	"RTN","HMP UTIL1",130 ,0)
	34112	I HMPFCNT >1 S ^TMP( "HMPF",$J, HMPFCNT,.3 )=$S(HMPLI TEM="SYNC" :"},",1:", ") S HMPLI TEM="FRESH " ; DE3502
	34113	"RTN","HMP UTIL1",131 ,0)
	34114	;
	34115	"RTN","HMP UTIL1",132 ,0)
	34116	; clean u p residual data in ^ TMP($J), m ay be quit e a lot
	34117	"RTN","HMP UTIL1",133 ,0)
	34118	K @HMPA4J SN,@HMPJSO N
	34119	"RTN","HMP UTIL1",134 ,0)
	34120	Q
	34121	"RTN","HMP UTIL1",135 ,0)
	34122	;
	34123	"RTN","HMP UTILS")
	34124	0^128^B390 59234
	34125	"RTN","HMP UTILS",1,0 )
	34126	HMPUTILS ; SLC/AGP,AS MR/RRB -- HMP utilit ies routin e ;8/14/13 11:22
	34127	"RTN","HMP UTILS",2,0 )
	34128	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	34129	"RTN","HMP UTILS",3,0 )
	34130	;Per VA D irective 6 402, this routine sh ould not b e modified .
	34131	"RTN","HMP UTILS",4,0 )
	34132	;
	34133	"RTN","HMP UTILS",5,0 )
	34134	; Externa l Referenc es DBIA#
	34135	"RTN","HMP UTILS",6,0 )
	34136	; ------- ---------- -- -----
	34137	"RTN","HMP UTILS",7,0 )
	34138	; XLFCRC 3156
	34139	"RTN","HMP UTILS",8,0 )
	34140	; XLFDT 10103
	34141	"RTN","HMP UTILS",9,0 )
	34142	; XLFUTL 2622
	34143	"RTN","HMP UTILS",10, 0)
	34144	; XUPARAM 2541
	34145	"RTN","HMP UTILS",11, 0)
	34146	;
	34147	"RTN","HMP UTILS",12, 0)
	34148	; DE2818/ RRB: SQA f indings 1s t 3 lines
	34149	"RTN","HMP UTILS",13, 0)
	34150	Q
	34151	"RTN","HMP UTILS",14, 0)
	34152	;
	34153	"RTN","HMP UTILS",15, 0)
	34154	CHKSP(HMPF HMP) ; -- ^XTMP chec k before p atient sub scription starts to cache B EGINS68-P JH
	34155	"RTN","HMP UTILS",16, 0)
	34156	; Input H MPFHMP - s erver name
	34157	"RTN","HMP UTILS",17, 0)
	34158	N HMPOK
	34159	"RTN","HMP UTILS",18, 0)
	34160	S HMPOK=0
	34161	"RTN","HMP UTILS",19, 0)
	34162	F D Q:H MPOK
	34163	"RTN","HMP UTILS",20, 0)
	34164	. ; -- if ok to run , reset DI SK USAGE S TATUS to ' WITHIN LIM IT' and co ntinue ; U S8228
	34165	"RTN","HMP UTILS",21, 0)
	34166	. I $$OKT ORUN^HMPDJ FSP("subsc ribe") S H MPOK=1 D S TATUS^HMPM ETA(HMPOK, HMPFHMP) Q ; US8228
	34167	"RTN","HMP UTILS",22, 0)
	34168	. ; -- ot herwise ma ke sure DI SK USAGE S TATUS is ' EXCEEDED L IMIT' and wait ; US8 228
	34169	"RTN","HMP UTILS",23, 0)
	34170	. D STATU S^HMPMETA( HMPOK,HMPF HMP) H $$G ETSECS^HMP DJFSP ; U S8228
	34171	"RTN","HMP UTILS",24, 0)
	34172	Q ; EN DS68-PJH
	34173	"RTN","HMP UTILS",25, 0)
	34174	;
	34175	"RTN","HMP UTILS",26, 0)
	34176	SETERROR(R ESULT,ERRO R,EXTERROR ,DATA) ; - - error te xt for JSO N
	34177	"RTN","HMP UTILS",27, 0)
	34178	N CNT,TEM P,HMPTEMP, XCNT
	34179	"RTN","HMP UTILS",28, 0)
	34180	S HMPTEMP ="HMPXTEMP ERRORS"
	34181	"RTN","HMP UTILS",29, 0)
	34182	I '$D(^XT MP(HMPTEMP ,0)) S ^XT MP(HMPTEMP ,0)=$$FMAD D^XLFDT(DT ,7)_U_DT_U _"HMP ERRO R GLOBAL"
	34183	"RTN","HMP UTILS",30, 0)
	34184	S RESULT( "success") ="false"
	34185	"RTN","HMP UTILS",31, 0)
	34186	I $D(DATA ) S XCNT=$ O(^XTMP(HM PTEMP,""), -1)+1 M ^X TMP(HMPTEM P,XCNT,"ER ROR")=DATA
	34187	"RTN","HMP UTILS",32, 0)
	34188	I $D(ERRO R) D SETER RTX(.TEMP, .ERROR) S RESULT("er ror","code ")=TEMP
	34189	"RTN","HMP UTILS",33, 0)
	34190	I +$G(XCN T)>0 S RES ULT("error ","code")= $G(RESULT( "error","c ode"))_" S ee ^XTMP(" _HMPTEMP_" ,"_XCNT_", DATA) for data"
	34191	"RTN","HMP UTILS",34, 0)
	34192	I $D(EXTE RROR) D SE TERRTX(.TE MP,.EXTERR OR) I TEMP '="" S RES ULT("error ","message ")=TEMP
	34193	"RTN","HMP UTILS",35, 0)
	34194	;
	34195	"RTN","HMP UTILS",36, 0)
	34196	Q
	34197	"RTN","HMP UTILS",37, 0)
	34198	;
	34199	"RTN","HMP UTILS",38, 0)
	34200	SETERRTX(T EMP,ERROR) ;
	34201	"RTN","HMP UTILS",39, 0)
	34202	S TEMP=""
	34203	"RTN","HMP UTILS",40, 0)
	34204	S CNT=0 F S CNT=$O (ERROR(CNT )) Q:CNT'> 0 D
	34205	"RTN","HMP UTILS",41, 0)
	34206	.S TEMP=$ S(TEMP'="" :TEMP=TEMP _$C(13,10) _ERROR(CNT ),1:ERROR( CNT))
	34207	"RTN","HMP UTILS",42, 0)
	34208	Q
	34209	"RTN","HMP UTILS",43, 0)
	34210	;
	34211	"RTN","HMP UTILS",44, 0)
	34212	SETTEXT(X, VALUE) ; - - format w ord proces sing
	34213	"RTN","HMP UTILS",45, 0)
	34214	N FIRST,I ,LINE
	34215	"RTN","HMP UTILS",46, 0)
	34216	S FIRST=1
	34217	"RTN","HMP UTILS",47, 0)
	34218	S I=0 F S I=$O(@X@ (I)) Q:I<1 D
	34219	"RTN","HMP UTILS",48, 0)
	34220	.S LINE=$ S($D(@X@(I ,0)):@X@(I ,0),1:@X@( I))
	34221	"RTN","HMP UTILS",49, 0)
	34222	.; FIRST= 1 S @VALUE @(I)=LINE, FIRST=0 Q
	34223	"RTN","HMP UTILS",50, 0)
	34224	.S @VALUE @(I)=LINE_ $C(13)_$C( 10)
	34225	"RTN","HMP UTILS",51, 0)
	34226	Q
	34227	"RTN","HMP UTILS",52, 0)
	34228	;
	34229	"RTN","HMP UTILS",53, 0)
	34230	SPLITVAL(N ODE,ARRAY) ; -- spli t a value into a lis t
	34231	"RTN","HMP UTILS",54, 0)
	34232	N CNT,NAM E,VALUE,FI ELD
	34233	"RTN","HMP UTILS",55, 0)
	34234	S NAME="" F S NAME =$O(ARRAY( NAME)) Q:N AME="" D
	34235	"RTN","HMP UTILS",56, 0)
	34236	.S CNT=+A RRAY(NAME)
	34237	"RTN","HMP UTILS",57, 0)
	34238	.S VALUE= $P($G(NODE ),U,CNT)
	34239	"RTN","HMP UTILS",58, 0)
	34240	.I NAME=" Code" S FI ELD=$P(ARR AY(NAME),U ,2) S VALU E=$$SETVUR N(FIELD,VA LUE)
	34241	"RTN","HMP UTILS",59, 0)
	34242	.S ARRAY( NAME)=VALU E
	34243	"RTN","HMP UTILS",60, 0)
	34244	Q
	34245	"RTN","HMP UTILS",61, 0)
	34246	;
	34247	"RTN","HMP UTILS",62, 0)
	34248	SETPROV(NO DE,PROV) ; -- provid ers
	34249	"RTN","HMP UTILS",63, 0)
	34250	S PROV("p roviderUid ")=$$SETUI D("user",, +NODE)
	34251	"RTN","HMP UTILS",64, 0)
	34252	S PROV("p roviderNam e")=$P(NOD E,U,2)
	34253	"RTN","HMP UTILS",65, 0)
	34254	Q
	34255	"RTN","HMP UTILS",66, 0)
	34256	;
	34257	"RTN","HMP UTILS",67, 0)
	34258	SETUID(DOM AIN,PAT,ID ,ADDDATA) ; -- creat e uid stri ng
	34259	"RTN","HMP UTILS",68, 0)
	34260	N RESULT, SYS
	34261	"RTN","HMP UTILS",69, 0)
	34262	S SYS=$S( $D(HMPSYS) :HMPSYS,1: $$GET^XPAR ("SYS","HM P SYSTEM N AME"))
	34263	"RTN","HMP UTILS",70, 0)
	34264	S RESULT= "urn:va:"_ DOMAIN_":" _SYS_":"_$ S($G(PAT): PAT_":",1: "")_ID
	34265	"RTN","HMP UTILS",71, 0)
	34266	I $L($G(A DDDATA)) S RESULT=RE SULT_":"_A DDDATA
	34267	"RTN","HMP UTILS",72, 0)
	34268	Q RESULT
	34269	"RTN","HMP UTILS",73, 0)
	34270	;
	34271	"RTN","HMP UTILS",74, 0)
	34272	SETFCURN(D OMAIN,FACI LITY,VALUE ) ; -- cre ate facili ty urn
	34273	"RTN","HMP UTILS",75, 0)
	34274	Q "urn:va :"_DOMAIN_ ":"_FACILI TY_":"_VAL UE
	34275	"RTN","HMP UTILS",76, 0)
	34276	;
	34277	"RTN","HMP UTILS",77, 0)
	34278	SETVURN(DO MAIN,VALUE ) ; -- cre ate VA urn
	34279	"RTN","HMP UTILS",78, 0)
	34280	N RESULT S RESULT=" "
	34281	"RTN","HMP UTILS",79, 0)
	34282	S RESULT= "urn:va:"_ DOMAIN_":" _VALUE
	34283	"RTN","HMP UTILS",80, 0)
	34284	Q RESULT
	34285	"RTN","HMP UTILS",81, 0)
	34286	;
	34287	"RTN","HMP UTILS",82, 0)
	34288	SYS() ; -- return ha shed syste m name
	34289	"RTN","HMP UTILS",83, 0)
	34290	Q $$BASE^ XLFUTL($$C RC16^XLFCR C($$KSP^XU PARAM("WHE RE")),10,1 6)
	34291	"RTN","HMP UTILS",84, 0)
	34292	;
	34293	"RTN","HMP UTILS",85, 0)
	34294	SETNCS(COD ESET,VALUE ) ; -- cre ate nation al codeset urn
	34295	"RTN","HMP UTILS",86, 0)
	34296	Q "urn:"_ CODESET_": "_VALUE
	34297	"RTN","HMP UTILS",87, 0)
	34298	;
	34299	"RTN","HMP UTILS",88, 0)
	34300	JSONDT(X) ; -- conve rt FileMan DT to HL7 DT for JS ON
	34301	"RTN","HMP UTILS",89, 0)
	34302	N D,DATE, M,TIME,Y
	34303	"RTN","HMP UTILS",90, 0)
	34304	S DATE=$P ($$FMTHL7^ XLFDT(X)," -")
	34305	"RTN","HMP UTILS",91, 0)
	34306	I $L(DATE )>8 S TIME =$E(DATE,9 ,$L(DATE))
	34307	"RTN","HMP UTILS",92, 0)
	34308	S Y=$E(DA TE,1,4),M= $E(DATE,5, 6),D=$E(DA TE,7,8)
	34309	"RTN","HMP UTILS",93, 0)
	34310	K DATE
	34311	"RTN","HMP UTILS",94, 0)
	34312	S DATE=Y I M>0 S DA TE=DATE_M S:D>0 DATE =DATE_D
	34313	"RTN","HMP UTILS",95, 0)
	34314	I $G(TIME )'="" D S DATE=DATE _TIME
	34315	"RTN","HMP UTILS",96, 0)
	34316	. N S S S =$E(TIME_" 000000",5, 6)
	34317	"RTN","HMP UTILS",97, 0)
	34318	. I S,S>5 9 S TIME=$ E(TIME,1,4 ) ;strip b ad seconds
	34319	"RTN","HMP UTILS",98, 0)
	34320	Q DATE
	34321	"RTN","HMP UTILS",99, 0)
	34322	;
	34323	"RTN","HMP UTILS",100 ,0)
	34324	FACILITY(X ,Y) ; -- a dd facilit y info to array for JSON
	34325	"RTN","HMP UTILS",101 ,0)
	34326	; X=STAT ION NUMBER ^STATION N AME
	34327	"RTN","HMP UTILS",102 ,0)
	34328	; Y=Vari able array name
	34329	"RTN","HMP UTILS",103 ,0)
	34330	; >D FACI LITY^HMPUT ILS("500^C AMP MASTER ","LAB")
	34331	"RTN","HMP UTILS",104 ,0)
	34332	;
	34333	"RTN","HMP UTILS",105 ,0)
	34334	S @Y@("fa cilityCode ")=$P(X,"^ ")
	34335	"RTN","HMP UTILS",106 ,0)
	34336	S @Y@("fa cilityName ")=$P(X,"^ ",2)
	34337	"RTN","HMP UTILS",107 ,0)
	34338	Q
	34339	"RTN","HMP UTILS",108 ,0)
	34340	VERSRV() ; Return server ver sion of op tion name
	34341	"RTN","HMP UTILS",109 ,0)
	34342	N HMPLST, VAL
	34343	"RTN","HMP UTILS",110 ,0)
	34344	D FIND^DI C(19,"",1, "X","HMP U I CONTEXT" ,1,,,,"HMP LST")
	34345	"RTN","HMP UTILS",111 ,0)
	34346	S VAL=$G( HMPLST("DI LIST","ID" ,1,1))
	34347	"RTN","HMP UTILS",112 ,0)
	34348	Q $$UP^XL FSTR($P(VA L,"version ",2))
	34349	"RTN","HMP UTILS",113 ,0)
	34350	;
	34351	"RTN","HMP UTILS",114 ,0)
	34352	VERCMP(CUR ,VAL) ; Re turns 1 if CUR<VAL, -1 if CUR> VAL, 0 if equal
	34353	"RTN","HMP UTILS",115 ,0)
	34354	N CURMAJO R,CURMINOR ,CURSNAP,V ALMAJOR,VA LMINOR,VAL SNAP
	34355	"RTN","HMP UTILS",116 ,0)
	34356	S CURMAJO R=$P(CUR," -"),CURMIN OR=$P(CUR, "-",2),CUR SNAP=$E($P (CUR,"-",3 ),1,4)="SN AP"
	34357	"RTN","HMP UTILS",117 ,0)
	34358	S VALMAJO R=$P(VAL," -"),VALMIN OR=$P(VAL, "-",2),VAL SNAP=$E($P (VAL,"-",3 ),1,4)="SN AP"
	34359	"RTN","HMP UTILS",118 ,0)
	34360	I $E(VALM INOR)="P" S VALMINOR =$E(VALMIN OR,2,99) ; "P"il ot version s (old)
	34361	"RTN","HMP UTILS",119 ,0)
	34362	I $E(CURM INOR)="P" S CURMINOR =$E(VALMIN OR,2,99)
	34363	"RTN","HMP UTILS",120 ,0)
	34364	I $E(VALM INOR)="S" S VALMINOR =$E(VALMIN OR,2,99)*1 0 ; "S"pr int versio ns
	34365	"RTN","HMP UTILS",121 ,0)
	34366	I $E(CURM INOR)="S" S CURMINOR =$E(CURMIN OR,2,99)*1 0
	34367	"RTN","HMP UTILS",122 ,0)
	34368	Q:VALMAJO R>CURMAJOR 1 Q:VAL MAJOR<CURM AJOR -1 ; compare m ajor versi ons
	34369	"RTN","HMP UTILS",123 ,0)
	34370	Q:VALMINO R>CURMINOR 1 Q:VAL MINOR<CURM INOR -1 ; compare m inor versi ons
	34371	"RTN","HMP UTILS",124 ,0)
	34372	Q:(CURSNA P&'VALSNAP ) 1 Q:(VA LSNAP&'CUR SNAP) -1 ; "SNAPSHOT " < releas ed
	34373	"RTN","HMP UTILS",125 ,0)
	34374	Q 0
	34375	"RTN","HMP UTILS",126 ,0)
	34376	;
	34377	"RTN","HMP UTILS",127 ,0)
	34378	WDWH() ; W hat kind o f data exi sts?
	34379	"RTN","HMP UTILS",128 ,0)
	34380	; HMPA = loop cou nter
	34381	"RTN","HMP UTILS",129 ,0)
	34382	; HMPB = dummy va riable
	34383	"RTN","HMP UTILS",130 ,0)
	34384	; HMPOPD = 1 if ope rational d ata exists
	34385	"RTN","HMP UTILS",131 ,0)
	34386	; "" otherw ise
	34387	"RTN","HMP UTILS",132 ,0)
	34388	; HMPPAT = 1 if pat ient data exists
	34389	"RTN","HMP UTILS",133 ,0)
	34390	; "" otherw ise
	34391	"RTN","HMP UTILS",134 ,0)
	34392	; HMPRET = return v ariable - 0 if no da ta exists
	34393	"RTN","HMP UTILS",135 ,0)
	34394	; 1 if ONLY patient da ta exists
	34395	"RTN","HMP UTILS",136 ,0)
	34396	; 2 if ONLY operationa l data exi sts
	34397	"RTN","HMP UTILS",137 ,0)
	34398	; 3 if BOTH patient an d operatio nal data e xist
	34399	"RTN","HMP UTILS",138 ,0)
	34400	N HMPA,HM POPD,HMPPA T,HMPRET
	34401	"RTN","HMP UTILS",139 ,0)
	34402	S (HMPOPD ,HMPPAT)=" ",HMPA="HM PFX",HMPRE T=0
	34403	"RTN","HMP UTILS",140 ,0)
	34404	F S HMPA =$O(^XTMP( HMPA)) Q:H MPA']"" D
	34405	"RTN","HMP UTILS",141 ,0)
	34406	.S HMPB=$ P(HMPA,"~" ,3)
	34407	"RTN","HMP UTILS",142 ,0)
	34408	.I HMPB=" OPD" S HMP OPD=1 Q
	34409	"RTN","HMP UTILS",143 ,0)
	34410	.I HMPB=+ HMPB S HMP PAT=1
	34411	"RTN","HMP UTILS",144 ,0)
	34412	I HMPPAT, 'HMPOPD S HMPRET=1
	34413	"RTN","HMP UTILS",145 ,0)
	34414	I 'HMPPAT ,HMPOPD S HMPRET=2
	34415	"RTN","HMP UTILS",146 ,0)
	34416	I HMPPAT, HMPOPD S H MPRET=3
	34417	"RTN","HMP UTILS",147 ,0)
	34418	Q HMPRET
	34419	"RTN","HMP UTILS",148 ,0)
	34420	;
	34421	"RTN","HMP UTILS",149 ,0)
	34422	NODATA(A) ; Is there any patie nt data; J D - 2/23/1 5
	34423	"RTN","HMP UTILS",150 ,0)
	34424	; Returns 1 if ther e is no pa tient data
	34425	"RTN","HMP UTILS",151 ,0)
	34426	; 0 Otherw ise
	34427	"RTN","HMP UTILS",152 ,0)
	34428	; HMPA = Loop count er
	34429	"RTN","HMP UTILS",153 ,0)
	34430	; HMPF = Dummy vari able
	34431	"RTN","HMP UTILS",154 ,0)
	34432	N HMPA,HM PF
	34433	"RTN","HMP UTILS",155 ,0)
	34434	S HMPF=0, HMPA=""
	34435	"RTN","HMP UTILS",156 ,0)
	34436	F S HMPA =$O(^XTMP( A,0,"count ",HMPA)) Q :HMPF!(HMP A']"") D
	34437	"RTN","HMP UTILS",157 ,0)
	34438	.I +$G(^X TMP(A,0,"c ount",HMPA ))>0 S HMP F=1 Q
	34439	"RTN","HMP UTILS",158 ,0)
	34440	Q $S(HMPF :0,1:1)
	34441	"RTN","HMP UTILS",159 ,0)
	34442	;
	34443	"RTN","HMP UTILS",160 ,0)
	34444	GETSIZE(HM PMODE,HMPS RVN) ; -- returns cu rrent aggr egate extr act size f or extract s waiting to be sent to HMP se rvers
	34445	"RTN","HMP UTILS",161 ,0)
	34446	; input: HMPMODE := [ estimat e - use es timated do main avera ge sizes ( default) \|
	34447	"RTN","HMP UTILS",162 ,0)
	34448	; actual - walk tho ugh object nodes to calculate using $LEN GTH ]
	34449	"RTN","HMP UTILS",163 ,0)
	34450	; HMPSRVN := name of H MP server [optional - defaults to all HM P servers]
	34451	"RTN","HMP UTILS",164 ,0)
	34452	; returns : total si ze ^ objec t count
	34453	"RTN","HMP UTILS",165 ,0)
	34454	;
	34455	"RTN","HMP UTILS",166 ,0)
	34456	; -- loop thru extr acts for s erver(s)
	34457	"RTN","HMP UTILS",167 ,0)
	34458	N ROOT,BA TCH,TASK,D OMAIN,OBJS ,OBJCNT,OB JSIZES,TOT AL
	34459	"RTN","HMP UTILS",168 ,0)
	34460	S HMPMODE =$G(HMPMOD E,"estimat e")
	34461	"RTN","HMP UTILS",169 ,0)
	34462	I HMPMODE ="estimate " D GETLST ^XPAR(.OBJ SIZES,"PKG ","HMP DOM AIN SIZES" ,"I")
	34463	"RTN","HMP UTILS",170 ,0)
	34464	S (OBJCNT ,TOTAL)=0
	34465	"RTN","HMP UTILS",171 ,0)
	34466	S ROOT="H MPFX~"_$S( $G(HMPSRVN )]"":HMPSR VN_"~",1:" ")
	34467	"RTN","HMP UTILS",172 ,0)
	34468	S BATCH=R OOT
	34469	"RTN","HMP UTILS",173 ,0)
	34470	F S BATC H=$O(^XTMP (BATCH)) Q :$E(BATCH, 1,$L(ROOT) )'=ROOT D
	34471	"RTN","HMP UTILS",174 ,0)
	34472	. S TASK= 0 F S TAS K=$O(^XTMP (BATCH,TAS K)) Q:'TAS K D
	34473	"RTN","HMP UTILS",175 ,0)
	34474	. . S DOM AIN="" F S DOMAIN=$ O(^XTMP(BA TCH,TASK,D OMAIN)) Q: DOMAIN="" D
	34475	"RTN","HMP UTILS",176 ,0)
	34476	. . . S O BJS=+$O(^X TMP(BATCH, TASK,DOMAI N," "),-1)
	34477	"RTN","HMP UTILS",177 ,0)
	34478	. . . S O BJCNT=OBJC NT+OBJS
	34479	"RTN","HMP UTILS",178 ,0)
	34480	. . . I H MPMODE="ac tual" S TO TAL=TOTAL+ $$WALK(BAT CH,TASK,DO MAIN) Q
	34481	"RTN","HMP UTILS",179 ,0)
	34482	. . . S T OTAL=TOTAL +(OBJS*$G( OBJSIZES($ P(DOMAIN," #")),1000) )
	34483	"RTN","HMP UTILS",180 ,0)
	34484	Q TOTAL_" ^"_OBJCNT
	34485	"RTN","HMP UTILS",181 ,0)
	34486	;
	34487	"RTN","HMP UTILS",182 ,0)
	34488	WALK(BATCH ,TASK,DOMA IN) ; -- w alk throug h domain o bjectS in task to ge t actual s ize
	34489	"RTN","HMP UTILS",183 ,0)
	34490	N OBJ,SIZ E,NODE
	34491	"RTN","HMP UTILS",184 ,0)
	34492	S (OBJ,SI ZE)=0
	34493	"RTN","HMP UTILS",185 ,0)
	34494	F S OBJ= $O(^XTMP(B ATCH,TASK, DOMAIN,OBJ )) Q:'OBJ D
	34495	"RTN","HMP UTILS",186 ,0)
	34496	. S NODE= 0 F S NOD E=$O(^XTMP (BATCH,TAS K,DOMAIN,O BJ,NODE)) Q:'NODE S SIZE=SIZE +$L(^(NODE ))
	34497	"RTN","HMP UTILS",187 ,0)
	34498	Q SIZE
	34499	"RTN","HMP WB")
	34500	1^192
	34501	"RTN","HMP WB1")
	34502	1^193
	34503	"RTN","HMP WB2")
	34504	1^194
	34505	"RTN","HMP XGDPT")
	34506	0^142^B201 9789
	34507	"RTN","HMP XGDPT",1,0 )
	34508	HMPXGDPT ; ASMR/PB - Patient F ile Utilit ies;Nov 03 , 2015 18: 23:03
	34509	"RTN","HMP XGDPT",2,0 )
	34510	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;No vember 30, 2015;Build 63
	34511	"RTN","HMP XGDPT",3,0 )
	34512	;Per VA D irective 6 402, this routine sh ould not b e modified .
	34513	"RTN","HMP XGDPT",4,0 )
	34514	;
	34515	"RTN","HMP XGDPT",5,0 )
	34516	; Externa l Referenc es
	34517	"RTN","HMP XGDPT",6,0 )
	34518	; ------- ---------- --
	34519	"RTN","HMP XGDPT",7,0 )
	34520	; Patient File - IA 10035
	34521	"RTN","HMP XGDPT",8,0 )
	34522	; DBIA332 7
	34523	"RTN","HMP XGDPT",9,0 )
	34524	;
	34525	"RTN","HMP XGDPT",10, 0)
	34526	Q
	34527	"RTN","HMP XGDPT",11, 0)
	34528	;
	34529	"RTN","HMP XGDPT",12, 0)
	34530	TOP(HMPARR AY,HMPDFN, HMPFLDS,HM PFLG) ; re turns data based on the DFN an d the list of fields supplied.
	34531	"RTN","HMP XGDPT",13, 0)
	34532	;This API only retu rns fields that are at the top level of the record .
	34533	"RTN","HMP XGDPT",14, 0)
	34534	;It will not return data from multiples , use the LOWER API to return fields fro m a multip le in the Patient fi le.
	34535	"RTN","HMP XGDPT",15, 0)
	34536	;Data is returned i n the arra y passed i n the ARRA Y paramete r. Data is returned for both i nternal an d external values.
	34537	"RTN","HMP XGDPT",16, 0)
	34538	;
	34539	"RTN","HMP XGDPT",17, 0)
	34540	; HMPARRA Y - result array, pa ssed by re ference
	34541	"RTN","HMP XGDPT",18, 0)
	34542	; HMPDFN - IEN of t he Patient , required
	34543	"RTN","HMP XGDPT",19, 0)
	34544	; HMPFLDS - FileMan field lis t (optiona l), if not passed al l fields r eturned
	34545	"RTN","HMP XGDPT",20, 0)
	34546	; HMPFLG - FileMan data flag (optional)
	34547	"RTN","HMP XGDPT",21, 0)
	34548	;
	34549	"RTN","HMP XGDPT",22, 0)
	34550	N DA,DR,D IQ,DIC,FLA GS
	34551	"RTN","HMP XGDPT",23, 0)
	34552	Q:$G(HMPD FN)="" ;D FN must be defined
	34553	"RTN","HMP XGDPT",24, 0)
	34554	Q:$G(HMPF LDS)="" ; FLDS must have a lea st one fie ld defined . Fields a re listed by field n umber and separated by a semi colon
	34555	"RTN","HMP XGDPT",25, 0)
	34556	S:'$G(HMP FLG) FLAGS ="IE"
	34557	"RTN","HMP XGDPT",26, 0)
	34558	S DIC=2,D R=HMPFLDS, DA=HMPDFN, DIQ=HMPARR AY,DIQ(0)= $G(HMPFLG)
	34559	"RTN","HMP XGDPT",27, 0)
	34560	D EN^DIQ1
	34561	"RTN","HMP XGDPT",28, 0)
	34562	Q
	34563	"RTN","HMP XGDPT",29, 0)
	34564	;
	34565	"RTN","HMP XGDPT",30, 0)
	34566	INOUT(HMPD FN) ; Bool ean functi on, 1 for inpatient, else zero
	34567	"RTN","HMP XGDPT",31, 0)
	34568	N LOC S L OC=$G(^DPT (+$G(HMPDF N),.1)) Q $S($L(LOC) :1,1:0) ; ICR 10035, (#.1) WAR D LOCATION [E1,30F]
	34569	"RTN","HMP XGDPT",32, 0)
	34570	;
	34571	"RTN","HMP XGLAB")
	34572	0^143^B106 4430
	34573	"RTN","HMP XGLAB",1,0 )
	34574	HMPXGLAB ; ASMR/hrub ovcak - La b data ret rieval ;No v 05, 2015 15:27:37
	34575	"RTN","HMP XGLAB",2,0 )
	34576	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	34577	"RTN","HMP XGLAB",3,0 )
	34578	;Per VA D irective 6 402, this routine sh ould not b e modified .
	34579	"RTN","HMP XGLAB",4,0 )
	34580	;
	34581	"RTN","HMP XGLAB",5,0 )
	34582	Q
	34583	"RTN","HMP XGLAB",6,0 )
	34584	;
	34585	"RTN","HMP XGLAB",7,0 )
	34586	LABTSTNM(H MPLTIEN) ; function, return NAM E field (# .01) from LABORATORY TEST file (#60)
	34587	"RTN","HMP XGLAB",8,0 )
	34588	; IA 1005 4 - NAME c an be read with File Man
	34589	"RTN","HMP XGLAB",9,0 )
	34590	; HMPLTIE N - Lab Te st IEN (re quired)
	34591	"RTN","HMP XGLAB",10, 0)
	34592	Q:'($G(HM PLTIEN)>0) "ERROR: L ab Test IE N missing"
	34593	"RTN","HMP XGLAB",11, 0)
	34594	;
	34595	"RTN","HMP XGLAB",12, 0)
	34596	N DA,DIC, DIQ,DR,FLA GS,HMPRSLT ,HMPTSTNM
	34597	"RTN","HMP XGLAB",13, 0)
	34598	S DIC=60, DR=".01",D A=HMPLTIEN ,DIQ="HMPR SLT",DIQ(0 )="E",FLAG S="E"
	34599	"RTN","HMP XGLAB",14, 0)
	34600	D EN^DIQ1
	34601	"RTN","HMP XGLAB",15, 0)
	34602	;
	34603	"RTN","HMP XGLAB",16, 0)
	34604	Q $G(HMPR SLT(60,HMP LTIEN,.01, "E"))
	34605	"RTN","HMP XGLAB",17, 0)
	34606	;
	34607	"RTN","HMP XGLAB",18, 0)
	34608	LRDFN(HMPD FN) ;funct ion, retur n LRDFN fr om PATIENT file
	34609	"RTN","HMP XGLAB",19, 0)
	34610	;
	34611	"RTN","HMP XGLAB",20, 0)
	34612	Q:'($G(HM PDFN)>0) " " ; patie nt's DFN r equired
	34613	"RTN","HMP XGLAB",21, 0)
	34614	;
	34615	"RTN","HMP XGLAB",22, 0)
	34616	N HMPDEMO G
	34617	"RTN","HMP XGLAB",23, 0)
	34618	D TOP^HMP XGDPT("HMP DEMOG",HMP DFN,"63"," I") ; (#6 3) LABORAT ORY REFERE NCE
	34619	"RTN","HMP XGLAB",24, 0)
	34620	Q $G(HMPD EMOG(2,HMP DFN,63,"I" ))
	34621	"RTN","HMP XGLAB",25, 0)
	34622	;
	34623	"RTN","HMP XGNP")
	34624	0^145^B129 9808
	34625	"RTN","HMP XGNP",1,0)
	34626	HMPXGNP ; ASMR/hrubo vcak - NEW PERSON fi le (#200) data retri eval ;Nov 03, 2015 1 8:23:03
	34627	"RTN","HMP XGNP",2,0)
	34628	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	34629	"RTN","HMP XGNP",3,0)
	34630	;Per VA D irective 6 402, this routine sh ould not b e modified .
	34631	"RTN","HMP XGNP",4,0)
	34632	;
	34633	"RTN","HMP XGNP",5,0)
	34634	Q
	34635	"RTN","HMP XGNP",6,0)
	34636	; IA 1006 0 - All NE W PERSON f ields supp orted for read via F ileMan
	34637	"RTN","HMP XGNP",7,0)
	34638	;
	34639	"RTN","HMP XGNP",8,0)
	34640	TOP(HMPRSL T,HMPNPIEN ,HMPFLDS,H MPFLG) ; r eturn top- level fiel ds, null f ields not returned
	34641	"RTN","HMP XGNP",9,0)
	34642	; HMPRSLT - result array, clo sed refere nce, requi red
	34643	"RTN","HMP XGNP",10,0 )
	34644	; HMPNPIE N - IEN of NEW PERSO N, require d
	34645	"RTN","HMP XGNP",11,0 )
	34646	; HMPFLDS - field l ist, requi red, FileM an convent ion
	34647	"RTN","HMP XGNP",12,0 )
	34648	; HMPFLG - data fla g, optiona l, FileMan conventio n
	34649	"RTN","HMP XGNP",13,0 )
	34650	;
	34651	"RTN","HMP XGNP",14,0 )
	34652	Q:'$L($G( HMPRSLT))
	34653	"RTN","HMP XGNP",15,0 )
	34654	;
	34655	"RTN","HMP XGNP",16,0 )
	34656	K @HMPRSL T ; clear all resul ts
	34657	"RTN","HMP XGNP",17,0 )
	34658	; error d ata is fou nd in -1 s ubscript
	34659	"RTN","HMP XGNP",18,0 )
	34660	I '($G(HM PNPIEN)>0) S @HMPRSL T@(-1,$T(+ 0))="NEW P ERSON IEN required" Q
	34661	"RTN","HMP XGNP",19,0 )
	34662	I $G(HMPF LDS)="" S @HMPRSLT@( -1,$T(+0)) ="NEW PERS ON fields required" Q
	34663	"RTN","HMP XGNP",20,0 )
	34664	I '$L($G( HMPFLG)) N HMPFLG S HMPFLG="EI N"
	34665	"RTN","HMP XGNP",21,0 )
	34666	N DA,DIC, DIQ,DR,FLA GS ; File Man variab les
	34667	"RTN","HMP XGNP",22,0 )
	34668	S DIC=200 ,DR=HMPFLD S,DA=HMPNP IEN,DIQ=HM PRSLT,DIQ( 0)=HMPFLG, FLAGS=HMPF LG
	34669	"RTN","HMP XGNP",23,0 )
	34670	D EN^DIQ1
	34671	"RTN","HMP XGNP",24,0 )
	34672	Q
	34673	"RTN","HMP XGNP",25,0 )
	34674	;
	34675	"RTN","HMP XGORD")
	34676	0^144^B256 8884
	34677	"RTN","HMP XGORD",1,0 )
	34678	HMPXGORD ; ASMR/hrub ovcak - OR DER file ( #100) data retrieval ;Nov 03, 2015 18:23 :03
	34679	"RTN","HMP XGORD",2,0 )
	34680	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	34681	"RTN","HMP XGORD",3,0 )
	34682	;Per VA D irective 6 402, this routine sh ould not b e modified .
	34683	"RTN","HMP XGORD",4,0 )
	34684	;
	34685	"RTN","HMP XGORD",5,0 )
	34686	Q
	34687	"RTN","HMP XGORD",6,0 )
	34688	;
	34689	"RTN","HMP XGORD",7,0 )
	34690	TOP(HMPRSL T,HMPORIEN ,HMPFLDS,H MPFLG) ; r eturn top- level fiel ds
	34691	"RTN","HMP XGORD",8,0 )
	34692	; HMPRSLT - result array, clo sed refere nce, requi red
	34693	"RTN","HMP XGORD",9,0 )
	34694	; HMPORIE N - IEN of NEW PERSO N, require d
	34695	"RTN","HMP XGORD",10, 0)
	34696	; HMPFLDS - field l ist, requi red, FileM an convent ion
	34697	"RTN","HMP XGORD",11, 0)
	34698	; HMPFLG - data fla g, optiona l, FileMan conventio n
	34699	"RTN","HMP XGORD",12, 0)
	34700	;
	34701	"RTN","HMP XGORD",13, 0)
	34702	Q:'$L($G( HMPRSLT))
	34703	"RTN","HMP XGORD",14, 0)
	34704	;
	34705	"RTN","HMP XGORD",15, 0)
	34706	K @HMPRSL T ; clear all resul ts
	34707	"RTN","HMP XGORD",16, 0)
	34708	; error d ata is fou nd in -1 s ubscript
	34709	"RTN","HMP XGORD",17, 0)
	34710	I '($G(HM PORIEN)>0) S @HMPRSL T@(-1,$T(+ 0))="ORDER IEN requi red" Q
	34711	"RTN","HMP XGORD",18, 0)
	34712	I $G(HMPF LDS)="" S @HMPRSLT@( -1,$T(+0)) ="ORDER fi elds requi red" Q
	34713	"RTN","HMP XGORD",19, 0)
	34714	I '$L($G( HMPFLG)) N HMPFLG S HMPFLG="EI N" ; defa ult is ext ernal and internal, skip nulls
	34715	"RTN","HMP XGORD",20, 0)
	34716	N DA,DIC, DIQ,DR,FLA GS ; File Man variab les
	34717	"RTN","HMP XGORD",21, 0)
	34718	S DIC=100 ,DR=HMPFLD S,DA=HMPOR IEN,DIQ=HM PRSLT,DIQ( 0)=HMPFLG, FLAGS=HMPF LG
	34719	"RTN","HMP XGORD",22, 0)
	34720	D EN^DIQ1
	34721	"RTN","HMP XGORD",23, 0)
	34722	Q
	34723	"RTN","HMP XGORD",24, 0)
	34724	;
	34725	"RTN","HMP XGORD",25, 0)
	34726	DIALOG(HMP ORIEN) ; f unction, r eturn (#2) DIALOG [5 V] for ORD ER
	34727	"RTN","HMP XGORD",26, 0)
	34728	Q $P($G(^ OR(100,+$G (HMPORIEN) ,0)),"^",5 )
	34729	"RTN","HMP XGORD",27, 0)
	34730	;
	34731	"RTN","HMP XGORD",28, 0)
	34732	ORDTOP(HMP ORDFL,HMPO RDIEN,HMPO RDND) ; fu nction, re turn top-l evel node from a fil e in ^ORD (file list below)
	34733	"RTN","HMP XGORD",29, 0)
	34734	;
	34735	"RTN","HMP XGORD",30, 0)
	34736	I '($G(HM PORDFL)>0) !'($G(HMPO RDIEN)>0)! '$L($G(HMP ORDND)) Q "" ; all required
	34737	"RTN","HMP XGORD",31, 0)
	34738	;
	34739	"RTN","HMP XGORD",32, 0)
	34740	Q $G(^ORD (HMPORDFL, HMPORDIEN, HMPORDND)) ; return s internal format
	34741	"RTN","HMP XGORD",33, 0)
	34742	;
	34743	"RTN","HMP XGORD",34, 0)
	34744	;
	34745	"RTN","HMP XGORD",35, 0)
	34746	; files i n the ^ORD global:
	34747	"RTN","HMP XGORD",36, 0)
	34748	;
	34749	"RTN","HMP XGORD",37, 0)
	34750	;ORDER ST ATUS (#100 .01)
	34751	"RTN","HMP XGORD",38, 0)
	34752	;NATURE O F ORDER (# 100.02)
	34753	"RTN","HMP XGORD",39, 0)
	34754	;ORDER RE ASON (#100 .03)
	34755	"RTN","HMP XGORD",40, 0)
	34756	;ORDER CH ECK INSTAN CES (#100. 05)
	34757	"RTN","HMP XGORD",41, 0)
	34758	;OE/RR PR INT FIELDS (#100.22)
	34759	"RTN","HMP XGORD",42, 0)
	34760	;OE/RR PR INT FORMAT S (#100.23 )
	34761	"RTN","HMP XGORD",43, 0)
	34762	;OE/RR RE LEASE EVEN TS (#100.5 )
	34763	"RTN","HMP XGORD",44, 0)
	34764	;OE/RR AU TO-DC RULE S (#100.6)
	34765	"RTN","HMP XGORD",45, 0)
	34766	;OE/RR EP CS PARAMET ERS (#100. 7)
	34767	"RTN","HMP XGORD",46, 0)
	34768	;ORDER CH ECKS (#100 .8)
	34769	"RTN","HMP XGORD",47, 0)
	34770	;OE/RR NO TIFICATION S (#100.9)
	34771	"RTN","HMP XGORD",48, 0)
	34772	;DISPLAY GROUP (#10 0.98)
	34773	"RTN","HMP XGORD",49, 0)
	34774	;ORDER PA RAMETERS ( #100.99)
	34775	"RTN","HMP XGORD",50, 0)
	34776	;PROTOCOL (#101)
	34777	"RTN","HMP XGORD",51, 0)
	34778	;OR CPRS TABS (#101 .13)
	34779	"RTN","HMP XGORD",52, 0)
	34780	;OE/RR CO M OBJECTS (#101.15)
	34781	"RTN","HMP XGORD",53, 0)
	34782	;OE/RR RE PORT (#101 .24)
	34783	"RTN","HMP XGORD",54, 0)
	34784	;ORDER EX ECUTE CODE S (#101.3)
	34785	"RTN","HMP XGORD",55, 0)
	34786	;ORDER DI ALOG (#101 .41)
	34787	"RTN","HMP XGORD",56, 0)
	34788	;ORDER UR GENCY (#10 1.42)
	34789	"RTN","HMP XGORD",57, 0)
	34790	;ORDERABL E ITEMS (# 101.43)
	34791	"RTN","HMP XGORD",58, 0)
	34792	;ORDER QU ICK VIEW ( #101.44)
	34793	"RTN","HMP XGORD",59, 0)
	34794	;CPRS QUE RY DEFINIT ION (#102. 21)
	34795	"RTN","HMP XGORD",60, 0)
	34796	;CPRS QUE RY CONSTRA INT (#102. 22)
	34797	"RTN","HMP XGORD",61, 0)
	34798	;CPRS QUE RY EDIT CO NTROL (#10 2.23)
	34799	"RTN","HMP XGORD",62, 0)
	34800	;CPRS QUE RY DISPLAY FIELDS (# 102.24)
	34801	"RTN","HMP XGORD",63, 0)
	34802	;
	34803	"RTN","HMP XGSD")
	34804	0^146^B260 2100
	34805	"RTN","HMP XGSD",1,0)
	34806	HMPXGSD ; ASMR/hrubo vcak - Sch eduling da ta retriev al ;Nov 20 , 2015 01: 49:50
	34807	"RTN","HMP XGSD",2,0)
	34808	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	34809	"RTN","HMP XGSD",3,0)
	34810	;Per VA D irective 6 402, this routine sh ould not b e modified .
	34811	"RTN","HMP XGSD",4,0)
	34812	;
	34813	"RTN","HMP XGSD",5,0)
	34814	Q
	34815	"RTN","HMP XGSD",6,0)
	34816	;
	34817	"RTN","HMP XGSD",7,0)
	34818	; DE2818, code belo w adapted from CLINL OC^ORWU
	34819	"RTN","HMP XGSD",8,0)
	34820	CLINLOC(RS LT,FROM,DI R) ; retur n list of clinics fr om HOSPITA L LOCATION file (#44 )
	34821	"RTN","HMP XGSD",9,0)
	34822	; all 3 a rguments r equired
	34823	"RTN","HMP XGSD",10,0 )
	34824	; RSLT=re turned lis t (passed by referen ce), FROM= text to $O RDER from, DIR=$ORDE R directio n
	34825	"RTN","HMP XGSD",11,0 )
	34826	; RSLT(co unter) = I EN^locatio n name
	34827	"RTN","HMP XGSD",12,0 )
	34828	N I,IEN,L OCNM ; co unter, int ernal entr y number, location n ame
	34829	"RTN","HMP XGSD",13,0 )
	34830	S I=0,LOC NM=$G(FROM )
	34831	"RTN","HMP XGSD",14,0 )
	34832	F S LOCN M=$O(^SC(" B",LOCNM), DIR) Q:LOC NM="" D ; ICR 1004 0
	34833	"RTN","HMP XGSD",15,0 )
	34834	. S IEN=" " F S IEN =$O(^SC("B ",LOCNM,IE N),DIR) Q: 'IEN D
	34835	"RTN","HMP XGSD",16,0 )
	34836	.. Q:'($ P($G(^SC(I EN,0)),U,3 )="C") ; check (#2) TYPE [3S] , must be clinic
	34837	"RTN","HMP XGSD",17,0 )
	34838	.. Q:'$$ ACTLOC(IEN ) ; must be active
	34839	"RTN","HMP XGSD",18,0 )
	34840	.. S I=I +1,RSLT(I) =IEN_"^"_L OCNM
	34841	"RTN","HMP XGSD",19,0 )
	34842	;
	34843	"RTN","HMP XGSD",20,0 )
	34844	Q
	34845	"RTN","HMP XGSD",21,0 )
	34846	;
	34847	"RTN","HMP XGSD",22,0 )
	34848	; DE2818, code belo w adapted from ACTLO C^ORWU
	34849	"RTN","HMP XGSD",23,0 )
	34850	ACTLOC(LOC ) ; Boolea n function , TRUE if active hos pital loca tion
	34851	"RTN","HMP XGSD",24,0 )
	34852	; LOC - I EN in HOSP ITAL LOCAT ION file, ICR 10040
	34853	"RTN","HMP XGSD",25,0 )
	34854	; IND - t he "I" nod e, ^SC(D0, I) = (#250 5) INACTIV ATE DATE [ 1D] ^ (#25 06) REACTI VATE DATE [2D] ^
	34855	"RTN","HMP XGSD",26,0 )
	34856	; D0, X - used by W IN^DGPMDDC F
	34857	"RTN","HMP XGSD",27,0 )
	34858	N D0,IND, X
	34859	"RTN","HMP XGSD",28,0 )
	34860	Q:+$G(^SC (LOC,"OOS" )) 0 ; (# 50.01) OCC ASION OF S ERVICE CLI NIC?, scre en entry
	34861	"RTN","HMP XGSD",29,0 )
	34862	S D0=+$G( ^SC(LOC,42 )) I D0 D WIN^DGPMDD CF Q 'X ; check out -of-servic e wards, I CR 1246
	34863	"RTN","HMP XGSD",30,0 )
	34864	S IND=$G( ^SC(LOC,"I ")) Q:'IND 1 ; INAC TIVATE DAT E not foun d
	34865	"RTN","HMP XGSD",31,0 )
	34866	I DT>$P(I ND,U)&($P( IND,U,2)=" "!(DT<$P(I ND,U,2))) Q 0 ; che ck REACTIV ATE DATE
	34867	"RTN","HMP XGSD",32,0 )
	34868	Q 1 ; ac tive
	34869	"RTN","HMP XGSD",33,0 )
	34870	;
	34871	"RTN","HMP YCSI")
	34872	1^195
	34873	"RTN","HMP YCSO")
	34874	0^133^B220 00106
	34875	"RTN","HMP YCSO",1,0)
	34876	HMPYCSO ;S LC/MJK,ASM R/RRB - Co nvert syst em objects utility ; 8/2/11 15 :29
	34877	"RTN","HMP YCSO",2,0)
	34878	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Se p 01, 2011 ;Build 63
	34879	"RTN","HMP YCSO",3,0)
	34880	;Per VA D irective 6 402, this routine sh ould not b e modified .
	34881	"RTN","HMP YCSO",4,0)
	34882	;
	34883	"RTN","HMP YCSO",5,0)
	34884	; S68-JC H This ro utine intr oduced wit h S68
	34885	"RTN","HMP YCSO",6,0)
	34886	Q
	34887	"RTN","HMP YCSO",7,0)
	34888	;
	34889	"RTN","HMP YCSO",8,0)
	34890	CONV(HMPDA TA,HMPCNTS ) ; -- exe cute conve rsion over a system object typ e
	34891	"RTN","HMP YCSO",9,0)
	34892	; input: HMPDATA("t ype") := o bject type
	34893	"RTN","HMP YCSO",10,0 )
	34894	; - [ OPD - operation al (file # 800000.11) \| PT - HM P (file #8 00000.1) / default ]
	34895	"RTN","HMP YCSO",11,0 )
	34896	;
	34897	"RTN","HMP YCSO",12,0 )
	34898	; ("collect ion") := o bject coll ection nam e as it ap pears in " C" xref
	34899	"RTN","HMP YCSO",13,0 )
	34900	; - ex. "task"
	34901	"RTN","HMP YCSO",14,0 )
	34902	;
	34903	"RTN","HMP YCSO",15,0 )
	34904	; ("callb ack") := c allback co de to exec ute conver sion on si ngle objec t
	34905	"RTN","HMP YCSO",16,0 )
	34906	; - callbac k should e xpect deco ded array containing object to convert a nd IEN of object
	34907	"RTN","HMP YCSO",17,0 )
	34908	; - T AG^ROUTINE
	34909	"RTN","HMP YCSO",18,0 )
	34910	; - e x. TASK^HM PP3I
	34911	"RTN","HMP YCSO",19,0 )
	34912	; - callbac k must ret urn indica tor on how to procee d
	34913	"RTN","HMP YCSO",20,0 )
	34914	; - 1 : update converted object
	34915	"RTN","HMP YCSO",21,0 )
	34916	; - 0 : stop pr ocessing t his object ; no conve rsion need ed
	34917	"RTN","HMP YCSO",22,0 )
	34918	;
	34919	"RTN","HMP YCSO",23,0 )
	34920	; HMPCNTS : returns a rray of co unts relat ed to conv ersion [op tional]
	34921	"RTN","HMP YCSO",24,0 )
	34922	; - closed array ref erence
	34923	"RTN","HMP YCSO",25,0 )
	34924	; - Counts :
	34925	"RTN","HMP YCSO",26,0 )
	34926	; - HM PTALLY("co nverted") -> convers ion perfor med
	34927	"RTN","HMP YCSO",27,0 )
	34928	; ("er rored") -> errored at some p oint in pr ocess
	34929	"RTN","HMP YCSO",28,0 )
	34930	; ("pa ssed") -> no conv ersion nee ded
	34931	"RTN","HMP YCSO",29,0 )
	34932	; ("re viewed") -> count o f objects reviewed f or convers ion
	34933	"RTN","HMP YCSO",30,0 )
	34934	;
	34935	"RTN","HMP YCSO",31,0 )
	34936	N HMPTYPE ,HMPCOLL,H MPCB,X,HMP FILE,HMPZC NTS
	34937	"RTN","HMP YCSO",32,0 )
	34938	S HMPTYPE =$G(HMPDAT A("type"), "PT")
	34939	"RTN","HMP YCSO",33,0 )
	34940	S HMPCOLL =$G(HMPDAT A("collect ion"))
	34941	"RTN","HMP YCSO",34,0 )
	34942	S HMPCB=$ G(HMPDATA( "callback" ))
	34943	"RTN","HMP YCSO",35,0 )
	34944	;
	34945	"RTN","HMP YCSO",36,0 )
	34946	; - colle ction name and callb ack must b e defined
	34947	"RTN","HMP YCSO",37,0 )
	34948	I HMPCOLL =""!(HMPCB ="") Q
	34949	"RTN","HMP YCSO",38,0 )
	34950	;
	34951	"RTN","HMP YCSO",39,0 )
	34952	I HMPTYPE '="PT",HMP TYPE'="OPD " Q
	34953	"RTN","HMP YCSO",40,0 )
	34954	;
	34955	"RTN","HMP YCSO",41,0 )
	34956	; -- curr ently only supports PT, as OPD has not b een tested
	34957	"RTN","HMP YCSO",42,0 )
	34958	I HMPTYPE '="PT" Q
	34959	"RTN","HMP YCSO",43,0 )
	34960	;
	34961	"RTN","HMP YCSO",44,0 )
	34962	; -- init ialize cou nts
	34963	"RTN","HMP YCSO",45,0 )
	34964	F X="revi ewed","err ored","con verted","p assed" S H MPZCNTS(X) =0
	34965	"RTN","HMP YCSO",46,0 )
	34966	;
	34967	"RTN","HMP YCSO",47,0 )
	34968	I HMPTYPE ="PT" D
	34969	"RTN","HMP YCSO",48,0 )
	34970	. N DFN,I EN
	34971	"RTN","HMP YCSO",49,0 )
	34972	. S HMPFI LE=800000. 1
	34973	"RTN","HMP YCSO",50,0 )
	34974	. S DFN=0 F S DFN= $O(^HMP(HM PFILE,"C", DFN)) Q:DF N'>0 D
	34975	"RTN","HMP YCSO",51,0 )
	34976	. . S IEN =0 F S IE N=$O(^HMP( HMPFILE,"C ",DFN,HMPC OLL,IEN)) Q:IEN'>0 D CONVOBJ( HMPFILE,IE N,HMPCB)
	34977	"RTN","HMP YCSO",52,0 )
	34978	E D
	34979	"RTN","HMP YCSO",53,0 )
	34980	. N IEN
	34981	"RTN","HMP YCSO",54,0 )
	34982	. S HMPFI LE=800000. 11
	34983	"RTN","HMP YCSO",55,0 )
	34984	. S IEN=0 F S IEN= $O(^HMP(HM PFILE,"C", HMPCOLL,IE N)) Q:IEN' >0 D CONV OBJ(HMPFIL E,IEN,HMPC B)
	34985	"RTN","HMP YCSO",56,0 )
	34986	;
	34987	"RTN","HMP YCSO",57,0 )
	34988	I $G(HMPC NTS)]"" M @HMPCNTS=H MPZCNTS
	34989	"RTN","HMP YCSO",58,0 )
	34990	Q
	34991	"RTN","HMP YCSO",59,0 )
	34992	;
	34993	"RTN","HMP YCSO",60,0 )
	34994	CONVOBJ(HM PFILE,IEN, HMPCB) ; - - convert object
	34995	"RTN","HMP YCSO",61,0 )
	34996	N HMPY,HM PTEMP,ERRO R,UID,I,HM P0,HMPCOLL
	34997	"RTN","HMP YCSO",62,0 )
	34998	S HMPY=$N A(^TMP($J, "HMPY"))
	34999	"RTN","HMP YCSO",63,0 )
	35000	S HMPTEMP =$NA(^TMP( $J,"HMPTEM P"))
	35001	"RTN","HMP YCSO",64,0 )
	35002	K @HMPY,@ HMPTEMP
	35003	"RTN","HMP YCSO",65,0 )
	35004	D TALLY(" reviewed")
	35005	"RTN","HMP YCSO",66,0 )
	35006	;
	35007	"RTN","HMP YCSO",67,0 )
	35008	S HMP0=$G (^HMP(HMPF ILE,IEN,0) )
	35009	"RTN","HMP YCSO",68,0 )
	35010	S HMPCOLL =$P(HMP0,U ,3)
	35011	"RTN","HMP YCSO",69,0 )
	35012	S UID=$P( HMP0,U)
	35013	"RTN","HMP YCSO",70,0 )
	35014	I UID="" D ERROR("E rror: JSO N "_HMPCOL L_" Object (IEN: "_I EN_") miss ing UID") Q
	35015	"RTN","HMP YCSO",71,0 )
	35016	;
	35017	"RTN","HMP YCSO",72,0 )
	35018	S I=0 F S I=$O(^HM P(HMPFILE, IEN,1,I)) Q:I<1 S X =$G(^(I,0) ),@HMPY@(I )=X
	35019	"RTN","HMP YCSO",73,0 )
	35020	;
	35021	"RTN","HMP YCSO",74,0 )
	35022	D DECODE^ HMPJSON(HM PY,HMPTEMP ,"ERROR")
	35023	"RTN","HMP YCSO",75,0 )
	35024	I $D(ERRO R) D ERROR ("Error in decoding JSON "_HMP COLL_" Obj ect (IEN: "_IEN_")") Q
	35025	"RTN","HMP YCSO",76,0 )
	35026	;
	35027	"RTN","HMP YCSO",77,0 )
	35028	; -- exec ute type c onversion callback ; quit if o bject pass ed w/o nee ding conve rsion
	35029	"RTN","HMP YCSO",78,0 )
	35030	I @("'$$" _HMPCB_"(H MPTEMP,IEN )") D TALL Y("passed" ) Q
	35031	"RTN","HMP YCSO",79,0 )
	35032	;
	35033	"RTN","HMP YCSO",80,0 )
	35034	K @HMPY
	35035	"RTN","HMP YCSO",81,0 )
	35036	D ENCODE^ HMPJSON(HM PTEMP,HMPY ,"ERROR")
	35037	"RTN","HMP YCSO",82,0 )
	35038	I $D(ERRO R) D ERROR ("Error in encoding JSON "_HMP COLL_" obj ect (IEN: "_IEN_")") Q
	35039	"RTN","HMP YCSO",83,0 )
	35040	;
	35041	"RTN","HMP YCSO",84,0 )
	35042	D MES^XPD UTL("Updat ing "_HMPC OLL_" uid: "_UID)
	35043	"RTN","HMP YCSO",85,0 )
	35044	I '$$UPDA TE(HMPFILE ,IEN,HMPY) D Q
	35045	"RTN","HMP YCSO",86,0 )
	35046	. D ERROR ("Error: U nable to o btain lock on DATA n ode for JS ON "_HMPCO LL_" objec t (IEN: "_ IEN_")")
	35047	"RTN","HMP YCSO",87,0 )
	35048	E D
	35049	"RTN","HMP YCSO",88,0 )
	35050	. D TALLY ("converte d")
	35051	"RTN","HMP YCSO",89,0 )
	35052	;
	35053	"RTN","HMP YCSO",90,0 )
	35054	K @HMPY,@ HMPTEMP
	35055	"RTN","HMP YCSO",91,0 )
	35056	;
	35057	"RTN","HMP YCSO",92,0 )
	35058	Q
	35059	"RTN","HMP YCSO",93,0 )
	35060	;
	35061	"RTN","HMP YCSO",94,0 )
	35062	ERROR(MSG) ; -- writ e out erro r message and inc er ror tally
	35063	"RTN","HMP YCSO",95,0 )
	35064	;D EN^DDI OL(MSG)
	35065	"RTN","HMP YCSO",96,0 )
	35066	D BMES^XP DUTL(MSG)
	35067	"RTN","HMP YCSO",97,0 )
	35068	D TALLY(" errored")
	35069	"RTN","HMP YCSO",98,0 )
	35070	Q
	35071	"RTN","HMP YCSO",99,0 )
	35072	;
	35073	"RTN","HMP YCSO",100, 0)
	35074	TALLY(CNTY P) ; -- in c counter
	35075	"RTN","HMP YCSO",101, 0)
	35076	S HMPZCNT S(CNTYP)=$ G(HMPZCNTS (CNTYP))+1
	35077	"RTN","HMP YCSO",102, 0)
	35078	Q
	35079	"RTN","HMP YCSO",103, 0)
	35080	;
	35081	"RTN","HMP YCSO",104, 0)
	35082	UPDATE(HMP FILE,DA,JS ON) ; -- u pdate DATA wp field on patient object
	35083	"RTN","HMP YCSO",105, 0)
	35084	; input: DA - int ernal entr y number i n 800000.1
	35085	"RTN","HMP YCSO",106, 0)
	35086	; JSON - clo sed array reference for M repr esentation of object
	35087	"RTN","HMP YCSO",107, 0)
	35088	; return: 1 - upd ate succes sful \| 0 - update no t successf ul (unable to obtain lock)
	35089	"RTN","HMP YCSO",108, 0)
	35090	L +^HMP(H MPFILE,DA, 1):$S($G(D ILOCKTM)>0 :DILOCKTM, 1:5)
	35091	"RTN","HMP YCSO",109, 0)
	35092	I '$T Q 0
	35093	"RTN","HMP YCSO",110, 0)
	35094	;
	35095	"RTN","HMP YCSO",111, 0)
	35096	N CNT,I,H MPSUB
	35097	"RTN","HMP YCSO",112, 0)
	35098	S CNT=0
	35099	"RTN","HMP YCSO",113, 0)
	35100	; -- deri ve subfile number
	35101	"RTN","HMP YCSO",114, 0)
	35102	S HMPSUB= HMPFILE_$S (HMPFILE=8 00000.1:"0 1",1:"1")
	35103	"RTN","HMP YCSO",115, 0)
	35104	K ^HMP(HM PFILE,DA,1 ) S ^(1,0) ="^"_HMPSU B_"^^"
	35105	"RTN","HMP YCSO",116, 0)
	35106	S I="" F S I=$O(@J SON@(I)) Q :I="" S C NT=CNT+1,^ HMP(HMPFIL E,DA,1,CNT ,0)=@JSON@ (I)
	35107	"RTN","HMP YCSO",117, 0)
	35108	I CNT S ^ HMP(HMPFIL E,DA,1,0)= "^800000.1 01^"_CNT_U _CNT
	35109	"RTN","HMP YCSO",118, 0)
	35110	;
	35111	"RTN","HMP YCSO",119, 0)
	35112	L -^HMP(H MPFILE,DA, 1)
	35113	"RTN","HMP YCSO",120, 0)
	35114	Q 1
	35115	"RTN","HMP YCSO",121, 0)
	35116	;
	35117	"RTN","HMP YCSO",122, 0)
	35118	TASKCONV ; -- conver t patient task objec ts
	35119	"RTN","HMP YCSO",123, 0)
	35120	; - c onverts 'p id' proper ty to SYSI D;DFN (ex. F484;237)
	35121	"RTN","HMP YCSO",124, 0)
	35122	; - r emoves 'pa tientId' p roperty if it exists
	35123	"RTN","HMP YCSO",125, 0)
	35124	;
	35125	"RTN","HMP YCSO",126, 0)
	35126	N HMPAMS, HMPSTATS
	35127	"RTN","HMP YCSO",127, 0)
	35128	S HMPAMS( "type")="P T"
	35129	"RTN","HMP YCSO",128, 0)
	35130	S HMPAMS( "collectio n")="task"
	35131	"RTN","HMP YCSO",129, 0)
	35132	S HMPAMS( "callback" )="TASKCB^ HMPYCSO"
	35133	"RTN","HMP YCSO",130, 0)
	35134	D CONV^HM PYCSO(.HMP AMS,"HMPST ATS")
	35135	"RTN","HMP YCSO",131, 0)
	35136	D BMES^XP DUTL("Task object co nversion s tatistics: ")
	35137	"RTN","HMP YCSO",132, 0)
	35138	D MES^XPD UTL(" Rev iewed: "_$ J($G(HMPST ATS("revie wed")),8))
	35139	"RTN","HMP YCSO",133, 0)
	35140	D MES^XPD UTL(" P assed: "_$ J($G(HMPST ATS("passe d")),8))
	35141	"RTN","HMP YCSO",134, 0)
	35142	D MES^XPD UTL(" Conv erted: "_$ J($G(HMPST ATS("conve rted")),8) )
	35143	"RTN","HMP YCSO",135, 0)
	35144	D MES^XPD UTL(" Er rored: "_$ J($G(HMPST ATS("error ed")),8))
	35145	"RTN","HMP YCSO",136, 0)
	35146	K HMPB4
	35147	"RTN","HMP YCSO",137, 0)
	35148	Q
	35149	"RTN","HMP YCSO",138, 0)
	35150	;
	35151	"RTN","HMP YCSO",139, 0)
	35152	TASKCB(OBJ REF,IEN) ; -- callba ck that co nverts a ' task' obje ct's if ne cessary
	35153	"RTN","HMP YCSO",140, 0)
	35154	; - con verts 'pid ' property to SYSID; DFN (ex. F 484;237)
	35155	"RTN","HMP YCSO",141, 0)
	35156	; - rem oves 'pati entId' pro perty if i t exists
	35157	"RTN","HMP YCSO",142, 0)
	35158	;
	35159	"RTN","HMP YCSO",143, 0)
	35160	; input: OBJREF := JSON deco ded task o bject for DATA field in 800000 .1
	35161	"RTN","HMP YCSO",144, 0)
	35162	; IEN := internal entry numb er in 8000 00.1
	35163	"RTN","HMP YCSO",145, 0)
	35164	;
	35165	"RTN","HMP YCSO",146, 0)
	35166	; return: 1 - task was conver ted \| 0 - no convers ion requir ed
	35167	"RTN","HMP YCSO",147, 0)
	35168	;
	35169	"RTN","HMP YCSO",148, 0)
	35170	N HMPOK,D FN,PID
	35171	"RTN","HMP YCSO",149, 0)
	35172	S HMPOK=0
	35173	"RTN","HMP YCSO",150, 0)
	35174	S DFN=+$P ($G(^HMP(8 00000.1,+$ G(IEN),0)) ,"^",2)
	35175	"RTN","HMP YCSO",151, 0)
	35176	I 'DFN Q 0
	35177	"RTN","HMP YCSO",152, 0)
	35178	S PID=$$S YS^HMPUTIL S_";"_DFN
	35179	"RTN","HMP YCSO",153, 0)
	35180	; -- if p id differe nt, first kill 'pid' to get ri d of possi ble ...,"p id","\s") node
	35181	"RTN","HMP YCSO",154, 0)
	35182	I $G(@OBJ REF@("pid" ))'=PID K @OBJREF@(" pid") S @O BJREF@("pi d")=PID,HM POK=1
	35183	"RTN","HMP YCSO",155, 0)
	35184	I $D(@OBJ REF@("pati entId")) K @OBJREF@( "patientId ") S HMPOK =1
	35185	"RTN","HMP YCSO",156, 0)
	35186	Q HMPOK
	35187	"RTN","HMP YFRP")
	35188	1^196
	35189	"RTN","HMP YFRP1")
	35190	1^197
	35191	"RTN","HMP YFRP2")
	35192	1^198
	35193	"RTN","HMP YPAR")
	35194	1^199
	35195	"RTN","HMP Z0218")
	35196	0^141^B563 2129
	35197	"RTN","HMP Z0218",1,0 )
	35198	HMPZ0218 ; ASMR/JCH - Clinical Procedures failing T IU patch q uick fix ; Feb 18, 20 15@14:29:5 2
	35199	"RTN","HMP Z0218",2,0 )
	35200	;;2.0;ENT ERPRISE HE ALTH MANAG EMENT PLAT FORM;**;Fe b 18, 2015 ;Build 63
	35201	"RTN","HMP Z0218",3,0 )
	35202	;Per VA D irective 6 402, this routine sh ould not b e modified .
	35203	"RTN","HMP Z0218",4,0 )
	35204	;
	35205	"RTN","HMP Z0218",5,0 )
	35206	Q
	35207	"RTN","HMP Z0218",6,0 )
	35208	;
	35209	"RTN","HMP Z0218",7,0 )
	35210	; tempora ry fix for Clinical Procedures issue (Us er Story 5 021)
	35211	"RTN","HMP Z0218",8,0 )
	35212	DISABLE ;
	35213	"RTN","HMP Z0218",9,0 )
	35214	;
	35215	"RTN","HMP Z0218",10, 0)
	35216	D BMES^XP DUTL("Disa bling INDE X entries for Clinic al Procedu res "_$$NO W),MES^XPD UTL("routi ne: "_$T(+ 0))
	35217	"RTN","HMP Z0218",11, 0)
	35218	;
	35219	"RTN","HMP Z0218",12, 0)
	35220	; HMPARY - IEN arra y for INDE X
	35221	"RTN","HMP Z0218",13, 0)
	35222	; HMPINDX - target INDEX entr y
	35223	"RTN","HMP Z0218",14, 0)
	35224	N F,G,HMP ARY,HMPIND X,I,J,Q,X, Y
	35225	"RTN","HMP Z0218",15, 0)
	35226	;
	35227	"RTN","HMP Z0218",16, 0)
	35228	S Q=$C(34 )
	35229	"RTN","HMP Z0218",17, 0)
	35230	F J=1:1 S HMPINDX=$ P($T(INDXL ST+J),";;" ,2,99) Q:H MPINDX="" D ; find INDEX fil e (#.11) e ntries
	35231	"RTN","HMP Z0218",18, 0)
	35232	.D MES^XP DUTL("look ing for IN DEX: "_HMP INDX)
	35233	"RTN","HMP Z0218",19, 0)
	35234	.N FL,I,N TRY,Y
	35235	"RTN","HMP Z0218",20, 0)
	35236	.S NTRY=0 ; INDEX enrty IEN
	35237	"RTN","HMP Z0218",21, 0)
	35238	.S FL=+$P (HMPINDX,U ) ; file #
	35239	"RTN","HMP Z0218",22, 0)
	35240	.S I=0 F S I=$O(^D D("IX","B" ,FL,I)) Q: 'I!(NTRY) D ; find entry and save it
	35241	"RTN","HMP Z0218",23, 0)
	35242	..S Y=$G( ^DD("IX",I ,0)) S:$P( HMPINDX,U, 1,3)=$P(Y, U,1,3) NTR Y=I,HMPIND X(FL,I)=Y, HMPINDX(0) =$G(HMPIND X(0))+1
	35243	"RTN","HMP Z0218",24, 0)
	35244	;
	35245	"RTN","HMP Z0218",25, 0)
	35246	I '($G(HM PINDX(0))= 1) D Q ; must loca te both en tries, exi t if not f ound
	35247	"RTN","HMP Z0218",26, 0)
	35248	.D BMES^X PDUTL("Una ble to fin d INDEX fi le entries "),MES^XPD UTL("exiti ng routine "_$T(+0)_ " "_$$NOW)
	35249	"RTN","HMP Z0218",27, 0)
	35250	;
	35251	"RTN","HMP Z0218",28, 0)
	35252	S F=0 F S F=$O(HMP INDX(F)) Q :'F D
	35253	"RTN","HMP Z0218",29, 0)
	35254	.N GLB,ND ,UPDT
	35255	"RTN","HMP Z0218",30, 0)
	35256	.S I=+$O( HMPINDX(F, 0)) Q:'I
	35257	"RTN","HMP Z0218",31, 0)
	35258	.S GLB=$N A(^DD("IX" ,I,0)),Y=$ G(@GLB) D BMES^XPDUT L("examini ng "_GLB), MES^XPDUTL (" "_Q_Y _Q)
	35259	"RTN","HMP Z0218",32, 0)
	35260	.S UPDT=0 ; update d flag, fa lse if ind ex not cha nged
	35261	"RTN","HMP Z0218",33, 0)
	35262	.F ND=1,2 D
	35263	"RTN","HMP Z0218",34, 0)
	35264	..S Y=$G( ^DD("IX",I ,ND)),GLB= $NA(^(ND))
	35265	"RTN","HMP Z0218",35, 0)
	35266	..D MES^X PDUTL("val ue found i n "_GLB_" was: "),ME S^XPDUTL(" "_Q_Y_Q )
	35267	"RTN","HMP Z0218",36, 0)
	35268	..I $E(Y) '="Q" S UP DT=1,Y="Q ;"_Y
	35269	"RTN","HMP Z0218",37, 0)
	35270	..S:UPDT @GLB=Y
	35271	"RTN","HMP Z0218",38, 0)
	35272	..D MES^X PDUTL($S(U PDT:"updat ed to "_Q_ Y_Q,1:"* N OT CHANGED *"))
	35273	"RTN","HMP Z0218",39, 0)
	35274	;
	35275	"RTN","HMP Z0218",40, 0)
	35276	;
	35277	"RTN","HMP Z0218",41, 0)
	35278	D BMES^XP DUTL("INDE X entry co mpleted "_ $$NOW)
	35279	"RTN","HMP Z0218",42, 0)
	35280	;
	35281	"RTN","HMP Z0218",43, 0)
	35282	Q
	35283	"RTN","HMP Z0218",44, 0)
	35284	;
	35285	"RTN","HMP Z0218",45, 0)
	35286	NOW() ; ex trinsic va riable, no w in exter nal format
	35287	"RTN","HMP Z0218",46, 0)
	35288	Q $$HTE^X LFDT($H)
	35289	"RTN","HMP Z0218",47, 0)
	35290	;
	35291	"RTN","HMP Z0218",48, 0)
	35292	INDXLST ; *S68 - dis able of AE VT index o n file 892 5 removed US5074
	35293	"RTN","HMP Z0218",49, 0)
	35294	;;702^AVP R^Trigger updates to VPR^
	35295	"RTN","HMP Z0218",50, 0)
	35296	;
	35297	"SEC","^DI C",800000, 800000,0," AUDIT")
	35298	@
	35299	"SEC","^DI C",800000, 800000,0," DD")
	35300	@
	35301	"SEC","^DI C",800000, 800000,0," DEL")
	35302	@
	35303	"SEC","^DI C",800000, 800000,0," LAYGO")
	35304	@
	35305	"SEC","^DI C",800000, 800000,0," RD")
	35306	@
	35307	"SEC","^DI C",800000, 800000,0," WR")
	35308	@
	35309	"SEC","^DI C",800000. 1,800000.1 ,0,"AUDIT" )
	35310	@
	35311	"SEC","^DI C",800000. 1,800000.1 ,0,"DD")
	35312	@
	35313	"SEC","^DI C",800000. 1,800000.1 ,0,"DEL")
	35314	@
	35315	"SEC","^DI C",800000. 1,800000.1 ,0,"LAYGO" )
	35316	@
	35317	"SEC","^DI C",800000. 1,800000.1 ,0,"RD")
	35318	@
	35319	"SEC","^DI C",800000. 1,800000.1 ,0,"WR")
	35320	@
	35321	"SEC","^DI C",800000. 11,800000. 11,0,"AUDI T")
	35322	@
	35323	"SEC","^DI C",800000. 11,800000. 11,0,"DD")
	35324	@
	35325	"SEC","^DI C",800000. 11,800000. 11,0,"DEL" )
	35326	@
	35327	"SEC","^DI C",800000. 11,800000. 11,0,"LAYG O")
	35328	@
	35329	"SEC","^DI C",800000. 11,800000. 11,0,"RD")
	35330	@
	35331	"SEC","^DI C",800000. 11,800000. 11,0,"WR")
	35332	@
	35333	"SEC","^DI C",800000. 2,800000.2 ,0,"AUDIT" )
	35334	@
	35335	"SEC","^DI C",800000. 2,800000.2 ,0,"DD")
	35336	@
	35337	"SEC","^DI C",800000. 2,800000.2 ,0,"DEL")
	35338	@
	35339	"SEC","^DI C",800000. 2,800000.2 ,0,"LAYGO" )
	35340	@
	35341	"SEC","^DI C",800000. 2,800000.2 ,0,"RD")
	35342	@
	35343	"SEC","^DI C",800000. 2,800000.2 ,0,"WR")
	35344	@
	35345	"SEC","^DI C",800000. 21,800000. 21,0,"AUDI T")
	35346	@
	35347	"SEC","^DI C",800000. 21,800000. 21,0,"DD")
	35348	@
	35349	"SEC","^DI C",800000. 21,800000. 21,0,"DEL" )
	35350	@
	35351	"SEC","^DI C",800000. 21,800000. 21,0,"LAYG O")
	35352	@
	35353	"SEC","^DI C",800000. 21,800000. 21,0,"RD")
	35354	@
	35355	"SEC","^DI C",800000. 21,800000. 21,0,"WR")
	35356	@
	35357	"SEC","^DI C",800000. 22,800000. 22,0,"AUDI T")
	35358	@
	35359	"SEC","^DI C",800000. 22,800000. 22,0,"DD")
	35360	@
	35361	"SEC","^DI C",800000. 22,800000. 22,0,"DEL" )
	35362	@
	35363	"SEC","^DI C",800000. 22,800000. 22,0,"LAYG O")
	35364	@
	35365	"SEC","^DI C",800000. 22,800000. 22,0,"RD")
	35366	@
	35367	"SEC","^DI C",800000. 22,800000. 22,0,"WR")
	35368	@
	35369	"SEC","^DI C",800001, 800001,0," AUDIT")
	35370	@
	35371	"SEC","^DI C",800001, 800001,0," DD")
	35372	@
	35373	"SEC","^DI C",800001, 800001,0," DEL")
	35374	@
	35375	"SEC","^DI C",800001, 800001,0," LAYGO")
	35376	@
	35377	"SEC","^DI C",800001, 800001,0," RD")
	35378	@
	35379	"SEC","^DI C",800001, 800001,0," WR")
	35380	@
	35381	"SEC","^DI C",800001. 2,800001.2 ,0,"AUDIT" )
	35382	@
	35383	"SEC","^DI C",800001. 2,800001.2 ,0,"DD")
	35384	@
	35385	"SEC","^DI C",800001. 2,800001.2 ,0,"DEL")
	35386	@
	35387	"SEC","^DI C",800001. 2,800001.2 ,0,"LAYGO" )
	35388	@
	35389	"SEC","^DI C",800001. 2,800001.2 ,0,"RD")
	35390	@
	35391	"SEC","^DI C",800001. 2,800001.2 ,0,"WR")
	35392	@
	35393	"SEC","^DI C",800001. 5,800001.5 ,0,"AUDIT" )
	35394	@
	35395	"SEC","^DI C",800001. 5,800001.5 ,0,"DD")
	35396	@
	35397	"SEC","^DI C",800001. 5,800001.5 ,0,"DEL")
	35398	@
	35399	"SEC","^DI C",800001. 5,800001.5 ,0,"LAYGO" )
	35400	@
	35401	"SEC","^DI C",800001. 5,800001.5 ,0,"RD")
	35402	@
	35403	"SEC","^DI C",800001. 5,800001.5 ,0,"WR")
	35404	@
	35405	"VER")
	35406	8.0^22.0
	35407	"^DD",8000 00,800000, 0)
	35408	FIELD^^.04 ^10
	35409	"^DD",8000 00,800000, 0,"DDA")
	35410	N
	35411	"^DD",8000 00,800000, 0,"DT")
	35412	3160126
	35413	"^DD",8000 00,800000, 0,"IX","B" ,800000,.0 1)
	35414
	35415	"^DD",8000 00,800000, 0,"NM","HM P SUBSCRIP TION")
	35416
	35417	"^DD",8000 00,800000, 0,"VRPK")
	35418	HMP
	35419	"^DD",8000 00,800000, .01,0)
	35420	SERVER^RF^ ^0;1^K:$L( X)>64!($L( X)<1)!'(X' ?1P.E) X
	35421	"^DD",8000 00,800000, .01,1,0)
	35422	^.1^^-1
	35423	"^DD",8000 00,800000, .01,1,1,0)
	35424	800000^B
	35425	"^DD",8000 00,800000, .01,1,1,1)
	35426	S ^HMP(800 000,"B",$E (X,1,64),D A)=""
	35427	"^DD",8000 00,800000, .01,1,1,2)
	35428	K ^HMP(800 000,"B",$E (X,1,64),D A)
	35429	"^DD",8000 00,800000, .01,1,1,"% D",0)
	35430	^^1^1^3150 922^
	35431	"^DD",8000 00,800000, .01,1,1,"% D",1,0)
	35432	Cross-refe rence, by DFN, of pa tients sub scribed to eHMP.
	35433	"^DD",8000 00,800000, .01,3)
	35434	Answer mus t be 1-64 characters in length .
	35435	"^DD",8000 00,800000, .01,21,0)
	35436	^.001^1^1^ 3150922^^^ ^
	35437	"^DD",8000 00,800000, .01,21,1,0 )
	35438	This is th e name of the client system th at is subs cribing to data upda tes.
	35439	"^DD",8000 00,800000, .01,"DT")
	35440	3141028
	35441	"^DD",8000 00,800000, .02,0)
	35442	LASTUPDATE ^F^^0;2^K: $L(X)>100! ($L(X)<3) X
	35443	"^DD",8000 00,800000, .02,3)
	35444	Answer mus t be 3-100 character s in lengt h. (Do not modified)
	35445	"^DD",8000 00,800000, .02,21,0)
	35446	^.001^3^3^ 3150922^^
	35447	"^DD",8000 00,800000, .02,21,1,0 )
	35448	This field holds a f lag indica ting if th is URL sho uld be not ified via the
	35449	"^DD",8000 00,800000, .02,21,2,0 )
	35450	nightly sc heduled op tion HMP A PPOINTMENT S of the l ist of pat ients expe cted
	35451	"^DD",8000 00,800000, .02,21,3,0 )
	35452	to be seen tomorrow.
	35453	"^DD",8000 00,800000, .02,"DT")
	35454	3141028
	35455	"^DD",8000 00,800000, .03,0)
	35456	OPERATION DATA^S^0:U NSUBCRIBED ;1:SUBSCRI BED;2:INIT IALIZED;^0 ;3^Q
	35457	"^DD",8000 00,800000, .03,3)
	35458	This field should no t be edite d manually without c onsulting the develo pment team .
	35459	"^DD",8000 00,800000, .03,21,0)
	35460	^.001^2^2^ 3151203^^^ ^
	35461	"^DD",8000 00,800000, .03,21,1,0 )
	35462	This field holds a f lag indica ting if th is URL sho uld be not ified via http
	35463	"^DD",8000 00,800000, .03,21,2,0 )
	35464	when a pat ient is ad mitted.
	35465	"^DD",8000 00,800000, .03,"DT")
	35466	3141028
	35467	"^DD",8000 00,800000, .04,0)
	35468	REPEAT POL LS^NJ8,0^^ 0;4^K:+X'= X!(X>99999 999)!(X<0) !(X?.E1"." 1N.N) X
	35469	"^DD",8000 00,800000, .04,3)
	35470	Type a num ber betwee n 0 and 99 999999, 0 decimal di gits.
	35471	"^DD",8000 00,800000, .04,21,0)
	35472	^.001^2^2^ 3150922^^
	35473	"^DD",8000 00,800000, .04,21,1,0 )
	35474	This track s the numb er of time s the same "last upd ate" value has been
	35475	"^DD",8000 00,800000, .04,21,2,0 )
	35476	repeated. A high rep eat may be normal if data are not changi ng.
	35477	"^DD",8000 00,800000, .04,"DT")
	35478	3141028
	35479	"^DD",8000 00,800000, .05,0)
	35480	DISK USAGE STATUS^S^ 0:WITHIN L IMIT;1:EXC EEDED LIMI T;^0;5^Q
	35481	"^DD",8000 00,800000, .05,3)
	35482	Enter curr ent status of eHMP d isk usage.
	35483	"^DD",8000 00,800000, .05,21,0)
	35484	^.001^5^5^ 3150922^^
	35485	"^DD",8000 00,800000, .05,21,1,0 )
	35486	The DISK U SAGE STATU S flag is an indicat or set aut omatically in the eH MP
	35487	"^DD",8000 00,800000, .05,21,2,0 )
	35488	subscripti on process . If the d isk space usage in g lobal ^XTM P by eHMP
	35489	"^DD",8000 00,800000, .05,21,3,0 )
	35490	subscripti ons is abo ve the thr eshold in the HMP EX TRACT DISK SIZE LIMI T
	35491	"^DD",8000 00,800000, .05,21,4,0 )
	35492	is exceede d this fla g will be set. Simil arly the f lag is res et if usag e
	35493	"^DD",8000 00,800000, .05,21,5,0 )
	35494	later fall s below th e threshol d.
	35495	"^DD",8000 00,800000, .05,23,0)
	35496	^.001^4^4^ 3150922^^
	35497	"^DD",8000 00,800000, .05,23,1,0 )
	35498	The field is updated from subs cription p rocess by the STATUS ^HMPMETA
	35499	"^DD",8000 00,800000, .05,23,2,0 )
	35500	routine.
	35501	"^DD",8000 00,800000, .05,23,3,0 )
	35502
	35503	"^DD",8000 00,800000, .05,23,4,0 )
	35504	The field is referen ced by the fetch pro cess using CHECK^HMP META routi ne.
	35505	"^DD",8000 00,800000, .05,"DT")
	35506	3150624
	35507	"^DD",8000 00,800000, .06,0)
	35508	DISK USAGE STATUS TI ME^D^^0;6^ S %DT="EST XR" D ^%DT S X=Y K:X <1 X
	35509	"^DD",8000 00,800000, .06,3)
	35510	Enter the time the D ISK USAGE STATUS fie ld was upd ated.
	35511	"^DD",8000 00,800000, .06,21,0)
	35512	^.001^6^6^ 3150922^^
	35513	"^DD",8000 00,800000, .06,21,1,0 )
	35514	The DISK U SAGE STATU S TIME is a field se t automati cally in t he eHMP
	35515	"^DD",8000 00,800000, .06,21,2,0 )
	35516	subscripti on process . If the d isk space usage in g lobal ^XTM P by eHMP
	35517	"^DD",8000 00,800000, .06,21,3,0 )
	35518	subscripti ons is abo ve the thr eshold in the HMP EX TRACT DISK SIZE LIMI T is
	35519	"^DD",8000 00,800000, .06,21,4,0 )
	35520	exceeded t he DISK US AGE STATUS field wil l be set a nd the tim e of the
	35521	"^DD",8000 00,800000, .06,21,5,0 )
	35522	change rec orded in t his field. Similarly the flag and time f ields will be
	35523	"^DD",8000 00,800000, .06,21,6,0 )
	35524	reset if u sage later falls bel ow the thr eshold.
	35525	"^DD",8000 00,800000, .06,23,0)
	35526	^.001^4^4^ 3150922^^
	35527	"^DD",8000 00,800000, .06,23,1,0 )
	35528	The field is updated from subs cription p rocess by the STATUS ^HMPMETA
	35529	"^DD",8000 00,800000, .06,23,2,0 )
	35530	routine.
	35531	"^DD",8000 00,800000, .06,23,3,0 )
	35532
	35533	"^DD",8000 00,800000, .06,23,4,0 )
	35534	The field is referen ced by the fetch pro cess using CHECK^HMP META routi ne.
	35535	"^DD",8000 00,800000, .06,"DT")
	35536	3150624
	35537	"^DD",8000 00,800000, .1,0)
	35538	URL^F^^.1; 1^K:$L(X)> 250!($L(X) <1) X
	35539	"^DD",8000 00,800000, .1,3)
	35540	Answer mus t be 1-250 character s in lengt h.
	35541	"^DD",8000 00,800000, .1,21,0)
	35542	^^1^1^3110 706^
	35543	"^DD",8000 00,800000, .1,21,1,0)
	35544	This is th e fully sp ecified UR L to call when updat es are ava ilable.
	35545	"^DD",8000 00,800000, .1,"DT")
	35546	3141028
	35547	"^DD",8000 00,800000, 1,0)
	35548	PATIENT^80 0000.01P^^ 1;0
	35549	"^DD",8000 00,800000, 1,21,0)
	35550	^.001^1^1^ 3151203^^^ ^
	35551	"^DD",8000 00,800000, 1,21,1,0)
	35552	These are patients t hat will b e monitore d for new data and u pdates.
	35553	"^DD",8000 00,800000, 2,0)
	35554	ROSTER^800 000.02P^^2 ;0
	35555	"^DD",8000 00,800000, 2,21,0)
	35556	^.001^1^1^ 3150922^^^ ^
	35557	"^DD",8000 00,800000, 2,21,1,0)
	35558	These are rosters th at will be monitored for new p atients an d updates.
	35559	"^DD",8000 00,800000, 2,"DT")
	35560	3130417
	35561	"^DD",8000 00,800000, 91,0)
	35562	CONCURRENT UPDATE CA LLS^NJ3,0^ ^91;1^K:+X '=X!(X>999 )!(X<0)!(X ?.E1"."1N. N) X
	35563	"^DD",8000 00,800000, 91,3)
	35564	Type a num ber betwee n 0 and 99 9, 0 decim al digits.
	35565	"^DD",8000 00,800000, 91,21,0)
	35566	^^3^3^3150 218^
	35567	"^DD",8000 00,800000, 91,21,1,0)
	35568	This field is used t o track th e number o f simultan eous calls to
	35569	"^DD",8000 00,800000, 91,21,2,0)
	35570	getPtUpdat es in API^ HMPDJFS. T his allows checkHeal th to repo rt if a
	35571	"^DD",8000 00,800000, 91,21,3,0)
	35572	getPtUpdat es RPC is in progres s.
	35573	"^DD",8000 00,800000, 91,"DT")
	35574	3150218
	35575	"^DD",8000 00,800000. 01,0)
	35576	PATIENT SU B-FIELD^^3 ^4
	35577	"^DD",8000 00,800000. 01,0,"DT")
	35578	3160126
	35579	"^DD",8000 00,800000. 01,0,"NM", "PATIENT")
	35580
	35581	"^DD",8000 00,800000. 01,0,"UP")
	35582	800000
	35583	"^DD",8000 00,800000. 01,.01,0)
	35584	PATIENT NA ME^MP2'X^D PT(^0;1^S DINUM=X
	35585	"^DD",8000 00,800000. 01,.01,1,0 )
	35586	^.1^^0
	35587	"^DD",8000 00,800000. 01,.01,3)
	35588	Enter the name of a patient to be tracke d.
	35589	"^DD",8000 00,800000. 01,.01,21, 0)
	35590	^.001^1^1^ 3140212^^
	35591	"^DD",8000 00,800000. 01,.01,21, 1,0)
	35592	This is th e name of the patien t being mo nitored fo r new data .
	35593	"^DD",8000 00,800000. 01,.01,"DT ")
	35594	3140226
	35595	"^DD",8000 00,800000. 01,2,0)
	35596	STATUS^S^0 :UNINITIAL IZED;1:INI TIALIZING; 2:INITIALI ZED;^0;2^Q
	35597	"^DD",8000 00,800000. 01,2,3)
	35598	Enter the tracking s tatus of a patient s ync. (Do N ot Modify)
	35599	"^DD",8000 00,800000. 01,2,21,0)
	35600	^.001^4^4^ 3151203^^^ ^
	35601	"^DD",8000 00,800000. 01,2,21,1, 0)
	35602	This field tracks th e initiali zation pro gress of t he patient . When a
	35603	"^DD",8000 00,800000. 01,2,21,2, 0)
	35604	patient is initially subscribe d, they ar e added to this mult iple. The
	35605	"^DD",8000 00,800000. 01,2,21,3, 0)
	35606	status is "1" when t he extract s start an d "2" when they fini sh. At th at
	35607	"^DD",8000 00,800000. 01,2,21,4, 0)
	35608	point, fre shness upd ates are m oved into the stream .
	35609	"^DD",8000 00,800000. 01,2,"DT")
	35610	3140521
	35611	"^DD",8000 00,800000. 01,3,0)
	35612	STATUS DAT E-TIME^D^^ 0;3^S %DT= "ESTXR" D ^%DT S X=Y K:Y<1 X
	35613	"^DD",8000 00,800000. 01,3,.1)
	35614	/LABEL
	35615	"^DD",8000 00,800000. 01,3,3)
	35616	Enter the date.time the status changed.
	35617	"^DD",8000 00,800000. 01,3,21,0)
	35618	^.001^1^1^ 3151116^^^
	35619	"^DD",8000 00,800000. 01,3,21,1, 0)
	35620	This is th e date.tim e of the l ast change in extrac t status.
	35621	"^DD",8000 00,800000. 01,3,"DT")
	35622	3151116
	35623	"^DD",8000 00,800000. 01,4,0)
	35624	ORDERS^800 000.14PA^^ 1;0
	35625	"^DD",8000 00,800000. 01,4,21,0)
	35626	^.001^2^2^ 3151217^^
	35627	"^DD",8000 00,800000. 01,4,21,1, 0)
	35628	All data i n this sub -file are to be mani pulated by software only.
	35629	"^DD",8000 00,800000. 01,4,21,2, 0)
	35630	Users shou ld not edi t any data without c onsulting with the d evelopers.
	35631	"^DD",8000 00,800000. 02,0)
	35632	ROSTER SUB -FIELD^^2^ 2
	35633	"^DD",8000 00,800000. 02,0,"NM", "ROSTER")
	35634
	35635	"^DD",8000 00,800000. 02,0,"UP")
	35636	800000
	35637	"^DD",8000 00,800000. 02,.01,0)
	35638	NAME^MP800 001.2'X^HM PROSTR(800 001.2,^0;1 ^S DINUM=X
	35639	"^DD",8000 00,800000. 02,.01,1,0 )
	35640	^.1^^0
	35641	"^DD",8000 00,800000. 02,.01,3)
	35642	Enter the name of a roster to be tracked .
	35643	"^DD",8000 00,800000. 02,.01,21, 0)
	35644	^.001^1^1^ 3130417^^
	35645	"^DD",8000 00,800000. 02,.01,21, 1,0)
	35646	This is th e name of the roster being mon itored for new patie nts.
	35647	"^DD",8000 00,800000. 02,.01,"DT ")
	35648	3130417
	35649	"^DD",8000 00,800000. 02,2,0)
	35650	ON^S^1:YES ;0:NO;^0;2 ^Q
	35651	"^DD",8000 00,800000. 02,2,3)
	35652	Enter YES to turn on data trac king for t his roster .
	35653	"^DD",8000 00,800000. 02,2,21,0)
	35654	^.001^3^3^ 3130417^^
	35655	"^DD",8000 00,800000. 02,2,21,1, 0)
	35656	This field turns on the Data M onitor for this rost er and cli ent system .
	35657	"^DD",8000 00,800000. 02,2,21,2, 0)
	35658	If ON=true , a new sn apshot of this roste r will be sent to th e client
	35659	"^DD",8000 00,800000. 02,2,21,3, 0)
	35660	when new d ata update s are requ ested.
	35661	"^DD",8000 00,800000. 02,2,"DT")
	35662	3130417
	35663	"^DD",8000 00,800000. 14,0)
	35664	ORDERS SUB -FIELD^^1. 01^17
	35665	"^DD",8000 00,800000. 14,0,"DT")
	35666	3160126
	35667	"^DD",8000 00,800000. 14,0,"IX", "B",800000 .14,.01)
	35668
	35669	"^DD",8000 00,800000. 14,0,"NM", "ORDERS")
	35670
	35671	"^DD",8000 00,800000. 14,0,"UP")
	35672	800000.01
	35673	"^DD",8000 00,800000. 14,.01,0)
	35674	ORDER NUMB ER^P100'X^ OR(100,^0; 1^S DINUM= X
	35675	"^DD",8000 00,800000. 14,.01,1,0 )
	35676	^.1
	35677	"^DD",8000 00,800000. 14,.01,1,1 ,0)
	35678	800000.14^ B
	35679	"^DD",8000 00,800000. 14,.01,1,1 ,1)
	35680	S ^HMP(800 000,DA(2), 1,DA(1),1, "B",$E(X,1 ,30),DA)=" "
	35681	"^DD",8000 00,800000. 14,.01,1,1 ,2)
	35682	K ^HMP(800 000,DA(2), 1,DA(1),1, "B",$E(X,1 ,30),DA)
	35683	"^DD",8000 00,800000. 14,.01,3)
	35684	Enter the Order numb er.
	35685	"^DD",8000 00,800000. 14,.01,21, 0)
	35686	^.001^15^1 5^3151217^ ^^^
	35687	"^DD",8000 00,800000. 14,.01,21, 1,0)
	35688	All the da ta in this sub-file are entere d programm atically.
	35689	"^DD",8000 00,800000. 14,.01,21, 2,0)
	35690
	35691	"^DD",8000 00,800000. 14,.01,21, 3,0)
	35692	The data a re used to create ti mestamps w ith second s in order to correc tly
	35693	"^DD",8000 00,800000. 14,.01,21, 4,0)
	35694	sequence o rders that are sync' d with the eHMP syst em. Timest amps with
	35695	"^DD",8000 00,800000. 14,.01,21, 5,0)
	35696	seconds ca ptured are necessary in order to sequenc e order ac tivity whe n
	35697	"^DD",8000 00,800000. 14,.01,21, 6,0)
	35698	using the lastUpdate Time. The lastUpdate Time is pa ssed with the order
	35699	"^DD",8000 00,800000. 14,.01,21, 7,0)
	35700	data durin g a sync o peration. Currently the VA Ord er file (# 100) only
	35701	"^DD",8000 00,800000. 14,.01,21, 8,0)
	35702	captures a timestamp that incl udes hrs a nd minutes but not s econds. It is
	35703	"^DD",8000 00,800000. 14,.01,21, 9,0)
	35704	possible f or two act ivities su ch as savi ng and sig ning to oc cur in the
	35705	"^DD",8000 00,800000. 14,.01,21, 10,0)
	35706	same minut e, without seconds a dded the t he activit y timestam p it is
	35707	"^DD",8000 00,800000. 14,.01,21, 11,0)
	35708	impossible to determ ine which activity o ccured fir st.
	35709	"^DD",8000 00,800000. 14,.01,21, 12,0)
	35710
	35711	"^DD",8000 00,800000. 14,.01,21, 13,0)
	35712	The PURGE DATETIME i s the date time to p urge this record. Th e PURGE
	35713	"^DD",8000 00,800000. 14,.01,21, 14,0)
	35714	DATETIME i s 24 hours after the record is created. Purging th e data aft er
	35715	"^DD",8000 00,800000. 14,.01,21, 15,0)
	35716	24 hours w ill preven t the file from grow ing too la rge.
	35717	"^DD",8000 00,800000. 14,.01,"DT ")
	35718	3151102
	35719	"^DD",8000 00,800000. 14,.02,0)
	35720	CREATE DAT E/TIME^D^^ 0;2^S %DT= "ESTX" D ^ %DT S X=Y K:Y<1 X
	35721	"^DD",8000 00,800000. 14,.02,3)
	35722	Enter the date and t ime the or der was cr eated.
	35723	"^DD",8000 00,800000. 14,.02,21, 0)
	35724	^.001^2^2^ 3151217^^^
	35725	"^DD",8000 00,800000. 14,.02,21, 1,0)
	35726	The date/t ime to inc lude secon ds that th e order wa s created.
	35727	"^DD",8000 00,800000. 14,.02,21, 2,0)
	35728	This field is entere d programm atically.
	35729	"^DD",8000 00,800000. 14,.02,"DT ")
	35730	3151216
	35731	"^DD",8000 00,800000. 14,.03,0)
	35732	SIGNED BY^ P200'^VA(2 00,^0;3^Q
	35733	"^DD",8000 00,800000. 14,.03,3)
	35734	Enter the User who s igned the order.
	35735	"^DD",8000 00,800000. 14,.03,21, 0)
	35736	^.001^2^2^ 3151217^^
	35737	"^DD",8000 00,800000. 14,.03,21, 1,0)
	35738	The person signing t he order.
	35739	"^DD",8000 00,800000. 14,.03,21, 2,0)
	35740	This field is entere d programm atically.
	35741	"^DD",8000 00,800000. 14,.03,"DT ")
	35742	3151216
	35743	"^DD",8000 00,800000. 14,.04,0)
	35744	SIGNED DAT E/TIME^D^^ 0;4^S %DT= "ESTX" D ^ %DT S X=Y K:Y<1 X
	35745	"^DD",8000 00,800000. 14,.04,3)
	35746	Enter the date and t ime the or der was si gned.
	35747	"^DD",8000 00,800000. 14,.04,21, 0)
	35748	^.001^2^2^ 3151217^^^
	35749	"^DD",8000 00,800000. 14,.04,21, 1,0)
	35750	The date/t ime with s econds the order was signed.
	35751	"^DD",8000 00,800000. 14,.04,21, 2,0)
	35752	This field is entere d programm atically.
	35753	"^DD",8000 00,800000. 14,.04,"DT ")
	35754	3151216
	35755	"^DD",8000 00,800000. 14,.05,0)
	35756	VERIFYING NURSE^P200 '^VA(200,^ 0;5^Q
	35757	"^DD",8000 00,800000. 14,.05,3)
	35758	Enter the nurse who verified t he order.
	35759	"^DD",8000 00,800000. 14,.05,21, 0)
	35760	^.001^2^2^ 3151217^^^
	35761	"^DD",8000 00,800000. 14,.05,21, 1,0)
	35762	The date/t ime, inclu ding secon ds, the nu rse verifi ed the ord er.
	35763	"^DD",8000 00,800000. 14,.05,21, 2,0)
	35764	This field is entere d programm atically.
	35765	"^DD",8000 00,800000. 14,.05,"DT ")
	35766	3151216
	35767	"^DD",8000 00,800000. 14,.06,0)
	35768	NURSE VERI FY DATE/TI ME^D^^0;6^ S %DT="EST X" D ^%DT S X=Y K:Y< 1 X
	35769	"^DD",8000 00,800000. 14,.06,3)
	35770	Enter the date and t ime the nu rse verifi ed the ord er.
	35771	"^DD",8000 00,800000. 14,.06,21, 0)
	35772	^.001^2^2^ 3151217^^^
	35773	"^DD",8000 00,800000. 14,.06,21, 1,0)
	35774	The date/t ime, inclu ding secon ds, the nu rse verifi ed the ord er.
	35775	"^DD",8000 00,800000. 14,.06,21, 2,0)
	35776	This field is entere d programm atically.
	35777	"^DD",8000 00,800000. 14,.06,"DT ")
	35778	3151216
	35779	"^DD",8000 00,800000. 14,.07,0)
	35780	VERIFYING CLERK^P200 '^VA(200,^ 0;7^Q
	35781	"^DD",8000 00,800000. 14,.07,3)
	35782	Enter the clerk who verified t he order.
	35783	"^DD",8000 00,800000. 14,.07,21, 0)
	35784	^.001^2^2^ 3151217^^^
	35785	"^DD",8000 00,800000. 14,.07,21, 1,0)
	35786	The clerk who verifi ed the ord er.
	35787	"^DD",8000 00,800000. 14,.07,21, 2,0)
	35788	This field is entere d programm atically.
	35789	"^DD",8000 00,800000. 14,.07,"DT ")
	35790	3151216
	35791	"^DD",8000 00,800000. 14,.08,0)
	35792	CLERK VERI FY DATE/TI ME^D^^0;8^ S %DT="EST X" D ^%DT S X=Y K:Y< 1 X
	35793	"^DD",8000 00,800000. 14,.08,3)
	35794	Enter the date and t ime the cl erk verifi ed the ord er.
	35795	"^DD",8000 00,800000. 14,.08,21, 0)
	35796	^.001^2^2^ 3151217^^
	35797	"^DD",8000 00,800000. 14,.08,21, 1,0)
	35798	The date/t ime, inclu ding secon ds, the cl erk verifi ed the ord er.
	35799	"^DD",8000 00,800000. 14,.08,21, 2,0)
	35800	This field is entere d programm atically.
	35801	"^DD",8000 00,800000. 14,.08,"DT ")
	35802	3151217
	35803	"^DD",8000 00,800000. 14,.09,0)
	35804	REVIEWED B Y^P200'^VA (200,^0;9^ Q
	35805	"^DD",8000 00,800000. 14,.09,3)
	35806	Enter the user who r eviewed th e order.
	35807	"^DD",8000 00,800000. 14,.09,21, 0)
	35808	^.001^2^2^ 3151217^^^
	35809	"^DD",8000 00,800000. 14,.09,21, 1,0)
	35810	The user w ho reviewe d the orde r.
	35811	"^DD",8000 00,800000. 14,.09,21, 2,0)
	35812	This field is entere d programm atically.
	35813	"^DD",8000 00,800000. 14,.09,"DT ")
	35814	3151216
	35815	"^DD",8000 00,800000. 14,.1,0)
	35816	REVIEWED D ATE/TIME^D ^^0;10^S % DT="ESTR" D ^%DT S X =Y K:Y<1 X
	35817	"^DD",8000 00,800000. 14,.1,3)
	35818	Enter the date and t ime the or der was re viewed.
	35819	"^DD",8000 00,800000. 14,.1,21,0 )
	35820	^.001^2^2^ 3151217^^
	35821	"^DD",8000 00,800000. 14,.1,21,1 ,0)
	35822	The date/t ime, inclu ding secon ds, the or der was re viewed.
	35823	"^DD",8000 00,800000. 14,.1,21,2 ,0)
	35824	This field is entere d programm atically.
	35825	"^DD",8000 00,800000. 14,.1,"DT" )
	35826	3151216
	35827	"^DD",8000 00,800000. 14,.11,0)
	35828	RELEASED B Y^P200'^VA (200,^0;11 ^Q
	35829	"^DD",8000 00,800000. 14,.11,3)
	35830	Enter the user who r eleased th e order.
	35831	"^DD",8000 00,800000. 14,.11,21, 0)
	35832	^.001^2^2^ 3151217^^
	35833	"^DD",8000 00,800000. 14,.11,21, 1,0)
	35834	The user w ho release d the orde r.
	35835	"^DD",8000 00,800000. 14,.11,21, 2,0)
	35836	This field is entere d programm atically.
	35837	"^DD",8000 00,800000. 14,.11,"DT ")
	35838	3151216
	35839	"^DD",8000 00,800000. 14,.12,0)
	35840	RELEASED D ATE/TIME^D ^^0;12^S % DT="ESTX" D ^%DT S X =Y K:Y<1 X
	35841	"^DD",8000 00,800000. 14,.12,3)
	35842	Enter the date and t ime the or der was re leased.
	35843	"^DD",8000 00,800000. 14,.12,21, 0)
	35844	^.001^2^2^ 3151217^^
	35845	"^DD",8000 00,800000. 14,.12,21, 1,0)
	35846	The date/t ime, inclu ding secon ds, the or der was re leased.
	35847	"^DD",8000 00,800000. 14,.12,21, 2,0)
	35848	This field is entere d programm atically.
	35849	"^DD",8000 00,800000. 14,.12,"DT ")
	35850	3151216
	35851	"^DD",8000 00,800000. 14,.13,0)
	35852	PURGE DATE /TIME^D^^0 ;13^S %DT= "EST" D ^% DT S X=Y K :Y<1 X
	35853	"^DD",8000 00,800000. 14,.13,3)
	35854	Enter the date and t ime after which this entry can be purged .
	35855	"^DD",8000 00,800000. 14,.13,21, 0)
	35856	^.001^2^2^ 3151217^^
	35857	"^DD",8000 00,800000. 14,.13,21, 1,0)
	35858	The earlie st date/ti me the ord er data ca n be purge d.
	35859	"^DD",8000 00,800000. 14,.13,21, 2,0)
	35860	This field is entere d programm atically.
	35861	"^DD",8000 00,800000. 14,.13,"DT ")
	35862	3151216
	35863	"^DD",8000 00,800000. 14,.14,0)
	35864	ORDER ACTI ON^S^NW:NE W;DC:DISCO NTINUED;HD :HOLD;RL:R ELEASE HOL D;XX:CHANG E;VA:VALID ATE;IP:TRA NSFERRED T O IP;OP:TR ANSFERRED TO OP;^0;1 4^Q
	35865	"^DD",8000 00,800000. 14,.14,3)
	35866	Enter the action per formed on this order .
	35867	"^DD",8000 00,800000. 14,.14,21, 0)
	35868	^.001^2^2^ 3151217^^^
	35869	"^DD",8000 00,800000. 14,.14,21, 1,0)
	35870	The action taken on the order.
	35871	"^DD",8000 00,800000. 14,.14,21, 2,0)
	35872	This field is entere d programm atically.
	35873	"^DD",8000 00,800000. 14,.14,"DT ")
	35874	3151216
	35875	"^DD",8000 00,800000. 14,.15,0)
	35876	ACTION DAT E/TIME^D^^ 0;15^S %DT ="EST" D ^ %DT S X=Y K:Y<1 X
	35877	"^DD",8000 00,800000. 14,.15,3)
	35878	Enter the date and t ime this o rder actio n was perf ormed.
	35879	"^DD",8000 00,800000. 14,.15,21, 0)
	35880	^.001^2^2^ 3151217^^
	35881	"^DD",8000 00,800000. 14,.15,21, 1,0)
	35882	The date/t ime of the order act ion.
	35883	"^DD",8000 00,800000. 14,.15,21, 2,0)
	35884	This field is entere d programm atically.
	35885	"^DD",8000 00,800000. 14,.15,"DT ")
	35886	3151216
	35887	"^DD",8000 00,800000. 14,1.01,0)
	35888	TRACKING S TART^DI^^1 ;1^S %DT=" ESTX" D ^% DT S X=Y K :Y<1 X
	35889	"^DD",8000 00,800000. 14,1.01,3)
	35890	Enter the date and t ime that e HMP starte d tracking this Orde r.
	35891	"^DD",8000 00,800000. 14,1.01,21 ,0)
	35892	^^2^2^3160 126^
	35893	"^DD",8000 00,800000. 14,1.01,21 ,1,0)
	35894	This field is set to NOW when the Order is first a dded to th is sub-fil e.
	35895	"^DD",8000 00,800000. 14,1.01,21 ,2,0)
	35896	It is uned itable.
	35897	"^DD",8000 00,800000. 14,1.01,"D T")
	35898	3160126
	35899	"^DD",8000 00,800000. 14,2,0)
	35900	ORDER FLAG /UNFLAG DA TE/TIME^80 0000.142DA ^^2;0
	35901	"^DD",8000 00,800000. 14,2,21,0)
	35902	^^1^1^3151 217^
	35903	"^DD",8000 00,800000. 14,2,21,1, 0)
	35904	This sub-f ile contai ns flaggin g /unflagg ing action s on order s.
	35905	"^DD",8000 00,800000. 14,2,"DT")
	35906	3151216
	35907	"^DD",8000 00,800000. 142,0)
	35908	ORDER FLAG /UNFLAG DA TE/TIME SU B-FIELD^^. 04^4
	35909	"^DD",8000 00,800000. 142,0,"DT" )
	35910	3151216
	35911	"^DD",8000 00,800000. 142,0,"IX" ,"B",80000 0.142,.01)
	35912
	35913	"^DD",8000 00,800000. 142,0,"NM" ,"ORDER FL AG/UNFLAG DATE/TIME" )
	35914
	35915	"^DD",8000 00,800000. 142,0,"UP" )
	35916	800000.14
	35917	"^DD",8000 00,800000. 142,.01,0)
	35918	ORDER FLAG /UNFLAG DA TE/TIME^D^ ^0;1^S %DT ="ESTR" D ^%DT S X=Y K:Y<1 X
	35919	"^DD",8000 00,800000. 142,.01,1, 0)
	35920	^.1
	35921	"^DD",8000 00,800000. 142,.01,1, 1,0)
	35922	800000.142 ^B
	35923	"^DD",8000 00,800000. 142,.01,1, 1,1)
	35924	S ^HMP(800 000,DA(3), 1,DA(2),1, DA(1),2,"B ",$E(X,1,3 0),DA)=""
	35925	"^DD",8000 00,800000. 142,.01,1, 1,2)
	35926	K ^HMP(800 000,DA(3), 1,DA(2),1, DA(1),2,"B ",$E(X,1,3 0),DA)
	35927	"^DD",8000 00,800000. 142,.01,3)
	35928	Enter the date and t ime the or der was fl agged or u nflagged.
	35929	"^DD",8000 00,800000. 142,.01,21 ,0)
	35930	^.001^3^3^ 3151217^^
	35931	"^DD",8000 00,800000. 142,.01,21 ,1,0)
	35932	This is th e date/tim e with sec onds that an order w as flagged /unflagge d.
	35933	"^DD",8000 00,800000. 142,.01,21 ,2,0)
	35934	This field is entere d programm atically.
	35935	"^DD",8000 00,800000. 142,.01,21 ,3,0)
	35936	An order c an be flag ged or unf lagged mul tiple time s.
	35937	"^DD",8000 00,800000. 142,.01,"D T")
	35938	3151216
	35939	"^DD",8000 00,800000. 142,.02,0)
	35940	FLAG ACTIO N^S^F:FLAG GED;U:UNFL AGGED;^0;2 ^Q
	35941	"^DD",8000 00,800000. 142,.02,3)
	35942	Indicate w hether the order was flagged o r unflagge d.
	35943	"^DD",8000 00,800000. 142,.02,21 ,0)
	35944	^.001^2^2^ 3151217^^
	35945	"^DD",8000 00,800000. 142,.02,21 ,1,0)
	35946	The date/t ime, with seconds, t he order w as flagged /unflagge d.
	35947	"^DD",8000 00,800000. 142,.02,21 ,2,0)
	35948	This field is entere d programm atically.
	35949	"^DD",8000 00,800000. 142,.02,"D T")
	35950	3151216
	35951	"^DD",8000 00,800000. 142,.03,0)
	35952	FLAG/UNFLA G USER^P20 0'^VA(200, ^0;3^Q
	35953	"^DD",8000 00,800000. 142,.03,3)
	35954	Enter the user who f lagged or unflagged the order.
	35955	"^DD",8000 00,800000. 142,.03,21 ,0)
	35956	^.001^2^2^ 3151217^^
	35957	"^DD",8000 00,800000. 142,.03,21 ,1,0)
	35958	The user w ho flagged /unflagge d the orde r.
	35959	"^DD",8000 00,800000. 142,.03,21 ,2,0)
	35960	This field is entere d programm atically.
	35961	"^DD",8000 00,800000. 142,.03,"D T")
	35962	3151216
	35963	"^DD",8000 00,800000. 142,.04,0)
	35964	FLAG/UNFLA G REASON^F ^^0;4^K:$L (X)>80!($L (X)<1) X
	35965	"^DD",8000 00,800000. 142,.04,.1 )
	35966	REASON FOR FLAGGING /UNFLAGGIN G
	35967	"^DD",8000 00,800000. 142,.04,3)
	35968	Answer mus t be 1-80 characters .
	35969	"^DD",8000 00,800000. 142,.04,21 ,0)
	35970	^.001^2^2^ 3151217^^^
	35971	"^DD",8000 00,800000. 142,.04,21 ,1,0)
	35972	This is wh y the orde r was flag ged /unfla gged.
	35973	"^DD",8000 00,800000. 142,.04,21 ,2,0)
	35974	This field is entere d programm atically.
	35975	"^DD",8000 00,800000. 142,.04,"D T")
	35976	3151216
	35977	"^DD",8000 00.1,80000 0.1,0)
	35978	FIELD^^1^4
	35979	"^DD",8000 00.1,80000 0.1,0,"DDA ")
	35980	N
	35981	"^DD",8000 00.1,80000 0.1,0,"IX" ,"B",80000 0.1,.01)
	35982
	35983	"^DD",8000 00.1,80000 0.1,0,"NM" ,"HMP PATI ENT OBJECT ")
	35984
	35985	"^DD",8000 00.1,80000 0.1,0,"VRP K")
	35986	HMP
	35987	"^DD",8000 00.1,80000 0.1,.01,0)
	35988	UID^RF^^0; 1^K:$L(X)> 63!($L(X)< 3)!'(X'?1P .E) X
	35989	"^DD",8000 00.1,80000 0.1,.01,1, 0)
	35990	^.1
	35991	"^DD",8000 00.1,80000 0.1,.01,1, 1,0)
	35992	800000.1^B
	35993	"^DD",8000 00.1,80000 0.1,.01,1, 1,1)
	35994	S ^HMP(800 000.1,"B", $E(X,1,63) ,DA)=""
	35995	"^DD",8000 00.1,80000 0.1,.01,1, 1,2)
	35996	K ^HMP(800 000.1,"B", $E(X,1,63) ,DA)
	35997	"^DD",8000 00.1,80000 0.1,.01,1, 1,"%D",0)
	35998	^^1^1^3151 116^
	35999	"^DD",8000 00.1,80000 0.1,.01,1, 1,"%D",1,0 )
	36000	Index of C OLLECTION by PATIENT (DFN).
	36001	"^DD",8000 00.1,80000 0.1,.01,3)
	36002	Answer mus t be 3-63 characters in length .
	36003	"^DD",8000 00.1,80000 0.1,.01,21 ,0)
	36004	^^1^1^3121 129^
	36005	"^DD",8000 00.1,80000 0.1,.01,21 ,1,0)
	36006	The fully specified Universal ID string for this o bject.
	36007	"^DD",8000 00.1,80000 0.1,.01,23 ,0)
	36008	^^1^1^3121 129^
	36009	"^DD",8000 00.1,80000 0.1,.01,23 ,1,0)
	36010	urn:va:{sy stemId}:{D FN}:{colle ction}:{ie n}
	36011	"^DD",8000 00.1,80000 0.1,.01,"D T")
	36012	3150812
	36013	"^DD",8000 00.1,80000 0.1,.02,0)
	36014	PATIENT^RP 2'^DPT(^0; 2^Q
	36015	"^DD",8000 00.1,80000 0.1,.02,3)
	36016	Enter the patient th at owns th is object.
	36017	"^DD",8000 00.1,80000 0.1,.02,21 ,0)
	36018	^^1^1^3121 129^
	36019	"^DD",8000 00.1,80000 0.1,.02,21 ,1,0)
	36020	Patient fi le #2 ien
	36021	"^DD",8000 00.1,80000 0.1,.02,"D T")
	36022	3121129
	36023	"^DD",8000 00.1,80000 0.1,.03,0)
	36024	COLLECTION ^F^^0;3^K: $L(X)>30!( $L(X)<3) X
	36025	"^DD",8000 00.1,80000 0.1,.03,3)
	36026	Answer mus t be 3-30 characters in length .
	36027	"^DD",8000 00.1,80000 0.1,.03,21 ,0)
	36028	^^1^1^3121 129^
	36029	"^DD",8000 00.1,80000 0.1,.03,21 ,1,0)
	36030	The name o f the type or kind o f data thi s object b elongs to.
	36031	"^DD",8000 00.1,80000 0.1,.03,"D T")
	36032	3121129
	36033	"^DD",8000 00.1,80000 0.1,1,0)
	36034	DATA^80000 0.101^^1;0
	36035	"^DD",8000 00.1,80000 0.101,0)
	36036	DATA SUB-F IELD^^.01^ 1
	36037	"^DD",8000 00.1,80000 0.101,0,"N M","DATA")
	36038
	36039	"^DD",8000 00.1,80000 0.101,0,"U P")
	36040	800000.1
	36041	"^DD",8000 00.1,80000 0.101,.01, 0)
	36042	DATA^Wx^^0 ;1^Q
	36043	"^DD",8000 00.1,80000 0.101,.01, 21,0)
	36044	^^1^1^3121 129^
	36045	"^DD",8000 00.1,80000 0.101,.01, 21,1,0)
	36046	JSON data object
	36047	"^DD",8000 00.1,80000 0.101,.01, "DT")
	36048	3121129
	36049	"^DD",8000 00.11,8000 00.11,0)
	36050	FIELD^^1^3
	36051	"^DD",8000 00.11,8000 00.11,0,"I X","ACNT", 800000.11, .03)
	36052
	36053	"^DD",8000 00.11,8000 00.11,0,"I X","B",800 000.11,.01 )
	36054
	36055	"^DD",8000 00.11,8000 00.11,0,"I X","C",800 000.11,.03 )
	36056
	36057	"^DD",8000 00.11,8000 00.11,0,"N M","HMP OB JECT")
	36058
	36059	"^DD",8000 00.11,8000 00.11,0,"V RPK")
	36060	HMP
	36061	"^DD",8000 00.11,8000 00.11,.01, 0)
	36062	UID^RF^^0; 1^K:$L(X)> 63!($L(X)< 3)!'(X'?1P .E) X
	36063	"^DD",8000 00.11,8000 00.11,.01, 1,0)
	36064	^.1
	36065	"^DD",8000 00.11,8000 00.11,.01, 1,1,0)
	36066	800000.11^ B
	36067	"^DD",8000 00.11,8000 00.11,.01, 1,1,1)
	36068	S ^HMP(800 000.11,"B" ,$E(X,1,63 ),DA)=""
	36069	"^DD",8000 00.11,8000 00.11,.01, 1,1,2)
	36070	K ^HMP(800 000.11,"B" ,$E(X,1,63 ),DA)
	36071	"^DD",8000 00.11,8000 00.11,.01, 1,1,"%D",0 )
	36072	^.101^1^1^ 3150923^^
	36073	"^DD",8000 00.11,8000 00.11,.01, 1,1,"%D",1 ,0)
	36074	Cross-refe rence by U niversal I Dentifier (UID).
	36075	"^DD",8000 00.11,8000 00.11,.01, 3)
	36076	Answer mus t be 3-63 characters in length .
	36077	"^DD",8000 00.11,8000 00.11,.01, 21,0)
	36078	^^1^1^3121 129^
	36079	"^DD",8000 00.11,8000 00.11,.01, 21,1,0)
	36080	The fully specified Universal ID string for this o bject.
	36081	"^DD",8000 00.11,8000 00.11,.01, 23,0)
	36082	^^1^1^3121 129^
	36083	"^DD",8000 00.11,8000 00.11,.01, 23,1,0)
	36084	urn:va:{co llection}: {systemId} :{ien}
	36085	"^DD",8000 00.11,8000 00.11,.01, "DT")
	36086	3121129
	36087	"^DD",8000 00.11,8000 00.11,.03, 0)
	36088	COLLECTION ^F^^0;3^K: $L(X)>30!( $L(X)<3) X
	36089	"^DD",8000 00.11,8000 00.11,.03, 1,0)
	36090	^.1
	36091	"^DD",8000 00.11,8000 00.11,.03, 1,1,0)
	36092	800000.11^ C
	36093	"^DD",8000 00.11,8000 00.11,.03, 1,1,1)
	36094	S ^HMP(800 000.11,"C" ,$E(X,1,30 ),DA)=""
	36095	"^DD",8000 00.11,8000 00.11,.03, 1,1,2)
	36096	K ^HMP(800 000.11,"C" ,$E(X,1,30 ),DA)
	36097	"^DD",8000 00.11,8000 00.11,.03, 1,1,"%D",0 )
	36098	^^1^1^3150 923^
	36099	"^DD",8000 00.11,8000 00.11,.03, 1,1,"%D",1 ,0)
	36100	Cross-refe rence by c ollection, VistA ext racted dom ains.
	36101	"^DD",8000 00.11,8000 00.11,.03, 1,1,"DT")
	36102	3121129
	36103	"^DD",8000 00.11,8000 00.11,.03, 1,2,0)
	36104	800000.11^ ACNT^MUMPS
	36105	"^DD",8000 00.11,8000 00.11,.03, 1,2,1)
	36106	S ^HMP(800 000.11,"AC NT",$E(X,1 ,30))=$G(^ HMP(800000 .11,"ACNT" ,$E(X,1,30 )))+1
	36107	"^DD",8000 00.11,8000 00.11,.03, 1,2,2)
	36108	S ^HMP(800 000.11,"AC NT",$E(X,1 ,30))=$G(^ HMP(800000 .11,"ACNT" ,$E(X,1,30 )))-1
	36109	"^DD",8000 00.11,8000 00.11,.03, 1,2,"%D",0 )
	36110	^.101^1^1^ 3150923^^^
	36111	"^DD",8000 00.11,8000 00.11,.03, 1,2,"%D",1 ,0)
	36112	Maintain a count of the number of items in each co llection.
	36113	"^DD",8000 00.11,8000 00.11,.03, 1,2,"DT")
	36114	3140503
	36115	"^DD",8000 00.11,8000 00.11,.03, 3)
	36116	Answer mus t be 3-30 characters in length .
	36117	"^DD",8000 00.11,8000 00.11,.03, 21,0)
	36118	^^1^1^3121 129^
	36119	"^DD",8000 00.11,8000 00.11,.03, 21,1,0)
	36120	The name o f the type or kind o f data thi s object b elongs to.
	36121	"^DD",8000 00.11,8000 00.11,.03, "DT")
	36122	3140503
	36123	"^DD",8000 00.11,8000 00.11,1,0)
	36124	DATA^80000 0.111^^1;0
	36125	"^DD",8000 00.11,8000 00.11,1,21 ,0)
	36126	^^1^1^3150 923^
	36127	"^DD",8000 00.11,8000 00.11,1,21 ,1,0)
	36128	Actual Vis tA domain data to be transmitt ed.
	36129	"^DD",8000 00.11,8000 00.111,0)
	36130	DATA SUB-F IELD^^.01^ 1
	36131	"^DD",8000 00.11,8000 00.111,0," NM","DATA" )
	36132
	36133	"^DD",8000 00.11,8000 00.111,0," UP")
	36134	800000.11
	36135	"^DD",8000 00.11,8000 00.111,.01 ,0)
	36136	DATA^Wx^^0 ;1^Q
	36137	"^DD",8000 00.11,8000 00.111,.01 ,21,0)
	36138	^.001^1^1^ 3150923^^
	36139	"^DD",8000 00.11,8000 00.111,.01 ,21,1,0)
	36140	JSON data object.
	36141	"^DD",8000 00.11,8000 00.111,.01 ,"DT")
	36142	3121129
	36143	"^DD",8000 00.2,80000 0.2,0)
	36144	FIELD^^.3^ 11
	36145	"^DD",8000 00.2,80000 0.2,0,"DT" )
	36146	3151117
	36147	"^DD",8000 00.2,80000 0.2,0,"IX" ,"ADD",800 000.2,.03)
	36148
	36149	"^DD",8000 00.2,80000 0.2,0,"IX" ,"AREFRESH ",800000.2 ,.08)
	36150
	36151	"^DD",8000 00.2,80000 0.2,0,"IX" ,"B",80000 0.2,.01)
	36152
	36153	"^DD",8000 00.2,80000 0.2,0,"NM" ,"HMP LIST ")
	36154
	36155	"^DD",8000 00.2,80000 0.2,0,"VRP K")
	36156	HMP
	36157	"^DD",8000 00.2,80000 0.2,.01,0)
	36158	NAME^RF^^0 ;1^K:$L(X) >30!($L(X) <3)!'(X'?1 P.E) X
	36159	"^DD",8000 00.2,80000 0.2,.01,1, 0)
	36160	^.1
	36161	"^DD",8000 00.2,80000 0.2,.01,1, 1,0)
	36162	800000.2^B
	36163	"^DD",8000 00.2,80000 0.2,.01,1, 1,1)
	36164	S ^HMPD(80 0000.2,"B" ,$E(X,1,30 ),DA)=""
	36165	"^DD",8000 00.2,80000 0.2,.01,1, 1,2)
	36166	K ^HMPD(80 0000.2,"B" ,$E(X,1,30 ),DA)
	36167	"^DD",8000 00.2,80000 0.2,.01,1, 1,"%D",0)
	36168	^^1^1^3150 923^
	36169	"^DD",8000 00.2,80000 0.2,.01,1, 1,"%D",1,0 )
	36170	Cross-refe rence by V istA domai n name.
	36171	"^DD",8000 00.2,80000 0.2,.01,3)
	36172	Answer mus t be 3-30 characters in length .
	36173	"^DD",8000 00.2,80000 0.2,.01,21 ,0)
	36174	^^1^1^3150 923^
	36175	"^DD",8000 00.2,80000 0.2,.01,21 ,1,0)
	36176	This is th e name of the HMP Li st.
	36177	"^DD",8000 00.2,80000 0.2,.01,"D T")
	36178	3150923
	36179	"^DD",8000 00.2,80000 0.2,.02,0)
	36180	TYPE^S^0:S TATIC;1:DY NAMIC;^0;2 ^Q
	36181	"^DD",8000 00.2,80000 0.2,.02,3)
	36182	This field should no t be edite d manually without c onsulting the develo pment team .
	36183	"^DD",8000 00.2,80000 0.2,.02,21 ,0)
	36184	^^1^1^3150 923^
	36185	"^DD",8000 00.2,80000 0.2,.02,21 ,1,0)
	36186	This field defines a data entr y as stati c or dynam ic.
	36187	"^DD",8000 00.2,80000 0.2,.02,"D T")
	36188	3121011
	36189	"^DD",8000 00.2,80000 0.2,.03,0)
	36190	DD NUMBER^ NJ14,5^^0; 3^K:+X'=X! (X>9999999 9)!(X<1)!( X?.E1"."6N .N) X
	36191	"^DD",8000 00.2,80000 0.2,.03,1, 0)
	36192	^.1
	36193	"^DD",8000 00.2,80000 0.2,.03,1, 1,0)
	36194	800000.2^A DD
	36195	"^DD",8000 00.2,80000 0.2,.03,1, 1,1)
	36196	S ^HMPD(80 0000.2,"AD D",$E(X,1, 30),DA)=""
	36197	"^DD",8000 00.2,80000 0.2,.03,1, 1,2)
	36198	K ^HMPD(80 0000.2,"AD D",$E(X,1, 30),DA)
	36199	"^DD",8000 00.2,80000 0.2,.03,1, 1,"%D",0)
	36200	^^1^1^3150 923^
	36201	"^DD",8000 00.2,80000 0.2,.03,1, 1,"%D",1,0 )
	36202	Cross-refe rence by t he File's Data Dicti onary numb er.
	36203	"^DD",8000 00.2,80000 0.2,.03,1, 1,"DT")
	36204	3121022
	36205	"^DD",8000 00.2,80000 0.2,.03,3)
	36206	Type a num ber betwee n 1 and 99 999999, 5 decimal di gits.
	36207	"^DD",8000 00.2,80000 0.2,.03,21 ,0)
	36208	^^1^1^3150 923^
	36209	"^DD",8000 00.2,80000 0.2,.03,21 ,1,0)
	36210	This is th e NUMBER o f the File being ref erenced.
	36211	"^DD",8000 00.2,80000 0.2,.03,"D T")
	36212	3121022
	36213	"^DD",8000 00.2,80000 0.2,.04,0)
	36214	DOMAIN^RP8 00000.21'^ HMPD(80000 0.21,^0;4^ Q
	36215	"^DD",8000 00.2,80000 0.2,.04,3)
	36216	Enter a Vi stA data d omain from the HMP L IST DOMAIN File.
	36217	"^DD",8000 00.2,80000 0.2,.04,21 ,0)
	36218	^^1^1^3150 923^
	36219	"^DD",8000 00.2,80000 0.2,.04,21 ,1,0)
	36220	A VistA da ta domain from the H MP LIST DO MAIN File.
	36221	"^DD",8000 00.2,80000 0.2,.04,"D T")
	36222	3121031
	36223	"^DD",8000 00.2,80000 0.2,.05,0)
	36224	ATTRIBUTE^ RP800000.2 2'^HMPD(80 0000.22,^0 ;5^Q
	36225	"^DD",8000 00.2,80000 0.2,.05,3)
	36226	Enter an A TTRIBUTE f rom the HM P LIST ATT RIBUTE Fil e.
	36227	"^DD",8000 00.2,80000 0.2,.05,21 ,0)
	36228	^^1^1^3150 923^
	36229	"^DD",8000 00.2,80000 0.2,.05,21 ,1,0)
	36230	This is a pointer to the HMP A TTRIBUTE F ile.
	36231	"^DD",8000 00.2,80000 0.2,.05,"D T")
	36232	3121107
	36233	"^DD",8000 00.2,80000 0.2,.08,0)
	36234	REFRESH TH RESHOLD^NJ 4,0^^0;8^K :+X'=X!(X> 1440)!(X<0 )!(X?.E1". "1N.N) X
	36235	"^DD",8000 00.2,80000 0.2,.08,1, 0)
	36236	^.1
	36237	"^DD",8000 00.2,80000 0.2,.08,1, 1,0)
	36238	800000.2^A REFRESH
	36239	"^DD",8000 00.2,80000 0.2,.08,1, 1,1)
	36240	S ^HMPD(80 0000.2,"AR EFRESH",$E (X,1,30),D A)=""
	36241	"^DD",8000 00.2,80000 0.2,.08,1, 1,2)
	36242	K ^HMPD(80 0000.2,"AR EFRESH",$E (X,1,30),D A)
	36243	"^DD",8000 00.2,80000 0.2,.08,1, 1,"%D",0)
	36244	^^1^1^3150 923^
	36245	"^DD",8000 00.2,80000 0.2,.08,1, 1,"%D",1,0 )
	36246	Cross-refe rence by t ime (in da ys) until a refresh happens.
	36247	"^DD",8000 00.2,80000 0.2,.08,1, 1,"DT")
	36248	3121031
	36249	"^DD",8000 00.2,80000 0.2,.08,3)
	36250	Type a num ber betwee n 0 and 14 40, 0 deci mal digits .
	36251	"^DD",8000 00.2,80000 0.2,.08,21 ,0)
	36252	^^2^2^3150 923^
	36253	"^DD",8000 00.2,80000 0.2,.08,21 ,1,0)
	36254	Amount of time, in d ays, requi red to pas s before a n automati c
	36255	"^DD",8000 00.2,80000 0.2,.08,21 ,2,0)
	36256	refresh wi ll occur.
	36257	"^DD",8000 00.2,80000 0.2,.08,"D T")
	36258	3121031
	36259	"^DD",8000 00.2,80000 0.2,.09,0)
	36260	NEXT REFRE SH DATE^D^ ^0;9^S %DT ="ETXR" D ^%DT S X=Y K:Y<1 X
	36261	"^DD",8000 00.2,80000 0.2,.09,3)
	36262	Enter a da te up to T +1440.
	36263	"^DD",8000 00.2,80000 0.2,.09,21 ,0)
	36264	^^1^1^3150 923^
	36265	"^DD",8000 00.2,80000 0.2,.09,21 ,1,0)
	36266	Date of ne xt refresh based on the value of REFRESH THRESHOLD .
	36267	"^DD",8000 00.2,80000 0.2,.09,"D T")
	36268	3150923
	36269	"^DD",8000 00.2,80000 0.2,.11,0)
	36270	GENERATION CODE^K^^. 11;E1,245^ K:$L(X)>24 5 X D:$D(X ) ^DIM
	36271	"^DD",8000 00.2,80000 0.2,.11,3)
	36272	This is St andard MUM PS code.
	36273	"^DD",8000 00.2,80000 0.2,.11,9)
	36274	@
	36275	"^DD",8000 00.2,80000 0.2,.11,21 ,0)
	36276	^^1^1^3150 923^
	36277	"^DD",8000 00.2,80000 0.2,.11,21 ,1,0)
	36278	MUMPS code to implem ent the re fresh of a domain.
	36279	"^DD",8000 00.2,80000 0.2,.11,"D T")
	36280	3121011
	36281	"^DD",8000 00.2,80000 0.2,.2,0)
	36282	COLUMNS^80 0000.202^^ 2;0
	36283	"^DD",8000 00.2,80000 0.2,.2,21, 0)
	36284	^.001^1^1^ 3150923^^
	36285	"^DD",8000 00.2,80000 0.2,.2,21, 1,0)
	36286	These are references to data w hich will be extract ed.
	36287	"^DD",8000 00.2,80000 0.2,.3,0)
	36288	DESCRIPTIO N^800000.2 03^^3;0
	36289	"^DD",8000 00.2,80000 0.2,.3,21, 0)
	36290	^.001^1^1^ 3151117^^^ ^
	36291	"^DD",8000 00.2,80000 0.2,.3,21, 1,0)
	36292	Descriptio n of the d ata to be extracted.
	36293	"^DD",8000 00.2,80000 0.2,.3,"DT ")
	36294	3151117
	36295	"^DD",8000 00.2,80000 0.2,.9,0)
	36296	DATA^80000 0.209^^9;0
	36297	"^DD",8000 00.2,80000 0.2,.9,21, 0)
	36298	^.001^1^1^ 3151117^^^
	36299	"^DD",8000 00.2,80000 0.2,.9,21, 1,0)
	36300	The actual data bein g sent.
	36301	"^DD",8000 00.2,80000 0.2,.9,"DT ")
	36302	3151117
	36303	"^DD",8000 00.2,80000 0.202,0)
	36304	COLUMNS SU B-FIELD^^. 02^2
	36305	"^DD",8000 00.2,80000 0.202,0,"I X","AORD", 800000.202 ,.02)
	36306
	36307	"^DD",8000 00.2,80000 0.202,0,"I X","B",800 000.202,.0 1)
	36308
	36309	"^DD",8000 00.2,80000 0.202,0,"N M","COLUMN S")
	36310
	36311	"^DD",8000 00.2,80000 0.202,0,"U P")
	36312	800000.2
	36313	"^DD",8000 00.2,80000 0.202,.01, 0)
	36314	COLUMN NAM E^MF^^0;1^ K:$L(X)>30 !($L(X)<3) !'(X?1UL.2 9ULN) X
	36315	"^DD",8000 00.2,80000 0.202,.01, 1,0)
	36316	^.1
	36317	"^DD",8000 00.2,80000 0.202,.01, 1,1,0)
	36318	800000.202 ^B
	36319	"^DD",8000 00.2,80000 0.202,.01, 1,1,1)
	36320	S ^HMPD(80 0000.2,DA( 1),2,"B",$ E(X,1,30), DA)=""
	36321	"^DD",8000 00.2,80000 0.202,.01, 1,1,2)
	36322	K ^HMPD(80 0000.2,DA( 1),2,"B",$ E(X,1,30), DA)
	36323	"^DD",8000 00.2,80000 0.202,.01, 1,1,"%D",0 )
	36324	^^1^1^3150 923^
	36325	"^DD",8000 00.2,80000 0.202,.01, 1,1,"%D",1 ,0)
	36326	COLUMN cro ss-referen ce by name .
	36327	"^DD",8000 00.2,80000 0.202,.01, 3)
	36328	Answer mus t be 3-30 characters in length .
	36329	"^DD",8000 00.2,80000 0.202,.01, 21,0)
	36330	^^1^1^3150 923^
	36331	"^DD",8000 00.2,80000 0.202,.01, 21,1,0)
	36332	Name of th e data col umn to be extracted.
	36333	"^DD",8000 00.2,80000 0.202,.01, "DT")
	36334	3141015
	36335	"^DD",8000 00.2,80000 0.202,.02, 0)
	36336	ORDER^RNJ2 ,0^^0;2^K: +X'=X!(X>9 9)!(X<3)!( X?.E1"."1N .N) X
	36337	"^DD",8000 00.2,80000 0.202,.02, 1,0)
	36338	^.1
	36339	"^DD",8000 00.2,80000 0.202,.02, 1,1,0)
	36340	800000.202 ^AORD
	36341	"^DD",8000 00.2,80000 0.202,.02, 1,1,1)
	36342	S ^HMPD(80 0000.2,DA( 1),2,"AORD ",$E(X,1,3 0),DA)=""
	36343	"^DD",8000 00.2,80000 0.202,.02, 1,1,2)
	36344	K ^HMPD(80 0000.2,DA( 1),2,"AORD ",$E(X,1,3 0),DA)
	36345	"^DD",8000 00.2,80000 0.202,.02, 1,1,"%D",0 )
	36346	^^1^1^3150 923^
	36347	"^DD",8000 00.2,80000 0.202,.02, 1,1,"%D",1 ,0)
	36348	Cross-refe rence of d ata column extractio n order.
	36349	"^DD",8000 00.2,80000 0.202,.02, 1,1,"DT")
	36350	3121031
	36351	"^DD",8000 00.2,80000 0.202,.02, 3)
	36352	Type a num ber betwee n 3 and 99 , 0 decima l digits.
	36353	"^DD",8000 00.2,80000 0.202,.02, 21,0)
	36354	^^1^1^3150 923^
	36355	"^DD",8000 00.2,80000 0.202,.02, 21,1,0)
	36356	Order in w hich data columns wi ll be extr acted.
	36357	"^DD",8000 00.2,80000 0.202,.02, "DT")
	36358	3121031
	36359	"^DD",8000 00.2,80000 0.203,0)
	36360	DESCRIPTIO N SUB-FIEL D^^.01^1
	36361	"^DD",8000 00.2,80000 0.203,0,"D T")
	36362	3151117
	36363	"^DD",8000 00.2,80000 0.203,0,"N M","DESCRI PTION")
	36364
	36365	"^DD",8000 00.2,80000 0.203,0,"U P")
	36366	800000.2
	36367	"^DD",8000 00.2,80000 0.203,.01, 0)
	36368	Descriptio n of JSON^ WLx^^0;1^Q
	36369	"^DD",8000 00.2,80000 0.203,.01, 3)
	36370
	36371	"^DD",8000 00.2,80000 0.203,.01, 21,0)
	36372	^.001^1^1^ 3151117^^^ ^
	36373	"^DD",8000 00.2,80000 0.203,.01, 21,1,0)
	36374	Descriptio n of the d ata to be extracted.
	36375	"^DD",8000 00.2,80000 0.203,.01, "DT")
	36376	3151117
	36377	"^DD",8000 00.2,80000 0.209,0)
	36378	DATA SUB-F IELD^^.01^ 1
	36379	"^DD",8000 00.2,80000 0.209,0,"N M","DATA")
	36380
	36381	"^DD",8000 00.2,80000 0.209,0,"U P")
	36382	800000.2
	36383	"^DD",8000 00.2,80000 0.209,.01, 0)
	36384	DATA^WLx^^ 0;1^Q
	36385	"^DD",8000 00.2,80000 0.209,.01, 3)
	36386
	36387	"^DD",8000 00.2,80000 0.209,.01, 21,0)
	36388	^.001^1^1^ 3151117^^^
	36389	"^DD",8000 00.2,80000 0.209,.01, 21,1,0)
	36390	The actual data bein g sent.
	36391	"^DD",8000 00.2,80000 0.209,.01, "DT")
	36392	3121030
	36393	"^DD",8000 00.21,8000 00.21,0)
	36394	FIELD^^.01 ^3
	36395	"^DD",8000 00.21,8000 00.21,0,"D T")
	36396	3150923
	36397	"^DD",8000 00.21,8000 00.21,0,"I X","B",800 000.21,.01 )
	36398
	36399	"^DD",8000 00.21,8000 00.21,0,"N M","HMP LI ST DOMAIN" )
	36400
	36401	"^DD",8000 00.21,8000 00.21,0,"P T",800000. 2,.04)
	36402
	36403	"^DD",8000 00.21,8000 00.21,0,"V RPK")
	36404	HMP
	36405	"^DD",8000 00.21,8000 00.21,.01, 0)
	36406	NAME^RF^^0 ;1^K:$L(X) >30!($L(X) <3)!'(X'?1 P.E) X
	36407	"^DD",8000 00.21,8000 00.21,.01, 1,0)
	36408	^.1
	36409	"^DD",8000 00.21,8000 00.21,.01, 1,1,0)
	36410	800000.21^ B
	36411	"^DD",8000 00.21,8000 00.21,.01, 1,1,1)
	36412	S ^HMPD(80 0000.21,"B ",$E(X,1,3 0),DA)=""
	36413	"^DD",8000 00.21,8000 00.21,.01, 1,1,2)
	36414	K ^HMPD(80 0000.21,"B ",$E(X,1,3 0),DA)
	36415	"^DD",8000 00.21,8000 00.21,.01, 1,1,"%D",0 )
	36416	^^1^1^3150 923^
	36417	"^DD",8000 00.21,8000 00.21,.01, 1,1,"%D",1 ,0)
	36418	The name c ross-refer ence by it s domain.
	36419	"^DD",8000 00.21,8000 00.21,.01, 3)
	36420	Answer mus t be 3-30 characters in length .
	36421	"^DD",8000 00.21,8000 00.21,.01, 21,0)
	36422	^^2^2^3150 923^
	36423	"^DD",8000 00.21,8000 00.21,.01, 21,1,0)
	36424	This is th e name of a VistA da ta domain which can be
	36425	"^DD",8000 00.21,8000 00.21,.01, 21,2,0)
	36426	extracted for transm ission.
	36427	"^DD",8000 00.21,8000 00.21,.01, "DT")
	36428	3150923
	36429	"^DD",8000 00.21,8000 00.21,.02, 0)
	36430	ABBREVIATI ON^F^^0;2^ K:$L(X)>10 !($L(X)<1) X
	36431	"^DD",8000 00.21,8000 00.21,.02, 3)
	36432	Answer mus t be 1-10 characters in length .
	36433	"^DD",8000 00.21,8000 00.21,.02, 21,0)
	36434	^^1^1^3150 923^
	36435	"^DD",8000 00.21,8000 00.21,.02, 21,1,0)
	36436	This is th e short na me of the VistA data domain.
	36437	"^DD",8000 00.21,8000 00.21,.02, "DT")
	36438	3121031
	36439	"^DD",8000 00.21,8000 00.21,.03, 0)
	36440	DISPLAY NA ME^F^^0;3^ K:$L(X)>50 !($L(X)<1) X
	36441	"^DD",8000 00.21,8000 00.21,.03, 3)
	36442	Answer mus t be 1-50 characters in length .
	36443	"^DD",8000 00.21,8000 00.21,.03, 21,0)
	36444	^^1^1^3150 923^
	36445	"^DD",8000 00.21,8000 00.21,.03, 21,1,0)
	36446	This is th e actual n ame of the VistA dat a domain.
	36447	"^DD",8000 00.21,8000 00.21,.03, "DT")
	36448	3121031
	36449	"^DD",8000 00.22,8000 00.22,0)
	36450	FIELD^^.01 ^3
	36451	"^DD",8000 00.22,8000 00.22,0,"D T")
	36452	3150923
	36453	"^DD",8000 00.22,8000 00.22,0,"I X","B",800 000.22,.01 )
	36454
	36455	"^DD",8000 00.22,8000 00.22,0,"N M","HMP LI ST ATTRIBU TE")
	36456
	36457	"^DD",8000 00.22,8000 00.22,0,"P T",800000. 2,.05)
	36458
	36459	"^DD",8000 00.22,8000 00.22,0,"V RPK")
	36460	HMP
	36461	"^DD",8000 00.22,8000 00.22,.01, 0)
	36462	NAME^RF^^0 ;1^K:$L(X) >30!($L(X) <3)!'(X'?1 P.E) X
	36463	"^DD",8000 00.22,8000 00.22,.01, 1,0)
	36464	^.1
	36465	"^DD",8000 00.22,8000 00.22,.01, 1,1,0)
	36466	800000.22^ B
	36467	"^DD",8000 00.22,8000 00.22,.01, 1,1,1)
	36468	S ^HMPD(80 0000.22,"B ",$E(X,1,3 0),DA)=""
	36469	"^DD",8000 00.22,8000 00.22,.01, 1,1,2)
	36470	K ^HMPD(80 0000.22,"B ",$E(X,1,3 0),DA)
	36471	"^DD",8000 00.22,8000 00.22,.01, 1,1,"%D",0 )
	36472	^^1^1^3150 923^
	36473	"^DD",8000 00.22,8000 00.22,.01, 1,1,"%D",1 ,0)
	36474	This is th e cross-re ference of the attri bute by it s name.
	36475	"^DD",8000 00.22,8000 00.22,.01, 3)
	36476	Answer mus t be 3-30 characters in length .
	36477	"^DD",8000 00.22,8000 00.22,.01, 21,0)
	36478	^^1^1^3150 923^
	36479	"^DD",8000 00.22,8000 00.22,.01, 21,1,0)
	36480	This is th e name of an eHMP da ta domain' s attribut e.
	36481	"^DD",8000 00.22,8000 00.22,.01, "DT")
	36482	3150923
	36483	"^DD",8000 00.22,8000 00.22,.02, 0)
	36484	ABBREVIATI ON^F^^0;2^ K:$L(X)>10 !($L(X)<1) X
	36485	"^DD",8000 00.22,8000 00.22,.02, 3)
	36486	Answer mus t be 1-10 characters in length .
	36487	"^DD",8000 00.22,8000 00.22,.02, 21,0)
	36488	^^1^1^3150 923^
	36489	"^DD",8000 00.22,8000 00.22,.02, 21,1,0)
	36490	This is th e short na me of an e HMP data d omain's at tribute.
	36491	"^DD",8000 00.22,8000 00.22,.02, "DT")
	36492	3121031
	36493	"^DD",8000 00.22,8000 00.22,.03, 0)
	36494	DISPLAY NA ME^F^^0;3^ K:$L(X)>50 !($L(X)<1) X
	36495	"^DD",8000 00.22,8000 00.22,.03, 3)
	36496	Answer mus t be 1-50 characters in length .
	36497	"^DD",8000 00.22,8000 00.22,.03, 21,0)
	36498	^^1^1^3150 923^
	36499	"^DD",8000 00.22,8000 00.22,.03, 21,1,0)
	36500	This is th e actual n ame of an eHMP data domain's a ttribute.
	36501	"^DD",8000 00.22,8000 00.22,.03, "DT")
	36502	3121031
	36503	"^DD",8000 01,800001, 0)
	36504	FIELD^^.03 ^4
	36505	"^DD",8000 01,800001, 0,"DDA")
	36506	N
	36507	"^DD",8000 01,800001, 0,"IX","B" ,800001,.0 1)
	36508
	36509	"^DD",8000 01,800001, 0,"IX","C" ,800001,.0 3)
	36510
	36511	"^DD",8000 01,800001, 0,"NM","HM P PANEL")
	36512
	36513	"^DD",8000 01,800001, 0,"PT",800 001.21,.02 )
	36514
	36515	"^DD",8000 01,800001, 0,"VRPK")
	36516	HMP
	36517	"^DD",8000 01,800001, .01,0)
	36518	NAME^R*P81 0.4'^PXRM( 810.4,^0;1 ^S DIC("S" )="I $P(^( 0),U,3)=3" D ^DIC K DIC S DIC= DIE,X=+Y K :Y<0 X
	36519	"^DD",8000 01,800001, .01,1,0)
	36520	^.1
	36521	"^DD",8000 01,800001, .01,1,1,0)
	36522	800001^B
	36523	"^DD",8000 01,800001, .01,1,1,1)
	36524	S ^HMPPANE L("B",$E(X ,1,30),DA) =""
	36525	"^DD",8000 01,800001, .01,1,1,2)
	36526	K ^HMPPANE L("B",$E(X ,1,30),DA)
	36527	"^DD",8000 01,800001, .01,1,1,"% D",0)
	36528	^^1^1^3150 923^
	36529	"^DD",8000 01,800001, .01,1,1,"% D",1,0)
	36530	This is th e cross-re ference of rule sets by name.
	36531	"^DD",8000 01,800001, .01,3)
	36532	Enter a Re minder Lis t Rule.
	36533	"^DD",8000 01,800001, .01,12)
	36534	Only selec t RULE SET types
	36535	"^DD",8000 01,800001, .01,12.1)
	36536	S DIC("S") ="I $P(^(0 ),U,3)=3"
	36537	"^DD",8000 01,800001, .01,21,0)
	36538	^^1^1^3150 923^
	36539	"^DD",8000 01,800001, .01,21,1,0 )
	36540	This is th e name of an applied rule set.
	36541	"^DD",8000 01,800001, .01,"DT")
	36542	3110629
	36543	"^DD",8000 01,800001, .02,0)
	36544	DISPLAY NA ME^RF^^0;2 ^K:$L(X)>5 0!($L(X)<3 ) X
	36545	"^DD",8000 01,800001, .02,3)
	36546	Answer mus t be 3-50 characters in length .
	36547	"^DD",8000 01,800001, .02,21,0)
	36548	^^1^1^3150 923^
	36549	"^DD",8000 01,800001, .02,21,1,0 )
	36550	This is th e full nam e of the a pplied rul e set.
	36551	"^DD",8000 01,800001, .02,"DT")
	36552	3110630
	36553	"^DD",8000 01,800001, .03,0)
	36554	PATIENT LI ST NAME^F^ ^0;3^K:$L( X)>40!($L( X)<3) X
	36555	"^DD",8000 01,800001, .03,1,0)
	36556	^.1
	36557	"^DD",8000 01,800001, .03,1,1,0)
	36558	800001^C
	36559	"^DD",8000 01,800001, .03,1,1,1)
	36560	S ^HMPPANE L("C",$E(X ,1,30),DA) =""
	36561	"^DD",8000 01,800001, .03,1,1,2)
	36562	K ^HMPPANE L("C",$E(X ,1,30),DA)
	36563	"^DD",8000 01,800001, .03,1,1,"% D",0)
	36564	^^1^1^3150 923^
	36565	"^DD",8000 01,800001, .03,1,1,"% D",1,0)
	36566	This is th e cross-re ference by the name of the pat ient list.
	36567	"^DD",8000 01,800001, .03,1,1,"D T")
	36568	3111006
	36569	"^DD",8000 01,800001, .03,3)
	36570	Answer mus t be 3-40 characters in length .
	36571	"^DD",8000 01,800001, .03,21,0)
	36572	^^1^1^3150 923^
	36573	"^DD",8000 01,800001, .03,21,1,0 )
	36574	This is th e name of the patien t list.
	36575	"^DD",8000 01,800001, .03,"DT")
	36576	3111006
	36577	"^DD",8000 01,800001, 5,0)
	36578	ORDER DIAL OGS^800001 .05P^^ORDE R DIALOGS; 0
	36579	"^DD",8000 01,800001, 5,21,0)
	36580	^.001^1^1^ 3151204^^^ ^
	36581	"^DD",8000 01,800001, 5,21,1,0)
	36582	This sub-f ile contai ns ORDER D IALOG entr ies.
	36583	"^DD",8000 01,800001. 05,0)
	36584	ORDER DIAL OGS SUB-FI ELD^^.01^1
	36585	"^DD",8000 01,800001. 05,0,"IX", "B",800001 .05,.01)
	36586
	36587	"^DD",8000 01,800001. 05,0,"NM", "ORDER DIA LOGS")
	36588
	36589	"^DD",8000 01,800001. 05,0,"UP")
	36590	800001
	36591	"^DD",8000 01,800001. 05,.01,0)
	36592	ORDER DIAL OGS^MP101. 41'^ORD(10 1.41,^0;1^ Q
	36593	"^DD",8000 01,800001. 05,.01,1,0 )
	36594	^.1
	36595	"^DD",8000 01,800001. 05,.01,1,1 ,0)
	36596	800001.05^ B
	36597	"^DD",8000 01,800001. 05,.01,1,1 ,1)
	36598	S ^HMPPANE L(DA(1),"O RDER DIALO GS","B",$E (X,1,30),D A)=""
	36599	"^DD",8000 01,800001. 05,.01,1,1 ,2)
	36600	K ^HMPPANE L(DA(1),"O RDER DIALO GS","B",$E (X,1,30),D A)
	36601	"^DD",8000 01,800001. 05,.01,1,1 ,"%D",0)
	36602	^^1^1^3150 923^
	36603	"^DD",8000 01,800001. 05,.01,1,1 ,"%D",1,0)
	36604	This is th e cross-re ference by the name of the ord er dialog.
	36605	"^DD",8000 01,800001. 05,.01,3)
	36606	Select an entry in t he ORDER D IALOG File .
	36607	"^DD",8000 01,800001. 05,.01,21, 0)
	36608	^.001^2^2^ 3151204^^^ ^
	36609	"^DD",8000 01,800001. 05,.01,21, 1,0)
	36610	This is th e IEN of a n entry in the ORDER DIALOG Fi le.
	36611	"^DD",8000 01,800001. 05,.01,21, 2,0)
	36612	LAYGO is n ot allowed , the ORDE R DIALOG m ust be cre ated first .
	36613	"^DD",8000 01,800001. 05,.01,"DT ")
	36614	3110629
	36615	"^DD",8000 01.2,80000 1.2,0)
	36616	FIELD^^3^1 0
	36617	"^DD",8000 01.2,80000 1.2,0,"DT" )
	36618	3150923
	36619	"^DD",8000 01.2,80000 1.2,0,"IX" ,"AB",8000 01.23,.01)
	36620
	36621	"^DD",8000 01.2,80000 1.2,0,"IX" ,"AC",8000 01.2,.04)
	36622
	36623	"^DD",8000 01.2,80000 1.2,0,"IX" ,"AD",8000 01.21,.02)
	36624
	36625	"^DD",8000 01.2,80000 1.2,0,"IX" ,"ATS",800 001.2,99)
	36626
	36627	"^DD",8000 01.2,80000 1.2,0,"IX" ,"B",80000 1.2,.01)
	36628
	36629	"^DD",8000 01.2,80000 1.2,0,"NM" ,"HMP ROST ER")
	36630
	36631	"^DD",8000 01.2,80000 1.2,0,"PT" ,800000.02 ,.01)
	36632
	36633	"^DD",8000 01.2,80000 1.2,0,"PT" ,800001.21 ,.02)
	36634
	36635	"^DD",8000 01.2,80000 1.2,0,"VRP K")
	36636	HMP
	36637	"^DD",8000 01.2,80000 1.2,.01,0)
	36638	NAME^RF^^0 ;1^K:$L(X) >104!($L(X )<3)!'(X'? 1P.E) X
	36639	"^DD",8000 01.2,80000 1.2,.01,1, 0)
	36640	^.1
	36641	"^DD",8000 01.2,80000 1.2,.01,1, 1,0)
	36642	800001.2^B
	36643	"^DD",8000 01.2,80000 1.2,.01,1, 1,1)
	36644	S ^HMPROST R(800001.2 ,"B",$E(X, 1,30),DA)= ""
	36645	"^DD",8000 01.2,80000 1.2,.01,1, 1,2)
	36646	K ^HMPROST R(800001.2 ,"B",$E(X, 1,30),DA)
	36647	"^DD",8000 01.2,80000 1.2,.01,1, 1,"%D",0)
	36648	^^1^1^3150 923^
	36649	"^DD",8000 01.2,80000 1.2,.01,1, 1,"%D",1,0 )
	36650	This is th e cross-re ference of eHMP rost ers by nam e.
	36651	"^DD",8000 01.2,80000 1.2,.01,3)
	36652	Answer mus t be 3-104 character s in lengt h.
	36653	"^DD",8000 01.2,80000 1.2,.01,21 ,0)
	36654	^^1^1^3150 923^
	36655	"^DD",8000 01.2,80000 1.2,.01,21 ,1,0)
	36656	This is th e name of an eHMP ro ster.
	36657	"^DD",8000 01.2,80000 1.2,.01,"D T")
	36658	3130220
	36659	"^DD",8000 01.2,80000 1.2,.02,0)
	36660	DISPLAY NA ME^F^^0;2^ K:$L(X)>45 !($L(X)<3) X
	36661	"^DD",8000 01.2,80000 1.2,.02,3)
	36662	Answer mus t be 3-45 characters in length .
	36663	"^DD",8000 01.2,80000 1.2,.02,21 ,0)
	36664	^^1^1^3150 923^
	36665	"^DD",8000 01.2,80000 1.2,.02,21 ,1,0)
	36666	This is th e actual n ame of an eHMP roste r.
	36667	"^DD",8000 01.2,80000 1.2,.02,"D T")
	36668	3110830
	36669	"^DD",8000 01.2,80000 1.2,.03,0)
	36670	DISABLE^S^ 1:YES;^0;3 ^Q
	36671	"^DD",8000 01.2,80000 1.2,.03,3)
	36672	Enter '1' or 'Yes' t o disable this roste r.
	36673	"^DD",8000 01.2,80000 1.2,.03,21 ,0)
	36674	^^1^1^3150 923^
	36675	"^DD",8000 01.2,80000 1.2,.03,21 ,1,0)
	36676	This is a setting to disable a n eHMP ros ter.
	36677	"^DD",8000 01.2,80000 1.2,.03,"D T")
	36678	3110830
	36679	"^DD",8000 01.2,80000 1.2,.04,0)
	36680	OWNER^P200 '^VA(200,^ 0;4^Q
	36681	"^DD",8000 01.2,80000 1.2,.04,1, 0)
	36682	^.1
	36683	"^DD",8000 01.2,80000 1.2,.04,1, 1,0)
	36684	800001.2^A C
	36685	"^DD",8000 01.2,80000 1.2,.04,1, 1,1)
	36686	S ^HMPROST R(800001.2 ,"AC",$E(X ,1,30),DA) =""
	36687	"^DD",8000 01.2,80000 1.2,.04,1, 1,2)
	36688	K ^HMPROST R(800001.2 ,"AC",$E(X ,1,30),DA)
	36689	"^DD",8000 01.2,80000 1.2,.04,1, 1,"%D",0)
	36690	^.101^1^1^ 3150923^^
	36691	"^DD",8000 01.2,80000 1.2,.04,1, 1,"%D",1,0 )
	36692	Cross-refe rence of r osters by owner.
	36693	"^DD",8000 01.2,80000 1.2,.04,1, 1,"DT")
	36694	3120105
	36695	"^DD",8000 01.2,80000 1.2,.04,3)
	36696	Enter the owner of t his roster .
	36697	"^DD",8000 01.2,80000 1.2,.04,21 ,0)
	36698	^^1^1^3150 923^
	36699	"^DD",8000 01.2,80000 1.2,.04,21 ,1,0)
	36700	This is th e DUZ of t he HMP ros ter's owne r.
	36701	"^DD",8000 01.2,80000 1.2,.04,"D T")
	36702	3120105
	36703	"^DD",8000 01.2,80000 1.2,.05,0)
	36704	TYPE^RS^PU :PUBLIC;PR :PRIVATE;^ 0;5^Q
	36705	"^DD",8000 01.2,80000 1.2,.05,3)
	36706	Enter inte rnally sto red code f or type of HMP roste r.
	36707	"^DD",8000 01.2,80000 1.2,.05,21 ,0)
	36708	^.001^1^1^ 3151117^^^
	36709	"^DD",8000 01.2,80000 1.2,.05,21 ,1,0)
	36710	The type o f an HMP r oster.
	36711	"^DD",8000 01.2,80000 1.2,.05,"D T")
	36712	3111115
	36713	"^DD",8000 01.2,80000 1.2,.06,0)
	36714	PATIENT LI ST NAME^F^ ^0;6^K:$L( X)>40!($L( X)<3) X
	36715	"^DD",8000 01.2,80000 1.2,.06,3)
	36716	Answer mus t be 3-40 characters in length .
	36717	"^DD",8000 01.2,80000 1.2,.06,21 ,0)
	36718	^^1^1^3150 923^
	36719	"^DD",8000 01.2,80000 1.2,.06,21 ,1,0)
	36720	The file c ontaining the patien t list nam es.
	36721	"^DD",8000 01.2,80000 1.2,.06,"D T")
	36722	3120120
	36723	"^DD",8000 01.2,80000 1.2,1,0)
	36724	SOURCES^80 0001.21^^1 ;0
	36725	"^DD",8000 01.2,80000 1.2,1,21,0 )
	36726	^^1^1^3150 923^
	36727	"^DD",8000 01.2,80000 1.2,1,21,1 ,0)
	36728	The source s of the p atient lis t.
	36729	"^DD",8000 01.2,80000 1.2,2,0)
	36730	SPECIAL HA NDLING^K^^ 3;E1,245^K :$L(X)>245 X D:$D(X) ^DIM
	36731	"^DD",8000 01.2,80000 1.2,2,3)
	36732	XXXX--CAN' T BE ALTER ED EXCEPT BY PROGRAM MER.
	36733	"^DD",8000 01.2,80000 1.2,2,9)
	36734	@
	36735	"^DD",8000 01.2,80000 1.2,2,21,0 )
	36736	^.001^1^1^ 3151116^^^
	36737	"^DD",8000 01.2,80000 1.2,2,21,1 ,0)
	36738	This is MU MPS code f or filteri ng and ref reshing pa tient list s.
	36739	"^DD",8000 01.2,80000 1.2,2,"DT" )
	36740	3120103
	36741	"^DD",8000 01.2,80000 1.2,3,0)
	36742	PATIENT^80 0001.23P^^ 4;0
	36743	"^DD",8000 01.2,80000 1.2,3,21,0 )
	36744	^^1^1^3150 923^
	36745	"^DD",8000 01.2,80000 1.2,3,21,1 ,0)
	36746	Patients w hich are m embers of this roste r.
	36747	"^DD",8000 01.2,80000 1.2,99,0)
	36748	TIMESTAMP^ D^^2;1^S % DT="ESTXR" D ^%DT S X=Y K:Y<1 X
	36749	"^DD",8000 01.2,80000 1.2,99,1,0 )
	36750	^.1
	36751	"^DD",8000 01.2,80000 1.2,99,1,1 ,0)
	36752	800001.2^A TS
	36753	"^DD",8000 01.2,80000 1.2,99,1,1 ,1)
	36754	S ^HMPROST R(800001.2 ,"ATS",$E( X,1,30),DA )=""
	36755	"^DD",8000 01.2,80000 1.2,99,1,1 ,2)
	36756	K ^HMPROST R(800001.2 ,"ATS",$E( X,1,30),DA )
	36757	"^DD",8000 01.2,80000 1.2,99,1,1 ,"%D",0)
	36758	^.101^2^2^ 3150923^^
	36759	"^DD",8000 01.2,80000 1.2,99,1,1 ,"%D",1,0)
	36760	The date.t ime cross- reference of patient s in the H MP
	36761	"^DD",8000 01.2,80000 1.2,99,1,1 ,"%D",2,0)
	36762	Roster fil e.
	36763	"^DD",8000 01.2,80000 1.2,99,1,1 ,"DT")
	36764	3110831
	36765	"^DD",8000 01.2,80000 1.2,99,3)
	36766	Type a dat e not earl ier than A UG 30, 201 1@08:39.
	36767	"^DD",8000 01.2,80000 1.2,99,21, 0)
	36768	^.001^1^1^ 3151116^^
	36769	"^DD",8000 01.2,80000 1.2,99,21, 1,0)
	36770	The date.t ime of a p atient's e ntry in th e HMP Rost er file.
	36771	"^DD",8000 01.2,80000 1.2,99,"DT ")
	36772	3150923
	36773	"^DD",8000 01.2,80000 1.21,0)
	36774	SOURCES SU B-FIELD^^. 05^5
	36775	"^DD",8000 01.2,80000 1.21,0,"DT ")
	36776	3150923
	36777	"^DD",8000 01.2,80000 1.21,0,"IX ","AS",800 001.21,.01 )
	36778
	36779	"^DD",8000 01.2,80000 1.21,0,"IX ","B",8000 01.21,.01)
	36780
	36781	"^DD",8000 01.2,80000 1.21,0,"NM ","SOURCES ")
	36782
	36783	"^DD",8000 01.2,80000 1.21,0,"UP ")
	36784	800001.2
	36785	"^DD",8000 01.2,80000 1.21,.01,0 )
	36786	SEQUENCE^M NJ8,0^^0;1 ^K:+X'=X!( X>99999999 )!(X<1)!(X ?.E1"."1N. N) X
	36787	"^DD",8000 01.2,80000 1.21,.01,1 ,0)
	36788	^.1
	36789	"^DD",8000 01.2,80000 1.21,.01,1 ,1,0)
	36790	800001.21^ B
	36791	"^DD",8000 01.2,80000 1.21,.01,1 ,1,1)
	36792	S ^HMPROST R(800001.2 ,DA(1),1," B",$E(X,1, 30),DA)=""
	36793	"^DD",8000 01.2,80000 1.21,.01,1 ,1,2)
	36794	K ^HMPROST R(800001.2 ,DA(1),1," B",$E(X,1, 30),DA)
	36795	"^DD",8000 01.2,80000 1.21,.01,1 ,1,"%D",0)
	36796	^^1^1^3150 923^
	36797	"^DD",8000 01.2,80000 1.21,.01,1 ,1,"%D",1, 0)
	36798	The name c ross-refer ence of pa tient list s.
	36799	"^DD",8000 01.2,80000 1.21,.01,1 ,2,0)
	36800	800001.21^ AS
	36801	"^DD",8000 01.2,80000 1.21,.01,1 ,2,1)
	36802	S ^HMPROST R(800001.2 ,DA(1),1," AS",$E(X,1 ,30),DA)=" "
	36803	"^DD",8000 01.2,80000 1.21,.01,1 ,2,2)
	36804	K ^HMPROST R(800001.2 ,DA(1),1," AS",$E(X,1 ,30),DA)
	36805	"^DD",8000 01.2,80000 1.21,.01,1 ,2,"%D",0)
	36806	^^1^1^3150 923^
	36807	"^DD",8000 01.2,80000 1.21,.01,1 ,2,"%D",1, 0)
	36808	The sequen ce cross-r eference o f patient lists.
	36809	"^DD",8000 01.2,80000 1.21,.01,1 ,2,"DT")
	36810	3110901
	36811	"^DD",8000 01.2,80000 1.21,.01,3 )
	36812	Type a num ber betwee n 1 and 99 999999, 0 decimal di gits.
	36813	"^DD",8000 01.2,80000 1.21,.01,2 1,0)
	36814	^.001^1^1^ 3150923^^
	36815	"^DD",8000 01.2,80000 1.21,.01,2 1,1,0)
	36816	The sequen ce number of a patie nt list so urce.
	36817	"^DD",8000 01.2,80000 1.21,.01," DT")
	36818	3150923
	36819	"^DD",8000 01.2,80000 1.21,.02,0 )
	36820	SOURCE^RV^ ^0;2^Q
	36821	"^DD",8000 01.2,80000 1.21,.02,1 ,0)
	36822	^.1
	36823	"^DD",8000 01.2,80000 1.21,.02,1 ,1,0)
	36824	800001.2^A D
	36825	"^DD",8000 01.2,80000 1.21,.02,1 ,1,1)
	36826	S ^HMPROST R(800001.2 ,"AD",$E(X ,1,30),DA( 1),DA)=""
	36827	"^DD",8000 01.2,80000 1.21,.02,1 ,1,2)
	36828	K ^HMPROST R(800001.2 ,"AD",$E(X ,1,30),DA( 1),DA)
	36829	"^DD",8000 01.2,80000 1.21,.02,1 ,1,"%D",0)
	36830	^^1^1^3150 923^
	36831	"^DD",8000 01.2,80000 1.21,.02,1 ,1,"%D",1, 0)
	36832	The file n umber cros s-referenc e of patie nt lists.
	36833	"^DD",8000 01.2,80000 1.21,.02,1 ,1,"DT")
	36834	3131126
	36835	"^DD",8000 01.2,80000 1.21,.02,3 )
	36836	Enter the file which will be t he source for this r oster.
	36837	"^DD",8000 01.2,80000 1.21,.02,2 1,0)
	36838	^^1^1^3150 923^
	36839	"^DD",8000 01.2,80000 1.21,.02,2 1,1,0)
	36840	The source of the pa tient list .
	36841	"^DD",8000 01.2,80000 1.21,.02," DT")
	36842	3131126
	36843	"^DD",8000 01.2,80000 1.21,.02," V",0)
	36844	^.12P^12^1 0
	36845	"^DD",8000 01.2,80000 1.21,.02," V",1,0)
	36846	2^PATIENT^ 1^PAT^n^n
	36847	"^DD",8000 01.2,80000 1.21,.02," V",1,1)
	36848
	36849	"^DD",8000 01.2,80000 1.21,.02," V",1,2)
	36850
	36851	"^DD",8000 01.2,80000 1.21,.02," V",2,0)
	36852	42^WARD LO CATION^2^W ARD^n^n
	36853	"^DD",8000 01.2,80000 1.21,.02," V",2,1)
	36854
	36855	"^DD",8000 01.2,80000 1.21,.02," V",2,2)
	36856
	36857	"^DD",8000 01.2,80000 1.21,.02," V",3,0)
	36858	44^CLINIC^ 3^CL^n^n
	36859	"^DD",8000 01.2,80000 1.21,.02," V",3,1)
	36860
	36861	"^DD",8000 01.2,80000 1.21,.02," V",3,2)
	36862
	36863	"^DD",8000 01.2,80000 1.21,.02," V",5,0)
	36864	200^PROVID ER^5^PROV^ n^n
	36865	"^DD",8000 01.2,80000 1.21,.02," V",5,1)
	36866
	36867	"^DD",8000 01.2,80000 1.21,.02," V",5,2)
	36868
	36869	"^DD",8000 01.2,80000 1.21,.02," V",6,0)
	36870	100.21^CPR S^6^CPRS^n ^n
	36871	"^DD",8000 01.2,80000 1.21,.02," V",6,1)
	36872
	36873	"^DD",8000 01.2,80000 1.21,.02," V",6,2)
	36874
	36875	"^DD",8000 01.2,80000 1.21,.02," V",7,0)
	36876	404.51^PCM M TEAM^7^P CMM^n^n
	36877	"^DD",8000 01.2,80000 1.21,.02," V",7,1)
	36878
	36879	"^DD",8000 01.2,80000 1.21,.02," V",7,2)
	36880
	36881	"^DD",8000 01.2,80000 1.21,.02," V",8,0)
	36882	810.4^REMI NDER'S LIS T RULE FIL E^22^PXRM^ y^n
	36883	"^DD",8000 01.2,80000 1.21,.02," V",8,1)
	36884	S DIC("S") ="I $P(^(0 ),U,3)=3"
	36885	"^DD",8000 01.2,80000 1.21,.02," V",8,2)
	36886	Only selec t Rule Set types
	36887	"^DD",8000 01.2,80000 1.21,.02," V",9,0)
	36888	800001.2^H MP ROSTER FILE^9^ROS T^^n
	36889	"^DD",8000 01.2,80000 1.21,.02," V",11,0)
	36890	45.7^SPECI ALTY^70^SP EC^n^n
	36891	"^DD",8000 01.2,80000 1.21,.02," V",12,0)
	36892	800001^Sel ect HMP Pa nel List R ule^80^HMP PAN^n^n
	36893	"^DD",8000 01.2,80000 1.21,.03,0 )
	36894	OPERATION^ S^0:UNION; 1:INTERSEC TION;2:DIF FERENCE;^0 ;3^Q
	36895	"^DD",8000 01.2,80000 1.21,.03,3 )
	36896	This code is used to determine which ope ration is to be perf ormed on t he Patient List.
	36897	"^DD",8000 01.2,80000 1.21,.03,2 1,0)
	36898	^^2^2^3150 923^
	36899	"^DD",8000 01.2,80000 1.21,.03,2 1,1,0)
	36900	This is th e type of operation to be perf ormed on t he
	36901	"^DD",8000 01.2,80000 1.21,.03,2 1,2,0)
	36902	patient li st file.
	36903	"^DD",8000 01.2,80000 1.21,.03," DT")
	36904	3110830
	36905	"^DD",8000 01.2,80000 1.21,.04,0 )
	36906	FILTER^S^T :TODAY;^0; 4^Q
	36907	"^DD",8000 01.2,80000 1.21,.04,3 )
	36908	Enter 'T' to set the filter.
	36909	"^DD",8000 01.2,80000 1.21,.04,2 1,0)
	36910	^^1^1^3150 923^
	36911	"^DD",8000 01.2,80000 1.21,.04,2 1,1,0)
	36912	This is a date filte r for the patient li st file.
	36913	"^DD",8000 01.2,80000 1.21,.04," DT")
	36914	3110901
	36915	"^DD",8000 01.2,80000 1.21,.05,0 )
	36916	REFRESH FR EQUENCY^S^ D:DAILY;H: HOURLY;^0; 5^Q
	36917	"^DD",8000 01.2,80000 1.21,.05,3 )
	36918	This code is used to specify t he refresh rate for the Patien t List.
	36919	"^DD",8000 01.2,80000 1.21,.05,2 1,0)
	36920	^^1^1^3150 923^
	36921	"^DD",8000 01.2,80000 1.21,.05,2 1,1,0)
	36922	The freque ncy by whi ch to refr esh the pa tient list .
	36923	"^DD",8000 01.2,80000 1.21,.05," DT")
	36924	3120119
	36925	"^DD",8000 01.2,80000 1.23,0)
	36926	PATIENT SU B-FIELD^^. 02^2
	36927	"^DD",8000 01.2,80000 1.23,0,"IX ","B",8000 01.23,.01)
	36928
	36929	"^DD",8000 01.2,80000 1.23,0,"NM ","PATIENT ")
	36930
	36931	"^DD",8000 01.2,80000 1.23,0,"UP ")
	36932	800001.2
	36933	"^DD",8000 01.2,80000 1.23,.01,0 )
	36934	PATIENT^MP 2'^DPT(^0; 1^Q
	36935	"^DD",8000 01.2,80000 1.23,.01,1 ,0)
	36936	^.1
	36937	"^DD",8000 01.2,80000 1.23,.01,1 ,1,0)
	36938	800001.23^ B
	36939	"^DD",8000 01.2,80000 1.23,.01,1 ,1,1)
	36940	S ^HMPROST R(800001.2 ,DA(1),4," B",$E(X,1, 30),DA)=""
	36941	"^DD",8000 01.2,80000 1.23,.01,1 ,1,2)
	36942	K ^HMPROST R(800001.2 ,DA(1),4," B",$E(X,1, 30),DA)
	36943	"^DD",8000 01.2,80000 1.23,.01,1 ,1,"%D",0)
	36944	^^1^1^3150 923^
	36945	"^DD",8000 01.2,80000 1.23,.01,1 ,1,"%D",1, 0)
	36946	HMP Roster File cros s-referenc e by patie nt name.
	36947	"^DD",8000 01.2,80000 1.23,.01,1 ,2,0)
	36948	800001.2^A B
	36949	"^DD",8000 01.2,80000 1.23,.01,1 ,2,1)
	36950	S ^HMPROST R(800001.2 ,"AB",$E(X ,1,30),DA( 1),DA)=""
	36951	"^DD",8000 01.2,80000 1.23,.01,1 ,2,2)
	36952	K ^HMPROST R(800001.2 ,"AB",$E(X ,1,30),DA( 1),DA)
	36953	"^DD",8000 01.2,80000 1.23,.01,1 ,2,"%D",0)
	36954	^.101^1^1^ 3150923^^
	36955	"^DD",8000 01.2,80000 1.23,.01,1 ,2,"%D",1, 0)
	36956	Index of a ll rosters patient i s in.
	36957	"^DD",8000 01.2,80000 1.23,.01,1 ,2,"DT")
	36958	3121220
	36959	"^DD",8000 01.2,80000 1.23,.01,3 )
	36960	Select an entry from the PATIE NT File (# 2).
	36961	"^DD",8000 01.2,80000 1.23,.01,2 1,0)
	36962	^^2^2^3150 923^
	36963	"^DD",8000 01.2,80000 1.23,.01,2 1,1,0)
	36964	This field identifie s a roster member pa tient by i ts DFN
	36965	"^DD",8000 01.2,80000 1.23,.01,2 1,2,0)
	36966	in the PAT IENT File (#2).
	36967	"^DD",8000 01.2,80000 1.23,.01," DT")
	36968	3121220
	36969	"^DD",8000 01.2,80000 1.23,.02,0 )
	36970	SRCSEQ^NJ6 ,0^^0;2^K: +X'=X!(X>9 99999)!(X< 1)!(X?.E1" ."1N.N) X
	36971	"^DD",8000 01.2,80000 1.23,.02,3 )
	36972	Type a num ber betwee n 1 and 99 9999, 0 de cimal digi ts.
	36973	"^DD",8000 01.2,80000 1.23,.02,2 1,0)
	36974	^^1^1^3150 923^
	36975	"^DD",8000 01.2,80000 1.23,.02,2 1,1,0)
	36976	The sequen ce number of this pa tient rost er.
	36977	"^DD",8000 01.2,80000 1.23,.02," DT")
	36978	3130717
	36979	"^DD",8000 01.5,80000 1.5,0)
	36980	FIELD^^7^7
	36981	"^DD",8000 01.5,80000 1.5,0,"DDA ")
	36982	N
	36983	"^DD",8000 01.5,80000 1.5,0,"IX" ,"B",80000 1.5,.01)
	36984
	36985	"^DD",8000 01.5,80000 1.5,0,"IX" ,"HMP",800 001.5,6)
	36986
	36987	"^DD",8000 01.5,80000 1.5,0,"NM" ,"HMP ACTI VITY")
	36988
	36989	"^DD",8000 01.5,80000 1.5,0,"VRP K")
	36990	HMP
	36991	"^DD",8000 01.5,80000 1.5,.01,0)
	36992	PATIENT NA ME^RP2'^DP T(^0;1^Q
	36993	"^DD",8000 01.5,80000 1.5,.01,1, 0)
	36994	^.1
	36995	"^DD",8000 01.5,80000 1.5,.01,1, 1,0)
	36996	800001.5^B
	36997	"^DD",8000 01.5,80000 1.5,.01,1, 1,1)
	36998	S ^HMP(800 001.5,"PTA PPT","B",$ E(X,1,30), DA)=""
	36999	"^DD",8000 01.5,80000 1.5,.01,1, 1,2)
	37000	K ^HMP(800 001.5,"PTA PPT","B",$ E(X,1,30), DA)
	37001	"^DD",8000 01.5,80000 1.5,.01,1, 1,"%D",0)
	37002	^^1^1^3150 923^
	37003	"^DD",8000 01.5,80000 1.5,.01,1, 1,"%D",1,0 )
	37004	PATIENT Fi le (#2) DF N cross-re ference of the HMP A ctivity Fi le.
	37005	"^DD",8000 01.5,80000 1.5,.01,3)
	37006	Select a p atient fro m the PATI ENT File ( #2).
	37007	"^DD",8000 01.5,80000 1.5,.01,21 ,0)
	37008	^^2^2^3150 923^
	37009	"^DD",8000 01.5,80000 1.5,.01,21 ,1,0)
	37010	The PATIEN T File (#2 ) DFN of a n eHMP sub scribed pa tient with
	37011	"^DD",8000 01.5,80000 1.5,.01,21 ,2,0)
	37012	appointmen ts.
	37013	"^DD",8000 01.5,80000 1.5,.01,"D T")
	37014	3140731
	37015	"^DD",8000 01.5,80000 1.5,2,0)
	37016	APPOINTMEN T DATE^D^^ 0;2^S %DT= "EST" D ^% DT S X=Y K :Y<1 X
	37017	"^DD",8000 01.5,80000 1.5,2,3)
	37018	Enter the date.time of the app ointment.
	37019	"^DD",8000 01.5,80000 1.5,2,21,0 )
	37020	^.001^1^1^ 3150923^^
	37021	"^DD",8000 01.5,80000 1.5,2,21,1 ,0)
	37022	The date.t ime of a p atient's a ppointment .
	37023	"^DD",8000 01.5,80000 1.5,2,"DT" )
	37024	3140804
	37025	"^DD",8000 01.5,80000 1.5,3,0)
	37026	APPOINTMEN T STATUS^F ^^0;3^K:$L (X)>5!($L( X)<1) X
	37027	"^DD",8000 01.5,80000 1.5,3,3)
	37028	Answer mus t be 1-5 c haracters in length.
	37029	"^DD",8000 01.5,80000 1.5,3,21,0 )
	37030	^^1^1^3150 923^
	37031	"^DD",8000 01.5,80000 1.5,3,21,1 ,0)
	37032	This is th e status o f a patien t's appoin tment.
	37033	"^DD",8000 01.5,80000 1.5,3,"DT" )
	37034	3140804
	37035	"^DD",8000 01.5,80000 1.5,4,0)
	37036	DATE RECOR D CREATED^ D^^0;4^S % DT="EST" D ^%DT S X= Y K:Y<1 X
	37037	"^DD",8000 01.5,80000 1.5,4,3)
	37038	Enter the date.time the activi ty record was create d.
	37039	"^DD",8000 01.5,80000 1.5,4,21,0 )
	37040	^^1^1^3150 923^
	37041	"^DD",8000 01.5,80000 1.5,4,21,1 ,0)
	37042	The date.t ime of cre ation of t he activit y record.
	37043	"^DD",8000 01.5,80000 1.5,4,"DT" )
	37044	3140804
	37045	"^DD",8000 01.5,80000 1.5,5,0)
	37046	DATE RECOR D RETREIVE D^D^^0;5^S %DT="EST" D ^%DT S X=Y K:Y<1 X
	37047	"^DD",8000 01.5,80000 1.5,5,3)
	37048	Do not pro mpt. Field is stuffe d by [TBD] .
	37049	"^DD",8000 01.5,80000 1.5,5,5,1, 0)
	37050	800001.5^6 ^2
	37051	"^DD",8000 01.5,80000 1.5,5,21,0 )
	37052	^^1^1^3150 923^
	37053	"^DD",8000 01.5,80000 1.5,5,21,1 ,0)
	37054	This is th e date.tim e that act ivity data was retri eved from VistA.
	37055	"^DD",8000 01.5,80000 1.5,5,"DT" )
	37056	3140804
	37057	"^DD",8000 01.5,80000 1.5,6,0)
	37058	HMP PROCES S FLAG^NJ1 ,0^^0;6^K: +X'=X!(X>1 )!(X<0)!(X ?.E1"."1N. N) X
	37059	"^DD",8000 01.5,80000 1.5,6,1,0)
	37060	^.1
	37061	"^DD",8000 01.5,80000 1.5,6,1,1, 0)
	37062	800001.5^H MP^MUMPS
	37063	"^DD",8000 01.5,80000 1.5,6,1,1, 1)
	37064	I +X=0 S ^ HMP(800001 .5,"PTAPPT ","HMP",+D A)=""
	37065	"^DD",8000 01.5,80000 1.5,6,1,1, 2)
	37066	K ^HMP(800 001.5,"PTA PPT","HMP" ,+DA)
	37067	"^DD",8000 01.5,80000 1.5,6,1,1, "%D",0)
	37068	^.101^1^1^ 3151029^^
	37069	"^DD",8000 01.5,80000 1.5,6,1,1, "%D",1,0)
	37070	This is a cross-refe rence of p atient act ivities by process f lag.
	37071	"^DD",8000 01.5,80000 1.5,6,1,1, "DT")
	37072	3140901
	37073	"^DD",8000 01.5,80000 1.5,6,1,2, 0)
	37074	^^TRIGGER^ 800001.5^5
	37075	"^DD",8000 01.5,80000 1.5,6,1,2, 1)
	37076	Q
	37077	"^DD",8000 01.5,80000 1.5,6,1,2, 2)
	37078	K DIV S DI V=X,D0=DA, DIV(0)=D0 S Y(1)=$S( $D(^HMP(80 0001.5,"PT APPT",D0,0 )):^(0),1: "") S X=$P (Y(1),U,5) ,X=X S DIU =X K Y S X =DIV N %I, %H,% D NOW ^%DTC S X= % X ^DD(80 0001.5,6,1 ,2,2.4)
	37079	"^DD",8000 01.5,80000 1.5,6,1,2, 2.4)
	37080	S DIH=$G(^ HMP(800001 .5,"PTAPPT ",DIV(0),0 )),DIV=X S $P(^(0),U ,5)=DIV,DI H=800001.5 ,DIG=5 D ^ DICR
	37081	"^DD",8000 01.5,80000 1.5,6,1,2, "%D",0)
	37082	^.101^2^2^ 3151029^^^
	37083	"^DD",8000 01.5,80000 1.5,6,1,2, "%D",1,0)
	37084	This trigg er causes an activit y file ent ry to be s kipped,
	37085	"^DD",8000 01.5,80000 1.5,6,1,2, "%D",2,0)
	37086	deleted, o r processe d.
	37087	"^DD",8000 01.5,80000 1.5,6,1,2, "CREATE VA LUE")
	37088	NO EFFECT
	37089	"^DD",8000 01.5,80000 1.5,6,1,2, "DELETE VA LUE")
	37090	NOW
	37091	"^DD",8000 01.5,80000 1.5,6,1,2, "DT")
	37092	3140804
	37093	"^DD",8000 01.5,80000 1.5,6,1,2, "FIELD")
	37094	DATE RECOR D RETREIVE D
	37095	"^DD",8000 01.5,80000 1.5,6,3)
	37096	Type a num ber betwee n 0 and 1, 0 decimal digits.
	37097	"^DD",8000 01.5,80000 1.5,6,21,0 )
	37098	^.001^2^2^ 3151029^^
	37099	"^DD",8000 01.5,80000 1.5,6,21,1 ,0)
	37100	This is a system HMP Process F lag indica ting an ac tivity
	37101	"^DD",8000 01.5,80000 1.5,6,21,2 ,0)
	37102	was proces sed.
	37103	"^DD",8000 01.5,80000 1.5,6,"DT" )
	37104	3140804
	37105	"^DD",8000 01.5,80000 1.5,7,0)
	37106	JSON MESSA GE^F^^JSON ;1^K:$L(X) >200!($L(X )<1) X
	37107	"^DD",8000 01.5,80000 1.5,7,3)
	37108	Answer mus t be 1-200 character s in lengt h.
	37109	"^DD",8000 01.5,80000 1.5,7,21,0 )
	37110	^^2^2^3150 923^
	37111	"^DD",8000 01.5,80000 1.5,7,21,1 ,0)
	37112	This is a JSON messa ge indicat ing the st atus of th e
	37113	"^DD",8000 01.5,80000 1.5,7,21,2 ,0)
	37114	correspond ing patien t activity record.
	37115	"^DD",8000 01.5,80000 1.5,7,"DT" )
	37116	3140805
	37117	"^DIC",800 000,800000 ,0)
	37118	HMP SUBSCR IPTION^800 000
	37119	"^DIC",800 000,800000 ,0,"GL")
	37120	^HMP(80000 0,
	37121	"^DIC",800 000,800000 ,"%",0)
	37122	^1.005^^0
	37123	"^DIC",800 000,800000 ,"%D",0)
	37124	^^4^4^3151 116^
	37125	"^DIC",800 000,800000 ,"%D",1,0)
	37126	This file contains t he data ne eded for e HMP data r etrieval.
	37127	"^DIC",800 000,800000 ,"%D",2,0)
	37128	The top le vel fields store inf ormation a bout serve rs known t o eHMP.
	37129	"^DIC",800 000,800000 ,"%D",3,0)
	37130	Each patie nt's subsc ription is stored in #800000.0 1 sub-file for
	37131	"^DIC",800 000,800000 ,"%D",4,0)
	37132	a server
	37133	"^DIC",800 000,"B","H MP SUBSCRI PTION",800 000)
	37134
	37135	"^DIC",800 000.1,8000 00.1,0)
	37136	HMP PATIEN T OBJECT^8 00000.1
	37137	"^DIC",800 000.1,8000 00.1,0,"GL ")
	37138	^HMP(80000 0.1,
	37139	"^DIC",800 000.1,8000 00.1,"%",0 )
	37140	^1.005^^0
	37141	"^DIC",800 000.1,8000 00.1,"%D", 0)
	37142	^1.001^2^2 ^3150923^^
	37143	"^DIC",800 000.1,8000 00.1,"%D", 1,0)
	37144	This file is used wh en transfe rring spec ific patie nt objects
	37145	"^DIC",800 000.1,8000 00.1,"%D", 2,0)
	37146	to JDS.
	37147	"^DIC",800 000.1,"B", "HMP PATIE NT OBJECT" ,800000.1)
	37148
	37149	"^DIC",800 000.11,800 000.11,0)
	37150	HMP OBJECT ^800000.11
	37151	"^DIC",800 000.11,800 000.11,0," GL")
	37152	^HMP(80000 0.11,
	37153	"^DIC",800 000.11,800 000.11,"%D ",0)
	37154	^^1^1^3150 923^
	37155	"^DIC",800 000.11,800 000.11,"%D ",1,0)
	37156	This file is a stagi ng area fo r JSON uid objects.
	37157	"^DIC",800 000.11,"B" ,"HMP OBJE CT",800000 .11)
	37158
	37159	"^DIC",800 000.2,8000 00.2,0)
	37160	HMP LIST^8 00000.2
	37161	"^DIC",800 000.2,8000 00.2,0,"GL ")
	37162	^HMPD(8000 00.2,
	37163	"^DIC",800 000.2,8000 00.2,"%D", 0)
	37164	^1.001^2^2 ^3151116^^
	37165	"^DIC",800 000.2,8000 00.2,"%D", 1,0)
	37166	A translat ion table for use by eHMP to c onnect Vis tA
	37167	"^DIC",800 000.2,8000 00.2,"%D", 2,0)
	37168	data domai ns to JSON objects f or transmi ssion.
	37169	"^DIC",800 000.2,"B", "HMP LIST" ,800000.2)
	37170
	37171	"^DIC",800 000.21,800 000.21,0)
	37172	HMP LIST D OMAIN^8000 00.21
	37173	"^DIC",800 000.21,800 000.21,0," GL")
	37174	^HMPD(8000 00.21,
	37175	"^DIC",800 000.21,800 000.21,"%" ,0)
	37176	^1.005^^0
	37177	"^DIC",800 000.21,800 000.21,"%D ",0)
	37178	^^2^2^3150 923^
	37179	"^DIC",800 000.21,800 000.21,"%D ",1,0)
	37180	This File contains t he extract ion domain s which ca n be
	37181	"^DIC",800 000.21,800 000.21,"%D ",2,0)
	37182	transmitte d.
	37183	"^DIC",800 000.21,"B" ,"HMP LIST DOMAIN",8 00000.21)
	37184
	37185	"^DIC",800 000.22,800 000.22,0)
	37186	HMP LIST A TTRIBUTE^8 00000.22
	37187	"^DIC",800 000.22,800 000.22,0," GL")
	37188	^HMPD(8000 00.22,
	37189	"^DIC",800 000.22,800 000.22,"%D ",0)
	37190	^^2^2^3150 923^
	37191	"^DIC",800 000.22,800 000.22,"%D ",1,0)
	37192	This file contains a list of t he attribu tes of the eHMP
	37193	"^DIC",800 000.22,800 000.22,"%D ",2,0)
	37194	data domai ns.
	37195	"^DIC",800 000.22,"B" ,"HMP LIST ATTRIBUTE ",800000.2 2)
	37196
	37197	"^DIC",800 001,800001 ,0)
	37198	HMP PANEL^ 800001
	37199	"^DIC",800 001,800001 ,0,"GL")
	37200	^HMPPANEL(
	37201	"^DIC",800 001,800001 ,"%D",0)
	37202	^1.001^4^4 ^3110701^^ ^
	37203	"^DIC",800 001,800001 ,"%D",1,0)
	37204	Contains t he Rule Se ts that co ntain the cohorts fo r creating patient p anels.
	37205	"^DIC",800 001,800001 ,"%D",2,0)
	37206	For exampl e, panel w hich inclu des Diabet ic patient s will be created
	37207	"^DIC",800 001,800001 ,"%D",3,0)
	37208	nightly to update th e list of patients. All panel s in this file will be
	37209	"^DIC",800 001,800001 ,"%D",4,0)
	37210	updated ni ghtly.
	37211	"^DIC",800 001,"B","H MP PANEL", 800001)
	37212
	37213	"^DIC",800 001.2,8000 01.2,0)
	37214	HMP ROSTER ^800001.2
	37215	"^DIC",800 001.2,8000 01.2,0,"GL ")
	37216	^HMPROSTR( 800001.2,
	37217	"^DIC",800 001.2,8000 01.2,"%D", 0)
	37218	^^2^2^3150 923^
	37219	"^DIC",800 001.2,8000 01.2,"%D", 1,0)
	37220	This file contains e HMP roster s which ca n be used by
	37221	"^DIC",800 001.2,8000 01.2,"%D", 2,0)
	37222	subscribed patients.
	37223	"^DIC",800 001.2,"B", "HMP ROSTE R",800001. 2)
	37224
	37225	"^DIC",800 001.5,8000 01.5,0)
	37226	HMP ACTIVI TY^800001. 5
	37227	"^DIC",800 001.5,8000 01.5,0,"GL ")
	37228	^HMP(80000 1.5,"PTAPP T",
	37229	"^DIC",800 001.5,8000 01.5,"%D", 0)
	37230	^1.001^2^2 ^3151029^^ ^
	37231	"^DIC",800 001.5,8000 01.5,"%D", 1,0)
	37232	The HMP Ac tivity Fil e contains appointme nts for pa tients
	37233	"^DIC",800 001.5,8000 01.5,"%D", 2,0)
	37234	which are subscribed to eHMP.
	37235	"^DIC",800 001.5,"B", "HMP ACTIV ITY",80000 1.5)
	37236
	37237	END
	37238	END