2. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 10/24/2017 8:44:06 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.

2.1 Files compared

#	Location	File	Last Modified
1	OneVA_Pharmacy_CAS_MPDU_Build-1_CIF_Package.zip\OneVA_Pharmacy_CAS_MPDU_Build-1_CIF_Package\OneVA_Pharmacy_CAS_MPDU_Build-1_Patch_Descriptions	PSO_7_497_TEST_v1.txt	Mon Oct 16 18:22:26 2017 UTC
2	OneVA_Pharmacy_CAS_MPDU_Build-1_CIF_Package.zip\OneVA_Pharmacy_CAS_MPDU_Build-1_CIF_Package\OneVA_Pharmacy_CAS_MPDU_Build-1_Patch_Descriptions	PSO_7_497_TEST_v1.txt	Tue Oct 24 13:25:10 2017 UTC

2.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	5	5062
Changed	4	10
Inserted	0	0
Removed	0	0

2.3 Comparison options

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

2.4 Active regular expressions

No regular expressions were active.

2.5 Comparison detail

	1	DEVICE: HO ME// 0;80; 999 SSH V IRTUAL TER MINAL
	2
	3	\x000CMailMan m essage for FISHER,BR ADLEY DEV ELOPER
	4	Printed at FORUM.VA. GOV 10/16 /17@13:20
	5	Subj: PSO* 7*497 TEST v1 [#861 47425] 10/ 09/17@12:4 4 2355 li nes
	6	From: NPM [#861474 25] In 'I N' basket. Page 1
	7	---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
	8	$TXT Creat ed by FISH ER,BRADLEY at D NS (KIDS) on Monday, 10 /09/
	9	17 at 11:3 0
	10	========== ========== ========== ========== ========== ========== ========== =======
	11	Run Date: OCT 09, 20 17 Designa tion: PSO* 7*497
	12	Package : PSO - OUTP ATIENT PHA RMACY Prio rity: Mand atory
	13	Version : 7 St atus: Unde r Developm ent
	14	========== ========== ========== ========== ========== ========== ========== =======
	15
	16	Associated patches: (v)PSO74 54 <<= m ust be ins talled BEF ORE `PSO7 497'
	17	(v)PSO74 75 <<= m ust be ins talled BEF ORE `PSO7 497'
	18	(v)PSO74 79 <<= m ust be ins talled BEF ORE `PSO7 497'
	19	(v)PSO74 88 <<= m ust be ins talled BEF ORE `PSO7 497'
	20
	21	Subject: O NEVA PHARM ACY CRITIC AL DEFECTS
	22
	23	Category:
	24	- Routin e
	25	- Data D ictionary
	26
	27	Descriptio n:
	28	========== ==
	29
	30	The PSO7 .0497 pat ch address es the MPD U OneVA Ph armacy cri tical defe cts.
	31	This patc h resolves critical defects fo r the foll owing item s:
	32	1.) Auto- suspend
	33	2.) Block ing prescr iptions th at contain a trade n ame
	34	3.) Block ing refill s for titr ation pres criptions
	35	4.) Acces s controls - check t o ensure t he user ha s the PSOR PH key in
	36	order to remote ly refill or partial fill pres cription.
	37	5.) Movem ent of the OneVA pha rmacy flag from file 59 (Outpa tient
	38	site) to file 5 9.7 (Pharm acy Site). This incl udes updat es to the logic
	39	that checks the status of the flag for remote prescript ion proces sing.
	40
	41	Patch Com ponents:
	42	--------- --------
	43
	44	Files & F ields Asso ciated:
	45
	46	File Name (Number) Fi eld Name ( Number) New/Modi fied/Delet ed
	47	--------- --------- -- ---------- ------- -------- ---------- --
	48	PHARMACY SYSTEM (#5 9.7) ON EVA PHARMA CY FLAG New
	49	(# 101)
	50
	51	Forms Ass ociated:
	52	--------- --------
	53	N/A
	54
	55	List Temp lates Asso ciated:
	56	--------- ---------- -------
	57	N/A
	58
	59
	60	Mail Grou ps Associa ted:
	61	--------- ---------- ----
	62	N/A
	63
	64
	65	Options A ssociated:
	66	--------- ----------
	67	N/A
	68
	69
	70	Protocols Associate d:
	71
	72	Protocol Name N ew/Modifie d/Deleted
	73	--------- ---- - ---------- ---------
	74	PSO LM RE FILL REMOT E ORDER Modifie d
	75	PSO LM RE MOTE ORDER MENU Modifie d
	76	PSO LM RE MOTE PARTI AL Modifie d
	77
	78	Remote Pr ocedure Ca lls:
	79	--------- ---------- ----
	80	N/A
	81
	82	Security Keys Assoc iated:
	83	--------- ---------- ------
	84	N/A
	85
	86	Templates Associate d:
	87	--------- ---------- --
	88	N/A
	89
	90	Additiona l Informat ion:
	91	--------- ---------- ----
	92	N/A
	93
	94	New Servi ce Request s (NSRs):
	95	--------- ---------- ---------
	96	N/A
	97
	98	Patient S afety Issu es (PSIs):
	99	--------- ---------- ----------
	100	N/A
	101
	102	Remedy Ti cket(s) & Overview:
	103	--------- ---------- ---------
	104
	105	1. I12092 772FY17 - ONEVA PHAR MACY FILL -- INITIAT ED BY USER WITHOUT P SORPH
	106
	107	Problem:
	108	--------
	109	The syste m allowed a pharmacy student ( w/o PSORPH ) to fill a OneVa re fill
	110	from anot her site. The system is allowi ng a non-p harmacist to make a
	111	determina tion about what drug from the local drug file will be dispen sed
	112	to satisf y the remo te rx (i.e a clinica l decision ). Also, w e are conc erned
	113	that all resulting displays ( and the fi leman fiel d labels i n the
	114	underlyin g data) li st this us er as "the pharmacis t" who com pleted the
	115	activity.
	116
	117	Resolutio n:
	118	--------- --
	119	The actio n protocol s for refi lling and partially filling re mote
	120	prescript ions has b een modifi ed to incl ude screen ing logic that check s
	121	will inac tivate the action if the user does not p osess the PSORPH key . Add
	122	screening logic to the associ ated menu protocol s o the acti on protoco ls
	123	will acti vate.
	124
	125	Technical Resolutio n:
	126	--------- ---------- --
	127	Screening logic add ed to PSO LM REFILL REMOTE ORD ER and PSO LM REMOTE
	128	PARTIAL:
	129
	130	I $$PSORP H^PSORRX2( DUZ)
	131
	132	Screening logic add ed to PSO LM REMOTE ORDER MENU to activa te screeni ng
	133	logic on action pro tocols:
	134
	135	I 1 X:$D( ^ORD(101,+ $P(^ORD(10 1,DA(1),10 ,DA,0),""" ^""",1),24 )) ^(24)
	136
	137
	138	2. I12204 814FY17 - OneVA Pres cription - Blank Act ivity, Sus pended Ref ill
	139	Request
	140
	141	Problem:
	142	--------
	143	Finding b lank activ ity and a suspense a ction on a refill re quested fr om
	144	another s ite via On eVA softwa re. Please refer to associated tickets
	145	R12129538 FY17, I121 50112FY17 , and I121 25069FY17.
	146
	147	Scenario:
	148	1.) A pre scription is origina lly filled at a 'hos t' site.
	149	2.) Some gap in tim e that exc eeds the d ays supply .
	150	3.) The p rescriptio n is refil led again at the 'ho st' site.
	151	4.) A sub sequent 'r emote' ref ill is att empted by a dispensi ng site ot her
	152	than the 'host' site.
	153	5.) This causes the prescript ion at the 'host' si te to be p laced in
	154	suspe nse due to the curre nt algorit hm not sto pping the prescripti on
	155	from being fill ed.
	156
	157	It has be en identif ied that l ogic assoc iated with the corre ct check f or a
	158	'fill too soon' sce nario (i.e auto-susp end) was w riting res ults to th e
	159	screen in a backgro und proces sing scena rio. Inste ad, the lo gic should
	160	have buil t a return message a nd quit pr ocessing. This messa ge should
	161	have then been sent back to t he remote site tryin g to refil l the host
	162	site pres cription.
	163
	164
	165	Resolutio n:
	166	--------- --
	167	Routine P SORREF0 ha s been mod ified to c orrectly c heck for t he auto-su spend
	168	Scenario. If the re quested fi ll date is less than the next possible f ill
	169	date on t he prescri ption, a m essage is created an d the pres cription r efill
	170	process s tops.
	171
	172	Technical Resolutio n:
	173	--------- ---------- --
	174	Modificat ion at EDA TE+7^PSORR EF0. Comme nted out c hecks that do not ap ply
	175	and modif ied the fi nal check so we are not checki ng the "EA OK" parame ter
	176	or the au to-suspend parameter . The EAOK and auto- suspend pa rameters d o not
	177	apply to OneVA phar macy. Comm ented code is being left in pl ace for
	178	reference by future Developer s/support.
	179
	180	; PSO74 97 - remov ing this c heck, as i t is not n eeded.
	181	;I
	182	'$P(PSOPA R,"^",6),' $D(PSOREF( "EAOK")),$ P(PSOREF(" RX3"),"^", 2)>PSOREF( "FILL
	183	DATE") D
	184	;. S PSOX 1=(PSOREF( "NUMBER")+ 1)*PSOREF( "DAYS SUPP LY")-10
	185	;. ; PSO* 7*497 - re placing li ne below w ith one th at follows
	186	(auto-sus pend defec t - do not allow byp ass)
	187	;. ;W !?5 ,$C(7),"LE SS THAN ", PSOX1," DA YS FOR ",P SOREF("NUM BER")+1,"
	188	FILLS",! D DIR K PS OX1
	189	;. S PSOR MSG(1)="LE SS THAN "_ PSOX1_" DA YS FOR "_P SOREF("NUM BER")+1_"
	190	FILLS" S (PSOREF("D FLG"),PSOM HV)=1 K PS OX1
	191	; PSO(7*4 97 - repla cing line below with the one t hat follow s - EAOK
	192	check and auto-susp end flag a re irrelev ant for on eva pharma cy
	193	;I
	194	'$P(PSOPA R,"^",6),$ G(PSOREF(" EAOK"))=0, $P(PSOREF( "RX3"),"^" ,2)>PSOREF ("FIL
	195	L DATE") D
	196	I $P(PSOR EF("RX3"), "^",2)>PSO REF("FILL DATE") D
	197	. ; PSO7 497 - rep lacing lin e below wi th one tha t follows (auto-susp end
	198	defect)
	199	. ;S Y=$P (PSOREF("R X3"),"^",2 ) D DD^%DT W !!,$C(7 ),"Cannot be refille d
	200	until "_Y _"." S (PS OREF("DFLG "),PSOMHV) =1 K Y
	201	. S Y=$P( PSOREF("RX 3"),"^",2) D DD^%DT S PSORMSG( 1)="Cannot be refill ed
	202	until "_Y _"." S (PS OREF("DFLG "),PSOMHV) =1 K Y
	203
	204
	205	3. I12239 583FY17 - OneVA and Drug TRADE NAME usag e
	206
	207	Problem:
	208	--------
	209	The OneVA pharmacy software c annot prop erly handl e the TRAD E NAME fie ld
	210	associate d with a p rescriptio n.
	211
	212
	213	Resolutio n:
	214	--------- --
	215	Routine P SORREF has been modi fied to bl ock prescr iptions th at contain a
	216	trade nam e from bei ng refille d by a non -host site pharmacy (i.e.
	217	dispensin g or remot e pharmacy ). When a prescripti on contain ing a trad e
	218	name is b locked, a message is sent to t he dispens ing pharma cy indicat ing
	219	the drug cannot be refilled o r partiall y filled b ecause it contains a
	220	trade nam e.
	221
	222	Technical Resolutio n:
	223	--------- ---------- --
	224	REMREF+15 -19^PSORRE F:
	225
	226	; PSO7 497 - trad e name blo ck/titrati on block
	227	I $$GET1 ^DIQ(52,RR XIEN,6.5," E")]"" D Q
	228	.D RET0
	229	.S RET(1 )="This pr escription cannot be refilled or partial filled
	230	because it has a value"
	231	.S RET(2 )="entered in the Rx trade nam e field. Please fol low local
	232	policy for obtain ing"
	233	.S RET(3 )="a new p rescriptio n."
	234
	235	PAR+19^PS ORRPA1
	236
	237	; PSO7 497 - trad e name blo ck
	238	I $$GET1 ^DIQ(52,RR XIEN,6.5," E")]"" D Q
	239	.S VALMS G(1)="This prescript ion cannot be refill ed or part ial filled be
	240	cause i t has a va lue"
	241	.S VALMS G(2)="ente red in the Rx trade name field . Please follow loc al
	242	policy for obtain ing"
	243	.S VALMS G(3)="a ne w prescrip tion."
	244	; PSO7 497 - end trade name block
	245
	246
	247	4.) TITRA TION - nee d ticket i nformation .
	248
	249	Problem:
	250	--------
	251	Prescript ions that are a 'tit ration' ty pe of pres cription c an be refi lled
	252	by a Non- host (remo te/dispens ing) facil ity. Only partial fi lls should be
	253	allowed f or The 'ti tration' p rescriptio n.
	254
	255	Resolutio n:
	256	--------- --
	257	Routine P SORREF has been modi fied to bl ock the re fill of a titration type
	258	Prescript ion and in form the u ser to iss ue a parti al fill re quest.
	259
	260	Technical Resolutio n:
	261	--------- ---------- --
	262	REMREF+20 ^PSORREF:
	263
	264	I $$TITRX ^PSOUTL(RR XIEN)="t" S RET(1)=" Cannot ref ill prescr iption - t ype
	265	is Titrat ion. You m ay request a partial fill." D RET0 Q
	266
	267	5.) - Mov ing the On eVA Pharma cy Flag
	268
	269	Problem:
	270	--------
	271	It has be en request ed that th e OneVA Ph armacy fla g be moved from the
	272	OUTPATIEN T SITE fil e (#59) to the PHARM ACY SYSTEM file (#59 .7). It ha s
	273	also been requested that the [PSS SYS E DIT] funct ion be mod ified to
	274	include t he new ONE VA PHARMAC Y FLAG fie ld in the prompting sequence f or
	275	users. Th e new loca tion is in the Pharm acy System file (#59 .7), and i s
	276	stored in the ONEVA PHARMACY FLAG field (#101).
	277
	278	Resolutio n:
	279	--------- --
	280	PSORX1,PS ORRPA1, an d PSORREF have been modified t o look at the new
	281	location for the On eVA pharma cy flag.
	282
	283	Technical Resolutio n:
	284	--------- ---------- --
	285	OERR+25^P SORX1
	286
	287	.I '$$GET 1^DIQ(59.7 ,1,101,"I" ) D Q
	288
	289
	290	PAR+5^PSO RRPA1
	291
	292	I '$$GET1 ^DIQ(59.7, 1,101,"I") D Q
	293
	294	REMREF+10 ^PSORREF
	295
	296	I '$$GET1 ^DIQ(59.7, 1,101,"I") D Q
	297
	298
	299	Test Site s:
	300	--------- -
	301	N/A
	302
	303
	304	Documenta tion Retri eval Instr uctions
	305	========= ========== ========== =======
	306	Updated d ocumentati on describ ing the ne w function ality intr oduced by this
	307	patch are available .
	308
	309	The prefe rred metho d is to re trieve fil es from do wnload. DNS . DNS .
	310	This tran smits the files from the first available server. S ites may a lso
	311	elect to retrieve f iles direc tly from a specific server.
	312
	313	Sites may retrieve the docume ntation di rectly usi ng Secure File Trans fer
	314	Protocol (SFTP) fro m the ANON YMOUS.SOFT WARE direc tory at th e followin g OI
	315	Field Off ices:
	316
	317
	318	Hines: DNS .U RL
	319	Salt Lake City: . URL
	320
	321
	322	Documenta tion can a lso be fou nd on the VA Softwar e Document ation Libr ary
	323	at:
	324	http:// URL /
	325
	326	Title File Name FTP Mod e
	327	--------- ---------- ---------- ---------- ---------- ---------- ---------- --
	328	<Document ation titl e>
	329
	330
	331	Patch Ins tallation:
	332
	333
	334	Pre/Post Installati on Overvie w:
	335	--------- ---------- ---------- --
	336	There are no pre-po st install ation inst ructions f or this pa tch.
	337
	338
	339	Pre-Insta llation In structions :
	340	--------- ---------- ---------- -
	341	N/A
	342
	343	This patc h may be i nstalled w ith users on the sys tem althou gh it is
	344	recommend ed that it be instal led during non-peak hours to m inimize
	345	potential disruptio n to users . This pa tch should take less than 5
	346	minutes
	347	to instal l.
	348
	349
	350	Installat ion Instru ctions:
	351	--------- ---------- -------
	352	1. Choos e the Pack Man messag e containi ng this pa tch.
	353
	354	2. Choos e the INST ALL/CHECK MESSAGE Pa ckMan opti on.
	355
	356	3. From the Kernel Installat ion and Di stribution System Me nu, select
	357	the I nstallatio n Menu. F rom this m enu, you m ay elect t o use the
	358	follo wing optio ns. When p rompted fo r the INST ALL NAME e nter the p atch
	359	#(ex. PSO7.04 97):
	360	a. B ackup a Tr ansport Gl obal - Thi s option w ill create a backup
	361	m essage of any routin es exporte d with thi s patch. I t will not
	362	b ackup any other chan ges such a s DDs or t emplates.
	363	b. C ompare Tra nsport Glo bal to Cur rent Syste m - This o ption will
	364	a llow you t o view all changes t hat will b e made whe n this pat ch
	365	i s installe d. It com pares all components of this p atch
	366	( routines, DDs, templ ates, etc. ).
	367	c. V erify Chec ksums in T ransport G lobal - Th is option will allow
	368	y ou to ensu re the int egrity of the routin es that ar e in the
	369	t ransport g lobal.
	370
	371	4. From the Instal lation Men u, select the Instal l Package( s) option and
	372	choos e the patc h to insta ll.
	373
	374	5. When prompted ' Want KIDS to Rebuild Menu Tree s Upon Com pletion of
	375	Insta ll? NO//', answer 'Y ES'.
	376
	377	6. When prompted ' Want KIDS to INHIBIT LOGONs du ring the i nstall?
	378	NO//' , answer ' NO'.
	379
	380	7. When prompted ' Want to DI SABLE Sche duled Opti ons, Menu Options,
	381	and P rotocols? NO//', ans wer 'NO'.
	382
	383
	384	Post-Inst allation I nstruction s:
	385	--------- ---------- ---------- --
	386	N/A
	387
	388	Routine In formation:
	389	========== ==========
	390	The second line of e ach of the se routine s now look s like:
	391	;;7.0;OUT PATIENT PH ARMACY;[ Patch List ];DEC 19 97;Build 2 2
	392
	393	The checks ums below are new ch ecksums, a nd
	394	can be ch ecked with CHECK1^XT SUMBLD.
	395
	396	Routine Na me: PSORRE F
	397	Before : B4409413 8 After: B49315727 454,47 5,497
	398	Routine Na me: PSORRE F0
	399	Before : B4651529 0 After: B43141161 454,49 7
	400	Routine Na me: PSORRP A1
	401	Before : B7534326 7 After: B80588571 454,47 5,497
	402	Routine Na me: PSORRX 2
	403	Before : B3472542 4 After: B35129325 454,47 9,497
	404	Routine Na me: PSORX1
	405	Before : B8303470 1 After: B82991230 **7,22,2 3,57,62,46 ,74,71,90,
	406	95,115, 117,146,13 9,135,182, 195,
	407	233,268 ,300,170,3 20,326,324 ,
	408	334,251 ,454,488,4 97**
	409
	410	Routine li st of prec eding patc hes: 475, 479, 488
	411
	412	========== ========== ========== ========== ========== ========== ========== =======
	413	User Infor mation:
	414	Entered By : FISHER ,BRADLEY Date E ntered : AUG 01, 20 17
	415	Completed By: Date C ompleted:
	416	Released B y : Date R eleased :
	417	========== ========== ========== ========== ========== ========== ========== =======
	418
	419
	420	Packman Ma il Message :
	421	========== ========== =
	422
	423	$END TXT
	424	$KID PSO7 .0497
	425	INSTALL NAME
	426	PSO7.049 7
	427	"BLD",9861 ,0)
	428	PSO7.049 7^OUTPATIE NT PHARMAC Y^0^317100 9^y
	429	"BLD",9861 ,4,0)
	430	^9.64PA^59 .7^1
	431	"BLD",9861 ,4,59.7,0)
	432	59.7
	433	"BLD",9861 ,4,59.7,2, 0)
	434	^9.641^59. 7^1
	435	"BLD",9861 ,4,59.7,2, 59.7,0)
	436	PHARMACY S YSTEM (Fi le-top lev el)
	437	"BLD",9861 ,4,59.7,2, 59.7,1,0)
	438	^9.6411^10 1^1
	439	"BLD",9861 ,4,59.7,2, 59.7,1,101 ,0)
	440	ONEVA PHAR MACY FLAG
	441	"BLD",9861 ,4,59.7,22 2)
	442	y^y^p^^^^n ^^n
	443	"BLD",9861 ,4,59.7,22 4)
	444
	445	"BLD",9861 ,4,"APDD", 59.7,59.7)
	446
	447	"BLD",9861 ,4,"APDD", 59.7,59.7, 101)
	448
	449	"BLD",9861 ,4,"B",59. 7,59.7)
	450
	451	"BLD",9861 ,6.3)
	452	22
	453	"BLD",9861 ,"ABPKG")
	454	n
	455	"BLD",9861 ,"KRN",0)
	456	^9.67PA^77 9.2^20
	457	"BLD",9861 ,"KRN",.4, 0)
	458	.4
	459	"BLD",9861 ,"KRN",.40 1,0)
	460	.401
	461	"BLD",9861 ,"KRN",.40 2,0)
	462	.402
	463	"BLD",9861 ,"KRN",.40 3,0)
	464	.403
	465	"BLD",9861 ,"KRN",.5, 0)
	466	.5
	467	"BLD",9861 ,"KRN",.84 ,0)
	468	.84
	469	"BLD",9861 ,"KRN",3.6 ,0)
	470	3.6
	471	"BLD",9861 ,"KRN",3.8 ,0)
	472	3.8
	473	"BLD",9861 ,"KRN",9.2 ,0)
	474	9.2
	475	"BLD",9861 ,"KRN",9.8 ,0)
	476	9.8
	477	"BLD",9861 ,"KRN",9.8 ,"NM",0)
	478	^9.68A^6^5
	479	"BLD",9861 ,"KRN",9.8 ,"NM",1,0)
	480	PSORREF^^0 ^B49315727
	481	"BLD",9861 ,"KRN",9.8 ,"NM",2,0)
	482	PSORRPA1^^ 0^B8058857 1
	483	"BLD",9861 ,"KRN",9.8 ,"NM",3,0)
	484	PSORREF0^^ 0^B4314116 1
	485	"BLD",9861 ,"KRN",9.8 ,"NM",5,0)
	486	PSORX1^^0^ B82991230
	487	"BLD",9861 ,"KRN",9.8 ,"NM",6,0)
	488	PSORRX2^^0 ^B35129325
	489	"BLD",9861 ,"KRN",9.8 ,"NM","B", "PSORREF", 1)
	490
	491	"BLD",9861 ,"KRN",9.8 ,"NM","B", "PSORREF0" ,3)
	492
	493	"BLD",9861 ,"KRN",9.8 ,"NM","B", "PSORRPA1" ,2)
	494
	495	"BLD",9861 ,"KRN",9.8 ,"NM","B", "PSORRX2", 6)
	496
	497	"BLD",9861 ,"KRN",9.8 ,"NM","B", "PSORX1",5 )
	498
	499	"BLD",9861 ,"KRN",19, 0)
	500	19
	501	"BLD",9861 ,"KRN",19. 1,0)
	502	19.1
	503	"BLD",9861 ,"KRN",101 ,0)
	504	101
	505	"BLD",9861 ,"KRN",101 ,"NM",0)
	506	^9.68A^3^3
	507	"BLD",9861 ,"KRN",101 ,"NM",1,0)
	508	PSO LM REM OTE PARTIA L^^0
	509	"BLD",9861 ,"KRN",101 ,"NM",2,0)
	510	PSO LM REF ILL REMOTE ORDER^^0
	511	"BLD",9861 ,"KRN",101 ,"NM",3,0)
	512	PSO LM REM OTE ORDER MENU^^0
	513	"BLD",9861 ,"KRN",101 ,"NM","B", "PSO LM RE FILL REMOT E ORDER",2 )
	514
	515	"BLD",9861 ,"KRN",101 ,"NM","B", "PSO LM RE MOTE ORDER MENU",3)
	516
	517	"BLD",9861 ,"KRN",101 ,"NM","B", "PSO LM RE MOTE PARTI AL",1)
	518
	519	"BLD",9861 ,"KRN",409 .61,0)
	520	409.61
	521	"BLD",9861 ,"KRN",771 ,0)
	522	771
	523	"BLD",9861 ,"KRN",779 .2,0)
	524	779.2
	525	"BLD",9861 ,"KRN",870 ,0)
	526	870
	527	"BLD",9861 ,"KRN",898 9.51,0)
	528	8989.51
	529	"BLD",9861 ,"KRN",898 9.52,0)
	530	8989.52
	531	"BLD",9861 ,"KRN",899 4,0)
	532	8994
	533	"BLD",9861 ,"KRN","B" ,.4,.4)
	534
	535	"BLD",9861 ,"KRN","B" ,.401,.401 )
	536
	537	"BLD",9861 ,"KRN","B" ,.402,.402 )
	538
	539	"BLD",9861 ,"KRN","B" ,.403,.403 )
	540
	541	"BLD",9861 ,"KRN","B" ,.5,.5)
	542
	543	"BLD",9861 ,"KRN","B" ,.84,.84)
	544
	545	"BLD",9861 ,"KRN","B" ,3.6,3.6)
	546
	547	"BLD",9861 ,"KRN","B" ,3.8,3.8)
	548
	549	"BLD",9861 ,"KRN","B" ,9.2,9.2)
	550
	551	"BLD",9861 ,"KRN","B" ,9.8,9.8)
	552
	553	"BLD",9861 ,"KRN","B" ,19,19)
	554
	555	"BLD",9861 ,"KRN","B" ,19.1,19.1 )
	556
	557	"BLD",9861 ,"KRN","B" ,101,101)
	558
	559	"BLD",9861 ,"KRN","B" ,409.61,40 9.61)
	560
	561	"BLD",9861 ,"KRN","B" ,771,771)
	562
	563	"BLD",9861 ,"KRN","B" ,779.2,779 .2)
	564
	565	"BLD",9861 ,"KRN","B" ,870,870)
	566
	567	"BLD",9861 ,"KRN","B" ,8989.51,8 989.51)
	568
	569	"BLD",9861 ,"KRN","B" ,8989.52,8 989.52)
	570
	571	"BLD",9861 ,"KRN","B" ,8994,8994 )
	572
	573	"BLD",9861 ,"QDEF")
	574	^^^^NO^^^^ NO^^NO
	575	"BLD",9861 ,"QUES",0)
	576	^9.62^^
	577	"BLD",9861 ,"REQB",0)
	578	^9.611^4^4
	579	"BLD",9861 ,"REQB",1, 0)
	580	PSO7.047 5^2
	581	"BLD",9861 ,"REQB",2, 0)
	582	PSO7.045 4^2
	583	"BLD",9861 ,"REQB",3, 0)
	584	PSO7.047 9^2
	585	"BLD",9861 ,"REQB",4, 0)
	586	PSO7.048 8^2
	587	"BLD",9861 ,"REQB","B ","PSO7.0 454",2)
	588
	589	"BLD",9861 ,"REQB","B ","PSO7.0 475",1)
	590
	591	"BLD",9861 ,"REQB","B ","PSO7.0 479",3)
	592
	593	"BLD",9861 ,"REQB","B ","PSO7.0 488",4)
	594
	595	"FIA",59.7 )
	596	PHARMACY S YSTEM
	597	"FIA",59.7 ,0)
	598	^PS(59.7,
	599	"FIA",59.7 ,0,0)
	600	59.7
	601	"FIA",59.7 ,0,1)
	602	y^y^p^^^^n ^^n
	603	"FIA",59.7 ,0,10)
	604
	605	"FIA",59.7 ,0,11)
	606
	607	"FIA",59.7 ,0,"RLRO")
	608
	609	"FIA",59.7 ,0,"VR")
	610	7.0^PSO
	611	"FIA",59.7 ,59.7)
	612	1
	613	"FIA",59.7 ,59.7,101)
	614
	615	"KRN",101, 7819,-1)
	616	0^3
	617	"KRN",101, 7819,0)
	618	PSO LM REM OTE ORDER MENU^Remot e Order Me nu^^M^^^^^ ^^^OUTPATI ENT PHARMA CY
	619	"KRN",101, 7819,4)
	620	45
	621	"KRN",101, 7819,10,0)
	622	^101.01PA^ 2^2
	623	"KRN",101, 7819,10,1, 0)
	624	7820^RF^1^
	625	"KRN",101, 7819,10,1, "^")
	626	PSO LM REF ILL REMOTE ORDER
	627	"KRN",101, 7819,10,2, 0)
	628	7821^PR^2^
	629	"KRN",101, 7819,10,2, "^")
	630	PSO LM REM OTE PARTIA L
	631	"KRN",101, 7819,24)
	632	I 1 X:$D(^ ORD(101,+$ P(^ORD(101 ,DA(1),10, DA,0),"""^ """,1),24) ) ^(24)
	633	"KRN",101, 7819,26)
	634	D SHOW^VAL M
	635	"KRN",101, 7819,28)
	636	Select Act ion:
	637	"KRN",101, 7819,99)
	638	64551,4056 3
	639	"KRN",101, 7820,-1)
	640	0^2
	641	"KRN",101, 7820,0)
	642	PSO LM REF ILL REMOTE ORDER^Ref ill Rx fro m Another VA Pharmac y^^A^^^^^^ ^^
	643	"KRN",101, 7820,2,0)
	644	^101.02A^1 ^1
	645	"KRN",101, 7820,2,1,0 )
	646	RF
	647	"KRN",101, 7820,2,"B" ,"RF",1)
	648
	649	"KRN",101, 7820,20)
	650	D REFREQ^P SORRX1
	651	"KRN",101, 7820,24)
	652	I $$PSORPH ^PSORRX2(D UZ)
	653	"KRN",101, 7820,99)
	654	64159,8127 5
	655	"KRN",101, 7821,-1)
	656	0^1
	657	"KRN",101, 7821,0)
	658	PSO LM REM OTE PARTIA L^Partial Fill Rx fr om Another VA Pharma cy^^A^^^^^ ^^^
	659	"KRN",101, 7821,20)
	660	D PARTIAL^ PSORRX1
	661	"KRN",101, 7821,24)
	662	I $$PSORPH ^PSORRX2(D UZ)
	663	"KRN",101, 7821,99)
	664	64551,4056 3
	665	"MBREQ")
	666	0
	667	"ORD",15,1 01)
	668	101;15;;;P RO^XPDTA;P ROF1^XPDIA ;PROE1^XPD IA;PROF2^X PDIA;;PROD EL^XPDIA
	669	"ORD",15,1 01,0)
	670	PROTOCOL
	671	"PKG",170, -1)
	672	1^1
	673	"PKG",170, 0)
	674	OUTPATIENT PHARMACY^ PSO^OUTPAT IENT LABEL S, PROFILE , INVENTOR Y, PRESCRI PTIONS
	675	"PKG",170, 20,0)
	676	^9.402P^^
	677	"PKG",170, 22,0)
	678	^9.49I^1^1
	679	"PKG",170, 22,1,0)
	680	7.0^297121 6^2981113^ 1
	681	"PKG",170, 22,1,"PAH" ,1,0)
	682	497^317100 9
	683	"QUES","XP F1",0)
	684	Y
	685	"QUES","XP F1","??")
	686	^D REP^XPD H
	687	"QUES","XP F1","A")
	688	Shall I wr ite over y our \|FLAG\| File
	689	"QUES","XP F1","B")
	690	YES
	691	"QUES","XP F1","M")
	692	D XPF1^XPD IQ
	693	"QUES","XP F2",0)
	694	Y
	695	"QUES","XP F2","??")
	696	^D DTA^XPD H
	697	"QUES","XP F2","A")
	698	Want my da ta \|FLAG\| yours
	699	"QUES","XP F2","B")
	700	YES
	701	"QUES","XP F2","M")
	702	D XPF2^XPD IQ
	703	"QUES","XP I1",0)
	704	YO
	705	"QUES","XP I1","??")
	706	^D INHIBIT ^XPDH
	707	"QUES","XP I1","A")
	708	Want KIDS to INHIBIT LOGONs du ring the i nstall
	709	"QUES","XP I1","B")
	710	NO
	711	"QUES","XP I1","M")
	712	D XPI1^XPD IQ
	713	"QUES","XP M1",0)
	714	PO^VA(200, :EM
	715	"QUES","XP M1","??")
	716	^D MG^XPDH
	717	"QUES","XP M1","A")
	718	Enter the Coordinato r for Mail Group '\|F LAG\|'
	719	"QUES","XP M1","B")
	720
	721	"QUES","XP M1","M")
	722	D XPM1^XPD IQ
	723	"QUES","XP O1",0)
	724	Y
	725	"QUES","XP O1","??")
	726	^D MENU^XP DH
	727	"QUES","XP O1","A")
	728	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	729	"QUES","XP O1","B")
	730	NO
	731	"QUES","XP O1","M")
	732	D XPO1^XPD IQ
	733	"QUES","XP Z1",0)
	734	Y
	735	"QUES","XP Z1","??")
	736	^D OPT^XPD H
	737	"QUES","XP Z1","A")
	738	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	739	"QUES","XP Z1","B")
	740	NO
	741	"QUES","XP Z1","M")
	742	D XPZ1^XPD IQ
	743	"QUES","XP Z2",0)
	744	Y
	745	"QUES","XP Z2","??")
	746	^D RTN^XPD H
	747	"QUES","XP Z2","A")
	748	Want to MO VE routine s to other CPUs
	749	"QUES","XP Z2","B")
	750	NO
	751	"QUES","XP Z2","M")
	752	D XPZ2^XPD IQ
	753	"RTN")
	754	5
	755	"RTN","PSO RREF")
	756	0^1^B49315 727^B44094 138
	757	"RTN","PSO RREF",1,0)
	758	PSORREF ;A ITC/BWF - Remote RX retrieval API ;12/12 /16 3:21pm
	759	"RTN","PSO RREF",2,0)
	760	;;7.0;OUT PATIENT PH ARMACY;4 54,475,497 ;DEC 199 7;Build 22
	761	"RTN","PSO RREF",3,0)
	762	;
	763	"RTN","PSO RREF",4,0)
	764	Q
	765	"RTN","PSO RREF",5,0)
	766	; RET - return d ata
	767	"RTN","PSO RREF",6,0)
	768	; RXNUM - RX Numbe r from rem ote system
	769	"RTN","PSO RREF",7,0)
	770	; FDATE - Fill Dat e
	771	"RTN","PSO RREF",8,0)
	772	; MW - Mail/Win dow - Defa ult of 'W' for now.
	773	"RTN","PSO RREF",9,0)
	774	; RPHARM - Pharmaci st from re mote site
	775	"RTN","PSO RREF",10,0 )
	776	; RPHONE - Contact number
	777	"RTN","PSO RREF",11,0 )
	778	; RSITE - Filling site numbe r
	779	"RTN","PSO RREF",12,0 )
	780	;
	781	"RTN","PSO RREF",13,0 )
	782	REMREF(RET ,RXNUM,FDA TE,MW,RPHA RM,RPHONE, RSITE,RX0, RX2,RXSTA, RPROV,RSIG ,RREF0,RO
	783	R1,RX3) ;
	784	"RTN","PSO RREF",14,0 )
	785	;
	786	"RTN","PSO RREF",15,0 )
	787	N MSG,BAC K,PSOPAR,R RXIEN,PSOS IEN,DSUPP, LASTREF,XT MPLOC,PASS LOC,HFSIEN ,FULLPTH,
	788	HFSDONE,PT HDAT,PTHPI ECE,FOUND, STRT,STATI ON,FTGOPEN ,PPL1,PSOS ITE
	789	"RTN","PSO RREF",16,0 )
	790	N PSOX,PT HFILE,SITE NUM,X,X1,X 2,HDRUG,CS VAL,PSISSD T,TFILLS,O FFSET,CHKD T,DINACT,
	791	DEL,FTGSTR T,PDIR,PFI L,PSODTCUT ,PSOEXREP, PSOPHDUZ
	792	"RTN","PSO RREF",17,0 )
	793	N PSODFDI R,PSOFNAME ,PAR,DELAR R,RREFIEN
	794	"RTN","PSO RREF",18,0 )
	795	N PSOBBC, PSOBBC1,PS ODIR,PSOMV H
	796	"RTN","PSO RREF",19,0 )
	797	; check 3 rd party p ayer rejec ts. Send m essage to initiating site if a pplicable
	798	.
	799	"RTN","PSO RREF",20,0 )
	800	S $ETRAP= "D ^%ZTER Q"
	801	"RTN","PSO RREF",21,0 )
	802	S RET(0)= ""
	803	"RTN","PSO RREF",22,0 )
	804	S RRXIEN= $O(^PSRX(" B",RXNUM,0 )),PSOSIEN =$$GET1^DI Q(52,RRXIE N,20,"I")
	805	"RTN","PSO RREF",23,0 )
	806	I '$$GET1 ^DIQ(59.7, 1,101,"I") D Q
	807	"RTN","PSO RREF",24,0 )
	808	.S RET(1) ="The OneV A pharmacy flag is t urned 'OFF ' at this facility."
	809	"RTN","PSO RREF",25,0 )
	810	.S RET(2) ="Unable t o process refill/par tial fill requests."
	811	"RTN","PSO RREF",26,0 )
	812	.D RET0
	813	"RTN","PSO RREF",27,0 )
	814	; PSO74 97 - trade name bloc k/titratio n block
	815	"RTN","PSO RREF",28,0 )
	816	I $$GET1^ DIQ(52,RRX IEN,6.5,"E ")]"" D Q
	817	"RTN","PSO RREF",29,0 )
	818	.D RET0
	819	"RTN","PSO RREF",30,0 )
	820	.S RET(1) ="This pre scription cannot be refilled o r partial filled bec ause it h
	821	as a value "
	822	"RTN","PSO RREF",31,0 )
	823	.S RET(2) ="entered in the Rx trade name field. P lease foll ow local p olicy for
	824	obtaining "
	825	"RTN","PSO RREF",32,0 )
	826	.S RET(3) ="a new pr escription ."
	827	"RTN","PSO RREF",33,0 )
	828	I $$TITRX ^PSOUTL(RR XIEN)="t" S RET(1)=" Cannot ref ill prescr iption - t ype is Ti
	829	tration. Y ou may req uest a par tial fill. " D RET0 Q
	830	"RTN","PSO RREF",34,0 )
	831	; PSO74 97 - end t rade name/ titration block
	832	"RTN","PSO RREF",35,0 )
	833	S PSOPHDU Z=$$GET1^D IQ(52,RRXI EN,23,"I") I 'PSOPHD UZ S PSOPH DUZ=.5
	834	"RTN","PSO RREF",36,0 )
	835	S HDRUG=$ $GET1^DIQ( 52,RRXIEN, 6,"I")
	836	"RTN","PSO RREF",37,0 )
	837	; quit if drug is i nactive
	838	"RTN","PSO RREF",38,0 )
	839	S DINACT= $$GET1^DIQ (50,HDRUG, 100,"I")
	840	"RTN","PSO RREF",39,0 )
	841	I DINACT> 0,DINACT<$ $NOW^XLFDT S RET(1)= "Drug is i nactive fo r Rx# "_RX NUM_". Ca
	842	nnot refil l." D RET0 Q
	843	"RTN","PSO RREF",40,0 )
	844	S CSVAL=$ $GET1^DIQ( 50,HDRUG,3 ,"E"),CSVA L=$E(CSVAL ,1)
	845	"RTN","PSO RREF",41,0 )
	846	I CSVAL,C SVAL>0,CSV AL<6 D RET 0 S RET(1) ="Rx #"_RX NUM_" cann ot be refi lled.",RE
	847	T(2)="The associated drug is c onsidered a controll ed substan ce",RET(3) ="at the
	848	host facil ity." Q
	849	"RTN","PSO RREF",42,0 )
	850	S PSOPAR= $G(^PS(59, PSOSIEN,1) ),PSOSITE= PSOSIEN
	851	"RTN","PSO RREF",43,0 )
	852	S RPHONE= $G(RPHONE, "")
	853	"RTN","PSO RREF",44,0 )
	854	; check t o see if t his action will thro w the pres cription i nto suspen se. If so
	855	, quit and return a message
	856	"RTN","PSO RREF",45,0 )
	857	S DSUPP=$ $GET1^DIQ( 52,RRXIEN, 8,"I")
	858	"RTN","PSO RREF",46,0 )
	859	S X2=-120 ,X1=DT D C ^%DTC S PS ODTCUT=X
	860	"RTN","PSO RREF",47,0 )
	861	S (PSODFN ,PSOREF("P SODFN"))=$ $GET1^DIQ( 52,RRXIEN, 2,"I") K P SOSD D ^PS OBUILD
	862	"RTN","PSO RREF",48,0 )
	863	N RXN K P SORX("FILL DATE") S PSOFROM="R EFILL" S P SOREF("DFL G")=0,PSOR EF("IRXN"
	864	)=$O(^PSRX ("B",RXNUM ,0)),PSORE F("QFLG")= 0
	865	"RTN","PSO RREF",49,0 )
	866	I $$LMREJ ^PSOREJU1( RXNUM,,.MS G,.BACK) S RET(1)=MS G D RET0 Q
	867	"RTN","PSO RREF",50,0 )
	868	S PSORX(" FILL DATE" )=FDATE
	869	"RTN","PSO RREF",51,0 )
	870	K PSOID D START^PSO RREF1(FDAT E) I PSORE F("DFLG") D EOJ Q
	871	"RTN","PSO RREF",52,0 )
	872	; check a bility to refill giv en issue d ate/days s upply
	873	"RTN","PSO RREF",53,0 )
	874	S PSISSDT =$$GET1^DI Q(52,RRXIE N,1,"I")
	875	"RTN","PSO RREF",54,0 )
	876	S TFILLS= $O(^PSRX(R RXIEN,1,"A "),-1)+1
	877	"RTN","PSO RREF",55,0 )
	878	S OFFSET= DSUPP*TFIL LS,OFFSET= OFFSET-10
	879	"RTN","PSO RREF",56,0 )
	880	S CHKDT=$ $FMADD^XLF DT(PSISSDT ,OFFSET)
	881	"RTN","PSO RREF",57,0 )
	882	I PSORX(" FILL DATE" )<CHKDT D RET0 S RET (1)="Canno t refill R x# "_RXNUM _". Next
	883	possible f ill date i s "_$$FMTE ^XLFDT(CHK DT,"5D") Q
	884	"RTN","PSO RREF",58,0 )
	885	I PSORX(" FILL DATE" )>$$GET1^D IQ(52,RRXI EN,26,"I") D RET0 S RET(1)="Ca nnot refi
	886	ll Rx# "_R XNUM_".",R ET(2)="Can not refill after exp iration da te "_$$GET 1^DIQ(52,
	887	RRXIEN,11, "E") Q
	888	"RTN","PSO RREF",59,0 )
	889	D PROCESS ^PSORREF0( .RET)
	890	"RTN","PSO RREF",60,0 )
	891	; make su re not err ors are re turned
	892	"RTN","PSO RREF",61,0 )
	893	I $D(RET( 1)) D EOJ Q
	894	"RTN","PSO RREF",62,0 )
	895	I '$D(RET (1)) D
	896	"RTN","PSO RREF",63,0 )
	897	.; bwf 8/ 14/14 - se t up neede d variable s for labe l printing
	898	"RTN","PSO RREF",64,0 )
	899	.S PSODFN =$P(^PSRX( RRXIEN,0), U,2)
	900	"RTN","PSO RREF",65,0 )
	901	.S PSORX( "IRXN")=RX NUM
	902	"RTN","PSO RREF",66,0 )
	903	.S PSORX( "PSOL",1)= RRXIEN_","
	904	"RTN","PSO RREF",67,0 )
	905	.S PSORX( "MAIL/WIND OW")="WIND OW"
	906	"RTN","PSO RREF",68,0 )
	907	.S PSORX( "NAME")=$$ GET1^DIQ(2 ,PSODFN,.0 1)
	908	"RTN","PSO RREF",69,0 )
	909	.S PSORX( "QFLG")=0
	910	"RTN","PSO RREF",70,0 )
	911	.S PSORX( "METHOD OF PICKUP")= ""
	912	"RTN","PSO RREF",71,0 )
	913	.S PSOX=$ G(^PS(55,P SODFN,"PS" )) I PSOX] "" S PSORX ("PATIENT STATUS")=$ P($G(^PS(
	914	53,PSOX,0) ),"^")
	915	"RTN","PSO RREF",72,0 )
	916	.S PPL1=R RXIEN
	917	"RTN","PSO RREF",73,0 )
	918	.; bwf 8/ 14/14 - en d setup fo r label pr inting.
	919	"RTN","PSO RREF",74,0 )
	920	.S PSODFD IR=$$DEFDI R^%ZISH()
	921	"RTN","PSO RREF",75,0 )
	922	.S PSOFNA ME="PSOLBL _"_RXNUM_" _"_PSOSITE _"_"_DT_". DAT"
	923	"RTN","PSO RREF",76,0 )
	924	.S FULLPT H=PSODFDIR _PSOFNAME
	925	"RTN","PSO RREF",77,0 )
	926	.S HFSDON E=0,PTHDAT =""
	927	"RTN","PSO RREF",78,0 )
	928	.; preser ve IO
	929	"RTN","PSO RREF",79,0 )
	930	.D SAVDEV ^%ZISUTL(" ONEVAHLIO" )
	931	"RTN","PSO RREF",80,0 )
	932	.S DELARR ("PSOLBL_" _RXNUM_"_" _PSOSITE_" _"_DT_".DA T")="" S D EL=$$DEL^% ZISH(PSOD
	933	FDIR,$NA(D ELARR))
	934	"RTN","PSO RREF",81,0 )
	935	.S PSOEXR EP=1
	936	"RTN","PSO RREF",82,0 )
	937	.; call o ut to gene rate label
	938	"RTN","PSO RREF",83,0 )
	939	.D LABEL^ PSORWRAP(R RXIEN,"HFS ",PSOSITE, PSOPHDUZ," ",PSOFNAME )
	940	"RTN","PSO RREF",84,0 )
	941	.S XTMPLO C="^XTMP(" "PSORLBL"" ,"_HLINSTN _","_+RXNU M_",1,0)"
	942	"RTN","PSO RREF",85,0 )
	943	.S PASSLO C="XTMP("" PSORLBL"", "_HLINSTN_ ","_+RXNUM _")"
	944	"RTN","PSO RREF",86,0 )
	945	.K ^XTMP( "PSORLBL", HLINSTN,+R XNUM,0)
	946	"RTN","PSO RREF",87,0 )
	947	.S ^XTMP( "PSORLBL", HLINSTN,+R XNUM,0)=DT _U_$$FMADD ^XLFDT(DT, 30)
	948	"RTN","PSO RREF",88,0 )
	949	.; looks like we ha ve to wait a moment before the file show s up.
	950	"RTN","PSO RREF",89,0 )
	951	.S FTGSTR T=$$NOW^XL FDT,(FOUND ,FTGOPEN)= 0
	952	"RTN","PSO RREF",90,0 )
	953	.N PAR S PAR=0
	954	"RTN","PSO RREF",91,0 )
	955	.F D Q: $$NOW^XLFD T>$$FMADD^ XLFDT(FTGS TRT,,,,15) !(FOUND)!( FTGOPEN)
	956	"RTN","PSO RREF",92,0 )
	957	..S FTGOP EN=$$FTG^% ZISH(PSODF DIR,PSOFNA ME,XTMPLOC ,4)
	958	"RTN","PSO RREF",93,0 )
	959	..I $O(^X TMP("PSORL BL",HLINST N,+RXNUM,0 )) S FOUND =1
	960	"RTN","PSO RREF",94,0 )
	961	.S DELARR ("PSOLBL_" _RXNUM_"_" _PSOSITE_" _"_DT_".DA T")="" S D EL=$$DEL^% ZISH(PSOD
	962	FDIR,$NA(D ELARR))
	963	"RTN","PSO RREF",95,0 )
	964	.; restor e IO
	965	"RTN","PSO RREF",96,0 )
	966	.D USE^%Z ISUTL("ONE VAHLIO"),R MDEV^%ZISU TL("ONEVAH LIO")
	967	"RTN","PSO RREF",97,0 )
	968	.D UPDREF (.RET,RRXI EN,RPHARM, RPHONE,RSI TE,PASSLOC )
	969	"RTN","PSO RREF",98,0 )
	970	.S RET(1) ="Rx # "_R XNUM_" ref illed."
	971	"RTN","PSO RREF",99,0 )
	972	.S RX0=$G (^PSRX(RRX IEN,0)),RX 2=$G(^PSRX (RRXIEN,2) ),RX3=$G(^ PSRX(RRXIE N,3))
	973	"RTN","PSO RREF",100, 0)
	974	.S RXSTA= $G(^PSRX(R RXIEN,"STA ")),RPROV= $$GET1^DIQ (200,$P(RX 0,U,4),.01 ,"E")_U_$
	975	$GET1^DIQ( 200,$P(RX0 ,U,16),.01 ,"E")
	976	"RTN","PSO RREF",101, 0)
	977	.S RSIG=$ G(^PSRX(RR XIEN,"SIG" ))
	978	"RTN","PSO RREF",102, 0)
	979	.S RREFIE N=$O(^PSRX (RRXIEN,1, "A"),-1)
	980	"RTN","PSO RREF",103, 0)
	981	.I RREFIE N S RREF0= $G(^PSRX(R RXIEN,1,RR EFIEN,0))
	982	"RTN","PSO RREF",104, 0)
	983	.S ROR1=$ G(^PSRX(RR XIEN,"OR1" ))
	984	"RTN","PSO RREF",105, 0)
	985	D EOJ
	986	"RTN","PSO RREF",106, 0)
	987	Q
	988	"RTN","PSO RREF",107, 0)
	989	EOJ ;
	990	"RTN","PSO RREF",108, 0)
	991	D RET0
	992	"RTN","PSO RREF",109, 0)
	993	K PSOMSG, PSOREF,PSO RX("BAR CO DE"),PSOLI ST,LFD,MAX ,MIN,NODE, PS,PSOERR, REF,RF,RX
	994	O,RXN,RXP, RXS,SD,VAE RR,PSORX(" FILL DATE" )
	995	"RTN","PSO RREF",110, 0)
	996	K PSOFROM ,PSODFN,PS ORX
	997	"RTN","PSO RREF",111, 0)
	998	Q
	999	"RTN","PSO RREF",112, 0)
	1000	\x000CSubj: PSO 7497 TES T v1 [#86 147425] Page 2
	1001	---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
	1002	; build r et(0) if n eeded
	1003	"RTN","PSO RREF",113, 0)
	1004	RET0 ;
	1005	"RTN","PSO RREF",114, 0)
	1006	I '$L(RET (0)) S RET (0)=0_U_RX NUM_U_RRXI EN_U_U_FDA TE,$P(RET( 0),U,15)=$ G(RPHARM)
	1007	,$P(RET(0) ,U,16)=$G( RPHONE),$P (RET(0),U, 17)=$G(RSI TE)
	1008	"RTN","PSO RREF",115, 0)
	1009	Q
	1010	"RTN","PSO RREF",116, 0)
	1011	;
	1012	"RTN","PSO RREF",117, 0)
	1013	ULK ;
	1014	"RTN","PSO RREF",118, 0)
	1015	Q
	1016	"RTN","PSO RREF",119, 0)
	1017	; success ful refill . Update d ata, and b uild respo nse
	1018	"RTN","PSO RREF",120, 0)
	1019	UPDREF(PSO MSG,PSOIEN ,RPHARM,RP HONE,RSITE ,PASSLOC) ;
	1020	"RTN","PSO RREF",121, 0)
	1021	N REFIEN, REFIENS,RE FDATA,FIL, RXNUM,RFIL LDT,QTY,DS UPP,CLERK, LOGDATE,ID IV,EDIV,D
	1022	ISPDT,NDC, FDA,DNAME, DIEN,DAT
	1023	"RTN","PSO RREF",122, 0)
	1024	S FIL=52. 1
	1025	"RTN","PSO RREF",123, 0)
	1026	; get las t refill d ata node
	1027	"RTN","PSO RREF",124, 0)
	1028	S REFIEN= $O(^PSRX(P SOIEN,1,"B ",DT,""),- 1)
	1029	"RTN","PSO RREF",125, 0)
	1030	S RXNUM=$ $GET1^DIQ( 52,PSOIEN, .01,"E")
	1031	"RTN","PSO RREF",126, 0)
	1032	S DNAME=$ $GET1^DIQ( 52,PSOIEN, 6,"E")
	1033	"RTN","PSO RREF",127, 0)
	1034	S DIEN=$$ GET1^DIQ(5 2,PSOIEN,6 ,"I")
	1035	"RTN","PSO RREF",128, 0)
	1036	S REFIENS =REFIEN_", "_PSOIEN_" ,"
	1037	"RTN","PSO RREF",129, 0)
	1038	; first, set in the remote ph armacist d ata
	1039	"RTN","PSO RREF",130, 0)
	1040	S FDA(FIL ,REFIENS,9 1)=RSITE
	1041	"RTN","PSO RREF",131, 0)
	1042	S FDA(FIL ,REFIENS,9 2)=RPHARM
	1043	"RTN","PSO RREF",132, 0)
	1044	S FDA(FIL ,REFIENS,9 3)=RPHONE
	1045	"RTN","PSO RREF",133, 0)
	1046	D FILE^DI E(,"FDA") K FDA
	1047	"RTN","PSO RREF",134, 0)
	1048	; now que ry data an d build RE T(0) holdi ng accurat e informat ion from t he refill
	1049	multiple
	1050	"RTN","PSO RREF",135, 0)
	1051	D GETS^DI Q(FIL,REFI ENS,"**"," IE","REFDA TA")
	1052	"RTN","PSO RREF",136, 0)
	1053	S RFILLDT =$G(REFDAT A(FIL,REFI ENS,.01,"I "))
	1054	"RTN","PSO RREF",137, 0)
	1055	S QTY=$G( REFDATA(FI L,REFIENS, 1,"I"))
	1056	"RTN","PSO RREF",138, 0)
	1057	S DSUPP=$ G(REFDATA( FIL,REFIEN S,1.1,"I") )
	1058	"RTN","PSO RREF",139, 0)
	1059	S CLERK=$ G(REFDATA( FIL,REFIEN S,6,"E"))
	1060	"RTN","PSO RREF",140, 0)
	1061	S LOGDATE =$G(REFDAT A(FIL,REFI ENS,7,"I") )
	1062	"RTN","PSO RREF",141, 0)
	1063	; interna l division number (I EN to PSO SITE file)
	1064	"RTN","PSO RREF",142, 0)
	1065	S IDIV=$G (REFDATA(F IL,REFIENS ,8,"I"))
	1066	"RTN","PSO RREF",143, 0)
	1067	S EDIV=$G (REFDATA(F IL,REFIENS ,8,"E"))
	1068	"RTN","PSO RREF",144, 0)
	1069	S DISPDT= $G(REFDATA (FIL,REFIE NS,10.1,"I "))
	1070	"RTN","PSO RREF",145, 0)
	1071	S NDC=$G( REFDATA(FI L,REFIENS, 11,"E"))
	1072	"RTN","PSO RREF",146, 0)
	1073	S RSITE=$ G(REFDATA( FIL,REFIEN S,91,"I"))
	1074	"RTN","PSO RREF",147, 0)
	1075	S RPHARM= $G(REFDATA (FIL,REFIE NS,92,"E") )
	1076	"RTN","PSO RREF",148, 0)
	1077	S RPHONE= $G(REFDATA (FIL,REFIE NS,93,"E") )
	1078	"RTN","PSO RREF",149, 0)
	1079	S $P(DAT( 1),U,3)=RX NUM,$P(DAT (1),U,4)=R SITE,$P(DA T(1),U,7)= QTY,$P(DAT (1),U,8)=
	1080	DISPDT,$P( DAT(1),U,9 )=DNAME,$P (DAT(1),U, 10)=DSUPP, $P(DAT(1), U,11)=RPHA RM,$P(DAT
	1081	(1),U,12)= RFILLDT
	1082	"RTN","PSO RREF",150, 0)
	1083	D LOGDATA ^PSORWRAP( $NA(DAT)," OR",,,PSOI EN)
	1084	"RTN","PSO RREF",151, 0)
	1085	S PSOMSG( 0)=1_U_RXN UM_U_PSOIE N_U_REFIEN _U_RFILLDT _U_DNAME_U _QTY_U_DSU PP_U_CLER
	1086	K_U_LOGDAT E_U_IDIV_U _EDIV_U_DI SPDT_U_NDC _U_RPHARM_ U_RPHONE_U _RSITE_U_P ASSLOC
	1087	"RTN","PSO RREF",152, 0)
	1088	Q
	1089	"RTN","PSO RREF0")
	1090	0^3^B43141 161^B46515 290
	1091	"RTN","PSO RREF0",1,0 )
	1092	PSORREF0 ; AITC/BWF Remote RX refill API ;7/15/16 1:57am
	1093	"RTN","PSO RREF0",2,0 )
	1094	;;7.0;OUT PATIENT PH ARMACY;4 54,497;D EC 1997;Bu ild 22
	1095	"RTN","PSO RREF0",3,0 )
	1096	;
	1097	"RTN","PSO RREF0",4,0 )
	1098	;External reference to ^PSDRU G supporte d by DBIA 221
	1099	"RTN","PSO RREF0",5,0 )
	1100	;
	1101	"RTN","PSO RREF0",6,0 )
	1102	; Modifie d copy of ^PSOREF0 f or the One VA Pharmac y Project - remote p rescripti
	1103	ons
	1104	"RTN","PSO RREF0",7,0 )
	1105	;
	1106	"RTN","PSO RREF0",8,0 )
	1107	;PSO*186 add check for DEA Sp ecial hand ling field refill re strictions
	1108	"RTN","PSO RREF0",9,0 )
	1109	Q
	1110	"RTN","PSO RREF0",10, 0)
	1111	PROCESS(PS ORMSG) ;
	1112	"RTN","PSO RREF0",11, 0)
	1113	K PSODF S PSOREF("R X0")=^PSRX (PSOREF("I RXN"),0),P SOREF("RX2 ")=^(2),PS OREF("RX3
	1114	")=^(3),PS OREF("STA" )=+$G(^("S TA")),PSOR EF("SIG")= $P($G(^("S IG")),"^") ,PSOREF("
	1115	PSODFN")=$ P(PSOREF(" RX0"),"^", 2)
	1116	"RTN","PSO RREF0",12, 0)
	1117	S PSOREF( "DAYS SUPP LY")=$P(PS OREF("RX0" ),"^",8)
	1118	"RTN","PSO RREF0",13, 0)
	1119	K ZD(PSOR EF("IRXN") ) ;*306
	1120	"RTN","PSO RREF0",14, 0)
	1121	S PSOREF( "DFLG")=0 D DSPLY G: PSOREF("DF LG") PROCE SSX
	1122	"RTN","PSO RREF0",15, 0)
	1123	D CHECK G :$G(PSODF) PROCESS G :PSOREF("D FLG") PROC ESSX D EN^ PSOR52(.PS OREF)
	1124	"RTN","PSO RREF0",16, 0)
	1125	PROCESSX D :$G(PSOREF ("OLD FILL DATE"))]" " SUSDATEK ^PSOUTIL(. PSOREF)
	1126	"RTN","PSO RREF0",17, 0)
	1127	Q
	1128	"RTN","PSO RREF0",18, 0)
	1129	DSPLY ;
	1130	"RTN","PSO RREF0",19, 0)
	1131	K FSIG,BS IG I $P($G (^PSRX(PSO REF("IRXN" ),"SIG")), "^",2) D F SIG^PSOUTL A("R",PSO
	1132	REF("IRXN" ),54) F PS REV=1:1 Q: '$D(FSIG(P SREV)) S BSIG(PSREV )=FSIG(PSR EV)
	1133	"RTN","PSO RREF0",20, 0)
	1134	K FSIG,PS REV I '$P( $G(^PSRX(P SOREF("IRX N"),"SIG") ),"^",2) D EN2^PSOUT LA1(PSORE
	1135	F("IRXN"), 54)
	1136	"RTN","PSO RREF0",21, 0)
	1137	I $O(BSIG (1)) F PSR EV=1:0 S P SREV=$O(BS IG(PSREV)) Q:'PSREV W !?24,$G (BSIG(PSR
	1138	EV))
	1139	"RTN","PSO RREF0",22, 0)
	1140	K BSIG,PS REV
	1141	"RTN","PSO RREF0",23, 0)
	1142	DSPLYX Q
	1143	"RTN","PSO RREF0",24, 0)
	1144	CHECK ;
	1145	"RTN","PSO RREF0",25, 0)
	1146	N STA
	1147	"RTN","PSO RREF0",26, 0)
	1148	I '$P(PSO PAR,"^",11 ),$G(^PSDR UG($P(PSOR EF("RX0"), "^",6),"I" ))]"",DT>$ G(^("I"))
	1149	D G CKQ
	1150	"RTN","PSO RREF0",27, 0)
	1151	.S PSORMS G(1)=" *** Drug is i nactive fo r Rx # "_$ P(PSOREF(" RX0"),"^") _" cannot
	1152	be refill ed ***"
	1153	"RTN","PSO RREF0",28, 0)
	1154	I PSOREF( "PSODFN")' =PSODFN S PSORMSG(1) ="Can't re fill Rx # "_$P(PSORE F("RX0"),
	1155	"^")_", it is not fo r this pat ient." G C KQ
	1156	"RTN","PSO RREF0",29, 0)
	1157	S (PSOX,P SOY,STA)=" "
	1158	"RTN","PSO RREF0",30, 0)
	1159	I $G(PSOS D) F S ST A=$O(PSOSD (STA)) Q:S TA="" F S PSOX=$O( PSOSD(STA, PSOX)) Q:
	1160	PSOX']""!( PSOREF("DF LG")) I P SOREF("IRX N")=+PSOSD (STA,PSOX) S PSOY=PS OSD(STA,P
	1161	SOX) I $P( PSOY,"^",4 )]"" D
	1162	"RTN","PSO RREF0",31, 0)
	1163	. S PSORE F("DFLG")= 1 S:'$G(PS OERR) PSOR MSG(1)="Ca nnot refil l Rx # "_$ P(PSOREF(
	1164	"RX0"),"^" ) S PSOREA =$P(PSOY," ^",4),PSOS TAT=PSOREF ("STA")
	1165	"RTN","PSO RREF0",32, 0)
	1166	. D STATU S(PSOREA,P SOSTAT,.PS ORMSG) K P SOREA,PSOS TAT
	1167	"RTN","PSO RREF0",33, 0)
	1168	. Q
	1169	"RTN","PSO RREF0",34, 0)
	1170	I PSOY="" S PSORMSG (1)="Canno t refill, Rx is disc ontinued o r expired. Later R
	1171	x may exis t." D I $ G(PSODF) Q
	1172	"RTN","PSO RREF0",35, 0)
	1173	.D LOOK I $G(PSODF) Q
	1174	"RTN","PSO RREF0",36, 0)
	1175	.S PSOREF ("DFLG")=1
	1176	"RTN","PSO RREF0",37, 0)
	1177	K PSOX,PS OY G:PSORE F("DFLG") CHECKX
	1178	"RTN","PSO RREF0",38, 0)
	1179	I $O(^PS( 52.5,"B",P SOREF("IRX N"),0)),'$ G(^PS(52.5 ,+$O(^PS(5 2.5,"B",PS OREF("IRX
	1180	N"),0)),"P ")) S PSOR MSG(1)="Rx is in sus pense and cannot be refilled" S PSOREF(
	1181	"DFLG")=1 G CHECKX
	1182	"RTN","PSO RREF0",39, 0)
	1183	S PSOREF( "RXSTATUS" )=PSOREF(" STA")
	1184	"RTN","PSO RREF0",40, 0)
	1185	I PSOREF( "RXSTATUS" ),PSOREF(" RXSTATUS") '=6 D G C HECKX
	1186	"RTN","PSO RREF0",41, 0)
	1187	. S PSOY= ";"_PSOREF ("RXSTATUS "),PSOX=$P (^DD(52,10 0,0),"^",3 ),PSOY=$F( PSOX,PSOY
	1188	),PSOY=$P( $E(PSOX,PS OY,999),"; ",1) ;IA #999
	1189	"RTN","PSO RREF0",42, 0)
	1190	. S PSORM SG(1)="Rx is in "_PS OY_" statu s, cannot be refille d" S PSORE F("DFLG")
	1191	=1
	1192	"RTN","PSO RREF0",43, 0)
	1193	D CHKDIV G:PSOREF(" DFLG") CHE CKX
	1194	"RTN","PSO RREF0",44, 0)
	1195	D NUMBER I PSOREF(" NUMBER")>$ P(PSOREF(" RX0"),"^", 9) S PSORM SG(1)="Can 't refill
	1196	, no refil ls remaini ng." S PSO REF("DFLG" )=1 G CHEC KX
	1197	"RTN","PSO RREF0",45, 0)
	1198	;PSO718 6 check D EA, SPEC H NDLG field , in case changed, a nd apply
	1199	"RTN","PSO RREF0",46, 0)
	1200	N PSODRG, PSODEA,PSO DAY
	1201	"RTN","PSO RREF0",47, 0)
	1202	S PSODRG= $G(^PSDRUG ($P(PSOREF ("RX0"),U, 6),0)),PSO DEA=$P(PSO DRG,U,3)
	1203	"RTN","PSO RREF0",48, 0)
	1204	S PSODAY= $P(PSOREF( "RX0"),U,8 )
	1205	"RTN","PSO RREF0",49, 0)
	1206	I $$DEACH K^PSOUTLA1 (PSOREF("I RXN"),PSOD EA,PSODAY) D G CHEC KX
	1207	"RTN","PSO RREF0",50, 0)
	1208	. S PSORM SG(1)="Thi s drug has been chan ged, No re fills allo wed"
	1209	"RTN","PSO RREF0",51, 0)
	1210	. S PSORE F("DFLG")= 1
	1211	"RTN","PSO RREF0",52, 0)
	1212	D DATES
	1213	"RTN","PSO RREF0",53, 0)
	1214	CHECKX Q
	1215	"RTN","PSO RREF0",54, 0)
	1216	CKQ ;
	1217	"RTN","PSO RREF0",55, 0)
	1218	S PSOREF( "DFLG")=1 D PAUSE^VA LM1 G CHEC KX
	1219	"RTN","PSO RREF0",56, 0)
	1220	Q
	1221	"RTN","PSO RREF0",57, 0)
	1222	;
	1223	"RTN","PSO RREF0",58, 0)
	1224	; PSO74 97 - quitt ing at CHK DIV functi on, the lo gic that w as execute d does no
	1225	t apply to OneVA Pha rmacy, per Rob Silve rman
	1226	"RTN","PSO RREF0",59, 0)
	1227	CHKDIV Q
	1228	"RTN","PSO RREF0",60, 0)
	1229	CHKDIVX Q
	1230	"RTN","PSO RREF0",61, 0)
	1231	;
	1232	"RTN","PSO RREF0",62, 0)
	1233	NUMBER K P SOX,PSOY S PSOREF("# OF REFILL S")=0
	1234	"RTN","PSO RREF0",63, 0)
	1235	I $G(^PSR X(PSOREF(" IRXN"),1,0 ))]"" F PS OX=0:0 S P SOX=$O(^PS RX(PSOREF( "IRXN"),1
	1236	,PSOX)) Q: 'PSOX S P SOREF("# O F REFILLS" )=PSOX
	1237	"RTN","PSO RREF0",64, 0)
	1238	S PSOREF( "NUMBER")= PSOREF("# OF REFILLS ")+1
	1239	"RTN","PSO RREF0",65, 0)
	1240	Q
	1241	"RTN","PSO RREF0",66, 0)
	1242	;
	1243	"RTN","PSO RREF0",67, 0)
	1244	DATES S PS OREF("STOP DATE")=$P (PSOREF("R X2"),"^",6 ) D NEXT^P SOUTIL(.PS OREF)
	1245	"RTN","PSO RREF0",68, 0)
	1246	D:$G(PSOB BC("QFLG") )&($P(PSOP AR,"^",6)) EDATE Q:$ G(PSOREF(" DFLG"))
	1247	"RTN","PSO RREF0",69, 0)
	1248	S PSOREF( "FILL DATE ")=$S($G(P SOREF("FIL L DATE")): PSOREF("FI LL DATE"), 1:DT)
	1249	"RTN","PSO RREF0",70, 0)
	1250	I $P(PSOP AR,"^",6), PSOREF("FI LL DATE")< $P(PSOREF( "RX3"),"^" ,2) D SUSD ATE^PSOUT
	1251	IL(.PSOREF )
	1252	"RTN","PSO RREF0",71, 0)
	1253	;
	1254	"RTN","PSO RREF0",72, 0)
	1255	I PSOREF( "FILL DATE ")>PSOREF( "STOP DATE ") D
	1256	"RTN","PSO RREF0",73, 0)
	1257	. S PSORM SG(1)="Can 't refill, Refill Da te "_$E(PS OREF("FILL DATE"),4, 5)_"/"_$E
	1258	(PSOREF("F ILL DATE") ,6,7)_"/"
	1259	"RTN","PSO RREF0",74, 0)
	1260	. S PSORM SG(2)=$E(P SOREF("FIL L DATE"),2 ,3)_" is p ast Expira tion Date "_$E(PSOR
	1261	EF("STOP D ATE"),4,5) _"/"_$E(PS OREF("STOP DATE"),6, 7)_"/"
	1262	"RTN","PSO RREF0",75, 0)
	1263	. S PSORM SG(3)=$E(P SOREF("STO P DATE"),2 ,3) S PSOR EF("DFLG") =1
	1264	"RTN","PSO RREF0",76, 0)
	1265	EDATE S PS OREF("LAST REFILL DA TE")=$P(PS OREF("RX3" ),"^",1)
	1266	"RTN","PSO RREF0",77, 0)
	1267	I PSOREF( "LAST REFI LL DATE"), PSOREF("FI LL DATE")= PSOREF("LA ST REFILL DATE") D
	1268	G DATESX
	1269	"RTN","PSO RREF0",78, 0)
	1270	. S PSORM SG(1)="Can 't refill, Fill Date already e xists for "_$E(PSORE F("FILL D
	1271	ATE"),4,5) _"/"_$E(PS OREF("FILL DATE"),6, 7)_"/"_$E( PSOREF("FI LL DATE"), 2,3)
	1272	"RTN","PSO RREF0",79, 0)
	1273	. S PSORE F("DFLG")= 1
	1274	"RTN","PSO RREF0",80, 0)
	1275	I PSOREF( "LAST REFI LL DATE"), PSOREF("FI LL DATE")< PSOREF("LA ST REFILL DATE") D
	1276	G DATESX
	1277	"RTN","PSO RREF0",81, 0)
	1278	. S PSORM SG(1)="Can 't refill, later Ref ill Date a lready exi sts for "_ $E(PSOREF
	1279	("LAST REF ILL DATE") ,4,5)_"/"_ $E(PSOREF( "LAST REFI LL DATE"), 6,7)_"/"_$ E(PSOREF(
	1280	"LAST REFI LL DATE"), 2,3)
	1281	"RTN","PSO RREF0",82, 0)
	1282	. S PSORE F("DFLG")= 1
	1283	"RTN","PSO RREF0",83, 0)
	1284	; PSO74 97 - remov ing this c heck, as i t is not n eeded.
	1285	"RTN","PSO RREF0",84, 0)
	1286	;I '$P(PS OPAR,"^",6 ),'$D(PSOR EF("EAOK") ),$P(PSORE F("RX3")," ^",2)>PSOR EF("FILL
	1287	DATE") D
	1288	"RTN","PSO RREF0",85, 0)
	1289	;. S PSOX 1=(PSOREF( "NUMBER")+ 1)*PSOREF( "DAYS SUPP LY")-10
	1290	"RTN","PSO RREF0",86, 0)
	1291	;. ; PSO* 7*497 - re placing li ne below w ith one th at follows (auto-sus pend defe
	1292	ct - do no t allow by pass)
	1293	"RTN","PSO RREF0",87, 0)
	1294	;. ;W !?5 ,$C(7),"LE SS THAN ", PSOX1," DA YS FOR ",P SOREF("NUM BER")+1," FILLS",!
	1295	D DIR K PS OX1
	1296	"RTN","PSO RREF0",88, 0)
	1297	;. S PSOR MSG(1)="LE SS THAN "_ PSOX1_" DA YS FOR "_P SOREF("NUM BER")+1_" FILLS" S
	1298	(PSOREF("D FLG"),PSOM HV)=1 K PS OX1
	1299	"RTN","PSO RREF0",89, 0)
	1300	; PSO(7*4 97 - repla cing line below with the one t hat follow s - EAOK c heck and
	1301	auto-suspe nd flag ar e irreleva nt for one va pharmac y
	1302	"RTN","PSO RREF0",90, 0)
	1303	;I '$P(PS OPAR,"^",6 ),$G(PSORE F("EAOK")) =0,$P(PSOR EF("RX3"), "^",2)>PSO REF("FILL
	1304	DATE") D
	1305	"RTN","PSO RREF0",91, 0)
	1306	I $P(PSOR EF("RX3"), "^",2)>PSO REF("FILL DATE") D
	1307	"RTN","PSO RREF0",92, 0)
	1308	. ; PSO7 497 - rep lacing lin e below wi th one tha t follows (auto-susp end defec
	1309	t)
	1310	"RTN","PSO RREF0",93, 0)
	1311	. ;S Y=$P (PSOREF("R X3"),"^",2 ) D DD^%DT W !!,$C(7 ),"Cannot be refille d until "
	1312	_Y_"." S ( PSOREF("DF LG"),PSOMH V)=1 K Y
	1313	"RTN","PSO RREF0",94, 0)
	1314	. S Y=$P( PSOREF("RX 3"),"^",2) D DD^%DT S PSORMSG( 1)="Cannot be refill ed until
	1315	"_Y_"." S (PSOREF("D FLG"))=1 K Y
	1316	"RTN","PSO RREF0",95, 0)
	1317	DATESX Q
	1318	"RTN","PSO RREF0",96, 0)
	1319	; PSO*497 - quit at DIR. This is not us ed for one va pharmac y.
	1320	"RTN","PSO RREF0",97, 0)
	1321	DIR ;
	1322	"RTN","PSO RREF0",98, 0)
	1323	Q
	1324	"RTN","PSO RREF0",99, 0)
	1325	;
	1326	"RTN","PSO RREF0",100 ,0)
	1327	EN(PSOREF) ; Entry Poi nt for Bat ch Barcode Option
	1328	"RTN","PSO RREF0",101 ,0)
	1329	D PROCESS K DRUG,PS ODF
	1330	"RTN","PSO RREF0",102 ,0)
	1331	Q
	1332	"RTN","PSO RREF0",103 ,0)
	1333	LOOK ;this entry is used to tr y and find current m ed order
	1334	"RTN","PSO RREF0",104 ,0)
	1335	S (PSOY,S TA,PSOX)=" ",DRUG=$P( ^PSDRUG($P (^PSRX(PSO REF("IRXN" ),0),"^",6 ),0),"^")
	1336	"RTN","PSO RREF0",105 ,0)
	1337	I $G(PSOS D) F S ST A=$O(PSOSD (STA)) Q:S TA="" F S PSOX=$O( PSOSD(STA, PSOX)) Q:
	1338	PSOX']"" I DRUG=PSO X,+PSOSD(S TA,PSOX) S PSOY=PSOS D(STA,PSOX ),PSOREF(" IRXN")=+P
	1339	SOSD(STA,P SOX),PSODF =1,PSOBBC( "DONE")=PS OREF("IRXN ")_"," Q
	1340	"RTN","PSO RREF0",106 ,0)
	1341	K DRUG
	1342	"RTN","PSO RREF0",107 ,0)
	1343	Q
	1344	"RTN","PSO RREF0",108 ,0)
	1345	;
	1346	"RTN","PSO RREF0",109 ,0)
	1347	STATUS(PSO REA,PSOSTA T,PSORMSG) ;
	1348	"RTN","PSO RREF0",110 ,0)
	1349	N DSMSG,P SOA,PSOB,T ARGET
	1350	"RTN","PSO RREF0",111 ,0)
	1351	S DSMSG=P SORMSG(1)
	1352	"RTN","PSO RREF0",112 ,0)
	1353	I PSOREA[ "A" S DSMS G=DSMSG_" Inactive D rug."
	1354	"RTN","PSO RREF0",113 ,0)
	1355	I PSOREA[ "M" S DSMS G=DSMSG_" Drug no lo nger used by Outpati ent."
	1356	"RTN","PSO RREF0",114 ,0)
	1357	I PSOREA[ "B" S DSMS G=DSMSG_" Narcotic D rug."
	1358	"RTN","PSO RREF0",115 ,0)
	1359	I PSOREA[ "C" S DSMS G=DSMSG_" Non-Renewa ble Drug."
	1360	"RTN","PSO RREF0",116 ,0)
	1361	I PSOREA[ "D" S DSMS G=DSMSG_" Non-Renewa ble Patien t Status."
	1362	"RTN","PSO RREF0",117 ,0)
	1363	I PSOREA[ "E" S DSMS G=DSMSG_" Non-Verifi ed Rx."
	1364	"RTN","PSO RREF0",118 ,0)
	1365	I PSOREA[ "F" S DSMS G=DSMSG_" Maximum of 26 Renewa ls."
	1366	"RTN","PSO RREF0",119 ,0)
	1367	I PSOREA[ "G" S DSMS G=DSMSG_" No refills left."
	1368	"RTN","PSO RREF0",120 ,0)
	1369	I PSOREA[ "Z" D
	1370	"RTN","PSO RREF0",121 ,0)
	1371	. S:PSOST AT=4 PSOST AT=1
	1372	"RTN","PSO RREF0",122 ,0)
	1373	. S PSOA= ";"_PSOSTA T
	1374	"RTN","PSO RREF0",123 ,0)
	1375	. D FIELD ^DID(52,10 0,,"POINTE R","TARGET ")
	1376	"RTN","PSO RREF0",124 ,0)
	1377	. S PSOB= $G(TARGET( "POINTER") )
	1378	"RTN","PSO RREF0",125 ,0)
	1379	. Q:PSOB= ""
	1380	"RTN","PSO RREF0",126 ,0)
	1381	. S PSOA= $F(PSOB,PS OA),PSOA=$ P($E(PSOB, PSOA,999), ";",1)
	1382	"RTN","PSO RREF0",127 ,0)
	1383	. S DSMSG =DSMSG_" R x is in "_ $P(PSOA,": ",2)_" sta tus."
	1384	"RTN","PSO RREF0",128 ,0)
	1385	. K PSOA, PSOB
	1386	"RTN","PSO RREF0",129 ,0)
	1387	. Q
	1388	"RTN","PSO RREF0",130 ,0)
	1389	S PSORMSG (1)=DSMSG
	1390	"RTN","PSO RREF0",131 ,0)
	1391	Q
	1392	"RTN","PSO RRPA1")
	1393	0^2^B80588 571^B75343 267
	1394	"RTN","PSO RRPA1",1,0 )
	1395	PSORRPA1 ; AITC/BWF - remote pa rtial pres criptions ;12/12/16 3:21pm
	1396	"RTN","PSO RRPA1",2,0 )
	1397	;;7.0;OUT PATIENT PH ARMACY;4 54,475,497 ;DEC 199 7;Build 22
	1398	"RTN","PSO RRPA1",3,0 )
	1399	;
	1400	"RTN","PSO RRPA1",4,0 )
	1401	;External reference s L,UL, PS OL, and PS OUL^PSSLOC K supporte d by DBIA 2789
	1402	"RTN","PSO RRPA1",5,0 )
	1403	;External reference to ^PSDRU G supporte d by DBIA 221
	1404	"RTN","PSO RRPA1",6,0 )
	1405	;External reference to ^DD(52 supported by DBIA 9 99
	1406	"RTN","PSO RRPA1",7,0 )
	1407	; bwf - M odified co py of PSOR XPA1
	1408	"RTN","PSO RRPA1",8,0 )
	1409	; bwf - 2 /24/14 add ing PAR re fill tag f or API usa ge.
	1410	"RTN","PSO RRPA1",9,0 )
	1411	; VALMSG - return data for r emote faci lity
	1412	"RTN","PSO RRPA1",10, 0)
	1413	; RXNUM - rx numb er
	1414	"RTN","PSO RRPA1",11, 0)
	1415	; PFDATE - Partial Fill Date
	1416	"RTN","PSO RRPA1",12, 0)
	1417	; MW - Mail or Window
	1418	"RTN","PSO RRPA1",13, 0)
	1419	; QTY - Quantit y
	1420	"RTN","PSO RRPA1",14, 0)
	1421	; DSUPP - Days Su pply
	1422	"RTN","PSO RRPA1",15, 0)
	1423	; REMARKS - Remarks entered b y 'remote' (filling) facility.
	1424	"RTN","PSO RRPA1",16, 0)
	1425	; PHARM - Remote pharmacist 's name
	1426	"RTN","PSO RRPA1",17, 0)
	1427	; PHONE - remote pharmacist s phone nu mber
	1428	"RTN","PSO RRPA1",18, 0)
	1429	; SITE - remote filling si te.
	1430	"RTN","PSO RRPA1",19, 0)
	1431	;
	1432	"RTN","PSO RRPA1",20, 0)
	1433	PAR(VALMSG ,RXNUM,PFD ATE,MW,QTY ,DSUPP,REM ARKS,PHARM ,PHONE,SIT E,RX0,RX2, RXSTA,RPR
	1434	OV,RSIG,RP AR0,ROR1,R X3,RREF0) ;
	1435	"RTN","PSO RRPA1",21, 0)
	1436	N RRXIEN, PSOPAR,ORN ,PSOLST,XT MPLOC,PASS LOC,HFSIEN ,FULLPTH,H FSDONE,PTH DAT,PTHPI
	1437	ECE,DEL,DE LARR,FTGOP EN,FOUND,F TGSTRT,FTG OPEN,STATI ON,HDRUG
	1438	"RTN","PSO RRPA1",22, 0)
	1439	N PERR,PD IR,PFIL,CS VAL,C,D,E, NEWPFIEN,P FIEN,PFIEN S,PSOEXREP ,PSOFROM,D INACT,PSO
	1440	PHDUZ,PSOD FDIR,PSOFN AME,PSOZ1, RREFIEN
	1441	"RTN","PSO RRPA1",23, 0)
	1442	S $ETRAP= "D ^%ZTER Q"
	1443	"RTN","PSO RRPA1",24, 0)
	1444	S (RRXIEN ,RXN)=$O(^ PSRX("B",R XNUM,0)),P SOSIEN=$$G ET1^DIQ(52 ,RRXIEN,20 ,"I")
	1445	"RTN","PSO RRPA1",25, 0)
	1446	I '$$GET1 ^DIQ(59.7, 1,101,"I") D Q
	1447	"RTN","PSO RRPA1",26, 0)
	1448	.S VALMSG (1)="The O neVA pharm acy flag i s turned ' OFF' at th is facilit y."
	1449	"RTN","PSO RRPA1",27, 0)
	1450	.S VALMSG (2)="Unabl e to proce ss refill/ partial fi ll request s."
	1451	"RTN","PSO RRPA1",28, 0)
	1452	.D PARFAI L(.VALMSG, RRXIEN,PHA RM,PHONE,S ITE)
	1453	"RTN","PSO RRPA1",29, 0)
	1454	; PSO74 97 - trade name bloc k
	1455	"RTN","PSO RRPA1",30, 0)
	1456	I $$GET1^ DIQ(52,RRX IEN,6.5,"E ")]"" D Q
	1457	"RTN","PSO RRPA1",31, 0)
	1458	.D PARFAI L(.VALMSG, RRXIEN,PHA RM,PHONE,S ITE)
	1459	"RTN","PSO RRPA1",32, 0)
	1460	.S VALMSG (1)="This prescripti on cannot be refille d or parti al filled because i
	1461	t has a va lue"
	1462	"RTN","PSO RRPA1",33, 0)
	1463	.S VALMSG (2)="enter ed in the Rx trade n ame field. Please f ollow loca l policy
	1464	for obtain ing"
	1465	"RTN","PSO RRPA1",34, 0)
	1466	.S VALMSG (3)="a new prescript ion."
	1467	"RTN","PSO RRPA1",35, 0)
	1468	; PSO74 97 - end t rade name block
	1469	"RTN","PSO RRPA1",36, 0)
	1470	S HDRUG=$ $GET1^DIQ( 52,RRXIEN, 6,"I")
	1471	"RTN","PSO RRPA1",37, 0)
	1472	S DINACT= $$GET1^DIQ (50,HDRUG, 100,"I")
	1473	"RTN","PSO RRPA1",38, 0)
	1474	I DINACT> 0,DINACT<$ $NOW^XLFDT S VALMSG( 1)="Drug i s inactive for Rx# " _RXNUM_".
	1475	Cannot pr ocess part ial fill." D PARFAIL (.VALMSG,R RXIEN,PHAR M,PHONE,SI TE) Q
	1476	"RTN","PSO RRPA1",39, 0)
	1477	S CSVAL=$ $GET1^DIQ( 50,HDRUG,3 ,"E"),CSVA L=$E(CSVAL ,1)
	1478	"RTN","PSO RRPA1",40, 0)
	1479	I CSVAL,C SVAL>0,CSV AL<6 D PAR FAIL(.VALM SG,RRXIEN, PHARM,PHON E,SITE) S VALMSG(1)
	1480	="Rx #"_RX NUM_" cann ot be part ially fill ed. The as sociated d rug is con sidered a
	1481	controlle d substanc e at the h ost facili ty." Q
	1482	"RTN","PSO RRPA1",41, 0)
	1483	I $D(^PSR X(RRXIEN," ADP",PFDAT E,RRXIEN)) S VALMSG( 1)="A part ial fill a lready ex
	1484	ists for " _$$FMTE^XL FDT(PFDATE ,"5D")_"." ,VALMSG(2) ="Partial cannot be processed
	1485	" D PARFAI L(.VALMSG, RRXIEN,PHA RM,PHONE,S ITE) Q
	1486	"RTN","PSO RRPA1",42, 0)
	1487	S PSOPAR= $G(^PS(59, PSOSIEN,1) ),PSOSITE= PSOSIEN
	1488	"RTN","PSO RRPA1",43, 0)
	1489	; set up PSOLST
	1490	"RTN","PSO RRPA1",44, 0)
	1491	S ORN=1,P SOLST(ORN) =52_U_RRXI EN_U_U
	1492	"RTN","PSO RRPA1",45, 0)
	1493	S PSOPHDU Z=$$GET1^D IQ(52,RRXI EN,23,"I") I 'PSOPHD UZ S PSOPH DUZ=.5
	1494	"RTN","PSO RRPA1",46, 0)
	1495	S PSORPDF N=+$P($G(^ PSRX($P(PS OLST(ORN), "^",2),0)) ,"^",2)
	1496	"RTN","PSO RRPA1",47, 0)
	1497	S DA=$P(P SOLST(ORN) ,"^",2),RX 0=^PSRX(DA ,0),J=DA,R X2=$G(^(2) ),R3=$G(^( 3)) S:'$G
	1498	(BBFLG) BB RX(1)=""
	1499	"RTN","PSO RRPA1",48, 0)
	1500	N PSORF,P SOTRIC D T RIC^PSORXL 1(DA) I PS OTRIC&($$S TATUS^PSOB PSUT(DA,PS ORF)'["PA
	1501	YABLE") D Q
	1502	"RTN","PSO RRPA1",49, 0)
	1503	. S VALMS G(1)="Part ial cannot be filled on Tricar e non-paya ble Rx."
	1504	"RTN","PSO RRPA1",50, 0)
	1505	. D PARFA IL(.VALMSG ,RRXIEN,PH ARM,PHONE, SITE)
	1506	"RTN","PSO RRPA1",51, 0)
	1507	I +$P($G( ^PSRX(DA,2 )),"^",6)< DT D
	1508	"RTN","PSO RRPA1",52, 0)
	1509	.S:$P($G( ^PSRX(DA," STA")),"^" )<12 $P(^P SRX(DA,"ST A"),"^")=1 1
	1510	"RTN","PSO RRPA1",53, 0)
	1511	.S COMM=" Medication Expired o n "_$E($P( ^PSRX(DA,2 ),"^",6),4 ,5)_"/"_$E ($P(^(2),
	1512	"^",6),6,7 )_"/"_$E($ P(^(2),"^" ,6),2,3)
	1513	"RTN","PSO RRPA1",54, 0)
	1514	.S STAT=" SC",PHARMS T="ZE" D E N^PSOHLSN1 (DA,STAT,P HARMST,COM M) K STAT, PHARMST,C
	1515	OMM,RX0,J, RX2,R3
	1516	"RTN","PSO RRPA1",55, 0)
	1517	I +^PSRX( DA,"STA"), +^("STA")' =5,+^("STA ")'=11 D K DA D ULK Q
	1518	"RTN","PSO RRPA1",56, 0)
	1519	.S C=";"_ +^PSRX(DA, "STA")_":" ,X=$P(^DD( 52,100,0), "^",3),E=$ F(X,C),D=$ P($E(X,E,
	1520	999),";") ;IA#999
	1521	"RTN","PSO RRPA1",57, 0)
	1522	.S VALMSG (1)="Presc ription is in a "_D_ " status."
	1523	"RTN","PSO RRPA1",58, 0)
	1524	.D PARFAI L(.VALMSG, RRXIEN,PHA RM,PHONE,S ITE)
	1525	"RTN","PSO RRPA1",59, 0)
	1526	I $G(PSXS YS),($O(^P S(52.5,"B" ,DA,""))) S PSOZ1=$O (^PS(52.5, "B",DA,"") ) D
	1527	"RTN","PSO RRPA1",60, 0)
	1528	.I $P($G( ^PS(52.5,P SOZ1,0))," ^",7)="Q"! ($P($G(^(0 )),"^",7)= "L") D
	1529	"RTN","PSO RRPA1",61, 0)
	1530	..S VALMS G(1)="A pa rtial ente red for th is Rx cann ot be susp ended."
	1531	"RTN","PSO RRPA1",62, 0)
	1532	..S VALMS G(2)="A fi ll for thi s Rx is al ready susp ended for CMOP trans mission."
	1533	"RTN","PSO RRPA1",63, 0)
	1534	..S VALMS G(3)="You may pull t his fill f rom suspen se or ente r a partia l and pri
	1535	nt the lab el."
	1536	"RTN","PSO RRPA1",64, 0)
	1537	..D PARFA IL(.VALMSG ,RRXIEN,PH ARM,PHONE, SITE)
	1538	"RTN","PSO RRPA1",65, 0)
	1539	CLC S PSOC LC=PSOPHDU Z,PHYS=$P( ^PSRX(DA,0 ),"^",4),D RG=$P(^(0) ,"^",6)
	1540	"RTN","PSO RRPA1",66, 0)
	1541	I 'PHYS,$ O(^PSRX(DA ,1,0)) F I =0:0 S I=$ O(^PSRX(DA ,1,I)) Q:' I S PHYS= $S($P(^PS
	1542	RX(DA,1,I, 0),"^",17) :$P(^PSRX( DA,1,I,0), "^",17),1: PHYS)
	1543	"RTN","PSO RRPA1",67, 0)
	1544	S PSOPRZ= 0 I $O(^PS RX(DA,"P", 0)) N Z2 F Z2=0:0 S Z2=$O(^PSR X(DA,"P",Z 2)) Q:'Z2
	1545	S PSOPRZ =Z2
	1546	"RTN","PSO RRPA1",68, 0)
	1547	I $D(RXPR (DA)),'$D( ^PSRX(DA," P",$G(RXPR (DA)))) D RMP^PSOCAN 3
	1548	"RTN","PSO RRPA1",69, 0)
	1549	; bwf - s ave inform ation into database, just as i t would be through ^ DIE
	1550	"RTN","PSO RRPA1",70, 0)
	1551	S FDA(52. 2,"+1,"_RR XIEN_",",. 01)=PFDATE D UPDATE^ DIE(,"FDA" ,"NEWPFIEN ","PERR")
	1552	K FDA
	1553	"RTN","PSO RRPA1",71, 0)
	1554	I $D(PERR ) M VALMSG =PERR
	1555	"RTN","PSO RRPA1",72, 0)
	1556	S PFIEN=$ O(NEWPFIEN (0)),PFIEN =$G(NEWPFI EN(PFIEN))
	1557	"RTN","PSO RRPA1",73, 0)
	1558	; set Z1 variable a s was done in the ^D IE call fo r later us e.
	1559	"RTN","PSO RRPA1",74, 0)
	1560	S Z1=PFIE N
	1561	"RTN","PSO RRPA1",75, 0)
	1562	S PFIENS= PFIEN_","_ RRXIEN_","
	1563	"RTN","PSO RRPA1",76, 0)
	1564	; set PM variable a s was done in the ^D IE call fo r later us e.
	1565	"RTN","PSO RRPA1",77, 0)
	1566	I MW="M"! ('$P($G(PS OPAR),U,12 )) S PM=1
	1567	"RTN","PSO RRPA1",78, 0)
	1568	S FDA(52. 2,PFIENS,. 02)=MW
	1569	"RTN","PSO RRPA1",79, 0)
	1570	S FDA(52. 2,PFIENS,. 04)=QTY
	1571	"RTN","PSO RRPA1",80, 0)
	1572	S FDA(52. 2,PFIENS,. 041)=DSUPP
	1573	"RTN","PSO RRPA1",81, 0)
	1574	; current ly we have no local pharmacist . May need to add en try to fil e 200 for
	1575	'REMOTE,P HARMACIST' or 'PHARM ACIST,REMO TE'
	1576	"RTN","PSO RRPA1",82, 0)
	1577	S FDA(52. 2,PFIENS,. 05)=PSOPHD UZ
	1578	"RTN","PSO RRPA1",83, 0)
	1579	; can we use DUZ as the clerk code, or will this need anoth er value??
	1580	"RTN","PSO RRPA1",84, 0)
	1581	S FDA(52. 2,PFIENS,. 07)=PSOPHD UZ
	1582	"RTN","PSO RRPA1",85, 0)
	1583	S FDA(52. 2,PFIENS,6 )=PHYS
	1584	"RTN","PSO RRPA1",86, 0)
	1585	S FDA(52. 2,PFIENS,. 08)=$$NOW^ XLFDT
	1586	"RTN","PSO RRPA1",87, 0)
	1587	S FDA(52. 2,PFIENS,. 09)=PSOSIT E
	1588	"RTN","PSO RRPA1",88, 0)
	1589	S FDA(52. 2,PFIENS,. 03)=REMARK S
	1590	"RTN","PSO RRPA1",89, 0)
	1591	;
	1592	"RTN","PSO RRPA1",90, 0)
	1593	; setting the parti al fill da te to the dispense d ate to mat ch the
	1594	"RTN","PSO RRPA1",91, 0)
	1595	; HL7 res ponse
	1596	"RTN","PSO RRPA1",92, 0)
	1597	S FDA(52. 2,PFIENS,7 .5)=PFDATE
	1598	"RTN","PSO RRPA1",93, 0)
	1599	;
	1600	"RTN","PSO RRPA1",94, 0)
	1601	S RXPR(RR XIEN)=PFIE N,PSOZZ=1, PRMK=REMAR KS
	1602	"RTN","PSO RRPA1",95, 0)
	1603	; file th e rest of the data o nto the ne wly create d multiple .
	1604	"RTN","PSO RRPA1",96, 0)
	1605	D FILE^DI E(,"FDA") K FDA
	1606	"RTN","PSO RRPA1",97, 0)
	1607	I Z1,$G(P RMK)]"" D D:$T(EN^P SOHDR)]"" EN^PSOHDR( "PPAR",RXN ) K DIE,RX N,RXF
	1608	"RTN","PSO RRPA1",98, 0)
	1609	.D ACT
	1610	"RTN","PSO RRPA1",99, 0)
	1611	.S ZD(RXN )=+^PSRX(R XN,"P",Z1, 0),^PSRX(R XN,"TYPE") =Z1,$P(^PS RX(RXN,"P" ,Z1,0),"^
	1612	",11)=$P($ G(^PSDRUG( DRG,660)), "^",6)
	1613	"RTN","PSO RRPA1",100 ,0)
	1614	S:'$D(PSO FROM) PSOF ROM="PARTI AL" S BING CRT=1 ;D:$ D(BINGRTE) &($D(DISGR OUP)) ^PS
	1615	OBING1 K B INGRTE,TM, TM1
	1616	"RTN","PSO RRPA1",101 ,0)
	1617	; bwf 8/1 4/14 - set up needed variables for label printing
	1618	"RTN","PSO RRPA1",102 ,0)
	1619	S PSODFN= $P(^PSRX(R RXIEN,0),U ,2)
	1620	"RTN","PSO RRPA1",103 ,0)
	1621	S PSORX(" PSOL",1)=R RXIEN_","
	1622	"RTN","PSO RRPA1",104 ,0)
	1623	S PSORX(" MAIL/WINDO W")="WINDO W"
	1624	"RTN","PSO RRPA1",105 ,0)
	1625	S PSORX(" NAME")=$$G ET1^DIQ(2, PSODFN,.01 )
	1626	"RTN","PSO RRPA1",106 ,0)
	1627	S PSORX(" QFLG")=0
	1628	"RTN","PSO RRPA1",107 ,0)
	1629	S PSORX(" METHOD OF PICKUP")=" "
	1630	"RTN","PSO RRPA1",108 ,0)
	1631	S PSOX=$G (^PS(55,PS ODFN,"PS") ) I PSOX]" " S PSORX( "PATIENT S TATUS")=$P ($G(^PS(5
	1632	3,PSOX,0)) ,"^")
	1633	"RTN","PSO RRPA1",109 ,0)
	1634	N PPL1
	1635	"RTN","PSO RRPA1",110 ,0)
	1636	S PPL1=RR XIEN
	1637	"RTN","PSO RRPA1",111 ,0)
	1638	S HFSDONE =0,PTHDAT= ""
	1639	"RTN","PSO RRPA1",112 ,0)
	1640	S PSODFDI R=$$DEFDIR ^%ZISH()
	1641	"RTN","PSO RRPA1",113 ,0)
	1642	S PSOFNAM E="PSOLBL_ "_RXNUM_"_ "_PSOSITE_ "_"_DT_".D AT"
	1643	"RTN","PSO RRPA1",114 ,0)
	1644	S FULLPTH =PSODFDIR_ PSOFNAME
	1645	"RTN","PSO RRPA1",115 ,0)
	1646	; bwf 8/1 4/14 - end setup for label pri nting.
	1647	"RTN","PSO RRPA1",116 ,0)
	1648	; preserv e IO
	1649	"RTN","PSO RRPA1",117 ,0)
	1650	D SAVDEV^ %ZISUTL("O NEVAHLIO")
	1651	"RTN","PSO RRPA1",118 ,0)
	1652	; delete the file f irst to en sure there isn't one lingering around
	1653	"RTN","PSO RRPA1",119 ,0)
	1654	S DELARR( "PSOLBL_"_ RXNUM_"_"_ PSOSITE_"_ "_DT_".DAT ")="" S DE L=$$DEL^%Z ISH(PSODF
	1655	DIR,$NA(DE LARR))
	1656	"RTN","PSO RRPA1",120 ,0)
	1657	S PSOEXRE P=1
	1658	"RTN","PSO RRPA1",121 ,0)
	1659	; call ou t to gener ate label
	1660	"RTN","PSO RRPA1",122 ,0)
	1661	D LABEL^P SORWRAP(RR XIEN,"HFS" ,PSOSITE,P SOPHDUZ,"" ,PSOFNAME)
	1662	"RTN","PSO RRPA1",123 ,0)
	1663	S XTMPLOC ="^XTMP("" PSORLBL"", "_HLINSTN_ ","_+RXNUM _",1,0)"
	1664	"RTN","PSO RRPA1",124 ,0)
	1665	S PASSLOC ="XTMP(""P SORLBL""," _HLINSTN_" ,"_+RXNUM_ ")"
	1666	"RTN","PSO RRPA1",125 ,0)
	1667	K ^XTMP(" PSORLBL",H LINSTN,+RX NUM)
	1668	"RTN","PSO RRPA1",126 ,0)
	1669	S ^XTMP(" PSORLBL",H LINSTN,+RX NUM,0)=DT_ U_$$FMADD^ XLFDT(DT,3 0)
	1670	"RTN","PSO RRPA1",127 ,0)
	1671	; looks l ike we hav e to wait a moment b efore the file shows up.
	1672	"RTN","PSO RRPA1",128 ,0)
	1673	S FTGSTRT =$$NOW^XLF DT,(FOUND, FTGOPEN)=0
	1674	"RTN","PSO RRPA1",129 ,0)
	1675	N PAR S P AR=0
	1676	"RTN","PSO RRPA1",130 ,0)
	1677	F D Q:$ $NOW^XLFDT >$$FMADD^X LFDT(FTGST RT,,,,15)! (FOUND)!(F TGOPEN)
	1678	"RTN","PSO RRPA1",131 ,0)
	1679	.S FTGOPE N=$$FTG^%Z ISH(PSODFD IR,PSOFNAM E,XTMPLOC, 4)
	1680	"RTN","PSO RRPA1",132 ,0)
	1681	.I $O(^XT MP("PSORLB L",HLINSTN ,+RXNUM,0) ) S FOUND= 1
	1682	"RTN","PSO RRPA1",133 ,0)
	1683	S DELARR( "PSOLBL_"_ RXNUM_"_"_ PSOSITE_"_ "_DT_".DAT ")="" S DE L=$$DEL^%Z ISH(PSODF
	1684	DIR,$NA(DE LARR))
	1685	"RTN","PSO RRPA1",134 ,0)
	1686	; restore IO
	1687	"RTN","PSO RRPA1",135 ,0)
	1688	D USE^%ZI SUTL("ONEV AHLIO"),RM DEV^%ZISUT L("ONEVAHL IO")
	1689	"RTN","PSO RRPA1",136 ,0)
	1690	D UPDPAR( .VALMSG,RR XIEN,PHARM ,PHONE,SIT E,PASSLOC)
	1691	"RTN","PSO RRPA1",137 ,0)
	1692	S RX0=$G( ^PSRX(RRXI EN,0)),RX2 =$G(^PSRX( RRXIEN,2)) ,RX3=$G(^P SRX(RRXIEN ,3))
	1693	"RTN","PSO RRPA1",138 ,0)
	1694	S RXSTA=$ G(^PSRX(RR XIEN,"STA" )),RPROV=$ $GET1^DIQ( 200,$P(RX0 ,U,4),.01, "E")_U_$$
	1695	GET1^DIQ(2 00,$P(RX0, U,16),.01, "E")
	1696	"RTN","PSO RRPA1",139 ,0)
	1697	S RSIG=$G (^PSRX(RRX IEN,"SIG") )
	1698	"RTN","PSO RRPA1",140 ,0)
	1699	S RPAR0=$ G(^PSRX(RR XIEN,"P",P FIEN,0))
	1700	"RTN","PSO RRPA1",141 ,0)
	1701	S ROR1=$G (^PSRX(RRX IEN,"OR1") )
	1702	"RTN","PSO RRPA1",142 ,0)
	1703	S RREFIEN =$O(^PSRX( RRXIEN,1," A"),-1)
	1704	"RTN","PSO RRPA1",143 ,0)
	1705	I RREFIEN S RREF0=$ G(^PSRX(RR XIEN,1,RRE FIEN,0))
	1706	"RTN","PSO RRPA1",144 ,0)
	1707	CLCX D ULK K DR,DIE, DRG,PPL,RX P,IOP,DA,P HYS,PSOPRZ ,PSORX,PSO SIEN,PSOSI TE,PSOX,P
	1708	SOZZ,PSXSY S,RXPR,ZD Q
	1709	"RTN","PSO RRPA1",145 ,0)
	1710	;
	1711	"RTN","PSO RRPA1",146 ,0)
	1712	KILL S DA= Z1,DIK="^P SRX("_RXN_ ",""P""," D ^DIK S ^ PSRX(RXN," TYPE")=0
	1713	"RTN","PSO RRPA1",147 ,0)
	1714	D ULK S V ALMSG(1)=" No Partial Fill Disp ensed" D P ARFAIL(.VA LMSG,RRXIE N,PHARM,P
	1715	HONE,SITE) Q
	1716	"RTN","PSO RRPA1",148 ,0)
	1717	KL K DFN,R FDAT,RLL,% ,PRMK,PM,% Y,%X,D0,D1 ,DA,DI,DIC ,DIE,DLAYG O,DQ,DR,I, II,J,JJJ,
	1718	N,PHYS,PS, PSDATE,RFL ,RFL1,RXF, ST,ST0,Z,Z 1,X,Y,PDT, PSL,PSNP
	1719	"RTN","PSO RRPA1",149 ,0)
	1720	K PSOM,PS OP,PSOD,PS OU,DIK,DUO UT,IFN,RXN ,DRG,HRX,I 1,PSOCLC,P SOLIST,PSO LST,PSPAR
	1721	,RXP D KVA ^VADPT Q
	1722	"RTN","PSO RRPA1",150 ,0)
	1723	ACT ;adds activity i nfo for pa rtial rx
	1724	"RTN","PSO RRPA1",151 ,0)
	1725	S RXF=0 F I=0:0 S I =$O(^PSRX( RRXIEN,1,I )) Q:'I S RXF=I S:I >5 RXF=I+1
	1726	"RTN","PSO RRPA1",152 ,0)
	1727	S DA=0 F FDA=0:0 S FDA=$O(^PS RX(RRXIEN, "A",FDA)) Q:'FDA S DA=FDA
	1728	"RTN","PSO RRPA1",153 ,0)
	1729	S DA=DA+1 ,^PSRX(RRX IEN,"A",0) ="^52.3DA^ "_DA_"^"_D A,^PSRX(RR XIEN,"A",D A,0)=DT_"
	1730	^"_"P"_"^" _PSOPHDUZ_ "^"_RXF_"^ "_PRMK
	1731	"RTN","PSO RRPA1",154 ,0)
	1732	EX K RXF,I ,FDA S DA= RXN
	1733	"RTN","PSO RRPA1",155 ,0)
	1734	Q
	1735	"RTN","PSO RRPA1",156 ,0)
	1736	ULK ;
	1737	"RTN","PSO RRPA1",157 ,0)
	1738	K PSOMSG, PSOPLCK,PS ORPDFN
	1739	"RTN","PSO RRPA1",158 ,0)
	1740	Q
	1741	"RTN","PSO RRPA1",159 ,0)
	1742	PARFAIL(PS OMSG,PSOIE N,RPHARM,R PHONE,RSIT E) ;
	1743	"RTN","PSO RRPA1",160 ,0)
	1744	S PSOMSG( 0)=0_U_$$G ET1^DIQ(52 ,PSOIEN,.0 1,"I")_U_P SOIEN,$P(P SOMSG(0),U ,15)=RPHA
	1745	RM,$P(PSOM SG(0),U,16 )=RPHONE,$ P(PSOMSG(0 ),U,17)=RS ITE
	1746	"RTN","PSO RRPA1",161 ,0)
	1747	Q
	1748	"RTN","PSO RRPA1",162 ,0)
	1749	UPDPAR(PSO MSG,PSOIEN ,RPHARM,RP HONE,RSITE ,PASSLOC) ;
	1750	"RTN","PSO RRPA1",163 ,0)
	1751	N PARIEN, PARIENS,PA RDATA,FIL, RXNUM,RFIL LDT,QTY,DS UPP,CLERK, LOGDATE,ID IV,EDIV,D
	1752	ISPDT,NDC, FDA,DNAME, DIEN
	1753	"RTN","PSO RRPA1",164 ,0)
	1754	S FIL=52. 2
	1755	"RTN","PSO RRPA1",165 ,0)
	1756	; get las t partial data node
	1757	"RTN","PSO RRPA1",166 ,0)
	1758	S PARIEN= $O(^PSRX(P SOIEN,"P", ""),-1)
	1759	"RTN","PSO RRPA1",167 ,0)
	1760	S RXNUM=$ $GET1^DIQ( 52,PSOIEN, .01,"E")
	1761	"RTN","PSO RRPA1",168 ,0)
	1762	S DNAME=$ $GET1^DIQ( 52,PSOIEN, 6,"E")
	1763	"RTN","PSO RRPA1",169 ,0)
	1764	S DIEN=$$ GET1^DIQ(5 2,PSOIEN,6 ,"I")
	1765	"RTN","PSO RRPA1",170 ,0)
	1766	S PARIENS =PARIEN_", "_PSOIEN_" ,"
	1767	"RTN","PSO RRPA1",171 ,0)
	1768	; first, set in the remote ph armacist d ata
	1769	"RTN","PSO RRPA1",172 ,0)
	1770	S FDA(52. 2,PARIENS, 91)=RSITE
	1771	"RTN","PSO RRPA1",173 ,0)
	1772	S FDA(52. 2,PARIENS, 92)=RPHARM
	1773	"RTN","PSO RRPA1",174 ,0)
	1774	S FDA(52. 2,PARIENS, 93)=RPHONE
	1775	"RTN","PSO RRPA1",175 ,0)
	1776	D FILE^DI E(,"FDA"," MSG") K FD A,RPHARM,R PHONE,RSIT E
	1777	"RTN","PSO RRPA1",176 ,0)
	1778	; now que ry data an d build RE T(0) holdi ng accurat e informat ion from t he refill
	1779	multiple
	1780	"RTN","PSO RRPA1",177 ,0)
	1781	D GETS^DI Q(FIL,PARI ENS,"**"," IE","PARDA TA")
	1782	"RTN","PSO RRPA1",178 ,0)
	1783	S RFILLDT =$G(PARDAT A(FIL,PARI ENS,.01,"I "))
	1784	"RTN","PSO RRPA1",179 ,0)
	1785	S QTY=$G( PARDATA(FI L,PARIENS, .04,"I"))
	1786	"RTN","PSO RRPA1",180 ,0)
	1787	S DSUPP=$ G(PARDATA( FIL,PARIEN S,.041,"I" ))
	1788	"RTN","PSO RRPA1",181 ,0)
	1789	S CLERK=$ G(PARDATA( FIL,PARIEN S,.07,"E") )
	1790	"RTN","PSO RRPA1",182 ,0)
	1791	S LOGDATE =$G(PARDAT A(FIL,PARI ENS,.08,"I "))
	1792	"RTN","PSO RRPA1",183 ,0)
	1793	; interna l division number (I EN to PSO SITE file)
	1794	"RTN","PSO RRPA1",184 ,0)
	1795	S IDIV=$G (PARDATA(F IL,PARIENS ,.09,"I"))
	1796	"RTN","PSO RRPA1",185 ,0)
	1797	S EDIV=$G (PARDATA(F IL,PARIENS ,.09,"E"))
	1798	"RTN","PSO RRPA1",186 ,0)
	1799	;
	1800	"RTN","PSO RRPA1",187 ,0)
	1801	; there i s nothing in this fi eld.
	1802	"RTN","PSO RRPA1",188 ,0)
	1803	; HL7 is returning refill dat e in the R XD
	1804	"RTN","PSO RRPA1",189 ,0)
	1805	; but try ing to log the blank dispense date from file 52.2 into 52.09
	1806	"RTN","PSO RRPA1",190 ,0)
	1807	S DISPDT= $G(PARDATA (FIL,PARIE NS,7.5,"I" ))
	1808	"RTN","PSO RRPA1",191 ,0)
	1809	;
	1810	"RTN","PSO RRPA1",192 ,0)
	1811	S NDC=$G( PARDATA(FI L,PARIENS, 1,"E"))
	1812	"RTN","PSO RRPA1",193 ,0)
	1813	S RSITE=$ G(PARDATA( FIL,PARIEN S,91,"I"))
	1814	"RTN","PSO RRPA1",194 ,0)
	1815	S RPHARM= $G(PARDATA (FIL,PARIE NS,92,"E") )
	1816	"RTN","PSO RRPA1",195 ,0)
	1817	S RPHONE= $G(PARDATA (FIL,PARIE NS,93,"E") )
	1818	"RTN","PSO RRPA1",196 ,0)
	1819	S $P(DAT( 1),U,3)=RX NUM,$P(DAT (1),U,4)=R SITE,$P(DA T(1),U,7)= QTY,$P(DAT (1),U,8)=
	1820	DISPDT,$P( DAT(1),U,9 )=DNAME,$P (DAT(1),U, 10)=DSUPP, $P(DAT(1), U,11)=RPHA RM,$P(DAT
	1821	(1),U,12)= RFILLDT
	1822	"RTN","PSO RRPA1",197 ,0)
	1823	D LOGDATA ^PSORWRAP( $NA(DAT)," OP",,,PSOI EN)
	1824	"RTN","PSO RRPA1",198 ,0)
	1825	S PSOMSG( 0)=1_U_RXN UM_U_PSOIE N_U_PARIEN _U_RFILLDT _U_DNAME_U _QTY_U_DSU PP_U_CLER
	1826	K_U_LOGDAT E_U_IDIV_U _EDIV_U_DI SPDT_U_NDC _U_RPHARM_ U_RPHONE_U _RSITE_U_P ASSLOC
	1827	"RTN","PSO RRPA1",199 ,0)
	1828	I '$L($G( PSOMSG(1)) ) S PSOMSG (1)="Parti al complet e for RX # "_RXNUM_". "
	1829	"RTN","PSO RRPA1",200 ,0)
	1830	Q
	1831	"RTN","PSO RRX2")
	1832	0^6^B35129 325^B34725 424
	1833	"RTN","PSO RRX2",1,0)
	1834	PSORRX2 ;A ITC/BWF - Remote RX driver ;8/ 30/16 12:0 0am
	1835	"RTN","PSO RRX2",2,0)
	1836	;;7.0;OUT PATIENT PH ARMACY;4 54,479,497 ;DEC 199 7;Build 22
	1837	"RTN","PSO RRX2",3,0)
	1838	;
	1839	"RTN","PSO RRX2",4,0)
	1840	Q
	1841	"RTN","PSO RRX2",5,0)
	1842	; read re sponse fro m refill s ite
	1843	"RTN","PSO RRX2",6,0)
	1844	READMSG(HL DAT,TYPE,L OCDRUG) ;
	1845	"RTN","PSO RRX2",7,0)
	1846	N ORFS,OR CS,ORRS,OR ES,ORSS,HL QUIT,ORQUI T,OREMSG1, OREMSG2,OR SMSG,ORSMS G,GBLLOC,
	1847	LBLOOP,LBT XT,LBLOVF, DIR,ORERR, MSGDONE,MS GCNT,MSGTX T
	1848	"RTN","PSO RRX2",8,0)
	1849	S ORFS=$G (HL("FS")) ,ORCS=$E($ G(HL("ECH" )),1),ORRS =$E($G(HL( "ECH")),2) ,ORES=$E(
	1850	$G(HL("ECH ")),3),ORS S=$E($G(HL ("ECH")),4 )
	1851	"RTN","PSO RRX2",9,0)
	1852	S TYPE=$G (TYPE,"")
	1853	"RTN","PSO RRX2",10,0 )
	1854	S HLQUIT= 0,ORQUIT=" ",OREMSG1= "",OREMSG2 ="",ORERR= ""
	1855	"RTN","PSO RRX2",11,0 )
	1856	F X HLNE XT Q:HLQUI T'>0!(ORQU IT'="") D
	1857	"RTN","PSO RRX2",12,0 )
	1858	.N LOOP
	1859	"RTN","PSO RRX2",13,0 )
	1860	.S LOOP=0 F S LOOP =$O(HLNODE (LOOP)) Q: LOOP="" S HLNODE=HL NODE_HLNOD E(LOOP)
	1861	"RTN","PSO RRX2",14,0 )
	1862	.I $E(HLN ODE,1,3)=" MSA"&($P(H LNODE,ORFS ,2)'="AA") S ORERR=$ P(HLNODE,O RFS,4)
	1863	"RTN","PSO RRX2",15,0 )
	1864	.I $E(HLN ODE,1,3)=" ERR" S ORE MSG1=$P(HL NODE,ORFS, 9)
	1865	"RTN","PSO RRX2",16,0 )
	1866	.I $E(HLN ODE,1,3)=" NTE" D
	1867	"RTN","PSO RRX2",17,0 )
	1868	..D REFNT E(.HLNODE, .HLDAT)
	1869	"RTN","PSO RRX2",18,0 )
	1870	..S ORSMS G=$P(@HLDA T@(1),ORFS )
	1871	"RTN","PSO RRX2",19,0 )
	1872	.I $E(HLN ODE,1,3)=" PID" D
	1873	"RTN","PSO RRX2",20,0 )
	1874	..S @HLDA T@(0)=$$FM ADD^XLFDT( $$NOW^XLFD T,2)_U_$$N OW^XLFDT
	1875	"RTN","PSO RRX2",21,0 )
	1876	..D REFPI D(.HLNODE, .HLDAT)
	1877	"RTN","PSO RRX2",22,0 )
	1878	.I $E(HLN ODE,1,3)=" ORC" D
	1879	"RTN","PSO RRX2",23,0 )
	1880	..D REFOR C(.HLNODE, .HLDAT,TYP E)
	1881	"RTN","PSO RRX2",24,0 )
	1882	.I $E(HLN ODE,1,3)=" RXD" D
	1883	"RTN","PSO RRX2",25,0 )
	1884	..D REFRX D(.HLNODE, .HLDAT,TYP E)
	1885	"RTN","PSO RRX2",26,0 )
	1886	I '$L(ORE RR),'$L(OR EMSG1) D
	1887	"RTN","PSO RRX2",27,0 )
	1888	.I '$D(@H LDAT) S OR ERR="No da ta was ret urned from the targe t vista." Q
	1889	"RTN","PSO RRX2",28,0 )
	1890	.W !!,"TR ANSACTION SUCCESSFUL ... The " _$S($G(PRX NUM):"part ial ",1:"r efill ")_
	1891	"for RX #" _RRXNUM_" has been r ecorded on "
	1892	"RTN","PSO RRX2",29,0 )
	1893	.W !,"the prescript ion at the host syst em."
	1894	"RTN","PSO RRX2",30,0 )
	1895	.W !!,"Se lect a pri nter to ge nerate the label or '^' to byp ass printi ng.",!
	1896	"RTN","PSO RRX2",31,0 )
	1897	.D LOGDAT A^PSORWRAP (.HLDAT,TY PE,LOCDRUG ,"")
	1898	"RTN","PSO RRX2",32,0 )
	1899	I $L(ORER R) D
	1900	"RTN","PSO RRX2",33,0 )
	1901	. K PSORR BLD ; no need to re build work list
	1902	"RTN","PSO RRX2",34,0 )
	1903	. I ORERR ="Invalid Receiving Applicatio n" S ORERR ="OneVA so ftware not installe
	1904	d at host site" ; T his error is returne d if patch is not in stalled at remote/h
	1905	ost site. Making it more user friendly.
	1906	"RTN","PSO RRX2",35,0 )
	1907	. W !!,OR ERR
	1908	"RTN","PSO RRX2",36,0 )
	1909	. S DIR(0 )="FO",DIR ("A")="Pre ss RETURN to continu e"
	1910	"RTN","PSO RRX2",37,0 )
	1911	. D ^DIR
	1912	"RTN","PSO RRX2",38,0 )
	1913	I OREMSG1 '="" D
	1914	"RTN","PSO RRX2",39,0 )
	1915	. K PSORR BLD ; no need to re build work list
	1916	"RTN","PSO RRX2",40,0 )
	1917	. W !!,OR EMSG1_". " _$S($L(ORE MSG2):OREM SG2_".",1: ""),!
	1918	"RTN","PSO RRX2",41,0 )
	1919	. I '$D(O RSMSG) S D IR(0)="FO" ,DIR("A")= "Press RET URN to con tinue" D ^ DIR
	1920	"RTN","PSO RRX2",42,0 )
	1921	I $D(ORSM SG) D
	1922	"RTN","PSO RRX2",43,0 )
	1923	.S MSGDON E=0
	1924	"RTN","PSO RRX2",44,0 )
	1925	.F MSGCNT =1:1 D Q: MSGDONE
	1926	"RTN","PSO RRX2",45,0 )
	1927	..S MSGTX T=$P(ORSMS G,"\|",MSGC NT) I MSGT XT']"" S M SGDONE=1 Q
	1928	"RTN","PSO RRX2",46,0 )
	1929	..W !,MSG TXT
	1930	"RTN","PSO RRX2",47,0 )
	1931	.S DIR(0) ="FO",DIR( "A")="Pres s RETURN t o continue " D ^DIR
	1932	"RTN","PSO RRX2",48,0 )
	1933	Q
	1934	"RTN","PSO RRX2",49,0 )
	1935	; HLDAT(1 )=MESSAGE^ PATIENT DF N^RX NUMBE R^REMOTE S ITE#^FILL/ PARTIAL DA TE^PHARMA
	1936	CIST NAME^ QUANTITY^D ISPENSE DA TE^DRUG NA ME^DAYS SU PPLY
	1937	"RTN","PSO RRX2",50,0 )
	1938	REFNTE(DAT A,HLDAT) ;
	1939	"RTN","PSO RRX2",51,0 )
	1940	; Message details
	1941	"RTN","PSO RRX2",52,0 )
	1942	N NTETYP, NTETEXT,NT ETYPE
	1943	"RTN","PSO RRX2",53,0 )
	1944	S NTETYPE =$P(DATA,O RFS,3)
	1945	"RTN","PSO RRX2",54,0 )
	1946	S NTETEXT =$P(DATA,O RFS,4)
	1947	"RTN","PSO RRX2",55,0 )
	1948	I NTETYPE ="L" D
	1949	"RTN","PSO RRX2",56,0 )
	1950	.I $L($P( $G(@HLDAT@ (1)),U)) S $P(@HLDAT @(1),U)=$P ($G(@HLDAT @(1)),U)_" \|"_NTETEX
	1951	T Q
	1952	"RTN","PSO RRX2",57,0 )
	1953	.S $P(@HL DAT@(1),U) =NTETEXT
	1954	"RTN","PSO RRX2",58,0 )
	1955	I NTETYPE ="O" D
	1956	"RTN","PSO RRX2",59,0 )
	1957	.S @HLDAT @("LBL",$O (@HLDAT@(" LBL",""),- 1)+1)=NTET EXT
	1958	"RTN","PSO RRX2",60,0 )
	1959	Q
	1960	"RTN","PSO RRX2",61,0 )
	1961	;
	1962	"RTN","PSO RRX2",62,0 )
	1963	REFPID(DAT A,HLDAT) ;
	1964	"RTN","PSO RRX2",63,0 )
	1965	; patient IEN from remote sit e
	1966	"RTN","PSO RRX2",64,0 )
	1967	S $P(@HLD AT@(1),U,2 )=$P($P($P (DATA,ORFS ,4),ORCS,1 1),ORRS,2)
	1968	"RTN","PSO RRX2",65,0 )
	1969	Q
	1970	"RTN","PSO RRX2",66,0 )
	1971	;
	1972	"RTN","PSO RRX2",67,0 )
	1973	REFORC(DAT A,HLDAT,TY PE) ;
	1974	"RTN","PSO RRX2",68,0 )
	1975	N RXNUM,R XSITE,RXDA TE,PHARMLN ,PHARMFN,R EQSITE,PHO NE,PHNAME, PNAME,RPDA TE,RPROV
	1976	"RTN","PSO RRX2",69,0 )
	1977	S RXNUM=$ P($P(DATA, ORFS,3),OR CS)
	1978	"RTN","PSO RRX2",70,0 )
	1979	S RXSITE= $P($P(DATA ,ORFS,14), ORCS,4)
	1980	"RTN","PSO RRX2",71,0 )
	1981	S RPDATE= $P(DATA,OR FS,10)
	1982	"RTN","PSO RRX2",72,0 )
	1983	S RPROV=$ P(DATA,ORF S,12)
	1984	"RTN","PSO RRX2",73,0 )
	1985	S PHNAME= $P(DATA,OR FS,11)
	1986	"RTN","PSO RRX2",74,0 )
	1987	S $P(@HLD AT@(1),U,3 )=RXNUM
	1988	"RTN","PSO RRX2",75,0 )
	1989	S $P(@HLD AT@(1),U,4 )=RXSITE
	1990	"RTN","PSO RRX2",76,0 )
	1991	S $P(@HLD AT@(1),U,5 )=RPDATE
	1992	"RTN","PSO RRX2",77,0 )
	1993	S $P(@HLD AT@(1),U,6 )=PHNAME
	1994	"RTN","PSO RRX2",78,0 )
	1995	S $P(@HLD AT@("RX0") ,U)=RXNUM, $P(@HLDAT@ ("RX0"),U, 2)=DFN,$P( @HLDAT@("R X0"),U,5)
	1996	=$P($P($P( DATA,ORFS, 22),ORCS,8 ),ORSS,2), $P(@HLDAT@ ("RX0"),U, 6)=LOCDRUG
	1997	\x000CSubj: PSO 7497 TES T v1 [#86 147425] Page 3
	1998	---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
	1999	"RTN","PSO RRX2",79,0 )
	2000	S $P(@HLD AT@("RX0") ,U,4)=$P($ P($P(DATA, ORFS,20),O RRS,1),ORC S,2)
	2001	"RTN","PSO RRX2",80,0 )
	2002	S $P(@HLD AT@("RX0") ,U,13)=$P( DATA,ORFS, 16),$P(@HL DAT@("RX0" ),U,19)=""
	2003	"RTN","PSO RRX2",81,0 )
	2004	; dont fo rget copie s in p18, if needed
	2005	"RTN","PSO RRX2",82,0 )
	2006	S $P(@HLD AT@("RX2") ,U,2)=RPDA TE,$P(@HLD AT@("RX2") ,U,10)=$P( $P($P(DATA ,ORFS,20)
	2007	,ORRS,2),O RCS,2)
	2008	"RTN","PSO RRX2",83,0 )
	2009	S $P(@HLD AT@("RX3") ,U)=$P(DAT A,ORFS,28)
	2010	"RTN","PSO RRX2",84,0 )
	2011	I TYPE="R F" D
	2012	"RTN","PSO RRX2",85,0 )
	2013	.S $P(@HL DAT@("RREF 0"),U)=RPD ATE,$P(@HL DAT@("RREF 0"),U,2)=" W",$P(@HLD AT@("RREF
	2014	0"),U,7)=$ P($P($P(DA TA,ORFS,20 ),ORRS,3), ORCS,2)
	2015	"RTN","PSO RRX2",86,0 )
	2016	.S $P(@HL DAT@("RREF 0"),U,17)= $P($P($P(D ATA,ORFS,2 0),ORRS,4) ,ORCS,2)
	2017	"RTN","PSO RRX2",87,0 )
	2018	I TYPE="P R" D
	2019	"RTN","PSO RRX2",88,0 )
	2020	.S $P(@HL DAT@("RPAR 0"),U)=RPD ATE,$P(@HL DAT@("RPAR 0"),U,2)=" W",$P(@HLD AT@("RPAR
	2021	0"),U,7)=$ P($P($P(DA TA,ORFS,20 ),ORRS,3), ORCS,2)
	2022	"RTN","PSO RRX2",89,0 )
	2023	.S $P(@HL DAT@("RPAR 0"),U,17)= $P($P($P(D ATA,ORFS,2 0),ORRS,4) ,ORCS,2)
	2024	"RTN","PSO RRX2",90,0 )
	2025	S $P(@HLD AT@("ROR1" ),U,5)=$P( $P($P(DATA ,ORFS,20), ORRS,5),OR CS,2)
	2026	"RTN","PSO RRX2",91,0 )
	2027	S @HLDAT@ ("RXSTA")= $P($P(DATA ,ORFS,26), ORCS),@HLD AT@("RXSTA 2")=$P($P( DATA,ORFS
	2028	,26),ORCS, 2)
	2029	"RTN","PSO RRX2",92,0 )
	2030	S @HLDAT@ ("PATST")= $P($P(DATA ,ORFS,26), ORCS,4)
	2031	"RTN","PSO RRX2",93,0 )
	2032	; HOST IN FO
	2033	"RTN","PSO RRX2",94,0 )
	2034	; P1 - NA ME, P2 - A DDRESS~~CI TY~STATE~Z IP, P3 - P HONE NUMBE R, P4 - HO ST SITE N
	2035	UMBER
	2036	"RTN","PSO RRX2",95,0 )
	2037	S $P(DATA ,ORFS,23)= $P($P(DATA ,ORFS,23), ORSS)_ORSS _$P($P(DAT A,ORFS,23) ,ORSS,3,5
	2038	)
	2039	"RTN","PSO RRX2",96,0 )
	2040	S @HLDAT@ ("HINFO")= $P($P(DATA ,ORFS,22), ORCS)_U_$P (DATA,ORFS ,23)_U_$P( DATA,ORFS
	2041	,24)
	2042	"RTN","PSO RRX2",97,0 )
	2043	S $P(@HLD AT@("HINFO "),U,4)=RX SITE
	2044	"RTN","PSO RRX2",98,0 )
	2045	S $P(@HLD AT@("HINFO "),U,5)=$P ($P($P(DAT A,ORFS,22) ,ORCS,8),O RSS,2) ;C linic
	2046	"RTN","PSO RRX2",99,0 )
	2047	Q
	2048	"RTN","PSO RRX2",100, 0)
	2049	REFRXD(DAT A,HLDAT,TY PE) ;
	2050	"RTN","PSO RRX2",101, 0)
	2051	N QTY,DSU PP,DNAME,H INFO,SIG1D ,SIGDAT,SI GNUM,SIGTX T,I
	2052	"RTN","PSO RRX2",102, 0)
	2053	S ($P(@HL DAT@(1),U, 7),$P(@HLD AT@("RX0") ,U,7))=$P( DATA,ORFS, 5) ; quan tity
	2054	"RTN","PSO RRX2",103, 0)
	2055	S $P(@HLD AT@(1),U,8 )=$P(DATA, ORFS,4) ; dispense d ate
	2056	"RTN","PSO RRX2",104, 0)
	2057	S $P(@HLD AT@(1),U,9 )=$P($P(DA TA,ORFS,3) ,ORCS,1) ; drug name
	2058	"RTN","PSO RRX2",105, 0)
	2059	S ($P(@HL DAT@(1),U, 10),$P(@HL DAT@("RX0" ),U,8))=$P (DATA,ORFS ,13) ; day s supply
	2060	"RTN","PSO RRX2",106, 0)
	2061	S $P(@HLD AT@("RX0") ,U,9)=$P(D ATA,ORFS,9 ),$P(@HLDA T@("RX0"), U,11)="W"
	2062	"RTN","PSO RRX2",107, 0)
	2063	S $P(@HLD AT@("RX0") ,U,18)=$P( DATA,ORFS, 23) ; Cop ies
	2064	"RTN","PSO RRX2",108, 0)
	2065	S $P(@HLD AT@("RX2") ,U,6)=$P(D ATA,ORFS,2 0) ; Rx E xpiration Date
	2066	"RTN","PSO RRX2",109, 0)
	2067	;
	2068	"RTN","PSO RRX2",110, 0)
	2069	I TYPE="R F" D
	2070	"RTN","PSO RRX2",111, 0)
	2071	.S $P(@HL DAT@("RREF 0"),U,4)=$ P(DATA,ORF S,5),$P(@H LDAT@("RRE F0"),U,10) =$P(DATA,
	2072	ORFS,13)
	2073	"RTN","PSO RRX2",112, 0)
	2074	.S @HLDAT @("RFIEN") =$P($P(DAT A,ORFS,8), ":",3)
	2075	"RTN","PSO RRX2",113, 0)
	2076	I TYPE="P R" D
	2077	"RTN","PSO RRX2",114, 0)
	2078	.S $P(@HL DAT@("RPAR 0"),U,4)=$ P(DATA,ORF S,5),$P(@H LDAT@("RPA R0"),U,10) =$P(DATA,
	2079	ORFS,13)
	2080	"RTN","PSO RRX2",115, 0)
	2081	.S @HLDAT @("PARIEN" )=$P($P(DA TA,ORFS,8) ,":",3)
	2082	"RTN","PSO RRX2",116, 0)
	2083	;
	2084	"RTN","PSO RRX2",117, 0)
	2085	S @HLDAT@ ("RSIG")=$ P($P($P(DA TA,ORFS,16 ),ORRS,1), ORCS,2)_U_ $P($P($P(D ATA,ORFS,
	2086	16),ORRS,1 ),ORCS)
	2087	"RTN","PSO RRX2",118, 0)
	2088	S @HLDAT@ ("RIEN")=$ P($P(DATA, ORFS,8),": ")
	2089	"RTN","PSO RRX2",119, 0)
	2090	;I '$P($G (@HLDAT@(" RSIG")),U, 2) Q
	2091	"RTN","PSO RRX2",120, 0)
	2092	S SIG1D=0
	2093	"RTN","PSO RRX2",121, 0)
	2094	F I=2:1 D Q:SIG1D
	2095	"RTN","PSO RRX2",122, 0)
	2096	.S SIGDAT =$P($P(DAT A,ORFS,16) ,ORRS,I) I SIGDAT']" " S SIG1D= 1 Q
	2097	"RTN","PSO RRX2",123, 0)
	2098	.S SIGNUM =$P(SIGDAT ,ORCS),SIG NUM=$P(SIG NUM,"_",2) ,SIGTXT=$P (SIGDAT,OR CS,2) Q:'
	2099	SIGNUM
	2100	"RTN","PSO RRX2",124, 0)
	2101	.S @HLDAT @("RSIG1", SIGNUM)=SI GTXT
	2102	"RTN","PSO RRX2",125, 0)
	2103	Q
	2104	"RTN","PSO RRX2",126, 0)
	2105	PSORPH(DUZ ) ;
	2106	"RTN","PSO RRX2",127, 0)
	2107	I $D(^XUS EC("PSORPH ",DUZ)) Q 1
	2108	"RTN","PSO RRX2",128, 0)
	2109	Q 0
	2110	"RTN","PSO RX1")
	2111	0^5^B82991 230^B83034 701
	2112	"RTN","PSO RX1",1,0)
	2113	PSORX1 ;BI R/SAB-medi cation pro cessing dr iver ;8/17 /16 5:10pm
	2114	"RTN","PSO RX1",2,0)
	2115	;;7.0;OUT PATIENT PH ARMACY;**7 ,22,23,57, 62,46,74,7 1,90,95,11 5,117,146, 139,135,1
	2116	82,195,233 ,268,300,1 70,320,326 ,324,334,2 51,454,488 ,497**;DEC 1997;Buil d 22
	2117	"RTN","PSO RX1",3,0)
	2118	;
	2119	"RTN","PSO RX1",4,0)
	2120	;External reference ^PS(55 su pported by DBIA 2228
	2121	"RTN","PSO RX1",5,0)
	2122	;External reference ^DIC(31 s upported b y DBIA 658
	2123	"RTN","PSO RX1",6,0)
	2124	;External reference ^DPT(D0,. 372 suppor ted by DBI A 1476
	2125	"RTN","PSO RX1",7,0)
	2126	;External reference DISPPRF^D GPFAPI sup ported by DBIA #4563
	2127	"RTN","PSO RX1",8,0)
	2128	;External reference ^ORRDI1 i s supporte d by DBIA 4659
	2129	"RTN","PSO RX1",9,0)
	2130	;External reference ^XTMP("OR RDI" is su pported by DBIA 4660
	2131	"RTN","PSO RX1",10,0)
	2132	;External reference ^PSUHL su pported by DBIA 4803
	2133	"RTN","PSO RX1",11,0)
	2134	;
	2135	"RTN","PSO RX1",12,0)
	2136	;PSO*195 add call t o display Patient Re cord Flag (DISPPRF^D GPFAPI)
	2137	"RTN","PSO RX1",13,0)
	2138	;
	2139	"RTN","PSO RX1",14,0)
	2140	START K PS OQFLG,PSOI D,PSOFIN,P SOQUIT,PSO DRUG,^TMP( $J,"PSOTDD "),^TMP("P SORXPO",$
	2141	J),^TMP("P SORXBO",$J )
	2142	"RTN","PSO RX1",15,0)
	2143	I '$G(PSO ONEVA) N P SOONEVA S PSOONEVA=1
	2144	"RTN","PSO RX1",16,0)
	2145	D EOJ S ( PSOBCK,PSO ERR)=1 D I NIT G:PSOR X("QFLG") END
	2146	"RTN","PSO RX1",17,0)
	2147	D PT G:$G (PSORX("QF LG")) END D FULL^VAL M1 I $G(NO PROC) K NO PROC G NX
	2148	"RTN","PSO RX1",18,0)
	2149	;call to add bingo board data to file 5 2.11
	2150	"RTN","PSO RX1",19,0)
	2151	F SLPPL=0 :0 S SLPPL =$O(RXRS(S LPPL)) Q:' SLPPL D
	2152	"RTN","PSO RX1",20,0)
	2153	.I $P($G( ^PSRX(SLPP L,"STA")), "^")'=5 K RXRS(SLPPL ) Q
	2154	"RTN","PSO RX1",21,0)
	2155	.S RXREC= SLPPL D WI ND^PSOSUPO E I $G(PBI NGRTE) D B BADD^PSOSU POE S (BIN GCRT,BING
	2156	RTE)=1 S:$ G(PSOFROM) '="NEW" PS OFROM="REF ILL"
	2157	"RTN","PSO RX1",22,0)
	2158	K TM,TM1 I $G(PSORX ("PSOL",1) )]""!($D(R XRS)) D ^P SORXL K PS ORX
	2159	"RTN","PSO RX1",23,0)
	2160	G:$G(NOBG ) NX
	2161	"RTN","PSO RX1",24,0)
	2162	S TM=$P(^ TMP("PSOBB ",$J),"^") ,TM1=$P(^T MP("PSOBB" ,$J),"^",2 ) K ^TMP(" PSOBB",$J
	2163	)
	2164	"RTN","PSO RX1",25,0)
	2165	I $G(PSOF ROM)="NEW" !($G(PSOFR OM)="REFIL L")!($G(PS OFROM)="PA RTIAL")!($ G(PSOFROM
	2166	)="UNHOLD" ) D:$D(BIN GCRT)&($D( BINGRTE)&( $D(DISGROU P))) ^PSOB ING1 K BIN GCRT,BING
	2167	RTE,BBRX,B BFLG
	2168	"RTN","PSO RX1",26,0)
	2169	NX I $G(PO ERR("DEAD" ))!$G(PSOQ FLG) D EOJ G START
	2170	"RTN","PSO RX1",27,0)
	2171	D EOJ G S TART
	2172	"RTN","PSO RX1",28,0)
	2173	END Q
	2174	"RTN","PSO RX1",29,0)
	2175	;-------- ---------- ---------- ---------- ---------- ---------
	2176	"RTN","PSO RX1",30,0)
	2177	INIT ;
	2178	"RTN","PSO RX1",31,0)
	2179	S PSORX(" QFLG")=0
	2180	"RTN","PSO RX1",32,0)
	2181	D:'$D(PSO PAR) ^PSOL SET I '$D( PSOPAR) S PSORX("QFL G")=1
	2182	"RTN","PSO RX1",33,0)
	2183	I $P($G(P SOPAR),"^" ,2),'$D(^X USEC("PSOR PH",DUZ)) S PSORX("V ERIFY")=1
	2184	"RTN","PSO RX1",34,0)
	2185	INITX Q
	2186	"RTN","PSO RX1",35,0)
	2187	;
	2188	"RTN","PSO RX1",36,0)
	2189	PT ;
	2190	"RTN","PSO RX1",37,0)
	2191	K ^TMP("P SORXDC",$J ),^TMP($J, "PSEXC","O UT"),CLOZP AT,DIC,PSO DFN,PSOPTL K
	2192	"RTN","PSO RX1",38,0)
	2193	S PSORX(" QFLG")=0,D IC(0)="QEA M" D EN^PS OPATLK S Y =PSOPTLK
	2194	"RTN","PSO RX1",39,0)
	2195	I +Y'>0 S PSORX("QF LG")=1 G P TX
	2196	"RTN","PSO RX1",40,0)
	2197	OERR N:$G( MEDP) PAT, POERR K PS OXFLG S (D FN,PSODFN) =+Y,PSORX( "NAME")=$P (Y,"^",2)
	2198	"RTN","PSO RX1",41,0)
	2199	K NPPROC, PSOQFLG,DI C,DR,DIQ S DIC=2,DA= PSODFN,DR= .351,DIQ=" PSOPTPST" D EN^DIQ1
	2200	"RTN","PSO RX1",42,0)
	2201	K DIC,DA, DR,DIQ D D EAD^PSOPTP ST I $G(PS OQFLG) S N OPROC=1 Q
	2202	"RTN","PSO RX1",43,0)
	2203	;PSO*195 move SSN w rite to he re and add DISPPRF c all
	2204	"RTN","PSO RX1",44,0)
	2205	S SSN=$P( ^DPT(PSODF N,0),"^",9 ) W !!?10, $C(7),PSOR X("NAME")
	2206	"RTN","PSO RX1",45,0)
	2207	W " ("_$E (SSN,1,3)_ "-"_$E(SSN ,4,5)_"-"_ $E(SSN,6,9 )_")" K SS N
	2208	"RTN","PSO RX1",46,0)
	2209	I $G(XQY0 )["PSO LMO E FINISH", '$G(MEDP), $D(^TMP($J ,"PSOFLPO" ,PSODFN)) D
	2210	"RTN","PSO RX1",47,0)
	2211	.I '$D(IO INORM)!('$ D(IOINHI)) S X="IORV OFF;IORVON ;IOINHI;IO INORM" D E NDR^%ZISS
	2212	"RTN","PSO RX1",48,0)
	2213	.W " ",I ORVON_IOIN HI,"<This patient ha s flagged orders>",I OINORM_IOR VOFF
	2214	"RTN","PSO RX1",49,0)
	2215	S PSONOAL ="" D ALLE RGY^PSOORU T2 D I PS ONOAL'="" D PAUSE
	2216	"RTN","PSO RX1",50,0)
	2217	.I PSONOA L'="" W !, $C(7)," No Aller gy Assessm ent!"
	2218	"RTN","PSO RX1",51,0)
	2219	D REMOTE
	2220	"RTN","PSO RX1",52,0)
	2221	; bwf - 1 /9/2014 - PHARMACY I NNOVATIONS , adding c all and on screen me ssage to
	2222	get remote rx's from MDWS.
	2223	"RTN","PSO RX1",53,0)
	2224	I $G(PSOO NEVA) D
	2225	"RTN","PSO RX1",54,0)
	2226	.N TFL,TF ILIST,TFLP ,TFLSITE,T FLIEN,TFLC NT,TFLDUP
	2227	"RTN","PSO RX1",55,0)
	2228	.D TFL^VA FCTFU1(.TF L,PSODFN)
	2229	"RTN","PSO RX1",56,0)
	2230	.S TFLCNT =0
	2231	"RTN","PSO RX1",57,0)
	2232	.S TFILIS T="^VAMC^M &ROC^M&ROC (M&RO)^OC^ OPC^CBOC^P RRTP^DOM^H CS^MC(M)^M C(M&D)^MO
	2233	RC^NHC^VAN PH^SOC^SAR RTP^" ; o nly exact matches
	2234	"RTN","PSO RX1",58,0)
	2235	.S TFLP=0 F S TFLP =$O(TFL(TF LP)) Q:'TF LP!(TFLCNT =2) D
	2236	"RTN","PSO RX1",59,0)
	2237	..S TFLSI TE=$P(TFL( TFLP),U) Q :TFLSITE=" "
	2238	"RTN","PSO RX1",60,0)
	2239	..Q:$D(TF LDUP(TFLSI TE))
	2240	"RTN","PSO RX1",61,0)
	2241	..S TFLDU P(TFLSITE) =""
	2242	"RTN","PSO RX1",62,0)
	2243	..Q:TFILI ST'[(U_$P( TFL(TFLP), U,5)_U)
	2244	"RTN","PSO RX1",63,0)
	2245	..S TFLCN T=$G(TFLCN T)+1
	2246	"RTN","PSO RX1",64,0)
	2247	.I $G(TFL CNT)<2 Q
	2248	"RTN","PSO RX1",65,0)
	2249	.I '$$GET 1^DIQ(59.7 ,1,101,"I" ) D Q
	2250	"RTN","PSO RX1",66,0)
	2251	..W !!,"T he OneVA P harmacy fl ag is turn ed off. Qu eries will NOT"
	2252	"RTN","PSO RX1",67,0)
	2253	..W !,"be made to o ther VA Ph armacy loc ations.",!
	2254	"RTN","PSO RX1",68,0)
	2255	.K DIR S DIR(0)="Y" ,DIR("B")= "YES",DIR( "A")="loca tions",DIR ("A",1)="W ould you
	2256	like to qu ery prescr iptions fr om other O neVA Pharm acy" D ^DI R
	2257	"RTN","PSO RX1",69,0)
	2258	.K DIR
	2259	"RTN","PSO RX1",70,0)
	2260	.Q:'Y
	2261	"RTN","PSO RX1",71,0)
	2262	.W !!,"Pl ease wait. Checking for prescr iptions at other VA Pharmacy l ocations.
	2263	This may take a mom ent...",!
	2264	"RTN","PSO RX1",72,0)
	2265	.D REMOTE RX^PSORRX1 (PSODFN,PS OSITE)
	2266	"RTN","PSO RX1",73,0)
	2267	N PSOUPDT
	2268	"RTN","PSO RX1",74,0)
	2269	S PSOUPDT =1
	2270	"RTN","PSO RX1",75,0)
	2271	I $G(XQY0 )["PSO LMO E FINISH" S PSOUPDT= 0
	2272	"RTN","PSO RX1",76,0)
	2273	D CHKADDR ^PSOBAI(PS ODFN,1,PSO UPDT)
	2274	"RTN","PSO RX1",77,0)
	2275	D:($G(XQY 0)["PSO LM OE FINISH" )&('$G(SNG LPAT)) DIS PPRF^DGPFA PI(PSODFN)
	2276	"RTN","PSO RX1",78,0)
	2277	;
	2278	"RTN","PSO RX1",79,0)
	2279	I $P($G(^ PS(55,PSOD FN,"LAN")) ,"^") W !? 10,"Patien t has anot her langua ge prefer
	2280	ence!",! H 3
	2281	"RTN","PSO RX1",80,0)
	2282	I $G(^PS( 55,"ASTALK ",PSODFN)) W !,"Pati ent is enr olled to r eceive Scr ipTalk 't
	2283	alking' pr escription labels.", ! H 2 D MA IL
	2284	"RTN","PSO RX1",81,0)
	2285	D NOW^%DT C S TM=$E( %,1,12),TM 1=$P(TM,". ",2) S ^TM P("PSOBB", $J)=TM_"^" _TM1
	2286	"RTN","PSO RX1",82,0)
	2287	;Call to display re mote/local prescript ions
	2288	"RTN","PSO RX1",83,0)
	2289	I '$G(PSO FIN) D RDI CHK^PSORMR X(PSODFN)
	2290	"RTN","PSO RX1",84,0)
	2291	S PSOQFLG =0,DIC="^P S(55,",DLA YGO=55
	2292	"RTN","PSO RX1",85,0)
	2293	I '$D(^PS (55,PSODFN ,0)) D
	2294	"RTN","PSO RX1",86,0)
	2295	.K DD,DO S DIC(0)=" L",(DINUM, X)=PSODFN D FILE^DIC N D:Y<1 K DIC,DA,DR ,DD,DO
	2296	"RTN","PSO RX1",87,0)
	2297	..S $P(^P S(55,PSODF N,0),"^")= PSODFN K D IK S DA=PS ODFN,DIK=" ^PS(55,",D IK(1)=.01
	2298	D EN^DIK K DIK
	2299	"RTN","PSO RX1",88,0)
	2300	D RXSTA
	2301	"RTN","PSO RX1",89,0)
	2302	S PSOLOUD =1 D:$P($G (^PS(55,PS ODFN,0))," ^",6)'=2 E N^PSOHLUP( PSODFN) K PSOLOUD
	2303	"RTN","PSO RX1",90,0)
	2304	I $G(^PS( 55,PSODFN, "PS"))']"" D I $G(P OERR("QFLG ")) G EOJ
	2305	"RTN","PSO RX1",91,0)
	2306	.L +^PS(5 5,PSODFN): $S(+$G(^DD ("DILOCKTM "))>0:+^DD ("DILOCKTM "),1:3) I '$T W $C(
	2307	7),!!,"Pat ient Data is Being E dited by A nother Use r!",! S PO ERR("QFLG" )=1 S:$G(
	2308	PSOFIN) PS OQUIT=1 Q
	2309	"RTN","PSO RX1",92,0)
	2310	.S PSOXFL G=1,SSN=$P (^DPT(PSOD FN,0),"^", 9) W !!?10 ,$C(7),PSO RX("NAME") _" ("_$E(
	2311	SSN,1,3)_" -"_$E(SSN, 4,5)_"-"_$ E(SSN,6,9) _")",! K S SN
	2312	"RTN","PSO RX1",93,0)
	2313	.S DIE=55 ,DR=".02;. 03;.04;.05 ;1;D ELIG^ PSORX1;3;5 0;106;106. 1",DA=PSOD FN W !!,?
	2314	5,">>PHARM ACY PATIEN T DATA<<", ! D ^DIE L -^PS(55,P SODFN)
	2315	"RTN","PSO RX1",94,0)
	2316	S PSOX=$G (^PS(55,PS ODFN,"PS") ) I PSOX]" " S PSORX( "PATIENT S TATUS")=$P ($G(^PS(5
	2317	3,PSOX,0)) ,"^")
	2318	"RTN","PSO RX1",95,0)
	2319	I $G(^PS( 55,PSODFN, "PS"))']"" D I $G(P OERR("QFLG ")) G EOJ
	2320	"RTN","PSO RX1",96,0)
	2321	.W !!,"Pa tient Stat us Require d!!",! D E LIG
	2322	"RTN","PSO RX1",97,0)
	2323	.W ! K PO ERR("QFLG" ),DIC,DR,D IE S DIC(" A")="RX PA TIENT STAT US: ",DIC( 0)="QEAMZ
	2324	",DIC=53 D ^DIC K DI C
	2325	"RTN","PSO RX1",98,0)
	2326	.I $D(DIR UT)!(Y=-1) D Q
	2327	"RTN","PSO RX1",99,0)
	2328	..W $C(7) ,"Required Data!",! S POERR("Q FLG")=1 S: $G(PSOFIN) PSOQUIT=1
	2329	"RTN","PSO RX1",100,0 )
	2330	..I $O(^P S(55,PSODF N,0))="" S DA=PSODFN ,DIK="^PS( 55," D ^DI K
	2331	"RTN","PSO RX1",101,0 )
	2332	.S ^PS(55 ,PSODFN,"P S")=+Y,PSO RX("PATIEN T STATUS") =$P(^PS(53 ,+Y,0),"^" )
	2333	"RTN","PSO RX1",102,0 )
	2334	.K DIRUT, DTOUT,DUOU T,X,Y,DA
	2335	"RTN","PSO RX1",103,0 )
	2336	Q:$G(PSOF IN)
	2337	"RTN","PSO RX1",104,0 )
	2338	D ^PSOBUI LD
	2339	"RTN","PSO RX1",105,0 )
	2340	F PT="GET ","DEAD"," INP","CNH" ,"TPB","AD DRESS","CO PAY" S RTN =PT_"^PSOP TPST" D @
	2341	RTN Q:$G(P OERR("DEAD "))!($G(PS OQFLG))
	2342	"RTN","PSO RX1",106,0 )
	2343	I $G(POER R("DEAD")) S POERR(" QFLG")=1 F II=0:0 S II=$O(^PS( 52.41,"P", PSODFN,II
	2344	)) D:$P($G (^PS(52.41 ,II,0)),"^ ",3)'="DC" &($P($G(^( 0)),"^",3) '="DE") DC ^PSOORFI2
	2345	"RTN","PSO RX1",107,0 )
	2346	K PSOERR( "DEAD"),II I $G(PSOQ FLG) S POE RR("QFLG") =1 G EOJ Q
	2347	"RTN","PSO RX1",108,0 )
	2348	S (PAT,PS OXXDFN)=PS ODFN,POERR =1 D ^PSOO RUT2,BLD^P SOORUT1,EN ^PSOLMUTL
	2349	"RTN","PSO RX1",109,0 )
	2350	D CLEAR^V ALM1 G:$G( PSOQUIT) P TX D EN^PS OLMAO
	2351	"RTN","PSO RX1",110,0 )
	2352	S (DFN,PS ODFN)=PSOX XDFN K DIE ,DIC,DLAYG O,DR,DA,PS OX,PSORXED
	2353	"RTN","PSO RX1",111,0 )
	2354	I $O(RXFL ("")),$P(^ PS(55,PSOD FN,0),"^", 7)="" D
	2355	"RTN","PSO RX1",112,0 )
	2356	. N %
	2357	"RTN","PSO RX1",113,0 )
	2358	. D NOW^% DTC
	2359	"RTN","PSO RX1",114,0 )
	2360	. S $P(^P S(55,PSODF N,0),"^",7 )=$E(%,1,1 2),$P(^(0) ,"^",8)="A " D LOGDFN ^PSUHL(PS
	2361	ODFN)
	2362	"RTN","PSO RX1",115,0 )
	2363	PTX ;
	2364	"RTN","PSO RX1",116,0 )
	2365	K X,Y,^TM P("PS",$J) ,^TMP($J," PSEXC","OU T"),C,DEA, PRC,PSCNT, PSOACT,PSO CLC,PSOCS
	2366	,PSOCT,PSO FINFL,PSOH D,PSOLST,P SOOPT,PSOP F,PSOX,PSO X1,PSOXXDF N,SIGOK,ST P,STR,PSO
	2367	PTLK
	2368	"RTN","PSO RX1",117,0 )
	2369	Q
	2370	"RTN","PSO RX1",118,0 )
	2371	EOJ ;
	2372	"RTN","PSO RX1",119,0 )
	2373	I $G(PSOD FN) K ^TMP ($J,"PSOIN TERVENE",P SODFN)
	2374	"RTN","PSO RX1",120,0 )
	2375	K PSOERR, PSOMED,PSO RX,PSOSD,P SODRUG,PSO DFN,PSOOPT ,PSOBILL,P SOIBQS,PSO CPAY,PSOP
	2376	F,PSOPI,CO MM,DGI,DGS ,PT,PTDY,P TRF,RN,RTN ,SERS,ST0, STAT,DFN,S TOP,SLPPL, RXREC
	2377	"RTN","PSO RX1",121,0 )
	2378	K:'$G(MED P) PSOQFLG
	2379	"RTN","PSO RX1",122,0 )
	2380	D KVA^VAD PT,FULL^VA LM1 K PSOL ST,PSOXFLG ,PSCNT,PSD IS,PSOAL,P 1,LOG,%,%D T,%I,D0,D
	2381	AT,DFN,DRG ,ORX,PSON, PSOPTPST,P SORX,PTST, PSOBCK,PSO ID,PSOBXPU L
	2382	"RTN","PSO RX1",123,0 )
	2383	K INCOM,S IG,SG,STP, RX0,RXN,RX 2,RX3,RTS, C,DEAD,PS, PSOCLC,PSO CNT,PSOCT, PSODA,PSO
	2384	FROM,PSOHD ,R3,REA,RF ,RFD,RFM,R LD,RXNUM,R XP,RXPR,RX RP,RXRS,ST R,POERR,VA LMSG
	2385	"RTN","PSO RX1",124,0 )
	2386	K ^TMP("P SORXDD",$J ),^TMP("PS ORXDC",$J) ,^TMP("PSO AL",$J),^T MP("PSOAO" ,$J),^TMP
	2387	("PSOSF",$ J),^TMP("P SOPF",$J), ^TMP("PSOP I",$J),^TM P("PSOPO", $J),^TMP(" PSOHDR",$
	2388	J),^TMP("P SORXPO",$J )
	2389	"RTN","PSO RX1",125,0 )
	2390	I '$G(MED P),'$G(PSO QUIT) K PA T
	2391	"RTN","PSO RX1",126,0 )
	2392	K ^TMP("P SORXBO",$J ),PSORX,RF N,PSOXXDFN ,VALM,VALM KEY,PSOBCK ,SPOERR,PS OFLAG,VAL
	2393	MBCK,D,GMR A,GMRAL,GM RAREC,PSOS TA,PSODT,R XFL,NOBG,B BRX,BBFLG, ^TMP($J,"P SOFLPO")
	2394	"RTN","PSO RX1",127,0 )
	2395	K PPL,PPL 1,PSOQFLAG ;*334 ADD ED KILLS
	2396	"RTN","PSO RX1",128,0 )
	2397	K ^XTMP(" PSORRX1",$ J),PSORCNT ;*454 add ed kill
	2398	"RTN","PSO RX1",129,0 )
	2399	Q
	2400	"RTN","PSO RX1",130,0 )
	2401	ELIG ; sho ws eligibi lity and d isabilitie s
	2402	"RTN","PSO RX1",131,0 )
	2403	D ELIG^VA DPT W !,"E ligibility : "_$P(VAE L(1),"^",2 )_$S(+VAEL (3):" SC%: "_$P
	2404	(VAEL(3)," ^",2),1:"" ) S N=0 F S N=$O(VA EL(1,N)) Q :'N W !,? 10,$P(VAEL (1,N),"^"
	2405	,2)
	2406	"RTN","PSO RX1",132,0 )
	2407	W !,"Disa bilities: " F I=0:0 S I=$O(^DP T(DFN,.372 ,I)) Q:'I S I1=$S($ D(^DPT(DF
	2408	N,.372,I,0 )):^(0),1: "") D:+I1
	2409	"RTN","PSO RX1",133,0 )
	2410	.S PSDIS= $S($P($G(^ DIC(31,+I1 ,0)),"^")] ""&($P($G( ^(0)),"^", 4)']""):$P (^(0),"^"
	2411	),$P($G(^D IC(31,+I1, 0)),"^",4) ]"":$P(^(0 ),"^",4),1 :""),PSCNT =$P(I1,"^" ,2)
	2412	"RTN","PSO RX1",134,0 )
	2413	.W:$L(PSD IS_"-"_PSC NT_"% ("_$ S($P(I1,"^ ",3):"SC", 1:"NSC")_" ), ")>80 ! ,?15
	2414	"RTN","PSO RX1",135,0 )
	2415	.W $S($G( PSDIS)]"": PSDIS_"-", 1:"")_PSCN T_"% ("_$S ($P(I1,"^" ,3):"SC",1 :"NSC")_"
	2416	), "
	2417	"RTN","PSO RX1",136,0 )
	2418	K N
	2419	"RTN","PSO RX1",137,0 )
	2420	Q
	2421	"RTN","PSO RX1",138,0 )
	2422	PROFILE ;
	2423	"RTN","PSO RX1",139,0 )
	2424	S (PSORX( "REFILL"), PSORX("REN EW"))=0,PS OX="" D ^P SOBUILD
	2425	"RTN","PSO RX1",140,0 )
	2426	I '$G(PSO SD) W !,"T his patien t has no p rescriptio ns" S:'$D( DFN) DFN=P SODFN D G
	2427	MRA^PSODEM G PROFILE X
	2428	"RTN","PSO RX1",141,0 )
	2429	S (PSODRG ,PSOX)="" F S PSODR G=$O(PSOSD (PSODRG)) Q:PSODRG=" " F S PS OX=$O(PSO
	2430	SD(PSODRG, PSOX)) Q:P SOX="" S: $P(PSOSD(P SODRG,PSOX ),"^",3)=" " PSORX("R ENEW")=1
	2431	S:$P(PSOSD (PSODRG,PS OX),"^",4) ="" PSORX( "REFILL")= 1
	2432	"RTN","PSO RX1",142,0 )
	2433	K PSOX
	2434	"RTN","PSO RX1",143,0 )
	2435	PROFILEX Q
	2436	"RTN","PSO RX1",144,0 )
	2437	;
	2438	"RTN","PSO RX1",145,0 )
	2439	MAIL ; MAK E SURE MAI L STATUS I S COMPATIB LE WITH SC RIPTALK PA TIENT
	2440	"RTN","PSO RX1",146,0 )
	2441	I $P($G(^ PS(59,PSOS ITE,"STALK ")),"^")=" " Q ; NO SCRIPTALK PRINTER SE T UP FOR
	2442	THIS DIVIS ION
	2443	"RTN","PSO RX1",147,0 )
	2444	N MAIL
	2445	"RTN","PSO RX1",148,0 )
	2446	S MAIL=$G (^PS(55,PS ODFN,0)) I $P(MAIL," ^",3)>1 Q
	2447	"RTN","PSO RX1",149,0 )
	2448	MAILP W !! ,"REMINDER : CMOP doe s not fill ScripTalk prescript ions. Plea se select
	2449	mail"
	2450	"RTN","PSO RX1",150,0 )
	2451	W !,"stat us: 2 (DO NOT MAIL) , 3 (LOCAL REGULAR M AIL) or 4 (LOCAL CER TFIED MAI
	2452	L)."
	2453	"RTN","PSO RX1",151,0 )
	2454	R !,"MAIL : ",MAIL:1 20
	2455	"RTN","PSO RX1",152,0 )
	2456	I MAIL?1" ^".E Q
	2457	"RTN","PSO RX1",153,0 )
	2458	I MAIL<2! (MAIL>4) W !,"INVALI D MAIL SET TING - ENT ER 2,3, OR 4" G MAIL P
	2459	"RTN","PSO RX1",154,0 )
	2460	W " ",$S (MAIL=2:"D O NOT MAIL ",MAIL=3:" LOCAL REGU LAR MAIL", 1:"LOCAL C ERTIFIED
	2461	MAIL")
	2462	"RTN","PSO RX1",155,0 )
	2463	S $P(^PS( 55,PSODFN, 0),"^",3)= MAIL
	2464	"RTN","PSO RX1",156,0 )
	2465	Q
	2466	"RTN","PSO RX1",157,0 )
	2467	REMOTE ;
	2468	"RTN","PSO RX1",158,0 )
	2469	I $T(HAVE HDR^ORRDI1 )']"" Q
	2470	"RTN","PSO RX1",159,0 )
	2471	I '$$HAVE HDR^ORRDI1 Q
	2472	"RTN","PSO RX1",160,0 )
	2473	D HD^PSOD DPR2():(($ Y+5)'>IOSL )
	2474	"RTN","PSO RX1",161,0 )
	2475	I $D(^XTM P("ORRDI", "OUTAGE IN FO","DOWN" )) W !!,"R emote data not avail able - On
	2476	ly local o rder check s processe d.",! D HD ^PSODDPR2( ):(($Y+5)' >IOSL) Q
	2477	"RTN","PSO RX1",162,0 )
	2478	Q
	2479	"RTN","PSO RX1",163,0 )
	2480	PAUSE ;
	2481	"RTN","PSO RX1",164,0 )
	2482	W ! K DIR S DIR(0)= "E",DIR("? ")="Press Return to continue", DIR("A")=" Press Ret
	2483	urn to con tinue" D ^ DIR K DIR
	2484	"RTN","PSO RX1",165,0 )
	2485	Q
	2486	"RTN","PSO RX1",166,0 )
	2487	;
	2488	"RTN","PSO RX1",167,0 )
	2489	RXSTA ; DI SPLAY ELIG IBILITY & PROMPT FOR RX PATIEN T STATUS
	2490	"RTN","PSO RX1",168,0 )
	2491	N DA,PSOS TA
	2492	"RTN","PSO RX1",169,0 )
	2493	I '$G(PSO DFN) Q
	2494	"RTN","PSO RX1",170,0 )
	2495	S DA=PSOD FN,PSOSTA= $G(^PS(55, PSODFN,"PS "))
	2496	"RTN","PSO RX1",171,0 )
	2497	I $G(XQY0 )["PSO LMO E FINISH"! (XQY0["PSO LM BACKDO OR ORDERS" ) I PSOSTA ]"" D
	2498	"RTN","PSO RX1",172,0 )
	2499	.D ELIG^V ADPT W !," Eligibilit y: "_$P(VA EL(1),"^", 2)_$S(+VAE L(3):" SC%: "_$
	2500	P(VAEL(3), "^",2),1:" ")
	2501	"RTN","PSO RX1",173,0 )
	2502	.S N=0 F S N=$O(VA EL(1,N)) Q :'N W !,? 10,$P(VAEL (1,N),"^", 2)
	2503	"RTN","PSO RX1",174,0 )
	2504	.S DIC("A ")="RX PAT IENT STATU S: ",DIC(" B")=PSOSTA ,DIC(0)="Q EAMZ",DIC= 53 D ^DIC
	2505	K DIC
	2506	"RTN","PSO RX1",175,0 )
	2507	.I +Y>0,+ Y'=PSOSTA S DIE="^PS (55,",DR=" 3////"_+Y D ^DIE
	2508	"RTN","PSO RX1",176,0 )
	2509	Q
	2510	"VER")
	2511	8.0^22.2
	2512	"^DD",59.7 ,59.7,101, 0)
	2513	ONEVA PHAR MACY FLAG^ S^1:ON;0:O FF;^101;1^ Q
	2514	"^DD",59.7 ,59.7,101, 3)
	2515	Select '1' to turn o n the OneV A Pharmacy remote pr escription logic. Se lect '0'
	2516	to turn it off.
	2517	"^DD",59.7 ,59.7,101, 21,0)
	2518	^^6^6^3170 822^
	2519	"^DD",59.7 ,59.7,101, 21,1,0)
	2520	This flag controls t he functio nality of the OneVA Pharmacy r emote
	2521	"^DD",59.7 ,59.7,101, 21,2,0)
	2522	prescripti on logic. If the fla g is turne d on, this facility will be ab le
	2523	"^DD",59.7 ,59.7,101, 21,3,0)
	2524	to query p rescriptio ns from ot her facili ties, and will accep t incoming
	2525	"^DD",59.7 ,59.7,101, 21,4,0)
	2526	refill and partial f ills from other VA m edical fac ilities. I f the flag is
	2527	"^DD",59.7 ,59.7,101, 21,5,0)
	2528	turned 'of f', no que ries will be made, a nd externa l refill/p artial fil l
	2529	"^DD",59.7 ,59.7,101, 21,6,0)
	2530	requests w ill be dec lined.
	2531	"^DD",59.7 ,59.7,101, "DT")
	2532	3170822
	2533	"BLD",9861 ,6)
	2534	1^
	2535	$END KID P SO7.0497
	2536