42. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 5/13/2019 2:40:17 PM 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.

42.1 Files compared

#	Location	File	Last Modified
1	C:\AraxisMergeCompare\Pri_un\MPDU\Patches	PSO_7_529.KID	Mon May 6 12:14:13 2019 UTC
2	C:\AraxisMergeCompare\Pri_re\MPDU\MPDU\Patches	PSO_7_529.KID	Tue May 7 13:22:40 2019 UTC

42.2 Comparison summary

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

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

42.4 Active regular expressions

No regular expressions were active.

42.5 Comparison detail

	1	KIDS Distr ibution sa ved on Feb 28, 2019@ 15:02:28
	2	PSO7529
	3	KIDS:P SO7.0529 ^
	4
	5	INSTALL NAME
	6	PSO7.052 9
	7	"BLD",1038 2,0)
	8	PSO7.052 9^OUTPATIE NT PHARMAC Y^0^319022 8^y
	9	"BLD",1038 2,1,0)
	10	^^55^55^31 90211^
	11	"BLD",1038 2,1,1,0)
	12	The Clinic al Ancilla ry Service s (CAS) - Medication Permissio n/Dispensi ng
	13	"BLD",1038 2,1,2,0)
	14	Updates (M PDU) proje ct provide s the abil ity to sup port multi ple Drug
	15	"BLD",1038 2,1,3,0)
	16	Enforcemen t Administ ration (DE A) Numbers for a use r.
	17	"BLD",1038 2,1,4,0)
	18
	19	"BLD",1038 2,1,5,0)
	20	This patch PSO7529 is part o f a group of patches for this enhancemen t
	21	"BLD",1038 2,1,6,0)
	22	and must b e installe d after XU 8688. Th e followin g other pa tches will be
	23	"BLD",1038 2,1,7,0)
	24	released i n the futu re and inc ludes: OR* 3506, XU 8689, PSO 7*545,
	25	"BLD",1038 2,1,8,0)
	26	PSJ5372, OR3488 and OR34 99.
	27	"BLD",1038 2,1,9,0)
	28
	29	"BLD",1038 2,1,10,0)
	30	******** ****** ** ATT ENTION * ******** ****** *******
	31	"BLD",1038 2,1,11,0)
	32	This enhan cement als o includes a new Gra phical Use r Interfac e (GUI)
	33	"BLD",1038 2,1,12,0)
	34	executable , ePCSData EntryforPr escriber.e xe (ePCS G UI), which allows se tup
	35	"BLD",1038 2,1,13,0)
	36	of users t o write co ntrolled s ubstances. For retri eval and i nstallatio n
	37	"BLD",1038 2,1,14,0)
	38	instructio ns, please see the D ocumentati on Retriev al Instruc tions sect ion.
	39	"BLD",1038 2,1,15,0)
	40
	41	"BLD",1038 2,1,16,0)
	42	This patch PSO7529 has the f ollowing e nhancement s:
	43	"BLD",1038 2,1,17,0)
	44
	45	"BLD",1038 2,1,18,0)
	46	1. Create a web serv ice client to be use d during i nstallatio n to retri eve
	47	"BLD",1038 2,1,19,0)
	48	the pro vider info rmation fr om the VA Maintained DOJ/DEA w eb server.
	49	"BLD",1038 2,1,20,0)
	50	This in formation will be st ored in th e DEA NUMB ERS FILE ( #8991.9), and
	51	"BLD",1038 2,1,21,0)
	52	linked to the NEW PERSON FI LE (#200), NEW DEA # 'S (#53.21 ) multiple .
	53	"BLD",1038 2,1,22,0)
	54
	55	"BLD",1038 2,1,23,0)
	56	2. An envi ronment ch eck routin e PSO7E529 is includ ed in this patch tha t
	57	"BLD",1038 2,1,24,0)
	58	will se tup the DO J/DEA web server and the web s ervice. It will chec k
	59	"BLD",1038 2,1,25,0)
	60	the ava ilability of the DOJ /DEA web s ervice and will cont inue the p atch
	61	"BLD",1038 2,1,26,0)
	62	install ation. If the web se rvice is a vailable, it will di splay a
	63	"BLD",1038 2,1,27,0)
	64	message , "The Env ironmental Check Rou tine finis hed Succes sfully" an d
	65	"BLD",1038 2,1,28,0)
	66	will co ntinue wit h the patc h installa tion. If t he web ser vice is no t
	67	"BLD",1038 2,1,29,0)
	68	availab le then it will abor t the inst allation w ith the fo llowing
	69	"BLD",1038 2,1,30,0)
	70	message :
	71	"BLD",1038 2,1,31,0)
	72
	73	"BLD",1038 2,1,32,0)
	74	***** ****** ****** ****** ****** ******
	75	"BLD",1038 2,1,33,0)
	76	W ARNING: T he WEB SER VER/SERVIC E SETUP FA ILED
	77	"BLD",1038 2,1,34,0)
	78	Ple ase see th e Pre-inst allation I nstruction s in the
	79	"BLD",1038 2,1,35,0)
	80	p atch descr iption for initializ ation inst ructions
	81	"BLD",1038 2,1,36,0)
	82	>>>> Installat ion aborte d <<<<"
	83	"BLD",1038 2,1,37,0)
	84	***** ****** ****** ****** ****** ******
	85	"BLD",1038 2,1,38,0)
	86
	87	"BLD",1038 2,1,39,0)
	88	3. A post- install ro utine PSO7 P529 inclu ded in thi s patch wi ll migrate
	89	"BLD",1038 2,1,40,0)
	90	all DEA 's from th e NEW PERS ON FILE (# 200) and w ill utiliz e the
	91	"BLD",1038 2,1,41,0)
	92	DOJ/DEA web servi ce to crea te entries in the DE A NUMBERS FILE
	93	"BLD",1038 2,1,42,0)
	94	(#8991. 9). Provid ers that c annot be l inked will be record ed in a
	95	"BLD",1038 2,1,43,0)
	96	Migrati on Excepti on Log and will be s ent in an email with the subje ct;
	97	"BLD",1038 2,1,44,0)
	98	DEA Mig ration Exc eption Rep ort 11/28/ 2018 (run date) to P SDMGR key
	99	"BLD",1038 2,1,45,0)
	100	holders . These en tries can be reviewe d and corr ected usin g the ePCS GUI
	101	"BLD",1038 2,1,46,0)
	102	executa ble that w ill be sen t separate ly as part of this p roject.
	103	"BLD",1038 2,1,47,0)
	104
	105	"BLD",1038 2,1,48,0)
	106	These m igrated pr ovider ent ries in th e DEA NUMB ERS FILE ( #8991.9) w ill
	107	"BLD",1038 2,1,49,0)
	108	be mark ed as USE FOR INPATI ENT ORDERS . The Deto x # will b e derived
	109	"BLD",1038 2,1,50,0)
	110	from th e business activity code/sub c ode.
	111	"BLD",1038 2,1,51,0)
	112
	113	"BLD",1038 2,1,52,0)
	114	4. Create Remote Pro cedure Cal ls to supp ort the en try and ma intenance of
	115	"BLD",1038 2,1,53,0)
	116	the inf ormation s tored in t he DEA NUM BERS FILE (#8991.9) using the ePCS
	117	"BLD",1038 2,1,54,0)
	118	GUI. Th is functio nality wil l utilize the DOJ/DE A web serv ice to get
	119	"BLD",1038 2,1,55,0)
	120	near re al-time up dates.
	121	"BLD",1038 2,4,0)
	122	^9.64PA^^
	123	"BLD",1038 2,6)
	124	7^
	125	"BLD",1038 2,6.3)
	126	19
	127	"BLD",1038 2,"ABPKG")
	128	n
	129	"BLD",1038 2,"INID")
	130	^
	131	"BLD",1038 2,"INIT")
	132	INITLOAD^P SO7P529
	133	"BLD",1038 2,"KRN",0)
	134	^9.67PA^77 9.2^20
	135	"BLD",1038 2,"KRN",.4 ,0)
	136	.4
	137	"BLD",1038 2,"KRN",.4 01,0)
	138	.401
	139	"BLD",1038 2,"KRN",.4 02,0)
	140	.402
	141	"BLD",1038 2,"KRN",.4 03,0)
	142	.403
	143	"BLD",1038 2,"KRN",.5 ,0)
	144	.5
	145	"BLD",1038 2,"KRN",.8 4,0)
	146	.84
	147	"BLD",1038 2,"KRN",3. 6,0)
	148	3.6
	149	"BLD",1038 2,"KRN",3. 8,0)
	150	3.8
	151	"BLD",1038 2,"KRN",9. 2,0)
	152	9.2
	153	"BLD",1038 2,"KRN",9. 8,0)
	154	9.8
	155	"BLD",1038 2,"KRN",9. 8,"NM",0)
	156	^9.68A^3^3
	157	"BLD",1038 2,"KRN",9. 8,"NM",1,0 )
	158	PSO7E529^^ 0^B2506749 4
	159	"BLD",1038 2,"KRN",9. 8,"NM",2,0 )
	160	PSODEAUT^^ 0^B2242208 58
	161	"BLD",1038 2,"KRN",9. 8,"NM",3,0 )
	162	PSO7P529^^ 0^B6338592 2
	163	"BLD",1038 2,"KRN",9. 8,"NM","B" ,"PSO7E529 ",1)
	164
	165	"BLD",1038 2,"KRN",9. 8,"NM","B" ,"PSO7P529 ",3)
	166
	167	"BLD",1038 2,"KRN",9. 8,"NM","B" ,"PSODEAUT ",2)
	168
	169	"BLD",1038 2,"KRN",19 ,0)
	170	19
	171	"BLD",1038 2,"KRN",19 ,"NM",0)
	172	^9.68A^1^1
	173	"BLD",1038 2,"KRN",19 ,"NM",1,0)
	174	PSO DEA ED IT DATA^^0
	175	"BLD",1038 2,"KRN",19 ,"NM","B", "PSO DEA E DIT DATA", 1)
	176
	177	"BLD",1038 2,"KRN",19 .1,0)
	178	19.1
	179	"BLD",1038 2,"KRN",10 1,0)
	180	101
	181	"BLD",1038 2,"KRN",40 9.61,0)
	182	409.61
	183	"BLD",1038 2,"KRN",77 1,0)
	184	771
	185	"BLD",1038 2,"KRN",77 9.2,0)
	186	779.2
	187	"BLD",1038 2,"KRN",87 0,0)
	188	870
	189	"BLD",1038 2,"KRN",89 89.51,0)
	190	8989.51
	191	"BLD",1038 2,"KRN",89 89.52,0)
	192	8989.52
	193	"BLD",1038 2,"KRN",89 94,0)
	194	8994
	195	"BLD",1038 2,"KRN",89 94,"NM",0)
	196	^9.68A^7^7
	197	"BLD",1038 2,"KRN",89 94,"NM",1, 0)
	198	PSO DEA AD D DEA^^0
	199	"BLD",1038 2,"KRN",89 94,"NM",2, 0)
	200	PSO DEA DE ADOJ^^0
	201	"BLD",1038 2,"KRN",89 94,"NM",3, 0)
	202	PSO DEA MB M^^0
	203	"BLD",1038 2,"KRN",89 94,"NM",4, 0)
	204	PSO DEA RE MOVE DEA^^ 0
	205	"BLD",1038 2,"KRN",89 94,"NM",5, 0)
	206	PSO DEA DU P CHECK^^0
	207	"BLD",1038 2,"KRN",89 94,"NM",6, 0)
	208	PSO DEA DE ALIST^^0
	209	"BLD",1038 2,"KRN",89 94,"NM",7, 0)
	210	PSO DEA ED IT^^0
	211	"BLD",1038 2,"KRN",89 94,"NM","B ","PSO DEA ADD DEA", 1)
	212
	213	"BLD",1038 2,"KRN",89 94,"NM","B ","PSO DEA DEADOJ",2 )
	214
	215	"BLD",1038 2,"KRN",89 94,"NM","B ","PSO DEA DEALIST", 6)
	216
	217	"BLD",1038 2,"KRN",89 94,"NM","B ","PSO DEA DUP CHECK ",5)
	218
	219	"BLD",1038 2,"KRN",89 94,"NM","B ","PSO DEA EDIT",7)
	220
	221	"BLD",1038 2,"KRN",89 94,"NM","B ","PSO DEA MBM",3)
	222
	223	"BLD",1038 2,"KRN",89 94,"NM","B ","PSO DEA REMOVE DE A",4)
	224
	225	"BLD",1038 2,"KRN","B ",.4,.4)
	226
	227	"BLD",1038 2,"KRN","B ",.401,.40 1)
	228
	229	"BLD",1038 2,"KRN","B ",.402,.40 2)
	230
	231	"BLD",1038 2,"KRN","B ",.403,.40 3)
	232
	233	"BLD",1038 2,"KRN","B ",.5,.5)
	234
	235	"BLD",1038 2,"KRN","B ",.84,.84)
	236
	237	"BLD",1038 2,"KRN","B ",3.6,3.6)
	238
	239	"BLD",1038 2,"KRN","B ",3.8,3.8)
	240
	241	"BLD",1038 2,"KRN","B ",9.2,9.2)
	242
	243	"BLD",1038 2,"KRN","B ",9.8,9.8)
	244
	245	"BLD",1038 2,"KRN","B ",19,19)
	246
	247	"BLD",1038 2,"KRN","B ",19.1,19. 1)
	248
	249	"BLD",1038 2,"KRN","B ",101,101)
	250
	251	"BLD",1038 2,"KRN","B ",409.61,4 09.61)
	252
	253	"BLD",1038 2,"KRN","B ",771,771)
	254
	255	"BLD",1038 2,"KRN","B ",779.2,77 9.2)
	256
	257	"BLD",1038 2,"KRN","B ",870,870)
	258
	259	"BLD",1038 2,"KRN","B ",8989.51, 8989.51)
	260
	261	"BLD",1038 2,"KRN","B ",8989.52, 8989.52)
	262
	263	"BLD",1038 2,"KRN","B ",8994,899 4)
	264
	265	"BLD",1038 2,"PRE")
	266	PSO7E529
	267	"BLD",1038 2,"QDEF")
	268	^^^^NO^^^^ NO^^NO
	269	"BLD",1038 2,"QUES",0 )
	270	^9.62^^
	271	"BLD",1038 2,"REQB",0 )
	272	^9.611^1^1
	273	"BLD",1038 2,"REQB",1 ,0)
	274	XU8.0688 ^2
	275	"BLD",1038 2,"REQB"," B","XU8.0 688",1)
	276
	277	"INIT")
	278	INITLOAD^P SO7P529
	279	"KRN",19,2 921843,-1)
	280	0^1
	281	"KRN",19,2 921843,0)
	282	PSO DEA ED IT DATA^eP CS Edit Pr escriber D ata^^B^^XU EPCSEDIT^^ ^^^^OUTPAT IENT PHARM ACY
	283	"KRN",19,2 921843,1,0 )
	284	^^3^3^3181 121^
	285	"KRN",19,2 921843,1,1 ,0)
	286	This conte xt option is given t o those in dividuals who are pe rmitted to
	287	"KRN",19,2 921843,1,2 ,0)
	288	edit the d ata relate d to e-pre scribing o f controll ed substan ces. They
	289	"KRN",19,2 921843,1,3 ,0)
	290	must hold the XUEPCS EDIT secur ity key.
	291	"KRN",19,2 921843,"RP C",0)
	292	^19.05P^15 ^15
	293	"KRN",19,2 921843,"RP C",1,0)
	294	XWB GET VA RIABLE VAL UE
	295	"KRN",19,2 921843,"RP C",2,0)
	296	XUS KEY CH ECK
	297	"KRN",19,2 921843,"RP C",3,0)
	298	DDR GETS E NTRY DATA
	299	"KRN",19,2 921843,"RP C",4,0)
	300	DDR LISTER
	301	"KRN",19,2 921843,"RP C",5,0)
	302	DDR FILER
	303	"KRN",19,2 921843,"RP C",6,0)
	304	DDR VALIDA TOR
	305	"KRN",19,2 921843,"RP C",7,0)
	306	DDR DELETE ENTRY
	307	"KRN",19,2 921843,"RP C",8,0)
	308	DDR LOCK/U NLOCK NODE
	309	"KRN",19,2 921843,"RP C",9,0)
	310	DDR FIND1
	311	"KRN",19,2 921843,"RP C",10,0)
	312	DDR GET DD HELP
	313	"KRN",19,2 921843,"RP C",11,0)
	314	DDR FINDER
	315	"KRN",19,2 921843,"RP C",12,0)
	316	DDR KEY VA LIDATOR
	317	"KRN",19,2 921843,"RP C",13,0)
	318	XUS PKI GE T UPN
	319	"KRN",19,2 921843,"RP C",14,0)
	320	XUS PKI SE T UPN
	321	"KRN",19,2 921843,"RP C",15,0)
	322	PSO DEA ED IT
	323	"KRN",19,2 921843,"U" )
	324	EPCS EDIT PRESCRIBER DATA
	325	"KRN",8994 ,4061,-1)
	326	0^1
	327	"KRN",8994 ,4061,0)
	328	PSO DEA AD D DEA^FILE FM^PSODEAU T^1^R
	329	"KRN",8994 ,4061,1,0)
	330	^^3^3^3181 116^
	331	"KRN",8994 ,4061,1,1, 0)
	332	INPUT: DA TA - DEA D ATA LINE " ^" DELIMIT ED.
	333	"KRN",8994 ,4061,1,2, 0)
	334	NP IEN - IEN OF PROVIDE R TO BE LI NKED TO TH IS DEA NUM BER
	335	"KRN",8994 ,4061,1,3, 0)
	336	OUTPUT: RE T - DEA IE N for SUCC ESS, 0 for UNSUCCESS FUL
	337	"KRN",8994 ,4061,2,0)
	338	^8994.02A^ 2^2
	339	"KRN",8994 ,4061,2,1, 0)
	340	DATA^1^^1^ 1
	341	"KRN",8994 ,4061,2,1, 1,0)
	342	^^22^22^31 81116^
	343	"KRN",8994 ,4061,2,1, 1,1,0)
	344	A STRING O F DEA INFO RMATION DE LIMITED BY THE "^"
	345	"KRN",8994 ,4061,2,1, 1,2,0)
	346	1 - PROV IDER NAME
	347	"KRN",8994 ,4061,2,1, 1,3,0)
	348	2 - ADDR ESS 1
	349	"KRN",8994 ,4061,2,1, 1,4,0)
	350	3 - ADDR ESS 2
	351	"KRN",8994 ,4061,2,1, 1,5,0)
	352	4 - ADDR ESS 3
	353	"KRN",8994 ,4061,2,1, 1,6,0)
	354	5 - CITY
	355	"KRN",8994 ,4061,2,1, 1,7,0)
	356	6 - STAT E
	357	"KRN",8994 ,4061,2,1, 1,8,0)
	358	7 - STAT E POINTER
	359	"KRN",8994 ,4061,2,1, 1,9,0)
	360	8 - ZIP CODE
	361	"KRN",8994 ,4061,2,1, 1,10,0)
	362	9 - ACTI VITY CODE
	363	"KRN",8994 ,4061,2,1, 1,11,0)
	364	10 - TYPE
	365	"KRN",8994 ,4061,2,1, 1,12,0)
	366	11 - DEA NUMBER
	367	"KRN",8994 ,4061,2,1, 1,13,0)
	368	12 - EXPI RATION DAT E
	369	"KRN",8994 ,4061,2,1, 1,14,0)
	370	13 - PROC ESSED DATE
	371	"KRN",8994 ,4061,2,1, 1,15,0)
	372	14 - DETO X NUMBER
	373	"KRN",8994 ,4061,2,1, 1,16,0)
	374	15 - SCHD EULE II NA RCOTIC
	375	"KRN",8994 ,4061,2,1, 1,17,0)
	376	16 - SCHE DULE II NO N-NARCOTIC
	377	"KRN",8994 ,4061,2,1, 1,18,0)
	378	17 - SCHE DULE III N ARCOTIC
	379	"KRN",8994 ,4061,2,1, 1,19,0)
	380	18 - SCHE DULE III N ON-NARCOTI C
	381	"KRN",8994 ,4061,2,1, 1,20,0)
	382	19 - SCHE DULE IV
	383	"KRN",8994 ,4061,2,1, 1,21,0)
	384	20 - SCHE DULE V
	385	"KRN",8994 ,4061,2,1, 1,22,0)
	386	21 - USE FOR INPATI ENT FLAG
	387	"KRN",8994 ,4061,2,2, 0)
	388	NPIEN^1^^1 ^2
	389	"KRN",8994 ,4061,2,2, 1,0)
	390	^^2^2^3181 116^
	391	"KRN",8994 ,4061,2,2, 1,1,0)
	392	Enter the internal e ntry numbe r (IEN) of the provi der that t his DEA
	393	"KRN",8994 ,4061,2,2, 1,2,0)
	394	Number is being link ed to.
	395	"KRN",8994 ,4061,2,"B ","DATA",1 )
	396
	397	"KRN",8994 ,4061,2,"B ","NPIEN", 2)
	398
	399	"KRN",8994 ,4061,2,"P ARAMSEQ",1 ,1)
	400
	401	"KRN",8994 ,4061,2,"P ARAMSEQ",2 ,2)
	402
	403	"KRN",8994 ,4062,-1)
	404	0^2
	405	"KRN",8994 ,4062,0)
	406	PSO DEA DE ADOJ^DEADO J^PSODEAUT ^2^R
	407	"KRN",8994 ,4062,1,0)
	408	^^25^25^31 81116^
	409	"KRN",8994 ,4062,1,1, 0)
	410	This RPC c all, accep ts a DEA N umber as i nput. It c alls the D OJ/DEA Web
	411	"KRN",8994 ,4062,1,2, 0)
	412	Service to get the m ost recent informati on for the provider which is
	413	"KRN",8994 ,4062,1,3, 0)
	414	returned t o the call ing progra m in a sin gle string with "^" delimited
	415	"KRN",8994 ,4062,1,4, 0)
	416	data. The values in the string are:
	417	"KRN",8994 ,4062,1,5, 0)
	418
	419	"KRN",8994 ,4062,1,6, 0)
	420	1 - PROV IDER NAME
	421	"KRN",8994 ,4062,1,7, 0)
	422	2 - ADDR ESS 1
	423	"KRN",8994 ,4062,1,8, 0)
	424	3 - ADDR ESS 2
	425	"KRN",8994 ,4062,1,9, 0)
	426	4 - ADDR ESS 3
	427	"KRN",8994 ,4062,1,10 ,0)
	428	5 - CITY
	429	"KRN",8994 ,4062,1,11 ,0)
	430	6 - STAT E
	431	"KRN",8994 ,4062,1,12 ,0)
	432	7 - STAT E POINTER
	433	"KRN",8994 ,4062,1,13 ,0)
	434	8 - ZIP CODE
	435	"KRN",8994 ,4062,1,14 ,0)
	436	9 - ACTI VITY CODE
	437	"KRN",8994 ,4062,1,15 ,0)
	438	10 - TYPE
	439	"KRN",8994 ,4062,1,16 ,0)
	440	11 - DEA NUMBER
	441	"KRN",8994 ,4062,1,17 ,0)
	442	12 - EXPI RATION DAT E
	443	"KRN",8994 ,4062,1,18 ,0)
	444	13 - PROC ESSED DATE
	445	"KRN",8994 ,4062,1,19 ,0)
	446	14 - DETO X NUMBER
	447	"KRN",8994 ,4062,1,20 ,0)
	448	15 - SCHD EULE II NA RCOTIC
	449	"KRN",8994 ,4062,1,21 ,0)
	450	16 - SCHE DULE II NO N-NARCOTIC
	451	"KRN",8994 ,4062,1,22 ,0)
	452	17 - SCHE DULE III N ARCOTIC
	453	"KRN",8994 ,4062,1,23 ,0)
	454	18 - SCHE DULE III N ON-NARCOTI C
	455	"KRN",8994 ,4062,1,24 ,0)
	456	19 - SCHE DULE IV
	457	"KRN",8994 ,4062,1,25 ,0)
	458	20 - SCHE DULE V
	459	"KRN",8994 ,4062,2,0)
	460	^8994.02A^ 1^1
	461	"KRN",8994 ,4062,2,1, 0)
	462	Provider D EA#^1^^1^1
	463	"KRN",8994 ,4062,2,1, 1,0)
	464	^^1^1^3181 116^
	465	"KRN",8994 ,4062,2,1, 1,1,0)
	466	DEA NUMBER FOR LOOKU P THROUGH THE DOJ/DE A WEB SERV ICE.
	467	"KRN",8994 ,4062,2,"B ","Provide r DEA#",1)
	468
	469	"KRN",8994 ,4062,2,"P ARAMSEQ",1 ,1)
	470
	471	"KRN",8994 ,4062,3,0)
	472	^^2^2^3181 116^
	473	"KRN",8994 ,4062,3,1, 0)
	474	An string of data co ntaining p rovider in formation from the D OJ/DEA web
	475	"KRN",8994 ,4062,3,2, 0)
	476	service.
	477	"KRN",8994 ,4063,-1)
	478	0^3
	479	"KRN",8994 ,4063,0)
	480	PSO DEA MB M^MBM^PSOD EAUT^1^R
	481	"KRN",8994 ,4063,1,0)
	482	^^2^2^3181 116^
	483	"KRN",8994 ,4063,1,1, 0)
	484	This RPC i s provided to ePCS G UI to chec k if the s ite is set up for Med s
	485	"KRN",8994 ,4063,1,2, 0)
	486	by Mail se rvice.
	487	"KRN",8994 ,4063,2,0)
	488	^8994.02A^ 1^1
	489	"KRN",8994 ,4063,2,1, 0)
	490	DATA^2^^1^ 2
	491	"KRN",8994 ,4063,2,"B ","DATA",1 )
	492
	493	"KRN",8994 ,4063,2,"P ARAMSEQ",2 ,1)
	494
	495	"KRN",8994 ,4064,-1)
	496	0^4
	497	"KRN",8994 ,4064,0)
	498	PSO DEA RE MOVE DEA^D EAREM^PSOD EAUT^1^R
	499	"KRN",8994 ,4064,1,0)
	500	^8994.01^4 ^4^3181203 ^^
	501	"KRN",8994 ,4064,1,1, 0)
	502	Functional ity to rem ove a DEA multiple f rom file # 200, Field 53.21
	503	"KRN",8994 ,4064,1,2, 0)
	504	INPUT: NPIEN - NE W PERSON F ILE #200 I NTERNAL EN TRY NUMBER
	505	"KRN",8994 ,4064,1,3, 0)
	506	DEATXT - P ROPERLY FO RMATTED DE A NUMBER
	507	"KRN",8994 ,4064,1,4, 0)
	508	OUTPUT: RET - 1 fo r SUCCESS, 0 for UNS UCCESSFUL
	509	"KRN",8994 ,4064,2,0)
	510	^8994.02A^ 2^2
	511	"KRN",8994 ,4064,2,1, 0)
	512	NPIEN^1^^1 ^1
	513	"KRN",8994 ,4064,2,2, 0)
	514	DEATXT^1^^ 1^2
	515	"KRN",8994 ,4064,2,"B ","DEATXT" ,2)
	516
	517	"KRN",8994 ,4064,2,"B ","NPIEN", 1)
	518
	519	"KRN",8994 ,4064,2,"P ARAMSEQ",1 ,1)
	520
	521	"KRN",8994 ,4064,2,"P ARAMSEQ",2 ,2)
	522
	523	"KRN",8994 ,4064,3,0)
	524	^8994.03^1 ^1^3181203 ^^
	525	"KRN",8994 ,4064,3,1, 0)
	526	OUTPUT: RE T - 1 for SUCCESS, 0 for UNSUC CESSFUL
	527	"KRN",8994 ,4065,-1)
	528	0^5
	529	"KRN",8994 ,4065,0)
	530	PSO DEA DU P CHECK^DU PCHK^PSODE AUT^1^R
	531	"KRN",8994 ,4065,1,0)
	532	^^3^3^3181 116^
	533	"KRN",8994 ,4065,1,1, 0)
	534	This RPC w ill accept a DEA in text forma t, and an institutio nal suffix if
	535	"KRN",8994 ,4065,1,2, 0)
	536	available. It will perform ch ecking to determine if the DEA is being
	537	"KRN",8994 ,4065,1,3, 0)
	538	used by an other user .
	539	"KRN",8994 ,4065,2,0)
	540	^8994.02A^ 2^2
	541	"KRN",8994 ,4065,2,1, 0)
	542	DEATXT^1^^ 1^1
	543	"KRN",8994 ,4065,2,1, 1,0)
	544	^^1^1^3181 116^
	545	"KRN",8994 ,4065,2,1, 1,1,0)
	546	This is th e provider s DEA numb er in text format.
	547	"KRN",8994 ,4065,2,2, 0)
	548	SUFFIX^1^^ 1^2
	549	"KRN",8994 ,4065,2,2, 1,0)
	550	^^1^1^3181 116^
	551	"KRN",8994 ,4065,2,2, 1,1,0)
	552	This is th e institut ional suff ix if avai lable.
	553	"KRN",8994 ,4065,2,"B ","DEATXT" ,1)
	554
	555	"KRN",8994 ,4065,2,"B ","SUFFIX" ,2)
	556
	557	"KRN",8994 ,4065,2,"P ARAMSEQ",1 ,1)
	558
	559	"KRN",8994 ,4065,2,"P ARAMSEQ",2 ,2)
	560
	561	"KRN",8994 ,4065,3,0)
	562	^^4^4^3181 116^
	563	"KRN",8994 ,4065,3,1, 0)
	564	The return value wil l be:
	565	"KRN",8994 ,4065,3,2, 0)
	566	1^Succes s - for a DEA number that does not have any duplic ates.
	567	"KRN",8994 ,4065,3,3, 0)
	568	0^Duplic ate inform ation if t he DEA num ber is bei ng used by another
	569	"KRN",8994 ,4065,3,4, 0)
	570	provider.
	571	"KRN",8994 ,4066,-1)
	572	0^6
	573	"KRN",8994 ,4066,0)
	574	PSO DEA DE ALIST^DEAL IST^PSODEA UT^2^R
	575	"KRN",8994 ,4066,1,0)
	576	^^21^21^31 81116^
	577	"KRN",8994 ,4066,1,1, 0)
	578	This remot e procedur e call wil l provide a list of active DEA #s for a
	579	"KRN",8994 ,4066,1,2, 0)
	580	given prov ider.
	581	"KRN",8994 ,4066,1,3, 0)
	582
	583	"KRN",8994 ,4066,1,4, 0)
	584	INPUT: NP IEN - NEW PERSON FIL E #200 INT ERNAL ENTR Y NUMBER
	585	"KRN",8994 ,4066,1,5, 0)
	586
	587	"KRN",8994 ,4066,1,6, 0)
	588	OUTPUT: RE T - A STRI NG OF DEA INFORMATIO N DELIMITE D BY THE " ^"
	589	"KRN",8994 ,4066,1,7, 0)
	590	1 - DEA NU MBER
	591	"KRN",8994 ,4066,1,8, 0)
	592	2 - INDIVI DUAL DEA S UFFIX
	593	"KRN",8994 ,4066,1,9, 0)
	594	3 - STATE
	595	"KRN",8994 ,4066,1,10 ,0)
	596	4 - DETOX NUMBER
	597	"KRN",8994 ,4066,1,11 ,0)
	598	5 - EXPIRA TION DATE: FROM THE DEA NUMBER S FILE (#8 991.9),
	599	"KRN",8994 ,4066,1,12 ,0)
	600	FIELD EXPIRATION DATE (#.0 4)
	601	"KRN",8994 ,4066,1,13 ,0)
	602	6 - NPIENS
	603	"KRN",8994 ,4066,1,14 ,0)
	604	7 - DNIENS
	605	"KRN",8994 ,4066,1,15 ,0)
	606	8 - SCHEDU LE II NARC OTIC
	607	"KRN",8994 ,4066,1,16 ,0)
	608	9 - SCHEDU LE II NON- NARCOTIC
	609	"KRN",8994 ,4066,1,17 ,0)
	610	1 0 - SCHEDU LE III NAR COTIC
	611	"KRN",8994 ,4066,1,18 ,0)
	612	1 1 - SCHEDU LE III NON -NARCOTIC
	613	"KRN",8994 ,4066,1,19 ,0)
	614	1 2 - SCHEDU LE IV
	615	"KRN",8994 ,4066,1,20 ,0)
	616	1 3 - SCHEDU LE V
	617	"KRN",8994 ,4066,1,21 ,0)
	618	1 4 - USE FO R INPATIEN T ORDERS?
	619	"KRN",8994 ,4066,2,0)
	620	^8994.02A^ 1^1
	621	"KRN",8994 ,4066,2,1, 0)
	622	NPIEN^1^^1 ^1
	623	"KRN",8994 ,4066,2,1, 1,0)
	624	^^1^1^3181 116^
	625	"KRN",8994 ,4066,2,1, 1,1,0)
	626	This is th e provider s IEN in t he NEW PER SON FILE # 200.
	627	"KRN",8994 ,4066,2,"B ","NPIEN", 1)
	628
	629	"KRN",8994 ,4066,2,"P ARAMSEQ",1 ,1)
	630
	631	"KRN",8994 ,4067,-1)
	632	0^7
	633	"KRN",8994 ,4067,0)
	634	PSO DEA ED IT^ENTRY^P SODEAUT^1^ R
	635	"KRN",8994 ,4067,1,0)
	636	^8994.01^2 ^2^3181121 ^^
	637	"KRN",8994 ,4067,1,1, 0)
	638	This remot e procedur e stores i nformation on editin g changes in file 20 0
	639	"KRN",8994 ,4067,1,2, 0)
	640	related to the elect ronic pres cribing of controlle d substanc es.
	641	"KRN",8994 ,4067,2,0)
	642	^8994.02A^ 1^1
	643	"KRN",8994 ,4067,2,1, 0)
	644	DATA^2^^1^ 1
	645	"KRN",8994 ,4067,2,"B ","DATA",1 )
	646
	647	"KRN",8994 ,4067,2,"P ARAMSEQ",1 ,1)
	648
	649	"MBREQ")
	650	0
	651	"ORD",16,8 994)
	652	8994;16;1; ;;;;;;RPCD EL^XPDIA1
	653	"ORD",16,8 994,0)
	654	REMOTE PRO CEDURE
	655	"ORD",18,1 9)
	656	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	657	"ORD",18,1 9,0)
	658	OPTION
	659	"PKG",170, -1)
	660	1^1
	661	"PKG",170, 0)
	662	OUTPATIENT PHARMACY^ PSO^OUTPAT IENT LABEL S, PROFILE , INVENTOR Y, PRESCRI PTIONS
	663	"PKG",170, 20,0)
	664	^9.402P^^
	665	"PKG",170, 22,0)
	666	^9.49I^1^1
	667	"PKG",170, 22,1,0)
	668	7.0^297121 6^2981113^ 1
	669	"PKG",170, 22,1,"PAH" ,1,0)
	670	529^319022 8^52082468 3
	671	"PKG",170, 22,1,"PAH" ,1,1,0)
	672	^^55^55^31 90228
	673	"PKG",170, 22,1,"PAH" ,1,1,1,0)
	674	The Clinic al Ancilla ry Service s (CAS) - Medication Permissio n/Dispensi ng
	675	"PKG",170, 22,1,"PAH" ,1,1,2,0)
	676	Updates (M PDU) proje ct provide s the abil ity to sup port multi ple Drug
	677	"PKG",170, 22,1,"PAH" ,1,1,3,0)
	678	Enforcemen t Administ ration (DE A) Numbers for a use r.
	679	"PKG",170, 22,1,"PAH" ,1,1,4,0)
	680
	681	"PKG",170, 22,1,"PAH" ,1,1,5,0)
	682	This patch PSO7529 is part o f a group of patches for this enhancemen t
	683	"PKG",170, 22,1,"PAH" ,1,1,6,0)
	684	and must b e installe d after XU 8688. Th e followin g other pa tches will be
	685	"PKG",170, 22,1,"PAH" ,1,1,7,0)
	686	released i n the futu re and inc ludes: OR* 3506, XU 8689, PSO 7*545,
	687	"PKG",170, 22,1,"PAH" ,1,1,8,0)
	688	PSJ5372, OR3488 and OR34 99.
	689	"PKG",170, 22,1,"PAH" ,1,1,9,0)
	690
	691	"PKG",170, 22,1,"PAH" ,1,1,10,0)
	692	******** ****** ** ATT ENTION * ******** ****** *******
	693	"PKG",170, 22,1,"PAH" ,1,1,11,0)
	694	This enhan cement als o includes a new Gra phical Use r Interfac e (GUI)
	695	"PKG",170, 22,1,"PAH" ,1,1,12,0)
	696	executable , ePCSData EntryforPr escriber.e xe (ePCS G UI), which allows se tup
	697	"PKG",170, 22,1,"PAH" ,1,1,13,0)
	698	of users t o write co ntrolled s ubstances. For retri eval and i nstallatio n
	699	"PKG",170, 22,1,"PAH" ,1,1,14,0)
	700	instructio ns, please see the D ocumentati on Retriev al Instruc tions sect ion.
	701	"PKG",170, 22,1,"PAH" ,1,1,15,0)
	702
	703	"PKG",170, 22,1,"PAH" ,1,1,16,0)
	704	This patch PSO7529 has the f ollowing e nhancement s:
	705	"PKG",170, 22,1,"PAH" ,1,1,17,0)
	706
	707	"PKG",170, 22,1,"PAH" ,1,1,18,0)
	708	1. Create a web serv ice client to be use d during i nstallatio n to retri eve
	709	"PKG",170, 22,1,"PAH" ,1,1,19,0)
	710	the pro vider info rmation fr om the VA Maintained DOJ/DEA w eb server.
	711	"PKG",170, 22,1,"PAH" ,1,1,20,0)
	712	This in formation will be st ored in th e DEA NUMB ERS FILE ( #8991.9), and
	713	"PKG",170, 22,1,"PAH" ,1,1,21,0)
	714	linked to the NEW PERSON FI LE (#200), NEW DEA # 'S (#53.21 ) multiple .
	715	"PKG",170, 22,1,"PAH" ,1,1,22,0)
	716
	717	"PKG",170, 22,1,"PAH" ,1,1,23,0)
	718	2. An envi ronment ch eck routin e PSO7E529 is includ ed in this patch tha t
	719	"PKG",170, 22,1,"PAH" ,1,1,24,0)
	720	will se tup the DO J/DEA web server and the web s ervice. It will chec k
	721	"PKG",170, 22,1,"PAH" ,1,1,25,0)
	722	the ava ilability of the DOJ /DEA web s ervice and will cont inue the p atch
	723	"PKG",170, 22,1,"PAH" ,1,1,26,0)
	724	install ation. If the web se rvice is a vailable, it will di splay a
	725	"PKG",170, 22,1,"PAH" ,1,1,27,0)
	726	message , "The Env ironmental Check Rou tine finis hed Succes sfully" an d
	727	"PKG",170, 22,1,"PAH" ,1,1,28,0)
	728	will co ntinue wit h the patc h installa tion. If t he web ser vice is no t
	729	"PKG",170, 22,1,"PAH" ,1,1,29,0)
	730	availab le then it will abor t the inst allation w ith the fo llowing
	731	"PKG",170, 22,1,"PAH" ,1,1,30,0)
	732	message :
	733	"PKG",170, 22,1,"PAH" ,1,1,31,0)
	734
	735	"PKG",170, 22,1,"PAH" ,1,1,32,0)
	736	***** ****** ****** ****** ****** ******
	737	"PKG",170, 22,1,"PAH" ,1,1,33,0)
	738	W ARNING: T he WEB SER VER/SERVIC E SETUP FA ILED
	739	"PKG",170, 22,1,"PAH" ,1,1,34,0)
	740	Ple ase see th e Pre-inst allation I nstruction s in the
	741	"PKG",170, 22,1,"PAH" ,1,1,35,0)
	742	p atch descr iption for initializ ation inst ructions
	743	"PKG",170, 22,1,"PAH" ,1,1,36,0)
	744	>>>> Installat ion aborte d <<<<"
	745	"PKG",170, 22,1,"PAH" ,1,1,37,0)
	746	***** ****** ****** ****** ****** ******
	747	"PKG",170, 22,1,"PAH" ,1,1,38,0)
	748
	749	"PKG",170, 22,1,"PAH" ,1,1,39,0)
	750	3. A post- install ro utine PSO7 P529 inclu ded in thi s patch wi ll migrate
	751	"PKG",170, 22,1,"PAH" ,1,1,40,0)
	752	all DEA 's from th e NEW PERS ON FILE (# 200) and w ill utiliz e the
	753	"PKG",170, 22,1,"PAH" ,1,1,41,0)
	754	DOJ/DEA web servi ce to crea te entries in the DE A NUMBERS FILE
	755	"PKG",170, 22,1,"PAH" ,1,1,42,0)
	756	(#8991. 9). Provid ers that c annot be l inked will be record ed in a
	757	"PKG",170, 22,1,"PAH" ,1,1,43,0)
	758	Migrati on Excepti on Log and will be s ent in an email with the subje ct;
	759	"PKG",170, 22,1,"PAH" ,1,1,44,0)
	760	DEA Mig ration Exc eption Rep ort 11/28/ 2018 (run date) to P SDMGR key
	761	"PKG",170, 22,1,"PAH" ,1,1,45,0)
	762	holders . These en tries can be reviewe d and corr ected usin g the ePCS GUI
	763	"PKG",170, 22,1,"PAH" ,1,1,46,0)
	764	executa ble that w ill be sen t separate ly as part of this p roject.
	765	"PKG",170, 22,1,"PAH" ,1,1,47,0)
	766
	767	"PKG",170, 22,1,"PAH" ,1,1,48,0)
	768	These m igrated pr ovider ent ries in th e DEA NUMB ERS FILE ( #8991.9) w ill
	769	"PKG",170, 22,1,"PAH" ,1,1,49,0)
	770	be mark ed as USE FOR INPATI ENT ORDERS . The Deto x # will b e derived
	771	"PKG",170, 22,1,"PAH" ,1,1,50,0)
	772	from th e business activity code/sub c ode.
	773	"PKG",170, 22,1,"PAH" ,1,1,51,0)
	774
	775	"PKG",170, 22,1,"PAH" ,1,1,52,0)
	776	4. Create Remote Pro cedure Cal ls to supp ort the en try and ma intenance of
	777	"PKG",170, 22,1,"PAH" ,1,1,53,0)
	778	the inf ormation s tored in t he DEA NUM BERS FILE (#8991.9) using the ePCS
	779	"PKG",170, 22,1,"PAH" ,1,1,54,0)
	780	GUI. Th is functio nality wil l utilize the DOJ/DE A web serv ice to get
	781	"PKG",170, 22,1,"PAH" ,1,1,55,0)
	782	near re al-time up dates.
	783	"PRE")
	784	PSO7E529
	785	"QUES","XP F1",0)
	786	Y
	787	"QUES","XP F1","??")
	788	^D REP^XPD H
	789	"QUES","XP F1","A")
	790	Shall I wr ite over y our \|FLAG\| File
	791	"QUES","XP F1","B")
	792	YES
	793	"QUES","XP F1","M")
	794	D XPF1^XPD IQ
	795	"QUES","XP F2",0)
	796	Y
	797	"QUES","XP F2","??")
	798	^D DTA^XPD H
	799	"QUES","XP F2","A")
	800	Want my da ta \|FLAG\| yours
	801	"QUES","XP F2","B")
	802	YES
	803	"QUES","XP F2","M")
	804	D XPF2^XPD IQ
	805	"QUES","XP I1",0)
	806	YO
	807	"QUES","XP I1","??")
	808	^D INHIBIT ^XPDH
	809	"QUES","XP I1","A")
	810	Want KIDS to INHIBIT LOGONs du ring the i nstall
	811	"QUES","XP I1","B")
	812	NO
	813	"QUES","XP I1","M")
	814	D XPI1^XPD IQ
	815	"QUES","XP M1",0)
	816	PO^VA(200, :EM
	817	"QUES","XP M1","??")
	818	^D MG^XPDH
	819	"QUES","XP M1","A")
	820	Enter the Coordinato r for Mail Group '\|F LAG\|'
	821	"QUES","XP M1","B")
	822
	823	"QUES","XP M1","M")
	824	D XPM1^XPD IQ
	825	"QUES","XP O1",0)
	826	Y
	827	"QUES","XP O1","??")
	828	^D MENU^XP DH
	829	"QUES","XP O1","A")
	830	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	831	"QUES","XP O1","B")
	832	NO
	833	"QUES","XP O1","M")
	834	D XPO1^XPD IQ
	835	"QUES","XP Z1",0)
	836	Y
	837	"QUES","XP Z1","??")
	838	^D OPT^XPD H
	839	"QUES","XP Z1","A")
	840	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	841	"QUES","XP Z1","B")
	842	NO
	843	"QUES","XP Z1","M")
	844	D XPZ1^XPD IQ
	845	"QUES","XP Z2",0)
	846	Y
	847	"QUES","XP Z2","??")
	848	^D RTN^XPD H
	849	"QUES","XP Z2","A")
	850	Want to MO VE routine s to other CPUs
	851	"QUES","XP Z2","B")
	852	NO
	853	"QUES","XP Z2","M")
	854	D XPZ2^XPD IQ
	855	"RTN")
	856	3
	857	"RTN","PSO 7E529")
	858	0^1^B25067 494
	859	"RTN","PSO 7E529",1,0 )
	860	PSO7E529 ; ALB/BI - E NVIRONMENT AL CHECK F OR PSO7.0 529 ;05/1 5/2018
	861	"RTN","PSO 7E529",2,0 )
	862	;;7.0;OUT PATIENT PH ARMACY;5 29;DEC 1 997;Build 19
	863	"RTN","PSO 7E529",3,0 )
	864	;External reference to ^XOB(1 8.12 suppo rted by DB IA 5813
	865	"RTN","PSO 7E529",4,0 )
	866	;External reference to ^XOB(1 8.02 suppo rted by DB IA 5814
	867	"RTN","PSO 7E529",5,0 )
	868	;
	869	"RTN","PSO 7E529",6,0 )
	870	; 1st: Ma kes an ent ry/update to the WEB SERVICE F ILE #18.02 in global ^XOB(18.0 2,
	871	"RTN","PSO 7E529",7,0 )
	872	; 2nd: Ma kes an ent ry/update to the WEB SERVICE F ILE #18.02 in global ^XOB(18.0 2,
	873	"RTN","PSO 7E529",8,0 )
	874	; 3nd: Ma kes an ent ry/update to the WEB SERVER FI LE #18.12 in global ^XOB(18.12 ,
	875	"RTN","PSO 7E529",9,0 )
	876	; 4th: Pe rforms a w eb service call to v alidate th e server c onnection.
	877	"RTN","PSO 7E529",10, 0)
	878	;
	879	"RTN","PSO 7E529",11, 0)
	880	N FDA ; -- File Man Data A rray
	881	"RTN","PSO 7E529",12, 0)
	882	N WEBVICE ; -- Web Service In ternal Ent ry Number
	883	"RTN","PSO 7E529",13, 0)
	884	N WEBVER ; -- Web Server Int ernal Entr y Number
	885	"RTN","PSO 7E529",14, 0)
	886	N MULTIEN ; -- Web Service Mu ltiple Int ernal Entr y Number
	887	"RTN","PSO 7E529",15, 0)
	888	N WSTAT ; -- Web Service St atus
	889	"RTN","PSO 7E529",16, 0)
	890	N IENROOT ,MSGROOT,I ENROOT1,VI CEIEN
	891	"RTN","PSO 7E529",17, 0)
	892	;
	893	"RTN","PSO 7E529",18, 0)
	894	K FDA
	895	"RTN","PSO 7E529",19, 0)
	896	S WEBVICE =$O(^XOB(1 8.02,"B"," PSO DOJ/DE A WEB SERV ICE",0))
	897	"RTN","PSO 7E529",20, 0)
	898	S WEBVICE =$S(WEBVIC E:WEBVICE, 1:"+1")
	899	"RTN","PSO 7E529",21, 0)
	900	S FDA(18. 02,WEBVICE _",",.01)= "PSO DOJ/D EA WEB SER VICE" ; NAME
	901	"RTN","PSO 7E529",22, 0)
	902	S FDA(18. 02,WEBVICE _",",.02)= "REST" ; TYPE
	903	"RTN","PSO 7E529",23, 0)
	904	S FDA(18. 02,WEBVICE _",",200)= "/sqa/dea- web-servic e/deaInfo/ " ; CONTE XT ROOT
	905	"RTN","PSO 7E529",24, 0)
	906	D UPDATE^ DIE("E","F DA","IENRO OT","MSGRO OT")
	907	"RTN","PSO 7E529",25, 0)
	908	K IENROOT ,MSGROOT,F DA
	909	"RTN","PSO 7E529",26, 0)
	910	;
	911	"RTN","PSO 7E529",27, 0)
	912	K FDA
	913	"RTN","PSO 7E529",28, 0)
	914	S WEBVICE =$O(^XOB(1 8.02,"B"," PSO DOJ/DE A WEB SERV ICE TEST", 0))
	915	"RTN","PSO 7E529",29, 0)
	916	S WEBVICE =$S(WEBVIC E:WEBVICE, 1:"+1")
	917	"RTN","PSO 7E529",30, 0)
	918	S FDA(18. 02,WEBVICE _",",.01)= "PSO DOJ/D EA WEB SER VICE TEST" ; NAME
	919	"RTN","PSO 7E529",31, 0)
	920	S FDA(18. 02,WEBVICE _",",.02)= "REST" ; TYPE
	921	"RTN","PSO 7E529",32, 0)
	922	S FDA(18. 02,WEBVICE _",",200)= "/sqa/dea- web-servic e/deaInfo/ AA1234563" ; CONTE XT ROOT
	923	"RTN","PSO 7E529",33, 0)
	924	D UPDATE^ DIE("E","F DA","IENRO OT","MSGRO OT")
	925	"RTN","PSO 7E529",34, 0)
	926	K IENROOT ,MSGROOT,F DA
	927	"RTN","PSO 7E529",35, 0)
	928	;
	929	"RTN","PSO 7E529",36, 0)
	930	S WEBVER= $O(^XOB(18 .12,"B","P SO DOJ/DEA WEB SERVE R",0))
	931	"RTN","PSO 7E529",37, 0)
	932	S WEBVER= $S(WEBVER: WEBVER,1:" +1")
	933	"RTN","PSO 7E529",38, 0)
	934	S FDA(18. 12,WEBVER_ ",",.01)=" PSO DOJ/DE A WEB SERV ER" ; NAME
	935	"RTN","PSO 7E529",39, 0)
	936	S FDA(18. 12,WEBVER_ ",",.03)=" " ; PORT
	937	"RTN","PSO 7E529",40, 0)
	938	S FDA(18. 12,WEBVER_ ",",.04)=" dea-sqa. DOMAIN . EXT " ; SERVER
	939	"RTN","PSO 7E529",41, 0)
	940	S FDA(18. 12,WEBVER_ ",",.06)=" ENABLED" ; STATU S 1-ENABLE D / 0-DISA BLED
	941	"RTN","PSO 7E529",42, 0)
	942	S FDA(18. 12,WEBVER_ ",",.07)=6 0 ; DEFAU LT HTTP TI MEOUT
	943	"RTN","PSO 7E529",43, 0)
	944	S FDA(18. 12,WEBVER_ ",",1.01)= "NO" ; LOGIN REQUIRED
	945	"RTN","PSO 7E529",44, 0)
	946	S FDA(18. 12,WEBVER_ ",",3.01)= "TRUE" ; SSL E NABLED
	947	"RTN","PSO 7E529",45, 0)
	948	S FDA(18. 12,WEBVER_ ",",3.02)= "encrypt_o nly_tlsv1" ; SSL C ONFIGURATI ON
	949	"RTN","PSO 7E529",46, 0)
	950	S FDA(18. 12,WEBVER_ ",",3.03)= 443 ; SSL P ORT
	951	"RTN","PSO 7E529",47, 0)
	952	D UPDATE^ DIE("E","F DA","IENRO OT","MSGRO OT")
	953	"RTN","PSO 7E529",48, 0)
	954	;
	955	"RTN","PSO 7E529",49, 0)
	956	S IENROOT 1=$G(IENRO OT(1)),MUL TIEN=0
	957	"RTN","PSO 7E529",50, 0)
	958	;
	959	"RTN","PSO 7E529",51, 0)
	960	S WEBVER= $S(IENROOT 1:IENROOT1 ,1:WEBVER)
	961	"RTN","PSO 7E529",52, 0)
	962	K IENROOT ,MSGROOT,F DA
	963	"RTN","PSO 7E529",53, 0)
	964	S VICEIEN =0 F S VI CEIEN=$O(^ XOB(18.12, WEBVER,100 ,"B",VICEI EN)) Q:'VI CEIEN I $ $GET1^DIQ( 18.02,VICE IEN,.01)=" PSO DOJ/DE A WEB SERV ICE" S MUL TIEN=VICEI EN Q
	965	"RTN","PSO 7E529",54, 0)
	966	S MULTIEN =$S(MULTIE N:MULTIEN, 1:"+1")
	967	"RTN","PSO 7E529",55, 0)
	968	S FDA(18. 121,MULTIE N_","_WEBV ER_",",.01 )="PSO DOJ /DEA WEB S ERVICE" ; WEB S ERVICE
	969	"RTN","PSO 7E529",56, 0)
	970	S FDA(18. 121,MULTIE N_","_WEBV ER_",",.06 )="ENABLED " ; STATU S 1-ENABLE D / 0-DISA BLED
	971	"RTN","PSO 7E529",57, 0)
	972	D UPDATE^ DIE("E","F DA","IENRO OT","MSGRO OT")
	973	"RTN","PSO 7E529",58, 0)
	974	;
	975	"RTN","PSO 7E529",59, 0)
	976	S WEBVER= $S(IENROOT 1:IENROOT1 ,1:WEBVER)
	977	"RTN","PSO 7E529",60, 0)
	978	K IENROOT ,MSGROOT,F DA
	979	"RTN","PSO 7E529",61, 0)
	980	S VICEIEN =0 F S VI CEIEN=$O(^ XOB(18.12, WEBVER,100 ,"B",VICEI EN)) Q:'VI CEIEN I $ $GET1^DIQ( 18.02,VICE IEN,.01)=" PSO DOJ/DE A WEB SERV ICE TEST" S MULTIEN= VICEIEN Q
	981	"RTN","PSO 7E529",62, 0)
	982	S MULTIEN =$S(MULTIE N:MULTIEN, 1:"+1")
	983	"RTN","PSO 7E529",63, 0)
	984	S FDA(18. 121,MULTIE N_","_WEBV ER_",",.01 )="PSO DOJ /DEA WEB S ERVICE TES T" ; WEB S ERVICE
	985	"RTN","PSO 7E529",64, 0)
	986	S FDA(18. 121,MULTIE N_","_WEBV ER_",",.06 )="ENABLED " ; STATU S 1-ENABLE D / 0-DISA BLED
	987	"RTN","PSO 7E529",65, 0)
	988	D UPDATE^ DIE("E","F DA","IENRO OT","MSGRO OT")
	989	"RTN","PSO 7E529",66, 0)
	990	;
	991	"RTN","PSO 7E529",67, 0)
	992	S WSTAT=$ $GET
	993	"RTN","PSO 7E529",68, 0)
	994	I 'WSTAT D Q
	995	"RTN","PSO 7E529",69, 0)
	996	. D BMES^ XPDUTL(" ***** ****** ****** ****** ****** ******")
	997	"RTN","PSO 7E529",70, 0)
	998	. D BMES^ XPDUTL(" WA RNING: Th e WEB SERV ER/SERVICE SETUP FAI LED")
	999	"RTN","PSO 7E529",71, 0)
	1000	. D BMES^ XPDUTL(" Pleas e see the Pre-instal lation Ins tructions in the")
	1001	"RTN","PSO 7E529",72, 0)
	1002	. D BMES^ XPDUTL(" pat ch descrip tion for i nitializat ion instru ctions.")
	1003	"RTN","PSO 7E529",73, 0)
	1004	. D BMES^ XPDUTL(" >>>> Installati on aborted <<<<")
	1005	"RTN","PSO 7E529",74, 0)
	1006	. D BMES^ XPDUTL(" ***** ****** ****** ****** ****** ******")
	1007	"RTN","PSO 7E529",75, 0)
	1008	. S XPDQU IT=1 ; Do not insta ll this tr ansport gl obal and K ILL it fro m ^XTMP.
	1009	"RTN","PSO 7E529",76, 0)
	1010	;
	1011	"RTN","PSO 7E529",77, 0)
	1012	I WSTAT D Q
	1013	"RTN","PSO 7E529",78, 0)
	1014	. D BMES^ XPDUTL(" ***** ****** ****** ****** ****** ******")
	1015	"RTN","PSO 7E529",79, 0)
	1016	. D BMES^ XPDUTL(" The En vironmenta l Check Ro utine fini shed Succe ssfully.")
	1017	"RTN","PSO 7E529",80, 0)
	1018	. D BMES^ XPDUTL(" ***** ****** ****** ****** ****** ******")
	1019	"RTN","PSO 7E529",81, 0)
	1020	;
	1021	"RTN","PSO 7E529",82, 0)
	1022	Q
	1023	"RTN","PSO 7E529",83, 0)
	1024	;
	1025	"RTN","PSO 7E529",84, 0)
	1026	GET() ; - - Send a t est to the Web Servi ce and com pare the R esult
	1027	"RTN","PSO 7E529",85, 0)
	1028	N SERVER, SERVICE,RE SOURCE,REQ UEST,SC,RE SPONSE,RES PJSON,DATA ,PSOERR
	1029	"RTN","PSO 7E529",86, 0)
	1030	S SERVER= "PSO DOJ/D EA WEB SER VER"
	1031	"RTN","PSO 7E529",87, 0)
	1032	S SERVICE ="PSO DOJ/ DEA WEB SE RVICE"
	1033	"RTN","PSO 7E529",88, 0)
	1034	S RESOURC E="AA12345 63"
	1035	"RTN","PSO 7E529",89, 0)
	1036	;
	1037	"RTN","PSO 7E529",90, 0)
	1038	; Get an instance o f the REST request o bject.
	1039	"RTN","PSO 7E529",91, 0)
	1040	S REQUEST =$$GETREST ^XOBWLIB(S ERVICE,SER VER)
	1041	"RTN","PSO 7E529",92, 0)
	1042	;
	1043	"RTN","PSO 7E529",93, 0)
	1044	; Execute the HTTP Get method .
	1045	"RTN","PSO 7E529",94, 0)
	1046	S SC=$$GE T^XOBWLIB( REQUEST,RE SOURCE,.PS OERR,0)
	1047	"RTN","PSO 7E529",95, 0)
	1048	I 'SC Q " 0^General Service Er ror"
	1049	"RTN","PSO 7E529",96, 0)
	1050	;
	1051	"RTN","PSO 7E529",97, 0)
	1052	; Process the respo nse.
	1053	"RTN","PSO 7E529",98, 0)
	1054	S RESPONS E=REQUEST. HttpRespon se
	1055	"RTN","PSO 7E529",99, 0)
	1056	S DATA=RE SPONSE.Dat a
	1057	"RTN","PSO 7E529",100 ,0)
	1058	S RESPJSO N=""
	1059	"RTN","PSO 7E529",101 ,0)
	1060	F Q:DATA .AtEnd Se t RESPJSON =RESPJSON_ DATA.ReadL ine()
	1061	"RTN","PSO 7E529",102 ,0)
	1062	S RESPJSO N=$TR(RESP JSON,$C(10 ),"")
	1063	"RTN","PSO 7E529",103 ,0)
	1064	I $E(RESP JSON,1,24) ="{""busin essActivit yCode"":" Q 1
	1065	"RTN","PSO 7E529",104 ,0)
	1066	Q 0
	1067	"RTN","PSO 7P529")
	1068	0^3^B63385 922
	1069	"RTN","PSO 7P529",1,0 )
	1070	PSO7P529 ; ALB/BI - D EA INITIAL IMPORT ;0 5/15/2018
	1071	"RTN","PSO 7P529",2,0 )
	1072	;;7.0;OUT PATIENT PH ARMACY;5 29;DEC 1 997;Build 19
	1073	"RTN","PSO 7P529",3,0 )
	1074	;External reference to sub-fi le NEW DEA #S (#200. 5321) is s upported b y DBIA 700 0
	1075	"RTN","PSO 7P529",4,0 )
	1076	;External reference to DEA NU MBERS file (#8991.9) is suppor ted by DBI A 7002
	1077	"RTN","PSO 7P529",5,0 )
	1078	Q
	1079	"RTN","PSO 7P529",6,0 )
	1080	;
	1081	"RTN","PSO 7P529",7,0 )
	1082	INITLOAD(L IFE) ; -- main entry point for DEA INITI AL IMPORT
	1083	"RTN","PSO 7P529",8,0 )
	1084	N DEA,FG, NPIEN,NPDA TA,NPNAME, DEAIEN,PHA NDLE
	1085	"RTN","PSO 7P529",9,0 )
	1086	S:'$D(LIF E) LIFE=90
	1087	"RTN","PSO 7P529",10, 0)
	1088	S PHANDLE =$$INITXTM P("PSODEAW B","DEA IN ITIAL IMPO RT",LIFE)
	1089	"RTN","PSO 7P529",11, 0)
	1090	S ^TMP($J ,"PSODEAWB ")=1
	1091	"RTN","PSO 7P529",12, 0)
	1092	S DEA=""
	1093	"RTN","PSO 7P529",13, 0)
	1094	F S DEA= $O(^VA(200 ,"PS1",DEA )) Q:DEA=" " D
	1095	"RTN","PSO 7P529",14, 0)
	1096	. S NPIEN =$O(^VA(20 0,"PS1",DE A,0))
	1097	"RTN","PSO 7P529",15, 0)
	1098	. S NPNAM E=$$GET1^D IQ(200,NPI EN,.01)
	1099	"RTN","PSO 7P529",16, 0)
	1100	. D BMES^ XPDUTL(DEA _" "_N PNAME)
	1101	"RTN","PSO 7P529",17, 0)
	1102	. S SC=$$ GET(.FG,DE A)
	1103	"RTN","PSO 7P529",18, 0)
	1104	. I 'SC D LOG(.FG,N PIEN,PHAND LE,"WEB SE RVICE ISSU E") Q
	1105	"RTN","PSO 7P529",19, 0)
	1106	. I FG("d eaNumber") ="DEA NOT FOUND" D L OG(.FG,NPI EN,PHANDLE ,"DEA# NOT FOUND IN DOJ FILE") Q
	1107	"RTN","PSO 7P529",20, 0)
	1108	. I $P(FG ("name")," ,",1)'=$P( NPNAME,"," ,1) D LOG( .FG,NPIEN, PHANDLE,"N AME MISMAT CH") Q
	1109	"RTN","PSO 7P529",21, 0)
	1110	. I $D(^X TV(8991.9, "B",DEA)) D LOG(.FG, NPIEN,PHAN DLE,"DUPLI CATE DEA N UMBER") Q
	1111	"RTN","PSO 7P529",22, 0)
	1112	. K DEAIE N S SC=$$D EAFILE(DEA ,NPIEN,PHA NDLE,.FG,. DEAIEN) I 'SC D LOG (.FG,NPIEN ,PHANDLE," DATA FILIN G ISSUE") Q
	1113	"RTN","PSO 7P529",23, 0)
	1114	. D NPFIL E(DEA,NPIE N,DEAIEN)
	1115	"RTN","PSO 7P529",24, 0)
	1116	K ^TMP($J ,"PSODEAWB ")
	1117	"RTN","PSO 7P529",25, 0)
	1118	D MSG
	1119	"RTN","PSO 7P529",26, 0)
	1120	D BMES^XP DUTL(" ******* ****** ****** ****** ****** ****")
	1121	"RTN","PSO 7P529",27, 0)
	1122	D BMES^XP DUTL(" The patch Post Inst allation C ompleted S uccessfull y!")
	1123	"RTN","PSO 7P529",28, 0)
	1124	D BMES^XP DUTL(" ******* ****** ****** ****** ****** ****")
	1125	"RTN","PSO 7P529",29, 0)
	1126	Q
	1127	"RTN","PSO 7P529",30, 0)
	1128	;
	1129	"RTN","PSO 7P529",31, 0)
	1130	GET(FG,DEA ) ; Functi on to Get the Remote DEA infor mation, Re turn in FG .
	1131	"RTN","PSO 7P529",32, 0)
	1132	N DATA,ER RORS,PATH, REQUEST,RE SOURCE,RES PJSON,RESP ONSE,SC,SE RVER,SERVI CE,PSOERR
	1133	"RTN","PSO 7P529",33, 0)
	1134	Q:$G(DEA) ="" "0^No DEA Number Entered."
	1135	"RTN","PSO 7P529",34, 0)
	1136	S SERVER= "PSO DOJ/D EA WEB SER VER"
	1137	"RTN","PSO 7P529",35, 0)
	1138	S SERVICE ="PSO DOJ/ DEA WEB SE RVICE"
	1139	"RTN","PSO 7P529",36, 0)
	1140	S RESOURC E=DEA
	1141	"RTN","PSO 7P529",37, 0)
	1142	;
	1143	"RTN","PSO 7P529",38, 0)
	1144	; Get an instance o f the REST request o bject.
	1145	"RTN","PSO 7P529",39, 0)
	1146	S REQUEST =$$GETREST ^XOBWLIB(S ERVICE,SER VER)
	1147	"RTN","PSO 7P529",40, 0)
	1148	;
	1149	"RTN","PSO 7P529",41, 0)
	1150	; Execute the HTTP Get method .
	1151	"RTN","PSO 7P529",42, 0)
	1152	S SC=$$GE T^XOBWLIB( REQUEST,RE SOURCE,.PS OERR,0)
	1153	"RTN","PSO 7P529",43, 0)
	1154	I 'SC Q " 0^General Service Er ror"
	1155	"RTN","PSO 7P529",44, 0)
	1156	;
	1157	"RTN","PSO 7P529",45, 0)
	1158	; Process the respo nse.
	1159	"RTN","PSO 7P529",46, 0)
	1160	S RESPONS E=REQUEST. HttpRespon se
	1161	"RTN","PSO 7P529",47, 0)
	1162	S DATA=RE SPONSE.Dat a
	1163	"RTN","PSO 7P529",48, 0)
	1164	S RESPJSO N=""
	1165	"RTN","PSO 7P529",49, 0)
	1166	F Q:DATA .AtEnd Se t RESPJSON =RESPJSON_ DATA.ReadL ine()
	1167	"RTN","PSO 7P529",50, 0)
	1168	S RESPJSO N=$TR(RESP JSON,$C(10 ),"")
	1169	"RTN","PSO 7P529",51, 0)
	1170	I RESPJSO N="" Q "0^ No DEA Fou nd."
	1171	"RTN","PSO 7P529",52, 0)
	1172	;
	1173	"RTN","PSO 7P529",53, 0)
	1174	; Decode the JSON f ormat into a MUMPS g lobal in F G
	1175	"RTN","PSO 7P529",54, 0)
	1176	D DECODE^ XLFJSON("R ESPJSON"," FG","ERROR S")
	1177	"RTN","PSO 7P529",55, 0)
	1178	;
	1179	"RTN","PSO 7P529",56, 0)
	1180	; Default the busin essActivit ySubcode.
	1181	"RTN","PSO 7P529",57, 0)
	1182	I $G(FG(" businessAc tivitySubc ode"))="" S FG("busi nessActivi tySubcode" )=0
	1183	"RTN","PSO 7P529",58, 0)
	1184	;
	1185	"RTN","PSO 7P529",59, 0)
	1186	Q "1^Succ ess"
	1187	"RTN","PSO 7P529",60, 0)
	1188	;
	1189	"RTN","PSO 7P529",61, 0)
	1190	LOG(FG,NPI EN,PHANDLE ,REASON) ; -- Log im port issue s
	1191	"RTN","PSO 7P529",62, 0)
	1192	N CNT,FLD ,IENS,TR
	1193	"RTN","PSO 7P529",63, 0)
	1194	D GETS^DI Q(200,NPIE N,".01;1;8 ;28;41.99; 53.2;53.9" ,"R","TR")
	1195	"RTN","PSO 7P529",64, 0)
	1196	S IENS=$O (TR(200,"" ))
	1197	"RTN","PSO 7P529",65, 0)
	1198	S ^XTMP(P HANDLE,0,0 )=$G(^XTMP (PHANDLE,0 ,0))+1,CNT =^XTMP(PHA NDLE,0,0)
	1199	"RTN","PSO 7P529",66, 0)
	1200	S ^XTMP(P HANDLE,CNT ,"LOCAL"," DUZ")=NPIE N
	1201	"RTN","PSO 7P529",67, 0)
	1202	M ^XTMP(P HANDLE,CNT ,"WS")=FG, ^XTMP(PHAN DLE,CNT,"L OCAL")=TR( 200,IENS)
	1203	"RTN","PSO 7P529",68, 0)
	1204	S ^XTMP(P HANDLE,CNT ,"Exceptio n")=REASON
	1205	"RTN","PSO 7P529",69, 0)
	1206	Q
	1207	"RTN","PSO 7P529",70, 0)
	1208	;
	1209	"RTN","PSO 7P529",71, 0)
	1210	DEAFILE(DE A,NPIEN,PH ANDLE,FG,D EAIEN) ; - - File the import da ta in DEA NUMBERS FI LE #8991.9
	1211	"RTN","PSO 7P529",72, 0)
	1212	; POSTAL^ XIPUTL use d in agree ment with Integratio n Agreemen t: 3618
	1213	"RTN","PSO 7P529",73, 0)
	1214	N ED,FDA, IENS,IENRO OT,MSGROOT ,NPDETOX,S C,XIP,XSTA TE,SCH200, SCHFLD,SCH CNT,BAC
	1215	"RTN","PSO 7P529",74, 0)
	1216	N DS S DS =$$UP^XLFS TR($G(FG(" drugSchedu le")))
	1217	"RTN","PSO 7P529",75, 0)
	1218	S SC="1^S UCCESS"
	1219	"RTN","PSO 7P529",76, 0)
	1220	S IENS=$S ($D(DEAIEN ):DEAIEN_" ,",1:"+1," )
	1221	"RTN","PSO 7P529",77, 0)
	1222	S FDA(1,8 991.9,IENS ,.01)=DEA
	1223	"RTN","PSO 7P529",78, 0)
	1224	S FDA(1,8 991.9,IENS ,.02)=$G(F G("busines sActivityC ode"))_$G( FG("busine ssActivity Subcode")) ; Pointer to file # 8991.8
	1225	"RTN","PSO 7P529",79, 0)
	1226	S BAC=$G( FG("busine ssActivity Code"))_$G (FG("busin essActivit ySubcode") )
	1227	"RTN","PSO 7P529",80, 0)
	1228	S FDA(1,8 991.9,IENS ,.03)=$S($ $DETOXCHK^ PSODEAUT(B AC):"X"_$E (DEA,2,9), 1:"") ; DETOX NUM BER
	1229	"RTN","PSO 7P529",81, 0)
	1230	;
	1231	"RTN","PSO 7P529",82, 0)
	1232	; DETOX D IFFERENCE LOGGING BU T NOT QUIT ING
	1233	"RTN","PSO 7P529",83, 0)
	1234	S NPDETOX =$$GET1^DI Q(200,NPIE N_",",53.1 1)
	1235	"RTN","PSO 7P529",84, 0)
	1236	I NPDETOX '="",'$$DE TOXCHK^PSO DEAUT(BAC) D LOG(.FG ,NPIEN,PHA NDLE,"DETO X: "_NPDET OX_" DOESN 'T MATCH B USINESS AC TIVITY COD E.")
	1237	"RTN","PSO 7P529",85, 0)
	1238	I NPDETOX '="",$$DET OXCHK^PSOD EAUT(BAC), NPDETOX'=( "X"_$E(DEA ,2,9)) D L OG(.FG,NPI EN,PHANDLE ,"Existing DETOX "_N PDETOX_" a nd CALCULA TED DETOX "_"X"_$E(D EA,2,9)_" MISMATCH." )
	1239	"RTN","PSO 7P529",86, 0)
	1240	;
	1241	"RTN","PSO 7P529",87, 0)
	1242	S FDA(1,8 991.9,IENS ,.04)=$G(F G("expirat ionDate"))
	1243	"RTN","PSO 7P529",88, 0)
	1244	S FDA(1,8 991.9,IENS ,.06)=1 ; Setting a ll provide rs = INPAT IENT for i nitial loa d.
	1245	"RTN","PSO 7P529",89, 0)
	1246	S FDA(1,8 991.9,IENS ,.07)=2 ; Setting a ll provide rs = INDIV IDUAL for initial lo ad.
	1247	"RTN","PSO 7P529",90, 0)
	1248	S FDA(1,8 991.9,IENS ,1.1)=$G(F G("name"))
	1249	"RTN","PSO 7P529",91, 0)
	1250	S FDA(1,8 991.9,IENS ,1.2)=$G(F G("address 1"))
	1251	"RTN","PSO 7P529",92, 0)
	1252	S FDA(1,8 991.9,IENS ,1.3)=$G(F G("address 2"))
	1253	"RTN","PSO 7P529",93, 0)
	1254	S FDA(1,8 991.9,IENS ,1.4)=$G(F G("address 3"))
	1255	"RTN","PSO 7P529",94, 0)
	1256	S FDA(1,8 991.9,IENS ,1.5)=$G(F G("city"))
	1257	"RTN","PSO 7P529",95, 0)
	1258	;
	1259	"RTN","PSO 7P529",96, 0)
	1260	; Special State Pro cessing
	1261	"RTN","PSO 7P529",97, 0)
	1262	D POSTAL^ XIPUTIL($G (FG("zipCo de")),.XIP )
	1263	"RTN","PSO 7P529",98, 0)
	1264	S XSTATE= $G(XIP("ST ATE"))
	1265	"RTN","PSO 7P529",99, 0)
	1266	I XSTATE' ="" S FDA( 1,8991.9,I ENS,1.6)=X STATE ; Po inter to t he State F ile #5.
	1267	"RTN","PSO 7P529",100 ,0)
	1268	;
	1269	"RTN","PSO 7P529",101 ,0)
	1270	S FDA(1,8 991.9,IENS ,1.7)=$G(F G("zipCode "))
	1271	"RTN","PSO 7P529",102 ,0)
	1272	;
	1273	"RTN","PSO 7P529",103 ,0)
	1274	D GETS^DI Q(200,NPIE N_",","55. 1:55.6","I ","SCH200" )
	1275	"RTN","PSO 7P529",104 ,0)
	1276	S SCHCNT= 0 F SCHFLD =55.1:.1:5 5.6 S SCHC NT=SCHCNT+ SCH200(200 ,NPIEN_"," ,SCHFLD,"I ")
	1277	"RTN","PSO 7P529",105 ,0)
	1278	;
	1279	"RTN","PSO 7P529",106 ,0)
	1280	D:SCHCNT
	1281	"RTN","PSO 7P529",107 ,0)
	1282	. S FDA(1 ,8991.9,IE NS,2.1)=$S (SCH200(20 0,NPIEN_", ",55.1,"I" ):"Y",1:"N ") ; SC HEDULE II NARCOTIC
	1283	"RTN","PSO 7P529",108 ,0)
	1284	. S FDA(1 ,8991.9,IE NS,2.2)=$S (SCH200(20 0,NPIEN_", ",55.2,"I" ):"Y",1:"N ") ; SC HEDULE II NON-NARCOT IC
	1285	"RTN","PSO 7P529",109 ,0)
	1286	. S FDA(1 ,8991.9,IE NS,2.3)=$S (SCH200(20 0,NPIEN_", ",55.3,"I" ):"Y",1:"N ") ; SC HEDULE III NARCOTIC
	1287	"RTN","PSO 7P529",110 ,0)
	1288	. S FDA(1 ,8991.9,IE NS,2.4)=$S (SCH200(20 0,NPIEN_", ",55.4,"I" ):"Y",1:"N ") ; SC HEDULE III NON-NARCO TIC
	1289	"RTN","PSO 7P529",111 ,0)
	1290	. S FDA(1 ,8991.9,IE NS,2.5)=$S (SCH200(20 0,NPIEN_", ",55.5,"I" ):"Y",1:"N ") ; SC HEDULE IV
	1291	"RTN","PSO 7P529",112 ,0)
	1292	. S FDA(1 ,8991.9,IE NS,2.6)=$S (SCH200(20 0,NPIEN_", ",55.6,"I" ):"Y",1:"N ") ; SC HEDULE V
	1293	"RTN","PSO 7P529",113 ,0)
	1294	;
	1295	"RTN","PSO 7P529",114 ,0)
	1296	D:'SCHCNT
	1297	"RTN","PSO 7P529",115 ,0)
	1298	. S FDA(1 ,8991.9,IE NS,2.1)=$S (DS["22N": "Y",(DS["2 "&(DS'["2N ")):"Y",1: "N") ; SCH EDULE II N ARCOTIC
	1299	"RTN","PSO 7P529",116 ,0)
	1300	. S FDA(1 ,8991.9,IE NS,2.2)=$S (DS["2N":" Y",1:"N") ; SCH EDULE II N ON-NARCOTI C
	1301	"RTN","PSO 7P529",117 ,0)
	1302	. S FDA(1 ,8991.9,IE NS,2.3)=$S (DS["33N": "Y",(DS["3 "&(DS'["3N ")):"Y",1: "N") ; SCH EDULE III NARCOTIC
	1303	"RTN","PSO 7P529",118 ,0)
	1304	. S FDA(1 ,8991.9,IE NS,2.4)=$S (DS["3N":" Y",1:"N") ; SCH EDULE III NON-NARCOT IC
	1305	"RTN","PSO 7P529",119 ,0)
	1306	. S FDA(1 ,8991.9,IE NS,2.5)=$S (DS["4":"Y ",1:"N") ; SCH EDULE IV
	1307	"RTN","PSO 7P529",120 ,0)
	1308	. S FDA(1 ,8991.9,IE NS,2.6)=$S (DS["5":"Y ",1:"N") ; SCH EDULE V
	1309	"RTN","PSO 7P529",121 ,0)
	1310	;
	1311	"RTN","PSO 7P529",122 ,0)
	1312	S FDA(1,8 991.9,IENS ,10.2)="N" ; LAST U PDATED DAT E/TIME
	1313	"RTN","PSO 7P529",123 ,0)
	1314	S FDA(1,8 991.9,IENS ,10.3)=$G( FG("proces sedDate")) ; LAST D OJ UPDATE DATE/TIME
	1315	"RTN","PSO 7P529",124 ,0)
	1316	;
	1317	"RTN","PSO 7P529",125 ,0)
	1318	D UPDATE^ DIE("E","F DA(1)","IE NROOT","MS GROOT")
	1319	"RTN","PSO 7P529",126 ,0)
	1320	I $D(MSGR OOT) S SC= "0^DATA DI DN'T FILE SUCCESSFUL LY." Q SC
	1321	"RTN","PSO 7P529",127 ,0)
	1322	S DEAIEN= $S($D(IENR OOT(1)):IE NROOT(1),1 :IENS)
	1323	"RTN","PSO 7P529",128 ,0)
	1324	I 'DEAIEN S SC="0^D ATA DIDN'T FILE SUCC ESSFULLY." Q SC
	1325	"RTN","PSO 7P529",129 ,0)
	1326	S FDA(2,8 991.9,DEAI EN,10.1)=D UZ D FILE^ DIE("","FD A(2)","MSG ROOT")
	1327	"RTN","PSO 7P529",130 ,0)
	1328	Q SC
	1329	"RTN","PSO 7P529",131 ,0)
	1330	;
	1331	"RTN","PSO 7P529",132 ,0)
	1332	NPFILE(DEA ,NPIEN,DEA IEN) ; -- File the D EA NUMBER in the NEW PERSON FI LE #200.
	1333	"RTN","PSO 7P529",133 ,0)
	1334	N FDA,IEN ROOT,MSGRO OT
	1335	"RTN","PSO 7P529",134 ,0)
	1336	Q:'$G(NPI EN) Q:'$G (DEAIEN)
	1337	"RTN","PSO 7P529",135 ,0)
	1338	S FDA(1,2 00.5321,"+ 1,"_NPIEN_ ",",.01)=D EA
	1339	"RTN","PSO 7P529",136 ,0)
	1340	S FDA(1,2 00.5321,"+ 1,"_NPIEN_ ",",.02)=" "
	1341	"RTN","PSO 7P529",137 ,0)
	1342	S FDA(1,2 00.5321,"+ 1,"_NPIEN_ ",",.03)=+ DEAIEN
	1343	"RTN","PSO 7P529",138 ,0)
	1344	D UPDATE^ DIE("","FD A(1)","IEN ROOT","MSG ROOT")
	1345	"RTN","PSO 7P529",139 ,0)
	1346	Q
	1347	"RTN","PSO 7P529",140 ,0)
	1348	;
	1349	"RTN","PSO 7P529",141 ,0)
	1350	INITXTMP(N AMESPC,TIT LE,LIFE) ; -- Initi alize ^XTM P accordin g to SAC s tandards.
	1351	"RTN","PSO 7P529",142 ,0)
	1352	N BEGDT,P URGDT
	1353	"RTN","PSO 7P529",143 ,0)
	1354	S BEGDT=$ $NOW^XLFDT ()
	1355	"RTN","PSO 7P529",144 ,0)
	1356	S PURGDT= $$FMADD^XL FDT(BEGDT, LIFE)
	1357	"RTN","PSO 7P529",145 ,0)
	1358	S NAMESPC =NAMESPC_" -"_BEGDT_" -"_$J
	1359	"RTN","PSO 7P529",146 ,0)
	1360	S ^XTMP(N AMESPC,0)= PURGDT_"^" _BEGDT_"^" _TITLE
	1361	"RTN","PSO 7P529",147 ,0)
	1362	Q NAMESPC
	1363	"RTN","PSO 7P529",148 ,0)
	1364	;
	1365	"RTN","PSO 7P529",149 ,0)
	1366	MSG ; Sen d MailMan LOG REPORT
	1367	"RTN","PSO 7P529",150 ,0)
	1368	N CNT,OBJ ,PHANDLE,X MSUB,XMDUZ ,PSOCNT,PS ODASH
	1369	"RTN","PSO 7P529",151 ,0)
	1370	S $P(PSOD ASH,"-",80 )=""
	1371	"RTN","PSO 7P529",152 ,0)
	1372	S PHANDLE =$O(^XTMP( "PSODEAWB" _"-"_($H+1 )),-1)
	1373	"RTN","PSO 7P529",153 ,0)
	1374	S XMSUB=" DEA Migrat ion Except ion Report "_$$FMTE^ XLFDT(DT," 5DZ"),XMDU Z=.5
	1375	"RTN","PSO 7P529",154 ,0)
	1376	K XMY S N PIEN=0 F S NPIEN=$O (^XUSEC("P SDMGR",NPI EN)) Q:'+N PIEN S XM Y(NPIEN)=" "
	1377	"RTN","PSO 7P529",155 ,0)
	1378	K PSOTEXT S PSOCNT =0
	1379	"RTN","PSO 7P529",156 ,0)
	1380	F CNT=1:1 :$G(^XTMP( PHANDLE,0, 0)) D
	1381	"RTN","PSO 7P529",157 ,0)
	1382	. K OBJ M OBJ=^XTMP (PHANDLE,C NT)
	1383	"RTN","PSO 7P529",158 ,0)
	1384	. ;
	1385	"RTN","PSO 7P529",159 ,0)
	1386	. S PSOCN T=PSOCNT+1
	1387	"RTN","PSO 7P529",160 ,0)
	1388	. S PSOTE XT(PSOCNT) ="PROVIDER NAME: "_$ $LJ^XLFSTR (OBJ("LOCA L","NAME") ,"35T")_" " ; 52
	1389	"RTN","PSO 7P529",161 ,0)
	1390	. S PSOTE XT(PSOCNT) =PSOTEXT(P SOCNT)_"IN ITIALS: "_ $$LJ^XLFST R(OBJ("LOC AL","INITI AL"),"5T") _" " ; 16
	1391	"RTN","PSO 7P529",162 ,0)
	1392	. ;
	1393	"RTN","PSO 7P529",163 ,0)
	1394	. If OBJ( "LOCAL","N AME")'=$G( OBJ("WS"," name")) D
	1395	"RTN","PSO 7P529",164 ,0)
	1396	.. S PSOC NT=PSOCNT+ 1
	1397	"RTN","PSO 7P529",165 ,0)
	1398	.. S PSOT EXT(PSOCNT )="DOJ PRO VIDER NAME : "_$$LJ^X LFSTR($G(O BJ("WS","n ame")),"35 T") ; 54
	1399	"RTN","PSO 7P529",166 ,0)
	1400	. ;
	1401	"RTN","PSO 7P529",167 ,0)
	1402	. S PSOCN T=PSOCNT+1
	1403	"RTN","PSO 7P529",168 ,0)
	1404	. S PSOTE XT(PSOCNT) ="TITLE: " _$$LJ^XLFS TR(OBJ("LO CAL","TITL E"),"30T") _" " ; 39
	1405	"RTN","PSO 7P529",169 ,0)
	1406	. S PSOTE XT(PSOCNT) =PSOTEXT(P SOCNT)_"DU Z: "_$$LJ^ XLFSTR(OBJ ("LOCAL"," DUZ"),"10T ") ; 15
	1407	"RTN","PSO 7P529",170 ,0)
	1408	. ;
	1409	"RTN","PSO 7P529",171 ,0)
	1410	. S PSOCN T=PSOCNT+1
	1411	"RTN","PSO 7P529",172 ,0)
	1412	. S PSOTE XT(PSOCNT) ="NPI: "_$ $LJ^XLFSTR (OBJ("LOCA L","NPI"), "10T")_" " ; 27
	1413	"RTN","PSO 7P529",173 ,0)
	1414	. S PSOTE XT(PSOCNT) =PSOTEXT(P SOCNT)_"DE A#: "_$$LJ ^XLFSTR(OB J("LOCAL", "DEA#"),"1 0T")_" " ; 27
	1415	"RTN","PSO 7P529",174 ,0)
	1416	. S PSOTE XT(PSOCNT) =PSOTEXT(P SOCNT)_"MA IL CODE: " _$$LJ^XLFS TR(OBJ("LO CAL","MAIL CODE"),"1 0T") ; 21
	1417	"RTN","PSO 7P529",175 ,0)
	1418	. ;
	1419	"RTN","PSO 7P529",176 ,0)
	1420	. S PSOCN T=PSOCNT+1 ,PSOTEXT(P SOCNT)="RE MARKS: "_$ $LJ^XLFSTR (OBJ("LOCA L","REMARK S"),"60T") ; 69
	1421	"RTN","PSO 7P529",177 ,0)
	1422	. ;
	1423	"RTN","PSO 7P529",178 ,0)
	1424	. S PSOCN T=PSOCNT+1 ,PSOTEXT(P SOCNT)="EX CEPTION: " _$$LJ^XLFS TR(OBJ("Ex ception"), "68T") ; 79
	1425	"RTN","PSO 7P529",179 ,0)
	1426	. ;
	1427	"RTN","PSO 7P529",180 ,0)
	1428	. S PSOCN T=PSOCNT+1 ,PSOTEXT(P SOCNT)=PSO DASH
	1429	"RTN","PSO 7P529",181 ,0)
	1430	. ;
	1431	"RTN","PSO 7P529",182 ,0)
	1432	N DIFROM S XMTEXT=" PSOTEXT(" D ^XMD K D IFROM
	1433	"RTN","PSO 7P529",183 ,0)
	1434	K PSOTEXT ,XMTEXT
	1435	"RTN","PSO 7P529",184 ,0)
	1436	;
	1437	"RTN","PSO 7P529",185 ,0)
	1438	Q
	1439	"RTN","PSO DEAUT")
	1440	0^2^B22422 0858
	1441	"RTN","PSO DEAUT",1,0 )
	1442	PSODEAUT ; ALB/BI - D EA MANUAL ENTRY ;05/ 15/2018
	1443	"RTN","PSO DEAUT",2,0 )
	1444	;;7.0;OUT PATIENT PH ARMACY;5 29;DEC 1 997;Build 19
	1445	"RTN","PSO DEAUT",3,0 )
	1446	;External reference to sub-fi le NEW DEA #S (#200. 5321) is s upported b y DBIA 700 0
	1447	"RTN","PSO DEAUT",4,0 )
	1448	;External reference to DEA BU SINESS ACT IVITY CODE S file (#8 991.8) is supported by DBIA 70 01
	1449	"RTN","PSO DEAUT",5,0 )
	1450	;External reference to DEA NU MBERS file (#8991.9) is suppor ted by DBI A 7002
	1451	"RTN","PSO DEAUT",6,0 )
	1452	;External reference to DEA NU MBERS file (#8991.6) is suppor ted by DBI A 7015
	1453	"RTN","PSO DEAUT",7,0 )
	1454	Q
	1455	"RTN","PSO DEAUT",8,0 )
	1456	;
	1457	"RTN","PSO DEAUT",9,0 )
	1458	DEALIST(RE T,NPIEN) ; -- RPC t o return a List of D EA numbers and infor mation for a single provider.
	1459	"RTN","PSO DEAUT",10, 0)
	1460	; INPUT: NPIEN - N EW PERSON FILE #200 INTERNAL E NTRY NUMBE R
	1461	"RTN","PSO DEAUT",11, 0)
	1462	;
	1463	"RTN","PSO DEAUT",12, 0)
	1464	; OUTPUT: RET - A S TRING OF D EA INFORMA TION DELIM ITED BY TH E "^"
	1465	"RTN","PSO DEAUT",13, 0)
	1466	; 1 - DEA NUMBER
	1467	"RTN","PSO DEAUT",14, 0)
	1468	; 2 - IND IVIDUAL DE A SUFFIX
	1469	"RTN","PSO DEAUT",15, 0)
	1470	; 3 - STA TE
	1471	"RTN","PSO DEAUT",16, 0)
	1472	; 4 - DET OX NUMBER
	1473	"RTN","PSO DEAUT",17, 0)
	1474	; 5 - EXP IRATION DA TE: FROM T HE DEA NUM BERS FILE (#8991.9), FIELD EXP IRATION DA TE (#.04)
	1475	"RTN","PSO DEAUT",18, 0)
	1476	; 6 - NPI ENS
	1477	"RTN","PSO DEAUT",19, 0)
	1478	; 7 - DNI ENS
	1479	"RTN","PSO DEAUT",20, 0)
	1480	; 8 - SCH EDULE II N ARCOTIC
	1481	"RTN","PSO DEAUT",21, 0)
	1482	; 9 - SCH EDULE II N ON-NARCOTI C
	1483	"RTN","PSO DEAUT",22, 0)
	1484	; 10 - SCH EDULE III NARCOTIC
	1485	"RTN","PSO DEAUT",23, 0)
	1486	; 11 - SCH EDULE III NON-NARCOT IC
	1487	"RTN","PSO DEAUT",24, 0)
	1488	; 12 - SCH EDULE IV
	1489	"RTN","PSO DEAUT",25, 0)
	1490	; 13 - SCH EDULE V
	1491	"RTN","PSO DEAUT",26, 0)
	1492	; 14 - USE FOR INPAT IENT ORDER S?
	1493	"RTN","PSO DEAUT",27, 0)
	1494	;
	1495	"RTN","PSO DEAUT",28, 0)
	1496	Q:'$G(NPI EN)
	1497	"RTN","PSO DEAUT",29, 0)
	1498	N CNT,DND EADAT,DNDE AIEN,FAIL, IENS,NPDEA DAT,NPDEAI EN
	1499	"RTN","PSO DEAUT",30, 0)
	1500	S NPDEAIE N=0 F CNT= 1:1 S NPDE AIEN=$O(^V A(200,NPIE N,"PS4",NP DEAIEN)) Q :'+NPDEAIE N D
	1501	"RTN","PSO DEAUT",31, 0)
	1502	. S IENS= NPDEAIEN_" ,"_NPIEN_" ,"
	1503	"RTN","PSO DEAUT",32, 0)
	1504	. K NPDEA DAT D GETS ^DIQ(200.5 321,IENS," **","","NP DEADAT") Q :'$D(NPDEA DAT)
	1505	"RTN","PSO DEAUT",33, 0)
	1506	. S DNDEA IEN=$$GET1 ^DIQ(200.5 321,IENS,. 03,"I") Q: 'DNDEAIEN
	1507	"RTN","PSO DEAUT",34, 0)
	1508	. K DNDEA DAT D GETS ^DIQ(8991. 9,DNDEAIEN ,"**",""," DNDEADAT") Q:'$D(DND EADAT)
	1509	"RTN","PSO DEAUT",35, 0)
	1510	. ;
	1511	"RTN","PSO DEAUT",36, 0)
	1512	. S RET(C NT)=""
	1513	"RTN","PSO DEAUT",37, 0)
	1514	. S RET(C NT)=RET(CN T)_NPDEADA T(200.5321 ,IENS,.01) _"^" ; NEW PE RSON DEA N UMBER
	1515	"RTN","PSO DEAUT",38, 0)
	1516	. S RET(C NT)=RET(CN T)_NPDEADA T(200.5321 ,IENS,.02) _"^" ; INDIVI DUAL DEA S UFFIX
	1517	"RTN","PSO DEAUT",39, 0)
	1518	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",1.6)_"^" ; STATE
	1519	"RTN","PSO DEAUT",40, 0)
	1520	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",.03)_"^" ; DETOX NUMBER
	1521	"RTN","PSO DEAUT",41, 0)
	1522	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",.04)_"^" ; EXPIRA TION DATE
	1523	"RTN","PSO DEAUT",42, 0)
	1524	. S RET(C NT)=RET(CN T)_IENS_"^ " ; NEW PE RSON IENS
	1525	"RTN","PSO DEAUT",43, 0)
	1526	. S RET(C NT)=RET(CN T)_DNDEAIE N_"^" ; DEA NU MBERS IEN
	1527	"RTN","PSO DEAUT",44, 0)
	1528	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",2.1)_"^" ; SCHEDU LE II NARC OTIC
	1529	"RTN","PSO DEAUT",45, 0)
	1530	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",2.2)_"^" ; SCHEDU LE II NON- NARCOTIC
	1531	"RTN","PSO DEAUT",46, 0)
	1532	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",2.3)_"^" ; SCHEDU LE III NAR COTIC
	1533	"RTN","PSO DEAUT",47, 0)
	1534	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",2.4)_"^" ; SCHEDU LE III NON -NARCOTIC
	1535	"RTN","PSO DEAUT",48, 0)
	1536	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",2.5)_"^" ; SCHEDU LE IV
	1537	"RTN","PSO DEAUT",49, 0)
	1538	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",2.6)_"^" ; SCHEDU LE V
	1539	"RTN","PSO DEAUT",50, 0)
	1540	. S RET(C NT)=RET(CN T)_DNDEADA T(8991.9,D NDEAIEN_", ",.06) ; USE FO R INPATIEN T ORDERS?
	1541	"RTN","PSO DEAUT",51, 0)
	1542	Q
	1543	"RTN","PSO DEAUT",52, 0)
	1544	;
	1545	"RTN","PSO DEAUT",53, 0)
	1546	DEADOJ(RET ,DEA) ; - - RPC to r eturn DEA Informatio n for a si ngle DEA N umber
	1547	"RTN","PSO DEAUT",54, 0)
	1548	; INPUT: DEA - PRO PERLY FORM ATTED DEA NUMBER
	1549	"RTN","PSO DEAUT",55, 0)
	1550	;
	1551	"RTN","PSO DEAUT",56, 0)
	1552	; OUTPUT: RET - A S TRING OF D EA INFORMA TION DELIM ITED BY TH E "^"
	1553	"RTN","PSO DEAUT",57, 0)
	1554	; 1 - PRO VIDER NAME
	1555	"RTN","PSO DEAUT",58, 0)
	1556	; 2 - ADD RESS 1
	1557	"RTN","PSO DEAUT",59, 0)
	1558	; 3 - ADD RESS 2
	1559	"RTN","PSO DEAUT",60, 0)
	1560	; 4 - ADD RESS 3
	1561	"RTN","PSO DEAUT",61, 0)
	1562	; 5 - CIT Y
	1563	"RTN","PSO DEAUT",62, 0)
	1564	; 6 - STA TE
	1565	"RTN","PSO DEAUT",63, 0)
	1566	; 7 - STA TE POINTER
	1567	"RTN","PSO DEAUT",64, 0)
	1568	; 8 - ZIP CODE
	1569	"RTN","PSO DEAUT",65, 0)
	1570	; 9 - ACT IVITY CODE
	1571	"RTN","PSO DEAUT",66, 0)
	1572	; 10 - TYP E
	1573	"RTN","PSO DEAUT",67, 0)
	1574	; 11 - DEA NUMBER
	1575	"RTN","PSO DEAUT",68, 0)
	1576	; 12 - EXP IRATION DA TE
	1577	"RTN","PSO DEAUT",69, 0)
	1578	; 13 - PRO CESSED DAT E
	1579	"RTN","PSO DEAUT",70, 0)
	1580	; 14 - DET OX NUMBER
	1581	"RTN","PSO DEAUT",71, 0)
	1582	; 15 - SCH DEULE II N ARCOTIC
	1583	"RTN","PSO DEAUT",72, 0)
	1584	; 16 - SCH EDULE II N ON-NARCOTI C
	1585	"RTN","PSO DEAUT",73, 0)
	1586	; 17 - SCH EDULE III NARCOTIC
	1587	"RTN","PSO DEAUT",74, 0)
	1588	; 18 - SCH EDULE III NON-NARCOT IC
	1589	"RTN","PSO DEAUT",75, 0)
	1590	; 19 - SCH EDULE IV
	1591	"RTN","PSO DEAUT",76, 0)
	1592	; 20 - SCH EDULE V
	1593	"RTN","PSO DEAUT",77, 0)
	1594	;
	1595	"RTN","PSO DEAUT",78, 0)
	1596	N FG,NAME ,NPIEN,VAL UE,DS,BAC, SC
	1597	"RTN","PSO DEAUT",79, 0)
	1598	I $G(DEA) ="" S RET( 0)="0^INVA LID DEA NU MBER" Q
	1599	"RTN","PSO DEAUT",80, 0)
	1600	I '$$DEAN UMFL(DEA) S RET(0)=" 0^Invalid DEA Number due to er ror in fir st letter" Q
	1601	"RTN","PSO DEAUT",81, 0)
	1602	I '$$DEAN UM(DEA) S RET(0)="0^ Invalid DE A Number d ue to erro r in the n umbers" Q
	1603	"RTN","PSO DEAUT",82, 0)
	1604	S SC=$$WS GET(.FG,DE A)
	1605	"RTN","PSO DEAUT",83, 0)
	1606	I $P($P(S C,"^",2)," .",1)="DEA NUMBER NO T FOUND" S RET(0)="0 ^DEA NUMBE R NOT FOUN D. Please enter the provider's DEA numbe r." Q
	1607	"RTN","PSO DEAUT",84, 0)
	1608	I 'SC S R ET(0)="0^W EB SERVICE FAILURE" Q
	1609	"RTN","PSO DEAUT",85, 0)
	1610	;
	1611	"RTN","PSO DEAUT",86, 0)
	1612	S RET(1)= ""
	1613	"RTN","PSO DEAUT",87, 0)
	1614	S RET(1)= RET(1)_$G( FG("name") )_"^" ; PROV IDER NAME
	1615	"RTN","PSO DEAUT",88, 0)
	1616	S RET(1)= RET(1)_$G( FG("addres s1"))_"^" ; ADDR ESS 1
	1617	"RTN","PSO DEAUT",89, 0)
	1618	S RET(1)= RET(1)_$G( FG("addres s2"))_"^" ; ADDR ESS 2
	1619	"RTN","PSO DEAUT",90, 0)
	1620	S RET(1)= RET(1)_$G( FG("addres s3"))_"^" ; ADDR ESS 3
	1621	"RTN","PSO DEAUT",91, 0)
	1622	S RET(1)= RET(1)_$G( FG("city") )_"^" ; CITY
	1623	"RTN","PSO DEAUT",92, 0)
	1624	;
	1625	"RTN","PSO DEAUT",93, 0)
	1626	; Special State Pro cessing
	1627	"RTN","PSO DEAUT",94, 0)
	1628	S RET(1)= RET(1)_$G( FG("state" ))_"^" ; STAT E
	1629	"RTN","PSO DEAUT",95, 0)
	1630	N XSTATE, XIP D POST AL^XIPUTIL ($G(FG("zi pCode")),. XIP) S XST ATE=$G(XIP ("STATE"))
	1631	"RTN","PSO DEAUT",96, 0)
	1632	S RET(1)= RET(1)_$G( XSTATE)_"^ " ; STAT E POINTER
	1633	"RTN","PSO DEAUT",97, 0)
	1634	;
	1635	"RTN","PSO DEAUT",98, 0)
	1636	S RET(1)= RET(1)_$G( FG("zipCod e"))_"^" ; ZIP CODE
	1637	"RTN","PSO DEAUT",99, 0)
	1638	S BAC=$G( FG("busine ssActivity Code"))_$G (FG("busin essActivit ySubcode") )
	1639	"RTN","PSO DEAUT",100 ,0)
	1640	S RET(1)= RET(1)_BAC _"^" ; AC TIVITY COD E
	1641	"RTN","PSO DEAUT",101 ,0)
	1642	S RET(1)= RET(1)_$P( $$PROVTYPE ($G(FG("bu sinessActi vityCode") )),"^",2)_ "^" ; TYP E
	1643	"RTN","PSO DEAUT",102 ,0)
	1644	S RET(1)= RET(1)_$G( FG("deaNum ber"))_"^" ; DEA NUMBER
	1645	"RTN","PSO DEAUT",103 ,0)
	1646	S RET(1)= RET(1)_$G( FG("expira tionDate") )_"^" ; EXPI RATION DAT E
	1647	"RTN","PSO DEAUT",104 ,0)
	1648	S RET(1)= RET(1)_$G( FG("proces sedDate")) _"^" ; PROC ESSED DATE
	1649	"RTN","PSO DEAUT",105 ,0)
	1650	;
	1651	"RTN","PSO DEAUT",106 ,0)
	1652	S DS=$G(F G("drugSch edule"))
	1653	"RTN","PSO DEAUT",107 ,0)
	1654	S NPIEN=$ O(^VA(200, "PS4",DEA, 0))
	1655	"RTN","PSO DEAUT",108 ,0)
	1656	S RET(1)= RET(1)_$S( $$DETOXCHK ^PSODEAUT( BAC):"X"_$ E(FG("deaN umber"),2, 9),1:"")_" ^" ; DETO X NUMBER
	1657	"RTN","PSO DEAUT",109 ,0)
	1658	S RET(1)= RET(1)_$S( DS["22N":" YES",(DS[" 2"&(DS'["2 N")):"YES" ,1:"NO")_" ^" ; SCHE DULE II NA RCOTIC
	1659	"RTN","PSO DEAUT",110 ,0)
	1660	S RET(1)= RET(1)_$S( DS["2N":"Y ES",1:"NO" )_"^" ; SCHE DULE II NO N-NARCOTIC
	1661	"RTN","PSO DEAUT",111 ,0)
	1662	S RET(1)= RET(1)_$S( DS["33N":" YES",DS["3 "&(DS'["3N "):"YES",1 :"NO")_"^" ; SCHE DULE III N ARCOTIC
	1663	"RTN","PSO DEAUT",112 ,0)
	1664	S RET(1)= RET(1)_$S( DS["3N":"Y ES",1:"NO" )_"^" ; SCHE DULE III N ON-NARCOTI C
	1665	"RTN","PSO DEAUT",113 ,0)
	1666	S RET(1)= RET(1)_$S( DS["4":"YE S",1:"NO") _"^" ; SCHE DULE IV
	1667	"RTN","PSO DEAUT",114 ,0)
	1668	S RET(1)= RET(1)_$S( DS["5":"YE S",1:"NO") ; SCHE DULE V
	1669	"RTN","PSO DEAUT",115 ,0)
	1670	S RET(0)= "1^SUCCESS "
	1671	"RTN","PSO DEAUT",116 ,0)
	1672	Q
	1673	"RTN","PSO DEAUT",117 ,0)
	1674	;
	1675	"RTN","PSO DEAUT",118 ,0)
	1676	DEAREM(RET ,NPIEN,DEA TXT) ; Fu nctionalit y to remov e a DEA mu ltiple fro m file #20 0, Field 5 3.21
	1677	"RTN","PSO DEAUT",119 ,0)
	1678	; INPUT: NPIEN - N EW PERSON FILE #200 INTERNAL E NTRY NUMBE R
	1679	"RTN","PSO DEAUT",120 ,0)
	1680	; DEATXT - PROPERLY F ORMATTED D EA NUMBER
	1681	"RTN","PSO DEAUT",121 ,0)
	1682	; OUTPUT: RET - 1 f or SUCCESS , 0 for UN SUCCESSFUL
	1683	"RTN","PSO DEAUT",122 ,0)
	1684	N FDA,IEN S,MSGROOT, NPDEAIEN,D NDEAIEN,DE ATYPE,DA,D IE,DR
	1685	"RTN","PSO DEAUT",123 ,0)
	1686	S RET=0 Q :'$G(NPIEN ) Q:$G(DE ATXT)=""
	1687	"RTN","PSO DEAUT",124 ,0)
	1688	S NPDEAIE N=$O(^VA(2 00,NPIEN," PS4","B",D EATXT,0)) I 'NPDEAIE N Q
	1689	"RTN","PSO DEAUT",125 ,0)
	1690	S DNDEAIE N=$$GET1^D IQ(200.532 1,NPDEAIEN _","_NPIEN _",",.03," I")
	1691	"RTN","PSO DEAUT",126 ,0)
	1692	S DEATYPE =$$GET1^DI Q(8991.9,D NDEAIEN,.0 7,"I")
	1693	"RTN","PSO DEAUT",127 ,0)
	1694	S FDA(1,2 00.5321,NP DEAIEN_"," _NPIEN_"," ,.01)="@"
	1695	"RTN","PSO DEAUT",128 ,0)
	1696	S FDA(2,8 991.9,DNDE AIEN_",",. 01)="@"
	1697	"RTN","PSO DEAUT",129 ,0)
	1698	D UPDATE^ DIE(,"FDA( 1)",,"MSGR OOT") Q:$D (MSGROOT)
	1699	"RTN","PSO DEAUT",130 ,0)
	1700	I DNDEAIE N,DEATYPE= 2 D UPDATE ^DIE(,"FDA (2)",,"MSG ROOT") Q:$ D(MSGROOT)
	1701	"RTN","PSO DEAUT",131 ,0)
	1702	S RET=1
	1703	"RTN","PSO DEAUT",132 ,0)
	1704	Q
	1705	"RTN","PSO DEAUT",133 ,0)
	1706	;
	1707	"RTN","PSO DEAUT",134 ,0)
	1708	VIEWFM(RET ,DEA) ; - - Request for DEA In formation stored in DEA NUMBER S FILE #89 91.9, Retu rn DEA Inf ormation i n RET
	1709	"RTN","PSO DEAUT",135 ,0)
	1710	N DEAIEN, GETSTMP
	1711	"RTN","PSO DEAUT",136 ,0)
	1712	I $G(DEA) ="" S RET( 0)="0^INVA LID DEA NU MBER" Q
	1713	"RTN","PSO DEAUT",137 ,0)
	1714	S DEAIEN= $O(^XTV(89 91.9,"B",D EA,0)) I ' DEAIEN S R ET(0)="0^D EA NUMBER NOT FOUND" Q
	1715	"RTN","PSO DEAUT",138 ,0)
	1716	D GETS^DI Q(8991.9,D EAIEN,"**" ,"R","GETS TMP")
	1717	"RTN","PSO DEAUT",139 ,0)
	1718	I '$D(GET STMP) S RE T(0)="0^NO DATA FOUN D" Q
	1719	"RTN","PSO DEAUT",140 ,0)
	1720	S RET(0)= "1^SUCCESS "
	1721	"RTN","PSO DEAUT",141 ,0)
	1722	S CNT=0,N AME="" F S NAME=$O( GETSTMP(89 91.9,DEAIE N_",",NAME )) Q:NAME= "" D
	1723	"RTN","PSO DEAUT",142 ,0)
	1724	. S CNT=C NT+1,RET(C NT)=NAME_" ^"_GETSTMP (8991.9,DE AIEN_",",N AME)
	1725	"RTN","PSO DEAUT",143 ,0)
	1726	Q
	1727	"RTN","PSO DEAUT",144 ,0)
	1728	;
	1729	"RTN","PSO DEAUT",145 ,0)
	1730	FILEWS(RET ,ARRAY) ; -- File D EA Informa tion in AR RAY, Retur n the IEN Number fro m DEA NUMB ERS FILE # 8991.9
	1731	"RTN","PSO DEAUT",146 ,0)
	1732	N FG,NAME ,VALUE,CNT
	1733	"RTN","PSO DEAUT",147 ,0)
	1734	F CNT=1:1 :$O(ARRAY( ""),-1) S FG($P(ARRA Y(CNT),"^" ,1))=$P(AR RAY(CNT)," ^",2)
	1735	"RTN","PSO DEAUT",148 ,0)
	1736	I $G(FG(" deaNumber" ))="" S RE T(0)="0^IN VALID DEA NUMBER" Q
	1737	"RTN","PSO DEAUT",149 ,0)
	1738	I '$$DEAN UMFL(FG("d eaNumber") ) S RET(0) ="0^Invali d DEA Numb er due to error in f irst lette r" Q
	1739	"RTN","PSO DEAUT",150 ,0)
	1740	I '$$DEAN UM(FG("dea Number")) S RET(0)=" 0^Invalid DEA Number due to er ror in the numbers" Q
	1741	"RTN","PSO DEAUT",151 ,0)
	1742	S RET=$$D EACOPY^PSO DEAUT(.FG)
	1743	"RTN","PSO DEAUT",152 ,0)
	1744	Q
	1745	"RTN","PSO DEAUT",153 ,0)
	1746	;
	1747	"RTN","PSO DEAUT",154 ,0)
	1748	DEACOPY(FG ) ; -- Pri vate Subro utine to C opy import data in t he GETS Ar ray
	1749	"RTN","PSO DEAUT",155 ,0)
	1750	; POSTAL^ XIPUTL use d in agree ment with Integratio n Agreemen t: 3618
	1751	"RTN","PSO DEAUT",156 ,0)
	1752	;
	1753	"RTN","PSO DEAUT",157 ,0)
	1754	; INPUT: FG ;Web Servi ce Respons e Global
	1755	"RTN","PSO DEAUT",158 ,0)
	1756	;
	1757	"RTN","PSO DEAUT",159 ,0)
	1758	; VARIABL ES:
	1759	"RTN","PSO DEAUT",160 ,0)
	1760	N DS ;Single drug sched ule field as sent fr om the VA DOJ Web Se rvice.
	1761	"RTN","PSO DEAUT",161 ,0)
	1762	N XIP ;Used to calculate the state from a zi p code.
	1763	"RTN","PSO DEAUT",162 ,0)
	1764	N XSTATE ;Used to calculate the state from a zi p code.
	1765	"RTN","PSO DEAUT",163 ,0)
	1766	N BAC ;Busines s Activity Code
	1767	"RTN","PSO DEAUT",164 ,0)
	1768	N DTRESUL T
	1769	"RTN","PSO DEAUT",165 ,0)
	1770	;
	1771	"RTN","PSO DEAUT",166 ,0)
	1772	S DS=$G(F G("drugSch edule"))
	1773	"RTN","PSO DEAUT",167 ,0)
	1774	S GETS(.0 1)=$G(FG(" deaNumber" ))
	1775	"RTN","PSO DEAUT",168 ,0)
	1776	S BAC=$G( FG("busine ssActivity Code"))_$G (FG("busin essActivit ySubcode") )
	1777	"RTN","PSO DEAUT",169 ,0)
	1778	S GETS(.0 2)=BAC ; P ointer to file #8991 .8
	1779	"RTN","PSO DEAUT",170 ,0)
	1780	S GETS(.0 3)=$S($$GE TDNDTX^PSO DEAUT(NPIE N)'="":"", $$DETOXCHK ^PSODEAUT( BAC):"X"_$ E($G(FG("d eaNumber") ),2,9),1:" ") ; DETO X NUMBER
	1781	"RTN","PSO DEAUT",171 ,0)
	1782	D DT^DILF ("E",$G(FG ("expirati onDate")), .DTRESULT)
	1783	"RTN","PSO DEAUT",172 ,0)
	1784	S GETS(.0 4)=$G(DTRE SULT(0))
	1785	"RTN","PSO DEAUT",173 ,0)
	1786	S GETS(.0 7)=$G(FG(" type"))
	1787	"RTN","PSO DEAUT",174 ,0)
	1788	S GETS(1. 1)=$G(FG(" name"))
	1789	"RTN","PSO DEAUT",175 ,0)
	1790	S GETS(1. 2)=$G(FG(" address1") )
	1791	"RTN","PSO DEAUT",176 ,0)
	1792	S GETS(1. 3)=$G(FG(" address2") )
	1793	"RTN","PSO DEAUT",177 ,0)
	1794	S GETS(1. 4)=$G(FG(" address3") )
	1795	"RTN","PSO DEAUT",178 ,0)
	1796	S GETS(1. 5)=$G(FG(" city"))
	1797	"RTN","PSO DEAUT",179 ,0)
	1798	;
	1799	"RTN","PSO DEAUT",180 ,0)
	1800	; Special State Pro cessing
	1801	"RTN","PSO DEAUT",181 ,0)
	1802	S GETS(1. 6)=$G(FG(" state"))
	1803	"RTN","PSO DEAUT",182 ,0)
	1804	D POSTAL^ XIPUTIL($G (FG("zipCo de")),.XIP )
	1805	"RTN","PSO DEAUT",183 ,0)
	1806	S XSTATE= $G(XIP("ST ATE"))
	1807	"RTN","PSO DEAUT",184 ,0)
	1808	I XSTATE' ="" S GETS (1.6)=XSTA TE ; Point er to the State File #5.
	1809	"RTN","PSO DEAUT",185 ,0)
	1810	;
	1811	"RTN","PSO DEAUT",186 ,0)
	1812	S GETS(1. 7)=$G(FG(" zipCode"))
	1813	"RTN","PSO DEAUT",187 ,0)
	1814	;
	1815	"RTN","PSO DEAUT",188 ,0)
	1816	S GETS(2. 1)=$S(DS[" 22N":"YES" ,(DS["2"&( DS'["2N")) :"YES",1:" NO") ; SCH EDULE II N ARCOTIC
	1817	"RTN","PSO DEAUT",189 ,0)
	1818	S GETS(2. 2)=$S(DS[" 2N":"YES", 1:"NO") ; SCHEDULE I I NON-NARC OTIC
	1819	"RTN","PSO DEAUT",190 ,0)
	1820	S GETS(2. 3)=$S(DS[" 33N":"YES" ,(DS["3"&( DS'["3N")) :"YES",1:" NO") ; SCH EDULE III NARCOTIC
	1821	"RTN","PSO DEAUT",191 ,0)
	1822	S GETS(2. 4)=$S(DS[" 3N":"YES", 1:"NO") ; SCHEDULE I II NON-NAR COTIC
	1823	"RTN","PSO DEAUT",192 ,0)
	1824	S GETS(2. 5)=$S(DS[" 4":"YES",1 :"NO") ; S CHEDULE IV
	1825	"RTN","PSO DEAUT",193 ,0)
	1826	S GETS(2. 6)=$S(DS[" 5":"YES",1 :"NO") ; S CHEDULE V
	1827	"RTN","PSO DEAUT",194 ,0)
	1828	;
	1829	"RTN","PSO DEAUT",195 ,0)
	1830	D DT^DILF ("E",%DT,. DTRESULT)
	1831	"RTN","PSO DEAUT",196 ,0)
	1832	S GETS(10 .2)=$G(DTR ESULT(0)) ; LAST UP DATED DATE /TIME
	1833	"RTN","PSO DEAUT",197 ,0)
	1834	D DT^DILF ("E",$G(FG ("processe dDate")),. DTRESULT)
	1835	"RTN","PSO DEAUT",198 ,0)
	1836	S GETS(10 .3)=$G(DTR ESULT(0)) ; LAST DO J UPDATE D ATE/TIME
	1837	"RTN","PSO DEAUT",199 ,0)
	1838	S GETS(10 .1)=DUZ
	1839	"RTN","PSO DEAUT",200 ,0)
	1840	Q
	1841	"RTN","PSO DEAUT",201 ,0)
	1842	;
	1843	"RTN","PSO DEAUT",202 ,0)
	1844	FILEFM(RET ,DATA,NPIE N) ; -- F ile DEA In formation in the DEA NUMBERS F ILE #8991. 9
	1845	"RTN","PSO DEAUT",203 ,0)
	1846	N DNDEAIE N,DNDEATXT ,FDA,IENRO OT,IENS,MS GROOT,SUFF IX,XSTATE, XIP
	1847	"RTN","PSO DEAUT",204 ,0)
	1848	S RET=0
	1849	"RTN","PSO DEAUT",205 ,0)
	1850	I '$D(DAT A) S RET=0 G FILEFMX
	1851	"RTN","PSO DEAUT",206 ,0)
	1852	;
	1853	"RTN","PSO DEAUT",207 ,0)
	1854	S DNDEATX T=$P(DATA, U,11) I DN DEATXT="" G FILEFMX
	1855	"RTN","PSO DEAUT",208 ,0)
	1856	S DNDEAIE N=$O(^XTV( 8991.9,"B" ,DNDEATXT, 0))
	1857	"RTN","PSO DEAUT",209 ,0)
	1858	S IENS=$S ($G(DNDEAI EN):$G(DND EAIEN)_"," ,1:"+1,")
	1859	"RTN","PSO DEAUT",210 ,0)
	1860	;
	1861	"RTN","PSO DEAUT",211 ,0)
	1862	; INPUT: DATA - A STRING OF DEA INFORM ATION DELI MITED BY T HE "^"
	1863	"RTN","PSO DEAUT",212 ,0)
	1864	S FDA(1,8 991.9,IENS ,1.1)=$P(D ATA,U,1) ; 1 - PROVID ER NAME
	1865	"RTN","PSO DEAUT",213 ,0)
	1866	S FDA(1,8 991.9,IENS ,1.2)=$P(D ATA,U,2) ; 2 - ADDRES S 1
	1867	"RTN","PSO DEAUT",214 ,0)
	1868	S FDA(1,8 991.9,IENS ,1.3)=$P(D ATA,U,3) ; 3 - ADDRES S 2
	1869	"RTN","PSO DEAUT",215 ,0)
	1870	S FDA(1,8 991.9,IENS ,1.4)=$P(D ATA,U,4) ; 4 - ADDRES S 3
	1871	"RTN","PSO DEAUT",216 ,0)
	1872	S FDA(1,8 991.9,IENS ,1.5)=$P(D ATA,U,5) ; 5 - CITY
	1873	"RTN","PSO DEAUT",217 ,0)
	1874	;
	1875	"RTN","PSO DEAUT",218 ,0)
	1876	; Special State Pro cessing
	1877	"RTN","PSO DEAUT",219 ,0)
	1878	D POSTAL^ XIPUTIL($P (DATA,U,8) ,.XIP)
	1879	"RTN","PSO DEAUT",220 ,0)
	1880	S XSTATE= $G(XIP("ST ATE"))
	1881	"RTN","PSO DEAUT",221 ,0)
	1882	I XSTATE' ="" S FDA( 1,8991.9,I ENS,1.6)=X STATE ; 6 - STATE
	1883	"RTN","PSO DEAUT",222 ,0)
	1884	;
	1885	"RTN","PSO DEAUT",223 ,0)
	1886	S FDA(1,8 991.9,IENS ,1.7)=$P(D ATA,U,8) ; 8 - ZIP CO DE
	1887	"RTN","PSO DEAUT",224 ,0)
	1888	S FDA(1,8 991.9,IENS ,.02)=$P(D ATA,U,9) ; 9 - ACTIVI TY CODE
	1889	"RTN","PSO DEAUT",225 ,0)
	1890	S FDA(1,8 991.9,IENS ,.07)=$P(D ATA,U,10) ; 1 0 - TYPE
	1891	"RTN","PSO DEAUT",226 ,0)
	1892	S FDA(1,8 991.9,IENS ,.01)=$P(D ATA,U,11) ; 1 1 - DEA NU MBER
	1893	"RTN","PSO DEAUT",227 ,0)
	1894	S FDA(1,8 991.9,IENS ,.04)=$P(D ATA,U,12) ; 1 2 - EXPIRA TION DATE
	1895	"RTN","PSO DEAUT",228 ,0)
	1896	S FDA(1,8 991.9,IENS ,10.2)="N" ; 1 3 - PROCES SED DATE
	1897	"RTN","PSO DEAUT",229 ,0)
	1898	I $$DEANU M($P(DATA, U,14)) D ; O NLY CLEAR AND SET IF VALIDATED
	1899	"RTN","PSO DEAUT",230 ,0)
	1900	. I $P(DA TA,U,14)'= "" D CLEAR DTX(NPIEN) ; R EMOVE DETO X NUMBERS FROM OTHER DEA NUMBE RS
	1901	"RTN","PSO DEAUT",231 ,0)
	1902	. S FDA(1 ,8991.9,IE NS,.03)=$P (DATA,U,14 ) ; 1 4 - DETOX NUMBER
	1903	"RTN","PSO DEAUT",232 ,0)
	1904	S FDA(1,8 991.9,IENS ,2.1)=$P(D ATA,U,15) ; 1 5 - SCHDEU LE II NARC OTIC
	1905	"RTN","PSO DEAUT",233 ,0)
	1906	S FDA(1,8 991.9,IENS ,2.2)=$P(D ATA,U,16) ; 1 6 - SCHEDU LE II NON- NARCOTIC
	1907	"RTN","PSO DEAUT",234 ,0)
	1908	S FDA(1,8 991.9,IENS ,2.3)=$P(D ATA,U,17) ; 1 7 - SCHEDU LE III NAR COTIC
	1909	"RTN","PSO DEAUT",235 ,0)
	1910	S FDA(1,8 991.9,IENS ,2.4)=$P(D ATA,U,18) ; 1 8 - SCHEDU LE III NON -NARCOTIC
	1911	"RTN","PSO DEAUT",236 ,0)
	1912	S FDA(1,8 991.9,IENS ,2.5)=$P(D ATA,U,19) ; 1 9 - SCHEDU LE IV
	1913	"RTN","PSO DEAUT",237 ,0)
	1914	S FDA(1,8 991.9,IENS ,2.6)=$P(D ATA,U,20) ; 2 0 - SCHEDU LE V
	1915	"RTN","PSO DEAUT",238 ,0)
	1916	S FDA(1,8 991.9,IENS ,.06)=$P(D ATA,U,21) ; 2 1 - USE FO R INPATIEN T FLAG
	1917	"RTN","PSO DEAUT",239 ,0)
	1918	S SUFFIX= $P(DATA,U, 22) ; 2 2 - DEA IN STITUTIONA L SUFFIX
	1919	"RTN","PSO DEAUT",240 ,0)
	1920	;
	1921	"RTN","PSO DEAUT",241 ,0)
	1922	D UPDATE^ DIE("E","F DA(1)","IE NROOT","MS GROOT")
	1923	"RTN","PSO DEAUT",242 ,0)
	1924	I $D(MSGR OOT) S RET ="0^DATA D IDN'T FILE SUCCESSFU LLY." G FI LEFMX
	1925	"RTN","PSO DEAUT",243 ,0)
	1926	S DNDEAIE N=$S($D(IE NROOT(1)): IENROOT(1) _",",1:IEN S)
	1927	"RTN","PSO DEAUT",244 ,0)
	1928	I '+DNDEA IEN S RET= "0^DATA DI DN'T FILE SUCCESSFUL LY." G FIL EFMX
	1929	"RTN","PSO DEAUT",245 ,0)
	1930	S FDA(2,8 991.9,DNDE AIEN,10.1) =$G(DUZ) D FILE^DIE( "","FDA(2) ","MSGROOT ")
	1931	"RTN","PSO DEAUT",246 ,0)
	1932	S:DNDEAIE N RET=+DND EAIEN_"^SU CCESSFULLY SAVED/UPD ATED IN 89 91.9"
	1933	"RTN","PSO DEAUT",247 ,0)
	1934	I $L(DNDE ATXT),$G(N PIEN),$G(D NDEAIEN) S RET=RET_" ^"_$$NPFIL E(DNDEATXT ,NPIEN,DND EAIEN,SUFF IX)
	1935	"RTN","PSO DEAUT",248 ,0)
	1936	I RET,$P( DATA,U,21) ="YES" S F DA(200,NPI EN_",",53. 2)=$P(DATA ,U,11) D U PDATE^DIE( ,"FDA")
	1937	"RTN","PSO DEAUT",249 ,0)
	1938	FILEFMX ; -- Subrou tine Exit Point
	1939	"RTN","PSO DEAUT",250 ,0)
	1940	Q
	1941	"RTN","PSO DEAUT",251 ,0)
	1942	;
	1943	"RTN","PSO DEAUT",252 ,0)
	1944	NPFILE(DND EATXT,NPIE N,DNDEAIEN ,SUFFIX) ; -- File t he DEA NUM BER in the NEW PERSO N FILE #20 0.
	1945	"RTN","PSO DEAUT",253 ,0)
	1946	N FDA,IEN ,IENROOT,M SGROOT
	1947	"RTN","PSO DEAUT",254 ,0)
	1948	Q:'$G(NPI EN) Q:'$G (DNDEAIEN)
	1949	"RTN","PSO DEAUT",255 ,0)
	1950	S IEN="+1 ,"
	1951	"RTN","PSO DEAUT",256 ,0)
	1952	I $D(^VA( 200,NPIEN, "PS4","B", DNDEATXT)) S IEN=$O( ^VA(200,NP IEN,"PS4", "B",DNDEAT XT,0))_","
	1953	"RTN","PSO DEAUT",257 ,0)
	1954	S FDA(1,2 00.5321,IE N_NPIEN_", ",.01)=DND EATXT
	1955	"RTN","PSO DEAUT",258 ,0)
	1956	S FDA(1,2 00.5321,IE N_NPIEN_", ",.02)=SUF FIX
	1957	"RTN","PSO DEAUT",259 ,0)
	1958	S FDA(1,2 00.5321,IE N_NPIEN_", ",.03)=+DN DEAIEN
	1959	"RTN","PSO DEAUT",260 ,0)
	1960	D UPDATE^ DIE("","FD A(1)","IEN ROOT","MSG ROOT")
	1961	"RTN","PSO DEAUT",261 ,0)
	1962	I $D(MSGR OOT) Q "0^ DATA DIDN' T FILE SUC CESSFULLY. "
	1963	"RTN","PSO DEAUT",262 ,0)
	1964	Q "1^SUCC ESSFULLY S AVED/UPDAT ED IN 200"
	1965	"RTN","PSO DEAUT",263 ,0)
	1966	;
	1967	"RTN","PSO DEAUT",264 ,0)
	1968	PROVTYPE(B A) ; -- C alculate t he Provide r Type fro m the Busi ness Activ ity Code.
	1969	"RTN","PSO DEAUT",265 ,0)
	1970	N RESULT S RESULT=" 1^INSTITUT IONAL"
	1971	"RTN","PSO DEAUT",266 ,0)
	1972	S:$G(BA)= "" RESULT= "2^INDIVID UAL"
	1973	"RTN","PSO DEAUT",267 ,0)
	1974	S:$E(BA)= "C" RESULT ="2^INDIVI DUAL"
	1975	"RTN","PSO DEAUT",268 ,0)
	1976	S:$E(BA)= "M" RESULT ="2^INDIVI DUAL"
	1977	"RTN","PSO DEAUT",269 ,0)
	1978	Q RESULT
	1979	"RTN","PSO DEAUT",270 ,0)
	1980	;
	1981	"RTN","PSO DEAUT",271 ,0)
	1982	CONVNAME(C N) ; -- S et up a NA ME convers ion array.
	1983	"RTN","PSO DEAUT",272 ,0)
	1984	S CN("add ress1")="A DDRESS 1"
	1985	"RTN","PSO DEAUT",273 ,0)
	1986	S CN("add ress2")="A DDRESS 2"
	1987	"RTN","PSO DEAUT",274 ,0)
	1988	S CN("add ress3")="A DDRESS 3"
	1989	"RTN","PSO DEAUT",275 ,0)
	1990	S CN("bus inessActiv ityCode")= "ACTIVITY CODE"
	1991	"RTN","PSO DEAUT",276 ,0)
	1992	S CN("bus inessActiv itySubcode ")="ACTIVI TY SUB"
	1993	"RTN","PSO DEAUT",277 ,0)
	1994	S CN("cit y")="CITY"
	1995	"RTN","PSO DEAUT",278 ,0)
	1996	S CN("dea Number")=" DEA NUMBER "
	1997	"RTN","PSO DEAUT",279 ,0)
	1998	S CN("dru gSchedule" )="DRUG SC HEDULE"
	1999	"RTN","PSO DEAUT",280 ,0)
	2000	S CN("exp irationDat e")="EXPIR ATION DATE "
	2001	"RTN","PSO DEAUT",281 ,0)
	2002	S CN("nam e")="NAME"
	2003	"RTN","PSO DEAUT",282 ,0)
	2004	S CN("pro cessedDate ")="PROCES SED DATE"
	2005	"RTN","PSO DEAUT",283 ,0)
	2006	S CN("sta te")="STAT E"
	2007	"RTN","PSO DEAUT",284 ,0)
	2008	S CN("typ e")="TYPE"
	2009	"RTN","PSO DEAUT",285 ,0)
	2010	S CN("zip Code")="ZI P CODE"
	2011	"RTN","PSO DEAUT",286 ,0)
	2012	Q
	2013	"RTN","PSO DEAUT",287 ,0)
	2014	;
	2015	"RTN","PSO DEAUT",288 ,0)
	2016	GETS(DEAIE N,GETS) ; -- Get th e existing data from the DEA N UMBERS FIL E #8991.9
	2017	"RTN","PSO DEAUT",289 ,0)
	2018	N GETSTMP
	2019	"RTN","PSO DEAUT",290 ,0)
	2020	D GETS^DI Q(8991.9,D EAIEN,"**" ,"","GETST MP")
	2021	"RTN","PSO DEAUT",291 ,0)
	2022	M GETS=GE TSTMP(8991 .9,DEAIEN_ ",")
	2023	"RTN","PSO DEAUT",292 ,0)
	2024	Q
	2025	"RTN","PSO DEAUT",293 ,0)
	2026	;
	2027	"RTN","PSO DEAUT",294 ,0)
	2028	DEANUM(X) ; -- Check DEA # par t
	2029	"RTN","PSO DEAUT",295 ,0)
	2030	N VA1,VA2
	2031	"RTN","PSO DEAUT",296 ,0)
	2032	S VA1=$E( X,3)+$E(X, 5)+$E(X,7) +(2*($E(X, 4)+$E(X,6) +$E(X,8)))
	2033	"RTN","PSO DEAUT",297 ,0)
	2034	S VA1=VA1 #10,VA2=$E (X,9)
	2035	"RTN","PSO DEAUT",298 ,0)
	2036	Q VA1=VA2
	2037	"RTN","PSO DEAUT",299 ,0)
	2038	;
	2039	"RTN","PSO DEAUT",300 ,0)
	2040	DEANUMFL(X ) ;Check D EA # First Letter Pa rt
	2041	"RTN","PSO DEAUT",301 ,0)
	2042	Q $S("ABF G"[$E(X):1 ,1:0)
	2043	"RTN","PSO DEAUT",302 ,0)
	2044	;
	2045	"RTN","PSO DEAUT",303 ,0)
	2046	DUPCHK(RET ,DEATXT,SU FFIX) ; - - Check fo r duplicat e DEA numb er or dupl icate SUFF IX usage.
	2047	"RTN","PSO DEAUT",304 ,0)
	2048	; INPUTS: DEATXT - The text format of a DEA Numb er
	2049	"RTN","PSO DEAUT",305 ,0)
	2050	; SUFFIX - The DEA s uffix for an Institu tional DEA number
	2051	"RTN","PSO DEAUT",306 ,0)
	2052	I $G(DEAT XT)="" S R ET="0^No D EA number supplied" Q
	2053	"RTN","PSO DEAUT",307 ,0)
	2054	S SUFFIX= $G(SUFFIX)
	2055	"RTN","PSO DEAUT",308 ,0)
	2056	S RET="1^ Success"
	2057	"RTN","PSO DEAUT",309 ,0)
	2058	I SUFFIX= "",$D(^VA( 200,"PS4", DEATXT)) S RET="0^Pr ovider DEA number is already a ssociated to another profile. Please che ck the num ber entere d." Q
	2059	"RTN","PSO DEAUT",310 ,0)
	2060	I SUFFIX' ="",$D(^VA (200,"F",D EATXT,SUFF IX)) S RET ="0^Duplic ate Usage of a SUFFI X" Q
	2061	"RTN","PSO DEAUT",311 ,0)
	2062	Q
	2063	"RTN","PSO DEAUT",312 ,0)
	2064	;
	2065	"RTN","PSO DEAUT",313 ,0)
	2066	DETOXCHK(B AC) ; -- Test Busin ess Activi ty Code fo r DEXTOX ( DW)
	2067	"RTN","PSO DEAUT",314 ,0)
	2068	N BACIEN
	2069	"RTN","PSO DEAUT",315 ,0)
	2070	I $G(BAC) ="" Q 0
	2071	"RTN","PSO DEAUT",316 ,0)
	2072	I '$D(^XT V(8991.8," B",BAC)) Q 0
	2073	"RTN","PSO DEAUT",317 ,0)
	2074	S BACIEN= $O(^XTV(89 91.8,"B",B AC,0)) I ' BACIEN Q 0
	2075	"RTN","PSO DEAUT",318 ,0)
	2076	I $$GET1^ DIQ(8991.8 ,BACIEN,1) ["DW/" Q 1
	2077	"RTN","PSO DEAUT",319 ,0)
	2078	Q 0
	2079	"RTN","PSO DEAUT",320 ,0)
	2080	;
	2081	"RTN","PSO DEAUT",321 ,0)
	2082	MBM(RET) ; -- MEDS B Y MAIL for ePCS GUI
	2083	"RTN","PSO DEAUT",322 ,0)
	2084	N SYS
	2085	"RTN","PSO DEAUT",323 ,0)
	2086	S RET=0
	2087	"RTN","PSO DEAUT",324 ,0)
	2088	S SYS=$$G ET^XPAR("S YS^PKG","P SO VAMC MB M PHARMACY MODE",1," E")
	2089	"RTN","PSO DEAUT",325 ,0)
	2090	I SYS="MB M" S RET=1
	2091	"RTN","PSO DEAUT",326 ,0)
	2092	Q
	2093	"RTN","PSO DEAUT",327 ,0)
	2094	;
	2095	"RTN","PSO DEAUT",328 ,0)
	2096	ENTRY(RESU LT,INPUT) ; -- remot eprocedure
	2097	"RTN","PSO DEAUT",329 ,0)
	2098	NEW I,NOW
	2099	"RTN","PSO DEAUT",330 ,0)
	2100	SET NOW=$ P($$HTE^XL FDT($H),": ",1,2)
	2101	"RTN","PSO DEAUT",331 ,0)
	2102	FOR I=-1: 0 SET I=$O (INPUT(I)) QUIT:I="" DO RECOR D(INPUT(I) ,NOW)
	2103	"RTN","PSO DEAUT",332 ,0)
	2104	SET RESUL T=1
	2105	"RTN","PSO DEAUT",333 ,0)
	2106	QUIT
	2107	"RTN","PSO DEAUT",334 ,0)
	2108	;
	2109	"RTN","PSO DEAUT",335 ,0)
	2110	RECORD(LIN E,NOW) ;
	2111	"RTN","PSO DEAUT",336 ,0)
	2112	N FDA,VAL UE,IEN,MSG ,I
	2113	"RTN","PSO DEAUT",337 ,0)
	2114	FOR I=1:1 :5 SET VAL UE=$P(LINE ,U,I),FDA( 8991.6,"+1 ,",(I/100) )=VALUE
	2115	"RTN","PSO DEAUT",338 ,0)
	2116	SET FDA(8 991.6,"+1, ",.06)=NOW
	2117	"RTN","PSO DEAUT",339 ,0)
	2118	DO UPDATE ^DIE("E"," FDA","IEN" ,"MSG")
	2119	"RTN","PSO DEAUT",340 ,0)
	2120	QUIT
	2121	"RTN","PSO DEAUT",341 ,0)
	2122	;
	2123	"RTN","PSO DEAUT",342 ,0)
	2124	CLEARDTX(N PIEN) ; R EMOVE DETO X NUMBERS FROM ALL O F A PROVID ERS DEA NU MBERS
	2125	"RTN","PSO DEAUT",343 ,0)
	2126	N DNDEAIE N,FDA,NPDE AIEN
	2127	"RTN","PSO DEAUT",344 ,0)
	2128	S NPDEAIE N=0 F S N PDEAIEN=$O (^VA(200,N PIEN,"PS4" ,NPDEAIEN) ) Q:'NPDEA IEN D
	2129	"RTN","PSO DEAUT",345 ,0)
	2130	. S DNDEA IEN=$$GET1 ^DIQ(200.5 321,NPDEAI EN_","_NPI EN_",",.03 ,"I")
	2131	"RTN","PSO DEAUT",346 ,0)
	2132	. K FDA S FDA(1,899 1.9,DNDEAI EN_",",.03 )="@" D UP DATE^DIE(" ","FDA(1)" ) K FDA
	2133	"RTN","PSO DEAUT",347 ,0)
	2134	Q
	2135	"RTN","PSO DEAUT",348 ,0)
	2136	;
	2137	"RTN","PSO DEAUT",349 ,0)
	2138	GETDNDTX(N PIEN) ; G ET A SINGL E DETOX NU MBER FROM ALL OF A P ROVIDERS D EA NUMBERS IN 8991.9
	2139	"RTN","PSO DEAUT",350 ,0)
	2140	N GETDNDT X,DNDEAIEN ,NPDEAIEN S GETDNDTX =""
	2141	"RTN","PSO DEAUT",351 ,0)
	2142	S NPDEAIE N=0 F S N PDEAIEN=$O (^VA(200,N PIEN,"PS4" ,NPDEAIEN) ) Q:'NPDEA IEN Q:$L( GETDNDTX) D
	2143	"RTN","PSO DEAUT",352 ,0)
	2144	. S DNDEA IEN=$$GET1 ^DIQ(200.5 321,NPDEAI EN_","_NPI EN_",",.03 ,"I") Q:'D NDEAIEN
	2145	"RTN","PSO DEAUT",353 ,0)
	2146	. S GETDN DTX=$$GET1 ^DIQ(8991. 9,DNDEAIEN _",",.03)
	2147	"RTN","PSO DEAUT",354 ,0)
	2148	Q GETDNDT X
	2149	"RTN","PSO DEAUT",355 ,0)
	2150	;
	2151	"RTN","PSO DEAUT",356 ,0)
	2152	WSGET(FG,D EA) ; Func tion to Ge t the Remo te DEA inf ormation, Return in FG.
	2153	"RTN","PSO DEAUT",357 ,0)
	2154	; INPUT: DEA ;Properly formatted DEA Numbe r for look up.
	2155	"RTN","PSO DEAUT",358 ,0)
	2156	;
	2157	"RTN","PSO DEAUT",359 ,0)
	2158	; OUTPUT: FG ;Web Serv ice Respon se Global
	2159	"RTN","PSO DEAUT",360 ,0)
	2160	;
	2161	"RTN","PSO DEAUT",361 ,0)
	2162	; RETURN: Status c ode with a text mess age.
	2163	"RTN","PSO DEAUT",362 ,0)
	2164	; If not f illed succ essfully a "0^Error Message" w ill be ret urned.
	2165	"RTN","PSO DEAUT",363 ,0)
	2166	;
	2167	"RTN","PSO DEAUT",364 ,0)
	2168	; VARIABL ES:
	2169	"RTN","PSO DEAUT",365 ,0)
	2170	N DATA ;The bo dy portion of the RE SPONSE obj ect.
	2171	"RTN","PSO DEAUT",366 ,0)
	2172	N ERRORS ;Errors that may be returne d from the JSON to M UMPS conve rtion.
	2173	"RTN","PSO DEAUT",367 ,0)
	2174	; FG ;The JS ON string converted to a MUMPS global.
	2175	"RTN","PSO DEAUT",368 ,0)
	2176	N REQUEST ;The we b service object.
	2177	"RTN","PSO DEAUT",369 ,0)
	2178	N RESOURC E ;Input variable f or the $$G ET^XOBWLIB call, in this case the DEA nu mber.
	2179	"RTN","PSO DEAUT",370 ,0)
	2180	N RESPJSO N ;Used t o store th e JSON res ponse in t he DATA ob ject into a single l ine string .
	2181	"RTN","PSO DEAUT",371 ,0)
	2182	N RESPONS E ;The re sponse obj ect portio n of the R EQUEST obj ect.
	2183	"RTN","PSO DEAUT",372 ,0)
	2184	N SC ;Status Code resp onse from the $$GET^ XOBWLIB ca ll.
	2185	"RTN","PSO DEAUT",373 ,0)
	2186	N SERVER ;The we b server i dentifier.
	2187	"RTN","PSO DEAUT",374 ,0)
	2188	N SERVICE ;The we b service identifier .
	2189	"RTN","PSO DEAUT",375 ,0)
	2190	N XU ;Left o ver variab le from th e XOBWLIB processes.
	2191	"RTN","PSO DEAUT",376 ,0)
	2192	N PSOERR ;Left o ver variab le from th e XOBWLIB processes.
	2193	"RTN","PSO DEAUT",377 ,0)
	2194	;
	2195	"RTN","PSO DEAUT",378 ,0)
	2196	Q:$G(DEA) ="" "0^No DEA Number Entered."
	2197	"RTN","PSO DEAUT",379 ,0)
	2198	S SERVER= "PSO DOJ/D EA WEB SER VER"
	2199	"RTN","PSO DEAUT",380 ,0)
	2200	S SERVICE ="PSO DOJ/ DEA WEB SE RVICE"
	2201	"RTN","PSO DEAUT",381 ,0)
	2202	S RESOURC E=DEA
	2203	"RTN","PSO DEAUT",382 ,0)
	2204	;
	2205	"RTN","PSO DEAUT",383 ,0)
	2206	; Get an instance o f the REST request o bject.
	2207	"RTN","PSO DEAUT",384 ,0)
	2208	S REQUEST =$$GETREST ^XOBWLIB(S ERVICE,SER VER)
	2209	"RTN","PSO DEAUT",385 ,0)
	2210	;
	2211	"RTN","PSO DEAUT",386 ,0)
	2212	; Execute the HTTP Get method .
	2213	"RTN","PSO DEAUT",387 ,0)
	2214	S SC=$$GE T^XOBWLIB( REQUEST,RE SOURCE,.PS OERR,0)
	2215	"RTN","PSO DEAUT",388 ,0)
	2216	I 'SC Q " 0^General Service Er ror"
	2217	"RTN","PSO DEAUT",389 ,0)
	2218	;
	2219	"RTN","PSO DEAUT",390 ,0)
	2220	; Process the respo nse. REQU EST(O) -> RESPONSE(0 ) -> DATA( S) -> RESP JSON(S)
	2221	"RTN","PSO DEAUT",391 ,0)
	2222	S RESPONS E=REQUEST. HttpRespon se
	2223	"RTN","PSO DEAUT",392 ,0)
	2224	S DATA=RE SPONSE.Dat a
	2225	"RTN","PSO DEAUT",393 ,0)
	2226	S RESPJSO N=""
	2227	"RTN","PSO DEAUT",394 ,0)
	2228	;
	2229	"RTN","PSO DEAUT",395 ,0)
	2230	F Q:DATA .AtEnd Se t RESPJSON =RESPJSON_ DATA.ReadL ine()
	2231	"RTN","PSO DEAUT",396 ,0)
	2232	S RESPJSO N=$TR(RESP JSON,$C(10 ),"")
	2233	"RTN","PSO DEAUT",397 ,0)
	2234	I RESPJSO N="" Q "0^ No Data Re turned."
	2235	"RTN","PSO DEAUT",398 ,0)
	2236	;
	2237	"RTN","PSO DEAUT",399 ,0)
	2238	; Decode the JSON f ormat into a MUMPS g lobal in F G
	2239	"RTN","PSO DEAUT",400 ,0)
	2240	D DECODE^ XLFJSON("R ESPJSON"," FG","ERROR S")
	2241	"RTN","PSO DEAUT",401 ,0)
	2242	;
	2243	"RTN","PSO DEAUT",402 ,0)
	2244	; Handle a "DEA NOT FOUND" gr acefully.
	2245	"RTN","PSO DEAUT",403 ,0)
	2246	I FG("dea Number")=" DEA NOT FO UND" Q "0^ DEA NUMBER NOT FOUND . Please e nter the p rovider's DEA number ."
	2247	"RTN","PSO DEAUT",404 ,0)
	2248	;
	2249	"RTN","PSO DEAUT",405 ,0)
	2250	; Define the TYPE f ield
	2251	"RTN","PSO DEAUT",406 ,0)
	2252	S FG("typ e")=$P($$P ROVTYPE^PS ODEAUT(FG( "businessA ctivityCod e")),"^",2 )
	2253	"RTN","PSO DEAUT",407 ,0)
	2254	;
	2255	"RTN","PSO DEAUT",408 ,0)
	2256	; Default the busin essActivit ySubcode.
	2257	"RTN","PSO DEAUT",409 ,0)
	2258	I $G(FG(" businessAc tivitySubc ode"))="" S FG("busi nessActivi tySubcode" )=0
	2259	"RTN","PSO DEAUT",410 ,0)
	2260	;
	2261	"RTN","PSO DEAUT",411 ,0)
	2262	Q "1^Succ ess"
	2263	"RTN","PSO DEAUT",412 ,0)
	2264	;
	2265	"VER")
	2266	8.0^22.2
	2267	END
	2268	END