2. EPMO Open Source Coordination Office Redaction File Detail Report

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

2.1 Files compared

#	Location	File	Last Modified
1	MCCF EDI TAS BPS PSO PSX Bundle.zip\MCCF EDI TAS BPS PSO PSX Bundle	BPS_1_22_PSO_PSX_T11.KID	Thu Jul 27 19:55:30 2017 UTC
2	MCCF EDI TAS BPS PSO PSX Bundle.zip\MCCF EDI TAS BPS PSO PSX Bundle	BPS_1_22_PSO_PSX_T11.KID	Thu Aug 31 16:54:56 2017 UTC

2.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	5	38680
Changed	4	8
Inserted	1	13
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	KIDS Distr ibution sa ved on Jun 29, 2017@ 08:41:37
2	MCCF EDI T AS ePharma cy Build 2 - T11
3	KIDS:B PS PSO PSX BUNDLE 10 .0^BPS1.0 22^PSO7. 0478^PSX* 2.0*81^
4
5	INSTALL NAME
6	BPS PSO PS X BUNDLE 1 0.0
7	"BLD",1053 2,0)
8	BPS PSO PS X BUNDLE 1 0.0^^1^317 0629^y
9	"BLD",1053 2,1,0)
10	^^1^1^3170 509^
11	"BLD",1053 2,1,1,0)
12	MCCF EDI T AS ePharma cy Build 2
13	"BLD",1053 2,6.3)
14	15
15	"BLD",1053 2,10,0)
16	^9.63^3^3
17	"BLD",1053 2,10,1,0)
18	BPS1.022 ^1
19	"BLD",1053 2,10,2,0)
20	PSO7.047 8^1
21	"BLD",1053 2,10,3,0)
22	PSX2.081 ^1
23	"BLD",1053 2,10,"B"," BPS1.022 ",1)
24
25	"BLD",1053 2,10,"B"," PSO7.047 8",2)
26
27	"BLD",1053 2,10,"B"," PSX2.081 ",3)
28
29	"BLD",1053 2,"KRN",0)
30	^9.67PA^77 9.2^20
31	"BLD",1053 2,"KRN",.4 ,0)
32	.4
33	"BLD",1053 2,"KRN",.4 01,0)
34	.401
35	"BLD",1053 2,"KRN",.4 02,0)
36	.402
37	"BLD",1053 2,"KRN",.4 03,0)
38	.403
39	"BLD",1053 2,"KRN",.5 ,0)
40	.5
41	"BLD",1053 2,"KRN",.8 4,0)
42	.84
43	"BLD",1053 2,"KRN",3. 6,0)
44	3.6
45	"BLD",1053 2,"KRN",3. 8,0)
46	3.8
47	"BLD",1053 2,"KRN",9. 2,0)
48	9.2
49	"BLD",1053 2,"KRN",9. 8,0)
50	9.8
51	"BLD",1053 2,"KRN",19 ,0)
52	19
53	"BLD",1053 2,"KRN",19 .1,0)
54	19.1
55	"BLD",1053 2,"KRN",10 1,0)
56	101
57	"BLD",1053 2,"KRN",40 9.61,0)
58	409.61
59	"BLD",1053 2,"KRN",77 1,0)
60	771
61	"BLD",1053 2,"KRN",77 9.2,0)
62	779.2
63	"BLD",1053 2,"KRN",87 0,0)
64	870
65	"BLD",1053 2,"KRN",89 89.51,0)
66	8989.51
67	"BLD",1053 2,"KRN",89 89.52,0)
68	8989.52
69	"BLD",1053 2,"KRN",89 94,0)
70	8994
71	"BLD",1053 2,"KRN","B ",.4,.4)
72
73	"BLD",1053 2,"KRN","B ",.401,.40 1)
74
75	"BLD",1053 2,"KRN","B ",.402,.40 2)
76
77	"BLD",1053 2,"KRN","B ",.403,.40 3)
78
79	"BLD",1053 2,"KRN","B ",.5,.5)
80
81	"BLD",1053 2,"KRN","B ",.84,.84)
82
83	"BLD",1053 2,"KRN","B ",3.6,3.6)
84
85	"BLD",1053 2,"KRN","B ",3.8,3.8)
86
87	"BLD",1053 2,"KRN","B ",9.2,9.2)
88
89	"BLD",1053 2,"KRN","B ",9.8,9.8)
90
91	"BLD",1053 2,"KRN","B ",19,19)
92
93	"BLD",1053 2,"KRN","B ",19.1,19. 1)
94
95	"BLD",1053 2,"KRN","B ",101,101)
96
97	"BLD",1053 2,"KRN","B ",409.61,4 09.61)
98
99	"BLD",1053 2,"KRN","B ",771,771)
100
101	"BLD",1053 2,"KRN","B ",779.2,77 9.2)
102
103	"BLD",1053 2,"KRN","B ",870,870)
104
105	"BLD",1053 2,"KRN","B ",8989.51, 8989.51)
106
107	"BLD",1053 2,"KRN","B ",8989.52, 8989.52)
108
109	"BLD",1053 2,"KRN","B ",8994,899 4)
110
111	"MBREQ")
112	0
113	"QUES","XP F1",0)
114	Y
115	"QUES","XP F1","??")
116	^D REP^XPD H
117	"QUES","XP F1","A")
118	Shall I wr ite over y our \|FLAG\| File
119	"QUES","XP F1","B")
120	YES
121	"QUES","XP F1","M")
122	D XPF1^XPD IQ
123	"QUES","XP F2",0)
124	Y
125	"QUES","XP F2","??")
126	^D DTA^XPD H
127	"QUES","XP F2","A")
128	Want my da ta \|FLAG\| yours
129	"QUES","XP F2","B")
130	YES
131	"QUES","XP F2","M")
132	D XPF2^XPD IQ
133	"QUES","XP I1",0)
134	YO
135	"QUES","XP I1","??")
136	^D INHIBIT ^XPDH
137	"QUES","XP I1","A")
138	Want KIDS to INHIBIT LOGONs du ring the i nstall
139	"QUES","XP I1","B")
140	NO
141	"QUES","XP I1","M")
142	D XPI1^XPD IQ
143	"QUES","XP M1",0)
144	PO^VA(200, :EM
145	"QUES","XP M1","??")
146	^D MG^XPDH
147	"QUES","XP M1","A")
148	Enter the Coordinato r for Mail Group '\|F LAG\|'
149	"QUES","XP M1","B")
150
151	"QUES","XP M1","M")
152	D XPM1^XPD IQ
153	"QUES","XP O1",0)
154	Y
155	"QUES","XP O1","??")
156	^D MENU^XP DH
157	"QUES","XP O1","A")
158	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
159	"QUES","XP O1","B")
160	NO
161	"QUES","XP O1","M")
162	D XPO1^XPD IQ
163	"QUES","XP Z1",0)
164	Y
165	"QUES","XP Z1","??")
166	^D OPT^XPD H
167	"QUES","XP Z1","A")
168	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
169	"QUES","XP Z1","B")
170	NO
171	"QUES","XP Z1","M")
172	D XPZ1^XPD IQ
173	"QUES","XP Z2",0)
174	Y
175	"QUES","XP Z2","??")
176	^D RTN^XPD H
177	"QUES","XP Z2","A")
178	Want to MO VE routine s to other CPUs
179	"QUES","XP Z2","B")
180	NO
181	"QUES","XP Z2","M")
182	D XPZ2^XPD IQ
183	"VER")
184	8.0^22.2
185	INSTALL NAME
186	BPS1.022
187	"BLD",1052 4,0)
188	BPS1.022 ^E CLAIMS MGMT ENGIN E^0^317062 9^y
189	"BLD",1052 4,1,0)
190	^^1^1^3170 602^^
191	"BLD",1052 4,1,1,0)
192	MCCF EDI T AS EPHARMA CY BUILD 2
193	"BLD",1052 4,4,0)
194	^9.64PA^90 02313.32^5
195	"BLD",1052 4,4,900231 3.02,0)
196	9002313.02
197	"BLD",1052 4,4,900231 3.02,2,0)
198	^9.641^900 2313.0201^ 1
199	"BLD",1052 4,4,900231 3.02,2,900 2313.0201, 0)
200	TRANSACTIO NS (sub-f ile)
201	"BLD",1052 4,4,900231 3.02,2,900 2313.0201, 1,0)
202	^9.6411^20 95^1
203	"BLD",1052 4,4,900231 3.02,2,900 2313.0201, 1,2095,0)
204	FACILITY I D QUALIFIE R
205	"BLD",1052 4,4,900231 3.02,222)
206	y^n^p^^^^n ^^n
207	"BLD",1052 4,4,900231 3.02,224)
208
209	"BLD",1052 4,4,900231 3.03,0)
210	9002313.03
211	"BLD",1052 4,4,900231 3.03,2,0)
212	^9.641^900 2313.0301^ 1
213	"BLD",1052 4,4,900231 3.03,2,900 2313.0301, 0)
214	RESPONSES (sub-file )
215	"BLD",1052 4,4,900231 3.03,2,900 2313.0301, 1,0)
216	^9.6411^20 98^1
217	"BLD",1052 4,4,900231 3.03,2,900 2313.0301, 1,2098,0)
218	RECONCILIA TION ID
219	"BLD",1052 4,4,900231 3.03,222)
220	y^n^p^^^^n ^^n
221	"BLD",1052 4,4,900231 3.03,224)
222
223	"BLD",1052 4,4,900231 3.32,0)
224	9002313.32
225	"BLD",1052 4,4,900231 3.32,2,0)
226	^9.641^900 2313.32^1
227	"BLD",1052 4,4,900231 3.32,2,900 2313.32,0)
228	BPS PAYER RESPONSE O VERRIDES (File-top level)
229	"BLD",1052 4,4,900231 3.32,2,900 2313.32,1, 0)
230	^9.6411^2. 09^1
231	"BLD",1052 4,4,900231 3.32,2,900 2313.32,1, 2.09,0)
232	RECONCILIA TION ID
233	"BLD",1052 4,4,900231 3.32,222)
234	y^n^p^^^^n ^^n
235	"BLD",1052 4,4,900231 3.32,224)
236
237	"BLD",1052 4,4,900231 3.56,0)
238	9002313.56
239	"BLD",1052 4,4,900231 3.56,2,0)
240	^9.641^900 2313.56^1
241	"BLD",1052 4,4,900231 3.56,2,900 2313.56,0)
242	BPS PHARMA CIES (Fil e-top leve l)
243	"BLD",1052 4,4,900231 3.56,2,900 2313.56,1, 0)
244	^9.6411^.0 9^1
245	"BLD",1052 4,4,900231 3.56,2,900 2313.56,1, .09,0)
246	AUTO-REVER SE PARAMET ER
247	"BLD",1052 4,4,900231 3.56,222)
248	y^y^p^^^^n ^^n
249	"BLD",1052 4,4,900231 3.56,224)
250
251	"BLD",1052 4,4,900231 3.91,0)
252	9002313.91
253	"BLD",1052 4,4,900231 3.91,222)
254	y^y^f^^n^^ y^o^n
255	"BLD",1052 4,4,"APDD" ,9002313.0 2,9002313. 0201)
256
257	"BLD",1052 4,4,"APDD" ,9002313.0 2,9002313. 0201,2095)
258
259	"BLD",1052 4,4,"APDD" ,9002313.0 3,9002313. 0301)
260
261	"BLD",1052 4,4,"APDD" ,9002313.0 3,9002313. 0301,2098)
262
263	"BLD",1052 4,4,"APDD" ,9002313.3 2,9002313. 32)
264
265	"BLD",1052 4,4,"APDD" ,9002313.3 2,9002313. 32,2.09)
266
267	"BLD",1052 4,4,"APDD" ,9002313.5 6,9002313. 56)
268
269	"BLD",1052 4,4,"APDD" ,9002313.5 6,9002313. 56,.09)
270
271	"BLD",1052 4,4,"B",90 02313.02,9 002313.02)
272
273	"BLD",1052 4,4,"B",90 02313.03,9 002313.03)
274
275	"BLD",1052 4,4,"B",90 02313.32,9 002313.32)
276
277	"BLD",1052 4,4,"B",90 02313.56,9 002313.56)
278
279	"BLD",1052 4,4,"B",90 02313.91,9 002313.91)
280
281	"BLD",1052 4,6.3)
282	15
283	"BLD",1052 4,"ABPKG")
284	n
285	"BLD",1052 4,"GLO",0)
286	^9.65^^
287	"BLD",1052 4,"INIT")
288	POST^BPS22 PST
289	"BLD",1052 4,"KRN",0)
290	^9.67PA^77 9.2^20
291	"BLD",1052 4,"KRN",.4 ,0)
292	.4
293	"BLD",1052 4,"KRN",.4 ,"NM",0)
294	^9.68A^^
295	"BLD",1052 4,"KRN",.4 01,0)
296	.401
297	"BLD",1052 4,"KRN",.4 02,0)
298	.402
299	"BLD",1052 4,"KRN",.4 03,0)
300	.403
301	"BLD",1052 4,"KRN",.5 ,0)
302	.5
303	"BLD",1052 4,"KRN",.8 4,0)
304	.84
305	"BLD",1052 4,"KRN",3. 6,0)
306	3.6
307	"BLD",1052 4,"KRN",3. 8,0)
308	3.8
309	"BLD",1052 4,"KRN",9. 2,0)
310	9.2
311	"BLD",1052 4,"KRN",9. 8,0)
312	9.8
313	"BLD",1052 4,"KRN",9. 8,"NM",0)
314	^9.68A^13^ 13
315	"BLD",1052 4,"KRN",9. 8,"NM",1,0 )
316	BPSSCR^^0^ B3032811
317	"BLD",1052 4,"KRN",9. 8,"NM",2,0 )
318	BPSSCRCV^^ 0^B6238232 9
319	"BLD",1052 4,"KRN",9. 8,"NM",3,0 )
320	BPSSCRSL^^ 0^B1656680 6
321	"BLD",1052 4,"KRN",9. 8,"NM",4,0 )
322	BPSVRX3^^0 ^B51860614
323	"BLD",1052 4,"KRN",9. 8,"NM",5,0 )
324	BPSBCKJ^^0 ^B53136758
325	"BLD",1052 4,"KRN",9. 8,"NM",6,0 )
326	BPSNCPDP^^ 0^B1038183 40
327	"BLD",1052 4,"KRN",9. 8,"NM",7,0 )
328	BPSPHAR^^0 ^B1773022
329	"BLD",1052 4,"KRN",9. 8,"NM",8,0 )
330	BPSTEST^^0 ^B22752928 1
331	"BLD",1052 4,"KRN",9. 8,"NM",9,0 )
332	BPSSCRLG^^ 0^B1279747 86
333	"BLD",1052 4,"KRN",9. 8,"NM",10, 0)
334	BPSSCRL1^^ 0^B6657675 0
335	"BLD",1052 4,"KRN",9. 8,"NM",11, 0)
336	BPSTEST1^^ 0^B196424
337	"BLD",1052 4,"KRN",9. 8,"NM",12, 0)
338	BPSSCRRJ^^ 0^B1305468 71
339	"BLD",1052 4,"KRN",9. 8,"NM",13, 0)
340	BPSNCPD3^^ 0^B6750638 8
341	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSBCKJ" ,5)
342
343	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSNCPD3 ",13)
344
345	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSNCPDP ",6)
346
347	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSPHAR" ,7)
348
349	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSSCR", 1)
350
351	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSSCRCV ",2)
352
353	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSSCRL1 ",10)
354
355	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSSCRLG ",9)
356
357	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSSCRRJ ",12)
358
359	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSSCRSL ",3)
360
361	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSTEST" ,8)
362
363	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSTEST1 ",11)
364
365	"BLD",1052 4,"KRN",9. 8,"NM","B" ,"BPSVRX3" ,4)
366
367	"BLD",1052 4,"KRN",19 ,0)
368	19
369	"BLD",1052 4,"KRN",19 .1,0)
370	19.1
371	"BLD",1052 4,"KRN",10 1,0)
372	101
373	"BLD",1052 4,"KRN",10 1,"NM",0)
374	^9.68A^17^ 17
375	"BLD",1052 4,"KRN",10 1,"NM",1,0 )
376	BPS VIEW E CME RX MEN U^^0
377	"BLD",1052 4,"KRN",10 1,"NM",2,0 )
378	BPS VRX NA V BILL LIS T^^0
379	"BLD",1052 4,"KRN",10 1,"NM",3,0 )
380	BPS VRX NA V BILLING EVENTS RPT ^^0
381	"BLD",1052 4,"KRN",10 1,"NM",4,0 )
382	BPS VRX NA V CRI^^0
383	"BLD",1052 4,"KRN",10 1,"NM",5,0 )
384	BPS VRX NA V DG ELIG STATUS^^0
385	"BLD",1052 4,"KRN",10 1,"NM",6,0 )
386	BPS VRX NA V DG ELIG VERIFICATI ON^^0
387	"BLD",1052 4,"KRN",10 1,"NM",7,0 )
388	BPS VRX NA V ECME CLA IM LOG^^0
389	"BLD",1052 4,"KRN",10 1,"NM",8,0 )
390	BPS VRX NA V INS POL^ ^0
391	"BLD",1052 4,"KRN",10 1,"NM",9,0 )
392	BPS VRX NA V PRINT RE PORT^^0
393	"BLD",1052 4,"KRN",10 1,"NM",10, 0)
394	BPS VRX NA V TPJI AR ACCT PROFI LE^^0
395	"BLD",1052 4,"KRN",10 1,"NM",11, 0)
396	BPS VRX NA V TPJI AR COMMENT HI STORY^^0
397	"BLD",1052 4,"KRN",10 1,"NM",12, 0)
398	BPS VRX NA V TPJI CLA IM INFORMA TION^^0
399	"BLD",1052 4,"KRN",10 1,"NM",13, 0)
400	BPS VRX NA V TPJI ECM E RX INFO^ ^0
401	"BLD",1052 4,"KRN",10 1,"NM",14, 0)
402	BPS VRX NA V VIEWRX^^ 0
403	"BLD",1052 4,"KRN",10 1,"NM",15, 0)
404	VALM BLANK 1^^0
405	"BLD",1052 4,"KRN",10 1,"NM",16, 0)
406	VALM BLANK 2^^0
407	"BLD",1052 4,"KRN",10 1,"NM",17, 0)
408	VALM BLANK 3^^0
409	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VIEW ECME RX M ENU",1)
410
411	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV BILL L IST",2)
412
413	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV BILLIN G EVENTS R PT",3)
414
415	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV CRI",4 )
416
417	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV DG ELI G STATUS", 5)
418
419	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV DG ELI G VERIFICA TION",6)
420
421	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV ECME C LAIM LOG", 7)
422
423	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV INS PO L",8)
424
425	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV PRINT REPORT",9)
426
427	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV TPJI A R ACCT PRO FILE",10)
428
429	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV TPJI A R COMMENT HISTORY",1 1)
430
431	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV TPJI C LAIM INFOR MATION",12 )
432
433	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV TPJI E CME RX INF O",13)
434
435	"BLD",1052 4,"KRN",10 1,"NM","B" ,"BPS VRX NAV VIEWRX ",14)
436
437	"BLD",1052 4,"KRN",10 1,"NM","B" ,"VALM BLA NK 1",15)
438
439	"BLD",1052 4,"KRN",10 1,"NM","B" ,"VALM BLA NK 2",16)
440
441	"BLD",1052 4,"KRN",10 1,"NM","B" ,"VALM BLA NK 3",17)
442
443	"BLD",1052 4,"KRN",40 9.61,0)
444	409.61
445	"BLD",1052 4,"KRN",40 9.61,"NM", 0)
446	^9.68A^1^1
447	"BLD",1052 4,"KRN",40 9.61,"NM", 1,0)
448	BPS VIEW E CME RX^^0
449	"BLD",1052 4,"KRN",40 9.61,"NM", "B","BPS V IEW ECME R X",1)
450
451	"BLD",1052 4,"KRN",77 1,0)
452	771
453	"BLD",1052 4,"KRN",77 9.2,0)
454	779.2
455	"BLD",1052 4,"KRN",87 0,0)
456	870
457	"BLD",1052 4,"KRN",89 89.51,0)
458	8989.51
459	"BLD",1052 4,"KRN",89 89.52,0)
460	8989.52
461	"BLD",1052 4,"KRN",89 94,0)
462	8994
463	"BLD",1052 4,"KRN","B ",.4,.4)
464
465	"BLD",1052 4,"KRN","B ",.401,.40 1)
466
467	"BLD",1052 4,"KRN","B ",.402,.40 2)
468
469	"BLD",1052 4,"KRN","B ",.403,.40 3)
470
471	"BLD",1052 4,"KRN","B ",.5,.5)
472
473	"BLD",1052 4,"KRN","B ",.84,.84)
474
475	"BLD",1052 4,"KRN","B ",3.6,3.6)
476
477	"BLD",1052 4,"KRN","B ",3.8,3.8)
478
479	"BLD",1052 4,"KRN","B ",9.2,9.2)
480
481	"BLD",1052 4,"KRN","B ",9.8,9.8)
482
483	"BLD",1052 4,"KRN","B ",19,19)
484
485	"BLD",1052 4,"KRN","B ",19.1,19. 1)
486
487	"BLD",1052 4,"KRN","B ",101,101)
488
489	"BLD",1052 4,"KRN","B ",409.61,4 09.61)
490
491	"BLD",1052 4,"KRN","B ",771,771)
492
493	"BLD",1052 4,"KRN","B ",779.2,77 9.2)
494
495	"BLD",1052 4,"KRN","B ",870,870)
496
497	"BLD",1052 4,"KRN","B ",8989.51, 8989.51)
498
499	"BLD",1052 4,"KRN","B ",8989.52, 8989.52)
500
501	"BLD",1052 4,"KRN","B ",8994,899 4)
502
503	"BLD",1052 4,"QUES",0 )
504	^9.62^^
505	"BLD",1052 4,"REQB",0 )
506	^9.611^^
507	"DATA",900 2313.91,1, 0)
508	101^^BIN N UMBER^N^^^ ^6^N
509	"DATA",900 2313.91,1, 5)
510	A1^6
511	"DATA",900 2313.91,1, 10,0)
512	^9002313.9 101^1^1^30 61023
513	"DATA",900 2313.91,1, 10,1,0)
514	S BPS("X") =$G(BPS("N CPDP","BIN Number"))
515	"DATA",900 2313.91,1, 20,0)
516	^9002313.9 102^1^1^31 01101
517	"DATA",900 2313.91,1, 20,1,0)
518	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),6)
519	"DATA",900 2313.91,1, 25,0)
520	^9002313.9 104^1^1^30 40130^^^^
521	"DATA",900 2313.91,1, 25,1,0)
522	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),6)
523	"DATA",900 2313.91,1, 30,0)
524	^9002313.9 103^1^1^30 40130^^^^
525	"DATA",900 2313.91,1, 30,1,0)
526	S $P(^BPSC (BPS(90023 13.02),100 ),U,1)=BPS ("X")
527	"DATA",900 2313.91,2, 0)
528	102^^VERSI ON/RELEASE NUMBER^A/ N^^^^2^A/N
529	"DATA",900 2313.91,2, 5)
530	A2^2
531	"DATA",900 2313.91,2, 10,0)
532	^9002313.9 101^1^1^30 61023
533	"DATA",900 2313.91,2, 10,1,0)
534	S BPS("X") =$G(BPS("N CPDP","Ver sion"))
535	"DATA",900 2313.91,2, 20,0)
536	^9002313.9 102^1^1^31 01101
537	"DATA",900 2313.91,2, 20,1,0)
538	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
539	"DATA",900 2313.91,2, 25,0)
540	^9002313.9 104^1^1^30 40114^^^^
541	"DATA",900 2313.91,2, 25,1,0)
542	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
543	"DATA",900 2313.91,2, 30,0)
544	^9002313.9 103^1^1^30 40114^^^^
545	"DATA",900 2313.91,2, 30,1,0)
546	S $P(^BPSC (BPS(90023 13.02),100 ),U,2)=BPS ("X")
547	"DATA",900 2313.91,3, 0)
548	103^^TRANS ACTION COD E^N^^^^2^A /N
549	"DATA",900 2313.91,3, 5)
550	A3^2
551	"DATA",900 2313.91,3, 10,0)
552	^9002313.9 101^1^1^30 61023
553	"DATA",900 2313.91,3, 10,1,0)
554	S BPS("X") =$G(BPS("T ransaction Code"))
555	"DATA",900 2313.91,3, 20,0)
556	^9002313.9 102^1^1^31 01101
557	"DATA",900 2313.91,3, 20,1,0)
558	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
559	"DATA",900 2313.91,3, 25,0)
560	^9002313.9 104^1^1^30 40130^^^^
561	"DATA",900 2313.91,3, 25,1,0)
562	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
563	"DATA",900 2313.91,3, 30,0)
564	^9002313.9 103^1^1^30 40130^^^^
565	"DATA",900 2313.91,3, 30,1,0)
566	S $P(^BPSC (BPS(90023 13.02),100 ),U,3)=BPS ("X")
567	"DATA",900 2313.91,4, 0)
568	104^^PROCE SSOR CONTR OL NUMBER^ A/N^^^^10^ A/N
569	"DATA",900 2313.91,4, 5)
570	A4^10
571	"DATA",900 2313.91,4, 10,0)
572	^9002313.9 101^1^1^30 61023
573	"DATA",900 2313.91,4, 10,1,0)
574	S BPS("X") =$G(BPS("N CPDP","PCN "))
575	"DATA",900 2313.91,4, 20,0)
576	^9002313.9 102^1^1^31 01101
577	"DATA",900 2313.91,4, 20,1,0)
578	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
579	"DATA",900 2313.91,4, 25,0)
580	^9002313.9 104^1^1^30 40820^^^^
581	"DATA",900 2313.91,4, 25,1,0)
582	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
583	"DATA",900 2313.91,4, 30,0)
584	^9002313.9 103^1^1^30 40820^^^^
585	"DATA",900 2313.91,4, 30,1,0)
586	S $P(^BPSC (BPS(90023 13.02),100 ),U,4)=BPS ("X")
587	"DATA",900 2313.91,5, 0)
588	201^^SERVI CE PROVIDE R ID^A/N^^ ^^15^A/N
589	"DATA",900 2313.91,5, 5)
590	B1^12
591	"DATA",900 2313.91,5, 10,0)
592	^^1^1^3110 523^
593	"DATA",900 2313.91,5, 10,1,0)
594	S BPS("X") =$G(BPS("S ite","NPI" ))
595	"DATA",900 2313.91,5, 20,0)
596	^9002313.9 102^1^1^31 10523^
597	"DATA",900 2313.91,5, 20,1,0)
598	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
599	"DATA",900 2313.91,5, 25,0)
600	^^1^1^3110 523^
601	"DATA",900 2313.91,5, 25,1,0)
602	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
603	"DATA",900 2313.91,5, 30,0)
604	^^1^1^3110 523^
605	"DATA",900 2313.91,5, 30,1,0)
606	S $P(^BPSC (BPS(90023 13.02),200 ),U,1)=BPS ("X")
607	"DATA",900 2313.91,6, 0)
608	301^^GROUP ID^A/N^^^ ^15^A/N
609	"DATA",900 2313.91,6, 5)
610	C1^15
611	"DATA",900 2313.91,6, 10,0)
612	^9002313.9 101^1^1^31 01216^
613	"DATA",900 2313.91,6, 10,1,0)
614	S BPS("X") =$G(BPS("I nsurer","G roup #"))
615	"DATA",900 2313.91,6, 20,0)
616	^9002313.9 102^1^1^31 01101
617	"DATA",900 2313.91,6, 20,1,0)
618	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
619	"DATA",900 2313.91,6, 25,0)
620	^9002313.9 104^1^1^30 41021^^^^
621	"DATA",900 2313.91,6, 25,1,0)
622	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
623	"DATA",900 2313.91,6, 30,0)
624	^9002313.9 103^1^1^30 41021^^^^
625	"DATA",900 2313.91,6, 30,1,0)
626	S $P(^BPSC (BPS(90023 13.02),300 ),U,1)=BPS ("X")
627	"DATA",900 2313.91,7, 0)
628	302^^CARDH OLDER ID^A /N^^^^20^A /N
629	"DATA",900 2313.91,7, 5)
630	C2^20
631	"DATA",900 2313.91,7, 10,0)
632	^9002313.9 101^1^1^30 41021
633	"DATA",900 2313.91,7, 10,1,0)
634	S BPS("X") =$G(BPS("I nsurer","P olicy #"))
635	"DATA",900 2313.91,7, 20,0)
636	^9002313.9 102^1^1^31 01101
637	"DATA",900 2313.91,7, 20,1,0)
638	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
639	"DATA",900 2313.91,7, 25,0)
640	^9002313.9 104^1^1^30 61121^
641	"DATA",900 2313.91,7, 25,1,0)
642	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
643	"DATA",900 2313.91,7, 30,0)
644	^9002313.9 103^1^1^31 01004^^^
645	"DATA",900 2313.91,7, 30,1,0)
646	S $P(^BPSC (BPS(90023 13.02),300 ),U,2)=$TR (BPS("X"), " ","")
647	"DATA",900 2313.91,8, 0)
648	303^^PERSO N CODE^A/N ^^^^3^A/N
649	"DATA",900 2313.91,8, 5)
650	C3^3
651	"DATA",900 2313.91,8, 10,0)
652	^9002313.9 101^1^1^30 40114
653	"DATA",900 2313.91,8, 10,1,0)
654	S BPS("X") =$G(BPS("I nsurer","P erson Code "))
655	"DATA",900 2313.91,8, 20,0)
656	^9002313.9 102^1^1^31 01101
657	"DATA",900 2313.91,8, 20,1,0)
658	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
659	"DATA",900 2313.91,8, 25,0)
660	^9002313.9 104^1^1^30 40114^^^^
661	"DATA",900 2313.91,8, 25,1,0)
662	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
663	"DATA",900 2313.91,8, 30,0)
664	^9002313.9 103^1^1^30 40114^^^^
665	"DATA",900 2313.91,8, 30,1,0)
666	S $P(^BPSC (BPS(90023 13.02),300 ),U,3)=BPS ("X")
667	"DATA",900 2313.91,9, 0)
668	304^^DATE OF BIRTH^N ^^^^8^N
669	"DATA",900 2313.91,9, 5)
670	C4^8
671	"DATA",900 2313.91,9, 10,0)
672	^9002313.9 101^1^1^30 40820
673	"DATA",900 2313.91,9, 10,1,0)
674	S BPS("X") =$G(BPS("P atient","D OB"))
675	"DATA",900 2313.91,9, 20,0)
676	^9002313.9 102^1^1^31 01029^
677	"DATA",900 2313.91,9, 20,1,0)
678	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
679	"DATA",900 2313.91,9, 25,0)
680	^9002313.9 104^1^1^30 40820^^^^
681	"DATA",900 2313.91,9, 25,1,0)
682	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
683	"DATA",900 2313.91,9, 30,0)
684	^9002313.9 103^1^1^31 01004^
685	"DATA",900 2313.91,9, 30,1,0)
686	S $P(^BPSC (BPS(90023 13.02),300 ),U,4)=$G( BPS("X"))
687	"DATA",900 2313.91,10 ,0)
688	305^^PATIE NT GENDER CODE^N^^^^ 1^N
689	"DATA",900 2313.91,10 ,5)
690	C5^1
691	"DATA",900 2313.91,10 ,10,0)
692	^9002313.9 101^3^3^30 40114
693	"DATA",900 2313.91,10 ,10,1,0)
694	S BPS("X") =$G(BPS("P atient","S ex"))
695	"DATA",900 2313.91,10 ,10,2,0)
696	S BPS("X") =$E(BPS("X "),1,1)
697	"DATA",900 2313.91,10 ,10,3,0)
698	S BPS("X") =$S(BPS("X ")="M":"1" ,BPS("X")= "F":"2",1: "0")
699	"DATA",900 2313.91,10 ,20,0)
700	^9002313.9 102^1^1^31 01101
701	"DATA",900 2313.91,10 ,20,1,0)
702	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
703	"DATA",900 2313.91,10 ,25,0)
704	^9002313.9 104^1^1^30 40114^^
705	"DATA",900 2313.91,10 ,25,1,0)
706	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
707	"DATA",900 2313.91,10 ,30,0)
708	^9002313.9 103^1^1^30 40114^^^^
709	"DATA",900 2313.91,10 ,30,1,0)
710	S $P(^BPSC (BPS(90023 13.02),300 ),U,5)=BPS ("X")
711	"DATA",900 2313.91,11 ,0)
712	306^^PATIE NT RELATIO NSHIP CODE ^N^^^^1^N
713	"DATA",900 2313.91,11 ,5)
714	C6^1
715	"DATA",900 2313.91,11 ,10,0)
716	^9002313.9 101^1^1^30 40114
717	"DATA",900 2313.91,11 ,10,1,0)
718	S BPS("X") =$G(BPS("I nsurer","R elationshi p"))
719	"DATA",900 2313.91,11 ,20,0)
720	^9002313.9 102^1^1^31 01101
721	"DATA",900 2313.91,11 ,20,1,0)
722	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
723	"DATA",900 2313.91,11 ,25,0)
724	^9002313.9 104^1^1^30 40114^^^
725	"DATA",900 2313.91,11 ,25,1,0)
726	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
727	"DATA",900 2313.91,11 ,30,0)
728	^9002313.9 103^1^1^30 40114^^^^
729	"DATA",900 2313.91,11 ,30,1,0)
730	S $P(^BPSC (BPS(90023 13.02),300 ),U,6)=BPS ("X")
731	"DATA",900 2313.91,12 ,0)
732	308^^OTHER COVERAGE CODE^N^^^^ 2^N
733	"DATA",900 2313.91,12 ,5)
734	C8^2
735	"DATA",900 2313.91,12 ,10,0)
736	^9002313.9 101^2^2^31 01115^
737	"DATA",900 2313.91,12 ,10,1,0)
738	S BPS("X") =$G(BPS("P atient","O ther Cover age Code") )
739	"DATA",900 2313.91,12 ,10,2,0)
740	S:'BPS("X" ) BPS("X") =0
741	"DATA",900 2313.91,12 ,20,0)
742	^9002313.9 102^1^1^31 01101
743	"DATA",900 2313.91,12 ,20,1,0)
744	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
745	"DATA",900 2313.91,12 ,25,0)
746	^9002313.9 104^1^1^30 40114^^^^
747	"DATA",900 2313.91,12 ,25,1,0)
748	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
749	"DATA",900 2313.91,12 ,30,0)
750	^9002313.9 103^1^1^31 01115^^^
751	"DATA",900 2313.91,12 ,30,1,0)
752	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 00),U,8)=B PS("X")
753	"DATA",900 2313.91,13 ,0)
754	401^^DATE OF SERVICE ^N^^^^8^N
755	"DATA",900 2313.91,13 ,5)
756	D1^8
757	"DATA",900 2313.91,13 ,10,0)
758	^^1^1^3121 128
759	"DATA",900 2313.91,13 ,10,1,0)
760	S BPS("X") =$G(BPS("N CPDP","DOS "))
761	"DATA",900 2313.91,13 ,20,0)
762	^9002313.9 102^1^1^31 01101
763	"DATA",900 2313.91,13 ,20,1,0)
764	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
765	"DATA",900 2313.91,13 ,25,0)
766	^9002313.9 104^1^1^30 40113^^^^
767	"DATA",900 2313.91,13 ,25,1,0)
768	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
769	"DATA",900 2313.91,13 ,30,0)
770	^^1^1^3121 128
771	"DATA",900 2313.91,13 ,30,1,0)
772	S $P(^BPSC (BPS(90023 13.02),401 ),U,1)=BPS ("X")
773	"DATA",900 2313.91,14 ,0)
774	307^^PLACE OF SERVIC E^A/N^^^^2 ^N
775	"DATA",900 2313.91,14 ,5)
776	C7^2
777	"DATA",900 2313.91,14 ,10,0)
778	^9002313.9 101^1^1^30 40820
779	"DATA",900 2313.91,14 ,10,1,0)
780	S BPS("X") =$G(BPS("P atient","P lace of Se rvice"))
781	"DATA",900 2313.91,14 ,20,0)
782	^9002313.9 102^1^1^31 01101
783	"DATA",900 2313.91,14 ,20,1,0)
784	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
785	"DATA",900 2313.91,14 ,25,0)
786	^9002313.9 104^1^1^30 61121^
787	"DATA",900 2313.91,14 ,25,1,0)
788	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
789	"DATA",900 2313.91,14 ,30,0)
790	^9002313.9 103^1^1^31 00910^^^^
791	"DATA",900 2313.91,14 ,30,1,0)
792	S $P(^BPSC (BPS(90023 13.02),300 ),U,7)=BPS ("X")
793	"DATA",900 2313.91,15 ,0)
794	309^^ELIGI BILITY CLA RIFICATION CODE^N^^^ ^1^N
795	"DATA",900 2313.91,15 ,5)
796	C9^1
797	"DATA",900 2313.91,15 ,10,0)
798	^^2^2^3110 727^
799	"DATA",900 2313.91,15 ,10,1,0)
800	S BPS("X") =$G(BPS("I nsurer","E ligibility Clarifica tion Code" ))
801	"DATA",900 2313.91,15 ,10,2,0)
802	S:BPS("X") ="" BPS("X ")=0
803	"DATA",900 2313.91,15 ,20,0)
804	^9002313.9 102^1^1^31 01101
805	"DATA",900 2313.91,15 ,20,1,0)
806	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
807	"DATA",900 2313.91,15 ,25,0)
808	^9002313.9 104^1^1^30 61121^
809	"DATA",900 2313.91,15 ,25,1,0)
810	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
811	"DATA",900 2313.91,15 ,30,0)
812	^9002313.9 103^1^1^30 40114^^^^
813	"DATA",900 2313.91,15 ,30,1,0)
814	S $P(^BPSC (BPS(90023 13.02),300 ),U,9)=BPS ("X")
815	"DATA",900 2313.91,16 ,0)
816	310^^PATIE NT FIRST N AME^A/N^^^ ^12^A/N
817	"DATA",900 2313.91,16 ,5)
818	CA^12
819	"DATA",900 2313.91,16 ,10,0)
820	^^1^1^3101 216^
821	"DATA",900 2313.91,16 ,10,1,0)
822	S BPS("X") =$G(BPS("P atient","F irst Name" ))
823	"DATA",900 2313.91,16 ,20,0)
824	^9002313.9 102^1^1^31 01101
825	"DATA",900 2313.91,16 ,20,1,0)
826	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 2)
827	"DATA",900 2313.91,16 ,25,0)
828	^9002313.9 104^1^1^30 61121^
829	"DATA",900 2313.91,16 ,25,1,0)
830	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 2)
831	"DATA",900 2313.91,16 ,30,0)
832	^9002313.9 103^1^1^31 01004^^^^
833	"DATA",900 2313.91,16 ,30,1,0)
834	S $P(^BPSC (BPS(90023 13.02),300 ),U,10)=BP S("X")
835	"DATA",900 2313.91,17 ,0)
836	311^^PATIE NT LAST NA ME^A/N^^^^ 15^A/N
837	"DATA",900 2313.91,17 ,5)
838	CB^15
839	"DATA",900 2313.91,17 ,10,0)
840	^^1^1^3101 216^
841	"DATA",900 2313.91,17 ,10,1,0)
842	S BPS("X") =$G(BPS("P atient","L ast Name") )
843	"DATA",900 2313.91,17 ,20,0)
844	^9002313.9 102^1^1^31 01004^
845	"DATA",900 2313.91,17 ,20,1,0)
846	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
847	"DATA",900 2313.91,17 ,25,0)
848	^9002313.9 104^1^1^31 01004^^^
849	"DATA",900 2313.91,17 ,25,1,0)
850	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
851	"DATA",900 2313.91,17 ,30,0)
852	^9002313.9 103^1^1^31 01004^^^
853	"DATA",900 2313.91,17 ,30,1,0)
854	S $P(^BPSC (BPS(90023 13.02),300 ),U,11)=$G (BPS("X"))
855	"DATA",900 2313.91,18 ,0)
856	402^^PRESC RIPTION/SE RVICE REF NO^N^^^^12 ^N
857	"DATA",900 2313.91,18 ,1)
858	PRESCRIPTI ON/SERVICE REFERENCE NUMBER
859	"DATA",900 2313.91,18 ,5)
860	D2^7
861	"DATA",900 2313.91,18 ,10,0)
862	^9002313.9 101^1^1^31 01115^^^^
863	"DATA",900 2313.91,18 ,10,1,0)
864	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"RX IEN") )
865	"DATA",900 2313.91,18 ,20,0)
866	^^2^2^3121 128
867	"DATA",900 2313.91,18 ,20,1,0)
868	I $L($G(BP S("X")))>1 2 S BPS("X ")=$E(BPS( "X"),$L(BP S("X"))-11 ,$L(BPS("X ")))
869	"DATA",900 2313.91,18 ,20,2,0)
870	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),12 )
871	"DATA",900 2313.91,18 ,25,0)
872	^9002313.9 104^2^2^31 01006^^^^
873	"DATA",900 2313.91,18 ,25,1,0)
874	I $L(BPS(" X"))>7 S B PS("X")=$E (BPS("X"), $L(BPS("X" ))-6,$L(BP S("X")))
875	"DATA",900 2313.91,18 ,25,2,0)
876	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),7)
877	"DATA",900 2313.91,18 ,30,0)
878	^9002313.9 103^1^1^31 01115^^^^
879	"DATA",900 2313.91,18 ,30,1,0)
880	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,2)=B PS("X")
881	"DATA",900 2313.91,19 ,0)
882	403^^FILL NUMBER^N^^ ^^2^N
883	"DATA",900 2313.91,19 ,5)
884	D3^2
885	"DATA",900 2313.91,19 ,10,0)
886	^9002313.9 101^1^1^30 30718
887	"DATA",900 2313.91,19 ,10,1,0)
888	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Refill # "))
889	"DATA",900 2313.91,19 ,20,0)
890	^9002313.9 102^1^1^31 01101
891	"DATA",900 2313.91,19 ,20,1,0)
892	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
893	"DATA",900 2313.91,19 ,25,0)
894	^9002313.9 104^1^1^30 30718^^
895	"DATA",900 2313.91,19 ,25,1,0)
896	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
897	"DATA",900 2313.91,19 ,30,0)
898	1^9002313. 9103^1^1^3 030718^^^
899	"DATA",900 2313.91,19 ,30,1,0)
900	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,3)=B PS("X")
901	"DATA",900 2313.91,20 ,0)
902	B87^^QUAN LIMIT PER SPC TM PD COUNT^^^^^ 1^N
903	"DATA",900 2313.91,20 ,1)
904	QUANTITY L IMIT PER S PECIFIC TI ME PERIOD COUNT
905	"DATA",900 2313.91,20 ,5)
906	3P^^2087
907	"DATA",900 2313.91,20 ,10,0)
908	^9002313.9 101^1^1^31 50915^^
909	"DATA",900 2313.91,20 ,10,1,0)
910	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
911	"DATA",900 2313.91,21 ,0)
912	405^^DAYS SUPPLY^N^^ ^^3^N
913	"DATA",900 2313.91,21 ,5)
914	D5^3
915	"DATA",900 2313.91,21 ,10,0)
916	^9002313.9 101^1^1^30 40109
917	"DATA",900 2313.91,21 ,10,1,0)
918	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Days Sup ply"))
919	"DATA",900 2313.91,21 ,20,0)
920	^9002313.9 102^1^1^31 01101
921	"DATA",900 2313.91,21 ,20,1,0)
922	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),3)
923	"DATA",900 2313.91,21 ,25,0)
924	^9002313.9 104^1^1^30 30827^^^^
925	"DATA",900 2313.91,21 ,25,1,0)
926	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),3)
927	"DATA",900 2313.91,21 ,30,0)
928	^9002313.9 103^1^1^30 30827^^^^
929	"DATA",900 2313.91,21 ,30,1,0)
930	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,5)=B PS("X")
931	"DATA",900 2313.91,22 ,0)
932	406^^COMPO UND CODE^N ^^^^1^N
933	"DATA",900 2313.91,22 ,5)
934	D6^407
935	"DATA",900 2313.91,22 ,10,0)
936	^9002313.9 101^2^2^30 40114
937	"DATA",900 2313.91,22 ,10,1,0)
938	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Compound Code"))
939	"DATA",900 2313.91,22 ,10,2,0)
940	S:BPS("X") ="" BPS("X ")=1
941	"DATA",900 2313.91,22 ,20,0)
942	^9002313.9 102^1^1^31 01101
943	"DATA",900 2313.91,22 ,20,1,0)
944	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
945	"DATA",900 2313.91,22 ,25,0)
946	^9002313.9 104^1^1^30 40114^^^^
947	"DATA",900 2313.91,22 ,25,1,0)
948	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
949	"DATA",900 2313.91,22 ,30,0)
950	^9002313.9 103^1^1^30 40114^^^^
951	"DATA",900 2313.91,22 ,30,1,0)
952	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,6)=B PS("X")
953	"DATA",900 2313.91,23 ,0)
954	407^^PRODU CT/SERVICE ID^A/N^^^ ^19^A/N
955	"DATA",900 2313.91,23 ,5)
956	D7^19
957	"DATA",900 2313.91,23 ,10,0)
958	^9002313.9 101^2^2^30 30825
959	"DATA",900 2313.91,23 ,10,1,0)
960	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"NDC"))
961	"DATA",900 2313.91,23 ,10,2,0)
962	S BPS("X") =$$NDCF^BP SECFM(BPS( "X"))
963	"DATA",900 2313.91,23 ,20,0)
964	^9002313.9 102^1^1^31 01101
965	"DATA",900 2313.91,23 ,20,1,0)
966	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
967	"DATA",900 2313.91,23 ,25,0)
968	^9002313.9 104^1^1^30 30825^^^
969	"DATA",900 2313.91,23 ,25,1,0)
970	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
971	"DATA",900 2313.91,23 ,30,0)
972	^9002313.9 103^1^1^30 30825^^^^
973	"DATA",900 2313.91,23 ,30,1,0)
974	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,7)=B PS("X")
975	"DATA",900 2313.91,24 ,0)
976	408^^DAW P RODUCT SEL ECTION COD E^N^^^^1^A /N
977	"DATA",900 2313.91,24 ,1)
978	DISPENSE A S WRITTEN (DAW)/ PRO DUCT SELEC TION CODE
979	"DATA",900 2313.91,24 ,5)
980	D8^1
981	"DATA",900 2313.91,24 ,10,0)
982	^9002313.9 101^2^2^30 70205
983	"DATA",900 2313.91,24 ,10,1,0)
984	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"DAW"))
985	"DATA",900 2313.91,24 ,10,2,0)
986	S:BPS("X") ="" BPS("X ")=0
987	"DATA",900 2313.91,24 ,20,0)
988	^9002313.9 102^1^1^31 01101
989	"DATA",900 2313.91,24 ,20,1,0)
990	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
991	"DATA",900 2313.91,24 ,25,0)
992	^9002313.9 104^1^1^30 61120^
993	"DATA",900 2313.91,24 ,25,1,0)
994	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
995	"DATA",900 2313.91,24 ,30,0)
996	^9002313.9 103^1^1^30 30722^
997	"DATA",900 2313.91,24 ,30,1,0)
998	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,8)=B PS("X")
999	"DATA",900 2313.91,25 ,0)
1000	409^^INGRE DIENT COST SUBMITTED ^D^^^^8^D
1001	"DATA",900 2313.91,25 ,5)
1002	D9^8
1003	"DATA",900 2313.91,25 ,10,0)
1004	^^1^1^3121 128
1005	"DATA",900 2313.91,25 ,10,1,0)
1006	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Ingredie nt Cost"))
1007	"DATA",900 2313.91,25 ,20,0)
1008	^9002313.9 102^1^1^31 01101
1009	"DATA",900 2313.91,25 ,20,1,0)
1010	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1011	"DATA",900 2313.91,25 ,25,0)
1012	^9002313.9 104^1^1^30 40907^^^^
1013	"DATA",900 2313.91,25 ,25,1,0)
1014	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1015	"DATA",900 2313.91,25 ,30,0)
1016	^9002313.9 103^1^1^30 40907^^^^
1017	"DATA",900 2313.91,25 ,30,1,0)
1018	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,9)=B PS("X")
1019	"DATA",900 2313.91,26 ,0)
1020	411^^PRESC RIBER ID^A /N^^^^15^A /N
1021	"DATA",900 2313.91,26 ,5)
1022	DB^15
1023	"DATA",900 2313.91,26 ,10,0)
1024	^9002313.9 101^1^1^30 70214
1025	"DATA",900 2313.91,26 ,10,1,0)
1026	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er NPI"))
1027	"DATA",900 2313.91,26 ,20,0)
1028	^9002313.9 102^1^1^31 01101
1029	"DATA",900 2313.91,26 ,20,1,0)
1030	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
1031	"DATA",900 2313.91,26 ,25,0)
1032	^9002313.9 104^1^1^30 70214^
1033	"DATA",900 2313.91,26 ,25,1,0)
1034	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
1035	"DATA",900 2313.91,26 ,30,0)
1036	^9002313.9 103^1^1^30 30823^^^^
1037	"DATA",900 2313.91,26 ,30,1,0)
1038	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,11)= BPS("X")
1039	"DATA",900 2313.91,27 ,0)
1040	414^^DATE PRESCRIPTI ON WRITTEN ^N^^^^8^N
1041	"DATA",900 2313.91,27 ,5)
1042	DE^8
1043	"DATA",900 2313.91,27 ,10,0)
1044	^9002313.9 101^1^1^30 40913
1045	"DATA",900 2313.91,27 ,10,1,0)
1046	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Date Wri tten"))
1047	"DATA",900 2313.91,27 ,20,0)
1048	^9002313.9 102^1^1^31 01101
1049	"DATA",900 2313.91,27 ,20,1,0)
1050	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
1051	"DATA",900 2313.91,27 ,25,0)
1052	^9002313.9 104^1^1^30 40913^^^^
1053	"DATA",900 2313.91,27 ,25,1,0)
1054	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
1055	"DATA",900 2313.91,27 ,30,0)
1056	^9002313.9 103^1^1^30 40913^^^^
1057	"DATA",900 2313.91,27 ,30,1,0)
1058	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,14)= BPS("X")
1059	"DATA",900 2313.91,28 ,0)
1060	415^^NUMBE R OF REFIL LS AUTHORI ZED^N^^^^2 ^N
1061	"DATA",900 2313.91,28 ,5)
1062	DF^2
1063	"DATA",900 2313.91,28 ,10,0)
1064	^9002313.9 101^1^1^30 30718
1065	"DATA",900 2313.91,28 ,10,1,0)
1066	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"# Refill s"))
1067	"DATA",900 2313.91,28 ,20,0)
1068	^9002313.9 102^1^1^31 01101
1069	"DATA",900 2313.91,28 ,20,1,0)
1070	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
1071	"DATA",900 2313.91,28 ,25,0)
1072	^9002313.9 104^1^1^30 30718^^
1073	"DATA",900 2313.91,28 ,25,1,0)
1074	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
1075	"DATA",900 2313.91,28 ,30,0)
1076	^9002313.9 103^1^1^30 30718^^^^
1077	"DATA",900 2313.91,28 ,30,1,0)
1078	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,15)= BPS("X")
1079	"DATA",900 2313.91,29 ,0)
1080	419^^PRESC RIPTION OR IGIN CODE^ N^^^^1^N
1081	"DATA",900 2313.91,29 ,5)
1082	DJ^1
1083	"DATA",900 2313.91,29 ,10,0)
1084	^9002313.9 101^2^2^30 30721
1085	"DATA",900 2313.91,29 ,10,1,0)
1086	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Origin C ode"))
1087	"DATA",900 2313.91,29 ,10,2,0)
1088	S:BPS("X") ="" BPS("X ")="0"
1089	"DATA",900 2313.91,29 ,20,0)
1090	^9002313.9 102^1^1^31 01101
1091	"DATA",900 2313.91,29 ,20,1,0)
1092	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
1093	"DATA",900 2313.91,29 ,25,0)
1094	^9002313.9 104^1^1^30 30721^^^^
1095	"DATA",900 2313.91,29 ,25,1,0)
1096	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
1097	"DATA",900 2313.91,29 ,30,0)
1098	^9002313.9 103^1^1^30 30721^^^^
1099	"DATA",900 2313.91,29 ,30,1,0)
1100	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,19)= BPS("X")
1101	"DATA",900 2313.91,30 ,0)
1102	420^^SUBMI SSION CLAR IFICATION CODE^N^^^^ 2^N
1103	"DATA",900 2313.91,30 ,5)
1104	DK^2
1105	"DATA",900 2313.91,30 ,10,0)
1106	^9002313.9 101^1^1^31 01006^^^^
1107	"DATA",900 2313.91,30 ,10,1,0)
1108	; GET CODE handled b y FLD420^B PSOSSG
1109	"DATA",900 2313.91,30 ,20,0)
1110	^9002313.9 102^1^1^31 01006^^^^
1111	"DATA",900 2313.91,30 ,20,1,0)
1112	; vD.0 FOR MAT CODE h andled by FLD420^BPS OSSG
1113	"DATA",900 2313.91,30 ,25,0)
1114	^9002313.9 104^1^1^31 01006^^^^
1115	"DATA",900 2313.91,30 ,25,1,0)
1116	; FORMAT C ODE handle d by FLD42 0^BPSOSSG
1117	"DATA",900 2313.91,30 ,30,0)
1118	^9002313.9 103^1^1^31 01006^^^^
1119	"DATA",900 2313.91,30 ,30,1,0)
1120	D FLD420^B PSOSSG
1121	"DATA",900 2313.91,31 ,0)
1122	453^^ORIG PRESCR PRO D/SERV ID QUAL^N^^^^ 2^A/N
1123	"DATA",900 2313.91,31 ,1)
1124	ORIGINALLY PRESCRIBE D PRODUCT/ SERVICE ID QUALIFIER
1125	"DATA",900 2313.91,31 ,5)
1126	EJ^2
1127	"DATA",900 2313.91,31 ,10,0)
1128	^9002313.9 101^1^1^30 40907
1129	"DATA",900 2313.91,31 ,10,1,0)
1130	S BPS("X") =""
1131	"DATA",900 2313.91,31 ,20,0)
1132	^9002313.9 102^1^1^31 01101
1133	"DATA",900 2313.91,31 ,20,1,0)
1134	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1135	"DATA",900 2313.91,31 ,25,0)
1136	^9002313.9 104^1^1^30 40907^^^^
1137	"DATA",900 2313.91,31 ,25,1,0)
1138	S BPS("X") =$$NFF^BPS ECFM(BPS(" X"),2)
1139	"DATA",900 2313.91,31 ,30,0)
1140	^9002313.9 103^1^1^30 40907^^^
1141	"DATA",900 2313.91,31 ,30,1,0)
1142	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 50),U,3)=" "
1143	"DATA",900 2313.91,32 ,0)
1144	B88^^QUAN LIMIT PER SPC TIME P ERIOD^^^^^ 10^N
1145	"DATA",900 2313.91,32 ,1)
1146	QUANTITY L IMIT PER S PECIFIC TI ME PERIOD
1147	"DATA",900 2313.91,32 ,5)
1148	3R^^2088
1149	"DATA",900 2313.91,32 ,10,0)
1150	^^1^1^3150 915^
1151	"DATA",900 2313.91,32 ,10,1,0)
1152	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
1153	"DATA",900 2313.91,33 ,0)
1154	423^^BASIS OF COST D ETERMINATI ON^A/N^^^^ 2^A/N
1155	"DATA",900 2313.91,33 ,5)
1156	DN^2
1157	"DATA",900 2313.91,33 ,10,0)
1158	^9002313.9 101^1^1^30 30916
1159	"DATA",900 2313.91,33 ,10,1,0)
1160	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Basis of Cost Dete rmination" ))
1161	"DATA",900 2313.91,33 ,20,0)
1162	^9002313.9 102^1^1^31 01101
1163	"DATA",900 2313.91,33 ,20,1,0)
1164	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1165	"DATA",900 2313.91,33 ,25,0)
1166	^9002313.9 104^1^1^30 61121^
1167	"DATA",900 2313.91,33 ,25,1,0)
1168	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1169	"DATA",900 2313.91,33 ,30,0)
1170	^9002313.9 103^1^1^30 30916^^^^
1171	"DATA",900 2313.91,33 ,30,1,0)
1172	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,23)= BPS("X")
1173	"DATA",900 2313.91,34 ,0)
1174	424^^DIAGN OSIS CODE^ A/N^^^^15^ A/N
1175	"DATA",900 2313.91,34 ,5)
1176	DO^15
1177	"DATA",900 2313.91,34 ,10,0)
1178	^9002313.9 101^1^1^30 30718
1179	"DATA",900 2313.91,34 ,10,1,0)
1180	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Diagnosi s Code"))
1181	"DATA",900 2313.91,34 ,20,0)
1182	^9002313.9 102^1^1^31 01101
1183	"DATA",900 2313.91,34 ,20,1,0)
1184	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
1185	"DATA",900 2313.91,34 ,25,0)
1186	^9002313.9 104^1^1^30 61122^
1187	"DATA",900 2313.91,34 ,25,1,0)
1188	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
1189	"DATA",900 2313.91,34 ,30,0)
1190	^9002313.9 103^1^1^30 30718^^
1191	"DATA",900 2313.91,34 ,30,1,0)
1192	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,24)= BPS("X")
1193	"DATA",900 2313.91,35 ,0)
1194	430^^GROSS AMOUNT DU E^D^^^^8^D
1195	"DATA",900 2313.91,35 ,5)
1196	DU^8
1197	"DATA",900 2313.91,35 ,10,0)
1198	^9002313.9 101^1^1^30 30722
1199	"DATA",900 2313.91,35 ,10,1,0)
1200	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Gross Am ount Due") )
1201	"DATA",900 2313.91,35 ,20,0)
1202	^9002313.9 102^1^1^31 01101
1203	"DATA",900 2313.91,35 ,20,1,0)
1204	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1205	"DATA",900 2313.91,35 ,25,0)
1206	^9002313.9 104^1^1^30 61122^
1207	"DATA",900 2313.91,35 ,25,1,0)
1208	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1209	"DATA",900 2313.91,35 ,30,0)
1210	^9002313.9 103^1^1^30 30722^^^^
1211	"DATA",900 2313.91,35 ,30,1,0)
1212	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,30)= BPS("X")
1213	"DATA",900 2313.91,36 ,0)
1214	433^^PATIE NT PAID AM OUNT SUBMI TTED^D^^^^ 8^D
1215	"DATA",900 2313.91,36 ,1)
1216	PATIENT PA ID AMOUNT SUBMITTED
1217	"DATA",900 2313.91,36 ,5)
1218	DX^8
1219	"DATA",900 2313.91,36 ,10,0)
1220	^^2^2^3110 727^
1221	"DATA",900 2313.91,36 ,10,1,0)
1222	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Patient Paid Amoun t"))
1223	"DATA",900 2313.91,36 ,10,2,0)
1224	S:BPS("X") ="" BPS("X ")="0.00"
1225	"DATA",900 2313.91,36 ,20,0)
1226	^9002313.9 102^1^1^31 01101
1227	"DATA",900 2313.91,36 ,20,1,0)
1228	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1229	"DATA",900 2313.91,36 ,25,0)
1230	^9002313.9 104^1^1^30 61122^
1231	"DATA",900 2313.91,36 ,25,1,0)
1232	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1233	"DATA",900 2313.91,36 ,30,0)
1234	^9002313.9 103^1^1^30 30916^^
1235	"DATA",900 2313.91,36 ,30,1,0)
1236	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 30),U,3)=B PS("X")
1237	"DATA",900 2313.91,37 ,0)
1238	439^^REASO N FOR SERV ICE CODE^A /N^^^^2^A/ N
1239	"DATA",900 2313.91,37 ,5)
1240	E4^2
1241	"DATA",900 2313.91,37 ,10,0)
1242	^9002313.9 101^1^1^30 31230
1243	"DATA",900 2313.91,37 ,10,1,0)
1244	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"DUR","DU R Conflict Code",439 ))
1245	"DATA",900 2313.91,37 ,20,0)
1246	^9002313.9 102^1^1^31 01101
1247	"DATA",900 2313.91,37 ,20,1,0)
1248	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1249	"DATA",900 2313.91,37 ,25,0)
1250	^9002313.9 104^1^1^30 31230^^
1251	"DATA",900 2313.91,37 ,25,1,0)
1252	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1253	"DATA",900 2313.91,37 ,30,0)
1254	^9002313.9 103^1^1^31 01115^^^^
1255	"DATA",900 2313.91,37 ,30,1,0)
1256	D FLD439^B PSOSSG
1257	"DATA",900 2313.91,38 ,0)
1258	440^^PROFE SSIONAL SE RVICE CODE ^A/N^^^^2^ A/N
1259	"DATA",900 2313.91,38 ,5)
1260	E5^2
1261	"DATA",900 2313.91,38 ,10,0)
1262	^9002313.9 101^1^1^30 31230
1263	"DATA",900 2313.91,38 ,10,1,0)
1264	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"DUR","DU R Interven tion Code" ,440))
1265	"DATA",900 2313.91,38 ,20,0)
1266	^9002313.9 102^1^1^31 01101
1267	"DATA",900 2313.91,38 ,20,1,0)
1268	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1269	"DATA",900 2313.91,38 ,25,0)
1270	^9002313.9 104^1^1^30 61122^
1271	"DATA",900 2313.91,38 ,25,1,0)
1272	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1273	"DATA",900 2313.91,38 ,30,0)
1274	^9002313.9 103^1^1^31 01115^
1275	"DATA",900 2313.91,38 ,30,1,0)
1276	D FLD440^B PSOSSG
1277	"DATA",900 2313.91,39 ,0)
1278	441^^RESUL T OF SERVI CE CODE^A/ N^^^^2^A/N
1279	"DATA",900 2313.91,39 ,5)
1280	E6^2
1281	"DATA",900 2313.91,39 ,10,0)
1282	^9002313.9 101^2^2^30 70214
1283	"DATA",900 2313.91,39 ,10,1,0)
1284	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"DUR","DU R Outcome Code",441) )
1285	"DATA",900 2313.91,39 ,10,2,0)
1286	S:BPS("X") ="" BPS("X ")="00"
1287	"DATA",900 2313.91,39 ,20,0)
1288	^9002313.9 102^1^1^31 01101
1289	"DATA",900 2313.91,39 ,20,1,0)
1290	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1291	"DATA",900 2313.91,39 ,25,0)
1292	^9002313.9 104^1^1^30 70214^^
1293	"DATA",900 2313.91,39 ,25,1,0)
1294	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1295	"DATA",900 2313.91,39 ,30,0)
1296	^9002313.9 103^1^1^31 01115^
1297	"DATA",900 2313.91,39 ,30,1,0)
1298	D FLD441^B PSOSSG
1299	"DATA",900 2313.91,40 ,0)
1300	442^^QUANT ITY DISPEN SED^N^^^^1 0^N
1301	"DATA",900 2313.91,40 ,5)
1302	E7^10
1303	"DATA",900 2313.91,40 ,10,0)
1304	^9002313.9 101^1^1^30 70620
1305	"DATA",900 2313.91,40 ,10,1,0)
1306	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Quantity "))*1000\1
1307	"DATA",900 2313.91,40 ,20,0)
1308	^9002313.9 102^1^1^31 01101
1309	"DATA",900 2313.91,40 ,20,1,0)
1310	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
1311	"DATA",900 2313.91,40 ,25,0)
1312	^9002313.9 104^1^1^30 61122^
1313	"DATA",900 2313.91,40 ,25,1,0)
1314	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
1315	"DATA",900 2313.91,40 ,30,0)
1316	^9002313.9 103^1^1^30 40109^^^^
1317	"DATA",900 2313.91,40 ,30,1,0)
1318	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 40),U,2)=B PS("X")
1319	"DATA",900 2313.91,41 ,0)
1320	B89^^QUANT ITY LIMIT TIME PERIO D^^^^^5^N
1321	"DATA",900 2313.91,41 ,1)
1322	QUANTITY L IMIT TIME PERIOD
1323	"DATA",900 2313.91,41 ,5)
1324	3S^^2089
1325	"DATA",900 2313.91,41 ,10,0)
1326	^^1^1^3150 915^
1327	"DATA",900 2313.91,41 ,10,1,0)
1328	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
1329	"DATA",900 2313.91,42 ,0)
1330	412^^DISPE NSING FEE SUBMITTED^ D^^^^8^D
1331	"DATA",900 2313.91,42 ,5)
1332	DC^8
1333	"DATA",900 2313.91,42 ,10,0)
1334	^^1^1^3121 128
1335	"DATA",900 2313.91,42 ,10,1,0)
1336	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Dispensi ng Fee"))
1337	"DATA",900 2313.91,42 ,20,0)
1338	^9002313.9 102^1^1^31 01101
1339	"DATA",900 2313.91,42 ,20,1,0)
1340	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1341	"DATA",900 2313.91,42 ,25,0)
1342	^9002313.9 104^1^1^30 61121^
1343	"DATA",900 2313.91,42 ,25,1,0)
1344	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1345	"DATA",900 2313.91,42 ,30,0)
1346	^9002313.9 103^1^1^30 40907^^^^
1347	"DATA",900 2313.91,42 ,30,1,0)
1348	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,12)= BPS("X")
1349	"DATA",900 2313.91,43 ,0)
1350	B90^^DAYS SUP LIM PE R SPC TM P D CNT^^^^^ 1^N
1351	"DATA",900 2313.91,43 ,1)
1352	DAYS SUPPL Y LIMIT PE R SPECIFIC TIME PERI OD COUNT
1353	"DATA",900 2313.91,43 ,5)
1354	3T^^2090
1355	"DATA",900 2313.91,43 ,10,0)
1356	^^1^1^3150 915^
1357	"DATA",900 2313.91,43 ,10,1,0)
1358	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
1359	"DATA",900 2313.91,44 ,0)
1360	418^^LEVEL OF SERVIC E^N^^^^2^N
1361	"DATA",900 2313.91,44 ,5)
1362	DI^2
1363	"DATA",900 2313.91,44 ,10,0)
1364	^9002313.9 101^2^2^31 01115^
1365	"DATA",900 2313.91,44 ,10,1,0)
1366	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Level of Service") )
1367	"DATA",900 2313.91,44 ,10,2,0)
1368	S:BPS("X") ="" BPS("X ")=0
1369	"DATA",900 2313.91,44 ,20,0)
1370	^9002313.9 102^1^1^31 01101
1371	"DATA",900 2313.91,44 ,20,1,0)
1372	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
1373	"DATA",900 2313.91,44 ,25,0)
1374	^9002313.9 104^1^1^30 70215^^
1375	"DATA",900 2313.91,44 ,25,1,0)
1376	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
1377	"DATA",900 2313.91,44 ,30,0)
1378	^9002313.9 103^1^1^30 70215^^^^
1379	"DATA",900 2313.91,44 ,30,1,0)
1380	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,18)= BPS("X")
1381	"DATA",900 2313.91,45 ,0)
1382	421^^PRIMA RY CARE PR OVIDER ID^ A/N^^^^15^ A/N
1383	"DATA",900 2313.91,45 ,5)
1384	DL^15
1385	"DATA",900 2313.91,45 ,10,0)
1386	^9002313.9 101^1^1^31 01115^
1387	"DATA",900 2313.91,45 ,10,1,0)
1388	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Primary Care Provi der NPI"))
1389	"DATA",900 2313.91,45 ,20,0)
1390	^9002313.9 102^1^1^31 01101
1391	"DATA",900 2313.91,45 ,20,1,0)
1392	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
1393	"DATA",900 2313.91,45 ,25,0)
1394	^9002313.9 104^1^1^30 70214^
1395	"DATA",900 2313.91,45 ,25,1,0)
1396	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
1397	"DATA",900 2313.91,45 ,30,0)
1398	^9002313.9 103^1^1^30 41015^
1399	"DATA",900 2313.91,45 ,30,1,0)
1400	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,21)= ""
1401	"DATA",900 2313.91,46 ,0)
1402	426^^USUAL AND CUSTO MARY CHARG E^D^^^^8^D
1403	"DATA",900 2313.91,46 ,5)
1404	DQ^8
1405	"DATA",900 2313.91,46 ,10,0)
1406	^9002313.9 101^1^1^30 31219
1407	"DATA",900 2313.91,46 ,10,1,0)
1408	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Usual & Customary" ))
1409	"DATA",900 2313.91,46 ,20,0)
1410	^9002313.9 102^1^1^31 01101
1411	"DATA",900 2313.91,46 ,20,1,0)
1412	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1413	"DATA",900 2313.91,46 ,25,0)
1414	^9002313.9 104^1^1^30 31219^^^^
1415	"DATA",900 2313.91,46 ,25,1,0)
1416	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1417	"DATA",900 2313.91,46 ,30,0)
1418	^9002313.9 103^1^1^30 31219^^^^
1419	"DATA",900 2313.91,46 ,30,1,0)
1420	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,26)= BPS("X")
1421	"DATA",900 2313.91,47 ,0)
1422	429^^SPECI AL PACKAGI NG INDICAT OR^N^^^^1^ N
1423	"DATA",900 2313.91,47 ,5)
1424	DT^1
1425	"DATA",900 2313.91,47 ,10,0)
1426	^9002313.9 101^2^2^31 01115^
1427	"DATA",900 2313.91,47 ,10,1,0)
1428	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Unit Dos e Indicato r"))
1429	"DATA",900 2313.91,47 ,10,2,0)
1430	S:BPS("X") ="" BPS("X ")=0
1431	"DATA",900 2313.91,47 ,20,0)
1432	^9002313.9 102^1^1^31 01101
1433	"DATA",900 2313.91,47 ,20,1,0)
1434	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
1435	"DATA",900 2313.91,47 ,25,0)
1436	^9002313.9 104^1^1^30 61122^
1437	"DATA",900 2313.91,47 ,25,1,0)
1438	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
1439	"DATA",900 2313.91,47 ,30,0)
1440	^9002313.9 103^1^1^30 30823^^^
1441	"DATA",900 2313.91,47 ,30,1,0)
1442	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,29)= BPS("X")
1443	"DATA",900 2313.91,48 ,0)
1444	431^^OTHER PAYER AMO UNT PAID^D ^^^^8^D
1445	"DATA",900 2313.91,48 ,5)
1446	DV^8
1447	"DATA",900 2313.91,48 ,10,0)
1448	^9002313.9 101^1^1^31 00916
1449	"DATA",900 2313.91,48 ,10,1,0)
1450	;GET code for this C OB field i s executed in COB^BP SOSHF
1451	"DATA",900 2313.91,48 ,20,0)
1452	^9002313.9 102^1^1^31 01101
1453	"DATA",900 2313.91,48 ,20,1,0)
1454	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1455	"DATA",900 2313.91,48 ,25,0)
1456	^9002313.9 104^1^1^31 01029^
1457	"DATA",900 2313.91,48 ,25,1,0)
1458	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1459	"DATA",900 2313.91,48 ,30,0)
1460	^9002313.9 103^1^1^31 00824
1461	"DATA",900 2313.91,48 ,30,1,0)
1462	D SET431^B PSFLD01
1463	"DATA",900 2313.91,49 ,0)
1464	438^^INCEN TIVE AMOUN T SUBMITTE D^D^^^^8^D
1465	"DATA",900 2313.91,49 ,5)
1466	E3^8
1467	"DATA",900 2313.91,49 ,10,0)
1468	^^1^1^3110 505^
1469	"DATA",900 2313.91,49 ,10,1,0)
1470	S BPS("X") =0
1471	"DATA",900 2313.91,49 ,20,0)
1472	^9002313.9 102^1^1^31 01101
1473	"DATA",900 2313.91,49 ,20,1,0)
1474	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1475	"DATA",900 2313.91,49 ,25,0)
1476	^9002313.9 104^1^1^30 61122^
1477	"DATA",900 2313.91,49 ,25,1,0)
1478	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
1479	"DATA",900 2313.91,49 ,30,0)
1480	^9002313.9 103^1^1^30 40907^
1481	"DATA",900 2313.91,49 ,30,1,0)
1482	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 30),U,8)=" "
1483	"DATA",900 2313.91,50 ,0)
1484	B91^^DAYS SUP LIM PE R SPC TM P ERIOD^^^^^ 3^N
1485	"DATA",900 2313.91,50 ,1)
1486	DAYS SUPPL Y LIMIT PE R SPECIFIC TIME PERI OD
1487	"DATA",900 2313.91,50 ,5)
1488	3W^^2091
1489	"DATA",900 2313.91,50 ,10,0)
1490	^^1^1^3150 915^
1491	"DATA",900 2313.91,50 ,10,1,0)
1492	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
1493	"DATA",900 2313.91,51 ,0)
1494	443^^OTHER PAYER DAT E^N^^^^8^N
1495	"DATA",900 2313.91,51 ,5)
1496	E8^8
1497	"DATA",900 2313.91,51 ,10,0)
1498	^9002313.9 101^1^1^31 00916
1499	"DATA",900 2313.91,51 ,10,1,0)
1500	;GET code for this C OB field i s executed in COB^BP SOSHF
1501	"DATA",900 2313.91,51 ,20,0)
1502	^9002313.9 102^1^1^31 01101
1503	"DATA",900 2313.91,51 ,20,1,0)
1504	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
1505	"DATA",900 2313.91,51 ,25,0)
1506	^9002313.9 104^1^1^30 40224^
1507	"DATA",900 2313.91,51 ,25,1,0)
1508	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
1509	"DATA",900 2313.91,51 ,30,0)
1510	^9002313.9 103^1^1^31 00824
1511	"DATA",900 2313.91,51 ,30,1,0)
1512	D SET443^B PSFLD01
1513	"DATA",900 2313.91,52 ,0)
1514	313^^CARDH OLDER LAST NAME^A/N^ ^^^15^A/N
1515	"DATA",900 2313.91,52 ,5)
1516	CD^15
1517	"DATA",900 2313.91,52 ,10,0)
1518	^^1^1^3101 216^
1519	"DATA",900 2313.91,52 ,10,1,0)
1520	S BPS("X") =$G(BPS("C ardholder" ,"Last Nam e"))
1521	"DATA",900 2313.91,52 ,20,0)
1522	^9002313.9 102^1^1^31 01101
1523	"DATA",900 2313.91,52 ,20,1,0)
1524	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
1525	"DATA",900 2313.91,52 ,25,0)
1526	^9002313.9 104^1^1^30 61121^
1527	"DATA",900 2313.91,52 ,25,1,0)
1528	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),15)
1529	"DATA",900 2313.91,52 ,30,0)
1530	^9002313.9 103^1^1^30 30823^^^^
1531	"DATA",900 2313.91,52 ,30,1,0)
1532	S $P(^BPSC (BPS(90023 13.02),300 ),U,13)=BP S("X")
1533	"DATA",900 2313.91,53 ,0)
1534	312^^CARDH OLDER FIRS T NAME^A/N ^^^^12^A/N
1535	"DATA",900 2313.91,53 ,5)
1536	CC^12
1537	"DATA",900 2313.91,53 ,10,0)
1538	^^1^1^3101 216^
1539	"DATA",900 2313.91,53 ,10,1,0)
1540	S BPS("X") =$G(BPS("C ardholder" ,"First Na me"))
1541	"DATA",900 2313.91,53 ,20,0)
1542	^9002313.9 102^1^1^31 01101
1543	"DATA",900 2313.91,53 ,20,1,0)
1544	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 2)
1545	"DATA",900 2313.91,53 ,25,0)
1546	^9002313.9 104^1^1^30 61121^
1547	"DATA",900 2313.91,53 ,25,1,0)
1548	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),12)
1549	"DATA",900 2313.91,53 ,30,0)
1550	^9002313.9 103^1^1^31 01115^^^^
1551	"DATA",900 2313.91,53 ,30,1,0)
1552	S $P(^BPSC (BPS(90023 13.02),300 ),U,12)=BP S("X")
1553	"DATA",900 2313.91,54 ,0)
1554	322^^PATIE NT STREET ADDRESS^A/ N^^^^30^A/ N
1555	"DATA",900 2313.91,54 ,5)
1556	CM^30
1557	"DATA",900 2313.91,54 ,10,0)
1558	^9002313.9 101^1^1^30 30718
1559	"DATA",900 2313.91,54 ,10,1,0)
1560	S BPS("X") =$G(BPS("P atient","S treet Addr ess"))
1561	"DATA",900 2313.91,54 ,20,0)
1562	^9002313.9 102^1^1^31 01101
1563	"DATA",900 2313.91,54 ,20,1,0)
1564	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
1565	"DATA",900 2313.91,54 ,25,0)
1566	^9002313.9 104^1^1^30 61121^
1567	"DATA",900 2313.91,54 ,25,1,0)
1568	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),30)
1569	"DATA",900 2313.91,54 ,30,0)
1570	^9002313.9 103^1^1^30 30718^^^^
1571	"DATA",900 2313.91,54 ,30,1,0)
1572	S $P(^BPSC (BPS(90023 13.02),321 ),U,2)=BPS ("X")
1573	"DATA",900 2313.91,55 ,0)
1574	323^^PATIE NT CITY AD DRESS^A/N^ ^^^20^A/N
1575	"DATA",900 2313.91,55 ,5)
1576	CN^20
1577	"DATA",900 2313.91,55 ,10,0)
1578	^9002313.9 101^1^1^30 30703
1579	"DATA",900 2313.91,55 ,10,1,0)
1580	S BPS("X") =$G(BPS("P atient","C ity"))
1581	"DATA",900 2313.91,55 ,20,0)
1582	^9002313.9 102^1^1^31 01101
1583	"DATA",900 2313.91,55 ,20,1,0)
1584	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
1585	"DATA",900 2313.91,55 ,25,0)
1586	^9002313.9 104^1^1^30 61121^
1587	"DATA",900 2313.91,55 ,25,1,0)
1588	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),20)
1589	"DATA",900 2313.91,55 ,30,0)
1590	^9002313.9 103^1^1^30 30703^^^^
1591	"DATA",900 2313.91,55 ,30,1,0)
1592	S $P(^BPSC (BPS(90023 13.02),321 ),U,3)=BPS ("X")
1593	"DATA",900 2313.91,56 ,0)
1594	324^^PATIE NT STATE/P ROVINCE AD DRESS^A/N^ ^^^2^A/N
1595	"DATA",900 2313.91,56 ,5)
1596	CO^2
1597	"DATA",900 2313.91,56 ,10,0)
1598	^9002313.9 101^1^1^30 30717
1599	"DATA",900 2313.91,56 ,10,1,0)
1600	S BPS("X") =$G(BPS("P atient","S tate"))
1601	"DATA",900 2313.91,56 ,20,0)
1602	^9002313.9 102^1^1^31 01101
1603	"DATA",900 2313.91,56 ,20,1,0)
1604	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1605	"DATA",900 2313.91,56 ,25,0)
1606	^9002313.9 104^1^1^30 61121^
1607	"DATA",900 2313.91,56 ,25,1,0)
1608	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),2)
1609	"DATA",900 2313.91,56 ,30,0)
1610	^9002313.9 103^1^1^30 30717^^^^
1611	"DATA",900 2313.91,56 ,30,1,0)
1612	S $P(^BPSC (BPS(90023 13.02),321 ),U,4)=BPS ("X")
1613	"DATA",900 2313.91,57 ,0)
1614	325^^PATIE NT ZIP/POS TAL ZONE^A /N^^^^15^A /N
1615	"DATA",900 2313.91,57 ,5)
1616	CP^15
1617	"DATA",900 2313.91,57 ,10,0)
1618	^9002313.9 101^1^1^30 30718
1619	"DATA",900 2313.91,57 ,10,1,0)
1620	S BPS("X") =$G(BPS("P atient","Z ip"))
1621	"DATA",900 2313.91,57 ,20,0)
1622	^^2^2^3121 128
1623	"DATA",900 2313.91,57 ,20,1,0)
1624	S BPS("X") =$TR($G(BP S("X")),"- /._","")
1625	"DATA",900 2313.91,57 ,20,2,0)
1626	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),15)
1627	"DATA",900 2313.91,57 ,25,0)
1628	^9002313.9 104^2^2^30 30718^^^^
1629	"DATA",900 2313.91,57 ,25,1,0)
1630	S BPS("X") =$TR(BPS(" X"),"-/._" ,"")
1631	"DATA",900 2313.91,57 ,25,2,0)
1632	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),9)
1633	"DATA",900 2313.91,57 ,30,0)
1634	^9002313.9 103^1^1^30 30718^^^^
1635	"DATA",900 2313.91,57 ,30,1,0)
1636	S $P(^BPSC (BPS(90023 13.02),321 ),U,5)=BPS ("X")
1637	"DATA",900 2313.91,58 ,0)
1638	314^^HOME PLAN^A/N^^ ^^3^A/N
1639	"DATA",900 2313.91,58 ,5)
1640	CE^3
1641	"DATA",900 2313.91,58 ,10,0)
1642	^9002313.9 101^1^1^30 30823
1643	"DATA",900 2313.91,58 ,10,1,0)
1644	S BPS("X") =$G(BPS("H ome Plan") )
1645	"DATA",900 2313.91,58 ,20,0)
1646	^9002313.9 102^1^1^31 01101
1647	"DATA",900 2313.91,58 ,20,1,0)
1648	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
1649	"DATA",900 2313.91,58 ,25,0)
1650	^9002313.9 104^1^1^30 61121^
1651	"DATA",900 2313.91,58 ,25,1,0)
1652	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),3)
1653	"DATA",900 2313.91,58 ,30,0)
1654	^9002313.9 103^1^1^30 30823^^^^
1655	"DATA",900 2313.91,58 ,30,1,0)
1656	S $P(^BPSC (BPS(90023 13.02),300 ),U,14)=BP S("X")
1657	"DATA",900 2313.91,59 ,0)
1658	315^^EMPLO YER NAME^A /N^^^^30^A /N
1659	"DATA",900 2313.91,59 ,5)
1660	CF^30
1661	"DATA",900 2313.91,59 ,10,0)
1662	^9002313.9 101^2^2^31 01115^
1663	"DATA",900 2313.91,59 ,10,1,0)
1664	D EMPL^BPS OSSG
1665	"DATA",900 2313.91,59 ,10,2,0)
1666	S BPS("X") =$G(BPS("E mployer"," Name"))
1667	"DATA",900 2313.91,59 ,20,0)
1668	^9002313.9 102^1^1^31 01101
1669	"DATA",900 2313.91,59 ,20,1,0)
1670	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
1671	"DATA",900 2313.91,59 ,25,0)
1672	^9002313.9 104^1^1^30 30718^^^
1673	"DATA",900 2313.91,59 ,25,1,0)
1674	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),30)
1675	"DATA",900 2313.91,59 ,30,0)
1676	^9002313.9 103^1^1^30 61120^
1677	"DATA",900 2313.91,59 ,30,1,0)
1678	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 10),U,5)=B PS("X")
1679	"DATA",900 2313.91,60 ,0)
1680	316^^EMPLO YER STREET ADDRESS^A /N^^^^30^A /N
1681	"DATA",900 2313.91,60 ,5)
1682	CG^30
1683	"DATA",900 2313.91,60 ,10,0)
1684	^9002313.9 101^1^1^30 30718
1685	"DATA",900 2313.91,60 ,10,1,0)
1686	S BPS("X") =$G(BPS("E mployer"," Address"))
1687	"DATA",900 2313.91,60 ,20,0)
1688	^9002313.9 102^1^1^31 01101
1689	"DATA",900 2313.91,60 ,20,1,0)
1690	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
1691	"DATA",900 2313.91,60 ,25,0)
1692	^9002313.9 104^1^1^30 30718^^^
1693	"DATA",900 2313.91,60 ,25,1,0)
1694	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),30)
1695	"DATA",900 2313.91,60 ,30,0)
1696	^9002313.9 103^1^1^30 61120^
1697	"DATA",900 2313.91,60 ,30,1,0)
1698	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 10),U,6)=B PS("X")
1699	"DATA",900 2313.91,61 ,0)
1700	317^^EMPLO YER CITY A DDRESS^A/N ^^^^20^A/N
1701	"DATA",900 2313.91,61 ,5)
1702	CH^20
1703	"DATA",900 2313.91,61 ,10,0)
1704	^9002313.9 101^1^1^31 50112^
1705	"DATA",900 2313.91,61 ,10,1,0)
1706	S BPS("X") =$G(BPS("E mployer"," City"))
1707	"DATA",900 2313.91,61 ,20,0)
1708	^9002313.9 102^1^1^31 01101
1709	"DATA",900 2313.91,61 ,20,1,0)
1710	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
1711	"DATA",900 2313.91,61 ,25,0)
1712	^9002313.9 104^1^1^30 30718^^
1713	"DATA",900 2313.91,61 ,25,1,0)
1714	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),20)
1715	"DATA",900 2313.91,61 ,30,0)
1716	^9002313.9 103^1^1^30 61120^
1717	"DATA",900 2313.91,61 ,30,1,0)
1718	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 10),U,7)=B PS("X")
1719	"DATA",900 2313.91,62 ,0)
1720	318^^EMPLO YER STATE/ PROV ADDRE SS^A/N^^^^ 2^A/N
1721	"DATA",900 2313.91,62 ,1)
1722	EMPLOYER S TATE/ PROV INCE ADDRE SS
1723	"DATA",900 2313.91,62 ,5)
1724	CI^2
1725	"DATA",900 2313.91,62 ,10,0)
1726	^9002313.9 101^1^1^30 30718
1727	"DATA",900 2313.91,62 ,10,1,0)
1728	S BPS("X") =$G(BPS("E mployer"," State"))
1729	"DATA",900 2313.91,62 ,20,0)
1730	^9002313.9 102^1^1^31 01101
1731	"DATA",900 2313.91,62 ,20,1,0)
1732	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1733	"DATA",900 2313.91,62 ,25,0)
1734	^9002313.9 104^1^1^30 61121^
1735	"DATA",900 2313.91,62 ,25,1,0)
1736	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),2)
1737	"DATA",900 2313.91,62 ,30,0)
1738	^9002313.9 103^1^1^30 61120^
1739	"DATA",900 2313.91,62 ,30,1,0)
1740	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 10),U,8)=B PS("X")
1741	"DATA",900 2313.91,63 ,0)
1742	319^^EMPLO YER ZIP/PO STAL ZONE^ A/N^^^^15^ A/N
1743	"DATA",900 2313.91,63 ,5)
1744	CJ^15
1745	"DATA",900 2313.91,63 ,10,0)
1746	^9002313.9 101^1^1^30 30718
1747	"DATA",900 2313.91,63 ,10,1,0)
1748	S BPS("X") =$G(BPS("E mployer"," Zip Code") )
1749	"DATA",900 2313.91,63 ,20,0)
1750	^9002313.9 102^1^1^31 01101
1751	"DATA",900 2313.91,63 ,20,1,0)
1752	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
1753	"DATA",900 2313.91,63 ,25,0)
1754	^9002313.9 104^1^1^30 61121^
1755	"DATA",900 2313.91,63 ,25,1,0)
1756	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),15)
1757	"DATA",900 2313.91,63 ,30,0)
1758	^9002313.9 103^1^1^30 61120^
1759	"DATA",900 2313.91,63 ,30,1,0)
1760	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 10),U,9)=B PS("X")
1761	"DATA",900 2313.91,64 ,0)
1762	327^^CARRI ER ID^A/N^ ^^^10^A/N
1763	"DATA",900 2313.91,64 ,5)
1764	CR^12
1765	"DATA",900 2313.91,64 ,10,0)
1766	^9002313.9 101^1^1^30 40224
1767	"DATA",900 2313.91,64 ,10,1,0)
1768	S BPS("X") =$G(BPS("C arrier ID #"))
1769	"DATA",900 2313.91,64 ,20,0)
1770	^9002313.9 102^1^1^31 01101
1771	"DATA",900 2313.91,64 ,20,1,0)
1772	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
1773	"DATA",900 2313.91,64 ,25,0)
1774	^9002313.9 104^1^1^30 61121^
1775	"DATA",900 2313.91,64 ,25,1,0)
1776	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),12)
1777	"DATA",900 2313.91,64 ,30,0)
1778	^9002313.9 103^1^1^30 61120^
1779	"DATA",900 2313.91,64 ,30,1,0)
1780	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 20),U,7)=B PS("X")
1781	"DATA",900 2313.91,65 ,0)
1782	B92^^DAYS SUPPLY LIM IT TIME PE RIOD^^^^^5 ^N
1783	"DATA",900 2313.91,65 ,1)
1784	DAYS SUPPL Y LIMIT TI ME PERIOD
1785	"DATA",900 2313.91,65 ,5)
1786	3X^^2092
1787	"DATA",900 2313.91,65 ,10,0)
1788	^^1^1^3150 915^
1789	"DATA",900 2313.91,65 ,10,1,0)
1790	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
1791	"DATA",900 2313.91,66 ,0)
1792	C01^^ORIG MANUFACTUR ER PRODUCT ID^A/N^^^ ^19^A/N
1793	"DATA",900 2313.91,66 ,1)
1794	ORIGINAL M ANUFACTURE R PRODUCT ID
1795	"DATA",900 2313.91,66 ,5)
1796	4N^19^2101
1797	"DATA",900 2313.91,66 ,10,0)
1798	^9002313.9 101^1^1^31 70228^^
1799	"DATA",900 2313.91,66 ,10,1,0)
1800	S BPS("X") =""
1801	"DATA",900 2313.91,66 ,20,0)
1802	^^1^1^3170 228^
1803	"DATA",900 2313.91,66 ,20,1,0)
1804	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
1805	"DATA",900 2313.91,66 ,25,0)
1806	^9002313.9 104^1^1^31 70228^^
1807	"DATA",900 2313.91,66 ,25,1,0)
1808	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
1809	"DATA",900 2313.91,66 ,30,0)
1810	^^1^1^3170 228^
1811	"DATA",900 2313.91,66 ,30,1,0)
1812	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," C0"),U,1)= BPS("X")
1813	"DATA",900 2313.91,67 ,0)
1814	427^^PRESC RIBER LAST NAME^A/N^ ^^^15^A/N
1815	"DATA",900 2313.91,67 ,5)
1816	DR^15
1817	"DATA",900 2313.91,67 ,10,0)
1818	^9002313.9 101^1^1^31 10107^^
1819	"DATA",900 2313.91,67 ,10,1,0)
1820	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er Last Na me"))
1821	"DATA",900 2313.91,67 ,20,0)
1822	^9002313.9 102^1^1^31 10107^
1823	"DATA",900 2313.91,67 ,20,1,0)
1824	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
1825	"DATA",900 2313.91,67 ,25,0)
1826	^9002313.9 104^1^1^31 10107^^
1827	"DATA",900 2313.91,67 ,25,1,0)
1828	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),15)
1829	"DATA",900 2313.91,67 ,30,0)
1830	^9002313.9 103^1^1^31 10107^^^^
1831	"DATA",900 2313.91,67 ,30,1,0)
1832	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 20),U,27)= BPS("X")
1833	"DATA",900 2313.91,68 ,0)
1834	C02^^ORIG MANUFACTUR ER PROD ID QUAL^A/N^ ^^^2^A/N
1835	"DATA",900 2313.91,68 ,1)
1836	ORIGINAL M ANUFACTURE R PRODUCT ID QUALIFI ER
1837	"DATA",900 2313.91,68 ,5)
1838	4P^2^2102
1839	"DATA",900 2313.91,68 ,10,0)
1840	^^1^1^3170 228^
1841	"DATA",900 2313.91,68 ,10,1,0)
1842	S BPS("X") =""
1843	"DATA",900 2313.91,68 ,20,0)
1844	^^1^1^3170 228^
1845	"DATA",900 2313.91,68 ,20,1,0)
1846	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1847	"DATA",900 2313.91,68 ,25,0)
1848	^^1^1^3170 228^
1849	"DATA",900 2313.91,68 ,25,1,0)
1850	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1851	"DATA",900 2313.91,68 ,30,0)
1852	^^1^1^3170 228^
1853	"DATA",900 2313.91,68 ,30,1,0)
1854	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," C0"),U,2)= BPS("X")
1855	"DATA",900 2313.91,69 ,0)
1856	434^^DATE OF INJURY^ N^^^^8^N
1857	"DATA",900 2313.91,69 ,5)
1858	DY^8
1859	"DATA",900 2313.91,69 ,10,0)
1860	^9002313.9 101^2^2^31 01115^
1861	"DATA",900 2313.91,69 ,10,1,0)
1862	S BPS("X") =$G(BPS("D ate of Inj ury"))
1863	"DATA",900 2313.91,69 ,10,2,0)
1864	S BPS("X") =$$DTF1^BP SECFM(BPS( "X"))
1865	"DATA",900 2313.91,69 ,20,0)
1866	^9002313.9 102^1^1^31 01101
1867	"DATA",900 2313.91,69 ,20,1,0)
1868	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
1869	"DATA",900 2313.91,69 ,25,0)
1870	^9002313.9 104^1^1^30 31210^^
1871	"DATA",900 2313.91,69 ,25,1,0)
1872	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
1873	"DATA",900 2313.91,69 ,30,0)
1874	^9002313.9 103^1^1^30 10125^^
1875	"DATA",900 2313.91,69 ,30,1,0)
1876	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,34)= BPS("X")
1877	"DATA",900 2313.91,70 ,0)
1878	435^^CLAIM /REFERENCE ID^A/N^^^ ^30^A/N
1879	"DATA",900 2313.91,70 ,5)
1880	DZ^30
1881	"DATA",900 2313.91,70 ,10,0)
1882	^9002313.9 101^1^1^30 30718
1883	"DATA",900 2313.91,70 ,10,1,0)
1884	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Claim/Re f ID #"))
1885	"DATA",900 2313.91,70 ,20,0)
1886	^9002313.9 102^1^1^31 01101
1887	"DATA",900 2313.91,70 ,20,1,0)
1888	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
1889	"DATA",900 2313.91,70 ,25,0)
1890	^9002313.9 104^1^1^30 61122^
1891	"DATA",900 2313.91,70 ,25,1,0)
1892	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),30)
1893	"DATA",900 2313.91,70 ,30,0)
1894	^9002313.9 103^1^1^30 30718^^^^
1895	"DATA",900 2313.91,70 ,30,1,0)
1896	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 00),U,35)= BPS("X")
1897	"DATA",900 2313.91,71 ,0)
1898	436^^PRODU CT/SERVICE ID QUALIF IER^A/N^^^ ^2^A/N
1899	"DATA",900 2313.91,71 ,5)
1900	E1^2
1901	"DATA",900 2313.91,71 ,10,0)
1902	^^1^1^3121 128
1903	"DATA",900 2313.91,71 ,10,1,0)
1904	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Product ID Qualifi er"))
1905	"DATA",900 2313.91,71 ,20,0)
1906	^9002313.9 102^1^1^31 01101
1907	"DATA",900 2313.91,71 ,20,1,0)
1908	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1909	"DATA",900 2313.91,71 ,25,0)
1910	^9002313.9 104^1^1^30 61122^
1911	"DATA",900 2313.91,71 ,25,1,0)
1912	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),2)
1913	"DATA",900 2313.91,71 ,30,0)
1914	^9002313.9 103^1^1^30 40107^^^^
1915	"DATA",900 2313.91,71 ,30,1,0)
1916	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 30),U,6)=B PS("X")
1917	"DATA",900 2313.91,72 ,0)
1918	B96^^PROVI DER FIRST NAME^A/N^^ ^^35^A/N
1919	"DATA",900 2313.91,72 ,1)
1920	PROVIDER F IRST NAME
1921	"DATA",900 2313.91,72 ,5)
1922	4A^35^2096
1923	"DATA",900 2313.91,72 ,10,0)
1924	^^1^1^3170 228^
1925	"DATA",900 2313.91,72 ,10,1,0)
1926	S BPS("X") =""
1927	"DATA",900 2313.91,72 ,20,0)
1928	^^1^1^3170 228^
1929	"DATA",900 2313.91,72 ,20,1,0)
1930	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 5)
1931	"DATA",900 2313.91,72 ,25,0)
1932	^^1^1^3170 228^
1933	"DATA",900 2313.91,72 ,25,1,0)
1934	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 5)
1935	"DATA",900 2313.91,72 ,30,0)
1936	^^1^1^3170 306^
1937	"DATA",900 2313.91,72 ,30,1,0)
1938	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B90"),U,6) =BPS("X")
1939	"DATA",900 2313.91,73 ,0)
1940	B97^^PROVI DER LAST N AME^A/N^^^ ^35^A/N
1941	"DATA",900 2313.91,73 ,1)
1942	PROVIDER L AST NAME
1943	"DATA",900 2313.91,73 ,5)
1944	4M^35^2097
1945	"DATA",900 2313.91,73 ,10,0)
1946	^^1^1^3170 228^
1947	"DATA",900 2313.91,73 ,10,1,0)
1948	S BPS("X") =""
1949	"DATA",900 2313.91,73 ,20,0)
1950	^^1^1^3170 228^
1951	"DATA",900 2313.91,73 ,20,1,0)
1952	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 5)
1953	"DATA",900 2313.91,73 ,25,0)
1954	^^1^1^3170 228^
1955	"DATA",900 2313.91,73 ,25,1,0)
1956	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 5)
1957	"DATA",900 2313.91,73 ,30,0)
1958	^^1^1^3170 306^
1959	"DATA",900 2313.91,73 ,30,1,0)
1960	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B90"),U,7) =BPS("X")
1961	"DATA",900 2313.91,74 ,0)
1962	498.51^^PR IOR AUTH P ROCESSED D ATE^A/N^^^ ^8^N
1963	"DATA",900 2313.91,74 ,5)
1964	PR^8
1965	"DATA",900 2313.91,74 ,10,0)
1966	^9002313.9 101^1^1^30 40223
1967	"DATA",900 2313.91,74 ,10,1,0)
1968	S BPS("X") =""
1969	"DATA",900 2313.91,74 ,20,0)
1970	^9002313.9 102^1^1^31 01101
1971	"DATA",900 2313.91,74 ,20,1,0)
1972	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
1973	"DATA",900 2313.91,75 ,0)
1974	202^^SERV PROVIDER I D QUALIFIE R^A/N^^^^2 ^A/N
1975	"DATA",900 2313.91,75 ,1)
1976	SERVICE PR OVIDER ID QUALIFIER
1977	"DATA",900 2313.91,75 ,5)
1978	B2^2
1979	"DATA",900 2313.91,75 ,10,0)
1980	^9002313.9 101^1^1^30 70214
1981	"DATA",900 2313.91,75 ,10,1,0)
1982	S BPS("X") ="01"
1983	"DATA",900 2313.91,75 ,20,0)
1984	^9002313.9 102^1^1^31 01101
1985	"DATA",900 2313.91,75 ,20,1,0)
1986	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1987	"DATA",900 2313.91,75 ,25,0)
1988	^9002313.9 104^1^1^30 70214^
1989	"DATA",900 2313.91,75 ,25,1,0)
1990	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
1991	"DATA",900 2313.91,75 ,30,0)
1992	^9002313.9 103^1^1^30 40114^^^^
1993	"DATA",900 2313.91,75 ,30,1,0)
1994	S $P(^BPSC (BPS(90023 13.02),200 ),U,2)=BPS ("X") ;VA
1995	"DATA",900 2313.91,76 ,0)
1996	110^^SOFTW ARE VENDOR /CERT ID^A /N^^^^10^A /N
1997	"DATA",900 2313.91,76 ,1)
1998	SOFTWARE V ENDOR/ CER TIFICATION ID
1999	"DATA",900 2313.91,76 ,5)
2000	AK^10
2001	"DATA",900 2313.91,76 ,10,0)
2002	^9002313.9 101^1^1^30 61023
2003	"DATA",900 2313.91,76 ,10,1,0)
2004	S BPS("X") =$G(BPS("N CPDP","Sof tware Vend or/Cert ID "))
2005	"DATA",900 2313.91,76 ,20,0)
2006	^9002313.9 102^1^1^31 01101
2007	"DATA",900 2313.91,76 ,20,1,0)
2008	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
2009	"DATA",900 2313.91,76 ,25,0)
2010	^9002313.9 104^1^1^30 40202^^^^
2011	"DATA",900 2313.91,76 ,25,1,0)
2012	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0) ;VA
2013	"DATA",900 2313.91,76 ,30,0)
2014	^9002313.9 103^1^1^30 61023^
2015	"DATA",900 2313.91,76 ,30,1,0)
2016	S $P(^BPSC (BPS(90023 13.02),100 ),U,10)=BP S("X")
2017	"DATA",900 2313.91,77 ,0)
2018	331^^PATIE NT ID QUAL IFIER^A/N^ ^^^2^A/N
2019	"DATA",900 2313.91,77 ,5)
2020	CX^2
2021	"DATA",900 2313.91,77 ,10,0)
2022	^9002313.9 101^1^1^30 61023
2023	"DATA",900 2313.91,77 ,10,1,0)
2024	S BPS("X") ="01"
2025	"DATA",900 2313.91,77 ,20,0)
2026	^9002313.9 102^1^1^31 01101
2027	"DATA",900 2313.91,77 ,20,1,0)
2028	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2029	"DATA",900 2313.91,77 ,25,0)
2030	^9002313.9 104^1^1^30 30718^^
2031	"DATA",900 2313.91,77 ,25,1,0)
2032	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2033	"DATA",900 2313.91,77 ,30,0)
2034	^9002313.9 103^1^1^30 30718^^^^
2035	"DATA",900 2313.91,77 ,30,1,0)
2036	S $P(^BPSC (BPS(90023 13.02),330 ),U,1)=BPS ("X") ;VA
2037	"DATA",900 2313.91,78 ,0)
2038	332^^PATIE NT ID^A/N^ ^^^20^A/N
2039	"DATA",900 2313.91,78 ,5)
2040	CY^20
2041	"DATA",900 2313.91,78 ,10,0)
2042	^9002313.9 101^1^1^30 61023
2043	"DATA",900 2313.91,78 ,10,1,0)
2044	S BPS("X") =$G(BPS("P atient","S SN"))
2045	"DATA",900 2313.91,78 ,20,0)
2046	^9002313.9 102^1^1^31 01101
2047	"DATA",900 2313.91,78 ,20,1,0)
2048	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
2049	"DATA",900 2313.91,78 ,25,0)
2050	^9002313.9 104^1^1^30 61121^
2051	"DATA",900 2313.91,78 ,25,1,0)
2052	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
2053	"DATA",900 2313.91,78 ,30,0)
2054	^9002313.9 103^1^1^30 40820^^^^
2055	"DATA",900 2313.91,78 ,30,1,0)
2056	S $P(^BPSC (BPS(90023 13.02),330 ),U,2)=BPS ("X") ;VA
2057	"DATA",900 2313.91,79 ,0)
2058	326^^PATIE NT TELEPHO NE NUMBER^ N^^^^10^N
2059	"DATA",900 2313.91,79 ,5)
2060	CQ^10
2061	"DATA",900 2313.91,79 ,10,0)
2062	^9002313.9 101^1^1^31 01115^
2063	"DATA",900 2313.91,79 ,10,1,0)
2064	S BPS("X") =$TR($G(BP S("Patient ","Phone # ")),"#() - _*.@")
2065	"DATA",900 2313.91,79 ,20,0)
2066	^9002313.9 102^1^1^31 01101
2067	"DATA",900 2313.91,79 ,20,1,0)
2068	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2069	"DATA",900 2313.91,79 ,25,0)
2070	^9002313.9 104^1^1^31 01115^
2071	"DATA",900 2313.91,79 ,25,1,0)
2072	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2073	"DATA",900 2313.91,79 ,30,0)
2074	^9002313.9 103^1^1^31 01115^
2075	"DATA",900 2313.91,79 ,30,1,0)
2076	S $P(^BPSC (BPS(90023 13.02),321 ),U,6)=BPS ("X")
2077	"DATA",900 2313.91,80 ,0)
2078	455^^PRESC RIPTION/SE RV REF NO QLFR^A/N^^ ^^1^A/N
2079	"DATA",900 2313.91,80 ,1)
2080	PRESCRIPTI ON/ SERVIC E REFERENC E NUMBER Q UALIFIER
2081	"DATA",900 2313.91,80 ,5)
2082	EM^1
2083	"DATA",900 2313.91,80 ,10,0)
2084	^9002313.9 101^1^1^31 01008^
2085	"DATA",900 2313.91,80 ,10,1,0)
2086	S BPS("X") =1
2087	"DATA",900 2313.91,80 ,20,0)
2088	^9002313.9 102^1^1^31 01007^^
2089	"DATA",900 2313.91,80 ,20,1,0)
2090	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
2091	"DATA",900 2313.91,80 ,25,0)
2092	^9002313.9 104^1^1^31 01007^^^
2093	"DATA",900 2313.91,80 ,25,1,0)
2094	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
2095	"DATA",900 2313.91,80 ,30,0)
2096	^9002313.9 103^1^1^31 01007^^^^
2097	"DATA",900 2313.91,80 ,30,1,0)
2098	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 50),U,5)=B PS("X")
2099	"DATA",900 2313.91,81 ,0)
2100	460^^QUANT ITY PRESCR IBED^N^^^^ 10^N
2101	"DATA",900 2313.91,81 ,5)
2102	ET^10
2103	"DATA",900 2313.91,81 ,10,0)
2104	^9002313.9 101^1^1^31 01115^
2105	"DATA",900 2313.91,81 ,10,1,0)
2106	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Quantity "))*1000\1
2107	"DATA",900 2313.91,81 ,20,0)
2108	^9002313.9 102^1^1^31 01101
2109	"DATA",900 2313.91,81 ,20,1,0)
2110	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2111	"DATA",900 2313.91,81 ,25,0)
2112	^9002313.9 104^1^1^30 30827^^^^
2113	"DATA",900 2313.91,81 ,25,1,0)
2114	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2115	"DATA",900 2313.91,81 ,30,0)
2116	^9002313.9 103^1^1^31 01115^
2117	"DATA",900 2313.91,81 ,30,1,0)
2118	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 50),U,10)= BPS("X")
2119	"DATA",900 2313.91,82 ,0)
2120	465^^PROVI DER ID QUA LIFIER^A/N ^^^^2^A/N
2121	"DATA",900 2313.91,82 ,5)
2122	EY^2
2123	"DATA",900 2313.91,82 ,10,0)
2124	^9002313.9 101^1^1^30 70214
2125	"DATA",900 2313.91,82 ,10,1,0)
2126	S BPS("X") ="05"
2127	"DATA",900 2313.91,82 ,20,0)
2128	^9002313.9 102^1^1^31 01101
2129	"DATA",900 2313.91,82 ,20,1,0)
2130	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2131	"DATA",900 2313.91,82 ,25,0)
2132	^9002313.9 104^1^1^30 70214^
2133	"DATA",900 2313.91,82 ,25,1,0)
2134	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2135	"DATA",900 2313.91,82 ,30,0)
2136	^9002313.9 103^1^1^30 41015^
2137	"DATA",900 2313.91,82 ,30,1,0)
2138	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,5)=" "
2139	"DATA",900 2313.91,83 ,0)
2140	444^^PROVI DER ID^A/N ^^^^15^A/N
2141	"DATA",900 2313.91,83 ,5)
2142	E9^15
2143	"DATA",900 2313.91,83 ,10,0)
2144	^9002313.9 101^1^1^30 70214
2145	"DATA",900 2313.91,83 ,10,1,0)
2146	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Provider NPI"))
2147	"DATA",900 2313.91,83 ,20,0)
2148	^9002313.9 102^1^1^31 01101
2149	"DATA",900 2313.91,83 ,20,1,0)
2150	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
2151	"DATA",900 2313.91,83 ,25,0)
2152	^9002313.9 104^1^1^30 70214^
2153	"DATA",900 2313.91,83 ,25,1,0)
2154	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
2155	"DATA",900 2313.91,83 ,30,0)
2156	^9002313.9 103^1^1^30 41015^
2157	"DATA",900 2313.91,83 ,30,1,0)
2158	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 40),U,4)=" "
2159	"DATA",900 2313.91,84 ,0)
2160	466^^PRESC RIBER ID Q UALIFIER^A /N^^^^2^A/ N
2161	"DATA",900 2313.91,84 ,5)
2162	EZ^2
2163	"DATA",900 2313.91,84 ,10,0)
2164	^^2^2^3101 216^
2165	"DATA",900 2313.91,84 ,10,1,0)
2166	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er ID Qual ifier"))
2167	"DATA",900 2313.91,84 ,10,2,0)
2168	S:BPS("X") ="" BPS("X ")="01"
2169	"DATA",900 2313.91,84 ,20,0)
2170	^9002313.9 102^1^1^31 01101
2171	"DATA",900 2313.91,84 ,20,1,0)
2172	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2173	"DATA",900 2313.91,84 ,25,0)
2174	^9002313.9 104^1^1^30 70214^^^^
2175	"DATA",900 2313.91,84 ,25,1,0)
2176	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
2177	"DATA",900 2313.91,84 ,30,0)
2178	^9002313.9 103^1^1^30 30823^^^^
2179	"DATA",900 2313.91,84 ,30,1,0)
2180	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,6)=B PS("X")
2181	"DATA",900 2313.91,85 ,0)
2182	467^^PRESC RIBER LOCA TION CODE^ A/N^^^^3^A /N
2183	"DATA",900 2313.91,85 ,5)
2184	1E^3
2185	"DATA",900 2313.91,85 ,10,0)
2186	^9002313.9 101^1^1^30 30721
2187	"DATA",900 2313.91,85 ,10,1,0)
2188	S BPS("X") =$G(BPS("R X",1,"Pres criber Bil ling Locat ion"))
2189	"DATA",900 2313.91,85 ,20,0)
2190	^9002313.9 102^1^1^31 01101
2191	"DATA",900 2313.91,85 ,20,1,0)
2192	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
2193	"DATA",900 2313.91,85 ,25,0)
2194	^9002313.9 104^1^1^30 61122^
2195	"DATA",900 2313.91,85 ,25,1,0)
2196	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
2197	"DATA",900 2313.91,85 ,30,0)
2198	^9002313.9 103^1^1^30 30721^^^^
2199	"DATA",900 2313.91,85 ,30,1,0)
2200	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,7)=B PS("X")
2201	"DATA",900 2313.91,86 ,0)
2202	498^^PRESC RIBER TELE PHONE NUMB ER^N^^^^10 ^N
2203	"DATA",900 2313.91,86 ,5)
2204	PM^10
2205	"DATA",900 2313.91,86 ,10,0)
2206	^9002313.9 101^1^1^31 01029^
2207	"DATA",900 2313.91,86 ,10,1,0)
2208	S BPS("X") =$TR($G(BP S("RX",BPS (9002313.0 201),"Pres criber Pho ne #")),"# () -_*.@")
2209	"DATA",900 2313.91,86 ,20,0)
2210	^9002313.9 102^1^1^31 01101
2211	"DATA",900 2313.91,86 ,20,1,0)
2212	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2213	"DATA",900 2313.91,86 ,25,0)
2214	^9002313.9 104^1^1^30 61122^
2215	"DATA",900 2313.91,86 ,25,1,0)
2216	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2217	"DATA",900 2313.91,86 ,30,0)
2218	^9002313.9 103^1^1^31 00917^^^^
2219	"DATA",900 2313.91,86 ,30,1,0)
2220	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 98),U,12)= BPS("X")
2221	"DATA",900 2313.91,87 ,0)
2222	468^^PRIMA RY CARE PR OVIDER ID QLFR^A/N^^ ^^2^A/N
2223	"DATA",900 2313.91,87 ,1)
2224	PRIMARY CA RE PROVIDE R ID QUALI FIER
2225	"DATA",900 2313.91,87 ,5)
2226	2E^2
2227	"DATA",900 2313.91,87 ,10,0)
2228	^^2^2^3110 727^
2229	"DATA",900 2313.91,87 ,10,1,0)
2230	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Primary Care Prov ID Qual"))
2231	"DATA",900 2313.91,87 ,10,2,0)
2232	S:BPS("X") ="" BPS("X ")="01"
2233	"DATA",900 2313.91,87 ,20,0)
2234	^9002313.9 102^1^1^31 01101
2235	"DATA",900 2313.91,87 ,20,1,0)
2236	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2237	"DATA",900 2313.91,87 ,25,0)
2238	^9002313.9 104^1^1^30 70214^^^^
2239	"DATA",900 2313.91,87 ,25,1,0)
2240	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
2241	"DATA",900 2313.91,87 ,30,0)
2242	^9002313.9 103^1^1^30 41015^
2243	"DATA",900 2313.91,87 ,30,1,0)
2244	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,8)=" "
2245	"DATA",900 2313.91,88 ,0)
2246	469^^PRIM CARE PROV LOCATION C ODE^N^^^^3 ^A/N
2247	"DATA",900 2313.91,88 ,5)
2248	H5^3
2249	"DATA",900 2313.91,88 ,10,0)
2250	^9002313.9 101^1^1^30 40114
2251	"DATA",900 2313.91,88 ,10,1,0)
2252	S BPS("X") =$G(BPS("P atient","P rimary Car e Prov Loc ation Code "))
2253	"DATA",900 2313.91,88 ,20,0)
2254	^9002313.9 102^1^1^31 01101
2255	"DATA",900 2313.91,88 ,20,1,0)
2256	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
2257	"DATA",900 2313.91,88 ,25,0)
2258	^9002313.9 104^1^1^30 40114^^^^
2259	"DATA",900 2313.91,88 ,25,1,0)
2260	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),3)
2261	"DATA",900 2313.91,88 ,30,0)
2262	^9002313.9 103^1^1^30 40114^^^^
2263	"DATA",900 2313.91,88 ,30,1,0)
2264	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,9)=B PS("X")
2265	"DATA",900 2313.91,89 ,0)
2266	470^^PRIM CARE PROVI DER LAST N AME^A/N^^^ ^15^A/N
2267	"DATA",900 2313.91,89 ,1)
2268	PRIMARY CA RE PROVIDE R LAST NAM E
2269	"DATA",900 2313.91,89 ,5)
2270	4E^15
2271	"DATA",900 2313.91,89 ,10,0)
2272	^^1^1^3101 217^
2273	"DATA",900 2313.91,89 ,10,1,0)
2274	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Primary Care Prov Last Name" ))
2275	"DATA",900 2313.91,89 ,20,0)
2276	^9002313.9 102^1^1^31 01101
2277	"DATA",900 2313.91,89 ,20,1,0)
2278	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
2279	"DATA",900 2313.91,89 ,25,0)
2280	^9002313.9 104^1^1^30 61122^
2281	"DATA",900 2313.91,89 ,25,1,0)
2282	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),15)
2283	"DATA",900 2313.91,89 ,30,0)
2284	^9002313.9 103^1^1^30 30825^^^^
2285	"DATA",900 2313.91,89 ,30,1,0)
2286	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,10)= BPS("X")
2287	"DATA",900 2313.91,90 ,0)
2288	B95^^FACIL ITY ID QUA LIFIER^A/N ^^^^2^A/N
2289	"DATA",900 2313.91,90 ,1)
2290	FACILITY I D QUALIFIE R
2291	"DATA",900 2313.91,90 ,5)
2292	3Z^2^2095
2293	"DATA",900 2313.91,90 ,10,0)
2294	^^2^2^3170 626^
2295	"DATA",900 2313.91,90 ,10,1,0)
2296	S BPS("X") =$G(BPS("I nsurer","F acility ID "))
2297	"DATA",900 2313.91,90 ,10,2,0)
2298	S BPS("X") =$S(BPS("X ")'="":1,1 :"")
2299	"DATA",900 2313.91,90 ,20,0)
2300	^9002313.9 102^1^1^31 70530^^^
2301	"DATA",900 2313.91,90 ,20,1,0)
2302	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2303	"DATA",900 2313.91,90 ,25,0)
2304	^9002313.9 104^1^1^31 70530^^^
2305	"DATA",900 2313.91,90 ,25,1,0)
2306	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2307	"DATA",900 2313.91,90 ,30,0)
2308	^9002313.9 103^1^1^31 70626^^^^
2309	"DATA",900 2313.91,90 ,30,1,0)
2310	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B90"),U,1) =BPS("X")
2311	"DATA",900 2313.91,91 ,0)
2312	480^^OTHER AMT CLAIM ED SUBMITT ED^D^^^^8^ D
2313	"DATA",900 2313.91,91 ,1)
2314	OTHER AMOU NT CLAIMED SUBMITTED
2315	"DATA",900 2313.91,91 ,5)
2316	H9^8
2317	"DATA",900 2313.91,91 ,10,0)
2318	^9002313.9 101^1^1^31 01006^^^^
2319	"DATA",900 2313.91,91 ,10,1,0)
2320	; GET CODE handled b y FLD480^B PSOSSG
2321	"DATA",900 2313.91,91 ,20,0)
2322	^9002313.9 102^1^1^31 01006^^^^
2323	"DATA",900 2313.91,91 ,20,1,0)
2324	; vD.0 for mat code h andled by FLD480^BPS OSSG
2325	"DATA",900 2313.91,91 ,25,0)
2326	^9002313.9 104^1^1^31 01006^^^^
2327	"DATA",900 2313.91,91 ,25,1,0)
2328	; format c ode handle d by FLD48 0^BPSOSSG
2329	"DATA",900 2313.91,91 ,30,0)
2330	^9002313.9 103^1^1^31 01006^^^^
2331	"DATA",900 2313.91,91 ,30,1,0)
2332	D FLD480^B PSOSSG
2333	"DATA",900 2313.91,92 ,0)
2334	109^^TRANS ACTION COU NT^A/N^^^^ 1^A/N
2335	"DATA",900 2313.91,92 ,5)
2336	A9^1
2337	"DATA",900 2313.91,92 ,10,0)
2338	^9002313.9 101^1^1^31 01115^
2339	"DATA",900 2313.91,92 ,10,1,0)
2340	S BPS("X") =$G(BPS("T ransaction Count"))
2341	"DATA",900 2313.91,92 ,20,0)
2342	^9002313.9 102^1^1^31 01101
2343	"DATA",900 2313.91,92 ,20,1,0)
2344	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
2345	"DATA",900 2313.91,92 ,25,0)
2346	^9002313.9 104^1^1^30 40114^^^^
2347	"DATA",900 2313.91,92 ,25,1,0)
2348	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
2349	"DATA",900 2313.91,92 ,30,0)
2350	^9002313.9 103^1^1^30 40114^^^
2351	"DATA",900 2313.91,92 ,30,1,0)
2352	S $P(^BPSC (BPS(90023 13.02),100 ),U,9)=BPS ("X")
2353	"DATA",900 2313.91,93 ,0)
2354	111^^SEGME NT IDENTIF ICATION^A/ N^^^^2^A/N
2355	"DATA",900 2313.91,93 ,5)
2356	AM^2
2357	"DATA",900 2313.91,93 ,10,0)
2358	^9002313.9 101^1^1^30 40114
2359	"DATA",900 2313.91,93 ,10,1,0)
2360	S BPS("X") =""
2361	"DATA",900 2313.91,93 ,20,0)
2362	^9002313.9 102^1^1^31 01101
2363	"DATA",900 2313.91,93 ,20,1,0)
2364	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2365	"DATA",900 2313.91,94 ,0)
2366	B98^^RECON CILIATION ID^A/N^^^^ 30^A/N
2367	"DATA",900 2313.91,94 ,1)
2368	RECONCILIA TION ID
2369	"DATA",900 2313.91,94 ,5)
2370	34^30^2098
2371	"DATA",900 2313.91,94 ,10,0)
2372	^^2^2^3170 626^
2373	"DATA",900 2313.91,94 ,10,1,0)
2374	; THIS IS A RESPONSE -ONLY FIEL D WHICH DO ES NOT USE THE GET, FORMAT, OR
2375	"DATA",900 2313.91,94 ,10,2,0)
2376	; SET CODE
2377	"DATA",900 2313.91,95 ,0)
2378	112^^TRANS ACTION RES PONSE STAT US^A/N^^^^ 1^A/N
2379	"DATA",900 2313.91,95 ,5)
2380	AN^2
2381	"DATA",900 2313.91,95 ,10,0)
2382	^9002313.9 101^1^1^31 01115^^
2383	"DATA",900 2313.91,95 ,10,1,0)
2384	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
2385	"DATA",900 2313.91,95 ,25,0)
2386	^9002313.9 104^1^1^30 40114^^
2387	"DATA",900 2313.91,95 ,25,1,0)
2388	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
2389	"DATA",900 2313.91,95 ,30,0)
2390	^9002313.9 103^1^1^30 40114^^
2391	"DATA",900 2313.91,95 ,30,1,0)
2392	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 110),U,2)= BPS("X")
2393	"DATA",900 2313.91,96 ,0)
2394	320^^EMPLO YER TELEPH ONE NUMBER ^N^^^^10^N
2395	"DATA",900 2313.91,96 ,5)
2396	CK^10
2397	"DATA",900 2313.91,96 ,10,0)
2398	^9002313.9 101^1^1^30 50802
2399	"DATA",900 2313.91,96 ,10,1,0)
2400	S BPS("X") =$TR($G(BP S("Employe r","Phone" )),"#() -_ *.@")
2401	"DATA",900 2313.91,96 ,20,0)
2402	^9002313.9 102^1^1^31 01101
2403	"DATA",900 2313.91,96 ,20,1,0)
2404	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2405	"DATA",900 2313.91,96 ,25,0)
2406	^9002313.9 104^1^1^30 61121^
2407	"DATA",900 2313.91,96 ,25,1,0)
2408	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),10)
2409	"DATA",900 2313.91,96 ,30,0)
2410	^9002313.9 103^1^1^30 61120^
2411	"DATA",900 2313.91,96 ,30,1,0)
2412	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 10),U,10)= BPS("X")
2413	"DATA",900 2313.91,97 ,0)
2414	321^^EMPLO YER CONTAC T NAME^A/N ^^^^30^A/N
2415	"DATA",900 2313.91,97 ,5)
2416	CL^30
2417	"DATA",900 2313.91,97 ,10,0)
2418	^9002313.9 101^1^1^30 40224
2419	"DATA",900 2313.91,97 ,10,1,0)
2420	S BPS("X") =""
2421	"DATA",900 2313.91,97 ,20,0)
2422	^9002313.9 102^1^1^31 01101
2423	"DATA",900 2313.91,97 ,20,1,0)
2424	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
2425	"DATA",900 2313.91,97 ,25,0)
2426	^9002313.9 104^1^1^30 40224^^^
2427	"DATA",900 2313.91,97 ,25,1,0)
2428	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),30)
2429	"DATA",900 2313.91,97 ,30,0)
2430	^9002313.9 103^1^1^30 40224^
2431	"DATA",900 2313.91,97 ,30,1,0)
2432	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 20),U,1)=B PS("X")
2433	"DATA",900 2313.91,98 ,0)
2434	330^^ALTER NATE ID^A/ N^^^^20^A/ N
2435	"DATA",900 2313.91,98 ,5)
2436	CW^20
2437	"DATA",900 2313.91,98 ,10,0)
2438	^9002313.9 101^1^1^30 40224
2439	"DATA",900 2313.91,98 ,10,1,0)
2440	S BPS("X") =""
2441	"DATA",900 2313.91,98 ,20,0)
2442	^9002313.9 102^1^1^31 01101
2443	"DATA",900 2313.91,98 ,20,1,0)
2444	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
2445	"DATA",900 2313.91,98 ,25,0)
2446	^9002313.9 104^1^1^30 40224^^^
2447	"DATA",900 2313.91,98 ,25,1,0)
2448	S BPS("X") =$$NFF^BPS ECFM(BPS(" X"),20)
2449	"DATA",900 2313.91,98 ,30,0)
2450	^9002313.9 103^1^1^30 40224^^
2451	"DATA",900 2313.91,98 ,30,1,0)
2452	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 20),U,10)= BPS("X")
2453	"DATA",900 2313.91,99 ,0)
2454	333^^EMPLO YER ID^A/N ^^^^15^A/N
2455	"DATA",900 2313.91,99 ,5)
2456	CZ^15
2457	"DATA",900 2313.91,99 ,10,0)
2458	^9002313.9 101^1^1^30 30823
2459	"DATA",900 2313.91,99 ,10,1,0)
2460	S BPS("X") =""
2461	"DATA",900 2313.91,99 ,20,0)
2462	^9002313.9 102^1^1^31 01101
2463	"DATA",900 2313.91,99 ,20,1,0)
2464	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
2465	"DATA",900 2313.91,99 ,25,0)
2466	^9002313.9 104^1^1^30 30823^
2467	"DATA",900 2313.91,99 ,25,1,0)
2468	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
2469	"DATA",900 2313.91,99 ,30,0)
2470	^9002313.9 103^1^1^30 30823^^^^
2471	"DATA",900 2313.91,99 ,30,1,0)
2472	S $P(^BPSC (BPS(90023 13.02),330 ),U,3)=BPS ("X")
2473	"DATA",900 2313.91,10 0,0)
2474	334^^SMOKE R/NONSMOKE R^N^^^^1^A /N
2475	"DATA",900 2313.91,10 0,5)
2476	1C^1
2477	"DATA",900 2313.91,10 0,10,0)
2478	^9002313.9 101^1^1^30 70620
2479	"DATA",900 2313.91,10 0,10,1,0)
2480	S BPS("X") =""
2481	"DATA",900 2313.91,10 0,20,0)
2482	^9002313.9 102^1^1^31 01101
2483	"DATA",900 2313.91,10 0,20,1,0)
2484	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
2485	"DATA",900 2313.91,10 0,25,0)
2486	^9002313.9 104^1^1^30 40114^^^^
2487	"DATA",900 2313.91,10 0,25,1,0)
2488	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),1)
2489	"DATA",900 2313.91,10 0,30,0)
2490	^9002313.9 103^1^1^30 40114^^^^
2491	"DATA",900 2313.91,10 0,30,1,0)
2492	S $P(^BPSC (BPS(90023 13.02),330 ),U,4)=BPS ("X")
2493	"DATA",900 2313.91,10 1,0)
2494	335^^PREGN ANCY INDIC ATOR^N^^^^ 1^A/N
2495	"DATA",900 2313.91,10 1,5)
2496	2C^1
2497	"DATA",900 2313.91,10 1,10,0)
2498	^9002313.9 101^1^1^30 30823
2499	"DATA",900 2313.91,10 1,10,1,0)
2500	S BPS("X") =""
2501	"DATA",900 2313.91,10 1,20,0)
2502	^9002313.9 102^1^1^31 01101
2503	"DATA",900 2313.91,10 1,20,1,0)
2504	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
2505	"DATA",900 2313.91,10 1,25,0)
2506	^9002313.9 104^1^1^30 30823^^
2507	"DATA",900 2313.91,10 1,25,1,0)
2508	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),1)
2509	"DATA",900 2313.91,10 1,30,0)
2510	^9002313.9 103^1^1^30 30823^^
2511	"DATA",900 2313.91,10 1,30,1,0)
2512	S $P(^BPSC (BPS(90023 13.02),330 ),U,5)=BPS ("X")
2513	"DATA",900 2313.91,10 2,0)
2514	336^^FACIL ITY ID^A/N ^^^^10^A/N
2515	"DATA",900 2313.91,10 2,5)
2516	8C^10
2517	"DATA",900 2313.91,10 2,10,0)
2518	^9002313.9 101^1^1^30 70103
2519	"DATA",900 2313.91,10 2,10,1,0)
2520	S BPS("X") =$G(BPS("I nsurer","F acility ID "))
2521	"DATA",900 2313.91,10 2,20,0)
2522	^9002313.9 102^1^1^31 01101
2523	"DATA",900 2313.91,10 2,20,1,0)
2524	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
2525	"DATA",900 2313.91,10 2,25,0)
2526	^9002313.9 104^1^1^30 30823^^
2527	"DATA",900 2313.91,10 2,25,1,0)
2528	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),10)
2529	"DATA",900 2313.91,10 2,30,0)
2530	^9002313.9 103^1^1^30 30823^
2531	"DATA",900 2313.91,10 2,30,1,0)
2532	S $P(^BPSC (BPS(90023 13.02),330 ),U,6)=BPS ("X")
2533	"DATA",900 2313.91,10 3,0)
2534	337^^COB/O THER PAYME NTS COUNT^ N^^^^1^N
2535	"DATA",900 2313.91,10 3,1)
2536	COORDINATI ON OF BENE FITS/OTHER PAYMENTS COUNT
2537	"DATA",900 2313.91,10 3,5)
2538	4C^1
2539	"DATA",900 2313.91,10 3,10,0)
2540	^9002313.9 101^1^1^31 00916
2541	"DATA",900 2313.91,10 3,10,1,0)
2542	;GET code for this C OB field i s executed in COB^BP SOSHF
2543	"DATA",900 2313.91,10 3,20,0)
2544	^9002313.9 102^1^1^31 01101
2545	"DATA",900 2313.91,10 3,20,1,0)
2546	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
2547	"DATA",900 2313.91,10 3,25,0)
2548	^9002313.9 104^1^1^30 40223^^^
2549	"DATA",900 2313.91,10 3,25,1,0)
2550	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
2551	"DATA",900 2313.91,10 3,30,0)
2552	^9002313.9 103^1^1^31 00824
2553	"DATA",900 2313.91,10 3,30,1,0)
2554	D SET337^B PSFLD01
2555	"DATA",900 2313.91,10 4,0)
2556	338^^OTHER PAYER COV ERAGE TYPE ^N^^^^2^A/ N
2557	"DATA",900 2313.91,10 4,5)
2558	5C^2
2559	"DATA",900 2313.91,10 4,10,0)
2560	^9002313.9 101^1^1^31 00916
2561	"DATA",900 2313.91,10 4,10,1,0)
2562	;GET code for this C OB field i s executed in COB^BP SOSHF
2563	"DATA",900 2313.91,10 4,20,0)
2564	^9002313.9 102^1^1^31 01101
2565	"DATA",900 2313.91,10 4,20,1,0)
2566	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2567	"DATA",900 2313.91,10 4,25,0)
2568	^9002313.9 104^1^1^31 01029^
2569	"DATA",900 2313.91,10 4,25,1,0)
2570	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2571	"DATA",900 2313.91,10 4,30,0)
2572	^9002313.9 103^1^1^31 01004^
2573	"DATA",900 2313.91,10 4,30,1,0)
2574	D SET338^B PSFLD01
2575	"DATA",900 2313.91,10 5,0)
2576	339^^OTHER PAYER ID QUALIFIER^ N^^^^2^A/N
2577	"DATA",900 2313.91,10 5,5)
2578	6C^2
2579	"DATA",900 2313.91,10 5,10,0)
2580	^9002313.9 101^1^1^31 00916
2581	"DATA",900 2313.91,10 5,10,1,0)
2582	;GET code for this C OB field i s executed in COB^BP SOSHF
2583	"DATA",900 2313.91,10 5,20,0)
2584	^9002313.9 102^1^1^31 01101
2585	"DATA",900 2313.91,10 5,20,1,0)
2586	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2587	"DATA",900 2313.91,10 5,25,0)
2588	^9002313.9 104^1^1^31 01029^
2589	"DATA",900 2313.91,10 5,25,1,0)
2590	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2591	"DATA",900 2313.91,10 5,30,0)
2592	^9002313.9 103^1^1^31 01004^
2593	"DATA",900 2313.91,10 5,30,1,0)
2594	D SET339^B PSFLD01
2595	"DATA",900 2313.91,10 6,0)
2596	340^^OTHER PAYER ID^ A/N^^^^10^ A/N
2597	"DATA",900 2313.91,10 6,5)
2598	7C^10
2599	"DATA",900 2313.91,10 6,10,0)
2600	^9002313.9 101^1^1^31 00916
2601	"DATA",900 2313.91,10 6,10,1,0)
2602	;GET code for this C OB field i s executed in COB^BP SOSHF
2603	"DATA",900 2313.91,10 6,20,0)
2604	^9002313.9 102^1^1^31 01101
2605	"DATA",900 2313.91,10 6,20,1,0)
2606	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
2607	"DATA",900 2313.91,10 6,25,0)
2608	^9002313.9 104^1^1^30 40223^^
2609	"DATA",900 2313.91,10 6,25,1,0)
2610	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
2611	"DATA",900 2313.91,10 6,30,0)
2612	^9002313.9 103^1^1^31 01004^^
2613	"DATA",900 2313.91,10 6,30,1,0)
2614	D SET340^B PSFLD01
2615	"DATA",900 2313.91,10 7,0)
2616	341^^OTHER PAYER AMO UNT PAID C OUNT^N^^^^ 1^N
2617	"DATA",900 2313.91,10 7,5)
2618	HB^1
2619	"DATA",900 2313.91,10 7,10,0)
2620	^9002313.9 101^1^1^31 00916
2621	"DATA",900 2313.91,10 7,10,1,0)
2622	;GET code for this C OB field i s executed in COB^BP SOSHF
2623	"DATA",900 2313.91,10 7,20,0)
2624	^9002313.9 102^1^1^31 01101
2625	"DATA",900 2313.91,10 7,20,1,0)
2626	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
2627	"DATA",900 2313.91,10 7,25,0)
2628	^9002313.9 104^1^1^30 40224^^^^
2629	"DATA",900 2313.91,10 7,25,1,0)
2630	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
2631	"DATA",900 2313.91,10 7,30,0)
2632	^9002313.9 103^1^1^31 00824
2633	"DATA",900 2313.91,10 7,30,1,0)
2634	D SET341^B PSFLD01
2635	"DATA",900 2313.91,10 8,0)
2636	342^^OTHER PAYER AMT PAID QUAL IFIER^A/N^ ^^^2^A/N
2637	"DATA",900 2313.91,10 8,1)
2638	OTHER PAYE R AMOUNT P AID QUALIF IER
2639	"DATA",900 2313.91,10 8,5)
2640	HC^2
2641	"DATA",900 2313.91,10 8,10,0)
2642	^9002313.9 101^1^1^31 00916
2643	"DATA",900 2313.91,10 8,10,1,0)
2644	;GET code for this C OB field i s executed in COB^BP SOSHF
2645	"DATA",900 2313.91,10 8,20,0)
2646	^9002313.9 102^1^1^31 01101
2647	"DATA",900 2313.91,10 8,20,1,0)
2648	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2649	"DATA",900 2313.91,10 8,25,0)
2650	^9002313.9 104^1^1^31 01029^
2651	"DATA",900 2313.91,10 8,25,1,0)
2652	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2653	"DATA",900 2313.91,10 8,30,0)
2654	^9002313.9 103^1^1^31 00824
2655	"DATA",900 2313.91,10 8,30,1,0)
2656	D SET342^B PSFLD01
2657	"DATA",900 2313.91,10 9,0)
2658	343^^DISPE NSING STAT US^A/N^^^^ 1^A/N
2659	"DATA",900 2313.91,10 9,5)
2660	HD^1
2661	"DATA",900 2313.91,10 9,10,0)
2662	^9002313.9 101^1^1^30 40913
2663	"DATA",900 2313.91,10 9,10,1,0)
2664	S BPS("X") =""
2665	"DATA",900 2313.91,10 9,20,0)
2666	^9002313.9 102^1^1^31 01101
2667	"DATA",900 2313.91,10 9,20,1,0)
2668	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
2669	"DATA",900 2313.91,10 9,25,0)
2670	^9002313.9 104^1^1^30 40913^^^^
2671	"DATA",900 2313.91,10 9,25,1,0)
2672	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
2673	"DATA",900 2313.91,10 9,30,0)
2674	^9002313.9 103^1^1^30 70620^
2675	"DATA",900 2313.91,10 9,30,1,0)
2676	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 40),U,3)=" "
2677	"DATA",900 2313.91,11 0,0)
2678	344^^QTY I NTENDED TO BE DISPEN SED^N^^^^1 0^N
2679	"DATA",900 2313.91,11 0,1)
2680	QUANTITY I NTENDED TO BE DISPEN SED
2681	"DATA",900 2313.91,11 0,5)
2682	HF^10
2683	"DATA",900 2313.91,11 0,10,0)
2684	^9002313.9 101^1^1^30 70620
2685	"DATA",900 2313.91,11 0,10,1,0)
2686	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Quantity "))*1000\1
2687	"DATA",900 2313.91,11 0,20,0)
2688	^9002313.9 102^1^1^31 01101
2689	"DATA",900 2313.91,11 0,20,1,0)
2690	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2691	"DATA",900 2313.91,11 0,25,0)
2692	^9002313.9 104^1^1^30 70620^
2693	"DATA",900 2313.91,11 0,25,1,0)
2694	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2695	"DATA",900 2313.91,11 0,30,0)
2696	^9002313.9 103^1^1^30 70620^
2697	"DATA",900 2313.91,11 0,30,1,0)
2698	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 40),U,4)=" "
2699	"DATA",900 2313.91,11 1,0)
2700	345^^DAYS SUPPLY INT END TO BE DISP^N^^^^ 3^N
2701	"DATA",900 2313.91,11 1,1)
2702	DAYS SUPPL Y INTENDED TO BE DIS PENSED
2703	"DATA",900 2313.91,11 1,5)
2704	HG^3
2705	"DATA",900 2313.91,11 1,10,0)
2706	^9002313.9 101^1^1^30 30827
2707	"DATA",900 2313.91,11 1,10,1,0)
2708	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Days Sup ply"))*100 0
2709	"DATA",900 2313.91,11 1,20,0)
2710	^9002313.9 102^1^1^31 01101
2711	"DATA",900 2313.91,11 1,20,1,0)
2712	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),3)
2713	"DATA",900 2313.91,11 1,25,0)
2714	^9002313.9 104^1^1^30 30827^^^
2715	"DATA",900 2313.91,11 1,25,1,0)
2716	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),3)
2717	"DATA",900 2313.91,11 1,30,0)
2718	^9002313.9 103^1^1^30 70620^
2719	"DATA",900 2313.91,11 1,30,1,0)
2720	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 40),U,5)=" "
2721	"DATA",900 2313.91,11 2,0)
2722	346^^BASIS OF CALC - DISPENSIN G FEE^A/N^ ^^^2^A/N
2723	"DATA",900 2313.91,11 2,5)
2724	HH^8
2725	"DATA",900 2313.91,11 2,10,0)
2726	^9002313.9 101^1^1^31 01115^
2727	"DATA",900 2313.91,11 2,10,1,0)
2728	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
2729	"DATA",900 2313.91,11 2,25,0)
2730	^^1^1^3031 205^
2731	"DATA",900 2313.91,11 2,25,1,0)
2732	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 )
2733	"DATA",900 2313.91,11 2,30,0)
2734	^^1^1^3031 205^
2735	"DATA",900 2313.91,11 2,30,1,0)
2736	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 340),U,6)= BPS("X")
2737	"DATA",900 2313.91,11 3,0)
2738	347^^BASIS OF CALC - COPAY^A/N ^^^^2^A/N
2739	"DATA",900 2313.91,11 3,5)
2740	HJ^8
2741	"DATA",900 2313.91,11 3,10,0)
2742	^9002313.9 101^1^1^31 01115^
2743	"DATA",900 2313.91,11 3,10,1,0)
2744	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
2745	"DATA",900 2313.91,11 3,25,0)
2746	^9002313.9 104^1^1^30 40114^^^
2747	"DATA",900 2313.91,11 3,25,1,0)
2748	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 )
2749	"DATA",900 2313.91,11 3,30,0)
2750	^9002313.9 103^1^1^30 40114^^^
2751	"DATA",900 2313.91,11 3,30,1,0)
2752	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 340),U,7)= BPS("X")
2753	"DATA",900 2313.91,11 4,0)
2754	348^^BASIS OF CALC - FLAT SALE S TAX^A/N^ ^^^2^A/N
2755	"DATA",900 2313.91,11 4,5)
2756	HK^8
2757	"DATA",900 2313.91,11 4,10,0)
2758	^9002313.9 101^1^1^31 01115^
2759	"DATA",900 2313.91,11 4,10,1,0)
2760	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
2761	"DATA",900 2313.91,11 4,25,0)
2762	^^1^1^3031 205^
2763	"DATA",900 2313.91,11 4,25,1,0)
2764	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 )
2765	"DATA",900 2313.91,11 4,30,0)
2766	^^1^1^3031 205^
2767	"DATA",900 2313.91,11 4,30,1,0)
2768	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 340),U,8)= BPS("X")
2769	"DATA",900 2313.91,11 5,0)
2770	349^^BASIS OF CALC - % SALES T AX^A/N^^^^ 2^A/N
2771	"DATA",900 2313.91,11 5,5)
2772	HM^8
2773	"DATA",900 2313.91,11 5,10,0)
2774	^9002313.9 101^1^1^31 01115^
2775	"DATA",900 2313.91,11 5,10,1,0)
2776	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
2777	"DATA",900 2313.91,11 5,25,0)
2778	^^1^1^3031 205^
2779	"DATA",900 2313.91,11 5,25,1,0)
2780	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 )
2781	"DATA",900 2313.91,11 5,30,0)
2782	^^1^1^3031 205^
2783	"DATA",900 2313.91,11 5,30,1,0)
2784	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 340),U,9)= BPS("X")
2785	"DATA",900 2313.91,11 6,0)
2786	350^^PATIE NT E-MAIL ADDRESS^A/ N^^^^80^A/ N
2787	"DATA",900 2313.91,11 6,5)
2788	HN^80
2789	"DATA",900 2313.91,11 6,10,0)
2790	^9002313.9 101^1^1^30 30512
2791	"DATA",900 2313.91,11 6,10,1,0)
2792	S BPS("X") =$G(BPS("P atient","P atient E-M ail Addres s"))
2793	"DATA",900 2313.91,11 6,20,0)
2794	^9002313.9 102^1^1^31 01101
2795	"DATA",900 2313.91,11 6,20,1,0)
2796	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 0)
2797	"DATA",900 2313.91,11 6,30,0)
2798	^9002313.9 103^1^1^31 01101^^^
2799	"DATA",900 2313.91,11 6,30,1,0)
2800	S $P(^BPSC (BPS(90023 13.02),340 ),U,10)=$G (BPS("X"))
2801	"DATA",900 2313.91,11 7,0)
2802	351^^OTHER PAYER-PAT RESP AMT QLFR^A/N^^ ^^2^A/N
2803	"DATA",900 2313.91,11 7,1)
2804	OTHER PAYE R-PATIENT RESPONSIBI LITY AMOUN T QUALIFIE R
2805	"DATA",900 2313.91,11 7,5)
2806	NP^1
2807	"DATA",900 2313.91,11 7,10,0)
2808	^^1^1^3101 222^
2809	"DATA",900 2313.91,11 7,10,1,0)
2810	;GET code for this C OB field i s executed in COB^BP SOSHF
2811	"DATA",900 2313.91,11 7,20,0)
2812	^9002313.9 102^1^1^31 01220^
2813	"DATA",900 2313.91,11 7,20,1,0)
2814	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2815	"DATA",900 2313.91,11 7,30,0)
2816	^^1^1^3101 222^
2817	"DATA",900 2313.91,11 7,30,1,0)
2818	D SET351^B PSFLD01
2819	"DATA",900 2313.91,11 8,0)
2820	352^^OTHER PAYER-PAT RESP AMOU NT^D^^^^10 ^D
2821	"DATA",900 2313.91,11 8,1)
2822	OTHER PAYE R-PATIENT RESPONSIBI LITY AMOUN T
2823	"DATA",900 2313.91,11 8,5)
2824	NQ^10
2825	"DATA",900 2313.91,11 8,10,0)
2826	^^1^1^3101 222^
2827	"DATA",900 2313.91,11 8,10,1,0)
2828	;GET code for this C OB field i s executed in COB^BP SOSHF
2829	"DATA",900 2313.91,11 8,20,0)
2830	^9002313.9 102^1^1^31 01101
2831	"DATA",900 2313.91,11 8,20,1,0)
2832	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),10 )
2833	"DATA",900 2313.91,11 8,25,0)
2834	^9002313.9 104^1^1^30 31212^
2835	"DATA",900 2313.91,11 8,25,1,0)
2836	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),10 )
2837	"DATA",900 2313.91,11 8,30,0)
2838	^9002313.9 103^1^1^31 01222^^
2839	"DATA",900 2313.91,11 8,30,1,0)
2840	D SET352^B PSFLD01
2841	"DATA",900 2313.91,11 9,0)
2842	353^^OTHER PAYER-PAT RESP AMT CNT^N^^^^2 ^N
2843	"DATA",900 2313.91,11 9,1)
2844	OTHER PAYE R-PATIENT RESPONSIBI LITY AMOUN T COUNT
2845	"DATA",900 2313.91,11 9,5)
2846	NR^1
2847	"DATA",900 2313.91,11 9,10,0)
2848	^^1^1^3101 222^
2849	"DATA",900 2313.91,11 9,10,1,0)
2850	;GET code for this C OB field i s executed in COB^BP SOSHF
2851	"DATA",900 2313.91,11 9,20,0)
2852	^9002313.9 102^1^1^31 01101
2853	"DATA",900 2313.91,11 9,20,1,0)
2854	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
2855	"DATA",900 2313.91,11 9,30,0)
2856	^9002313.9 103^1^1^31 01222^^
2857	"DATA",900 2313.91,11 9,30,1,0)
2858	D SET353^B PSFLD01
2859	"DATA",900 2313.91,12 0,0)
2860	445^^ORIG PRESCRIBED PROD/SERV CODE^A/N^ ^^^19^A/N
2861	"DATA",900 2313.91,12 0,1)
2862	ORIGINALLY PRESCRIBE D PRODUCT/ SERVICE CO DE
2863	"DATA",900 2313.91,12 0,5)
2864	EA^19
2865	"DATA",900 2313.91,12 0,10,0)
2866	^9002313.9 101^1^1^31 01029^
2867	"DATA",900 2313.91,12 0,10,1,0)
2868	S BPS("X") =""
2869	"DATA",900 2313.91,12 0,20,0)
2870	^9002313.9 102^1^1^31 01101
2871	"DATA",900 2313.91,12 0,20,1,0)
2872	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
2873	"DATA",900 2313.91,12 0,25,0)
2874	^9002313.9 104^1^1^30 40107^^
2875	"DATA",900 2313.91,12 0,25,1,0)
2876	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),19)
2877	"DATA",900 2313.91,12 0,30,0)
2878	^9002313.9 103^1^1^31 01115^
2879	"DATA",900 2313.91,12 0,30,1,0)
2880	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 40),U,5)=" "
2881	"DATA",900 2313.91,12 1,0)
2882	446^^ORIGI NALLY PRES CRIBED QUA NTITY^N^^^ ^10^N
2883	"DATA",900 2313.91,12 1,5)
2884	EB^10
2885	"DATA",900 2313.91,12 1,10,0)
2886	^9002313.9 101^1^1^31 01115^
2887	"DATA",900 2313.91,12 1,10,1,0)
2888	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Quantity "))*1000\1
2889	"DATA",900 2313.91,12 1,20,0)
2890	^9002313.9 102^1^1^31 01101
2891	"DATA",900 2313.91,12 1,20,1,0)
2892	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2893	"DATA",900 2313.91,12 1,25,0)
2894	^9002313.9 104^1^1^30 30828^^^^
2895	"DATA",900 2313.91,12 1,25,1,0)
2896	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
2897	"DATA",900 2313.91,12 1,30,0)
2898	^9002313.9 103^1^1^30 30828^^^^
2899	"DATA",900 2313.91,12 1,30,1,0)
2900	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 40),U,6)=B PS("X") ;V A
2901	"DATA",900 2313.91,12 2,0)
2902	454^^SCHED ULED PRESC RIPTION ID NUM^N^^^^ 12^A/N
2903	"DATA",900 2313.91,12 2,1)
2904	SCHEDULED PRESCRIPTI ON ID NUMB ER
2905	"DATA",900 2313.91,12 2,5)
2906	EK^12
2907	"DATA",900 2313.91,12 2,10,0)
2908	^9002313.9 101^1^1^30 40224
2909	"DATA",900 2313.91,12 2,10,1,0)
2910	S BPS("X") =""
2911	"DATA",900 2313.91,12 2,20,0)
2912	^9002313.9 102^1^1^31 01101
2913	"DATA",900 2313.91,12 2,20,1,0)
2914	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 2)
2915	"DATA",900 2313.91,12 2,25,0)
2916	^9002313.9 104^1^1^30 40224^^
2917	"DATA",900 2313.91,12 2,25,1,0)
2918	S BPS("X") =$$NFF^BPS ECFM(BPS(" X"),12)
2919	"DATA",900 2313.91,12 2,30,0)
2920	^9002313.9 103^1^1^30 40224^^
2921	"DATA",900 2313.91,12 2,30,1,0)
2922	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 50),U,4)=B PS("X")
2923	"DATA",900 2313.91,12 3,0)
2924	456^^ASSOC PRESCRIPT ION/SERV R EF NO^A/N^ ^^^12^N
2925	"DATA",900 2313.91,12 3,1)
2926	ASSOCIATED PRESCRIPT ION/ SERVI CE REFEREN CE NUMBER
2927	"DATA",900 2313.91,12 3,5)
2928	EN^7
2929	"DATA",900 2313.91,12 3,10,0)
2930	^9002313.9 101^1^1^30 30823
2931	"DATA",900 2313.91,12 3,10,1,0)
2932	S BPS("X") =""
2933	"DATA",900 2313.91,12 3,20,0)
2934	^9002313.9 102^1^1^31 01101
2935	"DATA",900 2313.91,12 3,20,1,0)
2936	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),12 )
2937	"DATA",900 2313.91,12 3,25,0)
2938	^9002313.9 104^1^1^30 30823^^
2939	"DATA",900 2313.91,12 3,25,1,0)
2940	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),7)
2941	"DATA",900 2313.91,12 3,30,0)
2942	^^1^1^3110 720^
2943	"DATA",900 2313.91,12 3,30,1,0)
2944	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 50),U,6)=$ S($G(BPS(" NCPDP","Ve rsion"))=5 1:BPS("X") ,1:"")
2945	"DATA",900 2313.91,12 4,0)
2946	457^^ASSOC PRESCRIPT ION/SERV D ATE^A/N^^^ ^8^N
2947	"DATA",900 2313.91,12 4,1)
2948	ASSOCIATED PRESCRIPT ION/ SERVI CE DATE
2949	"DATA",900 2313.91,12 4,5)
2950	EP^8
2951	"DATA",900 2313.91,12 4,10,0)
2952	^9002313.9 101^1^1^31 01029^
2953	"DATA",900 2313.91,12 4,10,1,0)
2954	S BPS("X") =""
2955	"DATA",900 2313.91,12 4,20,0)
2956	^9002313.9 102^1^1^31 01029^
2957	"DATA",900 2313.91,12 4,20,1,0)
2958	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
2959	"DATA",900 2313.91,12 4,25,0)
2960	^9002313.9 104^1^1^31 01029^
2961	"DATA",900 2313.91,12 4,25,1,0)
2962	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
2963	"DATA",900 2313.91,12 4,30,0)
2964	^9002313.9 103^1^1^31 10720^^
2965	"DATA",900 2313.91,12 4,30,1,0)
2966	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 50),U,7)=$ S($G(BPS(" NCPDP","Ve rsion"))=5 1:BPS("X") ,1:"")
2967	"DATA",900 2313.91,12 5,0)
2968	458^^PROCE DURE MODIF IER CODE C OUNT^N^^^^ 2^N
2969	"DATA",900 2313.91,12 5,5)
2970	SE^1
2971	"DATA",900 2313.91,12 5,10,0)
2972	^9002313.9 101^1^1^30 40819
2973	"DATA",900 2313.91,12 5,10,1,0)
2974	S BPS("X") =""
2975	"DATA",900 2313.91,12 5,20,0)
2976	^9002313.9 102^1^1^31 01101
2977	"DATA",900 2313.91,12 5,20,1,0)
2978	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
2979	"DATA",900 2313.91,12 5,25,0)
2980	^9002313.9 104^1^1^30 40819^^^^
2981	"DATA",900 2313.91,12 5,25,1,0)
2982	S BPS("X") =$$NFF^BPS ECFM(BPS(" X"),1)
2983	"DATA",900 2313.91,12 5,30,0)
2984	^9002313.9 103^1^1^30 40819^
2985	"DATA",900 2313.91,12 5,30,1,0)
2986	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 50),U,8)=" "
2987	"DATA",900 2313.91,12 6,0)
2988	459^^PROCE DURE MODIF IER CODE^A /N^^^^2^A/ N
2989	"DATA",900 2313.91,12 6,5)
2990	ER^2
2991	"DATA",900 2313.91,12 6,10,0)
2992	^9002313.9 101^1^1^30 40819
2993	"DATA",900 2313.91,12 6,10,1,0)
2994	S BPS("X") =""
2995	"DATA",900 2313.91,12 6,20,0)
2996	^9002313.9 102^1^1^31 01101
2997	"DATA",900 2313.91,12 6,20,1,0)
2998	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
2999	"DATA",900 2313.91,12 6,25,0)
3000	^9002313.9 104^1^1^30 40819^^^^
3001	"DATA",900 2313.91,12 6,25,1,0)
3002	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),2)
3003	"DATA",900 2313.91,12 6,30,0)
3004	^^1^1^3110 727^
3005	"DATA",900 2313.91,12 6,30,1,0)
3006	; Not impl emented
3007	"DATA",900 2313.91,12 7,0)
3008	461^^PRIOR AUTHORIZA TION TYPE CODE^N^^^^ 2^N
3009	"DATA",900 2313.91,12 7,5)
3010	EU^2
3011	"DATA",900 2313.91,12 7,10,0)
3012	^9002313.9 101^2^2^31 01115^
3013	"DATA",900 2313.91,12 7,10,1,0)
3014	S BPS("X") =$G(BPS("C laim",BPS( 9002313.02 01),"Prior Auth Type "))
3015	"DATA",900 2313.91,12 7,10,2,0)
3016	S:BPS("X") ="" BPS("X ")=0
3017	"DATA",900 2313.91,12 7,20,0)
3018	^9002313.9 102^1^1^31 01101
3019	"DATA",900 2313.91,12 7,20,1,0)
3020	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
3021	"DATA",900 2313.91,12 7,25,0)
3022	^9002313.9 104^1^1^30 31222^^^^
3023	"DATA",900 2313.91,12 7,25,1,0)
3024	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
3025	"DATA",900 2313.91,12 7,30,0)
3026	^9002313.9 103^1^1^30 31222^^^^
3027	"DATA",900 2313.91,12 7,30,1,0)
3028	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,1)=B PS("X")
3029	"DATA",900 2313.91,12 8,0)
3030	462^^PRIOR AUTH NUMB ER SUBMITT ED^A/N^^^^ 11^N
3031	"DATA",900 2313.91,12 8,1)
3032	PRIOR AUTH ORIZATION NUMBER SUB MITTED
3033	"DATA",900 2313.91,12 8,5)
3034	EV^11
3035	"DATA",900 2313.91,12 8,10,0)
3036	^9002313.9 101^1^1^30 31222
3037	"DATA",900 2313.91,12 8,10,1,0)
3038	S BPS("X") =$G(BPS("C laim",BPS( 9002313.02 01),"Prior Auth Num Sub"))
3039	"DATA",900 2313.91,12 8,20,0)
3040	^9002313.9 102^1^1^31 01101
3041	"DATA",900 2313.91,12 8,20,1,0)
3042	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),11 )
3043	"DATA",900 2313.91,12 8,25,0)
3044	^9002313.9 104^1^1^30 31222^^^^
3045	"DATA",900 2313.91,12 8,25,1,0)
3046	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),11 )
3047	"DATA",900 2313.91,12 8,30,0)
3048	^9002313.9 103^1^1^30 31222^^^^
3049	"DATA",900 2313.91,12 8,30,1,0)
3050	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,2)=B PS("X")
3051	"DATA",900 2313.91,12 9,0)
3052	464^^INTER MEDIARY AU THORIZATIO N ID^A/N^^ ^^11^A/N
3053	"DATA",900 2313.91,12 9,5)
3054	EX^11
3055	"DATA",900 2313.91,12 9,10,0)
3056	^^2^2^3110 727^
3057	"DATA",900 2313.91,12 9,10,1,0)
3058	S BPS("X") =$G(BPS("C laim",BPS( 9002313.02 01),"Inter mediary Au th ID"))
3059	"DATA",900 2313.91,12 9,10,2,0)
3060	S:BPS("X") ="" BPS("X ")=""
3061	"DATA",900 2313.91,12 9,20,0)
3062	^9002313.9 102^1^1^31 01101
3063	"DATA",900 2313.91,12 9,20,1,0)
3064	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 1)
3065	"DATA",900 2313.91,12 9,25,0)
3066	^9002313.9 104^1^1^30 30823^
3067	"DATA",900 2313.91,12 9,25,1,0)
3068	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),11)
3069	"DATA",900 2313.91,12 9,30,0)
3070	^9002313.9 103^1^1^30 30823^^^
3071	"DATA",900 2313.91,12 9,30,1,0)
3072	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,4)=B PS("X")
3073	"DATA",900 2313.91,13 0,0)
3074	471^^OTHER PAYER REJ ECT COUNT^ N^^^^2^N
3075	"DATA",900 2313.91,13 0,5)
3076	5E^2
3077	"DATA",900 2313.91,13 0,10,0)
3078	^9002313.9 101^1^1^31 00916
3079	"DATA",900 2313.91,13 0,10,1,0)
3080	;GET code for this C OB field i s executed in COB^BP SOSHF
3081	"DATA",900 2313.91,13 0,20,0)
3082	^9002313.9 102^1^1^31 01101
3083	"DATA",900 2313.91,13 0,20,1,0)
3084	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
3085	"DATA",900 2313.91,13 0,25,0)
3086	^9002313.9 104^1^1^30 40224^^
3087	"DATA",900 2313.91,13 0,25,1,0)
3088	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
3089	"DATA",900 2313.91,13 0,30,0)
3090	^9002313.9 103^1^1^31 00824
3091	"DATA",900 2313.91,13 0,30,1,0)
3092	D SET471^B PSFLD01
3093	"DATA",900 2313.91,13 1,0)
3094	472^^OTHER PAYER REJ ECT CODE^A /N^^^^3^A/ N
3095	"DATA",900 2313.91,13 1,5)
3096	6E^3
3097	"DATA",900 2313.91,13 1,10,0)
3098	^9002313.9 101^1^1^31 01206^
3099	"DATA",900 2313.91,13 1,10,1,0)
3100	;GET code for this C OB field i s executed in COB^BP SOSHF
3101	"DATA",900 2313.91,13 1,20,0)
3102	^9002313.9 102^1^1^31 01206^
3103	"DATA",900 2313.91,13 1,20,1,0)
3104	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
3105	"DATA",900 2313.91,13 1,25,0)
3106	^9002313.9 104^1^1^30 40224^^^^
3107	"DATA",900 2313.91,13 1,25,1,0)
3108	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
3109	"DATA",900 2313.91,13 1,30,0)
3110	^9002313.9 103^1^1^31 01206^
3111	"DATA",900 2313.91,13 1,30,1,0)
3112	D SET472^B PSFLD01
3113	"DATA",900 2313.91,13 2,0)
3114	473^^DUR/P PS CODE CO UNTER^N^^^ ^1^N
3115	"DATA",900 2313.91,13 2,5)
3116	7E^1
3117	"DATA",900 2313.91,13 2,10,0)
3118	^9002313.9 101^1^1^30 31230
3119	"DATA",900 2313.91,13 2,10,1,0)
3120	S BPS("X") =1
3121	"DATA",900 2313.91,13 2,20,0)
3122	^9002313.9 102^1^1^31 01101
3123	"DATA",900 2313.91,13 2,20,1,0)
3124	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
3125	"DATA",900 2313.91,13 2,25,0)
3126	^9002313.9 104^1^1^30 31230^^^^
3127	"DATA",900 2313.91,13 2,25,1,0)
3128	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
3129	"DATA",900 2313.91,13 2,30,0)
3130	^9002313.9 103^1^1^30 31230^^^^
3131	"DATA",900 2313.91,13 2,30,1,0)
3132	D FLD473^B PSOSSG
3133	"DATA",900 2313.91,13 3,0)
3134	474^^DUR/P PS LEVEL O F EFFORT^N ^^^^2^N
3135	"DATA",900 2313.91,13 3,5)
3136	8E^2
3137	"DATA",900 2313.91,13 3,10,0)
3138	^9002313.9 101^1^1^30 30718
3139	"DATA",900 2313.91,13 3,10,1,0)
3140	S BPS("X") =12
3141	"DATA",900 2313.91,13 3,20,0)
3142	^9002313.9 102^1^1^31 01101
3143	"DATA",900 2313.91,13 3,20,1,0)
3144	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
3145	"DATA",900 2313.91,13 3,25,0)
3146	^9002313.9 104^1^1^30 30718^
3147	"DATA",900 2313.91,13 3,25,1,0)
3148	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
3149	"DATA",900 2313.91,13 3,30,0)
3150	^9002313.9 103^1^1^30 30718^
3151	"DATA",900 2313.91,13 3,30,1,0)
3152	D FLD474^B PSOSSG
3153	"DATA",900 2313.91,13 4,0)
3154	475^^DUR C O-AGENT ID QUALIFIER ^A/N^^^^2^ A/N
3155	"DATA",900 2313.91,13 4,5)
3156	J9^2
3157	"DATA",900 2313.91,13 4,10,0)
3158	^9002313.9 101^1^1^30 30718
3159	"DATA",900 2313.91,13 4,10,1,0)
3160	S BPS("X") =""
3161	"DATA",900 2313.91,13 4,20,0)
3162	^9002313.9 102^1^1^31 01101
3163	"DATA",900 2313.91,13 4,20,1,0)
3164	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
3165	"DATA",900 2313.91,13 4,25,0)
3166	^9002313.9 104^1^1^30 30718^
3167	"DATA",900 2313.91,13 4,25,1,0)
3168	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
3169	"DATA",900 2313.91,13 4,30,0)
3170	^9002313.9 103^1^1^30 30718^
3171	"DATA",900 2313.91,13 4,30,1,0)
3172	D FLD475^B PSOSSG
3173	"DATA",900 2313.91,13 5,0)
3174	476^^DUR C O-AGENT ID ^A/N^^^^19 ^A/N
3175	"DATA",900 2313.91,13 5,5)
3176	H6^19
3177	"DATA",900 2313.91,13 5,10,0)
3178	^9002313.9 101^1^1^31 01115^
3179	"DATA",900 2313.91,13 5,10,1,0)
3180	S BPS("X") =""
3181	"DATA",900 2313.91,13 5,20,0)
3182	^9002313.9 102^1^1^31 01101
3183	"DATA",900 2313.91,13 5,20,1,0)
3184	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
3185	"DATA",900 2313.91,13 5,25,0)
3186	^9002313.9 104^1^1^30 40107^^^
3187	"DATA",900 2313.91,13 5,25,1,0)
3188	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
3189	"DATA",900 2313.91,13 5,30,0)
3190	^9002313.9 103^1^1^31 01115^^^^
3191	"DATA",900 2313.91,13 5,30,1,0)
3192	D FLD476^B PSOSSG
3193	"DATA",900 2313.91,13 6,0)
3194	477^^PROF SERVICE FE E SUBMITTE D^D^^^^8^D
3195	"DATA",900 2313.91,13 6,1)
3196	PROFESSION AL SERVICE FEE SUBMI TTED
3197	"DATA",900 2313.91,13 6,5)
3198	BE^8
3199	"DATA",900 2313.91,13 6,10,0)
3200	^9002313.9 101^1^1^31 00916
3201	"DATA",900 2313.91,13 6,10,1,0)
3202	S BPS("X") =0
3203	"DATA",900 2313.91,13 6,20,0)
3204	^9002313.9 102^1^1^31 01101
3205	"DATA",900 2313.91,13 6,20,1,0)
3206	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3207	"DATA",900 2313.91,13 6,25,0)
3208	^9002313.9 104^1^1^31 01029^
3209	"DATA",900 2313.91,13 6,25,1,0)
3210	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3211	"DATA",900 2313.91,13 6,30,0)
3212	^9002313.9 103^1^1^30 30823^^
3213	"DATA",900 2313.91,13 6,30,1,0)
3214	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 70),U,7)=B PS("X")
3215	"DATA",900 2313.91,13 9,0)
3216	481^^FLAT SALES TAX AMT SUBMIT TED^D^^^^8 ^D
3217	"DATA",900 2313.91,13 9,1)
3218	FLAT SALES TAX AMOUN T SUBMITTE D
3219	"DATA",900 2313.91,13 9,5)
3220	HA^8
3221	"DATA",900 2313.91,13 9,10,0)
3222	^9002313.9 101^1^1^31 00916
3223	"DATA",900 2313.91,13 9,10,1,0)
3224	S BPS("X") =0
3225	"DATA",900 2313.91,13 9,20,0)
3226	^9002313.9 102^1^1^31 01101
3227	"DATA",900 2313.91,13 9,20,1,0)
3228	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3229	"DATA",900 2313.91,13 9,25,0)
3230	^9002313.9 104^1^1^30 40907^^
3231	"DATA",900 2313.91,13 9,25,1,0)
3232	S BPS("X") =$$DFF^BPS ECFM(BPS(" X"),8)
3233	"DATA",900 2313.91,13 9,30,0)
3234	^9002313.9 103^1^1^31 00923^^^^
3235	"DATA",900 2313.91,13 9,30,1,0)
3236	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 80),U,1)=$ S($G(BPS(" NCPDP","Ve rsion"))=5 1:BPS("X") ,1:"")
3237	"DATA",900 2313.91,14 0,0)
3238	482^^PERCE NT SALES T AX AMT SBM TTD^D^^^^8 ^D
3239	"DATA",900 2313.91,14 0,1)
3240	PERCENTAGE SALES TAX AMOUNT SU BMITTED
3241	"DATA",900 2313.91,14 0,5)
3242	GE^8
3243	"DATA",900 2313.91,14 0,10,0)
3244	^9002313.9 101^1^1^30 50802
3245	"DATA",900 2313.91,14 0,10,1,0)
3246	S BPS("X") =0
3247	"DATA",900 2313.91,14 0,20,0)
3248	^9002313.9 102^1^1^31 01101
3249	"DATA",900 2313.91,14 0,20,1,0)
3250	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3251	"DATA",900 2313.91,14 0,25,0)
3252	^9002313.9 104^1^1^30 40907^^^^
3253	"DATA",900 2313.91,14 0,25,1,0)
3254	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3255	"DATA",900 2313.91,14 0,30,0)
3256	^9002313.9 103^1^1^31 00923^^^^
3257	"DATA",900 2313.91,14 0,30,1,0)
3258	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 80),U,2)=$ S($G(BPS(" NCPDP","Ve rsion"))=5 1:BPS("X") ,1:"")
3259	"DATA",900 2313.91,14 1,0)
3260	483^^PERCE NT SALES T AX RATE SB MTTD^D^^^^ 7^D
3261	"DATA",900 2313.91,14 1,1)
3262	PERCENTAGE SALES TAX RATE SUBM ITTED
3263	"DATA",900 2313.91,14 1,5)
3264	HE^7
3265	"DATA",900 2313.91,14 1,10,0)
3266	^9002313.9 101^1^1^31 01029^
3267	"DATA",900 2313.91,14 1,10,1,0)
3268	S BPS("X") =+$G(BPS(" Insurer"," Percent Sa les Tax Ra te Sub"))
3269	"DATA",900 2313.91,14 1,20,0)
3270	^^1^1^3121 128
3271	"DATA",900 2313.91,14 1,20,1,0)
3272	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),7, 4)
3273	"DATA",900 2313.91,14 1,25,0)
3274	^^1^1^3121 128
3275	"DATA",900 2313.91,14 1,25,1,0)
3276	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),7, 4)
3277	"DATA",900 2313.91,14 1,30,0)
3278	^9002313.9 103^1^1^31 00923^^^^
3279	"DATA",900 2313.91,14 1,30,1,0)
3280	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 80),U,3)=$ S($G(BPS(" NCPDP","Ve rsion"))=5 1:BPS("X") ,1:"")
3281	"DATA",900 2313.91,14 2,0)
3282	484^^PERCE NT SALES T AX BASIS S BMTTD^A/N^ ^^^2^A/N
3283	"DATA",900 2313.91,14 2,1)
3284	PERCENTAGE SALES TAX BASIS SUB MITTED
3285	"DATA",900 2313.91,14 2,5)
3286	JE^2
3287	"DATA",900 2313.91,14 2,10,0)
3288	^9002313.9 101^1^1^30 50802
3289	"DATA",900 2313.91,14 2,10,1,0)
3290	S BPS("X") =""
3291	"DATA",900 2313.91,14 2,20,0)
3292	^9002313.9 102^1^1^31 01101
3293	"DATA",900 2313.91,14 2,20,1,0)
3294	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
3295	"DATA",900 2313.91,14 2,25,0)
3296	^9002313.9 104^1^1^30 30824^
3297	"DATA",900 2313.91,14 2,25,1,0)
3298	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),2)
3299	"DATA",900 2313.91,14 2,30,0)
3300	^9002313.9 103^1^1^31 00923^^^^
3301	"DATA",900 2313.91,14 2,30,1,0)
3302	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 80),U,4)=$ S($G(BPS(" NCPDP","Ve rsion"))=5 1:BPS("X") ,1:"")
3303	"DATA",900 2313.91,14 3,0)
3304	485^^COUPO N TYPE^A/N ^^^^2^A/N
3305	"DATA",900 2313.91,14 3,5)
3306	KE^2
3307	"DATA",900 2313.91,14 3,10,0)
3308	^9002313.9 101^1^1^31 01115^
3309	"DATA",900 2313.91,14 3,10,1,0)
3310	S BPS("X") =""
3311	"DATA",900 2313.91,14 3,20,0)
3312	^9002313.9 102^1^1^31 01101
3313	"DATA",900 2313.91,14 3,20,1,0)
3314	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
3315	"DATA",900 2313.91,14 3,25,0)
3316	^9002313.9 104^1^1^30 40107^^
3317	"DATA",900 2313.91,14 3,25,1,0)
3318	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
3319	"DATA",900 2313.91,14 3,30,0)
3320	^9002313.9 103^1^1^31 01115^^^
3321	"DATA",900 2313.91,14 3,30,1,0)
3322	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 80),U,5)=B PS("X")
3323	"DATA",900 2313.91,14 4,0)
3324	486^^COUPO N NUMBER^A /N^^^^15^A /N
3325	"DATA",900 2313.91,14 4,5)
3326	ME^15
3327	"DATA",900 2313.91,14 4,10,0)
3328	^9002313.9 101^1^1^31 01115^
3329	"DATA",900 2313.91,14 4,10,1,0)
3330	S BPS("X") =""
3331	"DATA",900 2313.91,14 4,20,0)
3332	^9002313.9 102^1^1^31 01101
3333	"DATA",900 2313.91,14 4,20,1,0)
3334	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
3335	"DATA",900 2313.91,14 4,25,0)
3336	^9002313.9 104^1^1^30 31210^^
3337	"DATA",900 2313.91,14 4,25,1,0)
3338	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
3339	"DATA",900 2313.91,14 4,30,0)
3340	^9002313.9 103^1^1^30 31210^^
3341	"DATA",900 2313.91,14 4,30,1,0)
3342	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 80),U,6)=B PS("X")
3343	"DATA",900 2313.91,14 5,0)
3344	487^^COUPO N VALUE AM OUNT^D^^^^ 8^D
3345	"DATA",900 2313.91,14 5,5)
3346	NE^8
3347	"DATA",900 2313.91,14 5,10,0)
3348	^9002313.9 101^1^1^31 01115^
3349	"DATA",900 2313.91,14 5,10,1,0)
3350	S BPS("X") =""
3351	"DATA",900 2313.91,14 5,20,0)
3352	^9002313.9 102^1^1^31 01101
3353	"DATA",900 2313.91,14 5,20,1,0)
3354	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3355	"DATA",900 2313.91,14 5,25,0)
3356	^9002313.9 104^1^1^30 31210^^
3357	"DATA",900 2313.91,14 5,25,1,0)
3358	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3359	"DATA",900 2313.91,14 5,30,0)
3360	^9002313.9 103^1^1^30 31210^^
3361	"DATA",900 2313.91,14 5,30,1,0)
3362	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 80),U,7)=B PS("X")
3363	"DATA",900 2313.91,14 6,0)
3364	491^^DIAGN OSIS CODE COUNT^N^^^ ^1^N
3365	"DATA",900 2313.91,14 6,5)
3366	VE^1
3367	"DATA",900 2313.91,14 6,10,0)
3368	^9002313.9 101^1^1^31 01115^
3369	"DATA",900 2313.91,14 6,10,1,0)
3370	S BPS("X") =""
3371	"DATA",900 2313.91,14 6,20,0)
3372	^9002313.9 102^1^1^31 01101
3373	"DATA",900 2313.91,14 6,20,1,0)
3374	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
3375	"DATA",900 2313.91,14 6,25,0)
3376	^9002313.9 104^1^1^30 40107^^^^
3377	"DATA",900 2313.91,14 6,25,1,0)
3378	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
3379	"DATA",900 2313.91,14 7,0)
3380	492^^DIAGN OSIS CODE QUALIFIER^ A/N^^^^2^A /N
3381	"DATA",900 2313.91,14 7,5)
3382	WE^2
3383	"DATA",900 2313.91,14 7,10,0)
3384	^9002313.9 101^1^1^30 40224
3385	"DATA",900 2313.91,14 7,10,1,0)
3386	S BPS("X") =""
3387	"DATA",900 2313.91,14 7,20,0)
3388	^9002313.9 102^1^1^31 01101
3389	"DATA",900 2313.91,14 7,20,1,0)
3390	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
3391	"DATA",900 2313.91,14 7,25,0)
3392	^9002313.9 104^1^1^30 40224^^^
3393	"DATA",900 2313.91,14 7,25,1,0)
3394	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
3395	"DATA",900 2313.91,14 8,0)
3396	493^^CLINI CAL INFORM ATION COUN TER^N^^^^1 ^N
3397	"DATA",900 2313.91,14 8,5)
3398	XE^1
3399	"DATA",900 2313.91,14 8,10,0)
3400	^9002313.9 101^1^1^30 40224
3401	"DATA",900 2313.91,14 8,10,1,0)
3402	S BPS("X") =""
3403	"DATA",900 2313.91,14 8,20,0)
3404	^9002313.9 102^1^1^31 01101
3405	"DATA",900 2313.91,14 8,20,1,0)
3406	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
3407	"DATA",900 2313.91,14 8,25,0)
3408	^9002313.9 104^1^1^30 40224^^^^
3409	"DATA",900 2313.91,14 8,25,1,0)
3410	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
3411	"DATA",900 2313.91,14 9,0)
3412	498.01^^RE QUEST TYPE ^N^^^^1^A/ N
3413	"DATA",900 2313.91,14 9,5)
3414	PA^1
3415	"DATA",900 2313.91,14 9,10,0)
3416	^9002313.9 101^1^1^30 40428
3417	"DATA",900 2313.91,14 9,10,1,0)
3418	S BPS("X") =""
3419	"DATA",900 2313.91,14 9,20,0)
3420	^9002313.9 102^1^1^31 01101
3421	"DATA",900 2313.91,14 9,20,1,0)
3422	S BPS("X") =""
3423	"DATA",900 2313.91,14 9,25,0)
3424	^9002313.9 104^1^1^30 40428^
3425	"DATA",900 2313.91,14 9,25,1,0)
3426	S BPS("X") =""
3427	"DATA",900 2313.91,15 0,0)
3428	498.02^^RE QUEST PERI OD DATE-BE GIN^A/N^^^ ^8^N
3429	"DATA",900 2313.91,15 0,5)
3430	PB^8
3431	"DATA",900 2313.91,15 0,10,0)
3432	^9002313.9 101^1^1^30 40223
3433	"DATA",900 2313.91,15 0,10,1,0)
3434	S BPS("X") =""
3435	"DATA",900 2313.91,15 0,20,0)
3436	^9002313.9 102^1^1^31 01101
3437	"DATA",900 2313.91,15 0,20,1,0)
3438	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
3439	"DATA",900 2313.91,15 1,0)
3440	498.03^^RE QUEST PERI OD DATE-EN D^A/N^^^^8 ^N
3441	"DATA",900 2313.91,15 1,5)
3442	PC^8
3443	"DATA",900 2313.91,15 1,10,0)
3444	^9002313.9 101^1^1^30 40223
3445	"DATA",900 2313.91,15 1,10,1,0)
3446	S BPS("X") =""
3447	"DATA",900 2313.91,15 1,20,0)
3448	^9002313.9 102^1^1^31 01101
3449	"DATA",900 2313.91,15 1,20,1,0)
3450	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
3451	"DATA",900 2313.91,15 2,0)
3452	498.04^^BA SIS OF REQ UEST^A/N^^ ^^2^A/N
3453	"DATA",900 2313.91,15 2,5)
3454	PD^2
3455	"DATA",900 2313.91,15 2,10,0)
3456	^9002313.9 101^1^1^30 40223
3457	"DATA",900 2313.91,15 2,10,1,0)
3458	S BPS("X") =""
3459	"DATA",900 2313.91,15 2,20,0)
3460	^9002313.9 102^1^1^31 01101
3461	"DATA",900 2313.91,15 2,20,1,0)
3462	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
3463	"DATA",900 2313.91,15 3,0)
3464	498.05^^AU THORIZED R EP FIRST N AME^A/N^^^ ^12^A/N
3465	"DATA",900 2313.91,15 3,5)
3466	PE^12
3467	"DATA",900 2313.91,15 3,10,0)
3468	^9002313.9 101^1^1^30 40223
3469	"DATA",900 2313.91,15 3,10,1,0)
3470	S BPS("X") =""
3471	"DATA",900 2313.91,15 3,20,0)
3472	^9002313.9 102^1^1^31 01101
3473	"DATA",900 2313.91,15 3,20,1,0)
3474	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 2)
3475	"DATA",900 2313.91,15 4,0)
3476	498.06^^AU THORIZED R EP LAST NA ME^A/N^^^^ 15^A/N
3477	"DATA",900 2313.91,15 4,5)
3478	PF^15
3479	"DATA",900 2313.91,15 4,10,0)
3480	^9002313.9 101^1^1^30 40223
3481	"DATA",900 2313.91,15 4,10,1,0)
3482	S BPS("X") =""
3483	"DATA",900 2313.91,15 4,20,0)
3484	^9002313.9 102^1^1^31 01101
3485	"DATA",900 2313.91,15 4,20,1,0)
3486	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
3487	"DATA",900 2313.91,15 5,0)
3488	498.07^^AU THORIZED R EP STREET ADDRESS^A/ N^^^^30^A/ N
3489	"DATA",900 2313.91,15 5,5)
3490	PG^30
3491	"DATA",900 2313.91,15 5,10,0)
3492	^9002313.9 101^1^1^30 40223
3493	"DATA",900 2313.91,15 5,10,1,0)
3494	S BPS("X") =""
3495	"DATA",900 2313.91,15 5,20,0)
3496	^9002313.9 102^1^1^31 01101
3497	"DATA",900 2313.91,15 5,20,1,0)
3498	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
3499	"DATA",900 2313.91,15 6,0)
3500	498.08^^AU TH REP CIT Y ADDRESS^ A/N^^^^20^ A/N
3501	"DATA",900 2313.91,15 6,5)
3502	PH^20
3503	"DATA",900 2313.91,15 6,10,0)
3504	^9002313.9 101^1^1^30 40223
3505	"DATA",900 2313.91,15 6,10,1,0)
3506	S BPS("X") =""
3507	"DATA",900 2313.91,15 6,20,0)
3508	^9002313.9 102^1^1^31 01101
3509	"DATA",900 2313.91,15 6,20,1,0)
3510	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
3511	"DATA",900 2313.91,15 7,0)
3512	498.09^^AU THORIZED R EP STATE/P ROV ADDR^A /N^^^^2^A/ N
3513	"DATA",900 2313.91,15 7,5)
3514	PJ^2
3515	"DATA",900 2313.91,15 7,10,0)
3516	^9002313.9 101^1^1^31 01206^
3517	"DATA",900 2313.91,15 7,10,1,0)
3518	S BPS("X") =""
3519	"DATA",900 2313.91,15 7,20,0)
3520	^9002313.9 102^1^1^31 01206^
3521	"DATA",900 2313.91,15 7,20,1,0)
3522	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
3523	"DATA",900 2313.91,15 8,0)
3524	498.11^^AU THORIZED R EP ZIP/POS TAL ZONE^A /N^^^^15^A /N
3525	"DATA",900 2313.91,15 8,1)
3526	AUTHORIZED REPRESENT ATIVE ZIP/ POSTAL ZON E
3527	"DATA",900 2313.91,15 8,5)
3528	PK^15
3529	"DATA",900 2313.91,15 8,10,0)
3530	^9002313.9 101^1^1^30 40223
3531	"DATA",900 2313.91,15 8,10,1,0)
3532	S BPS("X") =""
3533	"DATA",900 2313.91,15 8,20,0)
3534	^9002313.9 102^1^1^31 01101
3535	"DATA",900 2313.91,15 8,20,1,0)
3536	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
3537	"DATA",900 2313.91,15 9,0)
3538	498.12^^PR ESCRIBER T ELEPHONE N UMBER^N^^^ ^10^N
3539	"DATA",900 2313.91,15 9,5)
3540	PM^10
3541	"DATA",900 2313.91,15 9,10,0)
3542	^9002313.9 101^1^1^30 50802
3543	"DATA",900 2313.91,15 9,10,1,0)
3544	S BPS("X") =$TR($G(BP S("RX",BPS (9002313.0 201),"Pres criber Pho ne #")),"# () -_*.@")
3545	"DATA",900 2313.91,15 9,20,0)
3546	^9002313.9 102^1^1^31 01101
3547	"DATA",900 2313.91,15 9,20,1,0)
3548	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
3549	"DATA",900 2313.91,15 9,25,0)
3550	^9002313.9 104^1^1^30 30722^^
3551	"DATA",900 2313.91,15 9,25,1,0)
3552	S BPS("X") =$$NFF^BPS ECFM(BPS(" X"),10)
3553	"DATA",900 2313.91,15 9,30,0)
3554	^9002313.9 103^1^1^30 30722^^
3555	"DATA",900 2313.91,15 9,30,1,0)
3556	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 98),U,12)= BPS("X")
3557	"DATA",900 2313.91,16 0,0)
3558	498.13^^PR IOR AUTH S UPPORTING DOCUMENT^A /N^^^^500^ A/N
3559	"DATA",900 2313.91,16 0,5)
3560	PP^200
3561	"DATA",900 2313.91,16 0,10,0)
3562	^9002313.9 101^1^1^30 40223
3563	"DATA",900 2313.91,16 0,10,1,0)
3564	S BPS("X") =""
3565	"DATA",900 2313.91,16 0,20,0)
3566	^9002313.9 102^1^1^31 01101
3567	"DATA",900 2313.91,16 0,20,1,0)
3568	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),5 00)
3569	"DATA",900 2313.91,16 1,0)
3570	498.14^^PR IOR AUTH N UMBER-ASSI GNED^N^^^^ 11^N
3571	"DATA",900 2313.91,16 1,5)
3572	PY^8
3573	"DATA",900 2313.91,16 1,10,0)
3574	^9002313.9 101^1^1^30 40223
3575	"DATA",900 2313.91,16 1,10,1,0)
3576	S BPS("X") =""
3577	"DATA",900 2313.91,16 1,20,0)
3578	^9002313.9 102^1^1^31 01101
3579	"DATA",900 2313.91,16 1,20,1,0)
3580	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),11 )
3581	"DATA",900 2313.91,16 2,0)
3582	498.52^^PR IOR AUTH E FFECTIVE D ATE^A/N^^^ ^8^N
3583	"DATA",900 2313.91,16 2,5)
3584	PS^8
3585	"DATA",900 2313.91,16 2,10,0)
3586	^9002313.9 101^1^1^30 40223
3587	"DATA",900 2313.91,16 2,10,1,0)
3588	S BPS("X") =""
3589	"DATA",900 2313.91,16 2,20,0)
3590	^9002313.9 102^1^1^31 01101
3591	"DATA",900 2313.91,16 2,20,1,0)
3592	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
3593	"DATA",900 2313.91,16 3,0)
3594	498.53^^PR IOR AUTH E XPIRATION DATE^A/N^^ ^^8^N
3595	"DATA",900 2313.91,16 3,5)
3596	PT^8
3597	"DATA",900 2313.91,16 3,10,0)
3598	^9002313.9 101^1^1^30 40223
3599	"DATA",900 2313.91,16 3,10,1,0)
3600	S BPS("X") =""
3601	"DATA",900 2313.91,16 3,20,0)
3602	^9002313.9 102^1^1^31 01101
3603	"DATA",900 2313.91,16 3,20,1,0)
3604	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
3605	"DATA",900 2313.91,16 4,0)
3606	498.54^^PR IOR AUTH N O REFILLS AUTH^N^^^^ 2^N
3607	"DATA",900 2313.91,16 4,5)
3608	PW^8
3609	"DATA",900 2313.91,16 4,10,0)
3610	^9002313.9 101^1^1^30 40223
3611	"DATA",900 2313.91,16 4,10,1,0)
3612	S BPS("X") =""
3613	"DATA",900 2313.91,16 4,20,0)
3614	^9002313.9 102^1^1^31 01101
3615	"DATA",900 2313.91,16 4,20,1,0)
3616	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
3617	"DATA",900 2313.91,16 5,0)
3618	498.55^^PR IOR AUTH Q TY ACCUMUL ATED^N^^^^ 10^N
3619	"DATA",900 2313.91,16 5,5)
3620	PX^8
3621	"DATA",900 2313.91,16 5,10,0)
3622	^9002313.9 101^1^1^30 40223
3623	"DATA",900 2313.91,16 5,10,1,0)
3624	S BPS("X") =""
3625	"DATA",900 2313.91,16 5,20,0)
3626	^9002313.9 102^1^1^31 01101
3627	"DATA",900 2313.91,16 5,20,1,0)
3628	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
3629	"DATA",900 2313.91,16 6,0)
3630	498.57^^PR IOR AUTHOR IZATION QU ANTITY^A/N ^^^^10^N
3631	"DATA",900 2313.91,16 6,5)
3632	RA^3
3633	"DATA",900 2313.91,16 6,10,0)
3634	^9002313.9 101^1^1^30 40223
3635	"DATA",900 2313.91,16 6,10,1,0)
3636	S BPS("X") =""
3637	"DATA",900 2313.91,16 6,20,0)
3638	^9002313.9 102^1^1^31 01101
3639	"DATA",900 2313.91,16 6,20,1,0)
3640	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
3641	"DATA",900 2313.91,16 7,0)
3642	498.58^^PR IOR AUTH D OLLARS AUT HORIZED^N^ ^^^8^D
3643	"DATA",900 2313.91,16 7,5)
3644	RB^8
3645	"DATA",900 2313.91,16 7,10,0)
3646	^9002313.9 101^1^1^30 40223
3647	"DATA",900 2313.91,16 7,10,1,0)
3648	S BPS("X") =""
3649	"DATA",900 2313.91,16 7,20,0)
3650	^9002313.9 102^1^1^31 01101
3651	"DATA",900 2313.91,16 7,20,1,0)
3652	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3653	"DATA",900 2313.91,16 8,0)
3654	498.59^^AU TH REP CIT Y ADDRESS^ A/N^^^^20^ A/N
3655	"DATA",900 2313.91,16 8,5)
3656	PH^20
3657	"DATA",900 2313.91,16 8,10,0)
3658	^9002313.9 101^1^1^30 30512
3659	"DATA",900 2313.91,16 8,10,1,0)
3660	S BPS("X") =""
3661	"DATA",900 2313.91,16 8,20,0)
3662	^9002313.9 102^1^1^31 01101
3663	"DATA",900 2313.91,16 8,20,1,0)
3664	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
3665	"DATA",900 2313.91,16 9,0)
3666	501^^HEADE R RESPONSE STATUS^A/ N^^^^1^A/N
3667	"DATA",900 2313.91,16 9,5)
3668	F1^1
3669	"DATA",900 2313.91,16 9,10,0)
3670	^9002313.9 101^1^1^31 01115^
3671	"DATA",900 2313.91,16 9,10,1,0)
3672	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3673	"DATA",900 2313.91,16 9,25,0)
3674	^9002313.9 104^1^1^30 40202^^^
3675	"DATA",900 2313.91,16 9,25,1,0)
3676	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
3677	"DATA",900 2313.91,16 9,30,0)
3678	^9002313.9 103^1^1^30 40202^^^
3679	"DATA",900 2313.91,16 9,30,1,0)
3680	S $P(^BPSR (BPS(90023 13.02),500 ),U,1)=BPS ("X")
3681	"DATA",900 2313.91,17 0,0)
3682	503^^AUTHO RIZATION N UMBER^A/N^ ^^^20^A/N
3683	"DATA",900 2313.91,17 0,5)
3684	F3^20
3685	"DATA",900 2313.91,17 0,10,0)
3686	^9002313.9 101^1^1^31 01115^
3687	"DATA",900 2313.91,17 0,10,1,0)
3688	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3689	"DATA",900 2313.91,17 0,30,0)
3690	^^1^1^3031 205^
3691	"DATA",900 2313.91,17 0,30,1,0)
3692	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,3)= BPS("X")
3693	"DATA",900 2313.91,17 1,0)
3694	504^^MESSA GE^A/N^^^^ 200^A/N
3695	"DATA",900 2313.91,17 1,5)
3696	F4^200
3697	"DATA",900 2313.91,17 1,10,0)
3698	^9002313.9 101^1^1^31 01115^
3699	"DATA",900 2313.91,17 1,10,1,0)
3700	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3701	"DATA",900 2313.91,17 1,25,0)
3702	^^1^1^3031 211^
3703	"DATA",900 2313.91,17 1,25,1,0)
3704	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 00)
3705	"DATA",900 2313.91,17 1,30,0)
3706	^^1^1^3031 211^
3707	"DATA",900 2313.91,17 1,30,1,0)
3708	S $P(^BPSR (BPS(90023 13.02),504 ),U,1)=BPS ("X")
3709	"DATA",900 2313.91,17 2,0)
3710	505^^PATIE NT PAY AMO UNT^A/N^^^ ^8^D
3711	"DATA",900 2313.91,17 2,5)
3712	F5^8
3713	"DATA",900 2313.91,17 2,10,0)
3714	^9002313.9 101^1^1^31 01115^
3715	"DATA",900 2313.91,17 2,10,1,0)
3716	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3717	"DATA",900 2313.91,17 2,25,0)
3718	^9002313.9 104^1^1^30 31212^^
3719	"DATA",900 2313.91,17 2,25,1,0)
3720	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3721	"DATA",900 2313.91,17 2,30,0)
3722	^9002313.9 103^1^1^30 31212^^
3723	"DATA",900 2313.91,17 2,30,1,0)
3724	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,5)= S BPS("X")
3725	"DATA",900 2313.91,17 3,0)
3726	506^^INGRE DIENT COST PAID^A/N^ ^^^8^D
3727	"DATA",900 2313.91,17 3,5)
3728	F6^8
3729	"DATA",900 2313.91,17 3,10,0)
3730	^9002313.9 101^1^1^31 01115^
3731	"DATA",900 2313.91,17 3,10,1,0)
3732	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3733	"DATA",900 2313.91,17 3,25,0)
3734	^9002313.9 104^1^1^30 31211^^
3735	"DATA",900 2313.91,17 3,25,1,0)
3736	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3737	"DATA",900 2313.91,17 3,30,0)
3738	^9002313.9 103^1^1^30 31211^^
3739	"DATA",900 2313.91,17 3,30,1,0)
3740	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,6)= BPS("X")
3741	"DATA",900 2313.91,17 4,0)
3742	507^^DISPE NSING FEE PAID^A/N^^ ^^8^D
3743	"DATA",900 2313.91,17 4,5)
3744	F7^8
3745	"DATA",900 2313.91,17 4,10,0)
3746	^9002313.9 101^1^1^31 01115^
3747	"DATA",900 2313.91,17 4,10,1,0)
3748	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3749	"DATA",900 2313.91,17 4,25,0)
3750	^9002313.9 104^1^1^30 31210^^^
3751	"DATA",900 2313.91,17 4,25,1,0)
3752	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3753	"DATA",900 2313.91,17 4,30,0)
3754	^9002313.9 103^1^1^30 31210^^^
3755	"DATA",900 2313.91,17 4,30,1,0)
3756	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,7)= BPS("X")
3757	"DATA",900 2313.91,17 5,0)
3758	509^^TOTAL AMOUNT PA ID^A/N^^^^ 8^D
3759	"DATA",900 2313.91,17 5,5)
3760	F9^8
3761	"DATA",900 2313.91,17 5,10,0)
3762	^9002313.9 101^1^1^31 01115^^
3763	"DATA",900 2313.91,17 5,10,1,0)
3764	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3765	"DATA",900 2313.91,17 5,25,0)
3766	^9002313.9 104^1^1^30 31217^^
3767	"DATA",900 2313.91,17 5,25,1,0)
3768	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3769	"DATA",900 2313.91,17 5,30,0)
3770	^9002313.9 103^1^1^30 31217^^
3771	"DATA",900 2313.91,17 5,30,1,0)
3772	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,9)
3773	"DATA",900 2313.91,17 6,0)
3774	510^^REJEC T COUNT^N^ ^^^2^N
3775	"DATA",900 2313.91,17 6,5)
3776	FA^2
3777	"DATA",900 2313.91,17 6,10,0)
3778	^9002313.9 101^1^1^31 01115^^
3779	"DATA",900 2313.91,17 6,10,1,0)
3780	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3781	"DATA",900 2313.91,17 6,25,0)
3782	^^1^1^3031 217^
3783	"DATA",900 2313.91,17 6,25,1,0)
3784	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
3785	"DATA",900 2313.91,17 6,30,0)
3786	^^1^1^3031 217^
3787	"DATA",900 2313.91,17 6,30,1,0)
3788	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,10) =BPS("X")
3789	"DATA",900 2313.91,17 7,0)
3790	511^^REJEC T CODE^A/N ^^^^3^A/N
3791	"DATA",900 2313.91,17 7,5)
3792	FB^3
3793	"DATA",900 2313.91,17 7,10,0)
3794	^9002313.9 101^1^1^31 01115^^
3795	"DATA",900 2313.91,17 7,10,1,0)
3796	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3797	"DATA",900 2313.91,17 7,25,0)
3798	^9002313.9 104^1^1^30 31217^^
3799	"DATA",900 2313.91,17 7,25,1,0)
3800	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
3801	"DATA",900 2313.91,17 7,30,0)
3802	^9002313.9 103^1^1^30 31217^^
3803	"DATA",900 2313.91,17 7,30,1,0)
3804	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 511,DUR,0) ,U,1)
3805	"DATA",900 2313.91,17 8,0)
3806	512^^ACCUM ULATED DED UCTIBLE AM OUNT^A/N^^ ^^8^D
3807	"DATA",900 2313.91,17 8,5)
3808	FC^8
3809	"DATA",900 2313.91,17 8,10,0)
3810	^9002313.9 101^1^1^31 01115^
3811	"DATA",900 2313.91,17 8,10,1,0)
3812	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3813	"DATA",900 2313.91,17 8,25,0)
3814	^9002313.9 104^1^1^30 31210^^^^
3815	"DATA",900 2313.91,17 8,25,1,0)
3816	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 )
3817	"DATA",900 2313.91,17 8,30,0)
3818	^9002313.9 103^1^1^30 31210^^^^
3819	"DATA",900 2313.91,17 8,30,1,0)
3820	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),"^",1 0)=BPS("X" )
3821	"DATA",900 2313.91,17 9,0)
3822	513^^REMAI NING DEDUC TIBLE AMOU NT^A/N^^^^ 8^D
3823	"DATA",900 2313.91,17 9,5)
3824	FD^8
3825	"DATA",900 2313.91,17 9,10,0)
3826	^9002313.9 101^1^1^31 01115^
3827	"DATA",900 2313.91,17 9,10,1,0)
3828	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3829	"DATA",900 2313.91,17 9,25,0)
3830	^9002313.9 104^1^1^30 31217^^
3831	"DATA",900 2313.91,17 9,25,1,0)
3832	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3833	"DATA",900 2313.91,17 9,30,0)
3834	^9002313.9 103^1^1^30 31217^^
3835	"DATA",900 2313.91,17 9,30,1,0)
3836	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,13) =BPS("X")
3837	"DATA",900 2313.91,18 0,0)
3838	514^^REMAI NING BENEF IT AMOUNT^ A/N^^^^8^D
3839	"DATA",900 2313.91,18 0,5)
3840	FE^8
3841	"DATA",900 2313.91,18 0,10,0)
3842	^9002313.9 101^1^1^31 01115^
3843	"DATA",900 2313.91,18 0,10,1,0)
3844	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3845	"DATA",900 2313.91,18 0,25,0)
3846	^9002313.9 104^1^1^30 31217^^^
3847	"DATA",900 2313.91,18 0,25,1,0)
3848	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3849	"DATA",900 2313.91,18 0,30,0)
3850	^9002313.9 103^1^1^30 31217^^^
3851	"DATA",900 2313.91,18 0,30,1,0)
3852	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,14)
3853	"DATA",900 2313.91,18 2,0)
3854	517^^AMT A PPLIED TO PERIODIC D EDUCT^D^^^ ^8^D
3855	"DATA",900 2313.91,18 2,5)
3856	FH^8
3857	"DATA",900 2313.91,18 2,10,0)
3858	^9002313.9 101^1^1^31 01115^
3859	"DATA",900 2313.91,18 2,10,1,0)
3860	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3861	"DATA",900 2313.91,18 2,25,0)
3862	^9002313.9 104^1^1^30 31205^^^
3863	"DATA",900 2313.91,18 2,25,1,0)
3864	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3865	"DATA",900 2313.91,18 2,30,0)
3866	^9002313.9 103^1^1^30 31205^^
3867	"DATA",900 2313.91,18 2,30,1,0)
3868	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),"^",1 7)=BPS("X" )
3869	"DATA",900 2313.91,18 3,0)
3870	518^^AMOUN T OF COPAY ^D^^^^8^D
3871	"DATA",900 2313.91,18 3,5)
3872	FI^8
3873	"DATA",900 2313.91,18 3,10,0)
3874	^9002313.9 101^1^1^31 01115^
3875	"DATA",900 2313.91,18 3,10,1,0)
3876	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3877	"DATA",900 2313.91,18 3,25,0)
3878	^^1^1^3031 205^
3879	"DATA",900 2313.91,18 3,25,1,0)
3880	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3881	"DATA",900 2313.91,18 3,30,0)
3882	^^1^1^3031 205^
3883	"DATA",900 2313.91,18 3,30,1,0)
3884	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),"^",1 8)=BPS("X" )
3885	"DATA",900 2313.91,18 4,0)
3886	519^^AMT A TTRIBUTED TO PRODUCT SEL^D^^^^ 8^D
3887	"DATA",900 2313.91,18 4,5)
3888	FJ^8
3889	"DATA",900 2313.91,18 4,10,0)
3890	^9002313.9 101^1^1^31 01115^
3891	"DATA",900 2313.91,18 4,10,1,0)
3892	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3893	"DATA",900 2313.91,18 4,25,0)
3894	^^1^1^3031 205^
3895	"DATA",900 2313.91,18 4,25,1,0)
3896	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3897	"DATA",900 2313.91,18 4,30,0)
3898	^^1^1^3031 205^
3899	"DATA",900 2313.91,18 4,30,1,0)
3900	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,19) =BPS("X")
3901	"DATA",900 2313.91,18 5,0)
3902	520^^AMOUN T EXCEEDIN G PERIODIC MAX^D^^^^ 8^D
3903	"DATA",900 2313.91,18 5,5)
3904	FK^8
3905	"DATA",900 2313.91,18 5,10,0)
3906	^9002313.9 101^1^1^31 01115^
3907	"DATA",900 2313.91,18 5,10,1,0)
3908	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3909	"DATA",900 2313.91,18 5,25,0)
3910	^^1^1^3031 205^
3911	"DATA",900 2313.91,18 5,25,1,0)
3912	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3913	"DATA",900 2313.91,18 5,30,0)
3914	^^1^1^3031 205^
3915	"DATA",900 2313.91,18 5,30,1,0)
3916	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,20) =BPS("X")
3917	"DATA",900 2313.91,18 6,0)
3918	521^^INCEN TIVE AMOUN T PAID^A/N ^^^^8^D
3919	"DATA",900 2313.91,18 6,5)
3920	FL^8
3921	"DATA",900 2313.91,18 6,10,0)
3922	^9002313.9 101^1^1^31 01115^
3923	"DATA",900 2313.91,18 6,10,1,0)
3924	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3925	"DATA",900 2313.91,18 6,25,0)
3926	^^1^1^3031 210^
3927	"DATA",900 2313.91,18 6,25,1,0)
3928	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3929	"DATA",900 2313.91,18 6,30,0)
3930	^^1^1^3031 210^
3931	"DATA",900 2313.91,18 6,30,1,0)
3932	$P(^BPSR(B PS(9002313 .02),1000, BPS(900231 3.0201),50 0),U,21)=B PS("X")
3933	"DATA",900 2313.91,18 7,0)
3934	522^^BASIS OF REIMB DETERMINAT ION^N^^^^2 ^N
3935	"DATA",900 2313.91,18 7,5)
3936	FM^2
3937	"DATA",900 2313.91,18 7,10,0)
3938	^9002313.9 101^1^1^31 01115^
3939	"DATA",900 2313.91,18 7,10,1,0)
3940	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3941	"DATA",900 2313.91,18 7,25,0)
3942	^^1^1^3031 205^
3943	"DATA",900 2313.91,18 7,25,1,0)
3944	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
3945	"DATA",900 2313.91,18 7,30,0)
3946	^^1^1^3031 205^
3947	"DATA",900 2313.91,18 7,30,1,0)
3948	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),U,22) =BPS("X")
3949	"DATA",900 2313.91,18 8,0)
3950	523^^AMOUN T ATTRIBUT ED TO SALE S TAX^D^^^ ^8^D
3951	"DATA",900 2313.91,18 8,5)
3952	FN^8
3953	"DATA",900 2313.91,18 8,10,0)
3954	^9002313.9 101^1^1^31 01115^
3955	"DATA",900 2313.91,18 8,10,1,0)
3956	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3957	"DATA",900 2313.91,18 8,25,0)
3958	^^1^1^3031 205^
3959	"DATA",900 2313.91,18 8,25,1,0)
3960	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
3961	"DATA",900 2313.91,18 8,30,0)
3962	^^1^1^3031 205^
3963	"DATA",900 2313.91,18 8,30,1,0)
3964	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 500),"^",2 3)=BPS("X" )
3965	"DATA",900 2313.91,18 9,0)
3966	524^^PLAN ID^A/N^^^^ 8^A/N
3967	"DATA",900 2313.91,18 9,5)
3968	FO^8
3969	"DATA",900 2313.91,18 9,10,0)
3970	^^1^1^3110 301^
3971	"DATA",900 2313.91,18 9,10,1,0)
3972	S BPS("X") =$G(BPS("I nsurer","P lan ID"))
3973	"DATA",900 2313.91,18 9,20,0)
3974	^9002313.9 102^1^1^31 01101
3975	"DATA",900 2313.91,18 9,20,1,0)
3976	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 )
3977	"DATA",900 2313.91,18 9,25,0)
3978	^9002313.9 104^1^1^30 61122^
3979	"DATA",900 2313.91,18 9,25,1,0)
3980	S BPS("X") =$$ANFF^BP SECFM(BPS( "X"),8)
3981	"DATA",900 2313.91,18 9,30,0)
3982	^9002313.9 103^1^1^30 30825^^^^
3983	"DATA",900 2313.91,18 9,30,1,0)
3984	S $P(^BPSC (BPS(90023 13.02),520 ),U,4)=BPS ("X")
3985	"DATA",900 2313.91,19 1,0)
3986	526^^ADDIT IONAL MESS AGE INFORM ATION^A/N^ ^^^40^A/N
3987	"DATA",900 2313.91,19 1,5)
3988	FQ^200
3989	"DATA",900 2313.91,19 1,10,0)
3990	^9002313.9 101^1^1^31 01115^
3991	"DATA",900 2313.91,19 1,10,1,0)
3992	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
3993	"DATA",900 2313.91,19 1,25,0)
3994	^9002313.9 104^1^1^30 31210^^^^
3995	"DATA",900 2313.91,19 1,25,1,0)
3996	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 00)
3997	"DATA",900 2313.91,19 1,30,0)
3998	^9002313.9 103^1^1^30 31210^^^^
3999	"DATA",900 2313.91,19 1,30,1,0)
4000	S ^BPSR(BP S(9002313. 02),1000,B PS(9002313 .0201),526 )=BPS("X")
4001	"DATA",900 2313.91,19 2,0)
4002	528^^CLINI CAL SIGNIF ICANCE COD E^A/N^^^^1 ^A/N
4003	"DATA",900 2313.91,19 2,5)
4004	FS^1
4005	"DATA",900 2313.91,19 2,10,0)
4006	^9002313.9 101^1^1^31 01115^
4007	"DATA",900 2313.91,19 2,10,1,0)
4008	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4009	"DATA",900 2313.91,19 2,25,0)
4010	^9002313.9 104^1^1^30 31210^^^^
4011	"DATA",900 2313.91,19 2,25,1,0)
4012	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
4013	"DATA",900 2313.91,19 2,30,0)
4014	^9002313.9 103^1^1^30 31210^^^^
4015	"DATA",900 2313.91,19 2,30,1,0)
4016	S ^BPSR(BP S(9002313. 02),1000,B PS(9002313 .0201),525 )=$G(BPS(" X"))
4017	"DATA",900 2313.91,19 3,0)
4018	529^^OTHER PHARMACY INDICATOR^ A/N^^^^1^N
4019	"DATA",900 2313.91,19 3,5)
4020	FT^1
4021	"DATA",900 2313.91,19 3,10,0)
4022	^9002313.9 101^1^1^30 31212
4023	"DATA",900 2313.91,19 3,10,1,0)
4024	S BPS("X") =""
4025	"DATA",900 2313.91,19 3,20,0)
4026	^9002313.9 102^1^1^31 01101
4027	"DATA",900 2313.91,19 3,20,1,0)
4028	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
4029	"DATA",900 2313.91,19 4,0)
4030	530^^PREVI OUS DATE O F FILL^A/N ^^^^8^N
4031	"DATA",900 2313.91,19 4,5)
4032	FU^8
4033	"DATA",900 2313.91,19 4,10,0)
4034	^9002313.9 101^1^1^31 01115^
4035	"DATA",900 2313.91,19 4,10,1,0)
4036	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4037	"DATA",900 2313.91,19 4,25,0)
4038	^^1^1^3031 216^
4039	"DATA",900 2313.91,19 4,25,1,0)
4040	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X"))
4041	"DATA",900 2313.91,19 4,30,0)
4042	^^1^1^3031 216^
4043	"DATA",900 2313.91,19 4,30,1,0)
4044	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 567.01,DUR ,0),U,5)=B PS("X")
4045	"DATA",900 2313.91,19 5,0)
4046	531^^QUANT ITY OF PRE VIOUS FILL ^N^^^^10^N
4047	"DATA",900 2313.91,19 5,5)
4048	FV^8
4049	"DATA",900 2313.91,19 5,10,0)
4050	^9002313.9 101^1^1^31 01115^
4051	"DATA",900 2313.91,19 5,10,1,0)
4052	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4053	"DATA",900 2313.91,19 5,25,0)
4054	^9002313.9 104^1^1^30 31217^^
4055	"DATA",900 2313.91,19 5,25,1,0)
4056	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
4057	"DATA",900 2313.91,19 5,30,0)
4058	^9002313.9 103^1^1^30 31217^^
4059	"DATA",900 2313.91,19 5,30,1,0)
4060	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 567.01,DUR ,0),U,6)=B PS("X")
4061	"DATA",900 2313.91,19 6,0)
4062	532^^DATAB ASE INDICA TOR^A/N^^^ ^1^A/N
4063	"DATA",900 2313.91,19 6,5)
4064	FW^1
4065	"DATA",900 2313.91,19 6,10,0)
4066	^9002313.9 101^1^1^31 01115^
4067	"DATA",900 2313.91,19 6,10,1,0)
4068	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4069	"DATA",900 2313.91,19 6,25,0)
4070	^9002313.9 104^1^1^30 31210^^^
4071	"DATA",900 2313.91,19 6,25,1,0)
4072	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
4073	"DATA",900 2313.91,19 6,30,0)
4074	^9002313.9 103^1^1^30 31210^^^
4075	"DATA",900 2313.91,19 6,30,1,0)
4076	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 567.01,BPS (9002313.0 20101),0), U,7)=BPS(" X")
4077	"DATA",900 2313.91,19 7,0)
4078	533^^OTHER PRESCRIBE R INDICATO R^A/N^^^^1 ^N
4079	"DATA",900 2313.91,19 7,5)
4080	FX^1
4081	"DATA",900 2313.91,19 7,10,0)
4082	^9002313.9 101^1^1^31 01115^
4083	"DATA",900 2313.91,19 7,10,1,0)
4084	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4085	"DATA",900 2313.91,19 7,25,0)
4086	^^1^1^3031 212^
4087	"DATA",900 2313.91,19 7,25,1,0)
4088	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
4089	"DATA",900 2313.91,19 7,30,0)
4090	^^1^1^3031 212^
4091	"DATA",900 2313.91,19 7,30,1,0)
4092	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 567.01,DUR ,0),U,8)=B PS("X")
4093	"DATA",900 2313.91,19 9,0)
4094	544^^DUR F REE TEXT M ESSAGE^A/N ^^^^30^A/N
4095	"DATA",900 2313.91,19 9,5)
4096	FY^30
4097	"DATA",900 2313.91,19 9,10,0)
4098	^9002313.9 101^1^1^31 01116^
4099	"DATA",900 2313.91,19 9,10,1,0)
4100	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4101	"DATA",900 2313.91,19 9,25,0)
4102	^9002313.9 104^1^1^30 31210^^
4103	"DATA",900 2313.91,19 9,25,1,0)
4104	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
4105	"DATA",900 2313.91,19 9,30,0)
4106	^9002313.9 103^1^1^30 31210^^
4107	"DATA",900 2313.91,19 9,30,1,0)
4108	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 567.01,DUR ,0),U,9)=B PS("X")
4109	"DATA",900 2313.91,20 0,0)
4110	545^^NETWO RK REIMBUR SEMENT ID^ A/N^^^^10^ A/N
4111	"DATA",900 2313.91,20 0,5)
4112	2F^10
4113	"DATA",900 2313.91,20 0,10,0)
4114	^9002313.9 101^1^1^30 40223
4115	"DATA",900 2313.91,20 0,10,1,0)
4116	S BPS("X") =""
4117	"DATA",900 2313.91,20 0,20,0)
4118	^9002313.9 102^1^1^31 01101
4119	"DATA",900 2313.91,20 0,20,1,0)
4120	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
4121	"DATA",900 2313.91,20 1,0)
4122	546^^REJEC TED FLD OC CURRENCE I NDCTR^A/N^ ^^^2^N
4123	"DATA",900 2313.91,20 1,5)
4124	4F^2
4125	"DATA",900 2313.91,20 1,10,0)
4126	^9002313.9 101^1^1^31 01115^
4127	"DATA",900 2313.91,20 1,10,1,0)
4128	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4129	"DATA",900 2313.91,20 1,25,0)
4130	^9002313.9 104^1^1^30 31217^^
4131	"DATA",900 2313.91,20 1,25,1,0)
4132	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4133	"DATA",900 2313.91,20 1,30,0)
4134	^9002313.9 103^1^1^30 31217^^
4135	"DATA",900 2313.91,20 1,30,1,0)
4136	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 511,DUR,0) ,U,2)=BPS( "X")
4137	"DATA",900 2313.91,20 2,0)
4138	547^^APPRO VED MESSAG E CODE COU NT^A/N^^^^ 1^N
4139	"DATA",900 2313.91,20 2,5)
4140	5F^1
4141	"DATA",900 2313.91,20 2,10,0)
4142	^9002313.9 101^1^1^31 01115^
4143	"DATA",900 2313.91,20 2,10,1,0)
4144	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4145	"DATA",900 2313.91,20 2,25,0)
4146	^^1^1^3031 205^
4147	"DATA",900 2313.91,20 2,25,1,0)
4148	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
4149	"DATA",900 2313.91,20 2,30,0)
4150	^^1^1^3031 205^
4151	"DATA",900 2313.91,20 2,30,1,0)
4152	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 540),U,7)= BPS("X")
4153	"DATA",900 2313.91,20 3,0)
4154	548^^APPRO VED MESSAG E CODE^A/N ^^^^3^A/N
4155	"DATA",900 2313.91,20 3,5)
4156	6F^3
4157	"DATA",900 2313.91,20 3,10,0)
4158	^9002313.9 101^1^1^31 01115^
4159	"DATA",900 2313.91,20 3,10,1,0)
4160	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4161	"DATA",900 2313.91,20 3,25,0)
4162	^9002313.9 104^1^1^30 31210^^^
4163	"DATA",900 2313.91,20 3,25,1,0)
4164	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
4165	"DATA",900 2313.91,20 3,30,0)
4166	^9002313.9 103^1^1^30 31210^^^
4167	"DATA",900 2313.91,20 3,30,1,0)
4168	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 548,0),B,4 )=BPS("X")
4169	"DATA",900 2313.91,20 4,0)
4170	549^^HELP DESK PHONE NUMBER QU AL^A/N^^^^ 2^A/N
4171	"DATA",900 2313.91,20 4,1)
4172	HELP DESK TELEPHONE NUMBER QUA LIFER
4173	"DATA",900 2313.91,20 4,5)
4174	7F^2
4175	"DATA",900 2313.91,20 4,10,0)
4176	^9002313.9 101^1^1^31 01115^
4177	"DATA",900 2313.91,20 4,10,1,0)
4178	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4179	"DATA",900 2313.91,20 4,25,0)
4180	^^1^1^3031 210^
4181	"DATA",900 2313.91,20 4,25,1,0)
4182	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4183	"DATA",900 2313.91,20 4,30,0)
4184	^^1^1^3031 210^
4185	"DATA",900 2313.91,20 4,30,1,0)
4186	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 540),U,9)= BPS("X")
4187	"DATA",900 2313.91,20 5,0)
4188	550^^HELP DESK TELEP HONE NUMBE R^A/N^^^^1 8^A/N
4189	"DATA",900 2313.91,20 5,5)
4190	8F^18
4191	"DATA",900 2313.91,20 5,10,0)
4192	^9002313.9 101^1^1^31 01115^
4193	"DATA",900 2313.91,20 5,10,1,0)
4194	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4195	"DATA",900 2313.91,20 5,25,0)
4196	^9002313.9 104^1^1^30 31210^^
4197	"DATA",900 2313.91,20 5,25,1,0)
4198	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 8)
4199	"DATA",900 2313.91,20 5,30,0)
4200	^9002313.9 103^1^1^30 31210^^
4201	"DATA",900 2313.91,20 5,30,1,0)
4202	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 540),U,10) =BPS("X")
4203	"DATA",900 2313.91,20 6,0)
4204	551^^PREFE RRED PRODU CT COUNT^A /N^^^^1^N
4205	"DATA",900 2313.91,20 6,5)
4206	9F^1
4207	"DATA",900 2313.91,20 6,10,0)
4208	^9002313.9 101^1^1^30 31216
4209	"DATA",900 2313.91,20 6,10,1,0)
4210	S BPS("X") =""
4211	"DATA",900 2313.91,20 6,20,0)
4212	^9002313.9 102^1^1^31 01101
4213	"DATA",900 2313.91,20 6,20,1,0)
4214	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
4215	"DATA",900 2313.91,20 7,0)
4216	552^^PREFE RRED PRODU CT ID QUAL IFIER^A/N^ ^^^2^A/N
4217	"DATA",900 2313.91,20 7,5)
4218	AP^2
4219	"DATA",900 2313.91,20 7,10,0)
4220	^9002313.9 101^1^1^31 01115^
4221	"DATA",900 2313.91,20 7,10,1,0)
4222	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4223	"DATA",900 2313.91,20 7,25,0)
4224	^^1^1^3031 216^
4225	"DATA",900 2313.91,20 7,25,1,0)
4226	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4227	"DATA",900 2313.91,20 7,30,0)
4228	^^1^1^3031 216^
4229	"DATA",900 2313.91,20 7,30,1,0)
4230	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 551.01,DUR ,1),U,1)=B PS("X")
4231	"DATA",900 2313.91,20 8,0)
4232	553^^PREFE RRED PRODU CT ID^A/N^ ^^^19^A/N
4233	"DATA",900 2313.91,20 8,5)
4234	AR^19
4235	"DATA",900 2313.91,20 8,10,0)
4236	^9002313.9 101^1^1^31 01115^^
4237	"DATA",900 2313.91,20 8,10,1,0)
4238	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4239	"DATA",900 2313.91,20 8,25,0)
4240	^^1^1^3031 216^
4241	"DATA",900 2313.91,20 8,25,1,0)
4242	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
4243	"DATA",900 2313.91,20 8,30,0)
4244	^^1^1^3031 216^
4245	"DATA",900 2313.91,20 8,30,1,0)
4246	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 551.01,DUR ,1),U,2)=B PS("X")
4247	"DATA",900 2313.91,20 9,0)
4248	554^^PREFE RRED PRODU CT INCENTI VE^A/N^^^^ 8^D
4249	"DATA",900 2313.91,20 9,5)
4250	AS^8
4251	"DATA",900 2313.91,20 9,10,0)
4252	^9002313.9 101^1^1^31 01115^
4253	"DATA",900 2313.91,20 9,10,1,0)
4254	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4255	"DATA",900 2313.91,20 9,25,0)
4256	^^1^1^3031 216^
4257	"DATA",900 2313.91,20 9,25,1,0)
4258	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
4259	"DATA",900 2313.91,20 9,30,0)
4260	^^1^1^3031 216^
4261	"DATA",900 2313.91,20 9,30,1,0)
4262	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 551.01,DUR ,1),U,3)=B PS("X")
4263	"DATA",900 2313.91,21 0,0)
4264	555^^PREF PRODUCT CO ST SHARE I NCNTV^A/N^ ^^^8^D
4265	"DATA",900 2313.91,21 0,5)
4266	AT^8
4267	"DATA",900 2313.91,21 0,10,0)
4268	^9002313.9 101^1^1^31 01115^
4269	"DATA",900 2313.91,21 0,10,1,0)
4270	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4271	"DATA",900 2313.91,21 0,25,0)
4272	^9002313.9 104^1^1^30 31216^^
4273	"DATA",900 2313.91,21 0,25,1,0)
4274	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
4275	"DATA",900 2313.91,21 0,30,0)
4276	^9002313.9 103^1^1^30 31216^^
4277	"DATA",900 2313.91,21 0,30,1,0)
4278	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 551.01,DUR ,1),U,4)=B PS("X")
4279	"DATA",900 2313.91,21 1,0)
4280	556^^PREFE RRED PRODU CT DESCRIP TION^A/N^^ ^^40^A/N
4281	"DATA",900 2313.91,21 1,5)
4282	AU^40
4283	"DATA",900 2313.91,21 1,10,0)
4284	^9002313.9 101^1^1^31 01115^
4285	"DATA",900 2313.91,21 1,10,1,0)
4286	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4287	"DATA",900 2313.91,21 1,25,0)
4288	^^1^1^3031 216^
4289	"DATA",900 2313.91,21 1,25,1,0)
4290	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
4291	"DATA",900 2313.91,21 1,30,0)
4292	^^1^1^3031 216^
4293	"DATA",900 2313.91,21 1,30,1,0)
4294	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 551.01,DUR ,1),U,5)=B PS("X")
4295	"DATA",900 2313.91,21 2,0)
4296	557^^TAX E XEMPT INDI CATOR^A/N^ ^^^1^A/N
4297	"DATA",900 2313.91,21 2,5)
4298	AV^1
4299	"DATA",900 2313.91,21 2,10,0)
4300	^9002313.9 101^1^1^31 01115^
4301	"DATA",900 2313.91,21 2,10,1,0)
4302	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4303	"DATA",900 2313.91,21 2,25,0)
4304	^^1^1^3031 217^
4305	"DATA",900 2313.91,21 2,25,1,0)
4306	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
4307	"DATA",900 2313.91,21 2,30,0)
4308	^^1^1^3031 217^
4309	"DATA",900 2313.91,21 2,30,1,0)
4310	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 550),U,7)
4311	"DATA",900 2313.91,21 3,0)
4312	558^^FLAT SALES TAX AMOUNT PAI D^A/N^^^^8 ^D
4313	"DATA",900 2313.91,21 3,5)
4314	AW^8
4315	"DATA",900 2313.91,21 3,10,0)
4316	^9002313.9 101^1^1^31 01115^
4317	"DATA",900 2313.91,21 3,10,1,0)
4318	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4319	"DATA",900 2313.91,21 3,25,0)
4320	^9002313.9 104^1^1^30 31210^^
4321	"DATA",900 2313.91,21 3,25,1,0)
4322	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
4323	"DATA",900 2313.91,21 3,30,0)
4324	^9002313.9 103^1^1^30 31210^^
4325	"DATA",900 2313.91,21 3,30,1,0)
4326	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 550),U,8)= BPS("X")
4327	"DATA",900 2313.91,21 4,0)
4328	559^^PERCE NTAGE SALE S TAX AMT PAID^A/N^^ ^^8^D
4329	"DATA",900 2313.91,21 4,5)
4330	AX^8
4331	"DATA",900 2313.91,21 4,10,0)
4332	^9002313.9 101^1^1^31 01115^
4333	"DATA",900 2313.91,21 4,10,1,0)
4334	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4335	"DATA",900 2313.91,21 4,25,0)
4336	^9002313.9 104^1^1^30 31212^^
4337	"DATA",900 2313.91,21 4,25,1,0)
4338	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
4339	"DATA",900 2313.91,21 4,30,0)
4340	^9002313.9 103^1^1^30 31212^^^
4341	"DATA",900 2313.91,21 4,30,1,0)
4342	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 550),U,9)= BPS("X")
4343	"DATA",900 2313.91,21 5,0)
4344	560^^PERCE NTAGE SALE S TAX RATE PAID^A/N^ ^^^7^D
4345	"DATA",900 2313.91,21 5,5)
4346	AY^8
4347	"DATA",900 2313.91,21 5,10,0)
4348	^9002313.9 101^1^1^30 40223
4349	"DATA",900 2313.91,21 5,10,1,0)
4350	S BPS("X") =""
4351	"DATA",900 2313.91,21 5,20,0)
4352	^9002313.9 102^1^1^31 01101
4353	"DATA",900 2313.91,21 5,20,1,0)
4354	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),7)
4355	"DATA",900 2313.91,21 6,0)
4356	561^^PERCE NT SALES T AX BASIS P AID^A/N^^^ ^2^A/N
4357	"DATA",900 2313.91,21 6,5)
4358	AZ^8
4359	"DATA",900 2313.91,21 6,10,0)
4360	^9002313.9 101^1^1^30 31212
4361	"DATA",900 2313.91,21 6,10,1,0)
4362	S BPS("X") =""
4363	"DATA",900 2313.91,21 6,20,0)
4364	^9002313.9 102^1^1^31 01101
4365	"DATA",900 2313.91,21 6,20,1,0)
4366	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4367	"DATA",900 2313.91,21 7,0)
4368	562^^PROFE SSIONAL SE RVICE FEE PAID^A/N^^ ^^8^D
4369	"DATA",900 2313.91,21 7,5)
4370	J1^8
4371	"DATA",900 2313.91,21 7,10,0)
4372	^9002313.9 101^1^1^31 01115^
4373	"DATA",900 2313.91,21 7,10,1,0)
4374	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4375	"DATA",900 2313.91,21 7,25,0)
4376	^^1^1^3031 217^
4377	"DATA",900 2313.91,21 7,25,1,0)
4378	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 )
4379	"DATA",900 2313.91,21 7,30,0)
4380	^^1^1^3031 217^
4381	"DATA",900 2313.91,21 7,30,1,0)
4382	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 560),U,2)= BPS("X")
4383	"DATA",900 2313.91,21 8,0)
4384	563^^OTHER AMOUNT PA ID COUNT^N ^^^^1^N
4385	"DATA",900 2313.91,21 8,5)
4386	J2^1
4387	"DATA",900 2313.91,21 8,10,0)
4388	^9002313.9 101^1^1^31 01115^
4389	"DATA",900 2313.91,21 8,10,1,0)
4390	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4391	"DATA",900 2313.91,21 8,25,0)
4392	^^1^1^3031 212^
4393	"DATA",900 2313.91,21 8,25,1,0)
4394	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
4395	"DATA",900 2313.91,21 8,30,0)
4396	^^1^1^3031 212^
4397	"DATA",900 2313.91,21 8,30,1,0)
4398	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 563.01,DUR ,0)),U,1)
4399	"DATA",900 2313.91,21 9,0)
4400	564^^OTHER AMOUNT PA ID QUALIFI ER^A/N^^^^ 2^A/N
4401	"DATA",900 2313.91,21 9,5)
4402	J3^2
4403	"DATA",900 2313.91,21 9,10,0)
4404	^9002313.9 101^1^1^31 01115^
4405	"DATA",900 2313.91,21 9,10,1,0)
4406	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4407	"DATA",900 2313.91,21 9,25,0)
4408	^^1^1^3031 212^
4409	"DATA",900 2313.91,21 9,25,1,0)
4410	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4411	"DATA",900 2313.91,21 9,30,0)
4412	^^1^1^3031 212^
4413	"DATA",900 2313.91,21 9,30,1,0)
4414	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 563.01,DUR ,1),U,1)=B PS("X")
4415	"DATA",900 2313.91,22 0,0)
4416	565^^OTHER AMOUNT PA ID^A/N^^^^ 8^D
4417	"DATA",900 2313.91,22 0,5)
4418	J4^8
4419	"DATA",900 2313.91,22 0,10,0)
4420	^9002313.9 101^1^1^31 01115^
4421	"DATA",900 2313.91,22 0,10,1,0)
4422	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4423	"DATA",900 2313.91,22 0,25,0)
4424	^9002313.9 104^1^1^30 31212^^
4425	"DATA",900 2313.91,22 0,25,1,0)
4426	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 )
4427	"DATA",900 2313.91,22 0,30,0)
4428	^9002313.9 103^1^1^30 31212^^
4429	"DATA",900 2313.91,22 0,30,1,0)
4430	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 563.01,DUR ,1),U,2)=B PS("X")
4431	"DATA",900 2313.91,22 1,0)
4432	566^^OTHER PAYER AMO UNT RECOGN IZED^A/N^^ ^^8^D
4433	"DATA",900 2313.91,22 1,5)
4434	J5^8
4435	"DATA",900 2313.91,22 1,10,0)
4436	^9002313.9 101^1^1^31 01115^^
4437	"DATA",900 2313.91,22 1,10,1,0)
4438	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4439	"DATA",900 2313.91,22 1,25,0)
4440	^^1^1^3090 304^
4441	"DATA",900 2313.91,22 1,25,1,0)
4442	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),6)
4443	"DATA",900 2313.91,22 1,30,0)
4444	^^1^1^3090 304^
4445	"DATA",900 2313.91,22 1,30,1,0)
4446	D SET566^B PSFLD01
4447	"DATA",900 2313.91,22 2,0)
4448	567^^DUR/P PS RESPONS E CODE COU NTER^N^^^^ 1^N
4449	"DATA",900 2313.91,22 2,5)
4450	J6^1
4451	"DATA",900 2313.91,22 2,10,0)
4452	^9002313.9 101^1^1^31 01115^
4453	"DATA",900 2313.91,22 2,10,1,0)
4454	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4455	"DATA",900 2313.91,22 2,25,0)
4456	^9002313.9 104^1^1^30 31210^^
4457	"DATA",900 2313.91,22 2,25,1,0)
4458	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
4459	"DATA",900 2313.91,22 2,30,0)
4460	^9002313.9 103^1^1^30 31210^^
4461	"DATA",900 2313.91,22 2,30,1,0)
4462	S $P(^BPSR (BPS(90023 13.02),100 0,BPS(9002 313.0201), 567.01,DUR ,0),U,1)=B PS("X")
4463	"DATA",900 2313.91,22 3,0)
4464	568^^PAYER ID QUALIF IER^A/N^^^ ^2^A/N
4465	"DATA",900 2313.91,22 3,5)
4466	J7^2
4467	"DATA",900 2313.91,22 3,10,0)
4468	^9002313.9 101^1^1^31 01115^
4469	"DATA",900 2313.91,22 3,10,1,0)
4470	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4471	"DATA",900 2313.91,22 3,25,0)
4472	^^1^1^3031 212^
4473	"DATA",900 2313.91,22 3,25,1,0)
4474	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4475	"DATA",900 2313.91,22 3,30,0)
4476	^^1^1^3031 212^
4477	"DATA",900 2313.91,22 3,30,1,0)
4478	S $P(^BPSR (BPS(90023 13.02),560 ),U,8)
4479	"DATA",900 2313.91,22 4,0)
4480	569^^PAYER ID^A/N^^^ ^10^A/N
4481	"DATA",900 2313.91,22 4,5)
4482	J8^10
4483	"DATA",900 2313.91,22 4,10,0)
4484	^9002313.9 101^1^1^31 01115^
4485	"DATA",900 2313.91,22 4,10,1,0)
4486	;This is R esponse-on ly field w hich does not use th e GET FORM AT or SET code
4487	"DATA",900 2313.91,22 4,25,0)
4488	^9002313.9 104^1^1^30 31212^^
4489	"DATA",900 2313.91,22 4,25,1,0)
4490	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
4491	"DATA",900 2313.91,22 4,30,0)
4492	^9002313.9 103^1^1^30 31212^^
4493	"DATA",900 2313.91,22 4,30,1,0)
4494	S $P(^BPSR (BPS(90023 13.02),560 ),U,9)=BPS ("X")
4495	"DATA",900 2313.91,22 5,0)
4496	600^^UNIT OF MEASURE ^A/N^^^^2^ A/N
4497	"DATA",900 2313.91,22 5,5)
4498	28^2
4499	"DATA",900 2313.91,22 5,10,0)
4500	^9002313.9 101^1^1^30 70625
4501	"DATA",900 2313.91,22 5,10,1,0)
4502	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Unit of Measure"))
4503	"DATA",900 2313.91,22 5,20,0)
4504	^9002313.9 102^1^1^31 01101
4505	"DATA",900 2313.91,22 5,20,1,0)
4506	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4507	"DATA",900 2313.91,22 5,25,0)
4508	^9002313.9 104^1^1^30 70620^
4509	"DATA",900 2313.91,22 5,25,1,0)
4510	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4511	"DATA",900 2313.91,22 5,30,0)
4512	^9002313.9 103^1^1^30 70620^
4513	"DATA",900 2313.91,22 5,30,1,0)
4514	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),6 00),U,1)=" "
4515	"DATA",900 2313.91,24 0,0)
4516	478^^OTHER AMT CLAIM ED SBMTTD COUNT^N^^^ ^1^N
4517	"DATA",900 2313.91,24 0,1)
4518	OTHER AMOU NT CLAIMED SUBMITTED COUNT
4519	"DATA",900 2313.91,24 0,5)
4520	H7^1
4521	"DATA",900 2313.91,24 0,10,0)
4522	^9002313.9 101^1^1^31 01006^^^
4523	"DATA",900 2313.91,24 0,10,1,0)
4524	; fields 4 78, 479, 4 80 handled by FLD480 ^BPSOSSG ( see SET CO DE in fiel d 480)
4525	"DATA",900 2313.91,24 0,20,0)
4526	^9002313.9 102^1^1^31 01006^^^
4527	"DATA",900 2313.91,24 0,20,1,0)
4528	; fields 4 78, 479, 4 80 handled by FLD480 ^BPSOSSG ( see SET CO DE in fiel d 480)
4529	"DATA",900 2313.91,24 0,25,0)
4530	^9002313.9 104^1^1^31 01006^^
4531	"DATA",900 2313.91,24 0,25,1,0)
4532	; fields 4 78, 479, 4 80 handled by FLD480 ^BPSOSSG ( see SET CO DE in fiel d 480)
4533	"DATA",900 2313.91,24 0,30,0)
4534	^9002313.9 103^1^1^31 01006^^
4535	"DATA",900 2313.91,24 0,30,1,0)
4536	; fields 4 78, 479, 4 80 handled by FLD480 ^BPSOSSG ( see SET CO DE in fiel d 480)
4537	"DATA",900 2313.91,24 1,0)
4538	479^^OTHER AMT CLAIM ED SUBM QL FR^A/N^^^^ 2^A/N
4539	"DATA",900 2313.91,24 1,1)
4540	OTHER AMOU NT CLAIMED SUBMITTED QUALIFIER
4541	"DATA",900 2313.91,24 1,5)
4542	H8^2
4543	"DATA",900 2313.91,24 1,10,0)
4544	^9002313.9 101^1^1^31 01006^^^
4545	"DATA",900 2313.91,24 1,10,1,0)
4546	; fields 4 78, 479, 4 80 handled by FLD480 ^BPSOSSG ( see SET CO DE in fiel d 480)
4547	"DATA",900 2313.91,24 1,20,0)
4548	^9002313.9 102^1^1^31 01006^^^
4549	"DATA",900 2313.91,24 1,20,1,0)
4550	; fields 4 78, 479, 4 80 handled by FLD480 ^BPSOSSG ( see SET CO DE in fiel d 480)
4551	"DATA",900 2313.91,24 1,25,0)
4552	^9002313.9 104^1^1^31 01006^^
4553	"DATA",900 2313.91,24 1,25,1,0)
4554	; fields 4 78, 479, 4 80 handled by FLD480 ^BPSOSSG ( see SET CO DE in fiel d 480)
4555	"DATA",900 2313.91,24 1,30,0)
4556	^9002313.9 103^1^1^31 01006^^
4557	"DATA",900 2313.91,24 1,30,1,0)
4558	; fields 4 78, 479, 4 80 handled by FLD480 ^BPSOSSG ( see SET CO DE in fiel d 480)
4559	"DATA",900 2313.91,24 2,0)
4560	463^^INTER MEDIARY AU TH TYPE ID ^N^^^^2^N
4561	"DATA",900 2313.91,24 2,1)
4562	INTERMEDIA RY AUTHORI ZATION TYP E ID
4563	"DATA",900 2313.91,24 2,5)
4564	EW^2
4565	"DATA",900 2313.91,24 2,10,0)
4566	^^2^2^3110 727^
4567	"DATA",900 2313.91,24 2,10,1,0)
4568	S BPS("X") =$G(BPS("C laim",BPS( 9002313.02 01),"Inter mediary Au th Type ID "))
4569	"DATA",900 2313.91,24 2,10,2,0)
4570	S:BPS("X") ="" BPS("X ")=0
4571	"DATA",900 2313.91,24 2,20,0)
4572	^9002313.9 102^1^1^31 01101
4573	"DATA",900 2313.91,24 2,20,1,0)
4574	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
4575	"DATA",900 2313.91,24 2,25,0)
4576	^9002313.9 104^1^1^30 30823^^^^
4577	"DATA",900 2313.91,24 2,25,1,0)
4578	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
4579	"DATA",900 2313.91,24 2,30,0)
4580	^9002313.9 103^1^1^30 30823^^
4581	"DATA",900 2313.91,24 2,30,1,0)
4582	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 60),U,3)=B PS("X")
4583	"DATA",900 2313.91,26 5,0)
4584	451^^COMPO UND DISP U NIT FORM I NDCTR^N^^^ ^1^N
4585	"DATA",900 2313.91,26 5,1)
4586	COMPOUND D ISPENSING UNIT FORM INDICATOR
4587	"DATA",900 2313.91,26 5,5)
4588	EG^1
4589	"DATA",900 2313.91,26 5,10,0)
4590	^9002313.9 101^1^1^30 40224
4591	"DATA",900 2313.91,26 5,10,1,0)
4592	S BPS("X") =""
4593	"DATA",900 2313.91,26 5,20,0)
4594	^9002313.9 102^1^1^31 01101
4595	"DATA",900 2313.91,26 5,20,1,0)
4596	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
4597	"DATA",900 2313.91,26 5,25,0)
4598	^9002313.9 104^1^1^30 40224^^^^
4599	"DATA",900 2313.91,26 5,25,1,0)
4600	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
4601	"DATA",900 2313.91,26 6,0)
4602	450^^COMPO UND DOSAGE FORM DESC CODE^A/N^ ^^^15^A/N
4603	"DATA",900 2313.91,26 6,1)
4604	COMPOUND D OSAGE FORM DESCRIPTI ON CODE
4605	"DATA",900 2313.91,26 6,5)
4606	EF^15
4607	"DATA",900 2313.91,26 6,10,0)
4608	^9002313.9 101^1^1^31 01115^
4609	"DATA",900 2313.91,26 6,10,1,0)
4610	S BPS("X") =""
4611	"DATA",900 2313.91,26 6,20,0)
4612	^9002313.9 102^1^1^31 01101
4613	"DATA",900 2313.91,26 6,20,1,0)
4614	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4615	"DATA",900 2313.91,26 6,25,0)
4616	^9002313.9 104^1^1^30 40107^^^^
4617	"DATA",900 2313.91,26 6,25,1,0)
4618	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4619	"DATA",900 2313.91,26 6,30,0)
4620	^9002313.9 103^1^1^30 40107^^^^
4621	"DATA",900 2313.91,26 6,30,1,0)
4622	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 40),U,10)= BPS("X")
4623	"DATA",900 2313.91,26 7,0)
4624	490^^COMP INGRED BAS IS COST DE TERM^A/N^^ ^^2^A/N
4625	"DATA",900 2313.91,26 7,1)
4626	COMPOUND I NGREDIENT BASIS OF C OST DETERM INATION
4627	"DATA",900 2313.91,26 7,5)
4628	UE^2
4629	"DATA",900 2313.91,26 7,10,0)
4630	^9002313.9 101^1^1^30 40224
4631	"DATA",900 2313.91,26 7,10,1,0)
4632	S BPS("X") =""
4633	"DATA",900 2313.91,26 7,20,0)
4634	^9002313.9 102^1^1^31 01101
4635	"DATA",900 2313.91,26 7,20,1,0)
4636	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4637	"DATA",900 2313.91,26 7,25,0)
4638	^9002313.9 104^1^1^30 40224^^^^
4639	"DATA",900 2313.91,26 7,25,1,0)
4640	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4641	"DATA",900 2313.91,26 8,0)
4642	447^^COMPO UND INGRED IENT COMP COUNT^N^^^ ^2^N
4643	"DATA",900 2313.91,26 8,1)
4644	COMPOUND I NGREDIENT COMPONENT COUNT
4645	"DATA",900 2313.91,26 8,5)
4646	EC^2
4647	"DATA",900 2313.91,26 8,10,0)
4648	^9002313.9 101^1^1^31 01115^
4649	"DATA",900 2313.91,26 8,10,1,0)
4650	S BPS("X") =""
4651	"DATA",900 2313.91,26 8,20,0)
4652	^9002313.9 102^1^1^31 01101
4653	"DATA",900 2313.91,26 8,20,1,0)
4654	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
4655	"DATA",900 2313.91,26 8,25,0)
4656	^9002313.9 104^1^1^30 40107^^^^
4657	"DATA",900 2313.91,26 8,25,1,0)
4658	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
4659	"DATA",900 2313.91,26 8,30,0)
4660	^9002313.9 103^1^1^30 40107^^^^
4661	"DATA",900 2313.91,26 8,30,1,0)
4662	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),4 40),U,7)=B PS("X")
4663	"DATA",900 2313.91,26 9,0)
4664	449^^COMPO UND INGRED IENT DRUG COST^N^^^^ 8^D
4665	"DATA",900 2313.91,26 9,5)
4666	EE^8
4667	"DATA",900 2313.91,26 9,10,0)
4668	^9002313.9 101^1^1^30 40224
4669	"DATA",900 2313.91,26 9,10,1,0)
4670	S BPS("X") =""
4671	"DATA",900 2313.91,26 9,20,0)
4672	^9002313.9 102^1^1^31 01101
4673	"DATA",900 2313.91,26 9,20,1,0)
4674	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
4675	"DATA",900 2313.91,26 9,25,0)
4676	^9002313.9 104^1^1^30 40224^^^^
4677	"DATA",900 2313.91,26 9,25,1,0)
4678	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 )
4679	"DATA",900 2313.91,27 1,0)
4680	489^^COMPO UND PRODUC T ID^A/N^^ ^^19^A/N
4681	"DATA",900 2313.91,27 1,5)
4682	TE^19
4683	"DATA",900 2313.91,27 1,10,0)
4684	^9002313.9 101^1^1^30 40224
4685	"DATA",900 2313.91,27 1,10,1,0)
4686	S BPS("X") =""
4687	"DATA",900 2313.91,27 1,20,0)
4688	^9002313.9 102^1^1^31 01101
4689	"DATA",900 2313.91,27 1,20,1,0)
4690	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
4691	"DATA",900 2313.91,27 1,25,0)
4692	^9002313.9 104^1^1^30 40224^^^^
4693	"DATA",900 2313.91,27 1,25,1,0)
4694	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
4695	"DATA",900 2313.91,27 2,0)
4696	488^^COMPO UND PRODUC T ID QUALI FIER^A/N^^ ^^2^A/N
4697	"DATA",900 2313.91,27 2,5)
4698	RE^2
4699	"DATA",900 2313.91,27 2,10,0)
4700	^9002313.9 101^1^1^30 40224
4701	"DATA",900 2313.91,27 2,10,1,0)
4702	S BPS("X") =""
4703	"DATA",900 2313.91,27 2,20,0)
4704	^9002313.9 102^1^1^31 01101
4705	"DATA",900 2313.91,27 2,20,1,0)
4706	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4707	"DATA",900 2313.91,27 2,25,0)
4708	^9002313.9 104^1^1^30 40224^^^^
4709	"DATA",900 2313.91,27 2,25,1,0)
4710	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4711	"DATA",900 2313.91,27 3,0)
4712	452^^COMPO UND ROUTE OF ADMIN^N ^^^^2^N
4713	"DATA",900 2313.91,27 3,5)
4714	EH^2
4715	"DATA",900 2313.91,27 3,10,0)
4716	^9002313.9 101^1^1^30 40224
4717	"DATA",900 2313.91,27 3,10,1,0)
4718	S BPS("X") =""
4719	"DATA",900 2313.91,27 3,20,0)
4720	^9002313.9 102^1^1^31 01101
4721	"DATA",900 2313.91,27 3,20,1,0)
4722	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
4723	"DATA",900 2313.91,27 3,25,0)
4724	^9002313.9 104^1^1^30 40224^^^^
4725	"DATA",900 2313.91,27 3,25,1,0)
4726	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
4727	"DATA",900 2313.91,30 8,0)
4728	448^^COMPO UND INGRED IENT QUANT ITY^N^^^^1 0^N
4729	"DATA",900 2313.91,30 8,5)
4730	ED^10
4731	"DATA",900 2313.91,30 8,10,0)
4732	^9002313.9 101^1^1^30 40224
4733	"DATA",900 2313.91,30 8,10,1,0)
4734	S BPS("X") =""
4735	"DATA",900 2313.91,30 8,20,0)
4736	^9002313.9 102^1^1^31 01101
4737	"DATA",900 2313.91,30 8,20,1,0)
4738	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
4739	"DATA",900 2313.91,30 8,25,0)
4740	^9002313.9 104^1^1^30 40224^^^^
4741	"DATA",900 2313.91,30 8,25,1,0)
4742	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),10 )
4743	"DATA",900 2313.91,32 4,0)
4744	494^^MEASU REMENT DAT E^A/N^^^^8 ^N
4745	"DATA",900 2313.91,32 4,5)
4746	ZE^8
4747	"DATA",900 2313.91,32 4,10,0)
4748	^9002313.9 101^1^1^30 40224
4749	"DATA",900 2313.91,32 4,10,1,0)
4750	S BPS("X") =""
4751	"DATA",900 2313.91,32 4,20,0)
4752	^9002313.9 102^1^1^31 01101
4753	"DATA",900 2313.91,32 4,20,1,0)
4754	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
4755	"DATA",900 2313.91,32 4,25,0)
4756	^9002313.9 104^1^1^30 40224^
4757	"DATA",900 2313.91,32 4,25,1,0)
4758	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
4759	"DATA",900 2313.91,32 5,0)
4760	496^^MEASU REMENT DIM ENSION^A/N ^^^^2^A/N
4761	"DATA",900 2313.91,32 5,5)
4762	H2^2
4763	"DATA",900 2313.91,32 5,10,0)
4764	^9002313.9 101^1^1^30 40224
4765	"DATA",900 2313.91,32 5,10,1,0)
4766	S BPS("X") =""
4767	"DATA",900 2313.91,32 5,20,0)
4768	^9002313.9 102^1^1^31 01101
4769	"DATA",900 2313.91,32 5,20,1,0)
4770	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4771	"DATA",900 2313.91,32 5,25,0)
4772	^9002313.9 104^1^1^30 40224^^^^
4773	"DATA",900 2313.91,32 5,25,1,0)
4774	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4775	"DATA",900 2313.91,32 6,0)
4776	495^^MEASU REMENT TIM E^N^^^^4^N
4777	"DATA",900 2313.91,32 6,5)
4778	H1^4
4779	"DATA",900 2313.91,32 6,10,0)
4780	^9002313.9 101^1^1^30 40224
4781	"DATA",900 2313.91,32 6,10,1,0)
4782	S BPS("X") =""
4783	"DATA",900 2313.91,32 6,20,0)
4784	^9002313.9 102^1^1^31 01101
4785	"DATA",900 2313.91,32 6,20,1,0)
4786	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),4)
4787	"DATA",900 2313.91,32 6,25,0)
4788	^9002313.9 104^1^1^30 40224^^^^
4789	"DATA",900 2313.91,32 6,25,1,0)
4790	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),4)
4791	"DATA",900 2313.91,32 7,0)
4792	497^^MEASU REMENT UNI T^A/N^^^^2 ^A/N
4793	"DATA",900 2313.91,32 7,5)
4794	H3^2
4795	"DATA",900 2313.91,32 7,10,0)
4796	^9002313.9 101^1^1^30 40224
4797	"DATA",900 2313.91,32 7,10,1,0)
4798	S BPS("X") =""
4799	"DATA",900 2313.91,32 7,20,0)
4800	^9002313.9 102^1^1^31 01101
4801	"DATA",900 2313.91,32 7,20,1,0)
4802	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4803	"DATA",900 2313.91,32 7,25,0)
4804	^9002313.9 104^1^1^30 40224^^^^
4805	"DATA",900 2313.91,32 7,25,1,0)
4806	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4807	"DATA",900 2313.91,32 8,0)
4808	499^^MEASU REMENT VAL UE^A/N^^^^ 15^A/N
4809	"DATA",900 2313.91,32 8,5)
4810	H4^15
4811	"DATA",900 2313.91,32 8,10,0)
4812	^9002313.9 101^1^1^30 40224
4813	"DATA",900 2313.91,32 8,10,1,0)
4814	S BPS("X") =""
4815	"DATA",900 2313.91,32 8,20,0)
4816	^9002313.9 102^1^1^31 01101
4817	"DATA",900 2313.91,32 8,20,1,0)
4818	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
4819	"DATA",900 2313.91,32 8,25,0)
4820	^9002313.9 104^1^1^30 40224^^^
4821	"DATA",900 2313.91,32 8,25,1,0)
4822	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
4823	"DATA",900 2313.91,32 9,0)
4824	990^^OTHER PAYER BIN NUMBER^N^ ^^^6^N
4825	"DATA",900 2313.91,32 9,5)
4826	MG^6
4827	"DATA",900 2313.91,32 9,10,0)
4828	^9002313.9 101^1^1^31 01101
4829	"DATA",900 2313.91,32 9,10,1,0)
4830	S BPS("X") =""
4831	"DATA",900 2313.91,32 9,20,0)
4832	^9002313.9 102^1^1^31 01101
4833	"DATA",900 2313.91,32 9,20,1,0)
4834	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),6)
4835	"DATA",900 2313.91,32 9,30,0)
4836	^9002313.9 103^1^1^31 01101^
4837	"DATA",900 2313.91,32 9,30,1,0)
4838	S $P(^BPSC (BPS(90023 13.02),980 ),U,10)=""
4839	"DATA",900 2313.91,33 0,0)
4840	991^^OTHER PAYER PRO C CONTROL NUM^A/N^^^ ^10^A/N
4841	"DATA",900 2313.91,33 0,1)
4842	OTHER PAYE R PROCESSO R CONTROL NUMBER
4843	"DATA",900 2313.91,33 0,5)
4844	MH^10
4845	"DATA",900 2313.91,33 0,10,0)
4846	^9002313.9 101^1^1^31 01101
4847	"DATA",900 2313.91,33 0,10,1,0)
4848	S BPS("X") =""
4849	"DATA",900 2313.91,33 0,20,0)
4850	^9002313.9 102^1^1^31 01101
4851	"DATA",900 2313.91,33 0,20,1,0)
4852	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
4853	"DATA",900 2313.91,33 0,30,0)
4854	^9002313.9 103^1^1^31 01101^^
4855	"DATA",900 2313.91,33 0,30,1,0)
4856	S $P(^BPSC (BPS(90023 13.02),990 ),U,1)=""
4857	"DATA",900 2313.91,33 1,0)
4858	356^^OTHER PAYER CAR DHOLDER ID ^A/N^^^^20 ^A/N
4859	"DATA",900 2313.91,33 1,5)
4860	NU^20
4861	"DATA",900 2313.91,33 1,10,0)
4862	^9002313.9 101^1^1^31 01101
4863	"DATA",900 2313.91,33 1,10,1,0)
4864	S BPS("X") =""
4865	"DATA",900 2313.91,33 1,20,0)
4866	^9002313.9 102^1^1^31 01101
4867	"DATA",900 2313.91,33 1,20,1,0)
4868	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
4869	"DATA",900 2313.91,33 1,30,0)
4870	^9002313.9 103^1^1^31 01101^^
4871	"DATA",900 2313.91,33 1,30,1,0)
4872	S $P(^BPSC (BPS(90023 13.02),350 ),U,6)=""
4873	"DATA",900 2313.91,33 2,0)
4874	992^^OTHER PAYER GRO UP ID^A/N^ ^^^15^A/N
4875	"DATA",900 2313.91,33 2,5)
4876	MJ^15
4877	"DATA",900 2313.91,33 2,10,0)
4878	^9002313.9 101^1^1^31 01101
4879	"DATA",900 2313.91,33 2,10,1,0)
4880	S BPS("X") =""
4881	"DATA",900 2313.91,33 2,20,0)
4882	^9002313.9 102^1^1^31 01101
4883	"DATA",900 2313.91,33 2,20,1,0)
4884	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
4885	"DATA",900 2313.91,33 2,30,0)
4886	^9002313.9 103^1^1^31 01101^^
4887	"DATA",900 2313.91,33 2,30,1,0)
4888	S $P(^BPSC (BPS(90023 13.02),990 ),U,2)=""
4889	"DATA",900 2313.91,33 3,0)
4890	359^^MEDIG AP ID^A/N^ ^^^20^A/N
4891	"DATA",900 2313.91,33 3,5)
4892	2A^20
4893	"DATA",900 2313.91,33 3,10,0)
4894	^9002313.9 101^1^1^31 01101
4895	"DATA",900 2313.91,33 3,10,1,0)
4896	S BPS("X") =""
4897	"DATA",900 2313.91,33 3,20,0)
4898	^9002313.9 102^1^1^31 01101
4899	"DATA",900 2313.91,33 3,20,1,0)
4900	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
4901	"DATA",900 2313.91,33 3,30,0)
4902	^9002313.9 103^1^1^31 00923^^
4903	"DATA",900 2313.91,33 3,30,1,0)
4904	S $P(^BPSC (BPS(90023 13.02),350 ),U,9)=""
4905	"DATA",900 2313.91,33 4,0)
4906	360^^MEDIC AID INDICA TOR^N^^^^2 ^A/N
4907	"DATA",900 2313.91,33 4,5)
4908	2B^2
4909	"DATA",900 2313.91,33 4,10,0)
4910	^9002313.9 101^1^1^31 01101
4911	"DATA",900 2313.91,33 4,10,1,0)
4912	S BPS("X") =""
4913	"DATA",900 2313.91,33 4,20,0)
4914	^9002313.9 102^1^1^31 01101
4915	"DATA",900 2313.91,33 4,20,1,0)
4916	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
4917	"DATA",900 2313.91,33 4,30,0)
4918	^9002313.9 103^1^1^31 01101^
4919	"DATA",900 2313.91,33 4,30,1,0)
4920	S $P(^BPSC (BPS(90023 13.02),350 ),U,10)=""
4921	"DATA",900 2313.91,33 5,0)
4922	361^^PROVI DER ACCEPT ASSGNMT I NDCTR^A/N^ ^^^1^A/N
4923	"DATA",900 2313.91,33 5,1)
4924	PROVIDER A CCEPT ASSI GNMENT IND ICATOR
4925	"DATA",900 2313.91,33 5,5)
4926	2D^1
4927	"DATA",900 2313.91,33 5,10,0)
4928	^9002313.9 101^1^1^31 01101
4929	"DATA",900 2313.91,33 5,10,1,0)
4930	S BPS("X") ="Y"
4931	"DATA",900 2313.91,33 5,20,0)
4932	^9002313.9 102^1^1^31 01101
4933	"DATA",900 2313.91,33 5,20,1,0)
4934	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
4935	"DATA",900 2313.91,33 5,30,0)
4936	^9002313.9 103^1^1^31 01101^^
4937	"DATA",900 2313.91,33 5,30,1,0)
4938	S $P(^BPSC (BPS(90023 13.02),360 ),U,1)=$G( BPS("X"))
4939	"DATA",900 2313.91,33 6,0)
4940	997^^CMS P ART D DEFN D QLFD FAC ILITY^A/N^ ^^^1^A/N
4941	"DATA",900 2313.91,33 6,1)
4942	CMS PART D DEFINED Q UALIFIED F ACILITY
4943	"DATA",900 2313.91,33 6,5)
4944	G2^1
4945	"DATA",900 2313.91,33 6,10,0)
4946	^9002313.9 101^1^1^31 01101
4947	"DATA",900 2313.91,33 6,10,1,0)
4948	S BPS("X") ="N"
4949	"DATA",900 2313.91,33 6,20,0)
4950	^9002313.9 102^1^1^31 01101
4951	"DATA",900 2313.91,33 6,20,1,0)
4952	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
4953	"DATA",900 2313.91,33 6,30,0)
4954	^9002313.9 103^1^1^31 01101^^
4955	"DATA",900 2313.91,33 6,30,1,0)
4956	S $P(^BPSC (BPS(90023 13.02),990 ),U,7)=$G( BPS("X"))
4957	"DATA",900 2313.91,33 7,0)
4958	115^^MEDIC AID ID NUM BER^A/N^^^ ^20^A/N
4959	"DATA",900 2313.91,33 7,5)
4960	N5^20
4961	"DATA",900 2313.91,33 7,10,0)
4962	^9002313.9 101^1^1^31 01101
4963	"DATA",900 2313.91,33 7,10,1,0)
4964	S BPS("X") =""
4965	"DATA",900 2313.91,33 7,20,0)
4966	^9002313.9 102^1^1^31 01101
4967	"DATA",900 2313.91,33 7,20,1,0)
4968	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
4969	"DATA",900 2313.91,33 7,30,0)
4970	^9002313.9 103^1^1^31 01206^
4971	"DATA",900 2313.91,33 7,30,1,0)
4972	S $P(^BPSC (BPS(90023 13.02),110 ),U,5)=""
4973	"DATA",900 2313.91,33 8,0)
4974	116^^MEDIC AID AGENCY NUMBER^A/ N^^^^15^A/ N
4975	"DATA",900 2313.91,33 8,5)
4976	N6^15
4977	"DATA",900 2313.91,33 8,10,0)
4978	^9002313.9 101^1^1^31 01101
4979	"DATA",900 2313.91,33 8,10,1,0)
4980	S BPS("X") =""
4981	"DATA",900 2313.91,33 8,20,0)
4982	^9002313.9 102^1^1^31 01101
4983	"DATA",900 2313.91,33 8,20,1,0)
4984	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
4985	"DATA",900 2313.91,33 8,30,0)
4986	^9002313.9 103^1^1^31 01206^
4987	"DATA",900 2313.91,33 8,30,1,0)
4988	S $P(^BPSC (BPS(90023 13.02),110 ),U,6)=""
4989	"DATA",900 2313.91,33 9,0)
4990	384^^PATIE NT RESIDEN CE^N^^^^2^ N
4991	"DATA",900 2313.91,33 9,5)
4992	4X^2
4993	"DATA",900 2313.91,33 9,10,0)
4994	^9002313.9 101^1^1^31 01101
4995	"DATA",900 2313.91,33 9,10,1,0)
4996	S BPS("X") =$G(BPS("P atient","P atient Res idence"))
4997	"DATA",900 2313.91,33 9,20,0)
4998	^9002313.9 102^1^1^31 01101
4999	"DATA",900 2313.91,33 9,20,1,0)
5000	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
5001	"DATA",900 2313.91,33 9,30,0)
5002	^9002313.9 103^1^1^31 01007^^^^
5003	"DATA",900 2313.91,33 9,30,1,0)
5004	S $P(^BPSC (BPS(90023 13.02),380 ),U,4)=$G( BPS("X"))
5005	"DATA",900 2313.91,34 0,0)
5006	354^^SUBMI SSION CLAR IF CODE CO UNT^N^^^^1 ^N
5007	"DATA",900 2313.91,34 0,1)
5008	SUBMISSION CLARIFICA TION CODE COUNT
5009	"DATA",900 2313.91,34 0,5)
5010	NX^2
5011	"DATA",900 2313.91,34 0,10,0)
5012	^9002313.9 101^1^1^31 01006^^
5013	"DATA",900 2313.91,34 0,10,1,0)
5014	; fields 3 54 & 420 h andled by FLD420^BPS OSSG (see SET CODE i n field 42 0)
5015	"DATA",900 2313.91,34 0,20,0)
5016	^9002313.9 102^1^1^31 01006^^
5017	"DATA",900 2313.91,34 0,20,1,0)
5018	; fields 3 54 & 420 h andled by FLD420^BPS OSSG (see SET CODE i n field 42 0)
5019	"DATA",900 2313.91,34 0,25,0)
5020	^9002313.9 104^1^1^31 01006^^
5021	"DATA",900 2313.91,34 0,25,1,0)
5022	; fields 3 54 & 420 h andled by FLD420^BPS OSSG (see SET CODE i n field 42 0)
5023	"DATA",900 2313.91,34 0,30,0)
5024	^9002313.9 103^1^1^31 01006^^^^
5025	"DATA",900 2313.91,34 0,30,1,0)
5026	; fields 3 54 & 420 h andled by FLD420^BPS OSSG (see SET CODE i n field 42 0)
5027	"DATA",900 2313.91,34 1,0)
5028	357^^DELAY REASON CO DE^N^^^^2^ N
5029	"DATA",900 2313.91,34 1,5)
5030	NV^2
5031	"DATA",900 2313.91,34 1,10,0)
5032	^9002313.9 101^1^1^31 01007^^
5033	"DATA",900 2313.91,34 1,10,1,0)
5034	S BPS("X") =$G(BPS("C laim",BPS( 9002313.02 01),"Delay Reason Co de"))
5035	"DATA",900 2313.91,34 1,20,0)
5036	^9002313.9 102^1^1^31 01012^
5037	"DATA",900 2313.91,34 1,20,1,0)
5038	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
5039	"DATA",900 2313.91,34 1,30,0)
5040	^9002313.9 103^1^1^31 01007^^
5041	"DATA",900 2313.91,34 1,30,1,0)
5042	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 50),U,7)=$ S($G(BPS(" X"))="NV00 ":"",1:$G( BPS("X")))
5043	"DATA",900 2313.91,34 2,0)
5044	880^^TRANS ACTION REF ERENCE NUM BER^A/N^^^ ^10^A/N
5045	"DATA",900 2313.91,34 2,5)
5046	K5^10
5047	"DATA",900 2313.91,34 2,10,0)
5048	^9002313.9 101^1^1^31 01101
5049	"DATA",900 2313.91,34 2,10,1,0)
5050	S BPS("X") =""
5051	"DATA",900 2313.91,34 2,20,0)
5052	^9002313.9 102^1^1^31 01101
5053	"DATA",900 2313.91,34 2,20,1,0)
5054	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
5055	"DATA",900 2313.91,34 2,30,0)
5056	^9002313.9 103^1^1^31 01206^
5057	"DATA",900 2313.91,34 2,30,1,0)
5058	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),8 70),U,10)= ""
5059	"DATA",900 2313.91,34 3,0)
5060	391^^PATIE NT ASSIGNM ENT INDICA TOR^A/N^^^ ^1^A/N
5061	"DATA",900 2313.91,34 3,1)
5062	PATIENT AS SIGNMENT I NDICATOR ( DIRECT MEM BER REIMBU RSEMENT IN DICATOR)
5063	"DATA",900 2313.91,34 3,5)
5064	MT^1
5065	"DATA",900 2313.91,34 3,10,0)
5066	^9002313.9 101^1^1^31 01101
5067	"DATA",900 2313.91,34 3,10,1,0)
5068	S BPS("X") ="Y"
5069	"DATA",900 2313.91,34 3,20,0)
5070	^9002313.9 102^1^1^31 01101
5071	"DATA",900 2313.91,34 3,20,1,0)
5072	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
5073	"DATA",900 2313.91,34 3,30,0)
5074	^9002313.9 103^1^1^31 01101^^
5075	"DATA",900 2313.91,34 3,30,1,0)
5076	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 90),U,1)=$ G(BPS("X") )
5077	"DATA",900 2313.91,34 4,0)
5078	995^^ROUTE OF ADMINI STRATION^A /N^^^^11^A /N
5079	"DATA",900 2313.91,34 4,5)
5080	E2^1
5081	"DATA",900 2313.91,34 4,10,0)
5082	^9002313.9 101^1^1^31 01101
5083	"DATA",900 2313.91,34 4,10,1,0)
5084	S BPS("X") =""
5085	"DATA",900 2313.91,34 4,20,0)
5086	^9002313.9 102^1^1^31 01101
5087	"DATA",900 2313.91,34 4,20,1,0)
5088	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 1)
5089	"DATA",900 2313.91,34 4,30,0)
5090	^9002313.9 103^1^1^31 01101^^
5091	"DATA",900 2313.91,34 4,30,1,0)
5092	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),9 90),U,5)=$ G(BPS("X") )
5093	"DATA",900 2313.91,34 5,0)
5094	996^^COMPO UND TYPE^A /N^^^^2^A/ N
5095	"DATA",900 2313.91,34 5,5)
5096	G1^2
5097	"DATA",900 2313.91,34 5,10,0)
5098	^9002313.9 101^1^1^31 01206^
5099	"DATA",900 2313.91,34 5,10,1,0)
5100	S BPS("X") =""
5101	"DATA",900 2313.91,34 5,20,0)
5102	^9002313.9 102^1^1^31 01206^
5103	"DATA",900 2313.91,34 5,20,1,0)
5104	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
5105	"DATA",900 2313.91,34 5,30,0)
5106	^^1^1^3121 128
5107	"DATA",900 2313.91,34 5,30,1,0)
5108	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),9 90),U,6)=" "
5109	"DATA",900 2313.91,34 6,0)
5110	114^^MEDIC AID SUBROG ATION ICN/ TCN^A/N^^^ ^20^A/N
5111	"DATA",900 2313.91,34 6,1)
5112	MEDICAID S UBROGATION INTERNAL CONTROL NU MBER/TRANS ACTION CON TROL NUMBE R (ICN/TCN )
5113	"DATA",900 2313.91,34 6,5)
5114	N4^20
5115	"DATA",900 2313.91,34 6,10,0)
5116	^9002313.9 101^1^1^31 01110^
5117	"DATA",900 2313.91,34 6,10,1,0)
5118	S BPS("X") =""
5119	"DATA",900 2313.91,34 6,20,0)
5120	^9002313.9 102^1^1^31 01110^
5121	"DATA",900 2313.91,34 6,20,1,0)
5122	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
5123	"DATA",900 2313.91,34 6,30,0)
5124	^9002313.9 103^1^1^31 01206^
5125	"DATA",900 2313.91,34 6,30,1,0)
5126	S $P(^BPSC (BPS(90023 13.02),110 ),U,4)=""
5127	"DATA",900 2313.91,34 7,0)
5128	147^^PHARM ACY SERVIC E TYPE^N^^ ^^2^N
5129	"DATA",900 2313.91,34 7,5)
5130	U7^2
5131	"DATA",900 2313.91,34 7,10,0)
5132	^9002313.9 101^1^1^31 01007^^
5133	"DATA",900 2313.91,34 7,10,1,0)
5134	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Pharmacy Service T ype"))
5135	"DATA",900 2313.91,34 7,20,0)
5136	^9002313.9 102^1^1^31 01007^^
5137	"DATA",900 2313.91,34 7,20,1,0)
5138	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
5139	"DATA",900 2313.91,34 7,30,0)
5140	^9002313.9 103^1^1^31 01007^^^^
5141	"DATA",900 2313.91,34 7,30,1,0)
5142	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 40),U,7)=$ G(BPS("X") )
5143	"DATA",900 2313.91,34 8,0)
5144	364^^PRESC RIBER FIRS T NAME^A/N ^^^^12^A/N
5145	"DATA",900 2313.91,34 8,5)
5146	2J^12
5147	"DATA",900 2313.91,34 8,10,0)
5148	^9002313.9 101^1^1^31 01029^
5149	"DATA",900 2313.91,34 8,10,1,0)
5150	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er First N ame"))
5151	"DATA",900 2313.91,34 8,20,0)
5152	^9002313.9 102^1^1^31 01101
5153	"DATA",900 2313.91,34 8,20,1,0)
5154	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 2)
5155	"DATA",900 2313.91,34 8,30,0)
5156	^9002313.9 103^1^1^31 01101^^^
5157	"DATA",900 2313.91,34 8,30,1,0)
5158	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 60),U,4)=$ G(BPS("X") )
5159	"DATA",900 2313.91,34 9,0)
5160	365^^PRESC RIBER STRE ET ADDRESS ^A/N^^^^30 ^A/N
5161	"DATA",900 2313.91,34 9,5)
5162	2K^30
5163	"DATA",900 2313.91,34 9,10,0)
5164	^9002313.9 101^1^1^31 01029^
5165	"DATA",900 2313.91,34 9,10,1,0)
5166	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er Street Address"))
5167	"DATA",900 2313.91,34 9,20,0)
5168	^9002313.9 102^1^1^31 01101
5169	"DATA",900 2313.91,34 9,20,1,0)
5170	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
5171	"DATA",900 2313.91,34 9,30,0)
5172	^9002313.9 103^1^1^31 01101^^
5173	"DATA",900 2313.91,34 9,30,1,0)
5174	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 60),U,5)=$ G(BPS("X") )
5175	"DATA",900 2313.91,35 0,0)
5176	366^^PRESC RIBER CITY ADDRESS^A /N^^^^20^A /N
5177	"DATA",900 2313.91,35 0,5)
5178	2M^20
5179	"DATA",900 2313.91,35 0,10,0)
5180	^9002313.9 101^1^1^31 01029^
5181	"DATA",900 2313.91,35 0,10,1,0)
5182	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er City Ad dress"))
5183	"DATA",900 2313.91,35 0,20,0)
5184	^9002313.9 102^1^1^31 01101
5185	"DATA",900 2313.91,35 0,20,1,0)
5186	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
5187	"DATA",900 2313.91,35 0,30,0)
5188	^9002313.9 103^1^1^31 01101^^
5189	"DATA",900 2313.91,35 0,30,1,0)
5190	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 60),U,6)=$ G(BPS("X") )
5191	"DATA",900 2313.91,35 1,0)
5192	367^^PRESC RIBER STAT E/PROV ADD RESS^A/N^^ ^^2^A/N
5193	"DATA",900 2313.91,35 1,1)
5194	PRESCRIBER STATE/PRO VINCE ADDR ESS
5195	"DATA",900 2313.91,35 1,5)
5196	2N^2
5197	"DATA",900 2313.91,35 1,10,0)
5198	^9002313.9 101^1^1^31 01029^^
5199	"DATA",900 2313.91,35 1,10,1,0)
5200	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er State/P rovince Ad dress"))
5201	"DATA",900 2313.91,35 1,20,0)
5202	^9002313.9 102^1^1^31 01101
5203	"DATA",900 2313.91,35 1,20,1,0)
5204	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
5205	"DATA",900 2313.91,35 1,30,0)
5206	^9002313.9 103^1^1^31 01101^^^
5207	"DATA",900 2313.91,35 1,30,1,0)
5208	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 60),U,7)=$ G(BPS("X") )
5209	"DATA",900 2313.91,35 2,0)
5210	368^^PRESC RIBER ZIP/ POSTAL ZON E^A/N^^^^1 5^A/N
5211	"DATA",900 2313.91,35 2,5)
5212	2P^2
5213	"DATA",900 2313.91,35 2,10,0)
5214	^9002313.9 101^1^1^31 01029^
5215	"DATA",900 2313.91,35 2,10,1,0)
5216	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er Zip/Pos tal Zone") )
5217	"DATA",900 2313.91,35 2,20,0)
5218	^9002313.9 102^1^1^31 01101
5219	"DATA",900 2313.91,35 2,20,1,0)
5220	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
5221	"DATA",900 2313.91,35 2,30,0)
5222	^9002313.9 103^1^1^31 01101^^
5223	"DATA",900 2313.91,35 2,30,1,0)
5224	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 60),U,8)=$ G(BPS("X") )
5225	"DATA",900 2313.91,35 3,0)
5226	993^^INTER NAL CONTRO L NUMBER^A /N^^^^30^A /N
5227	"DATA",900 2313.91,35 3,5)
5228	A7^30
5229	"DATA",900 2313.91,35 3,10,0)
5230	^9002313.9 101^1^1^31 01101
5231	"DATA",900 2313.91,35 3,10,1,0)
5232	S BPS("X") =""
5233	"DATA",900 2313.91,35 3,20,0)
5234	^9002313.9 102^1^1^31 01101
5235	"DATA",900 2313.91,35 3,20,1,0)
5236	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
5237	"DATA",900 2313.91,35 3,30,0)
5238	^9002313.9 103^1^1^31 01029^
5239	"DATA",900 2313.91,35 3,30,1,0)
5240	; This fie ld current ly not imp lemented
5241	"DATA",900 2313.91,35 4,0)
5242	392^^BENEF IT STAGE C OUNT^N^^^^ 1^N
5243	"DATA",900 2313.91,35 4,5)
5244	MU^1
5245	"DATA",900 2313.91,35 4,10,0)
5246	^^1^1^3110 727^
5247	"DATA",900 2313.91,35 4,10,1,0)
5248	;GET code for this C OB field i s executed in COB^BP SOSHF
5249	"DATA",900 2313.91,35 4,20,0)
5250	^9002313.9 102^1^1^31 01101
5251	"DATA",900 2313.91,35 4,20,1,0)
5252	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
5253	"DATA",900 2313.91,35 4,30,0)
5254	^^1^1^3110 727^
5255	"DATA",900 2313.91,35 4,30,1,0)
5256	D SET392^B PSFLD01
5257	"DATA",900 2313.91,35 5,0)
5258	393^^BENEF IT STAGE Q UALIFIER^A /N^^^^2^A/ N
5259	"DATA",900 2313.91,35 5,5)
5260	MV^2
5261	"DATA",900 2313.91,35 5,10,0)
5262	^^1^1^3110 727^
5263	"DATA",900 2313.91,35 5,10,1,0)
5264	;GET code for this C OB field i s executed in COB^BP SOSHF
5265	"DATA",900 2313.91,35 5,20,0)
5266	^9002313.9 102^1^1^31 01101
5267	"DATA",900 2313.91,35 5,20,1,0)
5268	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
5269	"DATA",900 2313.91,35 5,30,0)
5270	^^1^1^3110 727^
5271	"DATA",900 2313.91,35 5,30,1,0)
5272	D SET393^B PSFLD01
5273	"DATA",900 2313.91,35 6,0)
5274	394^^BENEF IT STAGE A MOUNT^N^^^ ^8^D
5275	"DATA",900 2313.91,35 6,5)
5276	MW^8
5277	"DATA",900 2313.91,35 6,10,0)
5278	^^1^1^3110 727^
5279	"DATA",900 2313.91,35 6,10,1,0)
5280	;GET code for this C OB field i s executed in COB^BP SOSHF
5281	"DATA",900 2313.91,35 6,20,0)
5282	^9002313.9 102^1^1^31 01101
5283	"DATA",900 2313.91,35 6,20,1,0)
5284	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
5285	"DATA",900 2313.91,35 6,30,0)
5286	^^1^1^3110 727^
5287	"DATA",900 2313.91,35 6,30,1,0)
5288	D SET394^B PSFLD01
5289	"DATA",900 2313.91,35 7,0)
5290	117^^BILLI NG ENTITY TYPE INDIC ATOR^N^^^^ 2^N
5291	"DATA",900 2313.91,35 7,5)
5292	TR^2
5293	"DATA",900 2313.91,35 7,10,0)
5294	^9002313.9 101^1^1^31 01101
5295	"DATA",900 2313.91,35 7,10,1,0)
5296	S BPS("X") =""
5297	"DATA",900 2313.91,35 7,20,0)
5298	^9002313.9 102^1^1^31 01101
5299	"DATA",900 2313.91,35 7,20,1,0)
5300	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
5301	"DATA",900 2313.91,35 7,30,0)
5302	^9002313.9 103^1^1^31 00924^
5303	"DATA",900 2313.91,35 7,30,1,0)
5304	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 10),U,7)=" "
5305	"DATA",900 2313.91,35 8,0)
5306	118^^PAY T O QUALIFIE R^A/N^^^^2 ^A/N
5307	"DATA",900 2313.91,35 8,5)
5308	TS^2
5309	"DATA",900 2313.91,35 8,10,0)
5310	^9002313.9 101^1^1^31 01101
5311	"DATA",900 2313.91,35 8,10,1,0)
5312	S BPS("X") =""
5313	"DATA",900 2313.91,35 8,20,0)
5314	^9002313.9 102^1^1^31 01101
5315	"DATA",900 2313.91,35 8,20,1,0)
5316	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
5317	"DATA",900 2313.91,35 8,30,0)
5318	^9002313.9 103^1^1^31 00924^
5319	"DATA",900 2313.91,35 8,30,1,0)
5320	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 10),U,8)=" "
5321	"DATA",900 2313.91,35 9,0)
5322	119^^PAY T O ID^A/N^^ ^^15^A/N
5323	"DATA",900 2313.91,35 9,5)
5324	TT^15
5325	"DATA",900 2313.91,35 9,10,0)
5326	^9002313.9 101^1^1^31 01101
5327	"DATA",900 2313.91,35 9,10,1,0)
5328	S BPS("X") =""
5329	"DATA",900 2313.91,35 9,20,0)
5330	^9002313.9 102^1^1^31 01101
5331	"DATA",900 2313.91,35 9,20,1,0)
5332	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
5333	"DATA",900 2313.91,35 9,30,0)
5334	^9002313.9 103^1^1^31 00924^
5335	"DATA",900 2313.91,35 9,30,1,0)
5336	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 10),U,9)=" "
5337	"DATA",900 2313.91,36 0,0)
5338	120^^PAY T O NAME^A/N ^^^^20^A/N
5339	"DATA",900 2313.91,36 0,5)
5340	TU^20
5341	"DATA",900 2313.91,36 0,10,0)
5342	^9002313.9 101^1^1^31 01101
5343	"DATA",900 2313.91,36 0,10,1,0)
5344	S BPS("X") =""
5345	"DATA",900 2313.91,36 0,20,0)
5346	^9002313.9 102^1^1^31 01101
5347	"DATA",900 2313.91,36 0,20,1,0)
5348	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
5349	"DATA",900 2313.91,36 0,30,0)
5350	^9002313.9 103^1^1^31 00924^
5351	"DATA",900 2313.91,36 0,30,1,0)
5352	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 10),U,10)= ""
5353	"DATA",900 2313.91,36 1,0)
5354	121^^PAY T O STREET A DDRESS^A/N ^^^^30^A/N
5355	"DATA",900 2313.91,36 1,5)
5356	TV^30
5357	"DATA",900 2313.91,36 1,10,0)
5358	^9002313.9 101^1^1^31 01101
5359	"DATA",900 2313.91,36 1,10,1,0)
5360	S BPS("X") =""
5361	"DATA",900 2313.91,36 1,20,0)
5362	^9002313.9 102^1^1^31 01101
5363	"DATA",900 2313.91,36 1,20,1,0)
5364	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
5365	"DATA",900 2313.91,36 1,30,0)
5366	^9002313.9 103^1^1^31 00924^
5367	"DATA",900 2313.91,36 1,30,1,0)
5368	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 20),U,1)=" "
5369	"DATA",900 2313.91,36 2,0)
5370	122^^PAY T O CITY ADD RESS^A/N^^ ^^20^A/N
5371	"DATA",900 2313.91,36 2,5)
5372	TW^20
5373	"DATA",900 2313.91,36 2,10,0)
5374	^9002313.9 101^1^1^31 01101
5375	"DATA",900 2313.91,36 2,10,1,0)
5376	S BPS("X") =""
5377	"DATA",900 2313.91,36 2,20,0)
5378	^9002313.9 102^1^1^31 01101
5379	"DATA",900 2313.91,36 2,20,1,0)
5380	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
5381	"DATA",900 2313.91,36 2,30,0)
5382	^9002313.9 103^1^1^31 00924^
5383	"DATA",900 2313.91,36 2,30,1,0)
5384	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 20),U,2)=" "
5385	"DATA",900 2313.91,36 3,0)
5386	124^^PAY T O ZIP/POST AL ZONE^A/ N^^^^15^A/ N
5387	"DATA",900 2313.91,36 3,5)
5388	TY^15
5389	"DATA",900 2313.91,36 3,10,0)
5390	^9002313.9 101^1^1^31 01101
5391	"DATA",900 2313.91,36 3,10,1,0)
5392	S BPS("X") =""
5393	"DATA",900 2313.91,36 3,20,0)
5394	^9002313.9 102^1^1^31 01101
5395	"DATA",900 2313.91,36 3,20,1,0)
5396	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
5397	"DATA",900 2313.91,36 3,30,0)
5398	^9002313.9 103^1^1^31 00924^
5399	"DATA",900 2313.91,36 3,30,1,0)
5400	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 20),U,4)=" "
5401	"DATA",900 2313.91,36 4,0)
5402	125^^GENER IC EQUIV P ROD ID QLF R^A/N^^^^2 ^A/N
5403	"DATA",900 2313.91,36 4,1)
5404	GENERIC EQ UIVALENT P RODUCT ID QUALIFIER
5405	"DATA",900 2313.91,36 4,5)
5406	TZ^2
5407	"DATA",900 2313.91,36 4,10,0)
5408	^9002313.9 101^1^1^31 01101
5409	"DATA",900 2313.91,36 4,10,1,0)
5410	S BPS("X") =""
5411	"DATA",900 2313.91,36 4,20,0)
5412	^9002313.9 102^1^1^31 01101
5413	"DATA",900 2313.91,36 4,20,1,0)
5414	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
5415	"DATA",900 2313.91,36 4,30,0)
5416	^9002313.9 103^1^1^31 00924^
5417	"DATA",900 2313.91,36 4,30,1,0)
5418	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 20),U,5)=" "
5419	"DATA",900 2313.91,36 5,0)
5420	126^^GENER IC EQUIVAL ENT PRODUC T ID^A/N^^ ^^19^A/N
5421	"DATA",900 2313.91,36 5,5)
5422	UA^19
5423	"DATA",900 2313.91,36 5,10,0)
5424	^9002313.9 101^1^1^31 01101
5425	"DATA",900 2313.91,36 5,10,1,0)
5426	S BPS("X") =""
5427	"DATA",900 2313.91,36 5,20,0)
5428	^9002313.9 102^1^1^31 01101
5429	"DATA",900 2313.91,36 5,20,1,0)
5430	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 9)
5431	"DATA",900 2313.91,36 5,30,0)
5432	^9002313.9 103^1^1^31 00924^
5433	"DATA",900 2313.91,36 5,30,1,0)
5434	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 20),U,6)=" "
5435	"DATA",900 2313.91,36 6,0)
5436	113^^MEDIC AID PAID A MOUNT^N^^^ ^8^D
5437	"DATA",900 2313.91,36 6,5)
5438	N3^8
5439	"DATA",900 2313.91,36 6,10,0)
5440	^9002313.9 101^1^1^31 01101
5441	"DATA",900 2313.91,36 6,10,1,0)
5442	S BPS("X") =""
5443	"DATA",900 2313.91,36 6,20,0)
5444	^9002313.9 102^1^1^31 01101
5445	"DATA",900 2313.91,36 6,20,1,0)
5446	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),8)
5447	"DATA",900 2313.91,36 6,30,0)
5448	^9002313.9 103^1^1^31 00924^
5449	"DATA",900 2313.91,36 6,30,1,0)
5450	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 10),U,3)=" "
5451	"DATA",900 2313.91,36 7,0)
5452	362^^COMPO UND INGRED MOD CODE CNT^N^^^^2 ^N
5453	"DATA",900 2313.91,36 7,1)
5454	COMPOUND I NGREDIENT MODIFIER C ODE COUNT
5455	"DATA",900 2313.91,36 7,5)
5456	2G^2
5457	"DATA",900 2313.91,36 7,10,0)
5458	^9002313.9 101^1^1^31 01101
5459	"DATA",900 2313.91,36 7,10,1,0)
5460	S BPS("X") =""
5461	"DATA",900 2313.91,36 7,20,0)
5462	^9002313.9 102^1^1^31 01101
5463	"DATA",900 2313.91,36 7,20,1,0)
5464	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
5465	"DATA",900 2313.91,36 7,30,0)
5466	^9002313.9 103^1^1^31 01206^
5467	"DATA",900 2313.91,36 7,30,1,0)
5468	; This fie ld current ly not imp lemented
5469	"DATA",900 2313.91,36 8,0)
5470	363^^COMPO UND INGRED MODIFIER CODE^A/N^^ ^^2^A/N
5471	"DATA",900 2313.91,36 8,1)
5472	COMPOUND I NGREDIENT MODIFIER C ODE
5473	"DATA",900 2313.91,36 8,5)
5474	2H^2
5475	"DATA",900 2313.91,36 8,10,0)
5476	^9002313.9 101^1^1^31 01101
5477	"DATA",900 2313.91,36 8,10,1,0)
5478	S BPS("X") =""
5479	"DATA",900 2313.91,36 8,20,0)
5480	^9002313.9 102^1^1^31 01101
5481	"DATA",900 2313.91,36 8,20,1,0)
5482	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
5483	"DATA",900 2313.91,36 8,30,0)
5484	^9002313.9 103^1^1^31 01206^
5485	"DATA",900 2313.91,36 8,30,1,0)
5486	; This fie ld current ly not imp lemented
5487	"DATA",900 2313.91,36 9,0)
5488	369^^ADDIT IONAL DCMN TN TYPE ID ^A/N^^^^3^ A/N
5489	"DATA",900 2313.91,36 9,1)
5490	ADDITIONAL DOCUMENTA TION TYPE ID
5491	"DATA",900 2313.91,36 9,5)
5492	2Q^3
5493	"DATA",900 2313.91,36 9,10,0)
5494	^9002313.9 101^1^1^31 01101
5495	"DATA",900 2313.91,36 9,10,1,0)
5496	S BPS("X") =""
5497	"DATA",900 2313.91,36 9,20,0)
5498	^9002313.9 102^1^1^31 01101
5499	"DATA",900 2313.91,36 9,20,1,0)
5500	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
5501	"DATA",900 2313.91,36 9,30,0)
5502	^9002313.9 103^1^1^31 01206^^
5503	"DATA",900 2313.91,36 9,30,1,0)
5504	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 60),U,9)=" "
5505	"DATA",900 2313.91,37 0,0)
5506	370^^LENGT H OF NEED^ N^^^^3^N
5507	"DATA",900 2313.91,37 0,5)
5508	2R^3
5509	"DATA",900 2313.91,37 0,10,0)
5510	^9002313.9 101^1^1^31 01101
5511	"DATA",900 2313.91,37 0,10,1,0)
5512	S BPS("X") =""
5513	"DATA",900 2313.91,37 0,20,0)
5514	^9002313.9 102^1^1^31 01101
5515	"DATA",900 2313.91,37 0,20,1,0)
5516	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),3)
5517	"DATA",900 2313.91,37 0,30,0)
5518	^9002313.9 103^1^1^31 00925^
5519	"DATA",900 2313.91,37 0,30,1,0)
5520	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 60),U,10)= ""
5521	"DATA",900 2313.91,37 1,0)
5522	371^^LENGT H OF NEED QUALIFIER^ N^^^^2^N
5523	"DATA",900 2313.91,37 1,5)
5524	2S^3
5525	"DATA",900 2313.91,37 1,10,0)
5526	^9002313.9 101^1^1^31 01101
5527	"DATA",900 2313.91,37 1,10,1,0)
5528	S BPS("X") =""
5529	"DATA",900 2313.91,37 1,20,0)
5530	^9002313.9 102^1^1^31 01101
5531	"DATA",900 2313.91,37 1,20,1,0)
5532	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
5533	"DATA",900 2313.91,37 1,30,0)
5534	^9002313.9 103^1^1^31 00925^
5535	"DATA",900 2313.91,37 1,30,1,0)
5536	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 70),U,1)=" "
5537	"DATA",900 2313.91,37 2,0)
5538	372^^PRESC RIBER/SUPP LIER DT SI GNED^N^^^^ 8^N
5539	"DATA",900 2313.91,37 2,1)
5540	PRESCRIBER /SUPPLIER DATE SIGNE D
5541	"DATA",900 2313.91,37 2,5)
5542	2T^9
5543	"DATA",900 2313.91,37 2,10,0)
5544	^9002313.9 101^1^1^31 01101
5545	"DATA",900 2313.91,37 2,10,1,0)
5546	S BPS("X") =""
5547	"DATA",900 2313.91,37 2,20,0)
5548	^9002313.9 102^1^1^31 01101
5549	"DATA",900 2313.91,37 2,20,1,0)
5550	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
5551	"DATA",900 2313.91,37 2,30,0)
5552	^9002313.9 103^1^1^31 00925^
5553	"DATA",900 2313.91,37 2,30,1,0)
5554	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 70),U,2)=" "
5555	"DATA",900 2313.91,37 3,0)
5556	373^^REQUE ST STATUS^ A/N^^^^1^A /N
5557	"DATA",900 2313.91,37 3,5)
5558	2U^1
5559	"DATA",900 2313.91,37 3,10,0)
5560	^9002313.9 101^1^1^31 01101
5561	"DATA",900 2313.91,37 3,10,1,0)
5562	S BPS("X") =""
5563	"DATA",900 2313.91,37 3,20,0)
5564	^9002313.9 102^1^1^31 01101
5565	"DATA",900 2313.91,37 3,20,1,0)
5566	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
5567	"DATA",900 2313.91,37 3,30,0)
5568	^9002313.9 103^1^1^31 00925^
5569	"DATA",900 2313.91,37 3,30,1,0)
5570	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 70),U,3)=" "
5571	"DATA",900 2313.91,37 4,0)
5572	374^^REQUE ST PERIOD BEGIN DATE ^N^^^^8^N
5573	"DATA",900 2313.91,37 4,5)
5574	2V^8
5575	"DATA",900 2313.91,37 4,10,0)
5576	^9002313.9 101^1^1^31 01101
5577	"DATA",900 2313.91,37 4,10,1,0)
5578	S BPS("X") =""
5579	"DATA",900 2313.91,37 4,20,0)
5580	^9002313.9 102^1^1^31 01101
5581	"DATA",900 2313.91,37 4,20,1,0)
5582	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
5583	"DATA",900 2313.91,37 4,30,0)
5584	^9002313.9 103^1^1^31 00925^
5585	"DATA",900 2313.91,37 4,30,1,0)
5586	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 70),U,4)=" "
5587	"DATA",900 2313.91,37 5,0)
5588	375^^REQ P ERIOD RECE RT/REVISED DT^N^^^^8 ^N
5589	"DATA",900 2313.91,37 5,1)
5590	REQUEST PE RIOD RECER T/REVISED DATE
5591	"DATA",900 2313.91,37 5,5)
5592	2W^8
5593	"DATA",900 2313.91,37 5,10,0)
5594	^9002313.9 101^1^1^31 01101
5595	"DATA",900 2313.91,37 5,10,1,0)
5596	S BPS("X") =""
5597	"DATA",900 2313.91,37 5,20,0)
5598	^9002313.9 102^1^1^31 01101
5599	"DATA",900 2313.91,37 5,20,1,0)
5600	S BPS("X") =$$DTF1^BP SECFM($G(B PS("X")))
5601	"DATA",900 2313.91,37 5,30,0)
5602	^9002313.9 103^1^1^31 00925^
5603	"DATA",900 2313.91,37 5,30,1,0)
5604	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 70),U,5)=" "
5605	"DATA",900 2313.91,37 6,0)
5606	376^^SUPPO RTING DOCU MENTATION^ A/N^^^^65^ A/N
5607	"DATA",900 2313.91,37 6,5)
5608	2X^65
5609	"DATA",900 2313.91,37 6,10,0)
5610	^9002313.9 101^1^1^31 01101
5611	"DATA",900 2313.91,37 6,10,1,0)
5612	S BPS("X") =""
5613	"DATA",900 2313.91,37 6,20,0)
5614	^9002313.9 102^1^1^31 01101
5615	"DATA",900 2313.91,37 6,20,1,0)
5616	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),6 5)
5617	"DATA",900 2313.91,37 6,30,0)
5618	^9002313.9 103^1^1^31 00925^
5619	"DATA",900 2313.91,37 6,30,1,0)
5620	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 70),U,6)=" "
5621	"DATA",900 2313.91,37 7,0)
5622	377^^QUEST ION NUMBER /LETTER CO UNT^A/N^^^ ^2^N
5623	"DATA",900 2313.91,37 7,5)
5624	2Z^65
5625	"DATA",900 2313.91,37 7,10,0)
5626	^9002313.9 101^1^1^31 01101
5627	"DATA",900 2313.91,37 7,10,1,0)
5628	S BPS("X") =""
5629	"DATA",900 2313.91,37 7,20,0)
5630	^9002313.9 102^1^1^31 01101
5631	"DATA",900 2313.91,37 7,20,1,0)
5632	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
5633	"DATA",900 2313.91,37 8,0)
5634	378^^QUEST ION NUMBER /LETTER^A/ N^^^^3^A/N
5635	"DATA",900 2313.91,37 8,5)
5636	4B^3
5637	"DATA",900 2313.91,37 8,10,0)
5638	^9002313.9 101^1^1^31 01101
5639	"DATA",900 2313.91,37 8,10,1,0)
5640	S BPS("X") =""
5641	"DATA",900 2313.91,37 8,20,0)
5642	^9002313.9 102^1^1^31 01101
5643	"DATA",900 2313.91,37 8,20,1,0)
5644	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
5645	"DATA",900 2313.91,37 8,30,0)
5646	^9002313.9 103^1^1^31 01206^
5647	"DATA",900 2313.91,37 8,30,1,0)
5648	; This fie ld current ly not imp lemented
5649	"DATA",900 2313.91,37 9,0)
5650	379^^QUEST ION PERCEN T RESPONSE ^N^^^^5^N
5651	"DATA",900 2313.91,37 9,5)
5652	4D^5
5653	"DATA",900 2313.91,37 9,10,0)
5654	^9002313.9 101^1^1^31 01101
5655	"DATA",900 2313.91,37 9,10,1,0)
5656	S BPS("X") =""
5657	"DATA",900 2313.91,37 9,20,0)
5658	^9002313.9 102^1^1^31 01101
5659	"DATA",900 2313.91,37 9,20,1,0)
5660	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),5)
5661	"DATA",900 2313.91,37 9,30,0)
5662	^9002313.9 103^1^1^31 01206^
5663	"DATA",900 2313.91,37 9,30,1,0)
5664	; This fie ld current ly not imp lemented
5665	"DATA",900 2313.91,38 0,0)
5666	380^^QUEST ION DATE R ESPONSE^N^ ^^^8^N
5667	"DATA",900 2313.91,38 0,5)
5668	4G^8
5669	"DATA",900 2313.91,38 0,10,0)
5670	^9002313.9 101^1^1^31 01101
5671	"DATA",900 2313.91,38 0,10,1,0)
5672	S BPS("X") =""
5673	"DATA",900 2313.91,38 0,20,0)
5674	^9002313.9 102^1^1^31 01101
5675	"DATA",900 2313.91,38 0,20,1,0)
5676	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
5677	"DATA",900 2313.91,38 0,30,0)
5678	^9002313.9 103^1^1^31 01206^
5679	"DATA",900 2313.91,38 0,30,1,0)
5680	; This fie ld current ly not imp lemented
5681	"DATA",900 2313.91,38 1,0)
5682	381^^QUEST ION DOLLAR AMT RESPO NSE^N^^^^1 1^D
5683	"DATA",900 2313.91,38 1,1)
5684	QUESTION D OLLAR AMOU NT RESPONS E
5685	"DATA",900 2313.91,38 1,5)
5686	4H^9
5687	"DATA",900 2313.91,38 1,10,0)
5688	^9002313.9 101^1^1^31 01101
5689	"DATA",900 2313.91,38 1,10,1,0)
5690	S BPS("X") =""
5691	"DATA",900 2313.91,38 1,20,0)
5692	^9002313.9 102^1^1^31 01101
5693	"DATA",900 2313.91,38 1,20,1,0)
5694	S BPS("X") =$$DFF^BPS ECFM($G(BP S("X")),11 )
5695	"DATA",900 2313.91,38 1,30,0)
5696	^9002313.9 103^1^1^31 01206^
5697	"DATA",900 2313.91,38 1,30,1,0)
5698	; This fie ld current ly not imp lemented
5699	"DATA",900 2313.91,38 2,0)
5700	382^^QUEST ION NUMERI C RESPONSE ^N^^^^11^N
5701	"DATA",900 2313.91,38 2,5)
5702	4J^11
5703	"DATA",900 2313.91,38 2,10,0)
5704	^9002313.9 101^1^1^31 01101
5705	"DATA",900 2313.91,38 2,10,1,0)
5706	S BPS("X") =""
5707	"DATA",900 2313.91,38 2,20,0)
5708	^9002313.9 102^1^1^31 01101
5709	"DATA",900 2313.91,38 2,20,1,0)
5710	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),11 )
5711	"DATA",900 2313.91,38 2,30,0)
5712	^9002313.9 103^1^1^31 01206^
5713	"DATA",900 2313.91,38 2,30,1,0)
5714	; This fie ld current ly not imp lemented
5715	"DATA",900 2313.91,38 3,0)
5716	383^^QUEST ION ALPHAN UMERIC RES PONSE^A/N^ ^^^30^A/N
5717	"DATA",900 2313.91,38 3,5)
5718	4K^30
5719	"DATA",900 2313.91,38 3,10,0)
5720	^9002313.9 101^1^1^31 01101
5721	"DATA",900 2313.91,38 3,10,1,0)
5722	S BPS("X") =""
5723	"DATA",900 2313.91,38 3,20,0)
5724	^9002313.9 102^1^1^31 01101
5725	"DATA",900 2313.91,38 3,20,1,0)
5726	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
5727	"DATA",900 2313.91,38 3,30,0)
5728	^9002313.9 103^1^1^31 01206^
5729	"DATA",900 2313.91,38 3,30,1,0)
5730	; This fie ld current ly not imp lemented
5731	"DATA",900 2313.91,38 4,0)
5732	385^^FACIL ITY NAME^A /N^^^^30^A /N
5733	"DATA",900 2313.91,38 4,5)
5734	3Q^30
5735	"DATA",900 2313.91,38 4,10,0)
5736	^9002313.9 101^1^1^31 01101
5737	"DATA",900 2313.91,38 4,10,1,0)
5738	S BPS("X") =""
5739	"DATA",900 2313.91,38 4,20,0)
5740	^9002313.9 102^1^1^31 01101
5741	"DATA",900 2313.91,38 4,20,1,0)
5742	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
5743	"DATA",900 2313.91,38 4,30,0)
5744	^9002313.9 103^1^1^31 00925^
5745	"DATA",900 2313.91,38 4,30,1,0)
5746	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 80),U,5)=" "
5747	"DATA",900 2313.91,38 5,0)
5748	386^^FACIL ITY STREET ADDRESS^A /N^^^^30^A /N
5749	"DATA",900 2313.91,38 5,5)
5750	3U^30
5751	"DATA",900 2313.91,38 5,10,0)
5752	^9002313.9 101^1^1^31 01101
5753	"DATA",900 2313.91,38 5,10,1,0)
5754	S BPS("X") =""
5755	"DATA",900 2313.91,38 5,20,0)
5756	^9002313.9 102^1^1^31 01101
5757	"DATA",900 2313.91,38 5,20,1,0)
5758	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
5759	"DATA",900 2313.91,38 5,30,0)
5760	^9002313.9 103^1^1^31 00925^
5761	"DATA",900 2313.91,38 5,30,1,0)
5762	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 80),U,6)=" "
5763	"DATA",900 2313.91,38 6,0)
5764	387^^FACIL ITY STATE/ PROV ADDRE SS^A/N^^^^ 2^A/N
5765	"DATA",900 2313.91,38 6,1)
5766	FACILITY S TATE/PROVI NCE ADDRES S
5767	"DATA",900 2313.91,38 6,5)
5768	3V^2
5769	"DATA",900 2313.91,38 6,10,0)
5770	^9002313.9 101^1^1^31 01101
5771	"DATA",900 2313.91,38 6,10,1,0)
5772	S BPS("X") =""
5773	"DATA",900 2313.91,38 6,20,0)
5774	^9002313.9 102^1^1^31 01101
5775	"DATA",900 2313.91,38 6,20,1,0)
5776	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
5777	"DATA",900 2313.91,38 6,30,0)
5778	^9002313.9 103^1^1^31 00925^
5779	"DATA",900 2313.91,38 6,30,1,0)
5780	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 80),U,7)=" "
5781	"DATA",900 2313.91,38 7,0)
5782	388^^FACIL ITY CITY A DDRESS^A/N ^^^^20^A/N
5783	"DATA",900 2313.91,38 7,5)
5784	5J^20
5785	"DATA",900 2313.91,38 7,10,0)
5786	^9002313.9 101^1^1^31 01101
5787	"DATA",900 2313.91,38 7,10,1,0)
5788	S BPS("X") =""
5789	"DATA",900 2313.91,38 7,20,0)
5790	^9002313.9 102^1^1^31 01101
5791	"DATA",900 2313.91,38 7,20,1,0)
5792	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
5793	"DATA",900 2313.91,38 7,30,0)
5794	^9002313.9 103^1^1^31 00925^
5795	"DATA",900 2313.91,38 7,30,1,0)
5796	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 80),U,8)=" "
5797	"DATA",900 2313.91,38 8,0)
5798	389^^FACIL ITY ZIP/PO STAL ZONE^ A/N^^^^15^ A/N
5799	"DATA",900 2313.91,38 8,5)
5800	6D^16
5801	"DATA",900 2313.91,38 8,10,0)
5802	^9002313.9 101^1^1^31 01101
5803	"DATA",900 2313.91,38 8,10,1,0)
5804	S BPS("X") =""
5805	"DATA",900 2313.91,38 8,20,0)
5806	^9002313.9 102^1^1^31 01101
5807	"DATA",900 2313.91,38 8,20,1,0)
5808	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
5809	"DATA",900 2313.91,38 8,30,0)
5810	^9002313.9 103^1^1^31 00925^
5811	"DATA",900 2313.91,38 8,30,1,0)
5812	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 80),U,9)=" "
5813	"DATA",900 2313.91,38 9,0)
5814	390^^NARRA TIVE MESSA GE^A/N^^^^ 200^A/N
5815	"DATA",900 2313.91,38 9,5)
5816	BM^200
5817	"DATA",900 2313.91,38 9,10,0)
5818	^9002313.9 101^1^1^31 01110^
5819	"DATA",900 2313.91,38 9,10,1,0)
5820	S BPS("X") =""
5821	"DATA",900 2313.91,38 9,20,0)
5822	^9002313.9 102^1^1^31 01110^
5823	"DATA",900 2313.91,38 9,20,1,0)
5824	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 00)
5825	"DATA",900 2313.91,38 9,30,0)
5826	^9002313.9 103^1^1^31 01110^^
5827	"DATA",900 2313.91,38 9,30,1,0)
5828	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),3 89),U,2)=" "
5829	"DATA",900 2313.91,39 0,0)
5830	130^^ADDIT IONAL MESS AGE INFO C OUNT^N^^^^ 2^N
5831	"DATA",900 2313.91,39 0,5)
5832	UF^2
5833	"DATA",900 2313.91,39 0,10,0)
5834	^9002313.9 101^1^1^31 01206^
5835	"DATA",900 2313.91,39 0,10,1,0)
5836	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5837	"DATA",900 2313.91,39 1,0)
5838	132^^ADDIT IONAL MSG INFO QUALI FIER^A/N^^ ^^2^A/N
5839	"DATA",900 2313.91,39 1,5)
5840	UH^2
5841	"DATA",900 2313.91,39 1,10,0)
5842	^9002313.9 101^1^1^31 01206^
5843	"DATA",900 2313.91,39 1,10,1,0)
5844	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5845	"DATA",900 2313.91,39 2,0)
5846	131^^ADDIT IONAL MSG INFO CONTI NUITY^N^^^ ^1^A/N
5847	"DATA",900 2313.91,39 2,5)
5848	UG^2
5849	"DATA",900 2313.91,39 2,10,0)
5850	^9002313.9 101^1^1^31 01206^
5851	"DATA",900 2313.91,39 2,10,1,0)
5852	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5853	"DATA",900 2313.91,39 3,0)
5854	987^^URL^A /N^^^^255^ A/N
5855	"DATA",900 2313.91,39 3,5)
5856	MA^255
5857	"DATA",900 2313.91,39 3,10,0)
5858	^9002313.9 101^1^1^31 01206^
5859	"DATA",900 2313.91,39 3,10,1,0)
5860	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5861	"DATA",900 2313.91,39 4,0)
5862	571^^AMOUN T ATTRIB T O PROCESSO R FEE^N^^^ ^8^N
5863	"DATA",900 2313.91,39 4,5)
5864	NZ^8
5865	"DATA",900 2313.91,39 4,10,0)
5866	^9002313.9 101^1^1^31 01206^
5867	"DATA",900 2313.91,39 4,10,1,0)
5868	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5869	"DATA",900 2313.91,39 5,0)
5870	575^^PATIE NT SALES T AX^N^^^^8^ N
5871	"DATA",900 2313.91,39 5,5)
5872	EQ^8
5873	"DATA",900 2313.91,39 5,10,0)
5874	^9002313.9 101^1^1^31 01206^
5875	"DATA",900 2313.91,39 5,10,1,0)
5876	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5877	"DATA",900 2313.91,39 6,0)
5878	574^^PLAN SALES TAX AMOUNT^N^^ ^^8^N
5879	"DATA",900 2313.91,39 6,5)
5880	2Y^8
5881	"DATA",900 2313.91,39 6,10,0)
5882	^9002313.9 101^1^1^31 01206^
5883	"DATA",900 2313.91,39 6,10,1,0)
5884	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5885	"DATA",900 2313.91,39 7,0)
5886	572^^AMOUN T OF COINS URANCE^N^^ ^^8^N
5887	"DATA",900 2313.91,39 7,5)
5888	4U^8
5889	"DATA",900 2313.91,39 7,10,0)
5890	^9002313.9 101^1^1^31 01206^
5891	"DATA",900 2313.91,39 7,10,1,0)
5892	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5893	"DATA",900 2313.91,39 8,0)
5894	573^^BASIS OF CALC - COINSURAN CE^A/N^^^^ 2^A/N
5895	"DATA",900 2313.91,39 8,5)
5896	4V^2
5897	"DATA",900 2313.91,39 8,10,0)
5898	^9002313.9 101^1^1^31 01206^
5899	"DATA",900 2313.91,39 8,10,1,0)
5900	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5901	"DATA",900 2313.91,39 9,0)
5902	577^^ESTIM ATED GENER IC SAVINGS ^N^^^^8^N
5903	"DATA",900 2313.91,39 9,5)
5904	G3^8
5905	"DATA",900 2313.91,39 9,10,0)
5906	^9002313.9 101^1^1^31 01206^
5907	"DATA",900 2313.91,39 9,10,1,0)
5908	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5909	"DATA",900 2313.91,40 0,0)
5910	128^^SPEND ING ACCOUN T AMT REMA INING^N^^^ ^8^N
5911	"DATA",900 2313.91,40 0,5)
5912	UC^8
5913	"DATA",900 2313.91,40 0,10,0)
5914	^9002313.9 101^1^1^31 01206^
5915	"DATA",900 2313.91,40 0,10,1,0)
5916	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5917	"DATA",900 2313.91,40 1,0)
5918	129^^HEALT H PLAN-FUN DED ASSIST AMT^N^^^^ 8^N
5919	"DATA",900 2313.91,40 1,5)
5920	UD^8
5921	"DATA",900 2313.91,40 1,10,0)
5922	^9002313.9 101^1^1^31 01206^
5923	"DATA",900 2313.91,40 1,10,1,0)
5924	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5925	"DATA",900 2313.91,40 2,0)
5926	133^^AMT A TTR TO PRO V NETWORK SLCTN^N^^^ ^8^N
5927	"DATA",900 2313.91,40 2,5)
5928	UJ^8
5929	"DATA",900 2313.91,40 2,10,0)
5930	^9002313.9 101^1^1^31 01206^
5931	"DATA",900 2313.91,40 2,10,1,0)
5932	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5933	"DATA",900 2313.91,40 3,0)
5934	134^^AMT A TTR TO PRO D SEL BRND DRUG^N^^^ ^8^N
5935	"DATA",900 2313.91,40 3,5)
5936	UK^8
5937	"DATA",900 2313.91,40 3,10,0)
5938	^9002313.9 101^1^1^31 01206^
5939	"DATA",900 2313.91,40 3,10,1,0)
5940	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5941	"DATA",900 2313.91,40 4,0)
5942	135^^AMT A TTR NON-PR EF FRMLRY SEL^N^^^^8 ^N
5943	"DATA",900 2313.91,40 4,5)
5944	UM^8
5945	"DATA",900 2313.91,40 4,10,0)
5946	^9002313.9 101^1^1^31 01206^
5947	"DATA",900 2313.91,40 4,10,1,0)
5948	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5949	"DATA",900 2313.91,40 5,0)
5950	136^^AMT A TTR TO N-P REF FRMLRY SEL^N^^^^ 8^N
5951	"DATA",900 2313.91,40 5,5)
5952	UN^8
5953	"DATA",900 2313.91,40 5,10,0)
5954	^9002313.9 101^1^1^31 01206^
5955	"DATA",900 2313.91,40 5,10,1,0)
5956	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5957	"DATA",900 2313.91,40 6,0)
5958	137^^AMOUN T ATTR TO COVERAGE G AP^N^^^^8^ N
5959	"DATA",900 2313.91,40 6,5)
5960	UP^8
5961	"DATA",900 2313.91,40 6,10,0)
5962	^9002313.9 101^1^1^31 01206^
5963	"DATA",900 2313.91,40 6,10,1,0)
5964	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5965	"DATA",900 2313.91,40 7,0)
5966	148^^INGRE D COST CNT RCTD REIMB AMT^N^^^^ 8^N
5967	"DATA",900 2313.91,40 7,5)
5968	U8^8
5969	"DATA",900 2313.91,40 7,10,0)
5970	^9002313.9 101^1^1^31 01206^
5971	"DATA",900 2313.91,40 7,10,1,0)
5972	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5973	"DATA",900 2313.91,40 8,0)
5974	149^^DISP FEE CNTRCT D REIMB AM T^N^^^^8^N
5975	"DATA",900 2313.91,40 8,5)
5976	U9^8
5977	"DATA",900 2313.91,40 8,10,0)
5978	^9002313.9 101^1^1^31 01206^
5979	"DATA",900 2313.91,40 8,10,1,0)
5980	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5981	"DATA",900 2313.91,40 9,0)
5982	570^^DUR A DDITIONAL TEXT^A/N^^ ^^100^A/N
5983	"DATA",900 2313.91,40 9,5)
5984	NS^100
5985	"DATA",900 2313.91,40 9,10,0)
5986	^9002313.9 101^1^1^31 01206^
5987	"DATA",900 2313.91,40 9,10,1,0)
5988	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5989	"DATA",900 2313.91,41 0,0)
5990	355^^OTHER PAYER ID COUNT^N^^^ ^1^N
5991	"DATA",900 2313.91,41 0,5)
5992	NT^1
5993	"DATA",900 2313.91,41 0,10,0)
5994	^9002313.9 101^1^1^31 01206^
5995	"DATA",900 2313.91,41 0,10,1,0)
5996	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
5997	"DATA",900 2313.91,41 1,0)
5998	142^^OTHER PAYER PER SON CODE^A /N^^^^3^A/ N
5999	"DATA",900 2313.91,41 1,5)
6000	UV^3
6001	"DATA",900 2313.91,41 1,10,0)
6002	^9002313.9 101^1^1^31 01206^
6003	"DATA",900 2313.91,41 1,10,1,0)
6004	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6005	"DATA",900 2313.91,41 2,0)
6006	127^^OTHER PAYER HEL P DESK PH NUM^A/N^^^ ^18^A/N
6007	"DATA",900 2313.91,41 2,1)
6008	OTHER PAYE R HELP DES K TELEPHON E NUMBER
6009	"DATA",900 2313.91,41 2,5)
6010	UB^18
6011	"DATA",900 2313.91,41 2,10,0)
6012	^9002313.9 101^1^1^31 01206^
6013	"DATA",900 2313.91,41 2,10,1,0)
6014	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6015	"DATA",900 2313.91,41 3,0)
6016	143^^OTHER PAYER PAT IENT REL C ODE^N^^^^1 ^N
6017	"DATA",900 2313.91,41 3,5)
6018	UW^1
6019	"DATA",900 2313.91,41 3,10,0)
6020	^9002313.9 101^1^1^31 01206^
6021	"DATA",900 2313.91,41 3,10,1,0)
6022	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6023	"DATA",900 2313.91,41 4,0)
6024	144^^OTHER PAYER EFF ECTIVE DAT E^N^^^^8^N
6025	"DATA",900 2313.91,41 4,5)
6026	UX^8
6027	"DATA",900 2313.91,41 4,10,0)
6028	^9002313.9 101^1^1^31 01206^
6029	"DATA",900 2313.91,41 4,10,1,0)
6030	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6031	"DATA",900 2313.91,41 5,0)
6032	145^^OTHER PAYER TER MINATION D ATE^N^^^^8 ^N
6033	"DATA",900 2313.91,41 5,5)
6034	UY^8
6035	"DATA",900 2313.91,41 5,10,0)
6036	^9002313.9 101^1^1^31 01206^
6037	"DATA",900 2313.91,41 5,10,1,0)
6038	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6039	"DATA",900 2313.91,41 6,0)
6040	139^^MEDIC ARE PART D COVERAGE CODE^N^^^^ 2^N
6041	"DATA",900 2313.91,41 6,5)
6042	UR^2
6043	"DATA",900 2313.91,41 6,10,0)
6044	^9002313.9 101^1^1^31 01206^
6045	"DATA",900 2313.91,41 6,10,1,0)
6046	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6047	"DATA",900 2313.91,41 7,0)
6048	138^^CMS L ICS LEVEL^ A/N^^^^20^ A/N
6049	"DATA",900 2313.91,41 7,5)
6050	UQ^20
6051	"DATA",900 2313.91,41 7,10,0)
6052	^9002313.9 101^1^1^31 01206^
6053	"DATA",900 2313.91,41 7,10,1,0)
6054	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6055	"DATA",900 2313.91,41 8,0)
6056	240^^CONTR ACT NUMBER ^A/N^^^^8^ A/N
6057	"DATA",900 2313.91,41 8,5)
6058	U1^8
6059	"DATA",900 2313.91,41 8,10,0)
6060	^9002313.9 101^1^1^31 01206^
6061	"DATA",900 2313.91,41 8,10,1,0)
6062	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6063	"DATA",900 2313.91,41 9,0)
6064	926^^FORMU LARY ID^A/ N^^^^10^A/ N
6065	"DATA",900 2313.91,41 9,5)
6066	FF^10
6067	"DATA",900 2313.91,41 9,10,0)
6068	^9002313.9 101^1^1^31 01206^
6069	"DATA",900 2313.91,41 9,10,1,0)
6070	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6071	"DATA",900 2313.91,42 0,0)
6072	757^^BENEF IT ID^A/N^ ^^^15^A/N
6073	"DATA",900 2313.91,42 0,5)
6074	U6^15
6075	"DATA",900 2313.91,42 0,10,0)
6076	^9002313.9 101^1^1^31 01206^
6077	"DATA",900 2313.91,42 0,10,1,0)
6078	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6079	"DATA",900 2313.91,42 1,0)
6080	140^^NEXT MEDICARE P ART D EFF DATE^N^^^^ 8^N
6081	"DATA",900 2313.91,42 1,5)
6082	US^8
6083	"DATA",900 2313.91,42 1,10,0)
6084	^9002313.9 101^1^1^31 01206^
6085	"DATA",900 2313.91,42 1,10,1,0)
6086	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6087	"DATA",900 2313.91,42 2,0)
6088	141^^NEXT MEDICARE P ART D TERM DATE^N^^^ ^8^N
6089	"DATA",900 2313.91,42 2,5)
6090	UT^8
6091	"DATA",900 2313.91,42 2,10,0)
6092	^9002313.9 101^1^1^31 01206^
6093	"DATA",900 2313.91,42 2,10,1,0)
6094	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6095	"DATA",900 2313.91,42 3,0)
6096	123^^PAY T O STATE/PR OVINCE ADD RESS^A/N^^ ^^2^A/N
6097	"DATA",900 2313.91,42 3,1)
6098	PAY TO STA TE/ PROVIN CE ADDRESS
6099	"DATA",900 2313.91,42 3,5)
6100	TX^2
6101	"DATA",900 2313.91,42 3,10,0)
6102	^9002313.9 101^1^1^31 01101
6103	"DATA",900 2313.91,42 3,10,1,0)
6104	S BPS("X") =""
6105	"DATA",900 2313.91,42 3,20,0)
6106	^9002313.9 102^1^1^31 01101
6107	"DATA",900 2313.91,42 3,20,1,0)
6108	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6109	"DATA",900 2313.91,42 3,30,0)
6110	^9002313.9 103^1^1^31 00924^
6111	"DATA",900 2313.91,42 3,30,1,0)
6112	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),1 20),U,3)=" "
6113	"DATA",900 2313.91,42 4,0)
6114	579^^ASSOC RX/SERVIC E PROV ID QUAL^A/N^^ ^^2^A/N
6115	"DATA",900 2313.91,42 4,1)
6116	ASSOCIATED PRESCRIPT ION / SERV ICE PROVID ER ID QUAL IFIER
6117	"DATA",900 2313.91,42 4,5)
6118	XX^2
6119	"DATA",900 2313.91,42 4,10,0)
6120	^^1^1^3130 311^
6121	"DATA",900 2313.91,42 4,10,1,0)
6122	S BPS("X") =""
6123	"DATA",900 2313.91,42 4,20,0)
6124	^9002313.9 102^1^1^31 30311^^^^
6125	"DATA",900 2313.91,42 4,20,1,0)
6126	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6127	"DATA",900 2313.91,42 4,25,0)
6128	^9002313.9 104^1^1^31 30311^^^^
6129	"DATA",900 2313.91,42 4,25,1,0)
6130	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6131	"DATA",900 2313.91,42 4,30,0)
6132	^9002313.9 103^1^1^31 30311^^^
6133	"DATA",900 2313.91,42 4,30,1,0)
6134	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 70),U,9)=$ G(BPS("X") )
6135	"DATA",900 2313.91,42 5,0)
6136	580^^ASSOC RX/SERVIC E PROVIDER ID^A/N^^^ ^15^A/N
6137	"DATA",900 2313.91,42 5,1)
6138	ASSOCIATED PRESCRIPT ION / SERV ICE PROVID ER ID
6139	"DATA",900 2313.91,42 5,5)
6140	XY^15
6141	"DATA",900 2313.91,42 5,10,0)
6142	^9002313.9 101^1^1^31 30222^^
6143	"DATA",900 2313.91,42 5,10,1,0)
6144	S BPS("X") =""
6145	"DATA",900 2313.91,42 5,20,0)
6146	^9002313.9 102^1^1^31 30222^^
6147	"DATA",900 2313.91,42 5,20,1,0)
6148	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6149	"DATA",900 2313.91,42 5,25,0)
6150	^9002313.9 104^1^1^31 30222^^
6151	"DATA",900 2313.91,42 5,25,1,0)
6152	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6153	"DATA",900 2313.91,42 5,30,0)
6154	^^1^1^3130 222^
6155	"DATA",900 2313.91,42 5,30,1,0)
6156	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 70),U,10)= BPS("X")
6157	"DATA",900 2313.91,42 6,0)
6158	581^^ASSOC RX/SERVIC E REF NUM QUAL^A/N^^ ^^2^A/N
6159	"DATA",900 2313.91,42 6,1)
6160	ASSOCIATED PRESCRIPT ION / SERV ICE REFERE NCE NUMBER QUALIFIER
6161	"DATA",900 2313.91,42 6,5)
6162	XZ^2
6163	"DATA",900 2313.91,42 6,10,0)
6164	^^1^1^3130 222^
6165	"DATA",900 2313.91,42 6,10,1,0)
6166	S BPS("X") =""
6167	"DATA",900 2313.91,42 6,20,0)
6168	^^1^1^3130 222^
6169	"DATA",900 2313.91,42 6,20,1,0)
6170	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6171	"DATA",900 2313.91,42 6,25,0)
6172	^^1^1^3130 222^
6173	"DATA",900 2313.91,42 6,25,1,0)
6174	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6175	"DATA",900 2313.91,42 6,30,0)
6176	^^1^1^3130 222^
6177	"DATA",900 2313.91,42 6,30,1,0)
6178	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 80),U,1)=B PS("X")
6179	"DATA",900 2313.91,42 7,0)
6180	582^^ASSOC RX/SERVIC E FILL NUM BER^N^^^^2 ^N
6181	"DATA",900 2313.91,42 7,1)
6182	ASSOCIATED PRESCRIPT ION SERVIC E FILL NUM BER
6183	"DATA",900 2313.91,42 7,5)
6184	X0^2
6185	"DATA",900 2313.91,42 7,10,0)
6186	^^1^1^3130 222^
6187	"DATA",900 2313.91,42 7,10,1,0)
6188	S BPS("X") =""
6189	"DATA",900 2313.91,42 7,20,0)
6190	^^1^1^3130 222^
6191	"DATA",900 2313.91,42 7,20,1,0)
6192	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
6193	"DATA",900 2313.91,42 7,25,0)
6194	^^1^1^3130 222^
6195	"DATA",900 2313.91,42 7,25,1,0)
6196	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
6197	"DATA",900 2313.91,42 7,30,0)
6198	^^1^1^3130 222^
6199	"DATA",900 2313.91,42 7,30,1,0)
6200	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 80),U,2)=$ G(BPS("X") )
6201	"DATA",900 2313.91,42 8,0)
6202	583^^SERVI CE PROVIDE R NAME^A/N ^^^^30^A/N
6203	"DATA",900 2313.91,42 8,1)
6204	SERVICE PR OVIDE NAME
6205	"DATA",900 2313.91,42 8,5)
6206	YK^30
6207	"DATA",900 2313.91,42 8,10,0)
6208	^^1^1^3130 228^
6209	"DATA",900 2313.91,42 8,10,1,0)
6210	S BPS("X") =""
6211	"DATA",900 2313.91,42 8,20,0)
6212	^^1^1^3130 222^
6213	"DATA",900 2313.91,42 8,20,1,0)
6214	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
6215	"DATA",900 2313.91,42 8,25,0)
6216	^^1^1^3130 222^
6217	"DATA",900 2313.91,42 8,25,1,0)
6218	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
6219	"DATA",900 2313.91,42 8,30,0)
6220	^^1^1^3130 222^
6221	"DATA",900 2313.91,42 8,30,1,0)
6222	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 80),U,3)=B PS("X")
6223	"DATA",900 2313.91,42 9,0)
6224	584^^SERVI CE PROVIDE R STREET^A /N^^^^30^A /N
6225	"DATA",900 2313.91,42 9,1)
6226	SERVICE PR OVIDER STR EET ADDRES S
6227	"DATA",900 2313.91,42 9,5)
6228	YM^30
6229	"DATA",900 2313.91,42 9,10,0)
6230	^^1^1^3130 222^
6231	"DATA",900 2313.91,42 9,10,1,0)
6232	S BPS("X") =""
6233	"DATA",900 2313.91,42 9,20,0)
6234	^^1^1^3130 222^
6235	"DATA",900 2313.91,42 9,20,1,0)
6236	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
6237	"DATA",900 2313.91,42 9,25,0)
6238	^^1^1^3130 222^
6239	"DATA",900 2313.91,42 9,25,1,0)
6240	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
6241	"DATA",900 2313.91,42 9,30,0)
6242	^^1^1^3130 222^
6243	"DATA",900 2313.91,42 9,30,1,0)
6244	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 80),U,4)=B PS("X")
6245	"DATA",900 2313.91,43 0,0)
6246	585^^SERVI CE PROVIDE R CITY^A/N ^^^^20^A/N
6247	"DATA",900 2313.91,43 0,1)
6248	SERVICE PR OVIDER CIT Y ADDRESS
6249	"DATA",900 2313.91,43 0,5)
6250	YN^20
6251	"DATA",900 2313.91,43 0,10,0)
6252	^9002313.9 101^1^1^31 30228^^
6253	"DATA",900 2313.91,43 0,10,1,0)
6254	S BPS("X") =""
6255	"DATA",900 2313.91,43 0,20,0)
6256	^^1^1^3130 222^
6257	"DATA",900 2313.91,43 0,20,1,0)
6258	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
6259	"DATA",900 2313.91,43 0,25,0)
6260	^^1^1^3130 222^
6261	"DATA",900 2313.91,43 0,25,1,0)
6262	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
6263	"DATA",900 2313.91,43 0,30,0)
6264	^^1^1^3130 222^
6265	"DATA",900 2313.91,43 0,30,1,0)
6266	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 80),U,5)=B PS("X")
6267	"DATA",900 2313.91,43 1,0)
6268	586^^SERVI CE PROVIDE STATE/PRO VINCE^A/N^ ^^^2^A/N
6269	"DATA",900 2313.91,43 1,1)
6270	SERVICE PR OVIDER STA TE/PROVINC E ADDRESS
6271	"DATA",900 2313.91,43 1,5)
6272	YP^2
6273	"DATA",900 2313.91,43 1,10,0)
6274	^^1^1^3130 222^
6275	"DATA",900 2313.91,43 1,10,1,0)
6276	S BPS("X") =""
6277	"DATA",900 2313.91,43 1,20,0)
6278	^^1^1^3130 222^
6279	"DATA",900 2313.91,43 1,20,1,0)
6280	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6281	"DATA",900 2313.91,43 1,25,0)
6282	^^1^1^3130 222^
6283	"DATA",900 2313.91,43 1,25,1,0)
6284	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6285	"DATA",900 2313.91,43 1,30,0)
6286	^^1^1^3130 222^
6287	"DATA",900 2313.91,43 1,30,1,0)
6288	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 80),U,6)=B PS("X")
6289	"DATA",900 2313.91,43 2,0)
6290	587^^SERVI CE PROVIDE R ZIP/POST CODE^A/N^ ^^^15^A/N
6291	"DATA",900 2313.91,43 2,1)
6292	SERVICE PR OVIDER ZIP /POSTAL CO DE
6293	"DATA",900 2313.91,43 2,5)
6294	YQ^15
6295	"DATA",900 2313.91,43 2,10,0)
6296	^9002313.9 101^1^1^31 30222^^
6297	"DATA",900 2313.91,43 2,10,1,0)
6298	S BPS("X") =""
6299	"DATA",900 2313.91,43 2,20,0)
6300	^9002313.9 102^1^1^31 30222^^
6301	"DATA",900 2313.91,43 2,20,1,0)
6302	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6303	"DATA",900 2313.91,43 2,25,0)
6304	^9002313.9 104^1^1^31 30222^^
6305	"DATA",900 2313.91,43 2,25,1,0)
6306	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6307	"DATA",900 2313.91,43 2,30,0)
6308	^^1^1^3130 222^
6309	"DATA",900 2313.91,43 2,30,1,0)
6310	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 80),U,7)=B PS("X")
6311	"DATA",900 2313.91,43 3,0)
6312	590^^SELLE R INITIALS ^A/N^^^^3^ A/N
6313	"DATA",900 2313.91,43 3,1)
6314	SELLER INI TIALS
6315	"DATA",900 2313.91,43 3,5)
6316	YT^3
6317	"DATA",900 2313.91,43 3,10,0)
6318	^^1^1^3130 222^
6319	"DATA",900 2313.91,43 3,10,1,0)
6320	S BPS("X") =BPS("Prov ider",MEDN ,"Pharmaci st Initial s")
6321	"DATA",900 2313.91,43 3,20,0)
6322	^9002313.9 102^1^1^31 30222^^^^
6323	"DATA",900 2313.91,43 3,20,1,0)
6324	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
6325	"DATA",900 2313.91,43 3,25,0)
6326	^9002313.9 104^1^1^31 30222^^^^
6327	"DATA",900 2313.91,43 3,25,1,0)
6328	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 )
6329	"DATA",900 2313.91,43 3,30,0)
6330	^9002313.9 103^1^1^31 30222^^^^
6331	"DATA",900 2313.91,43 3,30,1,0)
6332	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 80),U,10)= BPS("X")
6333	"DATA",900 2313.91,43 4,0)
6334	591^^PURCH ASER ID QU ALIFIER^N^ ^^^2^N
6335	"DATA",900 2313.91,43 4,1)
6336	PURCHASER ID QUALIFI ER
6337	"DATA",900 2313.91,43 4,5)
6338	YU^2
6339	"DATA",900 2313.91,43 4,10,0)
6340	^9002313.9 101^1^1^31 30222^^
6341	"DATA",900 2313.91,43 4,10,1,0)
6342	S BPS("X") =""
6343	"DATA",900 2313.91,43 4,20,0)
6344	^9002313.9 102^1^1^31 30222^^
6345	"DATA",900 2313.91,43 4,20,1,0)
6346	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
6347	"DATA",900 2313.91,43 4,25,0)
6348	^9002313.9 104^1^1^31 30222^^
6349	"DATA",900 2313.91,43 4,25,1,0)
6350	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
6351	"DATA",900 2313.91,43 4,30,0)
6352	^^1^1^3130 222^
6353	"DATA",900 2313.91,43 4,30,1,0)
6354	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 90),U,1)=B PS("X")
6355	"DATA",900 2313.91,43 5,0)
6356	592^^PURCH ASER ID^A/ N^^^^20^A/ N
6357	"DATA",900 2313.91,43 5,1)
6358	PURCHASER ID
6359	"DATA",900 2313.91,43 5,5)
6360	YV^20
6361	"DATA",900 2313.91,43 5,10,0)
6362	^9002313.9 101^1^1^31 30222^^
6363	"DATA",900 2313.91,43 5,10,1,0)
6364	S BPS("X") =""
6365	"DATA",900 2313.91,43 5,20,0)
6366	^9002313.9 102^1^1^31 30222^^
6367	"DATA",900 2313.91,43 5,20,1,0)
6368	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
6369	"DATA",900 2313.91,43 5,25,0)
6370	^9002313.9 104^1^1^31 30222^^
6371	"DATA",900 2313.91,43 5,25,1,0)
6372	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
6373	"DATA",900 2313.91,43 5,30,0)
6374	^^1^1^3130 222^
6375	"DATA",900 2313.91,43 5,30,1,0)
6376	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 90),U,2)=B PS("X")
6377	"DATA",900 2313.91,43 6,0)
6378	593^^PURCH ASER ID ST ATE/PROVIN CE^A/N^^^^ 2^A/N
6379	"DATA",900 2313.91,43 6,1)
6380	PURCHASER ID ASSOCIA TED STATE/ PROVINCE A DDRESS
6381	"DATA",900 2313.91,43 6,5)
6382	YW^2
6383	"DATA",900 2313.91,43 6,10,0)
6384	^9002313.9 101^1^1^31 30222^^
6385	"DATA",900 2313.91,43 6,10,1,0)
6386	S BPS("X") =""
6387	"DATA",900 2313.91,43 6,20,0)
6388	^9002313.9 102^1^1^31 30222^^
6389	"DATA",900 2313.91,43 6,20,1,0)
6390	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6391	"DATA",900 2313.91,43 6,25,0)
6392	^9002313.9 104^1^1^31 30222^^
6393	"DATA",900 2313.91,43 6,25,1,0)
6394	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6395	"DATA",900 2313.91,43 6,30,0)
6396	^^1^1^3130 222^
6397	"DATA",900 2313.91,43 6,30,1,0)
6398	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 90),U,3)=B PS("X")
6399	"DATA",900 2313.91,43 7,0)
6400	594^^PURCH ASER DATE OF BIRTH^N ^^^^8^N
6401	"DATA",900 2313.91,43 7,1)
6402	PURCHASER DATE OF BI RTH
6403	"DATA",900 2313.91,43 7,5)
6404	YX^8
6405	"DATA",900 2313.91,43 7,10,0)
6406	^9002313.9 101^1^1^31 30228^^^
6407	"DATA",900 2313.91,43 7,10,1,0)
6408	S BPS("X") =""
6409	"DATA",900 2313.91,43 7,20,0)
6410	^^1^1^3130 228^
6411	"DATA",900 2313.91,43 7,20,1,0)
6412	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
6413	"DATA",900 2313.91,43 7,25,0)
6414	^9002313.9 104^1^1^31 30228^^^
6415	"DATA",900 2313.91,43 7,25,1,0)
6416	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
6417	"DATA",900 2313.91,43 7,30,0)
6418	^9002313.9 103^1^1^31 30228^^
6419	"DATA",900 2313.91,43 7,30,1,0)
6420	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 90),U,4)=B PS("X")
6421	"DATA",900 2313.91,43 8,0)
6422	595^^PURCH ASER GENDE R CODE^N^^ ^^1^N
6423	"DATA",900 2313.91,43 8,1)
6424	PURCHASER GENDER COD E
6425	"DATA",900 2313.91,43 8,5)
6426	YY^1
6427	"DATA",900 2313.91,43 8,10,0)
6428	^^1^1^3130 228^
6429	"DATA",900 2313.91,43 8,10,1,0)
6430	S BPS("X") =""
6431	"DATA",900 2313.91,43 8,20,0)
6432	^^1^1^3130 222^
6433	"DATA",900 2313.91,43 8,20,1,0)
6434	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
6435	"DATA",900 2313.91,43 8,25,0)
6436	^^1^1^3130 222^
6437	"DATA",900 2313.91,43 8,25,1,0)
6438	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
6439	"DATA",900 2313.91,43 8,30,0)
6440	^^1^1^3130 222^
6441	"DATA",900 2313.91,43 8,30,1,0)
6442	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 90),U,5)=B PS("X")
6443	"DATA",900 2313.91,43 9,0)
6444	596^^PURCH ASER FIRST NAME^A/N^ ^^^12^A/N
6445	"DATA",900 2313.91,43 9,1)
6446	PURCHASER FIRST NAME
6447	"DATA",900 2313.91,43 9,5)
6448	YZ^12
6449	"DATA",900 2313.91,43 9,10,0)
6450	^^1^1^3130 222^
6451	"DATA",900 2313.91,43 9,10,1,0)
6452	S BPS("X") =""
6453	"DATA",900 2313.91,43 9,20,0)
6454	^^1^1^3130 222^
6455	"DATA",900 2313.91,43 9,20,1,0)
6456	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 2)
6457	"DATA",900 2313.91,43 9,25,0)
6458	^^1^1^3130 222^
6459	"DATA",900 2313.91,43 9,25,1,0)
6460	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 2)
6461	"DATA",900 2313.91,43 9,30,0)
6462	^^1^1^3130 222^
6463	"DATA",900 2313.91,43 9,30,1,0)
6464	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 90),U,6)=B PS("X")
6465	"DATA",900 2313.91,44 0,0)
6466	597^^PURCH ASER LAST NAME^A/N^^ ^^15^A/N
6467	"DATA",900 2313.91,44 0,1)
6468	PURCHASER LAST NAME
6469	"DATA",900 2313.91,44 0,5)
6470	Y0^15
6471	"DATA",900 2313.91,44 0,10,0)
6472	^9002313.9 101^1^1^31 30403^^
6473	"DATA",900 2313.91,44 0,10,1,0)
6474	S BPS("X") =""
6475	"DATA",900 2313.91,44 0,20,0)
6476	^9002313.9 102^1^1^31 30403^^
6477	"DATA",900 2313.91,44 0,20,1,0)
6478	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6479	"DATA",900 2313.91,44 0,25,0)
6480	^9002313.9 104^1^1^31 30403^^
6481	"DATA",900 2313.91,44 0,25,1,0)
6482	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6483	"DATA",900 2313.91,44 0,30,0)
6484	^9002313.9 103^1^1^31 30403^^
6485	"DATA",900 2313.91,44 0,30,1,0)
6486	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 90),U,7)=B PS("X")
6487	"DATA",900 2313.91,44 1,0)
6488	598^^PURCH ASER STREE T ADDRESS^ A/N^^^^30^ A/N
6489	"DATA",900 2313.91,44 1,1)
6490	PURCHASER STREET ADD RESS
6491	"DATA",900 2313.91,44 1,5)
6492	Y1^30
6493	"DATA",900 2313.91,44 1,10,0)
6494	^^1^1^3130 222^
6495	"DATA",900 2313.91,44 1,10,1,0)
6496	S BPS("X") =""
6497	"DATA",900 2313.91,44 1,20,0)
6498	^^1^1^3130 222^
6499	"DATA",900 2313.91,44 1,20,1,0)
6500	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
6501	"DATA",900 2313.91,44 1,25,0)
6502	^^1^1^3130 222^
6503	"DATA",900 2313.91,44 1,25,1,0)
6504	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 0)
6505	"DATA",900 2313.91,44 1,30,0)
6506	^^1^1^3130 222^
6507	"DATA",900 2313.91,44 1,30,1,0)
6508	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 90),U,8)=B PS("X")
6509	"DATA",900 2313.91,44 2,0)
6510	599^^PURCH ASER CITY ADDRESS^A/ N^^^^20^A/ N
6511	"DATA",900 2313.91,44 2,1)
6512	PURCHASER CITY ADDRE SS
6513	"DATA",900 2313.91,44 2,5)
6514	Y2^20
6515	"DATA",900 2313.91,44 2,10,0)
6516	^^1^1^3130 222^
6517	"DATA",900 2313.91,44 2,10,1,0)
6518	S BPS("X") =""
6519	"DATA",900 2313.91,44 2,20,0)
6520	^^1^1^3130 222^
6521	"DATA",900 2313.91,44 2,20,1,0)
6522	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
6523	"DATA",900 2313.91,44 2,25,0)
6524	^^1^1^3130 222^
6525	"DATA",900 2313.91,44 2,25,1,0)
6526	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
6527	"DATA",900 2313.91,44 2,30,0)
6528	^^1^1^3130 222^
6529	"DATA",900 2313.91,44 2,30,1,0)
6530	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),5 90),U,9)=B PS("X")
6531	"DATA",900 2313.91,44 3,0)
6532	675^^PURCH ASER STATE /PROVINCE CODE^A/N^^ ^^2^A/N
6533	"DATA",900 2313.91,44 3,1)
6534	PURCHASER ADDRESS ST ATE/PROVIN CE CODE
6535	"DATA",900 2313.91,44 3,5)
6536	Y3^2
6537	"DATA",900 2313.91,44 3,10,0)
6538	^9002313.9 101^1^1^31 30222^^
6539	"DATA",900 2313.91,44 3,10,1,0)
6540	S BPS("X") =""
6541	"DATA",900 2313.91,44 3,20,0)
6542	^^1^1^3130 222^
6543	"DATA",900 2313.91,44 3,20,1,0)
6544	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6545	"DATA",900 2313.91,44 3,25,0)
6546	^9002313.9 104^1^1^31 30222^^
6547	"DATA",900 2313.91,44 3,25,1,0)
6548	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6549	"DATA",900 2313.91,44 3,30,0)
6550	^^1^1^3130 222^
6551	"DATA",900 2313.91,44 3,30,1,0)
6552	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),6 70),U,5)=B PS("X")
6553	"DATA",900 2313.91,44 4,0)
6554	676^^PURCH ASER ZIP/P OSTAL CODE ^A/N^^^^15 ^A/N
6555	"DATA",900 2313.91,44 4,1)
6556	PURCHASER ZIP/POSTAL CODE
6557	"DATA",900 2313.91,44 4,5)
6558	Y4^15
6559	"DATA",900 2313.91,44 4,10,0)
6560	^9002313.9 101^1^1^31 30222^^
6561	"DATA",900 2313.91,44 4,10,1,0)
6562	S BPS("X") =""
6563	"DATA",900 2313.91,44 4,20,0)
6564	^9002313.9 102^1^1^31 30222^^
6565	"DATA",900 2313.91,44 4,20,1,0)
6566	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6567	"DATA",900 2313.91,44 4,25,0)
6568	^9002313.9 104^1^1^31 30222^^
6569	"DATA",900 2313.91,44 4,25,1,0)
6570	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6571	"DATA",900 2313.91,44 4,30,0)
6572	^9002313.9 103^1^1^31 30222^^^
6573	"DATA",900 2313.91,44 4,30,1,0)
6574	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),6 70),U,6)=B PS("X")
6575	"DATA",900 2313.91,44 5,0)
6576	677^^PURCH ASER COUNT RY CODE^A/ N^^^^2^A/N
6577	"DATA",900 2313.91,44 5,1)
6578	PURCHASER COUNTRY CO DE
6579	"DATA",900 2313.91,44 5,5)
6580	Y5^2
6581	"DATA",900 2313.91,44 5,10,0)
6582	^^1^1^3130 222^
6583	"DATA",900 2313.91,44 5,10,1,0)
6584	S BPS("X") =""
6585	"DATA",900 2313.91,44 5,20,0)
6586	^^1^1^3130 222^
6587	"DATA",900 2313.91,44 5,20,1,0)
6588	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6589	"DATA",900 2313.91,44 5,25,0)
6590	^^1^1^3130 222^
6591	"DATA",900 2313.91,44 5,25,1,0)
6592	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6593	"DATA",900 2313.91,44 5,30,0)
6594	^^1^1^3130 222^
6595	"DATA",900 2313.91,44 5,30,1,0)
6596	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),6 70),U,7)=B PS("X")
6597	"DATA",900 2313.91,44 6,0)
6598	678^^TIME OF SERVICE ^N^^^^6^N
6599	"DATA",900 2313.91,44 6,1)
6600	TIME OF SE RVICE
6601	"DATA",900 2313.91,44 6,5)
6602	Y6^6
6603	"DATA",900 2313.91,44 6,10,0)
6604	^^1^1^3130 222^
6605	"DATA",900 2313.91,44 6,10,1,0)
6606	S BPS("X") =BPS("Clai m",MEDN,"T ime of Ser vice")
6607	"DATA",900 2313.91,44 6,20,0)
6608	^9002313.9 102^1^1^31 30222^^
6609	"DATA",900 2313.91,44 6,20,1,0)
6610	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),6)
6611	"DATA",900 2313.91,44 6,25,0)
6612	^9002313.9 104^1^1^31 30222^^
6613	"DATA",900 2313.91,44 6,25,1,0)
6614	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),6)
6615	"DATA",900 2313.91,44 6,30,0)
6616	^9002313.9 103^1^1^31 30222^^
6617	"DATA",900 2313.91,44 6,30,1,0)
6618	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),6 70),U,8)=B PS("X")
6619	"DATA",900 2313.91,44 7,0)
6620	679^^SELLE R ID^A/N^^ ^^70^A/N
6621	"DATA",900 2313.91,44 7,1)
6622	SELLER ID
6623	"DATA",900 2313.91,44 7,5)
6624	Y9^70
6625	"DATA",900 2313.91,44 7,10,0)
6626	^^1^1^3130 222^
6627	"DATA",900 2313.91,44 7,10,1,0)
6628	S BPS("X") =BPS("Prov ider",MEDN ,"Pharmaci st ID")
6629	"DATA",900 2313.91,44 7,20,0)
6630	^9002313.9 102^1^1^31 30222^^
6631	"DATA",900 2313.91,44 7,20,1,0)
6632	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),7 0)
6633	"DATA",900 2313.91,44 7,25,0)
6634	^9002313.9 104^1^1^31 30222^^
6635	"DATA",900 2313.91,44 7,25,1,0)
6636	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),7 0)
6637	"DATA",900 2313.91,44 7,30,0)
6638	^9002313.9 103^1^1^31 30222^^
6639	"DATA",900 2313.91,44 7,30,1,0)
6640	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),6 70),U,9)=B PS("X")
6641	"DATA",900 2313.91,44 8,0)
6642	680^^SELLE R ID QUALI FIER^N^^^^ 2^N
6643	"DATA",900 2313.91,44 8,1)
6644	SELLER ID QUALIFIER
6645	"DATA",900 2313.91,44 8,5)
6646	ZB^2
6647	"DATA",900 2313.91,44 8,10,0)
6648	^^1^1^3130 226^
6649	"DATA",900 2313.91,44 8,10,1,0)
6650	S BPS("X") ="01"
6651	"DATA",900 2313.91,44 8,20,0)
6652	^9002313.9 102^1^1^31 30222^^
6653	"DATA",900 2313.91,44 8,20,1,0)
6654	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
6655	"DATA",900 2313.91,44 8,25,0)
6656	^9002313.9 104^1^1^31 30222^^
6657	"DATA",900 2313.91,44 8,25,1,0)
6658	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
6659	"DATA",900 2313.91,44 8,30,0)
6660	^9002313.9 103^1^1^31 30222^^
6661	"DATA",900 2313.91,44 8,30,1,0)
6662	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),6 70),U,10)= BPS("X")
6663	"DATA",900 2313.91,44 9,0)
6664	681^^SALES TRANSACTI ON ID^A/N^ ^^^80^A/N
6665	"DATA",900 2313.91,44 9,1)
6666	SALES TRAN SACTION ID
6667	"DATA",900 2313.91,44 9,5)
6668	ZF^80
6669	"DATA",900 2313.91,44 9,10,0)
6670	^9002313.9 101^1^1^31 30222^^
6671	"DATA",900 2313.91,44 9,10,1,0)
6672	S BPS("X") =""
6673	"DATA",900 2313.91,44 9,20,0)
6674	^9002313.9 102^1^1^31 30222^^
6675	"DATA",900 2313.91,44 9,20,1,0)
6676	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 0)
6677	"DATA",900 2313.91,44 9,25,0)
6678	^9002313.9 104^1^1^31 30222^^
6679	"DATA",900 2313.91,44 9,25,1,0)
6680	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),8 0)
6681	"DATA",900 2313.91,44 9,30,0)
6682	^9002313.9 103^1^1^31 30222^^
6683	"DATA",900 2313.91,44 9,30,1,0)
6684	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201),6 80),U,1)=B PS("X")
6685	"DATA",900 2313.91,45 0,0)
6686	A22^^PATIE NT ID STAT E/PROVINCE ^A/N^^^^2^ A/N
6687	"DATA",900 2313.91,45 0,1)
6688	PATIENT ID ASSOCIATE D STATE/PR OVINCE ADD RESS
6689	"DATA",900 2313.91,45 0,5)
6690	YR^2^1022
6691	"DATA",900 2313.91,45 0,10,0)
6692	^^1^1^3130 222^
6693	"DATA",900 2313.91,45 0,10,1,0)
6694	S BPS("X") =""
6695	"DATA",900 2313.91,45 0,20,0)
6696	^^1^1^3130 222^
6697	"DATA",900 2313.91,45 0,20,1,0)
6698	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6699	"DATA",900 2313.91,45 0,25,0)
6700	^^1^1^3130 222^
6701	"DATA",900 2313.91,45 0,25,1,0)
6702	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6703	"DATA",900 2313.91,45 0,30,0)
6704	^^1^1^3130 227^
6705	"DATA",900 2313.91,45 0,30,1,0)
6706	S $P(^BPSC (BPS(90023 13.02),"A2 0"),U,2)=B PS("X")
6707	"DATA",900 2313.91,45 1,0)
6708	A23^^PURCH ASER RELAT IONSHIP CO DE^A/N^^^^ 2^A/N
6709	"DATA",900 2313.91,45 1,1)
6710	PURCHASER RELATIONSH IP CODE
6711	"DATA",900 2313.91,45 1,5)
6712	YS^2^1023
6713	"DATA",900 2313.91,45 1,10,0)
6714	^9002313.9 101^1^1^31 30222^^
6715	"DATA",900 2313.91,45 1,10,1,0)
6716	S BPS("X") =""
6717	"DATA",900 2313.91,45 1,20,0)
6718	^9002313.9 102^1^1^31 30222^^
6719	"DATA",900 2313.91,45 1,20,1,0)
6720	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6721	"DATA",900 2313.91,45 1,25,0)
6722	^^1^1^3130 222^
6723	"DATA",900 2313.91,45 1,25,1,0)
6724	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6725	"DATA",900 2313.91,45 1,30,0)
6726	^9002313.9 103^1^1^31 30222^^
6727	"DATA",900 2313.91,45 1,30,1,0)
6728	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A20"),U,3) =BPS("X")
6729	"DATA",900 2313.91,45 2,0)
6730	A24^^PRESC RIBER ID S TATE/PROVI NCE^A/N^^^ ^2^A/N
6731	"DATA",900 2313.91,45 2,1)
6732	PRESCRIBER ID ASSOCI ATED STATE /PROVINCE CODE
6733	"DATA",900 2313.91,45 2,5)
6734	ZK^2^1024
6735	"DATA",900 2313.91,45 2,10,0)
6736	^^1^1^3130 222^
6737	"DATA",900 2313.91,45 2,10,1,0)
6738	S BPS("X") =""
6739	"DATA",900 2313.91,45 2,20,0)
6740	^^1^1^3130 222^
6741	"DATA",900 2313.91,45 2,20,1,0)
6742	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6743	"DATA",900 2313.91,45 2,25,0)
6744	^^1^1^3130 222^
6745	"DATA",900 2313.91,45 2,25,1,0)
6746	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6747	"DATA",900 2313.91,45 2,30,0)
6748	^^1^1^3130 222^
6749	"DATA",900 2313.91,45 2,30,1,0)
6750	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A20"),U,4) =BPS("X")
6751	"DATA",900 2313.91,45 3,0)
6752	A25^^PRESC RIBER ALTE RNATE ID Q UAL^A/N^^^ ^2^A/N
6753	"DATA",900 2313.91,45 3,1)
6754	PRESCRIBER ALTERNATE ID QUALIF IER
6755	"DATA",900 2313.91,45 3,5)
6756	ZM^2^1025
6757	"DATA",900 2313.91,45 3,10,0)
6758	^^1^1^3130 227^
6759	"DATA",900 2313.91,45 3,10,1,0)
6760	S BPS("X") =""
6761	"DATA",900 2313.91,45 3,20,0)
6762	^^1^1^3130 222^
6763	"DATA",900 2313.91,45 3,20,1,0)
6764	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6765	"DATA",900 2313.91,45 3,25,0)
6766	^^1^1^3130 222^
6767	"DATA",900 2313.91,45 3,25,1,0)
6768	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6769	"DATA",900 2313.91,45 3,30,0)
6770	^9002313.9 103^1^1^31 30227^^
6771	"DATA",900 2313.91,45 3,30,1,0)
6772	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A20"),U,5) =BPS("X")
6773	"DATA",900 2313.91,45 4,0)
6774	A26^^PRESC RIBER ALTE RNATE ID^A /N^^^^15^A /N
6775	"DATA",900 2313.91,45 4,1)
6776	PRESCRIBER ALTERNATE ID
6777	"DATA",900 2313.91,45 4,5)
6778	ZP^15^1026
6779	"DATA",900 2313.91,45 4,10,0)
6780	^^1^1^3130 222^
6781	"DATA",900 2313.91,45 4,10,1,0)
6782	S BPS("X") =""
6783	"DATA",900 2313.91,45 4,20,0)
6784	^^1^1^3130 222^
6785	"DATA",900 2313.91,45 4,20,1,0)
6786	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6787	"DATA",900 2313.91,45 4,25,0)
6788	^^1^1^3130 222^
6789	"DATA",900 2313.91,45 4,25,1,0)
6790	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
6791	"DATA",900 2313.91,45 4,30,0)
6792	^^1^1^3130 222^
6793	"DATA",900 2313.91,45 4,30,1,0)
6794	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A20"),U,6) =BPS("X")
6795	"DATA",900 2313.91,45 5,0)
6796	A27^^PRESC RIBER ALTE RNATE STAT E^A/N^^^^2 ^A/N
6797	"DATA",900 2313.91,45 5,1)
6798	PRESCRIBER ALTERNATE ID ASSOCI ATED STATE /PROVINCE ADDRESS
6799	"DATA",900 2313.91,45 5,5)
6800	ZQ^2^1027
6801	"DATA",900 2313.91,45 5,10,0)
6802	^^1^1^3130 222^
6803	"DATA",900 2313.91,45 5,10,1,0)
6804	S BPS("X") =""
6805	"DATA",900 2313.91,45 5,20,0)
6806	^^1^1^3130 222^
6807	"DATA",900 2313.91,45 5,20,1,0)
6808	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6809	"DATA",900 2313.91,45 5,25,0)
6810	^^1^1^3130 222^
6811	"DATA",900 2313.91,45 5,25,1,0)
6812	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6813	"DATA",900 2313.91,45 5,30,0)
6814	^^1^1^3130 222^
6815	"DATA",900 2313.91,45 5,30,1,0)
6816	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A20"),U,7) =BPS("X")
6817	"DATA",900 2313.91,45 6,0)
6818	A28^^ADJUD ICATED PAY MENT TYPE^ N^^^^2^N
6819	"DATA",900 2313.91,45 6,1)
6820	ADJUDICATE D PAYMENT TYPE
6821	"DATA",900 2313.91,45 6,5)
6822	ZR^2^1028
6823	"DATA",900 2313.91,45 6,10,0)
6824	^^1^1^3130 222^
6825	"DATA",900 2313.91,45 6,10,1,0)
6826	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6827	"DATA",900 2313.91,45 7,0)
6828	A29^^REPOR TED PAYMEN T TYPE^N^^ ^^2^N
6829	"DATA",900 2313.91,45 7,1)
6830	REPORTED P AYMENT TYP E
6831	"DATA",900 2313.91,45 7,5)
6832	ZS^2^1029
6833	"DATA",900 2313.91,45 7,10,0)
6834	^^1^1^3130 222^
6835	"DATA",900 2313.91,45 7,10,1,0)
6836	S BPS("X") =""
6837	"DATA",900 2313.91,45 7,20,0)
6838	^^1^1^3130 222^
6839	"DATA",900 2313.91,45 7,20,1,0)
6840	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
6841	"DATA",900 2313.91,45 7,25,0)
6842	^^1^1^3130 222^
6843	"DATA",900 2313.91,45 7,25,1,0)
6844	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
6845	"DATA",900 2313.91,45 7,30,0)
6846	^^1^1^3130 222^
6847	"DATA",900 2313.91,45 7,30,1,0)
6848	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A20"),U,9) =BPS("X")
6849	"DATA",900 2313.91,45 8,0)
6850	A30^^RELEA SED DATE^N ^^^^8^N
6851	"DATA",900 2313.91,45 8,1)
6852	RELEASED D ATE
6853	"DATA",900 2313.91,45 8,5)
6854	ZT^8^1030
6855	"DATA",900 2313.91,45 8,10,0)
6856	^^1^1^3130 222^
6857	"DATA",900 2313.91,45 8,10,1,0)
6858	S BPS("X") =""
6859	"DATA",900 2313.91,45 8,20,0)
6860	^^1^1^3130 222^
6861	"DATA",900 2313.91,45 8,20,1,0)
6862	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
6863	"DATA",900 2313.91,45 8,25,0)
6864	^^1^1^3130 222^
6865	"DATA",900 2313.91,45 8,25,1,0)
6866	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
6867	"DATA",900 2313.91,45 8,30,0)
6868	^^1^1^3130 222^
6869	"DATA",900 2313.91,45 8,30,1,0)
6870	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A20"),U,10 )=BPS("X")
6871	"DATA",900 2313.91,45 9,0)
6872	A31^^RELEA SED TIME^N ^^^^6^N
6873	"DATA",900 2313.91,45 9,1)
6874	RELEASED T IME
6875	"DATA",900 2313.91,45 9,5)
6876	ZU^6^1031
6877	"DATA",900 2313.91,45 9,10,0)
6878	^^1^1^3130 228^
6879	"DATA",900 2313.91,45 9,10,1,0)
6880	S BPS("X") =""
6881	"DATA",900 2313.91,45 9,20,0)
6882	^^1^1^3130 222^
6883	"DATA",900 2313.91,45 9,20,1,0)
6884	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),6)
6885	"DATA",900 2313.91,45 9,25,0)
6886	^^1^1^3130 222^
6887	"DATA",900 2313.91,45 9,25,1,0)
6888	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),6)
6889	"DATA",900 2313.91,45 9,30,0)
6890	^^1^1^3130 222^
6891	"DATA",900 2313.91,45 9,30,1,0)
6892	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A30"),U,1) =BPS("X")
6893	"DATA",900 2313.91,46 0,0)
6894	A32^^COMPO UND PREPAR ATION TIME ^N^^^^4^N
6895	"DATA",900 2313.91,46 0,1)
6896	COMPOUND P REPARATION TIME
6897	"DATA",900 2313.91,46 0,5)
6898	ZW^4^1032
6899	"DATA",900 2313.91,46 0,10,0)
6900	^^1^1^3130 222^
6901	"DATA",900 2313.91,46 0,10,1,0)
6902	S BPS("X") =""
6903	"DATA",900 2313.91,46 0,20,0)
6904	^^1^1^3130 222^
6905	"DATA",900 2313.91,46 0,20,1,0)
6906	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),4)
6907	"DATA",900 2313.91,46 0,25,0)
6908	^^1^1^3130 222^
6909	"DATA",900 2313.91,46 0,25,1,0)
6910	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),4)
6911	"DATA",900 2313.91,46 0,30,0)
6912	^^1^1^3130 222^
6913	"DATA",900 2313.91,46 0,30,1,0)
6914	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A30"),U,2) =BPS("X")
6915	"DATA",900 2313.91,46 1,0)
6916	A43^^PATIE NT COUNTRY CODE^A/N^ ^^^2^A/N
6917	"DATA",900 2313.91,46 1,1)
6918	PATIENT CO UNTRY CODE
6919	"DATA",900 2313.91,46 1,5)
6920	1K^2^1043
6921	"DATA",900 2313.91,46 1,10,0)
6922	^^1^1^3130 222^
6923	"DATA",900 2313.91,46 1,10,1,0)
6924	S BPS("X") =""
6925	"DATA",900 2313.91,46 1,20,0)
6926	^9002313.9 102^1^1^31 30222^^
6927	"DATA",900 2313.91,46 1,20,1,0)
6928	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6929	"DATA",900 2313.91,46 1,25,0)
6930	^9002313.9 104^1^1^31 30222^^
6931	"DATA",900 2313.91,46 1,25,1,0)
6932	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
6933	"DATA",900 2313.91,46 1,30,0)
6934	^^1^1^3130 227^
6935	"DATA",900 2313.91,46 1,30,1,0)
6936	S $P(^BPSC (BPS(90023 13.02),"A4 0"),U,3)=B PS("X")
6937	"DATA",900 2313.91,46 2,0)
6938	A45^^VETER INARY USE INDICATOR^ A/N^^^^1^A /N
6939	"DATA",900 2313.91,46 2,1)
6940	VETERINARY USE INDIC ATOR
6941	"DATA",900 2313.91,46 2,5)
6942	1R^1^1045
6943	"DATA",900 2313.91,46 2,10,0)
6944	^^1^1^3130 222^
6945	"DATA",900 2313.91,46 2,10,1,0)
6946	S BPS("X") =""
6947	"DATA",900 2313.91,46 2,20,0)
6948	^^1^1^3130 222^
6949	"DATA",900 2313.91,46 2,20,1,0)
6950	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
6951	"DATA",900 2313.91,46 2,25,0)
6952	^^1^1^3130 222^
6953	"DATA",900 2313.91,46 2,25,1,0)
6954	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 )
6955	"DATA",900 2313.91,46 2,30,0)
6956	^^1^1^3130 227^
6957	"DATA",900 2313.91,46 2,30,1,0)
6958	S $P(^BPSC (BPS(90023 13.02),"A4 0"),U,5)=B PS("X")
6959	"DATA",900 2313.91,46 3,0)
6960	B04^^NEXT AVAILABLE FILL DATE^ N^^^^8^N
6961	"DATA",900 2313.91,46 3,1)
6962	NEXT AVAIL ABLE FILL DATE
6963	"DATA",900 2313.91,46 3,5)
6964	BT^8^2004
6965	"DATA",900 2313.91,46 3,10,0)
6966	^^1^1^3130 222^
6967	"DATA",900 2313.91,46 3,10,1,0)
6968	; This is a response -only fiel d which do es not use the GET, FORMAT, or SET code
6969	"DATA",900 2313.91,46 4,0)
6970	B08^^PATIE NT STREET ADDRESS LI NE 1^^^^^4 0^A/N
6971	"DATA",900 2313.91,46 4,5)
6972	7A^^2008
6973	"DATA",900 2313.91,46 4,10,0)
6974	^^1^1^3150 112^
6975	"DATA",900 2313.91,46 4,10,1,0)
6976	S BPS("X") =$G(BPS("P atient","S treet Addr ess Line 1 "))
6977	"DATA",900 2313.91,46 4,20,0)
6978	^^1^1^3141 223
6979	"DATA",900 2313.91,46 4,20,1,0)
6980	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
6981	"DATA",900 2313.91,46 4,30,0)
6982	^^1^1^3141 223
6983	"DATA",900 2313.91,46 4,30,1,0)
6984	S $P(^BPSC (BPS(90023 13.02),"B0 0"),U,8)=B PS("X")
6985	"DATA",900 2313.91,46 5,0)
6986	B09^^PATIE NT STREET ADDRESS LI NE 2^^^^^4 0^A/N
6987	"DATA",900 2313.91,46 5,5)
6988	7B^^2009
6989	"DATA",900 2313.91,46 5,10,0)
6990	^^1^1^3150 112^
6991	"DATA",900 2313.91,46 5,10,1,0)
6992	S BPS("X") =$G(BPS("P atient","S treet Addr ess Line 2 "))
6993	"DATA",900 2313.91,46 5,20,0)
6994	^^1^1^3141 223
6995	"DATA",900 2313.91,46 5,20,1,0)
6996	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
6997	"DATA",900 2313.91,46 5,30,0)
6998	^^1^1^3141 223
6999	"DATA",900 2313.91,46 5,30,1,0)
7000	S $P(^BPSC (BPS(90023 13.02),"B0 0"),U,9)=B PS("X")
7001	"DATA",900 2313.91,46 6,0)
7002	B38^^PATIE NT ID ASSO C COUNTRY CODE^^^^^2 ^A/N
7003	"DATA",900 2313.91,46 6,1)
7004	PATIENT ID ASSOCIATE D COUNTRY CODE
7005	"DATA",900 2313.91,46 6,5)
7006	1Y^^2038
7007	"DATA",900 2313.91,46 6,10,0)
7008	^^1^1^3141 223
7009	"DATA",900 2313.91,46 6,10,1,0)
7010	S BPS("X") ="US"
7011	"DATA",900 2313.91,46 6,20,0)
7012	^^1^1^3141 223
7013	"DATA",900 2313.91,46 6,20,1,0)
7014	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7015	"DATA",900 2313.91,46 6,30,0)
7016	^^1^1^3141 223
7017	"DATA",900 2313.91,46 6,30,1,0)
7018	S $P(^BPSC (BPS(90023 13.02),"B3 0"),U,8)=B PS("X")
7019	"DATA",900 2313.91,46 7,0)
7020	B26^^PRESC RIBER PHON E NUMBER E XT^^^^^8^N
7021	"DATA",900 2313.91,46 7,1)
7022	PRESCRIBER TELEPHONE NUMBER EX TENSION
7023	"DATA",900 2313.91,46 7,5)
7024	7T^^2026
7025	"DATA",900 2313.91,46 7,10,0)
7026	^^1^1^3141 223
7027	"DATA",900 2313.91,46 7,10,1,0)
7028	S BPS("X") =""
7029	"DATA",900 2313.91,46 7,20,0)
7030	^^1^1^3141 223
7031	"DATA",900 2313.91,46 7,20,1,0)
7032	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
7033	"DATA",900 2313.91,46 7,30,0)
7034	^^1^1^3141 223
7035	"DATA",900 2313.91,46 7,30,1,0)
7036	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B20"),U,6) =BPS("X")
7037	"DATA",900 2313.91,46 8,0)
7038	B27^^PRESC RIBER STRE ET ADDR LI NE 1^^^^^4 0^A/N
7039	"DATA",900 2313.91,46 8,1)
7040	PRESCRIBER STREET AD DRESS LINE 1
7041	"DATA",900 2313.91,46 8,5)
7042	7U^^2027
7043	"DATA",900 2313.91,46 8,10,0)
7044	^^1^1^3150 112^
7045	"DATA",900 2313.91,46 8,10,1,0)
7046	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er Street Address Li ne 1"))
7047	"DATA",900 2313.91,46 8,20,0)
7048	^^1^1^3141 223
7049	"DATA",900 2313.91,46 8,20,1,0)
7050	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7051	"DATA",900 2313.91,46 8,30,0)
7052	^^1^1^3141 223
7053	"DATA",900 2313.91,46 8,30,1,0)
7054	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B20"),U,7) =BPS("X")
7055	"DATA",900 2313.91,46 9,0)
7056	B28^^PRESC RIBER STRE ET ADDR LI NE 2^^^^^4 0^A/N
7057	"DATA",900 2313.91,46 9,1)
7058	PRESCRIBER STREET AD DRESS LINE 2
7059	"DATA",900 2313.91,46 9,5)
7060	7V^^2028
7061	"DATA",900 2313.91,46 9,10,0)
7062	^^1^1^3150 112^
7063	"DATA",900 2313.91,46 9,10,1,0)
7064	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er Street Address Li ne 2"))
7065	"DATA",900 2313.91,46 9,20,0)
7066	^^1^1^3141 223
7067	"DATA",900 2313.91,46 9,20,1,0)
7068	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7069	"DATA",900 2313.91,46 9,30,0)
7070	^^1^1^3141 223
7071	"DATA",900 2313.91,46 9,30,1,0)
7072	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B20"),U,8) =BPS("X")
7073	"DATA",900 2313.91,47 0,0)
7074	B40^^PRES ALT ID ASS OC COUNTRY CODE^^^^^ 2^A/N
7075	"DATA",900 2313.91,47 0,1)
7076	PRESCRIBER ALTERNATE ID ASSOCI ATED COUNT RY CODE
7077	"DATA",900 2313.91,47 0,5)
7078	3A^^2040
7079	"DATA",900 2313.91,47 0,10,0)
7080	^^1^1^3141 223
7081	"DATA",900 2313.91,47 0,10,1,0)
7082	S BPS("X") =""
7083	"DATA",900 2313.91,47 0,20,0)
7084	^^1^1^3141 223
7085	"DATA",900 2313.91,47 0,20,1,0)
7086	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7087	"DATA",900 2313.91,47 0,30,0)
7088	^^1^1^3141 223
7089	"DATA",900 2313.91,47 0,30,1,0)
7090	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B30"),U,10 )=BPS("X")
7091	"DATA",900 2313.91,47 1,0)
7092	B41^^PRES ID ASSOC C OUNTRY COD E^^^^^2^A/ N
7093	"DATA",900 2313.91,47 1,1)
7094	PRESCRIBER ID ASSOCI ATED COUNT RY CODE
7095	"DATA",900 2313.91,47 1,5)
7096	3B^^2041
7097	"DATA",900 2313.91,47 1,10,0)
7098	^9002313.9 101^1^1^31 50112^
7099	"DATA",900 2313.91,47 1,10,1,0)
7100	S BPS("X") ="US"
7101	"DATA",900 2313.91,47 1,20,0)
7102	^^1^1^3141 223
7103	"DATA",900 2313.91,47 1,20,1,0)
7104	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7105	"DATA",900 2313.91,47 1,30,0)
7106	^^1^1^3141 223
7107	"DATA",900 2313.91,47 1,30,1,0)
7108	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B40"),U,1) =BPS("X")
7109	"DATA",900 2313.91,47 2,0)
7110	B42^^PRESC RIBER COUN TRY CODE^^ ^^^2^A/N
7111	"DATA",900 2313.91,47 2,5)
7112	3C^^2042
7113	"DATA",900 2313.91,47 2,10,0)
7114	^^1^1^3150 112^
7115	"DATA",900 2313.91,47 2,10,1,0)
7116	S BPS("X") =$G(BPS("R X",BPS(900 2313.0201) ,"Prescrib er Country "))
7117	"DATA",900 2313.91,47 2,20,0)
7118	^^1^1^3141 223
7119	"DATA",900 2313.91,47 2,20,1,0)
7120	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7121	"DATA",900 2313.91,47 2,30,0)
7122	^^1^1^3141 223
7123	"DATA",900 2313.91,47 2,30,1,0)
7124	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B40"),U,2) =BPS("X")
7125	"DATA",900 2313.91,47 3,0)
7126	B15^^EMPLO YER STREET ADDRESS L INE 1^^^^^ 40^A/N
7127	"DATA",900 2313.91,47 3,5)
7128	8D^^2015
7129	"DATA",900 2313.91,47 3,10,0)
7130	^^1^1^3141 223
7131	"DATA",900 2313.91,47 3,10,1,0)
7132	S BPS("X") =""
7133	"DATA",900 2313.91,47 3,20,0)
7134	^^1^1^3141 223
7135	"DATA",900 2313.91,47 3,20,1,0)
7136	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7137	"DATA",900 2313.91,47 3,30,0)
7138	^^1^1^3141 223
7139	"DATA",900 2313.91,47 3,30,1,0)
7140	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B10"),U,5) =BPS("X")
7141	"DATA",900 2313.91,47 4,0)
7142	B16^^EMPLO YER STREET ADDRESS L INE 2^^^^^ 40^A/N
7143	"DATA",900 2313.91,47 4,5)
7144	7G^^2016
7145	"DATA",900 2313.91,47 4,10,0)
7146	^^1^1^3141 223
7147	"DATA",900 2313.91,47 4,10,1,0)
7148	S BPS("X") =""
7149	"DATA",900 2313.91,47 4,20,0)
7150	^^1^1^3141 223
7151	"DATA",900 2313.91,47 4,20,1,0)
7152	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7153	"DATA",900 2313.91,47 4,30,0)
7154	^^1^1^3141 223
7155	"DATA",900 2313.91,47 4,30,1,0)
7156	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B10"),U,6) =BPS("X")
7157	"DATA",900 2313.91,47 5,0)
7158	B17^^EMPLO YER CONTAC T FIRST NA ME^^^^^35^ A/N
7159	"DATA",900 2313.91,47 5,5)
7160	7H^^2017
7161	"DATA",900 2313.91,47 5,10,0)
7162	^^1^1^3141 223
7163	"DATA",900 2313.91,47 5,10,1,0)
7164	S BPS("X") =""
7165	"DATA",900 2313.91,47 5,20,0)
7166	^^1^1^3141 223
7167	"DATA",900 2313.91,47 5,20,1,0)
7168	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 5)
7169	"DATA",900 2313.91,47 5,30,0)
7170	^^1^1^3141 223
7171	"DATA",900 2313.91,47 5,30,1,0)
7172	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B10"),U,7) =BPS("X")
7173	"DATA",900 2313.91,47 6,0)
7174	B18^^EMPLO YER CONTAC T LAST NAM E^^^^^35^A /N
7175	"DATA",900 2313.91,47 6,5)
7176	7J^^2018
7177	"DATA",900 2313.91,47 6,10,0)
7178	^^1^1^3141 223
7179	"DATA",900 2313.91,47 6,10,1,0)
7180	S BPS("X") =""
7181	"DATA",900 2313.91,47 6,20,0)
7182	^^1^1^3141 223
7183	"DATA",900 2313.91,47 6,20,1,0)
7184	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),3 5)
7185	"DATA",900 2313.91,47 6,30,0)
7186	^^1^1^3141 223
7187	"DATA",900 2313.91,47 6,30,1,0)
7188	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B10"),U,8) =BPS("X")
7189	"DATA",900 2313.91,47 7,0)
7190	B19^^EMPLO YER PHONE NUMBER EXT ^^^^^8^N
7191	"DATA",900 2313.91,47 7,1)
7192	EMPLOYER T ELEPHONE N UMBER EXTE NSION
7193	"DATA",900 2313.91,47 7,5)
7194	7K^^2019
7195	"DATA",900 2313.91,47 7,10,0)
7196	^^1^1^3141 223
7197	"DATA",900 2313.91,47 7,10,1,0)
7198	S BPS("X") =""
7199	"DATA",900 2313.91,47 7,20,0)
7200	^^1^1^3141 223
7201	"DATA",900 2313.91,47 7,20,1,0)
7202	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),8)
7203	"DATA",900 2313.91,47 7,30,0)
7204	^^1^1^3141 223
7205	"DATA",900 2313.91,47 7,30,1,0)
7206	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B10"),U,9) =BPS("X")
7207	"DATA",900 2313.91,47 8,0)
7208	B24^^PAY T O STREET A DDRESS LIN E 1^^^^^40 ^A/N
7209	"DATA",900 2313.91,47 8,5)
7210	7R^^2024
7211	"DATA",900 2313.91,47 8,10,0)
7212	^^1^1^3141 223
7213	"DATA",900 2313.91,47 8,10,1,0)
7214	S BPS("X") =""
7215	"DATA",900 2313.91,47 8,20,0)
7216	^^1^1^3141 223
7217	"DATA",900 2313.91,47 8,20,1,0)
7218	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7219	"DATA",900 2313.91,47 8,30,0)
7220	^^1^1^3141 223
7221	"DATA",900 2313.91,47 8,30,1,0)
7222	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B20"),U,4) =BPS("X")
7223	"DATA",900 2313.91,47 9,0)
7224	B25^^PAY T O STREET A DDRESS LIN E 2^^^^^40 ^A/N
7225	"DATA",900 2313.91,47 9,5)
7226	7S^^2025
7227	"DATA",900 2313.91,47 9,10,0)
7228	^^1^1^3141 223
7229	"DATA",900 2313.91,47 9,10,1,0)
7230	S BPS("X") =""
7231	"DATA",900 2313.91,47 9,20,0)
7232	^^1^1^3141 223
7233	"DATA",900 2313.91,47 9,20,1,0)
7234	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7235	"DATA",900 2313.91,47 9,30,0)
7236	^^1^1^3141 223
7237	"DATA",900 2313.91,47 9,30,1,0)
7238	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B20"),U,5) =BPS("X")
7239	"DATA",900 2313.91,48 0,0)
7240	B35^^EMPLO YER COUNTR Y CODE^^^^ ^2^A/N
7241	"DATA",900 2313.91,48 0,5)
7242	1V^^2035
7243	"DATA",900 2313.91,48 0,10,0)
7244	^^1^1^3141 223
7245	"DATA",900 2313.91,48 0,10,1,0)
7246	S BPS("X") =""
7247	"DATA",900 2313.91,48 0,20,0)
7248	^^1^1^3141 223
7249	"DATA",900 2313.91,48 0,20,1,0)
7250	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7251	"DATA",900 2313.91,48 0,30,0)
7252	^^1^1^3141 223
7253	"DATA",900 2313.91,48 0,30,1,0)
7254	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B30"),U,5) =BPS("X")
7255	"DATA",900 2313.91,48 1,0)
7256	B39^^PAY T O COUNTRY CODE^^^^^2 ^A/N
7257	"DATA",900 2313.91,48 1,5)
7258	1Z^^2039
7259	"DATA",900 2313.91,48 1,10,0)
7260	^^1^1^3141 223
7261	"DATA",900 2313.91,48 1,10,1,0)
7262	S BPS("X") =""
7263	"DATA",900 2313.91,48 1,20,0)
7264	^^1^1^3141 223
7265	"DATA",900 2313.91,48 1,20,1,0)
7266	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7267	"DATA",900 2313.91,48 1,30,0)
7268	^^1^1^3141 223
7269	"DATA",900 2313.91,48 1,30,1,0)
7270	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B30"),U,9) =BPS("X")
7271	"DATA",900 2313.91,48 2,0)
7272	B13^^AUTH REP STREET ADDRESS L INE 1^^^^^ 40^A/N
7273	"DATA",900 2313.91,48 2,1)
7274	AUTHORIZED REPRESENT ATIVE STRE ET ADDRESS LINE 1
7275	"DATA",900 2313.91,48 2,5)
7276	7D^^2013
7277	"DATA",900 2313.91,48 2,10,0)
7278	^9002313.9 101^1^1^31 50112^
7279	"DATA",900 2313.91,48 2,10,1,0)
7280	S BPS("X") =""
7281	"DATA",900 2313.91,48 2,20,0)
7282	^9002313.9 102^1^1^31 50112^
7283	"DATA",900 2313.91,48 2,20,1,0)
7284	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7285	"DATA",900 2313.91,48 2,30,0)
7286	^9002313.9 103^1^1^31 50112^
7287	"DATA",900 2313.91,48 2,30,1,0)
7288	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B10"),U,3) =BPS("X")
7289	"DATA",900 2313.91,48 3,0)
7290	B14^^AUTH REP STREET ADDRESS L INE 2^^^^^ 40^A/N
7291	"DATA",900 2313.91,48 3,1)
7292	AUTHORIZED REPRESENT ATIVE STRE ET ADDRESS LINE 2
7293	"DATA",900 2313.91,48 3,5)
7294	8B^^2014
7295	"DATA",900 2313.91,48 3,10,0)
7296	^^1^1^3141 223
7297	"DATA",900 2313.91,48 3,10,1,0)
7298	S BPS("X") =""
7299	"DATA",900 2313.91,48 3,20,0)
7300	^^1^1^3141 223
7301	"DATA",900 2313.91,48 3,20,1,0)
7302	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7303	"DATA",900 2313.91,48 3,30,0)
7304	^^1^1^3141 223
7305	"DATA",900 2313.91,48 3,30,1,0)
7306	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B10"),U,4) =BPS("X")
7307	"DATA",900 2313.91,48 4,0)
7308	B34^^AUTH REP COUNTR Y CODE^^^^ ^2^A/N
7309	"DATA",900 2313.91,48 4,1)
7310	AUTHORIZED REPRESENT ATIVE COUN TRY CODE
7311	"DATA",900 2313.91,48 4,5)
7312	1U^^2034
7313	"DATA",900 2313.91,48 4,10,0)
7314	^^1^1^3141 223
7315	"DATA",900 2313.91,48 4,10,1,0)
7316	S BPS("X") =""
7317	"DATA",900 2313.91,48 4,20,0)
7318	^^1^1^3141 223
7319	"DATA",900 2313.91,48 4,20,1,0)
7320	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7321	"DATA",900 2313.91,48 4,30,0)
7322	^^1^1^3141 223
7323	"DATA",900 2313.91,48 4,30,1,0)
7324	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B30"),U,4) =BPS("X")
7325	"DATA",900 2313.91,48 5,0)
7326	B20^^FACIL ITY STREET ADDRESS L INE 1^^^^^ 40^A/N
7327	"DATA",900 2313.91,48 5,5)
7328	7M^^2020
7329	"DATA",900 2313.91,48 5,10,0)
7330	^^1^1^3141 223
7331	"DATA",900 2313.91,48 5,10,1,0)
7332	S BPS("X") =""
7333	"DATA",900 2313.91,48 5,20,0)
7334	^^1^1^3141 223
7335	"DATA",900 2313.91,48 5,20,1,0)
7336	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7337	"DATA",900 2313.91,48 5,30,0)
7338	^^1^1^3141 223
7339	"DATA",900 2313.91,48 5,30,1,0)
7340	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B10"),U,10 )=BPS("X")
7341	"DATA",900 2313.91,48 6,0)
7342	B21^^FACIL ITY STREET ADDRESS L INE 2^^^^^ 40^A/N
7343	"DATA",900 2313.91,48 6,5)
7344	7N^^2021
7345	"DATA",900 2313.91,48 6,10,0)
7346	^^1^1^3141 223
7347	"DATA",900 2313.91,48 6,10,1,0)
7348	S BPS("X") =""
7349	"DATA",900 2313.91,48 6,20,0)
7350	^^1^1^3141 223
7351	"DATA",900 2313.91,48 6,20,1,0)
7352	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7353	"DATA",900 2313.91,48 6,30,0)
7354	^^1^1^3141 223
7355	"DATA",900 2313.91,48 6,30,1,0)
7356	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B20"),U,1) =BPS("X")
7357	"DATA",900 2313.91,48 7,0)
7358	B37^^FACIL ITY COUNTR Y CODE^^^^ ^2^A/N
7359	"DATA",900 2313.91,48 7,5)
7360	1X^^2037
7361	"DATA",900 2313.91,48 7,10,0)
7362	^^1^1^3141 223
7363	"DATA",900 2313.91,48 7,10,1,0)
7364	S BPS("X") =""
7365	"DATA",900 2313.91,48 7,20,0)
7366	^^1^1^3141 223
7367	"DATA",900 2313.91,48 7,20,1,0)
7368	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7369	"DATA",900 2313.91,48 7,30,0)
7370	^^1^1^3141 223
7371	"DATA",900 2313.91,48 7,30,1,0)
7372	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B30"),U,7) =BPS("X")
7373	"DATA",900 2313.91,48 8,0)
7374	B29^^PURCH ASER STREE T ADDRESS LINE1^^^^^ 40^A/N
7375	"DATA",900 2313.91,48 8,1)
7376	PURCHASER STREET ADD RESS LINE 1
7377	"DATA",900 2313.91,48 8,5)
7378	7W^^2029
7379	"DATA",900 2313.91,48 8,10,0)
7380	^^1^1^3141 223
7381	"DATA",900 2313.91,48 8,10,1,0)
7382	S BPS("X") =""
7383	"DATA",900 2313.91,48 8,20,0)
7384	^^1^1^3141 223
7385	"DATA",900 2313.91,48 8,20,1,0)
7386	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7387	"DATA",900 2313.91,48 8,30,0)
7388	^^1^1^3141 223
7389	"DATA",900 2313.91,48 8,30,1,0)
7390	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B20"),U,9) =BPS("X")
7391	"DATA",900 2313.91,48 9,0)
7392	B30^^PURCH ASER STREE T ADDRESS LINE2^^^^^ 40^A/N
7393	"DATA",900 2313.91,48 9,1)
7394	PURCHASER STREET ADD RESS LINE 2
7395	"DATA",900 2313.91,48 9,5)
7396	7X^^2030
7397	"DATA",900 2313.91,48 9,10,0)
7398	^^1^1^3141 223
7399	"DATA",900 2313.91,48 9,10,1,0)
7400	S BPS("X") =""
7401	"DATA",900 2313.91,48 9,20,0)
7402	^^1^1^3141 223
7403	"DATA",900 2313.91,48 9,20,1,0)
7404	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7405	"DATA",900 2313.91,48 9,30,0)
7406	^^1^1^3141 223
7407	"DATA",900 2313.91,48 9,30,1,0)
7408	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B20"),U,10 )=BPS("X")
7409	"DATA",900 2313.91,49 0,0)
7410	B43^^PURCH ASER ID AS SOC COUNTR Y CD^^^^^2 ^A/N
7411	"DATA",900 2313.91,49 0,1)
7412	PURCHASER ID ASSOCIA TED COUNTR Y CODE
7413	"DATA",900 2313.91,49 0,5)
7414	3D^^2043
7415	"DATA",900 2313.91,49 0,10,0)
7416	^^1^1^3141 223
7417	"DATA",900 2313.91,49 0,10,1,0)
7418	S BPS("X") =""
7419	"DATA",900 2313.91,49 0,20,0)
7420	^^1^1^3141 223
7421	"DATA",900 2313.91,49 0,20,1,0)
7422	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7423	"DATA",900 2313.91,49 0,30,0)
7424	^^1^1^3141 223
7425	"DATA",900 2313.91,49 0,30,1,0)
7426	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B40"),U,3) =BPS("X")
7427	"DATA",900 2313.91,49 1,0)
7428	B31^^SERVI CE PROV ST REET ADD L INE 1^^^^^ 40^A/N
7429	"DATA",900 2313.91,49 1,1)
7430	SERVICE PR OVIDER STR EET ADDRES S LINE 1
7431	"DATA",900 2313.91,49 1,5)
7432	7Y^^2031
7433	"DATA",900 2313.91,49 1,10,0)
7434	^^1^1^3141 223
7435	"DATA",900 2313.91,49 1,10,1,0)
7436	S BPS("X") =""
7437	"DATA",900 2313.91,49 1,20,0)
7438	^^1^1^3141 223
7439	"DATA",900 2313.91,49 1,20,1,0)
7440	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7441	"DATA",900 2313.91,49 1,30,0)
7442	^^1^1^3141 223
7443	"DATA",900 2313.91,49 1,30,1,0)
7444	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B30"),U,1) =BPS("X")
7445	"DATA",900 2313.91,49 2,0)
7446	B32^^SERVI CE PROV ST REET ADD L INE 2^^^^^ 40^A/N
7447	"DATA",900 2313.91,49 2,1)
7448	SERVICE PR OVIDER STR EET ADDRES S LINE 2
7449	"DATA",900 2313.91,49 2,5)
7450	7Z^^2032
7451	"DATA",900 2313.91,49 2,10,0)
7452	^^1^1^3141 223
7453	"DATA",900 2313.91,49 2,10,1,0)
7454	S BPS("X") =""
7455	"DATA",900 2313.91,49 2,20,0)
7456	^^1^1^3141 223
7457	"DATA",900 2313.91,49 2,20,1,0)
7458	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),4 0)
7459	"DATA",900 2313.91,49 2,30,0)
7460	^^1^1^3141 223
7461	"DATA",900 2313.91,49 2,30,1,0)
7462	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B30"),U,2) =BPS("X")
7463	"DATA",900 2313.91,49 3,0)
7464	A93^^SERVI CE PROVIDE R COUNTRY CODE^^^^^2 ^A/N
7465	"DATA",900 2313.91,49 3,5)
7466	1T^^1093
7467	"DATA",900 2313.91,49 3,10,0)
7468	^^1^1^3141 223
7469	"DATA",900 2313.91,49 3,10,1,0)
7470	S BPS("X") =""
7471	"DATA",900 2313.91,49 3,20,0)
7472	^^1^1^3141 223
7473	"DATA",900 2313.91,49 3,20,1,0)
7474	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7475	"DATA",900 2313.91,49 3,30,0)
7476	^^1^1^3141 223
7477	"DATA",900 2313.91,49 3,30,1,0)
7478	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," A90"),U,3) =BPS("X")
7479	"DATA",900 2313.91,49 4,0)
7480	B44^^INTER MEDIARY ID COUNT^^^^ ^1^N
7481	"DATA",900 2313.91,49 4,5)
7482	8G^^2044
7483	"DATA",900 2313.91,49 4,10,0)
7484	^^1^1^3141 223
7485	"DATA",900 2313.91,49 4,10,1,0)
7486	S BPS("X") =""
7487	"DATA",900 2313.91,49 4,20,0)
7488	^^1^1^3141 223
7489	"DATA",900 2313.91,49 4,20,1,0)
7490	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
7491	"DATA",900 2313.91,49 4,30,0)
7492	^^1^1^3141 223
7493	"DATA",900 2313.91,49 4,30,1,0)
7494	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B40"),U,4) =BPS("X")
7495	"DATA",900 2313.91,49 5,0)
7496	B45^^INTER MEDIARY ID TYPE CODE ^^^^^2^A/N
7497	"DATA",900 2313.91,49 5,5)
7498	8H^^2045
7499	"DATA",900 2313.91,49 5,10,0)
7500	^^1^1^3141 223
7501	"DATA",900 2313.91,49 5,10,1,0)
7502	S BPS("X") =""
7503	"DATA",900 2313.91,49 5,20,0)
7504	^^1^1^3141 223
7505	"DATA",900 2313.91,49 5,20,1,0)
7506	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7507	"DATA",900 2313.91,49 6,0)
7508	B46^^INTER MEDIARY ID TYPE ENTI TY^^^^^2^A /N
7509	"DATA",900 2313.91,49 6,5)
7510	8J^^2046
7511	"DATA",900 2313.91,49 6,10,0)
7512	^^1^1^3141 223
7513	"DATA",900 2313.91,49 6,10,1,0)
7514	S BPS("X") =""
7515	"DATA",900 2313.91,49 6,20,0)
7516	^^1^1^3141 223
7517	"DATA",900 2313.91,49 6,20,1,0)
7518	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7519	"DATA",900 2313.91,49 7,0)
7520	B47^^INTER MEDIARY ID QUALIFIER ^^^^^2^A/N
7521	"DATA",900 2313.91,49 7,5)
7522	8K^^2047
7523	"DATA",900 2313.91,49 7,10,0)
7524	^^1^1^3141 223
7525	"DATA",900 2313.91,49 7,10,1,0)
7526	S BPS("X") =""
7527	"DATA",900 2313.91,49 7,20,0)
7528	^^1^1^3141 223
7529	"DATA",900 2313.91,49 7,20,1,0)
7530	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7531	"DATA",900 2313.91,49 8,0)
7532	B48^^INTER MEDIARY ID ^^^^^20^A/ N
7533	"DATA",900 2313.91,49 8,5)
7534	8M^^2048
7535	"DATA",900 2313.91,49 8,10,0)
7536	^^1^1^3141 223
7537	"DATA",900 2313.91,49 8,10,1,0)
7538	S BPS("X") =""
7539	"DATA",900 2313.91,49 8,20,0)
7540	^^1^1^3141 223
7541	"DATA",900 2313.91,49 8,20,1,0)
7542	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
7543	"DATA",900 2313.91,49 9,0)
7544	B49^^INTER MEDIARY ID STATE/PRO V ADD^^^^^ 2^A/N
7545	"DATA",900 2313.91,49 9,1)
7546	INTERMEDIA RY ID STAT E/PROVINCE ADDRESS
7547	"DATA",900 2313.91,49 9,5)
7548	8N^^2049
7549	"DATA",900 2313.91,49 9,10,0)
7550	^9002313.9 101^1^1^31 41231^
7551	"DATA",900 2313.91,49 9,10,1,0)
7552	S BPS("X") =""
7553	"DATA",900 2313.91,49 9,20,0)
7554	^9002313.9 102^1^1^31 41231^
7555	"DATA",900 2313.91,49 9,20,1,0)
7556	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7557	"DATA",900 2313.91,50 0,0)
7558	B55^^INTER MEDIARY ID COUNTRY C ODE^^^^^2^ A/N
7559	"DATA",900 2313.91,50 0,5)
7560	8U^^2055
7561	"DATA",900 2313.91,50 0,10,0)
7562	^^1^1^3141 223
7563	"DATA",900 2313.91,50 0,10,1,0)
7564	S BPS("X") =""
7565	"DATA",900 2313.91,50 0,20,0)
7566	^^1^1^3141 223
7567	"DATA",900 2313.91,50 0,20,1,0)
7568	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 )
7569	"DATA",900 2313.91,50 1,0)
7570	B50^^INTER MEDIARY ID RELATION CODE^^^^^1 ^N
7571	"DATA",900 2313.91,50 1,1)
7572	INTERMEDIA RY ID RELA TIONSHIP C ODE
7573	"DATA",900 2313.91,50 1,5)
7574	8P^^2050
7575	"DATA",900 2313.91,50 1,10,0)
7576	^^1^1^3141 223
7577	"DATA",900 2313.91,50 1,10,1,0)
7578	S BPS("X") =""
7579	"DATA",900 2313.91,50 1,20,0)
7580	^^1^1^3141 223
7581	"DATA",900 2313.91,50 1,20,1,0)
7582	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
7583	"DATA",900 2313.91,50 2,0)
7584	B56^^LAST KNOWN BIN NUMBER^^^^ ^6^N
7585	"DATA",900 2313.91,50 2,5)
7586	3E^^2056
7587	"DATA",900 2313.91,50 2,10,0)
7588	^^1^1^3141 223
7589	"DATA",900 2313.91,50 2,10,1,0)
7590	S BPS("X") =""
7591	"DATA",900 2313.91,50 2,20,0)
7592	^^1^1^3141 223
7593	"DATA",900 2313.91,50 2,20,1,0)
7594	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),1)
7595	"DATA",900 2313.91,50 2,30,0)
7596	^^1^1^3141 223
7597	"DATA",900 2313.91,50 2,30,1,0)
7598	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B50"),U,6) =BPS("X")
7599	"DATA",900 2313.91,50 3,0)
7600	B57^^LAST KNOWN PROC ESSOR CNTR L NUM^^^^^ 10^A/N
7601	"DATA",900 2313.91,50 3,1)
7602	LAST KNOWN PROCESSOR CONTROL N UMBER
7603	"DATA",900 2313.91,50 3,5)
7604	3F^^2057
7605	"DATA",900 2313.91,50 3,10,0)
7606	^^1^1^3141 223
7607	"DATA",900 2313.91,50 3,10,1,0)
7608	S BPS("X") =""
7609	"DATA",900 2313.91,50 3,20,0)
7610	^^1^1^3141 223
7611	"DATA",900 2313.91,50 3,20,1,0)
7612	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 0)
7613	"DATA",900 2313.91,50 3,30,0)
7614	^^1^1^3141 223
7615	"DATA",900 2313.91,50 3,30,1,0)
7616	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B50"),U,7) =BPS("X")
7617	"DATA",900 2313.91,50 4,0)
7618	B58^^LAST KNOWN GROU P ID^^^^^1 5^A/N
7619	"DATA",900 2313.91,50 4,5)
7620	3G^^2058
7621	"DATA",900 2313.91,50 4,10,0)
7622	^^1^1^3141 223
7623	"DATA",900 2313.91,50 4,10,1,0)
7624	S BPS("X") =""
7625	"DATA",900 2313.91,50 4,20,0)
7626	^^1^1^3141 223
7627	"DATA",900 2313.91,50 4,20,1,0)
7628	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),1 5)
7629	"DATA",900 2313.91,50 4,30,0)
7630	^^1^1^3141 223
7631	"DATA",900 2313.91,50 4,30,1,0)
7632	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B50"),U,8) =BPS("X")
7633	"DATA",900 2313.91,50 5,0)
7634	B59^^LAST KNOWN CARD HOLDER ID^ ^^^^20^A/N
7635	"DATA",900 2313.91,50 5,5)
7636	3H^^2059
7637	"DATA",900 2313.91,50 5,10,0)
7638	^^1^1^3141 223
7639	"DATA",900 2313.91,50 5,10,1,0)
7640	S BPS("X") =""
7641	"DATA",900 2313.91,50 5,20,0)
7642	^^1^1^3141 223
7643	"DATA",900 2313.91,50 5,20,1,0)
7644	S BPS("X") =$$ANFF^BP SECFM($G(B PS("X")),2 0)
7645	"DATA",900 2313.91,50 5,30,0)
7646	^^1^1^3141 223
7647	"DATA",900 2313.91,50 5,30,1,0)
7648	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B50"),U,9) =BPS("X")
7649	"DATA",900 2313.91,50 6,0)
7650	B60^^YEAR OF LAST PA ID CLAIM^^ ^^^4^N
7651	"DATA",900 2313.91,50 6,5)
7652	3J^^2060
7653	"DATA",900 2313.91,50 6,10,0)
7654	^9002313.9 101^1^1^31 50112^
7655	"DATA",900 2313.91,50 6,10,1,0)
7656	S BPS("X") =""
7657	"DATA",900 2313.91,50 6,20,0)
7658	^^1^1^3150 112^
7659	"DATA",900 2313.91,50 6,20,1,0)
7660	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),4)
7661	"DATA",900 2313.91,50 6,30,0)
7662	^9002313.9 103^1^1^31 50112^
7663	"DATA",900 2313.91,50 6,30,1,0)
7664	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B50"),U,10 )=BPS("X")
7665	"DATA",900 2313.91,50 7,0)
7666	B61^^MONTH OF LAST P AID CLAIM^ ^^^^2^N
7667	"DATA",900 2313.91,50 7,5)
7668	3K^^2061
7669	"DATA",900 2313.91,50 7,10,0)
7670	^^1^1^3141 223
7671	"DATA",900 2313.91,50 7,10,1,0)
7672	S BPS("X") =""
7673	"DATA",900 2313.91,50 7,20,0)
7674	^^1^1^3141 223
7675	"DATA",900 2313.91,50 7,20,1,0)
7676	S BPS("X") =$$NFF^BPS ECFM($G(BP S("X")),2)
7677	"DATA",900 2313.91,50 7,30,0)
7678	^^1^1^3141 223
7679	"DATA",900 2313.91,50 7,30,1,0)
7680	S $P(^BPSC (BPS(90023 13.02),400 ,BPS(90023 13.0201)," B60"),U,1) =BPS("X")
7681	"DATA",900 2313.91,50 8,0)
7682	B22^^HELP DESK TELEP HONE NUMBE R EXT^^^^^ 8^N
7683	"DATA",900 2313.91,50 8,1)
7684	HELP DESK TELEPHONE NUMBER EXT ENSION
7685	"DATA",900 2313.91,50 8,5)
7686	7P^^2022
7687	"DATA",900 2313.91,50 8,10,0)
7688	^^1^1^3141 223
7689	"DATA",900 2313.91,50 8,10,1,0)
7690	; THIS IS A RESPONSE -ONLY FIEL D WHICH DO ES NOT USE THE GET, FORMAT, OR SET CODE
7691	"DATA",900 2313.91,50 9,0)
7692	B33^^PRO S ERVICE FEE CONT/REIM AMT^^^^^6 .2^D
7693	"DATA",900 2313.91,50 9,1)
7694	PROFESSION AL SERVICE FEE CONTR ACTED/REIM BURSEMENT AMOUNT
7695	"DATA",900 2313.91,50 9,5)
7696	6G^^2033
7697	"DATA",900 2313.91,50 9,10,0)
7698	^^1^1^3141 223
7699	"DATA",900 2313.91,50 9,10,1,0)
7700	; THIS IS A RESPONSE -ONLY FIEL D WHICH DO ES NOT USE THE GET, FORMAT, OR SET CODE
7701	"DATA",900 2313.91,51 0,0)
7702	B23^^OTHER PAYER HEL PDESK PHON E EXT^^^^^ 8^N
7703	"DATA",900 2313.91,51 0,1)
7704	OTHER PAYE R HELP DES K TELEPHON E NUMBER E XTENSION
7705	"DATA",900 2313.91,51 0,5)
7706	7Q^^2023
7707	"DATA",900 2313.91,51 0,10,0)
7708	^^1^1^3141 223
7709	"DATA",900 2313.91,51 0,10,1,0)
7710	; THIS IS A RESPONSE -ONLY FIEL D WHICH DO ES NOT USE THE GET, FORMAT, OR SET CODE
7711	"DATA",900 2313.91,51 1,0)
7712	B52^^RESPO NSE INTERM EDIARY AUT H CNT^^^^^ 1^N
7713	"DATA",900 2313.91,51 1,1)
7714	RESPONSE I NTERMEDIAR Y AUTHORIZ ATION COUN T
7715	"DATA",900 2313.91,51 1,5)
7716	8R^^2052
7717	"DATA",900 2313.91,51 1,10,0)
7718	^^1^1^3141 223
7719	"DATA",900 2313.91,51 1,10,1,0)
7720	; THIS IS A RESPONSE -ONLY FIEL D WHICH DO ES NOT USE THE GET, FORMAT, OR SET CODE
7721	"DATA",900 2313.91,51 2,0)
7722	B53^^RESPO NSE INTERM ED AUTH TY PE ID^^^^^ 2^N
7723	"DATA",900 2313.91,51 2,1)
7724	RESPONSE I NTERMEDIAR Y AUTHORIZ ATION TYPE ID
7725	"DATA",900 2313.91,51 2,5)
7726	8S^^2053
7727	"DATA",900 2313.91,51 2,10,0)
7728	^^1^1^3141 223
7729	"DATA",900 2313.91,51 2,10,1,0)
7730	; THIS IS A RESPONSE -ONLY FIEL D WHICH DO ES NOT USE THE GET, FORMAT, OR SET CODE
7731	"DATA",900 2313.91,51 3,0)
7732	B54^^RESPO NSE INTERM EDIARY AUT H ID^^^^^2 0^A/N
7733	"DATA",900 2313.91,51 3,1)
7734	RESPONSE I NTERMEDIAR Y AUTHORIZ ATION ID
7735	"DATA",900 2313.91,51 3,5)
7736	8T^^2054
7737	"DATA",900 2313.91,51 3,10,0)
7738	^^1^1^3141 223
7739	"DATA",900 2313.91,51 3,10,1,0)
7740	; THIS IS A RESPONSE -ONLY FIEL D WHICH DO ES NOT USE THE GET, FORMAT, OR SET CODE
7741	"DATA",900 2313.91,51 4,0)
7742	B51^^INTER MEDIARY ME SSAGE^^^^^ 200^A/N
7743	"DATA",900 2313.91,51 4,5)
7744	8Q^^2051
7745	"DATA",900 2313.91,51 4,10,0)
7746	^^1^1^3141 223
7747	"DATA",900 2313.91,51 4,10,1,0)
7748	; THIS IS A RESPONSE -ONLY FIEL D WHICH DO ES NOT USE THE GET, FORMAT, OR SET CODE
7749	"FIA",9002 313.02)
7750	BPS CLAIMS
7751	"FIA",9002 313.02,0)
7752	^BPSC(
7753	"FIA",9002 313.02,0,0 )
7754	9002313.02
7755	"FIA",9002 313.02,0,1 )
7756	y^n^p^^^^n ^^n
7757	"FIA",9002 313.02,0,1 0)
7758
7759	"FIA",9002 313.02,0,1 1)
7760
7761	"FIA",9002 313.02,0," RLRO")
7762
7763	"FIA",9002 313.02,0," VR")
7764	1.0^BPS
7765	"FIA",9002 313.02,900 2313.02)
7766	1
7767	"FIA",9002 313.02,900 2313.0201)
7768	1
7769	"FIA",9002 313.02,900 2313.0201, 2095)
7770
7771	"FIA",9002 313.03)
7772	BPS RESPON SES
7773	"FIA",9002 313.03,0)
7774	^BPSR(
7775	"FIA",9002 313.03,0,0 )
7776	9002313.03 P
7777	"FIA",9002 313.03,0,1 )
7778	y^n^p^^^^n ^^n
7779	"FIA",9002 313.03,0,1 0)
7780
7781	"FIA",9002 313.03,0,1 1)
7782
7783	"FIA",9002 313.03,0," RLRO")
7784
7785	"FIA",9002 313.03,0," VR")
7786	1.0^BPS
7787	"FIA",9002 313.03,900 2313.03)
7788	1
7789	"FIA",9002 313.03,900 2313.0301)
7790	1
7791	"FIA",9002 313.03,900 2313.0301, 2098)
7792
7793	"FIA",9002 313.32)
7794	BPS PAYER RESPONSE O VERRIDES
7795	"FIA",9002 313.32,0)
7796	^BPS(90023 13.32,
7797	"FIA",9002 313.32,0,0 )
7798	9002313.32
7799	"FIA",9002 313.32,0,1 )
7800	y^n^p^^^^n ^^n
7801	"FIA",9002 313.32,0,1 0)
7802
7803	"FIA",9002 313.32,0,1 1)
7804
7805	"FIA",9002 313.32,0," RLRO")
7806
7807	"FIA",9002 313.32,0," VR")
7808	1.0^BPS
7809	"FIA",9002 313.32,900 2313.32)
7810	1
7811	"FIA",9002 313.32,900 2313.32,2. 09)
7812
7813	"FIA",9002 313.56)
7814	BPS PHARMA CIES
7815	"FIA",9002 313.56,0)
7816	^BPS(90023 13.56,
7817	"FIA",9002 313.56,0,0 )
7818	9002313.56
7819	"FIA",9002 313.56,0,1 )
7820	y^y^p^^^^n ^^n
7821	"FIA",9002 313.56,0,1 0)
7822
7823	"FIA",9002 313.56,0,1 1)
7824
7825	"FIA",9002 313.56,0," RLRO")
7826
7827	"FIA",9002 313.56,0," VR")
7828	1.0^BPS
7829	"FIA",9002 313.56,900 2313.56)
7830	1
7831	"FIA",9002 313.56,900 2313.56,.0 9)
7832
7833	"FIA",9002 313.91)
7834	BPS NCPDP FIELD DEFS
7835	"FIA",9002 313.91,0)
7836	^BPSF(9002 313.91,
7837	"FIA",9002 313.91,0,0 )
7838	9002313.91 I
7839	"FIA",9002 313.91,0,1 )
7840	y^y^f^^n^^ y^o^n
7841	"FIA",9002 313.91,0,1 0)
7842
7843	"FIA",9002 313.91,0,1 1)
7844
7845	"FIA",9002 313.91,0," RLRO")
7846
7847	"FIA",9002 313.91,0," VR")
7848	1.0^BPS
7849	"FIA",9002 313.91,900 2313.91)
7850	0
7851	"FIA",9002 313.91,900 2313.9101)
7852	0
7853	"FIA",9002 313.91,900 2313.9102)
7854	0
7855	"FIA",9002 313.91,900 2313.9103)
7856	0
7857	"FIA",9002 313.91,900 2313.9104)
7858	0
7859	"INIT")
7860	POST^BPS22 PST
7861	"KRN",101, 1702,-1)
7862	0^15
7863	"KRN",101, 1702,0)
7864	VALM BLANK 1^^^A^^^^ ^^^^LIST M ANAGER
7865	"KRN",101, 1702,1,0)
7866	^^1^1^2920 203^
7867	"KRN",101, 1702,1,1,0 )
7868	This proto col is use d to forma t spaces i n menu lis ts.
7869	"KRN",101, 1702,10,0)
7870	^101.01PA^ 0^0
7871	"KRN",101, 1704,-1)
7872	0^16
7873	"KRN",101, 1704,0)
7874	VALM BLANK 2^^^A^^^^ ^^^^LIST M ANAGER
7875	"KRN",101, 1704,1,0)
7876	^^1^1^3141 217^
7877	"KRN",101, 1704,1,1,0 )
7878	This proto col is use d to forma t spaces i n menu lis ts.
7879	"KRN",101, 1705,-1)
7880	0^17
7881	"KRN",101, 1705,0)
7882	VALM BLANK 3^^^A^^^^ ^^^^
7883	"KRN",101, 1705,1,0)
7884	^^1^1^2920 203^
7885	"KRN",101, 1705,1,1,0 )
7886	This proto col is use d to forma t spaces i n menu lis ts.
7887	"KRN",101, 7653,-1)
7888	0^1
7889	"KRN",101, 7653,0)
7890	BPS VIEW E CME RX MEN U^View ECM E Prescrip tion Menu^ ^M^^^^^^^^ E CLAIMS M GMT ENGINE
7891	"KRN",101, 7653,4)
7892	20^3
7893	"KRN",101, 7653,10,0)
7894	^101.01PA^ 17^17
7895	"KRN",101, 7653,10,2, 0)
7896	7654^VW^11 ^
7897	"KRN",101, 7653,10,2, "^")
7898	BPS VRX NA V VIEWRX
7899	"KRN",101, 7653,10,3, 0)
7900	7655^CL^12 ^
7901	"KRN",101, 7653,10,3, "^")
7902	BPS VRX NA V ECME CLA IM LOG
7903	"KRN",101, 7653,10,4, 0)
7904	7656^BE^13 ^
7905	"KRN",101, 7653,10,4, "^")
7906	BPS VRX NA V BILLING EVENTS RPT
7907	"KRN",101, 7653,10,5, 0)
7908	7657^CR^21 ^
7909	"KRN",101, 7653,10,5, "^")
7910	BPS VRX NA V CRI
7911	"KRN",101, 7653,10,6, 0)
7912	7658^IN^22 ^
7913	"KRN",101, 7653,10,6, "^")
7914	BPS VRX NA V INS POL
7915	"KRN",101, 7653,10,7, 0)
7916	7659^LB^23 ^
7917	"KRN",101, 7653,10,7, "^")
7918	BPS VRX NA V BILL LIS T
7919	"KRN",101, 7653,10,8, 0)
7920	7660^CI^31 ^
7921	"KRN",101, 7653,10,8, "^")
7922	BPS VRX NA V TPJI CLA IM INFORMA TION
7923	"KRN",101, 7653,10,9, 0)
7924	7661^AP^32 ^
7925	"KRN",101, 7653,10,9, "^")
7926	BPS VRX NA V TPJI AR ACCT PROFI LE
7927	"KRN",101, 7653,10,10 ,0)
7928	7662^CM^33 ^
7929	"KRN",101, 7653,10,10 ,"^")
7930	BPS VRX NA V TPJI AR COMMENT HI STORY
7931	"KRN",101, 7653,10,11 ,0)
7932	7663^ER^41 ^
7933	"KRN",101, 7653,10,11 ,"^")
7934	BPS VRX NA V TPJI ECM E RX INFO
7935	"KRN",101, 7653,10,12 ,0)
7936	7664^ES^42 ^
7937	"KRN",101, 7653,10,12 ,"^")
7938	BPS VRX NA V DG ELIG STATUS
7939	"KRN",101, 7653,10,13 ,0)
7940	7665^EV^43 ^
7941	"KRN",101, 7653,10,13 ,"^")
7942	BPS VRX NA V DG ELIG VERIFICATI ON
7943	"KRN",101, 7653,10,14 ,0)
7944	8274^PR^44 ^
7945	"KRN",101, 7653,10,14 ,"^")
7946	BPS VRX NA V PRINT RE PORT
7947	"KRN",101, 7653,10,15 ,0)
7948	1702^^14^
7949	"KRN",101, 7653,10,15 ,"^")
7950	VALM BLANK 1
7951	"KRN",101, 7653,10,16 ,0)
7952	1704^^24^
7953	"KRN",101, 7653,10,16 ,"^")
7954	VALM BLANK 2
7955	"KRN",101, 7653,10,17 ,0)
7956	1705^^34^
7957	"KRN",101, 7653,10,17 ,"^")
7958	VALM BLANK 3
7959	"KRN",101, 7653,26)
7960	D SHOW^VAL M
7961	"KRN",101, 7653,28)
7962	Select Act ion:
7963	"KRN",101, 7653,99)
7964	64419,4053 1
7965	"KRN",101, 7654,-1)
7966	0^14
7967	"KRN",101, 7654,0)
7968	BPS VRX NA V VIEWRX^V iew Rx^^A^ ^^^^^^^E C LAIMS MGMT ENGINE
7969	"KRN",101, 7654,15)
7970	S VALMBCK= "R"
7971	"KRN",101, 7654,20)
7972	D NAV^BPSV RX(1)
7973	"KRN",101, 7654,99)
7974	62524,2806 5
7975	"KRN",101, 7655,-1)
7976	0^7
7977	"KRN",101, 7655,0)
7978	BPS VRX NA V ECME CLA IM LOG^Cla im Log^^A^ ^^^^^^^E C LAIMS MGMT ENGINE
7979	"KRN",101, 7655,15)
7980	S VALMBCK= "R"
7981	"KRN",101, 7655,20)
7982	D NAV^BPSV RX(2)
7983	"KRN",101, 7655,99)
7984	62524,2806 5
7985	"KRN",101, 7656,-1)
7986	0^3
7987	"KRN",101, 7656,0)
7988	BPS VRX NA V BILLING EVENTS RPT ^Billing E vents^^A^^ ^^^^^^E CL AIMS MGMT ENGINE
7989	"KRN",101, 7656,15)
7990	S VALMBCK= "R"
7991	"KRN",101, 7656,20)
7992	D NAV^BPSV RX(3)
7993	"KRN",101, 7656,99)
7994	62524,2806 5
7995	"KRN",101, 7657,-1)
7996	0^4
7997	"KRN",101, 7657,0)
7998	BPS VRX NA V CRI^CRI Report^^A^ ^^^^^^^E C LAIMS MGMT ENGINE
7999	"KRN",101, 7657,15)
8000	S VALMBCK= "R"
8001	"KRN",101, 7657,20)
8002	D NAV^BPSV RX(4)
8003	"KRN",101, 7657,99)
8004	62524,2806 5
8005	"KRN",101, 7658,-1)
8006	0^8
8007	"KRN",101, 7658,0)
8008	BPS VRX NA V INS POL^ Insurance^ ^A^^^^^^^^ E CLAIMS M GMT ENGINE
8009	"KRN",101, 7658,15)
8010	S VALMBCK= "R"
8011	"KRN",101, 7658,20)
8012	D NAV^BPSV RX(5)
8013	"KRN",101, 7658,99)
8014	62524,2806 5
8015	"KRN",101, 7659,-1)
8016	0^2
8017	"KRN",101, 7659,0)
8018	BPS VRX NA V BILL LIS T^List of Bills^^A^^ ^^^^^^E CL AIMS MGMT ENGINE
8019	"KRN",101, 7659,15)
8020	S VALMBCK= "R"
8021	"KRN",101, 7659,20)
8022	D NAV^BPSV RX(6)
8023	"KRN",101, 7659,99)
8024	62524,2806 5
8025	"KRN",101, 7660,-1)
8026	0^12
8027	"KRN",101, 7660,0)
8028	BPS VRX NA V TPJI CLA IM INFORMA TION^TPJI Claim Info ^^A^^^^^^^ ^E CLAIMS MGMT ENGIN E
8029	"KRN",101, 7660,15)
8030	S VALMBCK= "R"
8031	"KRN",101, 7660,20)
8032	D NAV^BPSV RX(7)
8033	"KRN",101, 7660,99)
8034	62524,2806 5
8035	"KRN",101, 7661,-1)
8036	0^10
8037	"KRN",101, 7661,0)
8038	BPS VRX NA V TPJI AR ACCT PROFI LE^TPJI Ac ct Pro^^A^ ^^^^^^^E C LAIMS MGMT ENGINE
8039	"KRN",101, 7661,15)
8040	S VALMBCK= "R"
8041	"KRN",101, 7661,20)
8042	D NAV^BPSV RX(8)
8043	"KRN",101, 7661,99)
8044	62524,2806 5
8045	"KRN",101, 7662,-1)
8046	0^11
8047	"KRN",101, 7662,0)
8048	BPS VRX NA V TPJI AR COMMENT HI STORY^TPJI AR Comm^^ A^^^^^^^^E CLAIMS MG MT ENGINE
8049	"KRN",101, 7662,15)
8050	S VALMBCK= "R"
8051	"KRN",101, 7662,20)
8052	D NAV^BPSV RX(9)
8053	"KRN",101, 7662,99)
8054	62524,2806 5
8055	"KRN",101, 7663,-1)
8056	0^13
8057	"KRN",101, 7663,0)
8058	BPS VRX NA V TPJI ECM E RX INFO^ TPJI ECME Rx^^A^^^^^ ^^^E CLAIM S MGMT ENG INE
8059	"KRN",101, 7663,15)
8060	S VALMBCK= "R"
8061	"KRN",101, 7663,20)
8062	D NAV^BPSV RX(10)
8063	"KRN",101, 7663,99)
8064	62524,2806 5
8065	"KRN",101, 7664,-1)
8066	0^5
8067	"KRN",101, 7664,0)
8068	BPS VRX NA V DG ELIG STATUS^Eli g Status^^ A^^^^^^^^E CLAIMS MG MT ENGINE
8069	"KRN",101, 7664,15)
8070	S VALMBCK= "R"
8071	"KRN",101, 7664,20)
8072	D NAV^BPSV RX(11)
8073	"KRN",101, 7664,99)
8074	62524,2806 5
8075	"KRN",101, 7665,-1)
8076	0^6
8077	"KRN",101, 7665,0)
8078	BPS VRX NA V DG ELIG VERIFICATI ON^Elig Ve rif^^A^^^^ ^^^^E CLAI MS MGMT EN GINE
8079	"KRN",101, 7665,15)
8080	S VALMBCK= "R"
8081	"KRN",101, 7665,20)
8082	D NAV^BPSV RX(12)
8083	"KRN",101, 7665,99)
8084	62524,2806 5
8085	"KRN",101, 8274,-1)
8086	0^9
8087	"KRN",101, 8274,0)
8088	BPS VRX NA V PRINT RE PORT^Print Report(s) ^^A^^^^^^^ ^E CLAIMS MGMT ENGIN E
8089	"KRN",101, 8274,15)
8090	S VALMBCK= "R"
8091	"KRN",101, 8274,20)
8092	D REPORT^B PSVRX3
8093	"KRN",101, 8274,99)
8094	64419,4023 3
8095	"KRN",409. 61,699,-1)
8096	0^1
8097	"KRN",409. 61,699,0)
8098	BPS VIEW E CME RX^1^^ 240^5^18^1 ^1^^BPS VI EW ECME RX MENU^View ECME Pres cription^1 ^^1
8099	"KRN",409. 61,699,1)
8100	^VALM HIDD EN ACTIONS
8101	"KRN",409. 61,699,"AR RAY")
8102	^TMP("BPS VRX",$J)
8103	"KRN",409. 61,699,"FN L")
8104	D EXIT^BPS VRX
8105	"KRN",409. 61,699,"HD R")
8106	D HDR^BPSV RX
8107	"KRN",409. 61,699,"HL P")
8108	D HELP^BPS VRX
8109	"KRN",409. 61,699,"IN IT")
8110	D INIT^BPS VRX(.BPSVR X)
8111	"MBREQ")
8112	1
8113	"ORD",15,1 01)
8114	101;15;;;P RO^XPDTA;P ROF1^XPDIA ;PROE1^XPD IA;PROF2^X PDIA;;PROD EL^XPDIA
8115	"ORD",15,1 01,0)
8116	PROTOCOL
8117	"ORD",17,4 09.61)
8118	409.61;17; 1;;;;LME1^ XPDIA1;;;L MDEL^XPDIA 1
8119	"ORD",17,4 09.61,0)
8120	LIST TEMPL ATE
8121	"PKG",632, -1)
8122	1^1
8123	"PKG",632, 0)
8124	E CLAIMS M GMT ENGINE ^BPS^ELECT RONIC CLAI MS MGT
8125	"PKG",632, 22,0)
8126	^9.49I^1^1
8127	"PKG",632, 22,1,0)
8128	1.0^304100 8^3041130^ 568
8129	"PKG",632, 22,1,"PAH" ,1,0)
8130	22^3170629 ^520824639
8131	"PKG",632, 22,1,"PAH" ,1,1,0)
8132	^^1^1^3170 629
8133	"PKG",632, 22,1,"PAH" ,1,1,1,0)
8134	MCCF EDI T AS EPHARMA CY BUILD 2
8135	"QUES","XP F1",0)
8136	Y
8137	"QUES","XP F1","??")
8138	^D REP^XPD H
8139	"QUES","XP F1","A")
8140	Shall I wr ite over y our \|FLAG\| File
8141	"QUES","XP F1","B")
8142	YES
8143	"QUES","XP F1","M")
8144	D XPF1^XPD IQ
8145	"QUES","XP F2",0)
8146	Y
8147	"QUES","XP F2","??")
8148	^D DTA^XPD H
8149	"QUES","XP F2","A")
8150	Want my da ta \|FLAG\| yours
8151	"QUES","XP F2","B")
8152	YES
8153	"QUES","XP F2","M")
8154	D XPF2^XPD IQ
8155	"QUES","XP I1",0)
8156	YO
8157	"QUES","XP I1","??")
8158	^D INHIBIT ^XPDH
8159	"QUES","XP I1","A")
8160	Want KIDS to INHIBIT LOGONs du ring the i nstall
8161	"QUES","XP I1","B")
8162	NO
8163	"QUES","XP I1","M")
8164	D XPI1^XPD IQ
8165	"QUES","XP M1",0)
8166	PO^VA(200, :EM
8167	"QUES","XP M1","??")
8168	^D MG^XPDH
8169	"QUES","XP M1","A")
8170	Enter the Coordinato r for Mail Group '\|F LAG\|'
8171	"QUES","XP M1","B")
8172
8173	"QUES","XP M1","M")
8174	D XPM1^XPD IQ
8175	"QUES","XP O1",0)
8176	Y
8177	"QUES","XP O1","??")
8178	^D MENU^XP DH
8179	"QUES","XP O1","A")
8180	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
8181	"QUES","XP O1","B")
8182	NO
8183	"QUES","XP O1","M")
8184	D XPO1^XPD IQ
8185	"QUES","XP Z1",0)
8186	Y
8187	"QUES","XP Z1","??")
8188	^D OPT^XPD H
8189	"QUES","XP Z1","A")
8190	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
8191	"QUES","XP Z1","B")
8192	NO
8193	"QUES","XP Z1","M")
8194	D XPZ1^XPD IQ
8195	"QUES","XP Z2",0)
8196	Y
8197	"QUES","XP Z2","??")
8198	^D RTN^XPD H
8199	"QUES","XP Z2","A")
8200	Want to MO VE routine s to other CPUs
8201	"QUES","XP Z2","B")
8202	NO
8203	"QUES","XP Z2","M")
8204	D XPZ2^XPD IQ
8205	"RTN")
8206	14
8207	"RTN","BPS 22PST")
8208	0^^B196531 57
8209	"RTN","BPS 22PST",1,0 )
8210	BPS22PST ; AITC/PD - Post-insta ll for BPS 1.022 ;5 /10/2017
8211	"RTN","BPS 22PST",2,0 )
8212	;;1.0;E C LAIMS MGMT ENGINE; 22;;Buil d 15
8213	"RTN","BPS 22PST",3,0 )
8214	;;Per VA Directive 6402, this routine s hould not be modifie d.
8215	"RTN","BPS 22PST",4,0 )
8216	;
8217	"RTN","BPS 22PST",5,0 )
8218	Q
8219	"RTN","BPS 22PST",6,0 )
8220	;
8221	"RTN","BPS 22PST",7,0 )
8222	POST ; Pos t-install functions are coded here.
8223	"RTN","BPS 22PST",8,0 )
8224	;
8225	"RTN","BPS 22PST",9,0 )
8226	D MES^XPD UTL(" Sta rting post -install o f BPS1.0 22")
8227	"RTN","BPS 22PST",10, 0)
8228	D AUTOREV
8229	"RTN","BPS 22PST",11, 0)
8230	D BMES^XP DUTL(" Fi nished pos t-install of BPS1.0 22")
8231	"RTN","BPS 22PST",12, 0)
8232	Q
8233	"RTN","BPS 22PST",13, 0)
8234	;
8235	"RTN","BPS 22PST",14, 0)
8236	AUTOREV ; Update AUT O-REVERSAL PARAMETER in BPS PH ARMACIES
8237	"RTN","BPS 22PST",15, 0)
8238	;
8239	"RTN","BPS 22PST",16, 0)
8240	; If exis ting value is nil or outside o f inclusiv e range 3- 10 set val ue to 5.
8241	"RTN","BPS 22PST",17, 0)
8242	;
8243	"RTN","BPS 22PST",18, 0)
8244	N BPSAR,B PSARP,BPSI EN,CNT,DA, DIE,DR
8245	"RTN","BPS 22PST",19, 0)
8246	;
8247	"RTN","BPS 22PST",20, 0)
8248	D BMES^XP DUTL(" U pdating AU TO-REVERSA L PARAMETE Rs")
8249	"RTN","BPS 22PST",21, 0)
8250	;
8251	"RTN","BPS 22PST",22, 0)
8252	S CNT=0
8253	"RTN","BPS 22PST",23, 0)
8254	S BPSIEN= 0 F S BPS IEN=$O(^BP S(9002313. 56,BPSIEN) ) Q:BPSIEN '?1N.N D
8255	"RTN","BPS 22PST",24, 0)
8256	. S BPSAR P=$P($G(^B PS(9002313 .56,BPSIEN ,0)),U,9)
8257	"RTN","BPS 22PST",25, 0)
8258	. I (BPSA RP="")!(BP SARP<3)!(B PSARP>10) D
8259	"RTN","BPS 22PST",26, 0)
8260	. . S DIE =9002313.5 6,DA=BPSIE N,DR=".09/ ///5"
8261	"RTN","BPS 22PST",27, 0)
8262	. . D ^DI E
8263	"RTN","BPS 22PST",28, 0)
8264	. . S BPS AR(BPSIEN) =BPSARP_U_ $$NOW^XLFD T
8265	"RTN","BPS 22PST",29, 0)
8266	. . S CNT =CNT+1
8267	"RTN","BPS 22PST",30, 0)
8268	;
8269	"RTN","BPS 22PST",31, 0)
8270	I $D(BPSA R) D MAIL( .BPSAR)
8271	"RTN","BPS 22PST",32, 0)
8272	;
8273	"RTN","BPS 22PST",33, 0)
8274	D MES^XPD UTL(" - "_CNT_" e ntries upd ated")
8275	"RTN","BPS 22PST",34, 0)
8276	D MES^XPD UTL(" - Done with updating AUTO-REVER SAL PARAME TERs")
8277	"RTN","BPS 22PST",35, 0)
8278	;
8279	"RTN","BPS 22PST",36, 0)
8280	Q
8281	"RTN","BPS 22PST",37, 0)
8282	;
8283	"RTN","BPS 22PST",38, 0)
8284	MAIL(BPSAR ) ; Genera te MailMan E-Mail
8285	"RTN","BPS 22PST",39, 0)
8286	;
8287	"RTN","BPS 22PST",40, 0)
8288	N BPSARP, BPSDT,BPSI EN,BPSL,BP SNAME,BPSS ITE,BPSX,U SR,XMDUZ,X MSUB,XMTEX T,XMY
8289	"RTN","BPS 22PST",41, 0)
8290	;
8291	"RTN","BPS 22PST",42, 0)
8292	S BPSSITE =$$SITE^VA SITE() ; IA 10112
8293	"RTN","BPS 22PST",43, 0)
8294	;
8295	"RTN","BPS 22PST",44, 0)
8296	S BPSL=0
8297	"RTN","BPS 22PST",45, 0)
8298	S BPSL=BP SL+1,BPSX( BPSL)="Vis tA patch B PS1.022 was succes sfully ins talled at your site. "
8299	"RTN","BPS 22PST",46, 0)
8300	S BPSL=BP SL+1,BPSX( BPSL)=" "
8301	"RTN","BPS 22PST",47, 0)
8302	;
8303	"RTN","BPS 22PST",48, 0)
8304	S BPSIEN= ""
8305	"RTN","BPS 22PST",49, 0)
8306	F S BPSI EN=$O(BPSA R(BPSIEN)) Q:BPSIEN= "" D
8307	"RTN","BPS 22PST",50, 0)
8308	. S BPSAR P=$P($G(BP SAR(BPSIEN )),U)
8309	"RTN","BPS 22PST",51, 0)
8310	. S BPSDT =$P($G(BPS AR(BPSIEN) ),U,2)
8311	"RTN","BPS 22PST",52, 0)
8312	. S BPSNA ME=$P($G(^ BPS(900231 3.56,BPSIE N,0)),U,1)
8313	"RTN","BPS 22PST",53, 0)
8314	. S BPSL= BPSL+1,BPS X(BPSL)=" Nam e: "_BPSNA ME
8315	"RTN","BPS 22PST",54, 0)
8316	. S BPSL= BPSL+1,BPS X(BPSL)=" Station #: "_$P(BP SSITE,U,3)
8317	"RTN","BPS 22PST",55, 0)
8318	. S BPSL= BPSL+1,BPS X(BPSL)=" Date/Tim e: "_$$FMT E^XLFDT(BP SDT,"5ZPM" )
8319	"RTN","BPS 22PST",56, 0)
8320	. S BPSL= BPSL+1,BPS X(BPSL)=" B y: "_$P($G (^VA(200,D UZ,0)),U,1 )
8321	"RTN","BPS 22PST",57, 0)
8322	. S BPSL= BPSL+1,BPS X(BPSL)=" "
8323	"RTN","BPS 22PST",58, 0)
8324	. S BPSL= BPSL+1,BPS X(BPSL)="T he ePharma cy Auto-Re versal Par ameter has been chan ged at you r site."
8325	"RTN","BPS 22PST",59, 0)
8326	. S BPSL= BPSL+1,BPS X(BPSL)=" Previo us Value: "_BPSARP
8327	"RTN","BPS 22PST",60, 0)
8328	. S BPSL= BPSL+1,BPS X(BPSL)=" N ew Value: 5"
8329	"RTN","BPS 22PST",61, 0)
8330	. S BPSL= BPSL+1,BPS X(BPSL)=" "
8331	"RTN","BPS 22PST",62, 0)
8332	;
8333	"RTN","BPS 22PST",63, 0)
8334	S BPSL=BP SL+1,BPSX( BPSL)="The Auto-Reve rsal Param eter can b e changed using opti on Edit EC ME Pharmac y"
8335	"RTN","BPS 22PST",64, 0)
8336	S BPSL=BP SL+1,BPSX( BPSL)="Dat a."
8337	"RTN","BPS 22PST",65, 0)
8338	S BPSL=BP SL+1,BPSX( BPSL)=" "
8339	"RTN","BPS 22PST",66, 0)
8340	S BPSL=BP SL+1,BPSX( BPSL)="ECM E uses the AUTO-REVE RSE site p arameter w hen determ ining whet her non-re leased"
8341	"RTN","BPS 22PST",67, 0)
8342	S BPSL=BP SL+1,BPSX( BPSL)="pre scription claims (th at have re turned a P AYABLE res ponse) are to be"
8343	"RTN","BPS 22PST",68, 0)
8344	S BPSL=BP SL+1,BPSX( BPSL)="aut omatically REVERSED. "
8345	"RTN","BPS 22PST",69, 0)
8346	S BPSL=BP SL+1,BPSX( BPSL)=" "
8347	"RTN","BPS 22PST",70, 0)
8348	S BPSL=BP SL+1,BPSX( BPSL)="The AUTO-REVE RSE site p arameter i s set for the number of days t hat ECME w ill"
8349	"RTN","BPS 22PST",71, 0)
8350	S BPSL=BP SL+1,BPSX( BPSL)="wai t before t he claim i s automati cally REVE RSED. The user is al lowed to e nter"
8351	"RTN","BPS 22PST",72, 0)
8352	S BPSL=BP SL+1,BPSX( BPSL)="a n umber from 3 to 10. 5 is the s uggested s etting. EC ME will wa it the"
8353	"RTN","BPS 22PST",73, 0)
8354	S BPSL=BP SL+1,BPSX( BPSL)="ent ered numbe r of days before REV ERSING the non-relea sed RX wit h a PAYABL E"
8355	"RTN","BPS 22PST",74, 0)
8356	S BPSL=BP SL+1,BPSX( BPSL)="pay er returne d response ."
8357	"RTN","BPS 22PST",75, 0)
8358	;
8359	"RTN","BPS 22PST",76, 0)
8360	S XMSUB=" ePharmacy Auto-Rever sal Parame ter Change : BPS1.0 22 "
8361	"RTN","BPS 22PST",77, 0)
8362	S XMSUB=X MSUB_$P(BP SSITE,U,3) _" #"_$P(B PSSITE,U,2 )
8363	"RTN","BPS 22PST",78, 0)
8364	S XMDUZ=" BPS Patch* 1.0*22"
8365	"RTN","BPS 22PST",79, 0)
8366	S XMTEXT= "BPSX("
8367	"RTN","BPS 22PST",80, 0)
8368	; Define Recipients of Email - Recipien ts Include :
8369	"RTN","BPS 22PST",81, 0)
8370	; Install er of Patc h
8371	"RTN","BPS 22PST",82, 0)
8372	; Holders of PSO EP HARMACY SI TE MANAGER Key
8373	"RTN","BPS 22PST",83, 0)
8374	; Gregory Laird (pr oduction o nly)
8375	"RTN","BPS 22PST",84, 0)
8376	; Select team membe rs (produc tion only)
8377	"RTN","BPS 22PST",85, 0)
8378	S XMY(DUZ )=""
8379	"RTN","BPS 22PST",86, 0)
8380	S USR=0 F S USR=$O (^XUSEC("P SO EPHARMA CY SITE MA NAGER",USR )) Q:USR=" " S XMY(U SR)=""
8381	"RTN","BPS 22PST",87, 0)
8382	I $$PROD^ XUPROD(1) D
8383	"RTN","BPS 22PST",88, 0)
8384	. S XMY(" PII ")=""
8385	"RTN","BPS 22PST",89, 0)
8386	. S XMY(" PII ")=""
8387	"RTN","BPS 22PST",90, 0)
8388	. S XMY(" PII ")=""
8389	"RTN","BPS 22PST",91, 0)
8390	. S XMY(" P II ")=""
8391	"RTN","BPS 22PST",92, 0)
8392	; When in voking ^XM D in pre/p ost-init r outine of Kernel Ins tallation and
8393	"RTN","BPS 22PST",93, 0)
8394	; Distrib ution Syst em (KIDS) build, the calling r outine mus t NEW the DIFROM var iable
8395	"RTN","BPS 22PST",94, 0)
8396	; Otherwi se, your m essage wil l not be d elivered.
8397	"RTN","BPS 22PST",95, 0)
8398	N DIFROM
8399	"RTN","BPS 22PST",96, 0)
8400	D ^XMD ; IA# 10070
8401	"RTN","BPS 22PST",97, 0)
8402	;
8403	"RTN","BPS 22PST",98, 0)
8404	Q
8405	"RTN","BPS BCKJ")
8406	0^5^B53136 758
8407	"RTN","BPS BCKJ",1,0)
8408	BPSBCKJ ;B HAM ISC/AA T - BPS NI GHTLY BACK GROUND JOB ;02/27/20 05
8409	"RTN","BPS BCKJ",2,0)
8410	;;1.0;E C LAIMS MGMT ENGINE; 1,2,5,7,8, 22;JUN 2 004;Build 15
8411	"RTN","BPS BCKJ",3,0)
8412	;;Per VA Directive 6402, this routine s hould not be modifie d.
8413	"RTN","BPS BCKJ",4,0)
8414	;
8415	"RTN","BPS BCKJ",5,0)
8416	Q
8417	"RTN","BPS BCKJ",6,0)
8418	;
8419	"RTN","BPS BCKJ",7,0)
8420	EN ; The E CME NIGHTL Y PROCESS
8421	"RTN","BPS BCKJ",8,0)
8422	;
8423	"RTN","BPS BCKJ",9,0)
8424	; The lis t of night ly actions
8425	"RTN","BPS BCKJ",10,0 )
8426	D AUTOREV ; Aut o-Reversal s (normal and inpati ent)
8427	"RTN","BPS BCKJ",11,0 )
8428	D MAIN^BP SOSK ; Pur ge BPS LOG
8429	"RTN","BPS BCKJ",12,0 )
8430	D TASKMAN ^BPSJAREG ; Do autom atic regis tration.
8431	"RTN","BPS BCKJ",13,0 )
8432	Q
8433	"RTN","BPS BCKJ",14,0 )
8434	;
8435	"RTN","BPS BCKJ",15,0 )
8436	AUTOREV ; The Auto-R everse Pro cedure
8437	"RTN","BPS BCKJ",16,0 )
8438	N BDT,BTR AN,BPHARM, BTRAN0,BTR AN1,BTRAN4 ,BDAYS,BRX ,BFIL,BDAT E,BNOW,BCL AIM,BRES,B REV,BTEST, REF,BCNT,B TX,X,X1,X2
8439	"RTN","BPS BCKJ",17,0 )
8440	N BTRAN9, BELIG,BDRU G
8441	"RTN","BPS BCKJ",18,0 )
8442	;
8443	"RTN","BPS BCKJ",19,0 )
8444	S BTEST=0 ; Debuggi ng flag 1 - TEST, 0 - LIVE
8445	"RTN","BPS BCKJ",20,0 )
8446	S BCNT=0 ; Count re versals
8447	"RTN","BPS BCKJ",21,0 )
8448	;
8449	"RTN","BPS BCKJ",22,0 )
8450	S REF=$NA (^TMP($J," BPSBCKJ")) K @REF
8451	"RTN","BPS BCKJ",23,0 )
8452	;
8453	"RTN","BPS BCKJ",24,0 )
8454	S (X1,BNO W)=$$DT^XL FDT()
8455	"RTN","BPS BCKJ",25,0 )
8456	;
8457	"RTN","BPS BCKJ",26,0 )
8458	;Define n umber of d ays to loo k back - A uto Revers e days can be from 0 -31
8459	"RTN","BPS BCKJ",27,0 )
8460	;To make sure every claim is caught, mo ving back 45 days
8461	"RTN","BPS BCKJ",28,0 )
8462	S X2=-45 D C^%DTC S BDT=X
8463	"RTN","BPS BCKJ",29,0 )
8464	;
8465	"RTN","BPS BCKJ",30,0 )
8466	;Loop thr ough 'LAST UPDATE' ' AH' index
8467	"RTN","BPS BCKJ",31,0 )
8468	F S BDT= $O(^BPST(" AH",BDT)) Q:'BDT S BTRAN=0 F S BTRAN=$ O(^BPST("A H",BDT,BTR AN)) Q:'BT RAN D
8469	"RTN","BPS BCKJ",32,0 )
8470	. W:BTEST !,"TRAN=" ,BTRAN," " ,?20
8471	"RTN","BPS BCKJ",33,0 )
8472	. S BTRAN 0=$G(^BPST (BTRAN,0)) ,BTRAN1=$G (^(1)),BTR AN4=$G(^(4 )),BTRAN9= $G(^(9))
8473	"RTN","BPS BCKJ",34,0 )
8474	. I BTRAN 0=""!(BTRA N1="") W:B TEST "ZERO OR ONE NO DE MISSING " Q
8475	"RTN","BPS BCKJ",35,0 )
8476	. I '$$PA ID^BPSOSQ4 (BTRAN) W: BTEST "NOT PAID" Q ; Not paid
8477	"RTN","BPS BCKJ",36,0 )
8478	. S BPHAR M=$P(BTRAN 1,U,7) I ' BPHARM W:B TEST "NO B PS PHARM" Q ; BPS P HARMACY
8479	"RTN","BPS BCKJ",37,0 )
8480	. W:BTEST "BPHARM=" ,$P($G(^BP S(9002313. 56,BPHARM, 0)),U,1)," "
8481	"RTN","BPS BCKJ",38,0 )
8482	. ;
8483	"RTN","BPS BCKJ",39,0 )
8484	. ;Handle 'Inpatien t' Auto-Re versals
8485	"RTN","BPS BCKJ",40,0 )
8486	. S BREV= $$REVINP(B NOW,BTRAN, BTRAN0,BTR AN1,BPHARM ) Q:BREV
8487	"RTN","BPS BCKJ",41,0 )
8488	. ;
8489	"RTN","BPS BCKJ",42,0 )
8490	. ;Handle Regular A uto-Revers als
8491	"RTN","BPS BCKJ",43,0 )
8492	. S BDAYS =+$P($G(^B PS(9002313 .56,BPHARM ,0)),U,9)
8493	"RTN","BPS BCKJ",44,0 )
8494	. I 'BDAY S W:BTEST "AUTO-REV DISABLED" Q ;disabl ed
8495	"RTN","BPS BCKJ",45,0 )
8496	. I $P(BT RAN4,U,1) Q ;Revers al claim e xist
8497	"RTN","BPS BCKJ",46,0 )
8498	. S BCLAI M=$P(BTRAN 0,U,4) I ' BCLAIM W:B TEST "NO B CLAIM" Q
8499	"RTN","BPS BCKJ",47,0 )
8500	. I $P($G (^BPSC(BCL AIM,0)),U, 7) W:BTEST "AUTO-REV ERSE FLAG" Q
8501	"RTN","BPS BCKJ",48,0 )
8502	. S BDATE =$P($G(^BP SC(BCLAIM, 0)),U,5)
8503	"RTN","BPS BCKJ",49,0 )
8504	. I 'BDAT E S BDATE= $P($G(^BPS C(BCLAIM,0 )),U,6)
8505	"RTN","BPS BCKJ",50,0 )
8506	. S BDATE =$P(BDATE, ".")
8507	"RTN","BPS BCKJ",51,0 )
8508	. I 'BDAT E="" W:BTE ST "NO DAT E" Q
8509	"RTN","BPS BCKJ",52,0 )
8510	. W:BTEST "DATE=",B DATE," "
8511	"RTN","BPS BCKJ",53,0 )
8512	. I $$FMD IFF^XLFDT( BNOW,BDATE ,1)'>BDAYS W:BTEST " TOO EARLY" Q
8513	"RTN","BPS BCKJ",54,0 )
8514	. S BRX=$ P(BTRAN1,U ,11) I 'BR X W:BTEST "NO RX" Q
8515	"RTN","BPS BCKJ",55,0 )
8516	. S BFIL= $P(BTRAN1, U,1)
8517	"RTN","BPS BCKJ",56,0 )
8518	. I $$REL DATE(BRX,B FIL) W:BTE ST " RELEA SED" Q ;r eleased
8519	"RTN","BPS BCKJ",57,0 )
8520	. S BELIG =$P(BTRAN9 ,U,4) I BE LIG="" W:B TEST "NO E LIGIBILITY " Q
8521	"RTN","BPS BCKJ",58,0 )
8522	. S BDRUG =$$RXAPI1^ BPSUTIL1(B RX,6,"E") I BDRUG="" W:BTEST " NO DRUG" Q
8523	"RTN","BPS BCKJ",59,0 )
8524	. S BRES= $$REVERSE( BRX,BFIL,B CLAIM,1)
8525	"RTN","BPS BCKJ",60,0 )
8526	. W:BTEST " *REV CL M=",BCLAIM ," STAT=", BRES
8527	"RTN","BPS BCKJ",61,0 )
8528	. I BRES= 0!(BRES=4) D
8529	"RTN","BPS BCKJ",62,0 )
8530	.. S (BCN T,@REF@(BR ES))=$G(@R EF@(BRES)) +1
8531	"RTN","BPS BCKJ",63,0 )
8532	.. S @REF @(BRES,BCN T)=BTRAN_U _BCLAIM_U_ BRX_U_BFIL _U_BPHARM_ U_BELIG_U_ BDRUG
8533	"RTN","BPS BCKJ",64,0 )
8534	. ; Any n otificatio ns to IB?
8535	"RTN","BPS BCKJ",65,0 )
8536	D BULL(RE F) ; Send the bullet in
8537	"RTN","BPS BCKJ",66,0 )
8538	K @REF
8539	"RTN","BPS BCKJ",67,0 )
8540	Q
8541	"RTN","BPS BCKJ",68,0 )
8542	;
8543	"RTN","BPS BCKJ",69,0 )
8544	;Auto-Rev erse Claim s for Curr ent Inpati ents
8545	"RTN","BPS BCKJ",70,0 )
8546	;
8547	"RTN","BPS BCKJ",71,0 )
8548	;20050810 ;BEE;Phase III - CR1 1
8549	"RTN","BPS BCKJ",72,0 )
8550	;
8551	"RTN","BPS BCKJ",73,0 )
8552	REVINP(BNO W,BTRAN,BT RAN0,BTRAN 1,BPHARM) ;
8553	"RTN","BPS BCKJ",74,0 )
8554	N BRX,BFI L,BCLAIM,B DATE,BRES, DFN,VAIP
8555	"RTN","BPS BCKJ",75,0 )
8556	;
8557	"RTN","BPS BCKJ",76,0 )
8558	;Only pro cess Windo w fills
8559	"RTN","BPS BCKJ",77,0 )
8560	S BRX=+$P (BTRAN1,U, 11) I BRX= 0 Q 0
8561	"RTN","BPS BCKJ",78,0 )
8562	S BFIL=+$ P(BTRAN1,U )
8563	"RTN","BPS BCKJ",79,0 )
8564	I $$MWC^B PSRPT6(BRX ,BFIL)'="W " Q 0
8565	"RTN","BPS BCKJ",80,0 )
8566	;
8567	"RTN","BPS BCKJ",81,0 )
8568	;Check fo r Fill dat e - Must b e equal to T-5
8569	"RTN","BPS BCKJ",82,0 )
8570	S BCLAIM= $P(BTRAN0, U,4) I 'BC LAIM Q 0
8571	"RTN","BPS BCKJ",83,0 )
8572	S BDATE=$ $FILDATE(B RX,BFIL)
8573	"RTN","BPS BCKJ",84,0 )
8574	S BDATE=$ P(BDATE,". ")
8575	"RTN","BPS BCKJ",85,0 )
8576	I 'BDATE= "" Q 0
8577	"RTN","BPS BCKJ",86,0 )
8578	I $$FMDIF F^XLFDT(BN OW,BDATE,1 )'=5 Q 0
8579	"RTN","BPS BCKJ",87,0 )
8580	;
8581	"RTN","BPS BCKJ",88,0 )
8582	;Check fo r current Inpatient
8583	"RTN","BPS BCKJ",89,0 )
8584	S DFN=+$P (BTRAN0,U, 6) I DFN=0 Q 0
8585	"RTN","BPS BCKJ",90,0 )
8586	D IN5^VAD PT
8587	"RTN","BPS BCKJ",91,0 )
8588	I $G(VAIP (3))="" Q 0
8589	"RTN","BPS BCKJ",92,0 )
8590	;
8591	"RTN","BPS BCKJ",93,0 )
8592	;Auto-Rev erse Claim
8593	"RTN","BPS BCKJ",94,0 )
8594	S BRES=$$ REVERSE(BR X,BFIL,BCL AIM,2)
8595	"RTN","BPS BCKJ",95,0 )
8596	W:BTEST " *REV CLM= ",BCLAIM," STAT=",BR ES
8597	"RTN","BPS BCKJ",96,0 )
8598	I BRES=0! (BRES=4) D
8599	"RTN","BPS BCKJ",97,0 )
8600	. S (BCNT ,@REF@(BRE S))=$G(@RE F@(BRES))+ 1
8601	"RTN","BPS BCKJ",98,0 )
8602	. S @REF@ (BRES,BCNT )=BTRAN_U_ BCLAIM_U_B RX_U_BFIL_ U_BPHARM
8603	"RTN","BPS BCKJ",99,0 )
8604	Q 1
8605	"RTN","BPS BCKJ",100, 0)
8606	;
8607	"RTN","BPS BCKJ",101, 0)
8608	RELDATE(BR X,BFIL) ;G et the Rel eased Date
8609	"RTN","BPS BCKJ",102, 0)
8610	I BFIL Q $$RXSUBF1^ BPSUTIL1(B RX,52,52.1 ,+BFIL,17, "I")
8611	"RTN","BPS BCKJ",103, 0)
8612	Q $$RXAPI 1^BPSUTIL1 (BRX,31,"I ")
8613	"RTN","BPS BCKJ",104, 0)
8614	;
8615	"RTN","BPS BCKJ",105, 0)
8616	FILDATE(BR X,BFIL) ;G et the Fil l Date
8617	"RTN","BPS BCKJ",106, 0)
8618	I BFIL Q $$RXSUBF1^ BPSUTIL1(B RX,52,52.1 ,+BFIL,.01 ,"I")
8619	"RTN","BPS BCKJ",107, 0)
8620	Q $$RXAPI 1^BPSUTIL1 (BRX,22,"I ")
8621	"RTN","BPS BCKJ",108, 0)
8622	;
8623	"RTN","BPS BCKJ",109, 0)
8624	REVERSE(BR X,BFIL,BCL AIM,BTYPE) ;Auto-Rev erse the c laim
8625	"RTN","BPS BCKJ",110, 0)
8626	;PUBLIC B TEST
8627	"RTN","BPS BCKJ",111, 0)
8628	N BDOS,BR ES,BDAT,BM ES,BRSN,BP SCOB,BP59
8629	"RTN","BPS BCKJ",112, 0)
8630	I $G(BTES T) Q 0 ; Test mode
8631	"RTN","BPS BCKJ",113, 0)
8632	;
8633	"RTN","BPS BCKJ",114, 0)
8634	; Get Dat e of Servi ce and set reversal reason
8635	"RTN","BPS BCKJ",115, 0)
8636	S BDOS=$$ DOSDATE^BP SSCRRS(BRX ,BFIL)
8637	"RTN","BPS BCKJ",116, 0)
8638	S BRSN=$S (BTYPE=2:" CURRENT IN PATIENT",1 :"PRESCRIP TION NOT R ELEASED")
8639	"RTN","BPS BCKJ",117, 0)
8640	;
8641	"RTN","BPS BCKJ",118, 0)
8642	S BP59=$$ CLAIM59^BP SUTIL2(BCL AIM) ;get the BPS TR ANSACTION IEN for th e claim
8643	"RTN","BPS BCKJ",119, 0)
8644	S BPSCOB= $$COB59^BP SUTIL2(BP5 9) ;get CO B for the BPS TRANSA CTION IEN
8645	"RTN","BPS BCKJ",120, 0)
8646	;
8647	"RTN","BPS BCKJ",121, 0)
8648	; Call EC ME to proc ess revers al
8649	"RTN","BPS BCKJ",122, 0)
8650	S BRES=$$ EN^BPSNCPD P(BRX,BFIL ,BDOS,"ARE V","",BRSN ,"",,,,BPS COB)
8651	"RTN","BPS BCKJ",123, 0)
8652	;
8653	"RTN","BPS BCKJ",124, 0)
8654	; If succ essful, lo g message to the Pre scription Activity L og
8655	"RTN","BPS BCKJ",125, 0)
8656	; and se t the auto -reversal flag
8657	"RTN","BPS BCKJ",126, 0)
8658	S BRES=+B RES,BMES=" ECME: AUTO REVERSAL JOB-"_$S(B PSCOB=1:"p ",BPSCOB=2 :"s",1:"") _$$INSNAME ^BPSSCRU6( BP59)
8659	"RTN","BPS BCKJ",127, 0)
8660	I BRES=0 D
8661	"RTN","BPS BCKJ",128, 0)
8662	. D ECMEA CT^PSOBPSU 1(BRX,BFIL ,BMES,.5)
8663	"RTN","BPS BCKJ",129, 0)
8664	. S BDAT( 9002313.02 ,BCLAIM_", ",.07)=BTY PE D FILE^ DIE("","BD AT")
8665	"RTN","BPS BCKJ",130, 0)
8666	Q BRES
8667	"RTN","BPS BCKJ",131, 0)
8668	;
8669	"RTN","BPS BCKJ",132, 0)
8670	;
8671	"RTN","BPS BCKJ",133, 0)
8672	BULL(REF) ;Bulletin to the OPE CC
8673	"RTN","BPS BCKJ",134, 0)
8674	;PUBLIC B TEST,DUZ,D T
8675	"RTN","BPS BCKJ",135, 0)
8676	N XMSUB,X MY,XMTEXT, XMDUZ,BLNU M
8677	"RTN","BPS BCKJ",136, 0)
8678	;
8679	"RTN","BPS BCKJ",137, 0)
8680	I BCNT<1, '$G(BTEST) ,(+$G(@REF @(4)))=0 Q
8681	"RTN","BPS BCKJ",138, 0)
8682	S BLNUM=0 ,BCNT=+$G( @REF@(0))
8683	"RTN","BPS BCKJ",139, 0)
8684	S XMSUB=" ECME AUTO- REVERSAL P ROCESS"
8685	"RTN","BPS BCKJ",140, 0)
8686	I $G(BTES T) D T("** * P L E A S E D I S R E G A R D T H I S E M A I L ** *"),T(),T( "NOT ACTUA LLY REVERS ED - THIS IS A TEST" ),T()
8687	"RTN","BPS BCKJ",141, 0)
8688	D T("The ECME Night ly Process submitted auto-reve rsals for the follow ing e-Phar macy")
8689	"RTN","BPS BCKJ",142, 0)
8690	D T("pres criptions. ")
8691	"RTN","BPS BCKJ",143, 0)
8692	D T()
8693	"RTN","BPS BCKJ",144, 0)
8694	D T("TOTA L CLAIMS S UBMITTED F OR AUTO-RE VERSALS: " _BCNT)
8695	"RTN","BPS BCKJ",145, 0)
8696	D T()
8697	"RTN","BPS BCKJ",146, 0)
8698	D T("Clai ms Submitt ed for Aut o-Reversal s on "_$$D AT(DT)_":" ) D ARLIST (0,REF)
8699	"RTN","BPS BCKJ",147, 0)
8700	D T()
8701	"RTN","BPS BCKJ",148, 0)
8702	S BCNT=+$ G(@REF@(4) )
8703	"RTN","BPS BCKJ",149, 0)
8704	I BCNT'=0 D
8705	"RTN","BPS BCKJ",150, 0)
8706	. D T()
8707	"RTN","BPS BCKJ",151, 0)
8708	. D T("Th e ECME Nig htly Proce ss attempt ed to auto -reverse t he followi ng claims but")
8709	"RTN","BPS BCKJ",152, 0)
8710	. D T("co uld not be cause the previous r equest was IN PROGRE SS. Pleas e verify t hat")
8711	"RTN","BPS BCKJ",153, 0)
8712	. D T("th e previous request i s not stra nded.")
8713	"RTN","BPS BCKJ",154, 0)
8714	. D T()
8715	"RTN","BPS BCKJ",155, 0)
8716	. D T("To tal number of claims that coul d not be a uto-revers ed: "_BCNT )
8717	"RTN","BPS BCKJ",156, 0)
8718	. D T()
8719	"RTN","BPS BCKJ",157, 0)
8720	. D T("Cl aims not a uto-revers ed on "_$$ DAT(DT)_": ")
8721	"RTN","BPS BCKJ",158, 0)
8722	. D ARLIS T(4,REF)
8723	"RTN","BPS BCKJ",159, 0)
8724	. D T()
8725	"RTN","BPS BCKJ",160, 0)
8726	;
8727	"RTN","BPS BCKJ",161, 0)
8728	S XMDUZ=" BPS PACKAG E",XMTEXT= "BTX("
8729	"RTN","BPS BCKJ",162, 0)
8730	S XMY("G. BPS OPECC" )=""
8731	"RTN","BPS BCKJ",163, 0)
8732	I $G(DUZ) '<1 S XMY( DUZ)=""
8733	"RTN","BPS BCKJ",164, 0)
8734	D ^XMD
8735	"RTN","BPS BCKJ",165, 0)
8736	Q
8737	"RTN","BPS BCKJ",166, 0)
8738	;
8739	"RTN","BPS BCKJ",167, 0)
8740	T(BTXT) ; Add text t o the mess age
8741	"RTN","BPS BCKJ",168, 0)
8742	;PUBLIC B LNUM,BTEST
8743	"RTN","BPS BCKJ",169, 0)
8744	S BLNUM=B LNUM+1,BTX (BLNUM)=$G (BTXT," ")
8745	"RTN","BPS BCKJ",170, 0)
8746	I $G(BTES T) W !,$G( BTXT)
8747	"RTN","BPS BCKJ",171, 0)
8748	Q
8749	"RTN","BPS BCKJ",172, 0)
8750	;
8751	"RTN","BPS BCKJ",173, 0)
8752	ARLIST(BRE S,REF) ;Au to-Rev Lis t
8753	"RTN","BPS BCKJ",174, 0)
8754	N I,TXT,B CLAIM,BTRA N,Y,BRX,BF IL,BFDATE, BPHARM,BRX N,BPHARMN, BPAT,BPSTA T,BELIG,BD RUG
8755	"RTN","BPS BCKJ",175, 0)
8756	D T()
8757	"RTN","BPS BCKJ",176, 0)
8758	D T(" # RX/FILL STATUS DATE E LIG PATIEN T BP S PHARM D RUG NAME")
8759	"RTN","BPS BCKJ",177, 0)
8760	D T("---- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----")
8761	"RTN","BPS BCKJ",178, 0)
8762	S I=0 F S I=$O(@RE F@(BRES,I) ) Q:'I D
8763	"RTN","BPS BCKJ",179, 0)
8764	. S Y=@RE F@(BRES,I)
8765	"RTN","BPS BCKJ",180, 0)
8766	. S BTRAN =$P(Y,U)
8767	"RTN","BPS BCKJ",181, 0)
8768	. S BCLAI M=$P(Y,U,2 )
8769	"RTN","BPS BCKJ",182, 0)
8770	. S BRX=$ P(Y,U,3),B RXN=$$RXAP I1^BPSUTIL 1(BRX,.01, "I")
8771	"RTN","BPS BCKJ",183, 0)
8772	. S BPAT= $P($G(^DPT (+$$RXAPI1 ^BPSUTIL1( BRX,2,"I") ,0)),U)
8773	"RTN","BPS BCKJ",184, 0)
8774	. S BFIL= $P(Y,U,4)
8775	"RTN","BPS BCKJ",185, 0)
8776	. S BPHAR M=$P(Y,U,5 ),BPHARMN= $P($G(^BPS (9002313.5 6,BPHARM,0 )),U)
8777	"RTN","BPS BCKJ",186, 0)
8778	. S BELIG =$P(Y,U,6)
8779	"RTN","BPS BCKJ",187, 0)
8780	. S BDRUG =$P(Y,U,7)
8781	"RTN","BPS BCKJ",188, 0)
8782	. S BFDAT E=$$FILDAT E(BRX,BFIL )
8783	"RTN","BPS BCKJ",189, 0)
8784	. S BPSTA T=$$MWC^BP SRPT6(BRX, BFIL)_"/"_ $S($$RELDA TE(BRX,BFI L)]"":"RL" ,1:"NR")
8785	"RTN","BPS BCKJ",190, 0)
8786	. S TXT=$ J(I,3)_" " _$$J((BRXN _"/"_BFIL) ,13)_" "_$ J(BPSTAT,4 )_" "_$$J( $$DAT(BFDA TE),10)
8787	"RTN","BPS BCKJ",191, 0)
8788	. S TXT=T XT_$J(BELI G,1)_" "_ $$J($E(BPA T,1,18),18 )_" "_$J($ E(BPHARMN, 1,3),3)
8789	"RTN","BPS BCKJ",192, 0)
8790	. S TXT=T XT_" "_$$ J($E(BDRUG ,1,18),18)
8791	"RTN","BPS BCKJ",193, 0)
8792	. D T(TXT )
8793	"RTN","BPS BCKJ",194, 0)
8794	D T("---- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----")
8795	"RTN","BPS BCKJ",195, 0)
8796	Q
8797	"RTN","BPS BCKJ",196, 0)
8798	;
8799	"RTN","BPS BCKJ",197, 0)
8800	J(TXT,LEN) ;Left jus tify
8801	"RTN","BPS BCKJ",198, 0)
8802	Q TXT_$J( "",LEN-$L( TXT))
8803	"RTN","BPS BCKJ",199, 0)
8804	;
8805	"RTN","BPS BCKJ",200, 0)
8806	DAT(X,Y) ; Convert F M date to displayabl e (mm/dd/y y) format.
8807	"RTN","BPS BCKJ",201, 0)
8808	; -- opti onal outpu t of time, if $g(y)
8809	"RTN","BPS BCKJ",202, 0)
8810	N DATE,T
8811	"RTN","BPS BCKJ",203, 0)
8812	S DATE=$S (X:$E(X,4, 5)_"/"_$E( X,6,7)_"/" _$E(X,2,3) ,1:"")
8813	"RTN","BPS BCKJ",204, 0)
8814	I $G(Y) S T="."_$E( $P(X,".",2 )_"000000" ,1,7) I T> 0 S DATE=D ATE_" "_$S ($E(T,2,3) >12:$E(T,2 ,3)-12,$E( T,2,3)="00 ":"00",1:+ $E(T,2,3)) _":"_$E(T, 4,5)_$S($E (T,2,5)>12 00:" pm",1 :" am")
8815	"RTN","BPS BCKJ",205, 0)
8816	Q DATE
8817	"RTN","BPS NCPD3")
8818	0^13^B6750 6388
8819	"RTN","BPS NCPD3",1,0 )
8820	BPSNCPD3 ; BHAM ISC/L JE - Conti nuation of BPSNCPDP - DUR HAND LING ;06/1 6/2004
8821	"RTN","BPS NCPD3",2,0 )
8822	;;1.0;E C LAIMS MGMT ENGINE; 1,5,6,7,8, 10,11,15,1 9,20,22; JUN 2004;B uild 15
8823	"RTN","BPS NCPD3",3,0 )
8824	;;Per VA Directive 6402, this routine s hould not be modifie d.
8825	"RTN","BPS NCPD3",4,0 )
8826	;
8827	"RTN","BPS NCPD3",5,0 )
8828	; Due to space cons iderations , these co mments wer e moved fr om BPSNPCP D
8829	"RTN","BPS NCPD3",6,0 )
8830	; to th is routine .
8831	"RTN","BPS NCPD3",7,0 )
8832	;
8833	"RTN","BPS NCPD3",8,0 )
8834	; ------- ---------- - Beginnin g of BPSNC PDP commen ts ------- ---------- -
8835	"RTN","BPS NCPD3",9,0 )
8836	;Input
8837	"RTN","BPS NCPD3",10, 0)
8838	; BRXIEN = Prescrip tion IEN
8839	"RTN","BPS NCPD3",11, 0)
8840	; BFILL = Fill Num ber
8841	"RTN","BPS NCPD3",12, 0)
8842	; DOS = Date of Service
8843	"RTN","BPS NCPD3",13, 0)
8844	; BWHERE (RX Action )
8845	"RTN","BPS NCPD3",14, 0)
8846	; AREV = Auto-Re versal
8847	"RTN","BPS NCPD3",15, 0)
8848	; BB = Back Bi lling
8849	"RTN","BPS NCPD3",16, 0)
8850	; CRLB = CMOP/OP AI Release & Rebill
8851	"RTN","BPS NCPD3",17, 0)
8852	; CRLR = CMOP/OP AI Release & Reverse (successf ul release )
8853	"RTN","BPS NCPD3",18, 0)
8854	; CRLX = CMOP/OP AI unsucce ssful rele ase & reve rse
8855	"RTN","BPS NCPD3",19, 0)
8856	; CRRL = CMOP/OP AI Release - Origina l claim no t paid, su bmit anoth er claim, no reversa l
8857	"RTN","BPS NCPD3",20, 0)
8858	; DC = Discont inue - onl y reverse un-release d PAYABLE DC's, rele ase date c heck
8859	"RTN","BPS NCPD3",21, 0)
8860	; should be in call ing routin e.
8861	"RTN","BPS NCPD3",22, 0)
8862	; DE = Delete
8863	"RTN","BPS NCPD3",23, 0)
8864	; ED = Edit (i ncludes RX release w ith NDC ed it)
8865	"RTN","BPS NCPD3",24, 0)
8866	; ERES = Resubmi t from ECM E user scr een
8867	"RTN","BPS NCPD3",25, 0)
8868	; ERWV = Resubmi t Without Reversal f rom ECME u ser screen (BPS120 )
8869	"RTN","BPS NCPD3",26, 0)
8870	; ERNB = Resubmi t of a TRI /CVA non-b illable en try from t he ECME us er screen (BPS120)
8871	"RTN","BPS NCPD3",27, 0)
8872	; EREV = Reversa l from ECM E user scr een
8873	"RTN","BPS NCPD3",28, 0)
8874	; HLD = Put pre scription on Hold
8875	"RTN","BPS NCPD3",29, 0)
8876	; OREV = Reversa l from Out patient Ph armacy edi t screen ( BPS120)
8877	"RTN","BPS NCPD3",30, 0)
8878	; RSNB = Resubmi t Non-Bill able TRICA RE & CHAMP VA from PS O Reject I nfo Screen (BPS120 )
8879	"RTN","BPS NCPD3",31, 0)
8880	; OF = Origina l Fill
8881	"RTN","BPS NCPD3",32, 0)
8882	; P2 = Origina l submissi on from PR O Option, no reversa l
8883	"RTN","BPS NCPD3",33, 0)
8884	; P2S = Resubmi t from PRO Option
8885	"RTN","BPS NCPD3",34, 0)
8886	; PC = Pull CM OPs
8887	"RTN","BPS NCPD3",35, 0)
8888	; PE = Pull ea rly from s uspense
8889	"RTN","BPS NCPD3",36, 0)
8890	; PL = Pull lo cal from s uspense
8891	"RTN","BPS NCPD3",37, 0)
8892	; PP = Pull RX (PP) acti on from Pa tient Pres cription P rocessing option
8893	"RTN","BPS NCPD3",38, 0)
8894	; RF = Refill
8895	"RTN","BPS NCPD3",39, 0)
8896	; RN = Renew
8897	"RTN","BPS NCPD3",40, 0)
8898	; RRL = Release - Origina l claim no t paid, su bmit anoth er claim, no reversa l
8899	"RTN","BPS NCPD3",41, 0)
8900	; RS = Return- to-Stock
8901	"RTN","BPS NCPD3",42, 0)
8902	; BILLNDC = Valid N DC# with f ormat 5-4- 2
8903	"RTN","BPS NCPD3",43, 0)
8904	; REVREAS = Reversa l Reason
8905	"RTN","BPS NCPD3",44, 0)
8906	; DURREC = String of up to t hree sets of DUR inf o. Sets ar e delimite d with "~" . Each set consists of three " ^" pieces:
8907	"RTN","BPS NCPD3",45, 0)
8908	; Reaso n for Serv ice Code
8909	"RTN","BPS NCPD3",46, 0)
8910	; Profe ssional Se rvice Code
8911	"RTN","BPS NCPD3",47, 0)
8912	; Resul t of Servi ce Code
8913	"RTN","BPS NCPD3",48, 0)
8914	; BPOVRIE N = Pointe r to BPS N CPDP OVERI DE file. This param eter will
8915	"RTN","BPS NCPD3",49, 0)
8916	; only b e passed i f there ar e override s entered by the
8917	"RTN","BPS NCPD3",50, 0)
8918	; user v ia the Res ubmit with Edits (RE D) option in the
8919	"RTN","BPS NCPD3",51, 0)
8920	; user s creen.
8921	"RTN","BPS NCPD3",52, 0)
8922	; BPSAUTH = Prior authorizat ion code ( Prior auth code^Prio r auth num ber)
8923	"RTN","BPS NCPD3",53, 0)
8924	; BPSCLAR F = Submis sion Clari fication C ode (exter nal value from #9002 313.25), e ntered by
8925	"RTN","BPS NCPD3",54, 0)
8926	; pharma cist and p assed by O utpatient Pharmacy t o ECME to put into t he claim
8927	"RTN","BPS NCPD3",55, 0)
8928	; BPCOBIN D = (optio nal, defau lt is Prim ary) for C OB indicat ors - so w hen the AP I is calle d for the particular
8929	"RTN","BPS NCPD3",56, 0)
8930	; COB cl aim the BP SNCPDP can handle it .
8931	"RTN","BPS NCPD3",57, 0)
8932	; BPJOBFL G = (optio nal, defau lt is "F") B - if is called by unqueuein g logic in backgroun d, F - by other (for eground) p rocess,
8933	"RTN","BPS NCPD3",58, 0)
8934	; BPREQIE N = (optio nal) ien o f BPS REQU EST file r ecord, tha t needs to be unqueu ed
8935	"RTN","BPS NCPD3",59, 0)
8936	; BPSCLOS E = (optio nal) local array use d with BWH ERE="EREV" only, if the user h ad chosen to close t he claim a fter rever sal
8937	"RTN","BPS NCPD3",60, 0)
8938	; if cl aim needs to be clos ed then
8939	"RTN","BPS NCPD3",61, 0)
8940	; BPSCL OSE("CLOSE AFT REV") =1
8941	"RTN","BPS NCPD3",62, 0)
8942	; BPSCL OSE("CLOSE AFT REV R EASON")=<# 356.8 ien>
8943	"RTN","BPS NCPD3",63, 0)
8944	; BPSCL OSE("CLOSE AFT REV C OMMENT")=< some text>
8945	"RTN","BPS NCPD3",64, 0)
8946	; BPSPLAN = (optio nal) IEN o f the entr y in the G ROUP INSUR ANCE PLAN file (#355 .3)
8947	"RTN","BPS NCPD3",65, 0)
8948	; BPSPRDA T = (optio nal) local array pas sed by ref erence. Co ntains pri mary claim data need ed to subm it a secon dary claim .
8949	"RTN","BPS NCPD3",66, 0)
8950	; Format : BPSPRDA T(NCPDP fi eld)
8951	"RTN","BPS NCPD3",67, 0)
8952	; BPSRTYP E = (optio nal) rate type ( ien of the fi le #399.3)
8953	"RTN","BPS NCPD3",68, 0)
8954	; BPSDELA Y = Delay Reason Cod e (IEN of BPS NCPDP DELAY REAS ON CODE (# 9002313.29 ), entered by the us er
8955	"RTN","BPS NCPD3",69, 0)
8956	; in the Back Bill ing option of Claims Tracking and passed to ECME t o put into the claim .
8957	"RTN","BPS NCPD3",70, 0)
8958	;
8959	"RTN","BPS NCPD3",71, 0)
8960	;Output ( RESPONSE^M ESSAGE^ELI GIBILITY^C LAIMSTATUS ^COB^RXCOB ^INSURANCE )
8961	"RTN","BPS NCPD3",72, 0)
8962	; RESPONS E
8963	"RTN","BPS NCPD3",73, 0)
8964	; 0 S ubmitted t hrough ECM E
8965	"RTN","BPS NCPD3",74, 0)
8966	; 1 N o submissi on through ECME
8967	"RTN","BPS NCPD3",75, 0)
8968	; 2 I B not bill able
8969	"RTN","BPS NCPD3",76, 0)
8970	; 3 C laim was c losed, not submitted (RTS/Dele tes)
8971	"RTN","BPS NCPD3",77, 0)
8972	; 4 U nable to q ueue claim
8973	"RTN","BPS NCPD3",78, 0)
8974	; 5 I ncorrect i nformation supplied to ECME
8975	"RTN","BPS NCPD3",79, 0)
8976	; 6 I nactive EC ME - Prima rily used for TRICAR E/CHAMPVA to say ok to process rx
8977	"RTN","BPS NCPD3",80, 0)
8978	; 10 R eversal bu t no resub mit
8979	"RTN","BPS NCPD3",81, 0)
8980	; MESSAGE = Message associate d with the response (error/sub mitted)
8981	"RTN","BPS NCPD3",82, 0)
8982	; ELIGIBI LITY = V - Veteran, T - TRICAR E, C - CHA MPVA
8983	"RTN","BPS NCPD3",83, 0)
8984	; CLAIMST ATUS = cla im status (null or I N PROGRESS /E PAYABLE /etc...)
8985	"RTN","BPS NCPD3",84, 0)
8986	; COB = Coordinati on Of Bene fit indica tor of the insurance as it is stored in the PATIEN T file: 1- primary, 2 -secondary , 3-tertia ry
8987	"RTN","BPS NCPD3",85, 0)
8988	; RXCOB = the paye r sequence indicator of the cl aim which was sent t o the paye r as a res ult of thi s call: 1- primary, 2 -secondary )
8989	"RTN","BPS NCPD3",86, 0)
8990	; INSURAN CE = Name of the ins urance com pany that was billed as a resu lt of this call
8991	"RTN","BPS NCPD3",87, 0)
8992	;
8993	"RTN","BPS NCPD3",88, 0)
8994	; ------- ---------- End of BP SNCPDP com ments ---- ---------- --------
8995	"RTN","BPS NCPD3",89, 0)
8996	;
8997	"RTN","BPS NCPD3",90, 0)
8998	; ------- ---------- DUR1 ---- ---------- ---------- ---------- --------
8999	"RTN","BPS NCPD3",91, 0)
9000	; DUR1 is called by PSO to ge t the reje ct informa tion
9001	"RTN","BPS NCPD3",92, 0)
9002	;
9003	"RTN","BPS NCPD3",93, 0)
9004	;
9005	"RTN","BPS NCPD3",94, 0)
9006	; IA 4560 supports OP's use o f this pro cedure
9007	"RTN","BPS NCPD3",95, 0)
9008	;
9009	"RTN","BPS NCPD3",96, 0)
9010	; Functio n call for DUR INFOR MATION
9011	"RTN","BPS NCPD3",97, 0)
9012	; Paramet ers: BRXIE N = Prescr iption IEN
9013	"RTN","BPS NCPD3",98, 0)
9014	; BFILL = fill nu mber
9015	"RTN","BPS NCPD3",99, 0)
9016	; DUR = DUR info passed bac k
9017	"RTN","BPS NCPD3",100 ,0)
9018	; ERROR = error p assed back
9019	"RTN","BPS NCPD3",101 ,0)
9020	; BPRXC OB = payer sequence
9021	"RTN","BPS NCPD3",102 ,0)
9022	; Note:
9023	"RTN","BPS NCPD3",103 ,0)
9024	; DUR( "BILLED")= 0 if ecme off for ph armacy or no transac tion in EC ME
9025	"RTN","BPS NCPD3",104 ,0)
9026	; DUR( <Insurance counter>, "BILLED")= 1 if bille d through ecme
9027	"RTN","BPS NCPD3",105 ,0)
9028	DUR1(BRXIE N,BFILL,DU R,ERROR,BP RXCOB) ;
9029	"RTN","BPS NCPD3",106 ,0)
9030	N SITE,IE N59,DUR1,D URIEN
9031	"RTN","BPS NCPD3",107 ,0)
9032	I '$G(BRX IEN) S DUR ("BILLED") =0 Q
9033	"RTN","BPS NCPD3",108 ,0)
9034	I $G(BFIL L)="" S DU R("BILLED" )=0 Q
9035	"RTN","BPS NCPD3",109 ,0)
9036	S BPRXCOB =+$G(BPRXC OB)
9037	"RTN","BPS NCPD3",110 ,0)
9038	I BPRXCOB =0 S BPRXC OB=1 ;defa ult is Pri mary
9039	"RTN","BPS NCPD3",111 ,0)
9040	;
9041	"RTN","BPS NCPD3",112 ,0)
9042	; Get Sit e info and check is ECME is tu rned on
9043	"RTN","BPS NCPD3",113 ,0)
9044	; If not, set DUR(" BILLED")=0 and quit
9045	"RTN","BPS NCPD3",114 ,0)
9046	I '$G(BFI LL) S SITE =$$RXAPI1^ BPSUTIL1(B RXIEN,20," I")
9047	"RTN","BPS NCPD3",115 ,0)
9048	I $G(BFIL L) S SITE= $$RXSUBF1^ BPSUTIL1(B RXIEN,52,5 2.1,BFILL, 8,"I")
9049	"RTN","BPS NCPD3",116 ,0)
9050	I '$$ECME ON^BPSUTIL (SITE) S D UR("BILLED ")=0 Q
9051	"RTN","BPS NCPD3",117 ,0)
9052	;
9053	"RTN","BPS NCPD3",118 ,0)
9054	; Set up the Transa ction IEN
9055	"RTN","BPS NCPD3",119 ,0)
9056	S IEN59=$ $IEN59^BPS OSRX(BRXIE N,BFILL,BP RXCOB)
9057	"RTN","BPS NCPD3",120 ,0)
9058	I IEN59=" " S DUR("B ILLED")=0 Q
9059	"RTN","BPS NCPD3",121 ,0)
9060	;
9061	"RTN","BPS NCPD3",122 ,0)
9062	; If the transactio n record d oes not ex ist, set D UR("BILLED ")=0 and q uit
9063	"RTN","BPS NCPD3",123 ,0)
9064	I '$D(^BP ST(IEN59)) S DUR("BI LLED")=0 Q
9065	"RTN","BPS NCPD3",124 ,0)
9066	;
9067	"RTN","BPS NCPD3",125 ,0)
9068	S DUR(BPR XCOB,"BILL ED")=1
9069	"RTN","BPS NCPD3",126 ,0)
9070	;
9071	"RTN","BPS NCPD3",127 ,0)
9072	S DUR(BPR XCOB,"ELIG BLT")=$P($ G(^BPST(IE N59,9)),U, 4)
9073	"RTN","BPS NCPD3",128 ,0)
9074	; Get Ins urance Inf o and set into DUR a rray
9075	"RTN","BPS NCPD3",129 ,0)
9076	S DUR(BPR XCOB,"INSU RANCE POIN TER")=$$GE T1^DIQ(900 2313.59902 ,"1,"_IEN5 9_",",902. 33,"I") ; Insurance Company IE N
9077	"RTN","BPS NCPD3",130 ,0)
9078	D GETS^DI Q(9002313. 59902,"1," _IEN59_"," ,"902.05;9 02.06;902. 24;902.25; 902.26","E ","DUR1"," ERROR")
9079	"RTN","BPS NCPD3",131 ,0)
9080	S DUR(BPR XCOB,"INSU RANCE NAME ")=$G(DUR1 (9002313.5 9902,"1,"_ IEN59_",", 902.24,"E" )) ; Insu rance Comp any Name
9081	"RTN","BPS NCPD3",132 ,0)
9082	S DUR(BPR XCOB,"GROU P NUMBER") =$G(DUR1(9 002313.599 02,"1,"_IE N59_",",90 2.05,"E")) ; Insu rance Grou p Number
9083	"RTN","BPS NCPD3",133 ,0)
9084	S DUR(BPR XCOB,"GROU P NAME")=$ G(DUR1(900 2313.59902 ,"1,"_IEN5 9_",",902. 25,"E")) ; Insu rance Grou p Name
9085	"RTN","BPS NCPD3",134 ,0)
9086	S DUR(BPR XCOB,"PLAN CONTACT") =$G(DUR1(9 002313.599 02,"1,"_IE N59_",",90 2.26,"E")) ; Insu rance Cont act Number
9087	"RTN","BPS NCPD3",135 ,0)
9088	S DUR(BPR XCOB,"CARD HOLDER ID" )=$G(DUR1( 9002313.59 902,"1,"_I EN59_",",9 02.06,"E") ) ; Card holder ID
9089	"RTN","BPS NCPD3",136 ,0)
9090	;
9091	"RTN","BPS NCPD3",137 ,0)
9092	; Get Res ponse IEN and Data
9093	"RTN","BPS NCPD3",138 ,0)
9094	S DURIEN= "",DURIEN= $P(^BPST(I EN59,0),"^ ",5)
9095	"RTN","BPS NCPD3",139 ,0)
9096	D DURRESP (DURIEN,.D UR,BPRXCOB ) ; Note: In the fut ure, we ma y need to get/store DURIEN for each COB
9097	"RTN","BPS NCPD3",140 ,0)
9098	Q
9099	"RTN","BPS NCPD3",141 ,0)
9100	;
9101	"RTN","BPS NCPD3",142 ,0)
9102	DURRESP(DU RIEN,DUR,B PRXCOB) ;
9103	"RTN","BPS NCPD3",143 ,0)
9104	;Input Va riables:
9105	"RTN","BPS NCPD3",144 ,0)
9106	; DURIEN - Claim Re sponse IEN . Pointer to the BPS RESPONSES File #900 2313.03
9107	"RTN","BPS NCPD3",145 ,0)
9108	; BPRXCOB - (Option al) The Pa yer Sequen ce:
9109	"RTN","BPS NCPD3",146 ,0)
9110	; 1 - P rimary (de fault)
9111	"RTN","BPS NCPD3",147 ,0)
9112	; 2 - S econdary
9113	"RTN","BPS NCPD3",148 ,0)
9114	;
9115	"RTN","BPS NCPD3",149 ,0)
9116	;Output V ariables:
9117	"RTN","BPS NCPD3",150 ,0)
9118	; DUR - A rray of DU R related informatio n for a sp ecific cla im respons e in the
9119	"RTN","BPS NCPD3",151 ,0)
9120	; BPS R ESPONSES f ile in the following format (I NSN is the Payer Seq uence):
9121	"RTN","BPS NCPD3",152 ,0)
9122	;
9123	"RTN","BPS NCPD3",153 ,0)
9124	; DUR(INS N,"RESPONS E IEN") - Pointer to the RESPO NSE file ( #9002313.0 3) for
9125	"RTN","BPS NCPD3",154 ,0)
9126	; the c laim submi ssion
9127	"RTN","BPS NCPD3",155 ,0)
9128	; DUR(INS N,"PCN") - Processor Control N umber
9129	"RTN","BPS NCPD3",156 ,0)
9130	; DUR(INS N,"MESSAGE ") - The T ransmissio n level sp ecific dat a, Message field 504
9131	"RTN","BPS NCPD3",157 ,0)
9132	; DUR(INS N,"PAYER M ESSAGE") - Message r eturned fr om the pay er in the Transactio n
9133	"RTN","BPS NCPD3",158 ,0)
9134	; level
9135	"RTN","BPS NCPD3",159 ,0)
9136	; DUR(INS N,"STATUS" ) - Status of the cl aim (i.e. REJECTED C LAIM, PAYA BLE)
9137	"RTN","BPS NCPD3",160 ,0)
9138	;
9139	"RTN","BPS NCPD3",161 ,0)
9140	; The fol lowing fou r fields a re redunda nt with th e fields i n the DUR PPS
9141	"RTN","BPS NCPD3",162 ,0)
9142	; array b ut are pro vided for backwards compatibil ity.
9143	"RTN","BPS NCPD3",163 ,0)
9144	; DUR(INS N,"REASON" ) - Reason for Servi ce Code po inter to B PS NCPDP R EASON FOR
9145	"RTN","BPS NCPD3",164 ,0)
9146	; SERVI CE CODE fi le (#90023 13.23)
9147	"RTN","BPS NCPD3",165 ,0)
9148	; DUR(INS N,"PREV FI LL DATE") - Plan's P revious Fi ll Date
9149	"RTN","BPS NCPD3",166 ,0)
9150	; DUR(INS N,"DUR FRE E TEXT DES C") - Drug Utilizati on Review (DUR) desc ription
9151	"RTN","BPS NCPD3",167 ,0)
9152	; and/o r claims r ejection f ree text i nformation from the payer
9153	"RTN","BPS NCPD3",168 ,0)
9154	; DUR(INS N,"DUR ADD MSG TEXT" ) - Drug U tilization Review (D UR) additi onal free
9155	"RTN","BPS NCPD3",169 ,0)
9156	; text informatio n from the payer
9157	"RTN","BPS NCPD3",170 ,0)
9158	;
9159	"RTN","BPS NCPD3",171 ,0)
9160	; The fol lowing fie lds are fr om the DUR PPS RESPO NSE multip le.
9161	"RTN","BPS NCPD3",172 ,0)
9162	; DUR(INS N,"DUR PPS ",SEQ,"DUR PPS RESPO NSE") - To tal number of DUR PP S
9163	"RTN","BPS NCPD3",173 ,0)
9164	; respo nses from the payer
9165	"RTN","BPS NCPD3",174 ,0)
9166	; DUR(INS N,"DUR PPS ",SEQ,"REA SON FOR SE RVICE CODE ") - Code identifyin g the
9167	"RTN","BPS NCPD3",175 ,0)
9168	; type of utiliza tion confl ict detect ed or the reason for the pharm acist
9169	"RTN","BPS NCPD3",176 ,0)
9170	; profe ssional se rvice
9171	"RTN","BPS NCPD3",177 ,0)
9172	; DUR(INS N,"DUR PPS ",SEQ,"CLI NICAL SIGN IFICANCE C ODE") - Co de identif ying
9173	"RTN","BPS NCPD3",178 ,0)
9174	; the s ignificanc e or sever ity level of a clini cal event as contain ed
9175	"RTN","BPS NCPD3",179 ,0)
9176	; in th e originat ing data b ase
9177	"RTN","BPS NCPD3",180 ,0)
9178	; DUR(INS N,"DUR PPS ",SEQ,"OTH ER PHARMAC Y INDICATO R") - Code for the t ype of
9179	"RTN","BPS NCPD3",181 ,0)
9180	; pharm acy dispen sing the c onflicting drug
9181	"RTN","BPS NCPD3",182 ,0)
9182	; DUR(INS N,"DUR PPS ",SEQ,"PRE VIOUS DATE OF FILL") - Date pr escription was
9183	"RTN","BPS NCPD3",183 ,0)
9184	; previ ously fill ed
9185	"RTN","BPS NCPD3",184 ,0)
9186	; DUR(INS N,"DUR PPS ",SEQ,"QUA NTITY OF P REVIOUS FI LL") - Amo unt expres sed in
9187	"RTN","BPS NCPD3",185 ,0)
9188	; metri c decimal units of t he conflic ting agent that was previously filled
9189	"RTN","BPS NCPD3",186 ,0)
9190	; DUR(INS N,"DUR PPS ",SEQ,"DAT ABASE INDI CATOR") - Code ident ifying the source
9191	"RTN","BPS NCPD3",187 ,0)
9192	; of dr ug informa tion used for DUR pr ocessing
9193	"RTN","BPS NCPD3",188 ,0)
9194	; DUR(INS N,"DUR PPS ",SEQ,"OTH ER PRESCRI BER INDICA TOR") - Co de compari ng the
9195	"RTN","BPS NCPD3",189 ,0)
9196	; presc riber of t he current prescript ion to the prescribe r of the p reviously
9197	"RTN","BPS NCPD3",190 ,0)
9198	; fille d conflict ing prescr iption
9199	"RTN","BPS NCPD3",191 ,0)
9200	; DUR(INS N,"DUR PPS ",SEQ,"DUR FREE TEXT MESSAGE") - Text th at provide s
9201	"RTN","BPS NCPD3",192 ,0)
9202	; addit ional deta il regardi ng a DUR c onflict
9203	"RTN","BPS NCPD3",193 ,0)
9204	; DUR(INS N,"DUR PPS ",SEQ,"DUR ADDITIONA L TEXT") - Descripti ve informa tion that
9205	"RTN","BPS NCPD3",194 ,0)
9206	; furth er defines the refer enced DUR alert
9207	"RTN","BPS NCPD3",195 ,0)
9208	; DUR(INS N,"REJ COD E LST") - List of re jection co de(s) retu rned by th e payer
9209	"RTN","BPS NCPD3",196 ,0)
9210	; separ ated by co mmas (i.e. 79,14)
9211	"RTN","BPS NCPD3",197 ,0)
9212	; DUR(INS N,"REJ COD ES",SEQ,RE J CODE) - Array of r ejection c ode descri ptions
9213	"RTN","BPS NCPD3",198 ,0)
9214	; where REJ CODE correlates to DUR(IN SN,"REJ CO DE LST") v alue(s) an d SEQ
9215	"RTN","BPS NCPD3",199 ,0)
9216	; equal s a sequen tial numbe r
9217	"RTN","BPS NCPD3",200 ,0)
9218	;
9219	"RTN","BPS NCPD3",201 ,0)
9220	I '$G(DUR IEN) Q
9221	"RTN","BPS NCPD3",202 ,0)
9222	S BPRXCOB =+$G(BPRXC OB)
9223	"RTN","BPS NCPD3",203 ,0)
9224	I BPRXCOB =0 S BPRXC OB=1 ;defa ult is Pri mary
9225	"RTN","BPS NCPD3",204 ,0)
9226	N ADDMESS ,I,DUR1,CL MIEN
9227	"RTN","BPS NCPD3",205 ,0)
9228	S DUR(BPR XCOB,"RESP ONSE IEN") =DURIEN
9229	"RTN","BPS NCPD3",206 ,0)
9230	;
9231	"RTN","BPS NCPD3",207 ,0)
9232	;Get BIN from claim
9233	"RTN","BPS NCPD3",208 ,0)
9234	S CLMIEN= $$GET1^DIQ (9002313.0 3,DURIEN,. 01,"I")
9235	"RTN","BPS NCPD3",209 ,0)
9236	S DUR(BPR XCOB,"BIN" )=$$GET1^D IQ(9002313 .02,CLMIEN _",",101) ; BIN Numb er
9237	"RTN","BPS NCPD3",210 ,0)
9238	;
9239	"RTN","BPS NCPD3",211 ,0)
9240	;Get PCN from claim
9241	"RTN","BPS NCPD3",212 ,0)
9242	S DUR(BPR XCOB,"PCN" )=$$GET1^D IQ(9002313 .02,CLMIEN _",",104) ; PCN Numb er
9243	"RTN","BPS NCPD3",213 ,0)
9244	;
9245	"RTN","BPS NCPD3",214 ,0)
9246	; Get the Transmiss ion specif ic data (M essage)
9247	"RTN","BPS NCPD3",215 ,0)
9248	S DUR(BPR XCOB,"MESS AGE")=$$GE T1^DIQ(900 2313.03,DU RIEN_",",5 04,"E")
9249	"RTN","BPS NCPD3",216 ,0)
9250	;
9251	"RTN","BPS NCPD3",217 ,0)
9252	; Get the Additiona l Message Informatio n from the transacti on
9253	"RTN","BPS NCPD3",218 ,0)
9254	D ADDMESS ^BPSSCRLG( DURIEN,1,. ADDMESS)
9255	"RTN","BPS NCPD3",219 ,0)
9256	M DUR(BPR XCOB,"PAYE R MESSAGE" )=ADDMESS
9257	"RTN","BPS NCPD3",220 ,0)
9258	;
9259	"RTN","BPS NCPD3",221 ,0)
9260	; Get the other tra nsaction l evel data
9261	"RTN","BPS NCPD3",222 ,0)
9262	D GETS^DI Q(9002313. 0301,"1,"_ DURIEN_"," ,"501;567. 01*","E"," DUR1","ERR OR")
9263	"RTN","BPS NCPD3",223 ,0)
9264	S DUR(BPR XCOB,"STAT US")=$G(DU R1(9002313 .0301,"1," _DURIEN_", ",501,"E") ) ; Status of Response
9265	"RTN","BPS NCPD3",224 ,0)
9266	;
9267	"RTN","BPS NCPD3",225 ,0)
9268	; The fol lowing fou r fields a re redunda nt with th e fields i n the DUR PPS
9269	"RTN","BPS NCPD3",226 ,0)
9270	; multi ple but ar e needed f or backwar ds compati bility wit h the OP c ode
9271	"RTN","BPS NCPD3",227 ,0)
9272	S DUR(BPR XCOB,"REAS ON")=$G(DU R1(9002313 .1101,"1,1 ,"_DURIEN_ ",",439,"E ")) ; Reason for Service C ode
9273	"RTN","BPS NCPD3",228 ,0)
9274	S DUR(BPR XCOB,"PREV FILL DATE ")=$G(DUR1 (9002313.1 101,"1,1," _DURIEN_", ",530,"E") ) ; Previous D ate of Fil l
9275	"RTN","BPS NCPD3",229 ,0)
9276	S DUR(BPR XCOB,"DUR FREE TEXT DESC")=$G( DUR1(90023 13.1101,"1 ,1,"_DURIE N_",",544, "E")) ; DUR Free T ext Messag e from Pay er
9277	"RTN","BPS NCPD3",230 ,0)
9278	S DUR(BPR XCOB,"DUR ADD MSG TE XT")=$G(DU R1(9002313 .1101,"1,1 ,"_DURIEN_ ",",570,"E ")) ; DUR Additi onal Messa ge Text fr om Payer
9279	"RTN","BPS NCPD3",231 ,0)
9280	;
9281	"RTN","BPS NCPD3",232 ,0)
9282	; Get DUR PPS RESPO NSE multip le values
9283	"RTN","BPS NCPD3",233 ,0)
9284	S DUR(BPR XCOB,"DUR PPS RESPON SE")=""
9285	"RTN","BPS NCPD3",234 ,0)
9286	F I=1:1 Q :'$D(DUR1( 9002313.11 01,I_",1," _DURIEN_", ",.01)) D
9287	"RTN","BPS NCPD3",235 ,0)
9288	. S DUR(B PRXCOB,"DU R PPS RESP ONSE")=I
9289	"RTN","BPS NCPD3",236 ,0)
9290	. S DUR(B PRXCOB,"DU R PPS",I," DUR PPS RE SPONSE")=$ G(DUR1(900 2313.1101, I_",1,"_DU RIEN_",",. 01,"E"))
9291	"RTN","BPS NCPD3",237 ,0)
9292	. S DUR(B PRXCOB,"DU R PPS",I," REASON FOR SERVICE C ODE")=$G(D UR1(900231 3.1101,I_" ,1,"_DURIE N_",",439, "E"))
9293	"RTN","BPS NCPD3",238 ,0)
9294	. S DUR(B PRXCOB,"DU R PPS",I," CLINICAL S IGNIFICANC E CODE")=$ G(DUR1(900 2313.1101, I_",1,"_DU RIEN_",",5 28,"E"))
9295	"RTN","BPS NCPD3",239 ,0)
9296	. S DUR(B PRXCOB,"DU R PPS",I," OTHER PHAR MACY INDIC ATOR")=$G( DUR1(90023 13.1101,I_ ",1,"_DURI EN_",",529 ,"E"))
9297	"RTN","BPS NCPD3",240 ,0)
9298	. S DUR(B PRXCOB,"DU R PPS",I," PREVIOUS D ATE OF FIL L")=$G(DUR 1(9002313. 1101,I_",1 ,"_DURIEN_ ",",530,"E "))
9299	"RTN","BPS NCPD3",241 ,0)
9300	. S DUR(B PRXCOB,"DU R PPS",I," QUANTITY O F PREVIOUS FILL")=$G (DUR1(9002 313.1101,I _",1,"_DUR IEN_",",53 1,"E"))
9301	"RTN","BPS NCPD3",242 ,0)
9302	. S DUR(B PRXCOB,"DU R PPS",I," DATABASE I NDICATOR") =$G(DUR1(9 002313.110 1,I_",1,"_ DURIEN_"," ,532,"E"))
9303	"RTN","BPS NCPD3",243 ,0)
9304	. S DUR(B PRXCOB,"DU R PPS",I," OTHER PRES CRIBER IND ICATOR")=$ G(DUR1(900 2313.1101, I_",1,"_DU RIEN_",",5 33,"E"))
9305	"RTN","BPS NCPD3",244 ,0)
9306	. S DUR(B PRXCOB,"DU R PPS",I," DUR FREE T EXT MESSAG E")=$G(DUR 1(9002313. 1101,I_",1 ,"_DURIEN_ ",",544,"E "))
9307	"RTN","BPS NCPD3",245 ,0)
9308	. S DUR(B PRXCOB,"DU R PPS",I," DUR ADDITI ONAL TEXT" )=$G(DUR1( 9002313.11 01,I_",1," _DURIEN_", ",570,"E") )
9309	"RTN","BPS NCPD3",246 ,0)
9310	;
9311	"RTN","BPS NCPD3",247 ,0)
9312	; Get DUR reject co des and de scription and store in DUR
9313	"RTN","BPS NCPD3",248 ,0)
9314	D GETS^DI Q(9002313. 0301,"1,"_ DURIEN_"," ,"511*","I ","DUR1"," ERROR") ;g et DUR cod es and des criptions
9315	"RTN","BPS NCPD3",249 ,0)
9316	S DUR(BPR XCOB,"REJ CODE LST") =""
9317	"RTN","BPS NCPD3",250 ,0)
9318	F I=1:1 Q :'$D(DUR1( 9002313.03 511,I_",1, "_DURIEN_" ,")) D
9319	"RTN","BPS NCPD3",251 ,0)
9320	. N REJX, REJN
9321	"RTN","BPS NCPD3",252 ,0)
9322	. S REJX= $G(DUR1(90 02313.0351 1,I_",1,"_ DURIEN_"," ,.01,"I")) Q:REJX="" ; ext ernal reje ct code
9323	"RTN","BPS NCPD3",253 ,0)
9324	. S REJN= +$O(^BPSF( 9002313.93 ,"B",REJX, 0)) Q:'REJ N ; int ernal reje ct code ie n
9325	"RTN","BPS NCPD3",254 ,0)
9326	. S DUR(B PRXCOB,"RE J CODES",I ,REJX)=$P( $G(^BPSF(9 002313.93, REJN,0)),U ,2) ; rej ect code d escription
9327	"RTN","BPS NCPD3",255 ,0)
9328	. S DUR(B PRXCOB,"RE J CODE LST ")=DUR(BPR XCOB,"REJ CODE LST") _","_REJX
9329	"RTN","BPS NCPD3",256 ,0)
9330	S DUR(BPR XCOB,"REJ CODE LST") =$E(DUR(BP RXCOB,"REJ CODE LST" ),2,9999)
9331	"RTN","BPS NCPD3",257 ,0)
9332	Q
9333	"RTN","BPS NCPDP")
9334	0^6^B10381 8340
9335	"RTN","BPS NCPDP",1,0 )
9336	BPSNCPDP ; BHAM ISC/L JE/SS - AP I to submi t a claim to ECME ;1 1/7/07 16 :58
9337	"RTN","BPS NCPDP",2,0 )
9338	;;1.0;E C LAIMS MGMT ENGINE; 1,3,4,2,5, 6,7,8,10,1 1,19,20,22 ;JUN 200 4;Build 15
9339	"RTN","BPS NCPDP",3,0 )
9340	;;Per VA Directive 6402, this routine s hould not be modifie d.
9341	"RTN","BPS NCPDP",4,0 )
9342	;
9343	"RTN","BPS NCPDP",5,0 )
9344	; Referen ce to $$PR OD^XUPROD supported by DBIA 44 40
9345	"RTN","BPS NCPDP",6,0 )
9346	; Referen ce to $$GE TNDC^PSOND CUT suppor ted by DBI A 4705
9347	"RTN","BPS NCPDP",7,0 )
9348	; Referen ce to Pati ent file ( #2) suppor ted by DBI A 10035
9349	"RTN","BPS NCPDP",8,0 )
9350	;
9351	"RTN","BPS NCPDP",9,0 )
9352	; For com ments rega rding this API, see routine BP SNCPD3.
9353	"RTN","BPS NCPDP",10, 0)
9354	;
9355	"RTN","BPS NCPDP",11, 0)
9356	EN(BRXIEN, BFILL,DOS, BWHERE,BIL LNDC,REVRE AS,DURREC, BPOVRIEN,B PSCLARF,BP SAUTH,BPCO BIND,BPJOB FLG,BPREQI EN,BPSCLOS E,BPSPLAN, BPSPRDAT,B PSRTYPE,BP SDELAY) ;
9357	"RTN","BPS NCPDP",12, 0)
9358	N BPRETV, CLMSTAT,BR X,RESPONSE ,BPSCOB,IE N59,DFN,PN AME,WFLG,B PLCK,BPACT TYP,BPRET, BPSQUIT,SI TE
9359	"RTN","BPS NCPDP",13, 0)
9360	N BPNEWCL M,OLDRESP, BPPAYABL,B PSTART,BPR ESLT,BPSEL IG,BP77NEW ,TODAY,BPP REVRQ,BPSS TAT
9361	"RTN","BPS NCPDP",14, 0)
9362	; test no t ecme act ive
9363	"RTN","BPS NCPDP",15, 0)
9364	I '$$PROD ^XUPROD,'$ P($G(^BPS( 9002313.99 ,1,0)),"^" ,3) Q "1^E CME switch is not on for the s ite"
9365	"RTN","BPS NCPDP",16, 0)
9366	;== Set d efault val ues and ot her requir ed vars
9367	"RTN","BPS NCPDP",17, 0)
9368	; default is foregr ound ("F")
9369	"RTN","BPS NCPDP",18, 0)
9370	S BPJOBFL G=$S($G(BP JOBFLG)="" :"F",1:$G( BPJOBFLG))
9371	"RTN","BPS NCPDP",19, 0)
9372	S RESPONS E="",CLMST AT="",BP77 NEW=0
9373	"RTN","BPS NCPDP",20, 0)
9374	S BPLCK=0 ;0 - defa ult for "B " jobs
9375	"RTN","BPS NCPDP",21, 0)
9376	S REVREAS =$G(REVREA S),DURREC= $G(DURREC) ,BPSCLARF= $G(BPSCLAR F),BPSAUTH =$G(BPSAUT H),BPOVRIE N=$G(BPOVR IEN),BPSDE LAY=$G(BPS DELAY)
9377	"RTN","BPS NCPDP",22, 0)
9378	; BPCOBIN D will be used as a flag to in dicate the following
9379	"RTN","BPS NCPDP",23, 0)
9380	; If B PCOBIND>0 then the A PI is call ed for the particula r COB clai m
9381	"RTN","BPS NCPDP",24, 0)
9382	; if B PCOBIND=0 then the A PI is call ed for a w hole RX/RF - Outpati ent Pharma cy doesn't care abou t COB
9383	"RTN","BPS NCPDP",25, 0)
9384	; when the pharmacy u ser enters , deletes or edits R X/refills
9385	"RTN","BPS NCPDP",26, 0)
9386	S BPCOBIN D=+$G(BPCO BIND)
9387	"RTN","BPS NCPDP",27, 0)
9388	;
9389	"RTN","BPS NCPDP",28, 0)
9390	; BPSCOB variable w ill be use d to store COB value (default is PRIMARY ) in this function o nly
9391	"RTN","BPS NCPDP",29, 0)
9392	S BPSCOB= $S(BPCOBIN D>0:BPCOBI ND,1:1)
9393	"RTN","BPS NCPDP",30, 0)
9394	;
9395	"RTN","BPS NCPDP",31, 0)
9396	; Remove semi-colon s from rev ersal reas on BPS12 0
9397	"RTN","BPS NCPDP",32, 0)
9398	S REVREAS =$TR(REVRE AS,";","-" )
9399	"RTN","BPS NCPDP",33, 0)
9400	;
9401	"RTN","BPS NCPDP",34, 0)
9402	; Default is origin al fill
9403	"RTN","BPS NCPDP",35, 0)
9404	S BRXIEN= $G(BRXIEN)
9405	"RTN","BPS NCPDP",36, 0)
9406	I '$G(BFI LL) S BFIL L=0
9407	"RTN","BPS NCPDP",37, 0)
9408	;
9409	"RTN","BPS NCPDP",38, 0)
9410	; Get pre scription number
9411	"RTN","BPS NCPDP",39, 0)
9412	S BRX=$$R XAPI1^BPSU TIL1(BRXIE N,.01,"I")
9413	"RTN","BPS NCPDP",40, 0)
9414	;
9415	"RTN","BPS NCPDP",41, 0)
9416	; Make su re fill da te is not in the fut ure or emp ty
9417	"RTN","BPS NCPDP",42, 0)
9418	S TODAY=$ $DT^XLFDT
9419	"RTN","BPS NCPDP",43, 0)
9420	I '$G(DOS )!($G(DOS) >TODAY) S DOS=$$DOSD ATE^BPSSCR RS(BRXIEN, BFILL)
9421	"RTN","BPS NCPDP",44, 0)
9422	;
9423	"RTN","BPS NCPDP",45, 0)
9424	; Get the NDC if it was not p assed in
9425	"RTN","BPS NCPDP",46, 0)
9426	I $G(BILL NDC)="" S BILLNDC=$$ GETNDC^PSO NDCUT(BRXI EN,BFILL)
9427	"RTN","BPS NCPDP",47, 0)
9428	;
9429	"RTN","BPS NCPDP",48, 0)
9430	; Patient Info
9431	"RTN","BPS NCPDP",49, 0)
9432	S DFN=$$R XAPI1^BPSU TIL1(BRXIE N,2,"I"),P NAME=$$GET 1^DIQ(2,DF N,.01)
9433	"RTN","BPS NCPDP",50, 0)
9434	;
9435	"RTN","BPS NCPDP",51, 0)
9436	; Check p arameters and vars
9437	"RTN","BPS NCPDP",52, 0)
9438	S BPRETV= $$CHCKPAR^ BPSOSRX8(B RXIEN,BRX, $G(BWHERE) ,DFN,PNAME ) I +BPRET V=0 S CLMS TAT=$P(BPR ETV,U,2),R ESPONSE=5 G END
9439	"RTN","BPS NCPDP",53, 0)
9440	;
9441	"RTN","BPS NCPDP",54, 0)
9442	; Calcula te IEN59
9443	"RTN","BPS NCPDP",55, 0)
9444	S IEN59=$ $IEN59^BPS OSRX(BRXIE N,BFILL,BP SCOB) I IE N59="" S C LMSTAT="BP S Transact ion IEN co uld not be calculate d",RESPONS E=1 G END
9445	"RTN","BPS NCPDP",56, 0)
9446	;
9447	"RTN","BPS NCPDP",57, 0)
9448	;populate COB field s from BPS TRANSACTI ON to resu bmit secon dary claim s from the User Scre en
9449	"RTN","BPS NCPDP",58, 0)
9450	;if $G(BP SPRDAT("NE W COB DATA "))=1 then the resub mit reques ted from t he BPS COB PROCESS S ECOND TRIC ARE and th e user can change th e data
9451	"RTN","BPS NCPDP",59, 0)
9452	I BPSCOB= 2,$$ACTTYP E^BPSOSRX5 (BWHERE)=" UC",'$G(BP SPRDAT("NE W COB DATA ")) N:$D(B PSRTYPE)=0 BPSRTYPE N:$D(BPSPL AN)=0 BPSP LAN N:$D(B PSPRDAT)=0 BPSPRDAT I $$SECDAT A^BPSPRRX6 (BRXIEN,BF ILL,.BPSPL AN,.BPSPRD AT,.BPSRTY PE)=0 D G END
9453	"RTN","BPS NCPDP",60, 0)
9454	. S CLMST AT="Insuff icient dat a to resub mit the se condary cl aim, use P rocess Sec ondary/TRI CARE Rx to ECME opti on.",RESPO NSE=5
9455	"RTN","BPS NCPDP",61, 0)
9456	;
9457	"RTN","BPS NCPDP",62, 0)
9458	; Initial ize log
9459	"RTN","BPS NCPDP",63, 0)
9460	D LOG^BPS OSL(IEN59, $T(+0)_"-S tart of cl aim","DT")
9461	"RTN","BPS NCPDP",64, 0)
9462	D LOG^BPS OSL(IEN59, $T(+0)_"-B WHERE = "_ BWHERE)
9463	"RTN","BPS NCPDP",65, 0)
9464	D LOG^BPS OSL(IEN59, $T(+0)_"-J ob flag = "_BPJOBFLG _$S(BPJOBF LG="B":" B PS REQUEST ien = "_$ G(BPREQIEN ),1:""))
9465	"RTN","BPS NCPDP",66, 0)
9466	;
9467	"RTN","BPS NCPDP",67, 0)
9468	; Check i f we need to print t he message s to the s creen (WFL G=1 : YES)
9469	"RTN","BPS NCPDP",68, 0)
9470	S WFLG=0
9471	"RTN","BPS NCPDP",69, 0)
9472	S:BPJOBFL G="F" WFLG =$$PRINTSC R^BPSOSRX8 (BWHERE)
9473	"RTN","BPS NCPDP",70, 0)
9474	;
9475	"RTN","BPS NCPDP",71, 0)
9476	; Lock th e Rx and F ill while putting it on the qu eue to pre vent two j obs from b eing
9477	"RTN","BPS NCPDP",72, 0)
9478	; activ ated at th e same tim e. This i s only for foregroun d jobs.
9479	"RTN","BPS NCPDP",73, 0)
9480	; Backg round jobs are calle d from REQ ST99^BPSOS RX5 and th e RX/RF sh ould be al ready lock ed by this point.
9481	"RTN","BPS NCPDP",74, 0)
9482	I BPJOBFL G="F" D I 'BPLCK G END
9483	"RTN","BPS NCPDP",75, 0)
9484	. S BPLCK =$$LOCKRF^ BPSOSRX(BR XIEN,BFILL ,10,$G(IEN 59),$T(+0) )
9485	"RTN","BPS NCPDP",76, 0)
9486	. I 'BPLC K S RESPON SE=4,CLMST AT="Unable to acquir e the lock needed to put the R X and fill on the qu eue"
9487	"RTN","BPS NCPDP",77, 0)
9488	;
9489	"RTN","BPS NCPDP",78, 0)
9490	; Determi ne the act ion type
9491	"RTN","BPS NCPDP",79, 0)
9492	; If fore ground job then can be C,U and UC action s types
9493	"RTN","BPS NCPDP",80, 0)
9494	S BPACTTY P=""
9495	"RTN","BPS NCPDP",81, 0)
9496	I BPJOBFL G="F" S BP ACTTYP=$$A CTTYPE^BPS OSRX5(BWHE RE)
9497	"RTN","BPS NCPDP",82, 0)
9498	;if backg round/unqu eueing job then only two actio n types ar e allowed - C and U
9499	"RTN","BPS NCPDP",83, 0)
9500	I BPJOBFL G="B" D I RESPONSE= 5 G END
9501	"RTN","BPS NCPDP",84, 0)
9502	. S BPACT TYP=$P($G( ^BPS(90023 13.77,+$G( BPREQIEN), 1)),U,4)
9503	"RTN","BPS NCPDP",85, 0)
9504	. I BPACT TYP="" S R ESPONSE=5, CLMSTAT="U nknown Act ion type i n BPS REQU EST ien="_ BPREQIEN
9505	"RTN","BPS NCPDP",86, 0)
9506	;
9507	"RTN","BPS NCPDP",87, 0)
9508	;code to handle "ge neral" sub mit/revers al as oppo sed to pro cessing a claim for a specific payer seq uence (pri mary, seco ndary)
9509	"RTN","BPS NCPDP",88, 0)
9510	;ECME and IB always know the payer sequ ence and a lways shou ld set the proper BP COBIND par ameter
9511	"RTN","BPS NCPDP",89, 0)
9512	;thus if BPCOBIND=0 then the API is cal led by Pha rmacy. If so then th e CLAIM ac tion (not reversal) should be done for p rimary onl y.
9513	"RTN","BPS NCPDP",90, 0)
9514	S BPSQUIT =0
9515	"RTN","BPS NCPDP",91, 0)
9516	I BPCOBIN D=0 D I B PSQUIT=1 S CLMSTAT=" The second ary claim needs to b e reversed first.",R ESPONSE=5 G END
9517	"RTN","BPS NCPDP",92, 0)
9518	. I BPACT TYP=""!(BP ACTTYP="C" ) S BPCOBI ND=1 Q
9519	"RTN","BPS NCPDP",93, 0)
9520	. ;code t o handle " general" r eversal
9521	"RTN","BPS NCPDP",94, 0)
9522	. N BPSEC LM
9523	"RTN","BPS NCPDP",95, 0)
9524	. ;check if there i s the seco ndary e-cl aim
9525	"RTN","BPS NCPDP",96, 0)
9526	. S BPSEC LM=$$FINDE CLM^BPSPRR X5(BRXIEN, BFILL,2)
9527	"RTN","BPS NCPDP",97, 0)
9528	. ;quit i f we have secondary claim and it is paya ble or in progress - it needs to be reve rsed first
9529	"RTN","BPS NCPDP",98, 0)
9530	. I BPSEC LM=1!(BPSE CLM=3) S B PSQUIT=1
9531	"RTN","BPS NCPDP",99, 0)
9532	. S BPCOB IND=1
9533	"RTN","BPS NCPDP",100 ,0)
9534	;
9535	"RTN","BPS NCPDP",101 ,0)
9536	;== IF BP JOBFLG="F" THEN dete rmine if t here are a ny schedul ed/active/ in process requests for the RX /RF
9537	"RTN","BPS NCPDP",102 ,0)
9538	;CHKREQST ^BPSOSRX7 returns
9539	"RTN","BPS NCPDP",103 ,0)
9540	; negativ e number^m essage : c annot be a ccepted fo r some rea son
9541	"RTN","BPS NCPDP",104 ,0)
9542	; 0 : can be accept ed because there are NO reques ts for thi s RX/RF,
9543	"RTN","BPS NCPDP",105 ,0)
9544	; we will crea te a new r ecord in B PS REQUEST for it an d ACTIVATE it.
9545	"RTN","BPS NCPDP",106 ,0)
9546	; 1 : the re are ACT IVATED/IN PROCESS re quests alr eady for t his RX/RF
9547	"RTN","BPS NCPDP",107 ,0)
9548	S BPPREVR Q="-10^Bac kground qu euing." ;d efault
9549	"RTN","BPS NCPDP",108 ,0)
9550	I BPJOBFL G="F" D I BPPREVRQ' =0 G STATU S:RESPONSE =0,END:RES PONSE>0
9551	"RTN","BPS NCPDP",109 ,0)
9552	. S BPPRE VRQ=$$CHKR EQST^BPSOS RX7(BRXIEN ,BFILL,.BP RESLT)
9553	"RTN","BPS NCPDP",110 ,0)
9554	. D LOG^B PSOSL(IEN5 9,$T(+0)_" -CHKREQ^BP SOSRX7 res ult: "_BPP REVRQ)
9555	"RTN","BPS NCPDP",111 ,0)
9556	. ;if err or
9557	"RTN","BPS NCPDP",112 ,0)
9558	. I BPPRE VRQ<0 S RE SPONSE=4,C LMSTAT=$P( BPPREVRQ,U ,2) D LOG^ BPSOSL(IEN 59,$T(+0)_ "- - Canno t be accep ted becaus e of issue s with alr eady sched uled reque sts")
9559	"RTN","BPS NCPDP",113 ,0)
9560	. ;if the re are pri or request s for the RX/RF in t he queue a lready the n schedule additiona l request( s)
9561	"RTN","BPS NCPDP",114 ,0)
9562	. ;for th e future a nd quit si nce we do not know t he result of prior r equests
9563	"RTN","BPS NCPDP",115 ,0)
9564	. I BPPRE VRQ>0 D
9565	"RTN","BPS NCPDP",116 ,0)
9566	. . D LOG ^BPSOSL(IE N59,$T(+0) _"-There a re request s in the q ueue, do n ot process - schedul e addition al request (s)")
9567	"RTN","BPS NCPDP",117 ,0)
9568	. . I BPA CTTYP="U" S BPRET=$$ SCHREQ^BPS NCPD5(.BP7 7NEW,BRXIE N,BFILL,DO S,BWHERE,$ G(BILLNDC) ,REVREAS,D URREC,BPOV RIEN,BPSCL ARF,BPSAUT H,BPSDELAY ,IEN59,BPC OBIND,BPPR EVRQ,"U",. BPSCLOSE,$ G(BPSRTYPE ),$G(BPSPL AN),.BPSPR DAT)
9569	"RTN","BPS NCPDP",118 ,0)
9570	. . I BPA CTTYP="UC" D
9571	"RTN","BPS NCPDP",119 ,0)
9572	. . . S B PRET=$$SCH REQ^BPSNCP D5(.BP77NE W,BRXIEN,B FILL,DOS,B WHERE,$G(B ILLNDC),RE VREAS,DURR EC,BPOVRIE N,BPSCLARF ,BPSAUTH,B PSDELAY,IE N59,BPCOBI ND,BPPREVR Q,"U",.BPS CLOSE,$G(B PSRTYPE),$ G(BPSPLAN) ,.BPSPRDAT )
9573	"RTN","BPS NCPDP",120 ,0)
9574	. . . I + BPRET=0 S BPRET=$$SC HREQ^BPSNC PD5(.BP77N EW,BRXIEN, BFILL,DOS, BWHERE,$G( BILLNDC),R EVREAS,DUR REC,BPOVRI EN,BPSCLAR F,BPSAUTH, BPSDELAY,I EN59,BPCOB IND,BP77NE W,"C",.BPS CLOSE,$G(B PSRTYPE),$ G(BPSPLAN) ,.BPSPRDAT )
9575	"RTN","BPS NCPDP",121 ,0)
9576	. . I BPA CTTYP="C" S BPRET=$$ SCHREQ^BPS NCPD5(.BP7 7NEW,BRXIE N,BFILL,DO S,BWHERE,$ G(BILLNDC) ,REVREAS,D URREC,BPOV RIEN,BPSCL ARF,BPSAUT H,BPSDELAY ,IEN59,BPC OBIND,BPPR EVRQ,"C",. BPSCLOSE,$ G(BPSRTYPE ),$G(BPSPL AN),.BPSPR DAT)
9577	"RTN","BPS NCPDP",122 ,0)
9578	. . I +BP RET=0 S RE SPONSE=0,C LMSTAT=$P( BPRET,U,2) D LOG^BPS OSL(IEN59, $T(+0)_"-T he new req uest(s) sc heduled. T he last on e for the RX/RF now is: "_(BP7 7NEW)) Q
9579	"RTN","BPS NCPDP",123 ,0)
9580	. . I +BP RET>0 S RE SPONSE=+BP RET,CLMSTA T=$P(BPRET ,U,2) D LO G^BPSOSL(I EN59,$T(+0 )_"-Cannot create re quest(s)")
9581	"RTN","BPS NCPDP",124 ,0)
9582	;
9583	"RTN","BPS NCPDP",125 ,0)
9584	;== So we can conti nue only i f either
9585	"RTN","BPS NCPDP",126 ,0)
9586	; BPJOBF LG="B"
9587	"RTN","BPS NCPDP",127 ,0)
9588	; or
9589	"RTN","BPS NCPDP",128 ,0)
9590	; BPJOBF LG="F" and BPPREVRQ= 0
9591	"RTN","BPS NCPDP",129 ,0)
9592	;
9593	"RTN","BPS NCPDP",130 ,0)
9594	; If a ne w RX/RF - i.e. RX/RF was never processed thru ECME - process and quit
9595	"RTN","BPS NCPDP",131 ,0)
9596	S BPNEWCL M=$S(+$G(^ BPST(IEN59 ,0)):0,1:1 )
9597	"RTN","BPS NCPDP",132 ,0)
9598	; get pre -existing RX/RFs sta tus
9599	"RTN","BPS NCPDP",133 ,0)
9600	S OLDRESP =$P($$STAT US^BPSOSRX (BRXIEN,BF ILL,0,,BPS COB),U,1)
9601	"RTN","BPS NCPDP",134 ,0)
9602	; check i f the paye r IS going to PAY ac cording th e last res ponse
9603	"RTN","BPS NCPDP",135 ,0)
9604	S BPPAYAB L=$$PAYABL E^BPSOSRX5 (OLDRESP)
9605	"RTN","BPS NCPDP",136 ,0)
9606	; set sta rttime
9607	"RTN","BPS NCPDP",137 ,0)
9608	S BPSTART =$$STTM^BP SNCPD4()
9609	"RTN","BPS NCPDP",138 ,0)
9610	;
9611	"RTN","BPS NCPDP",139 ,0)
9612	; if this is a new RX/RF
9613	"RTN","BPS NCPDP",140 ,0)
9614	I BPNEWCL M D NEWCLA IM^BPSNCPD 6 G STATUS :RESPONSE= 0,END:RESP ONSE>0
9615	"RTN","BPS NCPDP",141 ,0)
9616	;
9617	"RTN","BPS NCPDP",142 ,0)
9618	; if we d o not have a status for the pr evious cla im AND thi s is not a reversal request - treat it a s a new cl aim
9619	"RTN","BPS NCPDP",143 ,0)
9620	; this wi ll be the case when resubmitti ng a non-b illable en try (bps1 20)
9621	"RTN","BPS NCPDP",144 ,0)
9622	I (OLDRES P=""),(BPA CTTYP'="U" ) D NEWCLA IM^BPSNCPD 6 G STATUS :RESPONSE= 0,END:RESP ONSE>0
9623	"RTN","BPS NCPDP",145 ,0)
9624	;
9625	"RTN","BPS NCPDP",146 ,0)
9626	; if we d o not have a status for the pr e-existing claim AND this is a reversal request - DO NOT rev erse
9627	"RTN","BPS NCPDP",147 ,0)
9628	I (OLDRES P=""),(BPA CTTYP="U") D RVNEW^B PSNCPD6 G END
9629	"RTN","BPS NCPDP",148 ,0)
9630	;
9631	"RTN","BPS NCPDP",149 ,0)
9632	;== Furth er below - all claim s with som e response (i.e. OLD RESP]""=1)
9633	"RTN","BPS NCPDP",150 ,0)
9634	;
9635	"RTN","BPS NCPDP",151 ,0)
9636	; if Back Billing - impossibl e
9637	"RTN","BPS NCPDP",152 ,0)
9638	I BWHERE= "BB" D BB^ BPSNCPD6 G END
9639	"RTN","BPS NCPDP",153 ,0)
9640	;
9641	"RTN","BPS NCPDP",154 ,0)
9642	; If retu rning to s tock or de leting and the previ ous claim was not pa id, then n o reversal is needed
9643	"RTN","BPS NCPDP",155 ,0)
9644	; so cl ose the pr escription and quit
9645	"RTN","BPS NCPDP",156 ,0)
9646	; Note: t his is inh erited "fu zzy logic" -
9647	"RTN","BPS NCPDP",157 ,0)
9648	; it chec ks only tw o statuses to determ ine that t he claim " was not pa id"
9649	"RTN","BPS NCPDP",158 ,0)
9650	I OLDRESP '["E PAYAB LE",OLDRES P'["E REVE RSAL REJEC TED",(",RS ,DE,"[("," _BWHERE_", ")) D G E ND
9651	"RTN","BPS NCPDP",159 ,0)
9652	. D CLOSE 2^BPSBUTL( BRXIEN,BFI LL,BWHERE)
9653	"RTN","BPS NCPDP",160 ,0)
9654	. S RESPO NSE=3
9655	"RTN","BPS NCPDP",161 ,0)
9656	. S CLMST AT="Claim was not pa yable so i t has been closed. No ECME cl aim create d."
9657	"RTN","BPS NCPDP",162 ,0)
9658	. D DISPL ^BPSNCPD4( WFLG,RESPO NSE_U_CLMS TAT_"^D^2" ,$G(BPSELI G))
9659	"RTN","BPS NCPDP",163 ,0)
9660	. D LOG^B PSOSL(IEN5 9,$T(+0)_" -"_CLMSTAT )
9661	"RTN","BPS NCPDP",164 ,0)
9662	;
9663	"RTN","BPS NCPDP",165 ,0)
9664	; Reversa ls for Pay able claim s
9665	"RTN","BPS NCPDP",166 ,0)
9666	; (Note: BPSCLOSE c an be used in this c ase only)
9667	"RTN","BPS NCPDP",167 ,0)
9668	I BPPAYAB L,BPACTTYP ="U" D RVP AID^BPSNCP D6 G STATU S:RESPONSE =0,END:RES PONSE>0
9669	"RTN","BPS NCPDP",168 ,0)
9670	;
9671	"RTN","BPS NCPDP",169 ,0)
9672	; Resubmi ts without doing a R eversal - special hi dden actio n on ECME User Scree n (BPS12 0)
9673	"RTN","BPS NCPDP",170 ,0)
9674	I BWHERE= "ERWV" D R VRSNPD^BPS NCPD6 G ST ATUS:RESPO NSE=0,END: RESPONSE>0
9675	"RTN","BPS NCPDP",171 ,0)
9676	;
9677	"RTN","BPS NCPDP",172 ,0)
9678	; Reversa ls+Resubmi ts for Pay able claim s
9679	"RTN","BPS NCPDP",173 ,0)
9680	I BPPAYAB L,BPACTTYP ="UC" D RV RSPAID^BPS NCPD6 G ST ATUS:((RES PONSE=0)!( RESPONSE=1 0)),END:RE SPONSE>0
9681	"RTN","BPS NCPDP",174 ,0)
9682	;
9683	"RTN","BPS NCPDP",175 ,0)
9684	; Resubmi ts for Pay able claim s - DO NOT resubmit
9685	"RTN","BPS NCPDP",176 ,0)
9686	I BPPAYAB L,BPACTTYP ="C" D RSP AID^BPSNCP D6 G END
9687	"RTN","BPS NCPDP",177 ,0)
9688	;
9689	"RTN","BPS NCPDP",178 ,0)
9690	; Reversa ls for Non -Payable c laims - DO NOT rever se
9691	"RTN","BPS NCPDP",179 ,0)
9692	I 'BPPAYA BL,BPACTTY P="U" D RV NPAID^BPSN CPD6 G END
9693	"RTN","BPS NCPDP",180 ,0)
9694	;
9695	"RTN","BPS NCPDP",181 ,0)
9696	; Resubmi ts AND Rev ersals+Res ubmits for Non-Payab le claims
9697	"RTN","BPS NCPDP",182 ,0)
9698	I 'BPPAYA BL,((BPACT TYP="C")!( BPACTTYP=" UC")) D RV RSNPD^BPSN CPD6 G STA TUS:RESPON SE=0,END:R ESPONSE>0
9699	"RTN","BPS NCPDP",183 ,0)
9700	;
9701	"RTN","BPS NCPDP",184 ,0)
9702	S RESPONS E=5,CLMSTA T="Unknown error"
9703	"RTN","BPS NCPDP",185 ,0)
9704	G END
9705	"RTN","BPS NCPDP",186 ,0)
9706	;
9707	"RTN","BPS NCPDP",187 ,0)
9708	;== Displ ay status
9709	"RTN","BPS NCPDP",188 ,0)
9710	STATUS ;
9711	"RTN","BPS NCPDP",189 ,0)
9712	;if succe ssful sche duling or/ and activa tion of th e request then make sure the b ackground job is run ning
9713	"RTN","BPS NCPDP",190 ,0)
9714	I BPJOBFL G="F",BPLC K D UNLCKR F^BPSOSRX( BRXIEN,BFI LL,$G(IEN5 9),$T(+0)) S BPLCK=0 ;to preve nt unlocki ng in END
9715	"RTN","BPS NCPDP",191 ,0)
9716	I (RESPON SE=0)!(RES PONSE=10) D LOG^BPSO SL(IEN59,$ T(+0)_"-Ca ll RUNNING ^BPSOSRX") D RUNNING ^BPSOSRX()
9717	"RTN","BPS NCPDP",192 ,0)
9718	I WFLG W !!,"Proces sing ",$S( BPSCOB=1:" Primary cl aim...",BP SCOB=2:"Se condary cl aim...",1: "claim wit h Unknown Payer Sequ ence...")
9719	"RTN","BPS NCPDP",193 ,0)
9720	I BPJOBFL G="F" D
9721	"RTN","BPS NCPDP",194 ,0)
9722	. ; If th e Write Fl ag is off and this i s TRICARE/ CHAMPVA, s et Write F lag to 2
9723	"RTN","BPS NCPDP",195 ,0)
9724	. ; STATU S^BPSNCPD1 will not display me ssages but will wait the same amount of time as if it were w riting mes sages
9725	"RTN","BPS NCPDP",196 ,0)
9726	. ; This needs to b e done so that TRICA RE/CHAMPVA claims ge t a chance to comple te before continuing
9727	"RTN","BPS NCPDP",197 ,0)
9728	. ; Other wise, the claim will be IN PRO GRESS, whi ch will cr eate the b ulletin (c ode below) and OP/CM OP will
9729	"RTN","BPS NCPDP",198 ,0)
9730	. ; not process c orrectly ( keep on su spense que ue, etc)
9731	"RTN","BPS NCPDP",199 ,0)
9732	. I 'WFLG ,$G(BPSELI G)="T"!($G (BPSELIG)= "C") S WFL G=2
9733	"RTN","BPS NCPDP",200 ,0)
9734	. I 'WFLG H 1
9735	"RTN","BPS NCPDP",201 ,0)
9736	. E D ST ATUS^BPSNC PD1(BRXIEN ,BFILL,+$G (BPPAYABL) ,$S(BPACTT YP="U":1,1 :0),BPSTAR T,BWHERE,$ G(BP77NEW) ,BPSCOB,$G (BPSELIG), IEN59,WFLG )
9737	"RTN","BPS NCPDP",202 ,0)
9738	;
9739	"RTN","BPS NCPDP",203 ,0)
9740	;== Clean up and qu it
9741	"RTN","BPS NCPDP",204 ,0)
9742	END ;
9743	"RTN","BPS NCPDP",205 ,0)
9744	; BPSELIG and other variables are estab lished by inference in BPSNCPD 6.
9745	"RTN","BPS NCPDP",206 ,0)
9746	I BPJOBFL G="F",BPLC K D UNLCKR F^BPSOSRX( BRXIEN,BFI LL,$G(IEN5 9),$T(+0)) S BPLCK=0
9747	"RTN","BPS NCPDP",207 ,0)
9748	; Get Sit e in case we send a Bulletin
9749	"RTN","BPS NCPDP",208 ,0)
9750	S SITE=$$ GETSITE^BP SOSRX8(BRX IEN,BFILL)
9751	"RTN","BPS NCPDP",209 ,0)
9752	;if foreg round AND we can't s chedule re quest for any reason AND this is not OP - send bul letin
9753	"RTN","BPS NCPDP",210 ,0)
9754	I BPJOBFL G="F",RESP ONSE=4,",A REV,BB,ERE S,ERWV,ERN B,EREV,P2, P2S,"'[(", "_BWHERE_" ,") D BULL ^BPSNCPD1( BRXIEN,BFI LL,$G(SITE ),$G(DFN), $G(PNAME), "",$G(CLMS TAT),$G(RE SPONSE),$G (BPSCOB))
9755	"RTN","BPS NCPDP",211 ,0)
9756	I $G(BPSE LIG)="" S BPSELIG=""
9757	"RTN","BPS NCPDP",212 ,0)
9758	; Send Bu lletin if TRICARE or CHAMPVA i s IN PROGR ESS and th is is not a release process
9759	"RTN","BPS NCPDP",213 ,0)
9760	S BPSSTAT =$S($G(BRX IEN):$P($$ STATUS^BPS OSRX(BRXIE N,BFILL,,, BPSCOB),U) ,1:"")
9761	"RTN","BPS NCPDP",214 ,0)
9762	;
9763	"RTN","BPS NCPDP",215 ,0)
9764	I $G(IEN5 9) D
9765	"RTN","BPS NCPDP",216 ,0)
9766	. D LOG^B PSOSL(IEN5 9,$T(+0)_" -Nearing e nd of firs t process, BPSELIG=" _BPSELIG_" , BPSSTAT= "_BPSSTAT)
9767	"RTN","BPS NCPDP",217 ,0)
9768	. I BPSEL IG="T"!(BP SELIG="C") ,BPSSTAT=" IN PROGRES S",$G(REVR EAS)'="RX RELEASE-ND C CHANGE", BWHERE="PC " D LOG^BP SOSL(IEN59 ,$T(+0)_"- Would have sent bull etin")
9769	"RTN","BPS NCPDP",218 ,0)
9770	;
9771	"RTN","BPS NCPDP",219 ,0)
9772	I BPSELIG ="T"!(BPSE LIG="C"),B PSSTAT="IN PROGRESS" ,$G(REVREA S)'="RX RE LEASE-NDC CHANGE",", CRLB,CRLR, CRLX,CRRL, PC,RRL,"'[ (","_BWHER E_",") D B ULL^BPSNCP D1(BRXIEN, BFILL,SITE ,$G(DFN),$ G(PNAME),B PSELIG,"", "",$G(BPSC OB))
9773	"RTN","BPS NCPDP",220 ,0)
9774	;
9775	"RTN","BPS NCPDP",221 ,0)
9776	S:'$D(RES PONSE) RES PONSE=1
9777	"RTN","BPS NCPDP",222 ,0)
9778	K MOREDAT A
9779	"RTN","BPS NCPDP",223 ,0)
9780	I $G(IEN5 9) D
9781	"RTN","BPS NCPDP",224 ,0)
9782	. N MSG
9783	"RTN","BPS NCPDP",225 ,0)
9784	. S MSG=" First Proc ess Comple te-RESPONS E="_$G(RES PONSE)
9785	"RTN","BPS NCPDP",226 ,0)
9786	. I $G(RE SPONSE)'=0 S MSG=MSG _", CLMSTA T="_$G(CLM STAT)
9787	"RTN","BPS NCPDP",227 ,0)
9788	. D LOG^B PSOSL(IEN5 9,$T(+0)_" -"_MSG)
9789	"RTN","BPS NCPDP",228 ,0)
9790	;
9791	"RTN","BPS NCPDP",229 ,0)
9792	; The fun ction $$EC MESND retu rns the fo llowing:
9793	"RTN","BPS NCPDP",230 ,0)
9794	; Respo nse ^ Mess age ^ Elig ibility ^ Claim Stat us ^ COB ^
9795	"RTN","BPS NCPDP",231 ,0)
9796	; RxCOB ^ Insuran ce
9797	"RTN","BPS NCPDP",232 ,0)
9798	; Respons e =
9799	"RTN","BPS NCPDP",233 ,0)
9800	; 0 Su bmitted th rough ECME
9801	"RTN","BPS NCPDP",234 ,0)
9802	; 1 No submissio n through ECME
9803	"RTN","BPS NCPDP",235 ,0)
9804	; 2 IB not billa ble
9805	"RTN","BPS NCPDP",236 ,0)
9806	; 3 Cl aim was cl osed, not submitted (RTS/Delet es)
9807	"RTN","BPS NCPDP",237 ,0)
9808	; 4 Un able to qu eue claim
9809	"RTN","BPS NCPDP",238 ,0)
9810	; 5 In correct in formation supplied t o ECME
9811	"RTN","BPS NCPDP",239 ,0)
9812	; 6 In active ECM E - Primar ily used f or TRICARE /CHAMPVA t o
9813	"RTN","BPS NCPDP",240 ,0)
9814	; sa y ok to pr ocess Rx
9815	"RTN","BPS NCPDP",241 ,0)
9816	; 10 Re versal but no resubm it
9817	"RTN","BPS NCPDP",242 ,0)
9818	; Message = Message indicatin g whether the claim was submit ted
9819	"RTN","BPS NCPDP",243 ,0)
9820	; Eligibi lity = V, Veteran; T, TRICARE ; C, CHAMP VA
9821	"RTN","BPS NCPDP",244 ,0)
9822	; Claim S tatus = IN PROGRESS if incompl ete; final status (e .g.
9823	"RTN","BPS NCPDP",245 ,0)
9824	; E PAY ABLE or E REJECTED) if complet e; null if non-billa ble
9825	"RTN","BPS NCPDP",246 ,0)
9826	; COB = COB indica tor as sto red in the INSURANCE TYPE sub- file
9827	"RTN","BPS NCPDP",247 ,0)
9828	; of th e PATIENT file
9829	"RTN","BPS NCPDP",248 ,0)
9830	; RxCOB = COB indic ator sent to the pay er and sto red in the
9831	"RTN","BPS NCPDP",249 ,0)
9832	; BPS T RANSACTION S file
9833	"RTN","BPS NCPDP",250 ,0)
9834	; Insuran ce = Name of the ins urance com pany that was billed as
9835	"RTN","BPS NCPDP",251 ,0)
9836	; a res ult of thi s call
9837	"RTN","BPS NCPDP",252 ,0)
9838	;
9839	"RTN","BPS NCPDP",253 ,0)
9840	Q RESPONS E_U_$G(CLM STAT)_U_BP SELIG_U_BP SSTAT_U_$$ CLMINFO^BP SUTIL2(+$G (IEN59))
9841	"RTN","BPS NCPDP",254 ,0)
9842	;
9843	"RTN","BPS NCPDP",255 ,0)
9844	;BPSNCPDP
9845	"RTN","BPS PHAR")
9846	0^7^B17730 22
9847	"RTN","BPS PHAR",1,0)
9848	BPSPHAR ;B HAM ISC/BE E - ECME M GR PHAR OP TION ;14-F EB-05
9849	"RTN","BPS PHAR",2,0)
9850	;;1.0;E C LAIMS MGMT ENGINE; 1,3,2,5,22 ;JUN 200 4;Build 15
9851	"RTN","BPS PHAR",3,0)
9852	;;Per VA Directive 6402, this routine s hould not be modifie d.
9853	"RTN","BPS PHAR",4,0)
9854	;
9855	"RTN","BPS PHAR",5,0)
9856	; This ro utine is c alled by t he BPS SET UP PHARMAC Y menu opt ion. It up dates
9857	"RTN","BPS PHAR",6,0)
9858	; several fields in the BPS P HARMACIES file.
9859	"RTN","BPS PHAR",7,0)
9860	;
9861	"RTN","BPS PHAR",8,0)
9862	Q
9863	"RTN","BPS PHAR",9,0)
9864	;
9865	"RTN","BPS PHAR",10,0 )
9866	EN ; Main Entry Poin t
9867	"RTN","BPS PHAR",11,0 )
9868	N D0,DA,D I,DIC,DLAY GO,DIE,DIR UT,DQ,DR,D TOUT,DUOUT ,X,Y
9869	"RTN","BPS PHAR",12,0 )
9870	;
9871	"RTN","BPS PHAR",13,0 )
9872	; First s elect the pharmacy o r enter a new one
9873	"RTN","BPS PHAR",14,0 )
9874	W !! S DI C(0)="QEAL M",(DLAYGO ,DIC)=9002 313.56,DIC ("A")="Sel ect BPS PH ARMACIES N AME: "
9875	"RTN","BPS PHAR",15,0 )
9876	D ^DIC
9877	"RTN","BPS PHAR",16,0 )
9878	;
9879	"RTN","BPS PHAR",17,0 )
9880	;Check fo r "^", tim eout, or b lank entry
9881	"RTN","BPS PHAR",18,0 )
9882	I ($G(DUO UT)=1)!($G (DTOUT)=1) !($G(Y)=-1 ) Q
9883	"RTN","BPS PHAR",19,0 )
9884	;
9885	"RTN","BPS PHAR",20,0 )
9886	;Pull int ernal entr y
9887	"RTN","BPS PHAR",21,0 )
9888	S DA=$P($ G(Y),U) Q: '$G(Y)
9889	"RTN","BPS PHAR",22,0 )
9890	;
9891	"RTN","BPS PHAR",23,0 )
9892	; If new BPS Pharma cy, defaul t the CMOP Switch an d Auto-Rev ersal Para meter
9893	"RTN","BPS PHAR",24,0 )
9894	I $P(Y,U, 3)=1 D
9895	"RTN","BPS PHAR",25,0 )
9896	. N DIE,D R,DTOUT
9897	"RTN","BPS PHAR",26,0 )
9898	. S DIE=9 002313.56, DR="1////0 ;.09////5"
9899	"RTN","BPS PHAR",27,0 )
9900	. D ^DIE
9901	"RTN","BPS PHAR",28,0 )
9902	;
9903	"RTN","BPS PHAR",29,0 )
9904	; Display the BPS P harmacy na me, NCPDP #, and NPI
9905	"RTN","BPS PHAR",30,0 )
9906	W !!,"NAM E: ",$P($G (^BPS(9002 313.56,DA, 0)),U,1)
9907	"RTN","BPS PHAR",31,0 )
9908	W !,"STAT US: ",$$GE T1^DIQ(900 2313.56,DA ,.1,"E")
9909	"RTN","BPS PHAR",32,0 )
9910	W !,"NCPD P #: ",$P( $G(^BPS(90 02313.56,D A,0)),U,2)
9911	"RTN","BPS PHAR",33,0 )
9912	W !,"NPI: ",$P($G(^ BPS(900231 3.56,DA,"N PI")),U,1)
9913	"RTN","BPS PHAR",34,0 )
9914	;
9915	"RTN","BPS PHAR",35,0 )
9916	; Now edi t OUTPATIE NT SITE, C MOP SWITCH , AUTO-REV ERSE PARAM ETER,
9917	"RTN","BPS PHAR",36,0 )
9918	; and t he DEFAULT DEA #
9919	"RTN","BPS PHAR",37,0 )
9920	S DIE=900 2313.56
9921	"RTN","BPS PHAR",38,0 )
9922	S DR="138 00;1;.09;. 03"
9923	"RTN","BPS PHAR",39,0 )
9924	S DR(2,90 02313.5601 )=".01"
9925	"RTN","BPS PHAR",40,0 )
9926	D ^DIE
9927	"RTN","BPS PHAR",41,0 )
9928	;
9929	"RTN","BPS PHAR",42,0 )
9930	Q
9931	"RTN","BPS SCR")
9932	0^1^B30328 11
9933	"RTN","BPS SCR",1,0)
9934	BPSSCR ;BH AM ISC/SS - ECME USE R SCREEN M AIN ;10-MA R-2005
9935	"RTN","BPS SCR",2,0)
9936	;;1.0;E C LAIMS MGMT ENGINE; 1,22;JUN 2004;Buil d 15
9937	"RTN","BPS SCR",3,0)
9938	;; Per VA Directive 6402, thi s routine should not be modifi ed.
9939	"RTN","BPS SCR",4,0)
9940	;USER SCR EEN
9941	"RTN","BPS SCR",5,0)
9942	Q
9943	"RTN","BPS SCR",6,0)
9944	EN ; -- ma in entry p oint for B PS ECME US ER SCREEN
9945	"RTN","BPS SCR",7,0)
9946	D EN^VALM ("BPS LSTM N ECME USR SCR")
9947	"RTN","BPS SCR",8,0)
9948	Q
9949	"RTN","BPS SCR",9,0)
9950	;
9951	"RTN","BPS SCR",10,0)
9952	HDR ; -- h eader code
9953	"RTN","BPS SCR",11,0)
9954	S VALMHDR (1)=$$HDR^ BPSSCR01(1 )
9955	"RTN","BPS SCR",12,0)
9956	S VALMHDR (2)=$$HDR^ BPSSCR01(2 )
9957	"RTN","BPS SCR",13,0)
9958	S VALMHDR (3)=$$HDR^ BPSSCR01(3 )
9959	"RTN","BPS SCR",14,0)
9960	Q
9961	"RTN","BPS SCR",15,0)
9962	;
9963	"RTN","BPS SCR",16,0)
9964	INIT ; -- init varia bles and l ist array
9965	"RTN","BPS SCR",17,0)
9966	D KILINSG L ;clean u p insuranc e list
9967	"RTN","BPS SCR",18,0)
9968	W !,"Plea se wait... "
9969	"RTN","BPS SCR",19,0)
9970	S VALMCNT =$$INIT^BP SSCR01()
9971	"RTN","BPS SCR",20,0)
9972	Q
9973	"RTN","BPS SCR",21,0)
9974	;
9975	"RTN","BPS SCR",22,0)
9976	HELP ; -- help code
9977	"RTN","BPS SCR",23,0)
9978	S X="?" D DISP^XQOR M1 W !!
9979	"RTN","BPS SCR",24,0)
9980	Q
9981	"RTN","BPS SCR",25,0)
9982	;
9983	"RTN","BPS SCR",26,0)
9984	EXIT ; -- exit code
9985	"RTN","BPS SCR",27,0)
9986	D CLEANUP
9987	"RTN","BPS SCR",28,0)
9988	Q
9989	"RTN","BPS SCR",29,0)
9990	;
9991	"RTN","BPS SCR",30,0)
9992	EXPND ; -- expand co de
9993	"RTN","BPS SCR",31,0)
9994	Q
9995	"RTN","BPS SCR",32,0)
9996	;
9997	"RTN","BPS SCR",33,0)
9998	CLEANUP ;
9999	"RTN","BPS SCR",34,0)
10000	K @VALMAR
10001	"RTN","BPS SCR",35,0)
10002	D KILINSG L ;clean u p insuranc e list
10003	"RTN","BPS SCR",36,0)
10004	S BPARR(" TEMPCV")=" " ; ensu re Temp CV flag is c leared
10005	"RTN","BPS SCR",37,0)
10006	Q
10007	"RTN","BPS SCR",38,0)
10008	; BPINSNA M - insura nce name; BPPHONE - insurance phone numb er
10009	"RTN","BPS SCR",39,0)
10010	CHKINSUR(B PINSNAM,BP PHONE) ; r eturns a u nique numb er for ins urance (am ong those found in c laims)
10011	"RTN","BPS SCR",40,0)
10012	N BPINSID ,BPMAXN
10013	"RTN","BPS SCR",41,0)
10014	I $L(BPIN SNAM)=0 S BPINSNAM=" UNKNOWN"
10015	"RTN","BPS SCR",42,0)
10016	I $L(BPPH ONE)=0 S B PPHONE="N/ A"
10017	"RTN","BPS SCR",43,0)
10018	S BPINSID =+$G(^TMP( $J,"BPSSCR INS","VAL" ,BPINSNAM, BPPHONE))
10019	"RTN","BPS SCR",44,0)
10020	I BPINSID =0 D
10021	"RTN","BPS SCR",45,0)
10022	. S BPMAX N=$G(^TMP( $J,"BPSSCR INS","MAXN "))+1
10023	"RTN","BPS SCR",46,0)
10024	. S ^TMP( $J,"BPSSCR INS","VAL" ,BPINSNAM, BPPHONE)=B PMAXN
10025	"RTN","BPS SCR",47,0)
10026	. S ^TMP( $J,"BPSSCR INS","MAXN ")=BPMAXN
10027	"RTN","BPS SCR",48,0)
10028	Q +$G(^TM P($J,"BPSS CRINS","VA L",BPINSNA M,BPPHONE) )
10029	"RTN","BPS SCR",49,0)
10030	;
10031	"RTN","BPS SCR",50,0)
10032	KILINSGL ;
10033	"RTN","BPS SCR",51,0)
10034	K ^TMP($J ,"BPSSCRIN S")
10035	"RTN","BPS SCR",52,0)
10036	Q
10037	"RTN","BPS SCR",53,0)
10038	;
10039	"RTN","BPS SCRCV")
10040	0^2^B62382 329
10041	"RTN","BPS SCRCV",1,0 )
10042	BPSSCRCV ; BHAM ISC/S S - ECME S CREEN CHAN GE VIEW ;0 5-APR-05
10043	"RTN","BPS SCRCV",2,0 )
10044	;;1.0;E C LAIMS MGMT ENGINE; 1,5,7,11,1 4,20,22; JUN 2004;B uild 15
10045	"RTN","BPS SCRCV",3,0 )
10046	;;Per VA Directive 6402, this routine s hould not be modifie d.
10047	"RTN","BPS SCRCV",4,0 )
10048	;USER SCR EEN
10049	"RTN","BPS SCRCV",5,0 )
10050	Q
10051	"RTN","BPS SCRCV",6,0 )
10052	;****
10053	"RTN","BPS SCRCV",7,0 )
10054	;This sof tware is u sing PARAM ETER TOOLS (see XT7 .326) to store user 's setting s:
10055	"RTN","BPS SCRCV",8,0 )
10056	;PARAMETE R DEFINITI ON NAME="B PS USRSCR" (file #89 89.51, IA# 2263)
10057	"RTN","BPS SCRCV",9,0 )
10058	;ENTITY i s "USR" , i.e. IEN i n ^VA(200 -- see de finition f or "BPS US RSCR"
10059	"RTN","BPS SCRCV",10, 0)
10060	;INSTANCE s are as f ollows:
10061	"RTN","BPS SCRCV",11, 0)
10062	;1.01 ONE /ALL USERS --'U' ONE USER, 'A' ALL; Disp lay claims for ONE o r ALL user s
10063	"RTN","BPS SCRCV",12, 0)
10064	;1.02 ONE /ALL PATIE NTS --'P' FOR ONE PA TIENT; 'A' FOR ALL; Display cl aims for O NE/ALL PAT IENTS
10065	"RTN","BPS SCRCV",13, 0)
10066	;1.03 ONE /ALL RX -- 'R' FOR ON E RX; 'A' FOR ALL; D isplay cla ims for ON E or ALL R X
10067	"RTN","BPS SCRCV",14, 0)
10068	;1.04 HOU RS/DAYS -- 'D' FOR D AYS; 'H' F OR HOURS; Use HOURS or DAYS to specify t imeframe
10069	"RTN","BPS SCRCV",15, 0)
10070	;1.05 TIM EFRAME -- NUMBER Dep ends on th e value of the field "USR SCR HOURS/DAYS " this fie ld will
10071	"RTN","BPS SCRCV",16, 0)
10072	;store th e default number of HOURS from NOW or DA YS from TO DAY to sel ect claims to displa y
10073	"RTN","BPS SCRCV",17, 0)
10074	;1.06 REJ ECTED/PAYA BLE --'R' FOR REJECT S; 'P' FOR PAYABLES; 'U' FOR U NSTRANDED; 'A' FOR A LL; Displa y Rejects or Payable s or Unstr anded or A LL claims
10075	"RTN","BPS SCRCV",18, 0)
10076	;1.07 REL EASED/NOT RELEASED - -'R' FOR R ELEASED; ' N' FOR NON -RELEASED; 'A' FOR A LL; Displa y Released Rxs or No n-Released Rxs or AL L
10077	"RTN","BPS SCRCV",19, 0)
10078	;1.08 CMO P/MAIL/WIN DOW --'C' FOR CMOP; 'M' FOR MA IL;'W' FOR WINDOW;'A ' FOR ALL; Display C MOP or Mai l or Windo w or ALL R xs
10079	"RTN","BPS SCRCV",20, 0)
10080	;1.09 REA LTIME/BACK BILL --'R' FOR REALT IME; 'B' F OR BACKBIL LS; 'P' FO R PRO Opti on; 'S' FO R ECME Use r Screen R esubmits;
10081	"RTN","BPS SCRCV",21, 0)
10082	; 'A ' FOR ALL; Display R ealTime, B ackbills, PRO Option , Resubmis sion, or A LL
10083	"RTN","BPS SCRCV",22, 0)
10084	;1.1 REJE CT CODE/AL L --'R' FO R REJECT C ODE; 'A' F OR ALL; Di splay Spec ific Rejec t Code or ALL Reject
10085	"RTN","BPS SCRCV",23, 0)
10086	;Codes 0 means ALL Reject Cod es otherwi se - Rejec t Code val ue
10087	"RTN","BPS SCRCV",24, 0)
10088	;1.11 SPE CIFIC/ALL INSURANCES --'I' FOR SPECIFIC INSURANCE( S);'A' FOR ALL; Disp lay Specif ic Insuran ce Company (s) or All null - AL L otherwis e - pointe r to INSUR ANCE COMPA NY file #3 6
10089	"RTN","BPS SCRCV",25, 0)
10090	;1.12 SOR T LIST --' T' FOR TRA NSACTION D ATE;'D' FO R DIVISION ; 'I' FOR INSURANCE; 'C' FOR R EJECT CODE ;
10091	"RTN","BPS SCRCV",26, 0)
10092	;'P' FOR PATIENT NA ME -- 'N' FOR DRUG N AME; 'B' F OR BILL TY PE (BB/P2/ RT/RS); 'L ' FOR FILL LOCATION;
10093	"RTN","BPS SCRCV",27, 0)
10094	;'R' FOR RELEASED/N ON-RELEASE D -- 'A' F OR ACTIVE/ DISCONTINU ED; the fi eld used t o sort cla ims in the list
10095	"RTN","BPS SCRCV",28, 0)
10096	;1.13 ALL ECME PHAR MACY DIVIS IONS --'D' FOR DIVIS ION; 'A' F OR ALL;
10097	"RTN","BPS SCRCV",29, 0)
10098	;1.14 SEL ECTED INSU RANCE -- S ingle, or multiple, insurance( s) to sele ct claims for the Us er Screen, to store INSURANCE COMPANY po inter (#36 )
10099	"RTN","BPS SCRCV",30, 0)
10100	;1.15 SEL ECTED REJE CTED CODE --POINTER TO BPS NCP DP REJECT CODES FILE (#9002313 .93) Rejec t code sel ected by t he user to filter cl aims.
10101	"RTN","BPS SCRCV",31, 0)
10102	;1.16 SEL ECTED USER -- POINTE R TO NEW P ERSON FILE (#200) Se lected use r for the user scree n
10103	"RTN","BPS SCRCV",32, 0)
10104	;1.17 SEL ECTED PATI ENT -- POI NTER TO PA TIENT FILE (#2) Sele cted patie nt for the User Scre en
10105	"RTN","BPS SCRCV",33, 0)
10106	;1.18 SEL ECTED RX - - POINTER TO PRESCRI PTION FILE (#52) Sel ected RX
10107	"RTN","BPS SCRCV",34, 0)
10108	;1.19 NON -BILLABLE TRI/CVA EN TRIES OPEN /CLOSED/AL L -- 'O' O pen; 'C' C losed; 'A' All
10109	"RTN","BPS SCRCV",35, 0)
10110	;2 ECM E PHARMACY DIVISION -- the lis t of POINT ERs TO BPS PHARMACIE S FILE (#9 002313.56) separated by ";"
10111	"RTN","BPS SCRCV",36, 0)
10112	;should s tart and e nd with "; ", example : ";4;5;"
10113	"RTN","BPS SCRCV",37, 0)
10114	;2.01 ELI GIBILITY T YPE --'V' FOR VETERA N;'T' FOR TRICARE;'C ' FOR CHAM PVA;'A' FO R ALL; Dis play claim s for spec ific Eligi bility Typ e or ALL ( BNT BPS1. 07)
10115	"RTN","BPS SCRCV",38, 0)
10116	;2.02 OPE N/CLOSED/A LL --'O' O PEN CLAIMS ;'C' CLOSE D CLAIMS;' A' FOR ALL ; Display Open, Clos ed, or ALL claims (B NT BPS1.0 7)
10117	"RTN","BPS SCRCV",39, 0)
10118	;2.03 SUB MISSION TY PE --'B' B ILLING REQ UESTS;'R' REVERSALS; 'A' FOR AL L; Display specific submission type clai ms or ALL (BNT BPS1 .07)
10119	"RTN","BPS SCRCV",40, 0)
10120	;2.04 INS URANCES -- List of P OINTERs to the INSUR ANCE COMPA NY FILE (# 36) separa ted by ";"
10121	"RTN","BPS SCRCV",41, 0)
10122	;should s tart and e nd with "; ", example : ";4;5;"
10123	"RTN","BPS SCRCV",42, 0)
10124	;NOTE: us e D ^XPARE DIT to add /edit valu es
10125	"RTN","BPS SCRCV",43, 0)
10126	;
10127	"RTN","BPS SCRCV",44, 0)
10128	;*****
10129	"RTN","BPS SCRCV",45, 0)
10130	;
10131	"RTN","BPS SCRCV",46, 0)
10132	CV ;
10133	"RTN","BPS SCRCV",47, 0)
10134	N BPSRESC V,BPSTMPCV ,DIR,Y
10135	"RTN","BPS SCRCV",48, 0)
10136	D FULL^VA LM1
10137	"RTN","BPS SCRCV",49, 0)
10138	W @IOF
10139	"RTN","BPS SCRCV",50, 0)
10140	S BPSTMPC V=$G(BPARR ("TEMPCV") ) ; Defi ne Temp Vi ew Flag be fore BPARR is killed
10141	"RTN","BPS SCRCV",51, 0)
10142	K BPARR
10143	"RTN","BPS SCRCV",52, 0)
10144	I +$G(DUZ )=0 D ERRM SG^BPSSCRC V("Unknown User") Q
10145	"RTN","BPS SCRCV",53, 0)
10146	N BPDUZ7
10147	"RTN","BPS SCRCV",54, 0)
10148	S BPDUZ7= +DUZ
10149	"RTN","BPS SCRCV",55, 0)
10150	;always g et current profile f rom the fi le
10151	"RTN","BPS SCRCV",56, 0)
10152	D READPRO F^BPSSCRSL (.BPARR,BP DUZ7)
10153	"RTN","BPS SCRCV",57, 0)
10154	; BPARR(" 1.13") is the parame ter for Ph armacy Div ision.
10155	"RTN","BPS SCRCV",58, 0)
10156	; If BPAR R("1.13") is defined , the user has a pre ferred vie w defined.
10157	"RTN","BPS SCRCV",59, 0)
10158	I ($G(BPS TMPCV)=1)& ($G(BPARR( "1.13"))'= "") D
10159	"RTN","BPS SCRCV",60, 0)
10160	. S DIR(0 )="Y"
10161	"RTN","BPS SCRCV",61, 0)
10162	. S DIR(" A")="Resto re your Pr eferred Vi ew and exi t Change V iew (Y/N)"
10163	"RTN","BPS SCRCV",62, 0)
10164	. S DIR(" B")="Y"
10165	"RTN","BPS SCRCV",63, 0)
10166	. D ^DIR
10167	"RTN","BPS SCRCV",64, 0)
10168	. S BPSRE SCV=Y
10169	"RTN","BPS SCRCV",65, 0)
10170	I $G(BPSR ESCV)=1 G CV1 ; User repli ed YES - r estore to preferred view.
10171	"RTN","BPS SCRCV",66, 0)
10172	D SAVEVIE W^BPSSCR01 (.BPARR)
10173	"RTN","BPS SCRCV",67, 0)
10174	;edit cur rent profi le
10175	"RTN","BPS SCRCV",68, 0)
10176	D EDITPRO F(.BPARR,. BPDUZ7)
10177	"RTN","BPS SCRCV",69, 0)
10178	;ask user if need t o save eve rything in USR PROFI LE file
10179	"RTN","BPS SCRCV",70, 0)
10180	;(except SORT LIST field)
10181	"RTN","BPS SCRCV",71, 0)
10182	N BPSRT S BPSRT=BPA RR(1.12)
10183	"RTN","BPS SCRCV",72, 0)
10184	K BPARR(1 .12)
10185	"RTN","BPS SCRCV",73, 0)
10186	D ENDEDIT ^BPSSCRSL( .BPARR,+BP DUZ7)
10187	"RTN","BPS SCRCV",74, 0)
10188	S BPARR(1 .12)=BPSRT
10189	"RTN","BPS SCRCV",75, 0)
10190	CV1 ;
10191	"RTN","BPS SCRCV",76, 0)
10192	D SAVEVIE W^BPSSCR01 (.BPARR)
10193	"RTN","BPS SCRCV",77, 0)
10194	S VALMBG= 1
10195	"RTN","BPS SCRCV",78, 0)
10196	D REDRAW^ BPSSCRUD(" Updating s creen...")
10197	"RTN","BPS SCRCV",79, 0)
10198	Q
10199	"RTN","BPS SCRCV",80, 0)
10200	;edit use r profile for CHANGE VIEW
10201	"RTN","BPS SCRCV",81, 0)
10202	EDITPROF(B PARR,BPDUZ 7) ;
10203	"RTN","BPS SCRCV",82, 0)
10204	I +$G(DUZ )=0 D ERRM SG("Unknow n User") Q
10205	"RTN","BPS SCRCV",83, 0)
10206	I $G(BPSR ESCV)="^" Q
10207	"RTN","BPS SCRCV",84, 0)
10208	N BP1,BPT F,BPQ,BPIN P
10209	"RTN","BPS SCRCV",85, 0)
10210	N BPRET
10211	"RTN","BPS SCRCV",86, 0)
10212	N DIR,DR, DIE,DA
10213	"RTN","BPS SCRCV",87, 0)
10214	;get ONE/ ALL USERS?
10215	"RTN","BPS SCRCV",88, 0)
10216	;EDITFLD( FILENO,FLD NO,RECIEN, CODESET,PR MTMSG,DFLT CODE) ;
10217	"RTN","BPS SCRCV",89, 0)
10218	S BPRET=$ $DS^BPSSCR DS(.BPARR, +BPDUZ7) ; get divisi ons
10219	"RTN","BPS SCRCV",90, 0)
10220	Q:BPRET=- 2 ;quit d ue to time out or ^
10221	"RTN","BPS SCRCV",91, 0)
10222	Q:$$EDITF LD(2.01,+B PDUZ7,"S^V :VETERAN;T :TRICARE;C :CHAMPVA;A :ALL","Sel ect Certai n Eligibil ity Type o r (A)ll"," V",.BPARR) =-1
10223	"RTN","BPS SCRCV",92, 0)
10224	S BPQ=0 F D Q:BPQ '=0
10225	"RTN","BPS SCRCV",93, 0)
10226	. S BPINP =$$EDITFLD (1.01,+BPD UZ7,"S^U:O NE USER;A: ALL","Disp lay One EC ME (U)ser or (A)LL", "ALL",.BPA RR)
10227	"RTN","BPS SCRCV",94, 0)
10228	. S:BPINP =-1 BPQ=-1 S:$P(BPIN P,U,2)="A" BPQ=1 I B PQ'=0 Q
10229	"RTN","BPS SCRCV",95, 0)
10230	. S BPINP =$$EDITFLD (1.16,+BPD UZ7,"P^VA( 200,","Sel ect User", "",.BPARR)
10231	"RTN","BPS SCRCV",96, 0)
10232	. S:BPINP =-1 BPQ=-1 S:$P(BPIN P,U,2)'="" BPQ=1 I B PQ'=0 Q
10233	"RTN","BPS SCRCV",97, 0)
10234	Q:BPQ=-1 ;quit due to timeou t or ^
10235	"RTN","BPS SCRCV",98, 0)
10236	S BPQ=0 F D Q:BPQ '=0
10237	"RTN","BPS SCRCV",99, 0)
10238	. S BPINP =$$EDITFLD (1.02,+BPD UZ7,"S^P:O NE PATIENT ;A:ALL","D isplay One (P)atient or (A)LL" ,"ALL",.BP ARR)
10239	"RTN","BPS SCRCV",100 ,0)
10240	. S:BPINP =-1 BPQ=-1 S:$P(BPIN P,U,2)="A" BPQ=1 I B PQ'=0 Q
10241	"RTN","BPS SCRCV",101 ,0)
10242	. S BPINP =$$EDITFLD (1.17,+BPD UZ7,"P^DPT (","Select Patient", "",.BPARR)
10243	"RTN","BPS SCRCV",102 ,0)
10244	. S:BPINP =-1 BPQ=-1 S:$P(BPIN P,U,2)'="" BPQ=1 I B PQ'=0 Q
10245	"RTN","BPS SCRCV",103 ,0)
10246	Q:BPQ=-1 ;quit due to timeou t or ^
10247	"RTN","BPS SCRCV",104 ,0)
10248	S BPQ=0 F D Q:BPQ '=0
10249	"RTN","BPS SCRCV",105 ,0)
10250	. S BPINP =$$EDITFLD (1.03,+BPD UZ7,"S^R:O NE RX;A:AL L","Displa y One (R)x or (A)LL" ,"ALL",.BP ARR)
10251	"RTN","BPS SCRCV",106 ,0)
10252	. S:BPINP =-1 BPQ=-1 S:$P(BPIN P,U,2)="A" BPQ=1 I B PQ'=0 Q
10253	"RTN","BPS SCRCV",107 ,0)
10254	. S BPINP =$$EDITRX^ BPSSCRPR(1 .18,+BPDUZ 7,"Select RX","",.BP ARR)
10255	"RTN","BPS SCRCV",108 ,0)
10256	. S:BPINP =-1 BPQ=-1 S:$P(BPIN P,U,2)'="" BPQ=1 I B PQ'=0 Q
10257	"RTN","BPS SCRCV",109 ,0)
10258	Q:BPQ=-1 ;quit due to timeou t or ^
10259	"RTN","BPS SCRCV",110 ,0)
10260	S BPINP=$ $EDITFLD(1 .04,+BPDUZ 7,"S^D:DAY S;H:HOURS" ,"Activity Timeframe (H)ours o r (D)ays", "DAYS",.BP ARR)
10261	"RTN","BPS SCRCV",111 ,0)
10262	I BPINP=- 1 Q ;quit due to ti meout or ^
10263	"RTN","BPS SCRCV",112 ,0)
10264	S BPTF=$P (BPINP,U,2 )
10265	"RTN","BPS SCRCV",113 ,0)
10266	Q:$$EDITF LD(1.05,+B PDUZ7,"N^1 :999:0","A ctivity Ti meframe Va lue",$S(BP TF="H":24, 1:7),.BPAR R)=-1
10267	"RTN","BPS SCRCV",114 ,0)
10268	Q:$$EDITF LD(2.02,+B PDUZ7,"S^O :OPEN CLAI MS;C:CLOSE D CLAIMS;A :ALL","Sel ect Open/C losed or A ll Claims" ,"O",.BPAR R)=-1
10269	"RTN","BPS SCRCV",115 ,0)
10270	Q:$$EDITF LD(1.19,+B PDUZ7,"S^O :Open Non- Billable E ntries;C:C losed Non- Billable E ntries;A:A LL","Displ ay (O)pen or (C)lose d or (A)ll Non-Billa ble Entrie s","A",.BP ARR)=-1
10271	"RTN","BPS SCRCV",116 ,0)
10272	Q:$$EDITF LD(2.03,+B PDUZ7,"S^B :BILLING R EQUESTS;R: REVERSALS; A:ALL","Se lect Submi ssion Type ","A",.BPA RR)=-1
10273	"RTN","BPS SCRCV",117 ,0)
10274	Q:$$EDITF LD(1.06,+B PDUZ7,"S^R :REJECTS;P :PAYABLES; U:UNSTRAND ED;A:ALL", "Display ( R)ejects o r (P)ayabl es or (U)n stranded o r (A)LL"," REJECTS",. BPARR)=-1
10275	"RTN","BPS SCRCV",118 ,0)
10276	Q:$$EDITF LD(1.07,+B PDUZ7,"S^R :RELEASED; N:NON-RELE ASED;A:ALL ","Display (R)elease d Rxs or ( N)on-Relea sed Rxs or (A)LL","R ELEASED",. BPARR)=-1
10277	"RTN","BPS SCRCV",119 ,0)
10278	Q:$$EDITF LD(1.08,+B PDUZ7,"S^C :CMOP;M:MA IL;W:WINDO W;A:ALL"," Display (C )MOP or (M )ail or (W )indow or (A)LL","AL L",.BPARR) =-1
10279	"RTN","BPS SCRCV",120 ,0)
10280	Q:$$EDITF LD(1.09,+B PDUZ7,"S^R :REALTIME; B:BACKBILL S;P:PRO OP TION;S:RES UBMISSION; A:ALL","Di splay (R)e alTime, (B )ackbills, (P)RO Opt ion, Re(S) ubmission or (A)LL", "ALL",.BPA RR)=-1
10281	"RTN","BPS SCRCV",121 ,0)
10282	S BPQ=0 F D Q:BPQ '=0
10283	"RTN","BPS SCRCV",122 ,0)
10284	. S BPINP =$$EDITFLD (1.1,+BPDU Z7,"S^R:RE JECT CODE; A:ALL","Di splay Spec ific (R)ej ect Code o r (A)LL"," ALL",.BPAR R)
10285	"RTN","BPS SCRCV",123 ,0)
10286	. S:BPINP =-1 BPQ=-1 S:$P(BPIN P,U,2)="A" BPQ=1 I B PQ'=0 Q
10287	"RTN","BPS SCRCV",124 ,0)
10288	. S BPINP =$$EDITFLD (1.15,+BPD UZ7,"P^BPS F(9002313. 93,","Sele ct Reject Code","",. BPARR)
10289	"RTN","BPS SCRCV",125 ,0)
10290	. S:BPINP =-1 BPQ=-1 S:$P(BPIN P,U,2)'="" BPQ=1 I B PQ'=0 Q
10291	"RTN","BPS SCRCV",126 ,0)
10292	Q:BPQ=-1 ;quit due to timeou t or ^
10293	"RTN","BPS SCRCV",127 ,0)
10294	Q:$$INSUR SEL^BPSSCR CU(.BPARR, +BPDUZ7)=- 1
10295	"RTN","BPS SCRCV",128 ,0)
10296	Q
10297	"RTN","BPS SCRCV",129 ,0)
10298	;
10299	"RTN","BPS SCRCV",130 ,0)
10300	ERRMSG(BPM SG) ;
10301	"RTN","BPS SCRCV",131 ,0)
10302	W !,"*" ,BPMSG," *",!
10303	"RTN","BPS SCRCV",132 ,0)
10304	D PAUSE^V ALM1
10305	"RTN","BPS SCRCV",133 ,0)
10306	Q
10307	"RTN","BPS SCRCV",134 ,0)
10308	;/**
10309	"RTN","BPS SCRCV",135 ,0)
10310	;FLDNO - PARAMETERS INSTANCE
10311	"RTN","BPS SCRCV",136 ,0)
10312	;RECIEN - User DUZ
10313	"RTN","BPS SCRCV",137 ,0)
10314	;DIR0 - l ike DIR(0) node for ^DIR - i.e . field ty pe, etc
10315	"RTN","BPS SCRCV",138 ,0)
10316	;PRMTMSG - user pro mpt
10317	"RTN","BPS SCRCV",139 ,0)
10318	;DFLTVAL - pass the default v alue for t he case if there is no value i n database
10319	"RTN","BPS SCRCV",140 ,0)
10320	;BPARRAY - array to store and change va lues in pr ofile
10321	"RTN","BPS SCRCV",141 ,0)
10322	;returns:
10323	"RTN","BPS SCRCV",142 ,0)
10324	;as retur n value:
10325	"RTN","BPS SCRCV",143 ,0)
10326	; "1^valu e" - if se lected
10327	"RTN","BPS SCRCV",144 ,0)
10328	; "-1" if timeout o r uparrow
10329	"RTN","BPS SCRCV",145 ,0)
10330	;via BPAR RAY
10331	"RTN","BPS SCRCV",146 ,0)
10332	; BPARRAY (filedno)= value
10333	"RTN","BPS SCRCV",147 ,0)
10334	EDITFLD(FL DNO,RECIEN ,DIR0,PRMT MSG,DFLTVA L,BPARRAY) ;*/
10335	"RTN","BPS SCRCV",148 ,0)
10336	N DIR,RET V,RETARR
10337	"RTN","BPS SCRCV",149 ,0)
10338	N RECIENS ,FDA,LCK,E RRARR
10339	"RTN","BPS SCRCV",150 ,0)
10340	S RETV=$$ GETPARAM^B PSSCRSL(FL DNO,RECIEN )
10341	"RTN","BPS SCRCV",151 ,0)
10342	I FLDNO=1 .17 S RETV =$P($G(^DP T(+RETV,0) ),U)
10343	"RTN","BPS SCRCV",152 ,0)
10344	;Use the External C ode from F ile #90023 13.93 as t he default value to display to user.
10345	"RTN","BPS SCRCV",153 ,0)
10346	I FLDNO=1 .15 S RETV =$P($G(^BP SF(9002313 .93,+RETV, 0)),U)
10347	"RTN","BPS SCRCV",154 ,0)
10348	;if data then use i t, otherwi se use dat a from par ameter
10349	"RTN","BPS SCRCV",155 ,0)
10350	I $L($G(R ETV))>0 S DFLTVAL=RE TV E S DF LTVAL=$G(D FLTVAL)
10351	"RTN","BPS SCRCV",156 ,0)
10352	;prompt t he user
10353	"RTN","BPS SCRCV",157 ,0)
10354	S RETV=$$ PROMPT(DIR 0,PRMTMSG, DFLTVAL)
10355	"RTN","BPS SCRCV",158 ,0)
10356	Q:RETV<0 -1
10357	"RTN","BPS SCRCV",159 ,0)
10358	;save it in the dat abase
10359	"RTN","BPS SCRCV",160 ,0)
10360	S BPARRAY (FLDNO)=RE TV
10361	"RTN","BPS SCRCV",161 ,0)
10362	Q "1^"_RE TV
10363	"RTN","BPS SCRCV",162 ,0)
10364	;
10365	"RTN","BPS SCRCV",163 ,0)
10366	;
10367	"RTN","BPS SCRCV",164 ,0)
10368	FILEIT(FIL ENO,FLDNO, RECIEN,NEW VAL) ;
10369	"RTN","BPS SCRCV",165 ,0)
10370	N RECIENS
10371	"RTN","BPS SCRCV",166 ,0)
10372	S RECIENS =RECIEN_", "
10373	"RTN","BPS SCRCV",167 ,0)
10374	S FDA(FIL ENO,RECIEN S,FLDNO)=N EWVAL
10375	"RTN","BPS SCRCV",168 ,0)
10376	L +^BPS(F ILENO,RECI EN,1):10 S LCK=$T I 'LCK Q "0^ "_NEWVAL_" ^LOCKED" ;quit
10377	"RTN","BPS SCRCV",169 ,0)
10378	D FILE^DI E("","FDA" ,"ERRARR")
10379	"RTN","BPS SCRCV",170 ,0)
10380	I LCK L - ^BPS(FILEN O,RECIEN,1 )
10381	"RTN","BPS SCRCV",171 ,0)
10382	I $D(ERRA RR) Q "0^" _NEWVAL_"^ "_ERRARR(" DIERR",1," TEXT",1)
10383	"RTN","BPS SCRCV",172 ,0)
10384	Q "1^"_NE WVAL
10385	"RTN","BPS SCRCV",173 ,0)
10386	;
10387	"RTN","BPS SCRCV",174 ,0)
10388	;prompts for select ion
10389	"RTN","BPS SCRCV",175 ,0)
10390	;returns selection
10391	"RTN","BPS SCRCV",176 ,0)
10392	;OR -1 wh en timeout and uparr ow
10393	"RTN","BPS SCRCV",177 ,0)
10394	PROMPT(ZER ONODE,PRMT MSG,DFLTVA L) ;
10395	"RTN","BPS SCRCV",178 ,0)
10396	N Y,DUOUT ,DTOUT,BPQ UIT,DIROUT
10397	"RTN","BPS SCRCV",179 ,0)
10398	S BPQUIT= 0
10399	"RTN","BPS SCRCV",180 ,0)
10400	I $E(ZERO NODE,1,1)= "P" D
10401	"RTN","BPS SCRCV",181 ,0)
10402	. N DIC
10403	"RTN","BPS SCRCV",182 ,0)
10404	. S DIC=" ^"_$P(ZERO NODE,U,2)
10405	"RTN","BPS SCRCV",183 ,0)
10406	. S DIC(0 )="AEMNQ"
10407	"RTN","BPS SCRCV",184 ,0)
10408	. S:$L($G (DFLTVAL)) >0 DIC("B" )=DFLTVAL
10409	"RTN","BPS SCRCV",185 ,0)
10410	. S DIC(" A")=PRMTMS G_": "
10411	"RTN","BPS SCRCV",186 ,0)
10412	. D ^DIC
10413	"RTN","BPS SCRCV",187 ,0)
10414	. I (Y=-1 )!$D(DUOUT )!$D(DTOUT ) S BPQUIT =1
10415	"RTN","BPS SCRCV",188 ,0)
10416	E D
10417	"RTN","BPS SCRCV",189 ,0)
10418	. N DIR
10419	"RTN","BPS SCRCV",190 ,0)
10420	. S DIR(0 )=ZERONODE
10421	"RTN","BPS SCRCV",191 ,0)
10422	. S DIR(" A")=PRMTMS G
10423	"RTN","BPS SCRCV",192 ,0)
10424	. S:$L($G (DFLTVAL)) >0 DIR("B" )=DFLTVAL
10425	"RTN","BPS SCRCV",193 ,0)
10426	. ;
10427	"RTN","BPS SCRCV",194 ,0)
10428	. ; displ ay some ex tra text f or FLDNO=1 .19 (BPS 120)
10429	"RTN","BPS SCRCV",195 ,0)
10430	. I $G(FL DNO)=1.19 D
10431	"RTN","BPS SCRCV",196 ,0)
10432	.. S DIR( "A",1)=" Please n ote this q uestion on ly applies to"
10433	"RTN","BPS SCRCV",197 ,0)
10434	.. S DIR( "A",2)=" TRICARE or CHAMPVA Non-Billa ble Entrie s."
10435	"RTN","BPS SCRCV",198 ,0)
10436	.. S DIR( "A",3)=" "
10437	"RTN","BPS SCRCV",199 ,0)
10438	.. Q
10439	"RTN","BPS SCRCV",200 ,0)
10440	. ;
10441	"RTN","BPS SCRCV",201 ,0)
10442	. D ^DIR
10443	"RTN","BPS SCRCV",202 ,0)
10444	. I (Y=-1 )!$D(DIROU T)!$D(DUOU T)!$D(DTOU T) S BPQUI T=1
10445	"RTN","BPS SCRCV",203 ,0)
10446	I BPQUIT= 1 Q -1
10447	"RTN","BPS SCRCV",204 ,0)
10448	Q $P(Y,U)
10449	"RTN","BPS SCRCV",205 ,0)
10450	;
10451	"RTN","BPS SCRCV",206 ,0)
10452	GETFLD(FIL ENO,FLDNO, RECIEN) ;
10453	"RTN","BPS SCRCV",207 ,0)
10454	N RETV,RE TARR
10455	"RTN","BPS SCRCV",208 ,0)
10456	N RECIENS
10457	"RTN","BPS SCRCV",209 ,0)
10458	S RECIENS =RECIEN_", "
10459	"RTN","BPS SCRCV",210 ,0)
10460	; first t ry to get the value from file
10461	"RTN","BPS SCRCV",211 ,0)
10462	D GETS^DI Q(FILENO,R ECIENS,FLD NO,"E","RE TARR")
10463	"RTN","BPS SCRCV",212 ,0)
10464	S RETV=$G (RETARR(FI LENO,RECIE NS,FLDNO," E"))
10465	"RTN","BPS SCRCV",213 ,0)
10466	Q $G(RETV )
10467	"RTN","BPS SCRCV",214 ,0)
10468	;
10469	"RTN","BPS SCRCV",215 ,0)
10470	;save all profile a rray to fi le
10471	"RTN","BPS SCRCV",216 ,0)
10472	;BPARRAY - arrays w ith pointe rs to 9002 313.56
10473	"RTN","BPS SCRCV",217 ,0)
10474	;BPDUZ7 - DUZ
10475	"RTN","BPS SCRCV",218 ,0)
10476	FILEALL(BP ARRAY,BPDU Z7) ;
10477	"RTN","BPS SCRCV",219 ,0)
10478	;BPS*14 - RRA chang ed API, be cause prev iously it was re-wri ting Divis ion
10479	"RTN","BPS SCRCV",220 ,0)
10480	;and Insu rance para meter rega rdless if it was mod ified and had a valu e
10481	"RTN","BPS SCRCV",221 ,0)
10482	;ticket 3 37299
10483	"RTN","BPS SCRCV",222 ,0)
10484	N BPFLD,B P2
10485	"RTN","BPS SCRCV",223 ,0)
10486	S BPFLD=0
10487	"RTN","BPS SCRCV",224 ,0)
10488	F S BPFL D=$O(BPARR AY(BPFLD)) Q:$G(BPFL D)="" D
10489	"RTN","BPS SCRCV",225 ,0)
10490	. I BPFLD ="DIVS" I $$SAVEPAR^ BPSSCRSL(2 ,BPDUZ7,$G (BPARRAY(" DIVS")))
10491	"RTN","BPS SCRCV",226 ,0)
10492	. I BPFLD ="INS" I $ $SAVEPAR^B PSSCRSL(2. 04,BPDUZ7, $G(BPARRAY ("INS")))
10493	"RTN","BPS SCRCV",227 ,0)
10494	. Q:+BPFL D=0 I $$S AVEPAR^BPS SCRSL(BPFL D,+BPDUZ7, $G(BPARRAY (BPFLD)))
10495	"RTN","BPS SCRCV",228 ,0)
10496	;I $$SAVE PAR^BPSSCR SL(2,BPDUZ 7,$G(BPARR AY("DIVS") ))
10497	"RTN","BPS SCRCV",229 ,0)
10498	;I $$SAVE PAR^BPSSCR SL(2.04,BP DUZ7,$G(BP ARRAY("INS ")))
10499	"RTN","BPS SCRCV",230 ,0)
10500	Q
10501	"RTN","BPS SCRL1")
10502	0^10^B6657 6750
10503	"RTN","BPS SCRL1",1,0 )
10504	BPSSCRL1 ; AITC/CKB - ECME LOGI NFO ;06/01 /2017
10505	"RTN","BPS SCRL1",2,0 )
10506	;;1.0;E C LAIMS MGMT ENGINE; 22;;Buil d 15
10507	"RTN","BPS SCRL1",3,0 )
10508	;;Per VA Directive 6402, this routine s hould not be modifie d.
10509	"RTN","BPS SCRL1",4,0 )
10510	;
10511	"RTN","BPS SCRL1",5,0 )
10512	; Moved f rom BPSSCR LG
10513	"RTN","BPS SCRL1",6,0 )
10514	Q
10515	"RTN","BPS SCRL1",7,0 )
10516	;
10517	"RTN","BPS SCRL1",8,0 )
10518	PREPINFO(B PLN,BPDFN, BP36,BP59) ;
10519	"RTN","BPS SCRL1",9,0 )
10520	;input:
10521	"RTN","BPS SCRL1",10, 0)
10522	; BPDFN: patient ie n #2
10523	"RTN","BPS SCRL1",11, 0)
10524	; BP36: i nsurance i en #36
10525	"RTN","BPS SCRL1",12, 0)
10526	; BP59: p tr to #900 2313.59
10527	"RTN","BPS SCRL1",13, 0)
10528	; returns # of line s
10529	"RTN","BPS SCRL1",14, 0)
10530	N BPSECME
10531	"RTN","BPS SCRL1",15, 0)
10532	I '$G(BP5 9) Q 0
10533	"RTN","BPS SCRL1",16, 0)
10534	I '$G(BP3 6) Q 0
10535	"RTN","BPS SCRL1",17, 0)
10536	I '$G(BPD FN) Q 0
10537	"RTN","BPS SCRL1",18, 0)
10538	N BPSCRLN S S BPSCRL NS=17 ;(se e "BPS LST MN LOG" LM template: Bottom=21 , Top = 4, 21-4=17)
10539	"RTN","BPS SCRL1",19, 0)
10540	N BPX,BPR XIEN,BPRXN ,BPREF,BP1 ,BPLSTCLM, BPLSTRSP,B PDAT59,BPU SR,BPSTRT, BPHIST,BPQ
10541	"RTN","BPS SCRL1",20, 0)
10542	N BPDT,BP LN0,BPCNT, DFN,VADM
10543	"RTN","BPS SCRL1",21, 0)
10544	S DFN=BPD FN D DEM^V ADPT
10545	"RTN","BPS SCRL1",22, 0)
10546	S BP1=$$R XREF^BPSSC RU2(BP59)
10547	"RTN","BPS SCRL1",23, 0)
10548	S BPRXIEN =$P(BP1,U, 1)
10549	"RTN","BPS SCRL1",24, 0)
10550	S BPRXN=$ $RXNUM^BPS SCRU2(+BPR XIEN)
10551	"RTN","BPS SCRL1",25, 0)
10552	S BPREF=$ P(BP1,U,2)
10553	"RTN","BPS SCRL1",26, 0)
10554	S BPDAT59 (0)=$G(^BP ST(BP59,0) )
10555	"RTN","BPS SCRL1",27, 0)
10556	;create h istory
10557	"RTN","BPS SCRL1",28, 0)
10558	D MKHIST^ BPSSCRU5(B P59,.BPHIS T)
10559	"RTN","BPS SCRL1",29, 0)
10560	;
10561	"RTN","BPS SCRL1",30, 0)
10562	S BPLN0=B PLN
10563	"RTN","BPS SCRL1",31, 0)
10564	D SETLINE ^BPSSCRLG( .BPLN,"Pha rmacy ECME Log")
10565	"RTN","BPS SCRL1",32, 0)
10566	D SETLINE ^BPSSCRLG( .BPLN,"")
10567	"RTN","BPS SCRL1",33, 0)
10568	S BPX=$$R J^BPSSCR02 ("Rx #: ", 20)_BPRXN_ "/"_BPREF
10569	"RTN","BPS SCRL1",34, 0)
10570	S BPSECME =$$ECMENUM ^BPSSCRU2( BP59)
10571	"RTN","BPS SCRL1",35, 0)
10572	S BPX=BPX _$$RJ^BPSS CR02("ECME #: ",20)_ BPSECME
10573	"RTN","BPS SCRL1",36, 0)
10574	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10575	"RTN","BPS SCRL1",37, 0)
10576	S BPX=$$R J^BPSSCR02 ("Drug: ", 20)_$$DRGN AM^BPSSCRU 2($$GETDRG 59^BPSSCRU 2(BP59))
10577	"RTN","BPS SCRL1",38, 0)
10578	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10579	"RTN","BPS SCRL1",39, 0)
10580	S BPX=$$R J^BPSSCR02 ("Patient: ",20)
10581	"RTN","BPS SCRL1",40, 0)
10582	S BPX=BPX _$$LJ^BPSS CR02($$PAT NAME^BPSSC RU2(BPDFN) _" "_$$SSN 4^BPSSCRU2 (BPDFN),25 )
10583	"RTN","BPS SCRL1",41, 0)
10584	S BPX=BPX _$$LJ^BPSS CR02("Sex: "_$P($G(V ADM(5)),"^ ",1),10)
10585	"RTN","BPS SCRL1",42, 0)
10586	S BPX=BPX _$$LJ^BPSS CR02("DOB: "_$P($G(V ADM(3)),"^ ",2)_"("_$ G(VADM(4)) _")",20)
10587	"RTN","BPS SCRL1",43, 0)
10588	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10589	"RTN","BPS SCRL1",44, 0)
10590	S BPX=$$R J^BPSSCR02 ("Transact ion Number : ",20)
10591	"RTN","BPS SCRL1",45, 0)
10592	S BPX=BPX _$P($G(^BP ST(BP59,0) ),U,1)
10593	"RTN","BPS SCRL1",46, 0)
10594	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10595	"RTN","BPS SCRL1",47, 0)
10596	S BPX=$$R J^BPSSCR02 ("Last Sub mitted: ", 20)
10597	"RTN","BPS SCRL1",48, 0)
10598	S BPSTRT= $P(BPDAT59 (0),U,11) ;@# need t o check wi th analyst if this i s a START DATE
10599	"RTN","BPS SCRL1",49, 0)
10600	I BPSTRT] "" S BPX=B PX_$$DATET IME^BPSSCR U5(BPSTRT)
10601	"RTN","BPS SCRL1",50, 0)
10602	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10603	"RTN","BPS SCRL1",51, 0)
10604	S BPX=$$R J^BPSSCR02 ("Last Sub mitted By: ",20)
10605	"RTN","BPS SCRL1",52, 0)
10606	S BPUSR=$ P(BPDAT59( 0),U,10)
10607	"RTN","BPS SCRL1",53, 0)
10608	I BPUSR]" " S BPX=BP X_$$GETUSR NM^BPSSCRU 1(BPUSR)
10609	"RTN","BPS SCRL1",54, 0)
10610	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10611	"RTN","BPS SCRL1",55, 0)
10612	;
10613	"RTN","BPS SCRL1",56, 0)
10614	;latest c laim
10615	"RTN","BPS SCRL1",57, 0)
10616	S BP1=+$O (BPHIST("C ",99999999 ),-1)
10617	"RTN","BPS SCRL1",58, 0)
10618	I BP1=0 D SETLINE^B PSSCRLG(.B PLN,""),SE TLINE^BPSS CRLG(.BPLN ,"------ N o electron ic claims ------") Q BPLN
10619	"RTN","BPS SCRL1",59, 0)
10620	S BP1=+$O (BPHIST("C ",BP1,0))
10621	"RTN","BPS SCRL1",60, 0)
10622	S BPX=$$R J^BPSSCR02 ("Last VA Claim #: " ,20)_$P($G (^BPSC(+BP 1,0)),U,1)
10623	"RTN","BPS SCRL1",61, 0)
10624	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10625	"RTN","BPS SCRL1",62, 0)
10626	F BPCNT=B PLN:1:BPLN 0+BPSCRLNS D SETLINE ^BPSSCRLG( .BPLN,"")
10627	"RTN","BPS SCRL1",63, 0)
10628	;process history
10629	"RTN","BPS SCRL1",64, 0)
10630	N BPTYPE, BPIEN,BPIE NRS
10631	"RTN","BPS SCRL1",65, 0)
10632	S BPDT=99 999999
10633	"RTN","BPS SCRL1",66, 0)
10634	F S BPDT =$O(BPHIST ("C",BPDT) ,-1) Q:+BP DT=0 D
10635	"RTN","BPS SCRL1",67, 0)
10636	. S BPIEN =+$O(BPHIS T("C",BPDT ,0)) Q:BPI EN=""
10637	"RTN","BPS SCRL1",68, 0)
10638	. D DISPC LM(.BPLN,B P59,BPIEN, +BPHIST("C ",BPDT,BPI EN),$P(BPH IST("C",BP DT,BPIEN), U,2),BPDT)
10639	"RTN","BPS SCRL1",69, 0)
10640	. S BPIEN RS=0
10641	"RTN","BPS SCRL1",70, 0)
10642	. F S BP IENRS=$O(B PHIST("C", BPDT,BPIEN ,"R",BPIEN RS)) Q:+BP IENRS=0 D
10643	"RTN","BPS SCRL1",71, 0)
10644	. . D DIS PRSP(.BPLN ,BP59,BPIE NRS,+BPHIS T("C",BPDT ,BPIEN,"R" ,BPIENRS), $P(BPHIST( "C",BPDT,B PIEN,"R",B PIENRS),U, 2),BPDT)
10645	"RTN","BPS SCRL1",72, 0)
10646	. . D DIS PPYR^BPSSC RLG(.BPLN, BPIENRS)
10647	"RTN","BPS SCRL1",73, 0)
10648	Q BPLN
10649	"RTN","BPS SCRL1",74, 0)
10650	;
10651	"RTN","BPS SCRL1",75, 0)
10652	;display claim reco rd
10653	"RTN","BPS SCRL1",76, 0)
10654	DISPCLM(BP LN,BP59,BP IEN02,BP57 ,BPSTYPE,B PSDTALT) ;
10655	"RTN","BPS SCRL1",77, 0)
10656	N BPSCRLN S S BPSCRL NS=17 ;(se e "BPS LST MN LOG" LM template: Bottom=21 , Top = 4, 21-4=17)
10657	"RTN","BPS SCRL1",78, 0)
10658	N BPX,BPL N0,BPCNT,B PSTR1,BPST YP2,BPNFLD T
10659	"RTN","BPS SCRL1",79, 0)
10660	S BPLN0=B PLN
10661	"RTN","BPS SCRL1",80, 0)
10662	S BPSTYP2 =$S(BPSTYP E="C":"CLA IM REQUEST ",BPSTYPE= "R":"REVER SAL",1:"")
10663	"RTN","BPS SCRL1",81, 0)
10664	S BPSTR1= "Transmiss ion Inform ation ("_B PSTYP2_")( #"_BPIEN02 _")"
10665	"RTN","BPS SCRL1",82, 0)
10666	D SETLINE ^BPSSCRLG( .BPLN,BPST R1_$$LINE^ BPSSCRU3(7 9-$L(BPSTR 1),"-"))
10667	"RTN","BPS SCRL1",83, 0)
10668	D SETLINE ^BPSSCRLG( .BPLN,"Cre ated on: " _$$CREATED T^BPSSCRLG (BPIEN02,B PSDTALT))
10669	"RTN","BPS SCRL1",84, 0)
10670	D SETLINE ^BPSSCRLG( .BPLN,"VA Claim ID: "_$P($G(^B PSC(+BPIEN 02,0)),U,1 ))
10671	"RTN","BPS SCRL1",85, 0)
10672	D SETLINE ^BPSSCRLG( .BPLN,"Sub mitted By: "_$$SUBMT BY^BPSSCRL G(BP57))
10673	"RTN","BPS SCRL1",86, 0)
10674	D SETLINE ^BPSSCRLG( .BPLN,"Tra nsaction T ype: "_$$T RTYPE^BPSS CRU5($$TRC ODE^BPSSCR LG(BPIEN02 )))
10675	"RTN","BPS SCRL1",87, 0)
10676	D SETLINE ^BPSSCRLG( .BPLN,"Dat e of Servi ce: "_$$DO SCLM^BPSSC RLG(BPIEN0 2))
10677	"RTN","BPS SCRL1",88, 0)
10678	;Display Next Avail able Fill Date - BPS 1.015
10679	"RTN","BPS SCRL1",89, 0)
10680	S BPNFLDT =$$NFLDT^B PSBUTL(BPR XIEN,BPREF ,$$RXCOB57 ^BPSSCRLG( BP57))
10681	"RTN","BPS SCRL1",90, 0)
10682	D:BPNFLDT SETLINE^B PSSCRLG(.B PLN,"Next Available Fill Date: "_$$FMTE^ XLFDT(BPNF LDT,"2ZM") )
10683	"RTN","BPS SCRL1",91, 0)
10684	D SETLINE ^BPSSCRLG( .BPLN,"NDC Code: "_$ $LNDC^BPSS CRU5(BPIEN 02))
10685	"RTN","BPS SCRL1",92, 0)
10686	D SETLINE ^BPSSCRLG( .BPLN,"NCP DP Qty: "_ $$QTY^BPSS CRLG(BPIEN 02)_" "_$$ UNITS^BPSS CRLG(BPIEN 02))
10687	"RTN","BPS SCRL1",93, 0)
10688	D SETLINE ^BPSSCRLG( .BPLN,"Day s Supply: "_$$DAYSSU PL^BPSSCRL G(BPIEN02) )
10689	"RTN","BPS SCRL1",94, 0)
10690	D SETLINE ^BPSSCRLG( .BPLN,"Div ision: "_$ $DIV^BPSSC RLG(BP57))
10691	"RTN","BPS SCRL1",95, 0)
10692	D SETLINE ^BPSSCRLG( .BPLN,"NPI #: "_$$NPI ^BPSSCRLG( BPIEN02))
10693	"RTN","BPS SCRL1",96, 0)
10694	D SETLINE ^BPSSCRLG( .BPLN,"ECM E Pharmacy : "_$$DIVN AME^BPSSCR DS($$LDIV^ BPSSCRLG(B P57)))
10695	"RTN","BPS SCRL1",97, 0)
10696	S BPX="Bi lled Qty: "_$$BILLQT Y^BPSSCRLG (BP57)_" " _$$BILLUNT ^BPSSCRLG( BP57)
10697	"RTN","BPS SCRL1",98, 0)
10698	S BPX=BPX _" Uni t Cost: "_ $$UNTPRICE ^BPSSCRLG( BP57)
10699	"RTN","BPS SCRL1",99, 0)
10700	S BPX=BPX _" Gro ss Amt Due : "_$$TOTP RICE^BPSSC RLG(BPIEN0 2)
10701	"RTN","BPS SCRL1",100 ,0)
10702	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10703	"RTN","BPS SCRL1",101 ,0)
10704	S BPX="In gredient C ost: "_$$I NGRCST^BPS SCRLG(BPIE N02)
10705	"RTN","BPS SCRL1",102 ,0)
10706	S BPX=BPX _" Dis pensing Fe e: "_$$DIS PFEE^BPSSC RLG(BPIEN0 2)
10707	"RTN","BPS SCRL1",103 ,0)
10708	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10709	"RTN","BPS SCRL1",104 ,0)
10710	S BPX="U& C Charge: "_$$UCCHRG ^BPSSCRLG( BPIEN02)
10711	"RTN","BPS SCRL1",105 ,0)
10712	S BPX=BPX _" Adm in Fee: "_ $$ADMNFEE^ BPSSCRLG(B PIEN02)
10713	"RTN","BPS SCRL1",106 ,0)
10714	D SETLINE ^BPSSCRLG( .BPLN,BPX)
10715	"RTN","BPS SCRL1",107 ,0)
10716	D SETLINE ^BPSSCRLG( .BPLN,"")
10717	"RTN","BPS SCRL1",108 ,0)
10718	D SETLINE ^BPSSCRLG( .BPLN,"Ins urance Nam e: "_$$INS UR57^BPSSC RLG(BP57))
10719	"RTN","BPS SCRL1",109 ,0)
10720	D SETLINE ^BPSSCRLG( .BPLN,"Gro up Name: " _$$GRPNM^B PSSCRLG(BP IEN02))
10721	"RTN","BPS SCRL1",110 ,0)
10722	D SETLINE ^BPSSCRLG( .BPLN,"Rx Coordinati on of Bene fits: "_$$ RXCOB57^BP SSCRLG(BP5 7))
10723	"RTN","BPS SCRL1",111 ,0)
10724	D SETLINE ^BPSSCRLG( .BPLN,"Pha rmacy Plan ID: "_$$P HPLANID^BP SSCRLG(BP5 7))
10725	"RTN","BPS SCRL1",112 ,0)
10726	D SETLINE ^BPSSCRLG( .BPLN,"BIN : "_$$BIN^ BPSSCRLG(B PIEN02))
10727	"RTN","BPS SCRL1",113 ,0)
10728	D SETLINE ^BPSSCRLG( .BPLN,"PCN : "_$$PCN^ BPSSCRLG(B PIEN02))
10729	"RTN","BPS SCRL1",114 ,0)
10730	D SETLINE ^BPSSCRLG( .BPLN,"NCP DP Version : "_$$GETV ER^BPSSCRL G(BPIEN02) )
10731	"RTN","BPS SCRL1",115 ,0)
10732	D SETLINE ^BPSSCRLG( .BPLN,"Gro up ID: "_$ $GRPID^BPS SCRLG(BPIE N02))
10733	"RTN","BPS SCRL1",116 ,0)
10734	D SETLINE ^BPSSCRLG( .BPLN,"Car dholder ID : "_$$CRDH LDID^BPSSC RLG(BPIEN0 2))
10735	"RTN","BPS SCRL1",117 ,0)
10736	D SETLINE ^BPSSCRLG( .BPLN,"Pat ient Relat ionship Co de: "_$$PA TRELSH^BPS SCRLG(BPIE N02))
10737	"RTN","BPS SCRL1",118 ,0)
10738	D SETLINE ^BPSSCRLG( .BPLN,"Car dholder Fi rst Name: "_$$CRDHLD FN^BPSSCRL G(BPIEN02, BP57))
10739	"RTN","BPS SCRL1",119 ,0)
10740	D SETLINE ^BPSSCRLG( .BPLN,"Car dholder La st Name: " _$$CRDHLDL N^BPSSCRLG (BPIEN02,B P57))
10741	"RTN","BPS SCRL1",120 ,0)
10742	; BPS12 2
10743	"RTN","BPS SCRL1",121 ,0)
10744	D SETLINE ^BPSSCRLG( .BPLN,"Fac ility ID Q ualifier: "_$$FACIDQ ^BPSSCRLG( BPIEN02))
10745	"RTN","BPS SCRL1",122 ,0)
10746	F BPCNT=B PLN:1:BPLN 0+BPSCRLNS D SETLINE ^BPSSCRLG( .BPLN,"")
10747	"RTN","BPS SCRL1",123 ,0)
10748	S BPLN0=B PLN
10749	"RTN","BPS SCRL1",124 ,0)
10750	D SETLINE ^BPSSCRLG( .BPLN,"Bil ling Reque st Payer S heet: "_$$ B1PYRIEN^B PSSCRU5(BP 57))
10751	"RTN","BPS SCRL1",125 ,0)
10752	D SETLINE ^BPSSCRLG( .BPLN,"Rev ersal Paye r Sheet: " _$$B2PYRIE N^BPSSCRU5 (BP57))
10753	"RTN","BPS SCRL1",126 ,0)
10754	D SETLINE ^BPSSCRLG( .BPLN,"VA Claim ID: "_$P($G(^B PSC(+BPIEN 02,0)),U,1 ))
10755	"RTN","BPS SCRL1",127 ,0)
10756	D SETLINE ^BPSSCRLG( .BPLN,"")
10757	"RTN","BPS SCRL1",128 ,0)
10758	Q
10759	"RTN","BPS SCRL1",129 ,0)
10760	;
10761	"RTN","BPS SCRL1",130 ,0)
10762	;display response r ecord
10763	"RTN","BPS SCRL1",131 ,0)
10764	DISPRSP(BP LN,BP59,BP IEN03,BP57 ,BPSTYPE,B PSDTALT) ;
10765	"RTN","BPS SCRL1",132 ,0)
10766	N BPSCRLN S S BPSCRL NS=17 ;(se e "BPS LST MN LOG" LM template: Bottom=21 , Top = 4, 21-4=17)
10767	"RTN","BPS SCRL1",133 ,0)
10768	N BPX,BPL N0,BPCNT,B PRJCDS,BPR J,BPSTR1,B PSTYP2,BDU R,BMSG,PTR ESP
10769	"RTN","BPS SCRL1",134 ,0)
10770	S BPLN0=B PLN
10771	"RTN","BPS SCRL1",135 ,0)
10772	S BPSTYP2 =$S(BPSTYP E="C":"CLA IM REQUEST ",BPSTYPE= "R":"REVER SAL",1:"")
10773	"RTN","BPS SCRL1",136 ,0)
10774	S BPSTR1= "Response Informatio n ("_BPST YP2_")(#"_ BPIEN03_") "
10775	"RTN","BPS SCRL1",137 ,0)
10776	D SETLINE ^BPSSCRLG( .BPLN,BPST R1_$$LINE^ BPSSCRU3(7 9-$L(BPSTR 1),"-"))
10777	"RTN","BPS SCRL1",138 ,0)
10778	D SETLINE ^BPSSCRLG( .BPLN,"Res ponse Rece ived: "_$$ RESPREC^BP SSCRLG(BPI EN03,BPSDT ALT))
10779	"RTN","BPS SCRL1",139 ,0)
10780	D SETLINE ^BPSSCRLG( .BPLN,"Dat e of Servi ce: "_$$DO SRSP^BPSSC RLG(BPIEN0 3))
10781	"RTN","BPS SCRL1",140 ,0)
10782	D SETLINE ^BPSSCRLG( .BPLN,"Tra nsaction R esponse St atus: "_$$ RESPSTAT^B PSSCRU5(BP IEN03))
10783	"RTN","BPS SCRL1",141 ,0)
10784	D SETLINE ^BPSSCRLG( .BPLN,"Tot al Amount Paid: $"_$ $TOTAMNT^B PSSCRLG(BP IEN03))
10785	"RTN","BPS SCRL1",142 ,0)
10786	D SETLINE ^BPSSCRLG( .BPLN,"Ing redient Co st Paid: $ "_$$ICPAID ^BPSSCRLG( BPIEN03)_" Dispens ing Fee Pa id: $"_$$D FPAID^BPSS CRLG(BPIEN 03))
10787	"RTN","BPS SCRL1",143 ,0)
10788	S PTRESP= $$PTRESP^B PSSCRLG(BP IEN03) S P TRESP=$S(P TRESP="":" $",PTRESP= "0.00":"$0 ",1:"($"_P TRESP_")")
10789	"RTN","BPS SCRL1",144 ,0)
10790	D SETLINE ^BPSSCRLG( .BPLN,"Pat ient Resp (INS): "_P TRESP)
10791	"RTN","BPS SCRL1",145 ,0)
10792	; BPS12 2
10793	"RTN","BPS SCRL1",146 ,0)
10794	D SETLINE ^BPSSCRLG( .BPLN,"Rec onciliatio n ID: "_$$ RECONID^BP SSCRLG(BPI EN03))
10795	"RTN","BPS SCRL1",147 ,0)
10796	D SETLINE ^BPSSCRLG( .BPLN,"Rej ect code(s ): ")
10797	"RTN","BPS SCRL1",148 ,0)
10798	D REJCODE S^BPSSCRU5 (BPIEN03,. BPRJCDS)
10799	"RTN","BPS SCRL1",149 ,0)
10800	S BPRJ=""
10801	"RTN","BPS SCRL1",150 ,0)
10802	F S BPRJ =$O(BPRJCD S(BPRJ)) Q :BPRJ="" D
10803	"RTN","BPS SCRL1",151 ,0)
10804	. D SETLI NE^BPSSCRL G(.BPLN," "_$$GETRJN AM^BPSSCRU 3(BPRJ))
10805	"RTN","BPS SCRL1",152 ,0)
10806	D WRAPLN^ BPSSCRU5(. BPLN,$$MES SAGE^BPSSC RLG(BPIEN0 3),76,"Pay er Message : ",5)
10807	"RTN","BPS SCRL1",153 ,0)
10808	D ADDMESS ^BPSSCRLG( BPIEN03,1, .BPADDMSG)
10809	"RTN","BPS SCRL1",154 ,0)
10810	S BMSG="" F S BMSG =$O(BPADDM SG(BMSG)) Q:BMSG="" D
10811	"RTN","BPS SCRL1",155 ,0)
10812	. D WRAPL N^BPSSCRU5 (.BPLN,BPA DDMSG(BMSG ),76,$S(BM SG=1:"Paye r Addition al Message : ",1:" "),5)
10813	"RTN","BPS SCRL1",156 ,0)
10814	D SETLINE ^BPSSCRLG( .BPLN,"Rea son for Se rvice Code : "_$$DURR EAS^BPSSCR LG(BPIEN03 ))
10815	"RTN","BPS SCRL1",157 ,0)
10816	D SETLINE ^BPSSCRLG( .BPLN,"DUR Text: "_$ $DURTEXT^B PSSCRLG(BP IEN03))
10817	"RTN","BPS SCRL1",158 ,0)
10818	D WRAPLN^ BPSSCRU5(. BPLN,$$DUR ADD^BPSSCR LG(BPIEN03 ),76,"DUR Additional Text: ",5 )
10819	"RTN","BPS SCRL1",159 ,0)
10820	; BPS11 8: Print Claim Log [BPS PRTCL USRSCR CL AIM LOG] ( when inclu ded in the incoming response)
10821	"RTN","BPS SCRL1",160 ,0)
10822	D SETLINE ^BPSSCRLG( .BPLN,"HPI D/OEID: "_ $$HPID^BPS SCRLG(BPIE N03,BP57))
10823	"RTN","BPS SCRL1",161 ,0)
10824	F BPCNT=1 :1:2 D SET LINE^BPSSC RLG(.BPLN, "")
10825	"RTN","BPS SCRL1",162 ,0)
10826	Q
10827	"RTN","BPS SCRL1",163 ,0)
10828	;
10829	"RTN","BPS SCRLG")
10830	0^9^B12797 4786
10831	"RTN","BPS SCRLG",1,0 )
10832	BPSSCRLG ; BHAM ISC/S S - ECME L OGINFO ;05 -APR-05
10833	"RTN","BPS SCRLG",2,0 )
10834	;;1.0;E C LAIMS MGMT ENGINE; 1,5,7,8,10 ,11,15,18, 20,22;JU N 2004;Bui ld 15
10835	"RTN","BPS SCRLG",3,0 )
10836	;;Per VA Directive 6402, this routine s hould not be modifie d.
10837	"RTN","BPS SCRLG",4,0 )
10838	;
10839	"RTN","BPS SCRLG",5,0 )
10840	Q
10841	"RTN","BPS SCRLG",6,0 )
10842	;
10843	"RTN","BPS SCRLG",7,0 )
10844	EN ; -- ma in entry p oint for B PS LSTMN L OG
10845	"RTN","BPS SCRLG",8,0 )
10846	D EN^VALM ("BPS LSTM N LOG")
10847	"RTN","BPS SCRLG",9,0 )
10848	Q
10849	"RTN","BPS SCRLG",10, 0)
10850	;
10851	"RTN","BPS SCRLG",11, 0)
10852	HDR ; -- h eader code
10853	"RTN","BPS SCRLG",12, 0)
10854	S VALMHDR (1)="Claim Log infor mation"
10855	"RTN","BPS SCRLG",13, 0)
10856	S VALMHDR (2)=""
10857	"RTN","BPS SCRLG",14, 0)
10858	Q
10859	"RTN","BPS SCRLG",15, 0)
10860	;
10861	"RTN","BPS SCRLG",16, 0)
10862	INIT ; -- init varia bles and l ist array
10863	"RTN","BPS SCRLG",17, 0)
10864	N BPSELCL M,LINE
10865	"RTN","BPS SCRLG",18, 0)
10866	S BPSELCL M=$G(@VALM AR@("SELLN "))
10867	"RTN","BPS SCRLG",19, 0)
10868	; piece 2: patient ien #2
10869	"RTN","BPS SCRLG",20, 0)
10870	; piece 3: insuran ce ien #36
10871	"RTN","BPS SCRLG",21, 0)
10872	; piece 4: ptr to #9002313.5 9
10873	"RTN","BPS SCRLG",22, 0)
10874	S LINE=1
10875	"RTN","BPS SCRLG",23, 0)
10876	S VALMCNT =$$PREPINF O(.LINE,$P (BPSELCLM, U,2),$P(BP SELCLM,U,3 ),$P(BPSEL CLM,U,4))
10877	"RTN","BPS SCRLG",24, 0)
10878	S:VALMCNT >1 VALMCNT =VALMCNT-1
10879	"RTN","BPS SCRLG",25, 0)
10880	Q
10881	"RTN","BPS SCRLG",26, 0)
10882	;
10883	"RTN","BPS SCRLG",27, 0)
10884	HELP ; -- help code
10885	"RTN","BPS SCRLG",28, 0)
10886	S X="?" D DISP^XQOR M1 W !!
10887	"RTN","BPS SCRLG",29, 0)
10888	K X
10889	"RTN","BPS SCRLG",30, 0)
10890	Q
10891	"RTN","BPS SCRLG",31, 0)
10892	;
10893	"RTN","BPS SCRLG",32, 0)
10894	EXIT ; -- exit code
10895	"RTN","BPS SCRLG",33, 0)
10896	Q
10897	"RTN","BPS SCRLG",34, 0)
10898	;
10899	"RTN","BPS SCRLG",35, 0)
10900	EXPND ; -- expand co de
10901	"RTN","BPS SCRLG",36, 0)
10902	Q
10903	"RTN","BPS SCRLG",37, 0)
10904	;
10905	"RTN","BPS SCRLG",38, 0)
10906	;
10907	"RTN","BPS SCRLG",39, 0)
10908	LOG ;entry point for LOG menu option
10909	"RTN","BPS SCRLG",40, 0)
10910	N BPRET,B PSEL,BP59, BPVLM
10911	"RTN","BPS SCRLG",41, 0)
10912	I '$D(@(V ALMAR)) Q
10913	"RTN","BPS SCRLG",42, 0)
10914	D FULL^VA LM1
10915	"RTN","BPS SCRLG",43, 0)
10916	W !,"Ente r the line number fo r which yo u wish to print clai m logs."
10917	"RTN","BPS SCRLG",44, 0)
10918	S BPSEL=$ $ASKLINE^B PSSCRU4("S elect item ","C","Ple ase select SINGLE Rx Line.")
10919	"RTN","BPS SCRLG",45, 0)
10920	I BPSEL<1 S VALMBCK ="R" Q
10921	"RTN","BPS SCRLG",46, 0)
10922	;
10923	"RTN","BPS SCRLG",47, 0)
10924	S BP59=$P (BPSEL,U,4 )
10925	"RTN","BPS SCRLG",48, 0)
10926	S BPVLM=+ $P(BPSEL,U ,5) ; 1 st line fo r indexes in the LM display ar ray
10927	"RTN","BPS SCRLG",49, 0)
10928	;
10929	"RTN","BPS SCRLG",50, 0)
10930	; check f or non-bil lable entr y for clai m LOG disp lay
10931	"RTN","BPS SCRLG",51, 0)
10932	I $$NB^BP SSCR03(BP5 9) D S VA LMBCK="R" Q
10933	"RTN","BPS SCRLG",52, 0)
10934	. W !!,$G (@VALMAR@( BPVLM,0)) ; LM display a rray
10935	"RTN","BPS SCRLG",53, 0)
10936	. W !?6,$ $EREJTXT^B PSSCR03(BP 59) ; eT /eC non-bi llable rea son line
10937	"RTN","BPS SCRLG",54, 0)
10938	. W !,"En try is NON BILLABLE. There is no Claim Log to dis play."
10939	"RTN","BPS SCRLG",55, 0)
10940	. D PAUSE ^VALM1
10941	"RTN","BPS SCRLG",56, 0)
10942	. Q
10943	"RTN","BPS SCRLG",57, 0)
10944	;
10945	"RTN","BPS SCRLG",58, 0)
10946	D SAVESEL (BPSEL,VAL MAR)
10947	"RTN","BPS SCRLG",59, 0)
10948	D EN
10949	"RTN","BPS SCRLG",60, 0)
10950	S VALMBCK ="R"
10951	"RTN","BPS SCRLG",61, 0)
10952	Q
10953	"RTN","BPS SCRLG",62, 0)
10954	;
10955	"RTN","BPS SCRLG",63, 0)
10956	;save for ListManag er
10957	"RTN","BPS SCRLG",64, 0)
10958	;BPSEL - selected l ine
10959	"RTN","BPS SCRLG",65, 0)
10960	;BPVALMR - parent V ALMAR
10961	"RTN","BPS SCRLG",66, 0)
10962	SAVESEL(BP SEL,BPVALM R) ;
10963	"RTN","BPS SCRLG",67, 0)
10964	D CLEANIT
10965	"RTN","BPS SCRLG",68, 0)
10966	S ^TMP("B PSLOG",$J, "VALM","SE LLN")=BPSE L
10967	"RTN","BPS SCRLG",69, 0)
10968	S ^TMP("B PSLOG",$J, "VALM","PA RENT")=BPV ALMR
10969	"RTN","BPS SCRLG",70, 0)
10970	M ^TMP("B PSLOG",$J, "VALM","VI EWPARAMS") =@BPVALMR@ ("VIEWPARA MS")
10971	"RTN","BPS SCRLG",71, 0)
10972	Q
10973	"RTN","BPS SCRLG",72, 0)
10974	;
10975	"RTN","BPS SCRLG",73, 0)
10976	CLEANIT ;
10977	"RTN","BPS SCRLG",74, 0)
10978	K ^TMP("B PSLOG",$J, "VALM")
10979	"RTN","BPS SCRLG",75, 0)
10980	Q
10981	"RTN","BPS SCRLG",76, 0)
10982	;
10983	"RTN","BPS SCRLG",77, 0)
10984	PREPINFO(B PLN,BPDFN, BP36,BP59) ;
10985	"RTN","BPS SCRLG",78, 0)
10986	;input:
10987	"RTN","BPS SCRLG",79, 0)
10988	; BPDFN: patient ie n #2
10989	"RTN","BPS SCRLG",80, 0)
10990	; BP36: i nsurance i en #36
10991	"RTN","BPS SCRLG",81, 0)
10992	; BP59: p tr to #900 2313.59
10993	"RTN","BPS SCRLG",82, 0)
10994	; returns # of line s
10995	"RTN","BPS SCRLG",83, 0)
10996	;
10997	"RTN","BPS SCRLG",84, 0)
10998	; Moved t o ^BPSSCRL 1 for sake of space
10999	"RTN","BPS SCRLG",85, 0)
11000	;
11001	"RTN","BPS SCRLG",86, 0)
11002	Q $$PREPI NFO^BPSSCR L1(BPLN,BP DFN,BP36,B P59)
11003	"RTN","BPS SCRLG",87, 0)
11004	;
11005	"RTN","BPS SCRLG",88, 0)
11006	;incremen ts BPLINE
11007	"RTN","BPS SCRLG",89, 0)
11008	SETLINE(BP LINE,BPSTR ) ;
11009	"RTN","BPS SCRLG",90, 0)
11010	D SET^VAL M10(BPLINE ,BPSTR)
11011	"RTN","BPS SCRLG",91, 0)
11012	S BPLINE= BPLINE+1
11013	"RTN","BPS SCRLG",92, 0)
11014	Q
11015	"RTN","BPS SCRLG",93, 0)
11016	;
11017	"RTN","BPS SCRLG",94, 0)
11018	;display claim reco rd
11019	"RTN","BPS SCRLG",95, 0)
11020	DISPCLM(BP LN,BP59,BP IEN02,BP57 ,BPSTYPE,B PSDTALT) ;
11021	"RTN","BPS SCRLG",96, 0)
11022	;
11023	"RTN","BPS SCRLG",97, 0)
11024	; Moved t o ^BPSSCRL 1 for sake of space
11025	"RTN","BPS SCRLG",98, 0)
11026	;
11027	"RTN","BPS SCRLG",99, 0)
11028	D DISPCLM ^BPSSCRL1
11029	"RTN","BPS SCRLG",100 ,0)
11030	Q
11031	"RTN","BPS SCRLG",101 ,0)
11032	;
11033	"RTN","BPS SCRLG",102 ,0)
11034	;Submitte d By User
11035	"RTN","BPS SCRLG",103 ,0)
11036	SUBMTBY(BP 57) ;
11037	"RTN","BPS SCRLG",104 ,0)
11038	N BPIEN,B PUSR
11039	"RTN","BPS SCRLG",105 ,0)
11040	S BPIEN=$ P($G(^BPST L(BP57,0)) ,U,10)
11041	"RTN","BPS SCRLG",106 ,0)
11042	S BPUSR=$ $GETUSRNM^ BPSSCRU1(B PIEN)
11043	"RTN","BPS SCRLG",107 ,0)
11044	Q $S(BPUS R']"":"UNK NOWN",1:BP USR)
11045	"RTN","BPS SCRLG",108 ,0)
11046	;
11047	"RTN","BPS SCRLG",109 ,0)
11048	;Date of service
11049	"RTN","BPS SCRLG",110 ,0)
11050	DOSCLM(BPI EN02) ;
11051	"RTN","BPS SCRLG",111 ,0)
11052	N BPDT
11053	"RTN","BPS SCRLG",112 ,0)
11054	S BPDT=$P ($G(^BPSC( BPIEN02,40 1)),U,1)\1
11055	"RTN","BPS SCRLG",113 ,0)
11056	Q $E(BPDT ,5,6)_"/"_ $E(BPDT,7, 8)_"/"_$E( BPDT,1,4)
11057	"RTN","BPS SCRLG",114 ,0)
11058	;
11059	"RTN","BPS SCRLG",115 ,0)
11060	;Create d ate
11061	"RTN","BPS SCRLG",116 ,0)
11062	CREATEDT(B PIEN02,BPS DTALT) ;
11063	"RTN","BPS SCRLG",117 ,0)
11064	N BPSDT
11065	"RTN","BPS SCRLG",118 ,0)
11066	S BPSDT=+ $P($G(^BPS C(BPIEN02, 0)),U,6)
11067	"RTN","BPS SCRLG",119 ,0)
11068	Q $$DATET IME^BPSSCR U5($S(BPSD T>0:BPSDT, 1:BPSDTALT ))
11069	"RTN","BPS SCRLG",120 ,0)
11070	;
11071	"RTN","BPS SCRLG",121 ,0)
11072	;Plan ID
11073	"RTN","BPS SCRLG",122 ,0)
11074	PLANID(BP5 7) ;
11075	"RTN","BPS SCRLG",123 ,0)
11076	Q $P($G(^ BPSTL(BP57 ,10,+$G(^B PSTL(BP57, 9)),0)),U, 1)
11077	"RTN","BPS SCRLG",124 ,0)
11078	;
11079	"RTN","BPS SCRLG",125 ,0)
11080	CERTMOD(BP 57) ;
11081	"RTN","BPS SCRLG",126 ,0)
11082	Q $P($G(^ BPSTL(BP57 ,10,+$G(^B PSTL(BP57, 9)),0)),U, 5)
11083	"RTN","BPS SCRLG",127 ,0)
11084	;
11085	"RTN","BPS SCRLG",128 ,0)
11086	;Software Vendor/Ce rt ID
11087	"RTN","BPS SCRLG",129 ,0)
11088	CERTIEN(BP 57) ;
11089	"RTN","BPS SCRLG",130 ,0)
11090	Q $P($G(^ BPSTL(BP57 ,10,+$G(^B PSTL(BP57, 9)),0)),U, 6)
11091	"RTN","BPS SCRLG",131 ,0)
11092	;
11093	"RTN","BPS SCRLG",132 ,0)
11094	;Division
11095	"RTN","BPS SCRLG",133 ,0)
11096	DIV(BP57) ;
11097	"RTN","BPS SCRLG",134 ,0)
11098	Q $$GET1^ DIQ(900231 3.57,BP57_ ",",11)
11099	"RTN","BPS SCRLG",135 ,0)
11100	;
11101	"RTN","BPS SCRLG",136 ,0)
11102	;NPI
11103	"RTN","BPS SCRLG",137 ,0)
11104	NPI(BPIEN0 2) ;
11105	"RTN","BPS SCRLG",138 ,0)
11106	Q $$GET1^ DIQ(900231 3.02,BPIEN 02_",",201 )
11107	"RTN","BPS SCRLG",139 ,0)
11108	;
11109	"RTN","BPS SCRLG",140 ,0)
11110	;Group ID
11111	"RTN","BPS SCRLG",141 ,0)
11112	GRPID(BPIE N02) ;
11113	"RTN","BPS SCRLG",142 ,0)
11114	Q $E($P($ G(^BPSC(BP IEN02,300) ),U,1),3,9 9)
11115	"RTN","BPS SCRLG",143 ,0)
11116	;
11117	"RTN","BPS SCRLG",144 ,0)
11118	;Group Na me
11119	"RTN","BPS SCRLG",145 ,0)
11120	GRPNM(BPSI EN02) ;
11121	"RTN","BPS SCRLG",146 ,0)
11122	N BPSGPN
11123	"RTN","BPS SCRLG",147 ,0)
11124	S BPSGPN= $P($G(^BPS TL(BP57,10 ,+$G(^BPST L(BP57,9)) ,3)),U,1)
11125	"RTN","BPS SCRLG",148 ,0)
11126	Q BPSGPN
11127	"RTN","BPS SCRLG",149 ,0)
11128	;
11129	"RTN","BPS SCRLG",150 ,0)
11130	;Cardhold er ID
11131	"RTN","BPS SCRLG",151 ,0)
11132	CRDHLDID(B PIEN02) ;
11133	"RTN","BPS SCRLG",152 ,0)
11134	Q $E($P($ G(^BPSC(BP IEN02,300) ),U,2),3,9 9)
11135	"RTN","BPS SCRLG",153 ,0)
11136	;
11137	"RTN","BPS SCRLG",154 ,0)
11138	;Cardhold er First n ame
11139	"RTN","BPS SCRLG",155 ,0)
11140	CRDHLDFN(B PIEN02,BP5 7) ;
11141	"RTN","BPS SCRLG",156 ,0)
11142	N Y
11143	"RTN","BPS SCRLG",157 ,0)
11144	S Y=$E($P ($G(^BPSC( BPIEN02,30 0)),U,12), 3,99)
11145	"RTN","BPS SCRLG",158 ,0)
11146	I $L(Y)=0 S Y=$P($G (^BPSTL(BP 57,10,+$G( ^BPSTL(BP5 7,9)),1)), U,6)
11147	"RTN","BPS SCRLG",159 ,0)
11148	Q Y
11149	"RTN","BPS SCRLG",160 ,0)
11150	;
11151	"RTN","BPS SCRLG",161 ,0)
11152	;Cardhold er Last Na me
11153	"RTN","BPS SCRLG",162 ,0)
11154	CRDHLDLN(B PIEN02,BP5 7) ;
11155	"RTN","BPS SCRLG",163 ,0)
11156	N Y
11157	"RTN","BPS SCRLG",164 ,0)
11158	S Y=$E($P ($G(^BPSC( BPIEN02,30 0)),U,13), 3,99)
11159	"RTN","BPS SCRLG",165 ,0)
11160	I $L(Y)=0 S Y=$P($G (^BPSTL(BP 57,10,+$G( ^BPSTL(BP5 7,9)),1)), U,7)
11161	"RTN","BPS SCRLG",166 ,0)
11162	Q Y
11163	"RTN","BPS SCRLG",167 ,0)
11164	;
11165	"RTN","BPS SCRLG",168 ,0)
11166	;Facility ID Qualif ier - BPS* 1*22
11167	"RTN","BPS SCRLG",169 ,0)
11168	FACIDQ(BPE IN02) ;
11169	"RTN","BPS SCRLG",170 ,0)
11170	Q $P($G(^ BPSC(BPIEN 02,400,1," B90")),U,5 )
11171	"RTN","BPS SCRLG",171 ,0)
11172	;
11173	"RTN","BPS SCRLG",172 ,0)
11174	;Patient Relationsh ip Code
11175	"RTN","BPS SCRLG",173 ,0)
11176	PATRELSH(B PIEN02) ;
11177	"RTN","BPS SCRLG",174 ,0)
11178	N Y
11179	"RTN","BPS SCRLG",175 ,0)
11180	S Y=$E($P ($G(^BPSC( BPIEN02,30 0)),U,6),3 ,99)
11181	"RTN","BPS SCRLG",176 ,0)
11182	Q $S(Y=0: "NOT SPECI FIED",Y=1: "CARDHOLDE R",Y=2:"SP OUSE",Y=3: "CHILD",Y= 4:"OTHER", 1:Y)
11183	"RTN","BPS SCRLG",177 ,0)
11184	;
11185	"RTN","BPS SCRLG",178 ,0)
11186	PCN(BPIEN0 2) ;
11187	"RTN","BPS SCRLG",179 ,0)
11188	Q $P($G(^ BPSC(BPIEN 02,100)),U ,4)
11189	"RTN","BPS SCRLG",180 ,0)
11190	;
11191	"RTN","BPS SCRLG",181 ,0)
11192	; Get the Payer She et Version Number.
11193	"RTN","BPS SCRLG",182 ,0)
11194	GETVER(BPI EN02) ;
11195	"RTN","BPS SCRLG",183 ,0)
11196	N BPSVER
11197	"RTN","BPS SCRLG",184 ,0)
11198	S BPSVER= $P($G(^BPS C(BPIEN02, 100)),U,2)
11199	"RTN","BPS SCRLG",185 ,0)
11200	I $G(BPSV ER)]"" S B PSVER=$E(B PSVER,1)_" ."_$E(BPSV ER,2,99)
11201	"RTN","BPS SCRLG",186 ,0)
11202	Q BPSVER
11203	"RTN","BPS SCRLG",187 ,0)
11204	;
11205	"RTN","BPS SCRLG",188 ,0)
11206	BIN(BPIEN0 2) ;
11207	"RTN","BPS SCRLG",189 ,0)
11208	Q $P($G(^ BPSC(BPIEN 02,100)),U ,1)
11209	"RTN","BPS SCRLG",190 ,0)
11210	;
11211	"RTN","BPS SCRLG",191 ,0)
11212	;insuranc e name by 9002313.57 pointer
11213	"RTN","BPS SCRLG",192 ,0)
11214	INSUR57(BP IEN57) ;
11215	"RTN","BPS SCRLG",193 ,0)
11216	N BPINSN
11217	"RTN","BPS SCRLG",194 ,0)
11218	S BPINSN= +$G(^BPSTL (BPIEN57,9 ))
11219	"RTN","BPS SCRLG",195 ,0)
11220	Q $P($G(^ BPSTL(BPIE N57,10,BPI NSN,0)),U, 7)
11221	"RTN","BPS SCRLG",196 ,0)
11222	;
11223	"RTN","BPS SCRLG",197 ,0)
11224	PHPLANID(B PIEN57) ; Get the Ph armacy Pla n ID from the BPS Lo g of Trans actions fi le
11225	"RTN","BPS SCRLG",198 ,0)
11226	; Input - BPSIEN57: IEN from the BPS Lo g of Trans actions fi le.
11227	"RTN","BPS SCRLG",199 ,0)
11228	I '$G(BPI EN57) Q ""
11229	"RTN","BPS SCRLG",200 ,0)
11230	N BPINSN
11231	"RTN","BPS SCRLG",201 ,0)
11232	S BPINSN= +$G(^BPSTL (BPIEN57,9 ))
11233	"RTN","BPS SCRLG",202 ,0)
11234	Q $P($G(^ BPSTL(BPIE N57,10,BPI NSN,3)),U, 3)
11235	"RTN","BPS SCRLG",203 ,0)
11236	;
11237	"RTN","BPS SCRLG",204 ,0)
11238	QTY(BPIEN0 2) ;
11239	"RTN","BPS SCRLG",205 ,0)
11240	Q $E($P($ G(^BPSC(BP IEN02,400, 1,440)),U, 2),3,99)/1 000
11241	"RTN","BPS SCRLG",206 ,0)
11242	;
11243	"RTN","BPS SCRLG",207 ,0)
11244	;NCPDP Un its
11245	"RTN","BPS SCRLG",208 ,0)
11246	UNITS(BPIE N02) ;
11247	"RTN","BPS SCRLG",209 ,0)
11248	I $G(BPIE N02)="" Q "( )"
11249	"RTN","BPS SCRLG",210 ,0)
11250	N X
11251	"RTN","BPS SCRLG",211 ,0)
11252	S X=$E($P ($G(^BPSC( BPIEN02,40 0,1,600)), U,1),3,99)
11253	"RTN","BPS SCRLG",212 ,0)
11254	Q $S(X="" :"( )",1: "("_X_")")
11255	"RTN","BPS SCRLG",213 ,0)
11256	;
11257	"RTN","BPS SCRLG",214 ,0)
11258	UNTPRICE(B PIEN57) ;
11259	"RTN","BPS SCRLG",215 ,0)
11260	I $G(BPIE N57)="" Q ""
11261	"RTN","BPS SCRLG",216 ,0)
11262	Q +$P($G( ^BPSTL(BPI EN57,5)),U ,2)
11263	"RTN","BPS SCRLG",217 ,0)
11264	;
11265	"RTN","BPS SCRLG",218 ,0)
11266	TOTPRICE(B PIEN02) ;
11267	"RTN","BPS SCRLG",219 ,0)
11268	I $G(BPIE N02)="" Q ""
11269	"RTN","BPS SCRLG",220 ,0)
11270	N X
11271	"RTN","BPS SCRLG",221 ,0)
11272	S X=$E($P ($G(^BPSC( BPIEN02,40 0,1,400)), U,30),3,99 )
11273	"RTN","BPS SCRLG",222 ,0)
11274	Q $S(X="" :X,1:$$DFF 2EXT^BPSEC FM(X))
11275	"RTN","BPS SCRLG",223 ,0)
11276	;
11277	"RTN","BPS SCRLG",224 ,0)
11278	BILLQTY(BP IEN57) ;
11279	"RTN","BPS SCRLG",225 ,0)
11280	Q $P($G(^ BPSTL(BPIE N57,5)),U, 9)
11281	"RTN","BPS SCRLG",226 ,0)
11282	;
11283	"RTN","BPS SCRLG",227 ,0)
11284	BILLUNT(BP IEN57) ;
11285	"RTN","BPS SCRLG",228 ,0)
11286	I $G(BPIE N57)="" Q "( )"
11287	"RTN","BPS SCRLG",229 ,0)
11288	N X
11289	"RTN","BPS SCRLG",230 ,0)
11290	S X=$P($G (^BPSTL(BP IEN57,5)), U,10)
11291	"RTN","BPS SCRLG",231 ,0)
11292	Q $S(X="" :"( )",1: "("_X_")")
11293	"RTN","BPS SCRLG",232 ,0)
11294	;
11295	"RTN","BPS SCRLG",233 ,0)
11296	;Ingredie nt Cost
11297	"RTN","BPS SCRLG",234 ,0)
11298	INGRCST(BP IEN02) ;
11299	"RTN","BPS SCRLG",235 ,0)
11300	I $G(BPIE N02)="" Q ""
11301	"RTN","BPS SCRLG",236 ,0)
11302	N X
11303	"RTN","BPS SCRLG",237 ,0)
11304	S X=$E($P ($G(^BPSC( BPIEN02,40 0,1,400)), U,9),3,99)
11305	"RTN","BPS SCRLG",238 ,0)
11306	Q $S(X="" :X,1:$$DFF 2EXT^BPSEC FM(X))
11307	"RTN","BPS SCRLG",239 ,0)
11308	;
11309	"RTN","BPS SCRLG",240 ,0)
11310	;Dispensi ng Fee Sub mitted
11311	"RTN","BPS SCRLG",241 ,0)
11312	DISPFEE(BP IEN02) ;
11313	"RTN","BPS SCRLG",242 ,0)
11314	I $G(BPIE N02)="" Q ""
11315	"RTN","BPS SCRLG",243 ,0)
11316	N X
11317	"RTN","BPS SCRLG",244 ,0)
11318	S X=$E($P ($G(^BPSC( BPIEN02,40 0,1,400)), U,12),3,99 )
11319	"RTN","BPS SCRLG",245 ,0)
11320	Q $S(X="" :X,1:$$DFF 2EXT^BPSEC FM(X))
11321	"RTN","BPS SCRLG",246 ,0)
11322	;
11323	"RTN","BPS SCRLG",247 ,0)
11324	;U&C Char ge
11325	"RTN","BPS SCRLG",248 ,0)
11326	UCCHRG(BPI EN02) ;
11327	"RTN","BPS SCRLG",249 ,0)
11328	I $G(BPIE N02)="" Q ""
11329	"RTN","BPS SCRLG",250 ,0)
11330	N X
11331	"RTN","BPS SCRLG",251 ,0)
11332	S X=$E($P ($G(^BPSC( BPIEN02,40 0,1,400)), U,26),3,99 )
11333	"RTN","BPS SCRLG",252 ,0)
11334	Q $S(X="" :X,1:$$DFF 2EXT^BPSEC FM(X))
11335	"RTN","BPS SCRLG",253 ,0)
11336	;
11337	"RTN","BPS SCRLG",254 ,0)
11338	;Admin Fe e
11339	"RTN","BPS SCRLG",255 ,0)
11340	ADMNFEE(BP IEN02) ;
11341	"RTN","BPS SCRLG",256 ,0)
11342	I $G(BPIE N02)="" Q ""
11343	"RTN","BPS SCRLG",257 ,0)
11344	N CNT,X,A F
11345	"RTN","BPS SCRLG",258 ,0)
11346	S AF="",C NT=0 F S CNT=$O(^BP SC(BPIEN02 ,400,1,478 .01,CNT)) Q:'CNT D
11347	"RTN","BPS SCRLG",259 ,0)
11348	. S X=$G( ^BPSC(BPIE N02,400,1, 478.01,CNT ,0))
11349	"RTN","BPS SCRLG",260 ,0)
11350	. I +$E($ P(X,U,2),3 ,4)=4 S AF =AF+$$DFF2 EXT^BPSECF M($E($P(X, U,3),3,10) )
11351	"RTN","BPS SCRLG",261 ,0)
11352	Q $S(AF=" ":AF,1:$J( AF,0,2))
11353	"RTN","BPS SCRLG",262 ,0)
11354	;
11355	"RTN","BPS SCRLG",263 ,0)
11356	;get ECME pharmacy division p tr for LOG
11357	"RTN","BPS SCRLG",264 ,0)
11358	LDIV(BPIEN 57) ;
11359	"RTN","BPS SCRLG",265 ,0)
11360	Q +$P($G( ^BPSTL(BPI EN57,1)),U ,7)
11361	"RTN","BPS SCRLG",266 ,0)
11362	;
11363	"RTN","BPS SCRLG",267 ,0)
11364	;transact ion code
11365	"RTN","BPS SCRLG",268 ,0)
11366	TRCODE(BPI EN02) ;
11367	"RTN","BPS SCRLG",269 ,0)
11368	Q $P($G(^ BPSC(BPIEN 02,100)),U ,3)
11369	"RTN","BPS SCRLG",270 ,0)
11370	;
11371	"RTN","BPS SCRLG",271 ,0)
11372	;days sup ply
11373	"RTN","BPS SCRLG",272 ,0)
11374	DAYSSUPL(B PIEN02) ;
11375	"RTN","BPS SCRLG",273 ,0)
11376	;format D 5NNN -> NN N
11377	"RTN","BPS SCRLG",274 ,0)
11378	Q +$E($P( $G(^BPSC(B PIEN02,400 ,1,400)),U ,5),3,99)
11379	"RTN","BPS SCRLG",275 ,0)
11380	;
11381	"RTN","BPS SCRLG",276 ,0)
11382	;display response r ecord
11383	"RTN","BPS SCRLG",277 ,0)
11384	DISPRSP(BP LN,BP59,BP IEN03,BP57 ,BPSTYPE,B PSDTALT) ;
11385	"RTN","BPS SCRLG",278 ,0)
11386	;
11387	"RTN","BPS SCRLG",279 ,0)
11388	; Moved t o ^BPSSCRL 1 for sake of space
11389	"RTN","BPS SCRLG",280 ,0)
11390	;
11391	"RTN","BPS SCRLG",281 ,0)
11392	D DISPRSP ^BPSSCRL1
11393	"RTN","BPS SCRLG",282 ,0)
11394	Q
11395	"RTN","BPS SCRLG",283 ,0)
11396	;
11397	"RTN","BPS SCRLG",284 ,0)
11398	RESPREC(BP IEN03,BPSD TALT) ;
11399	"RTN","BPS SCRLG",285 ,0)
11400	N BPSDT
11401	"RTN","BPS SCRLG",286 ,0)
11402	S BPSDT=+ $P($G(^BPS R(BPIEN03, 0)),U,2)
11403	"RTN","BPS SCRLG",287 ,0)
11404	Q $$DATET IME^BPSSCR U5($S(BPSD T>0:BPSDT, 1:BPSDTALT ))
11405	"RTN","BPS SCRLG",288 ,0)
11406	;
11407	"RTN","BPS SCRLG",289 ,0)
11408	DOSRSP(BPI EN03) ;
11409	"RTN","BPS SCRLG",290 ,0)
11410	N BPDT
11411	"RTN","BPS SCRLG",291 ,0)
11412	S BPDT=$P ($G(^BPSR( BPIEN03,40 0)),U,1)\1
11413	"RTN","BPS SCRLG",292 ,0)
11414	Q $E(BPDT ,5,6)_"/"_ $E(BPDT,7, 8)_"/"_$E( BPDT,1,4)
11415	"RTN","BPS SCRLG",293 ,0)
11416	;
11417	"RTN","BPS SCRLG",294 ,0)
11418	TOTAMNT(BP IEN03) ;
11419	"RTN","BPS SCRLG",295 ,0)
11420	I $G(BPIE N03)="" Q ""
11421	"RTN","BPS SCRLG",296 ,0)
11422	N X
11423	"RTN","BPS SCRLG",297 ,0)
11424	S X=$P($G (^BPSR(BPI EN03,1000, 1,500)),U, 9)
11425	"RTN","BPS SCRLG",298 ,0)
11426	Q $S(X="" :X,1:$$DFF 2EXT^BPSEC FM(X))
11427	"RTN","BPS SCRLG",299 ,0)
11428	;
11429	"RTN","BPS SCRLG",300 ,0)
11430	ICPAID(BPI EN03) ;Ing redient Co st Paid
11431	"RTN","BPS SCRLG",301 ,0)
11432	I $G(BPIE N03)="" Q ""
11433	"RTN","BPS SCRLG",302 ,0)
11434	N X
11435	"RTN","BPS SCRLG",303 ,0)
11436	S X=$P($G (^BPSR(BPI EN03,1000, 1,500)),U, 6)
11437	"RTN","BPS SCRLG",304 ,0)
11438	Q $S(X="" :X,1:$$DFF 2EXT^BPSEC FM(X))
11439	"RTN","BPS SCRLG",305 ,0)
11440	;
11441	"RTN","BPS SCRLG",306 ,0)
11442	; BPS12 2 - Reconc iliation I D
11443	"RTN","BPS SCRLG",307 ,0)
11444	RECONID(BP EIN03) ;
11445	"RTN","BPS SCRLG",308 ,0)
11446	Q $P($G(^ BPSR(BPIEN 03,1000,1, "B98")),U, 1)
11447	"RTN","BPS SCRLG",309 ,0)
11448	;
11449	"RTN","BPS SCRLG",310 ,0)
11450	DFPAID(BPI EN03) ;Dis pensing Fe e Paid
11451	"RTN","BPS SCRLG",311 ,0)
11452	I $G(BPIE N03)="" Q ""
11453	"RTN","BPS SCRLG",312 ,0)
11454	N X
11455	"RTN","BPS SCRLG",313 ,0)
11456	S X=$P($G (^BPSR(BPI EN03,1000, 1,500)),U, 7)
11457	"RTN","BPS SCRLG",314 ,0)
11458	Q $S(X="" :X,1:$$DFF 2EXT^BPSEC FM(X))
11459	"RTN","BPS SCRLG",315 ,0)
11460	;
11461	"RTN","BPS SCRLG",316 ,0)
11462	PTRESP(BPI EN03) ;Pat ient Respo nsibility
11463	"RTN","BPS SCRLG",317 ,0)
11464	I $G(BPIE N03)="" Q ""
11465	"RTN","BPS SCRLG",318 ,0)
11466	N X
11467	"RTN","BPS SCRLG",319 ,0)
11468	S X=$P($G (^BPSR(BPI EN03,1000, 1,500)),U, 5)
11469	"RTN","BPS SCRLG",320 ,0)
11470	Q $S(X="" :X,1:$$DFF 2EXT^BPSEC FM(X))
11471	"RTN","BPS SCRLG",321 ,0)
11472	;
11473	"RTN","BPS SCRLG",322 ,0)
11474	MESSAGE(BP IEN03) ;
11475	"RTN","BPS SCRLG",323 ,0)
11476	Q $P($G(^ BPSR(BPIEN 03,504)),U )
11477	"RTN","BPS SCRLG",324 ,0)
11478	;
11479	"RTN","BPS SCRLG",325 ,0)
11480	ADDMESS(BP IEN03,POS, BPADDMSG) ;
11481	"RTN","BPS SCRLG",326 ,0)
11482	N ADM,X,Q UA,TXT,CON ,BPMTMP,L, NEXT
11483	"RTN","BPS SCRLG",327 ,0)
11484	K BPMTMP, BPADDMSG
11485	"RTN","BPS SCRLG",328 ,0)
11486	I '$G(BPI EN03) Q
11487	"RTN","BPS SCRLG",329 ,0)
11488	I '$G(POS ) S POS=1
11489	"RTN","BPS SCRLG",330 ,0)
11490	S (ADM,L) =0 F S AD M=$O(^BPSR (BPIEN03,1 000,POS,13 0.01,ADM)) Q:'ADM D
11491	"RTN","BPS SCRLG",331 ,0)
11492	. S X=$G( ^BPSR(BPIE N03,1000,P OS,130.01, ADM,0))
11493	"RTN","BPS SCRLG",332 ,0)
11494	. S TXT=$ P($G(^BPSR (BPIEN03,1 000,POS,13 0.01,ADM,1 )),U,1)
11495	"RTN","BPS SCRLG",333 ,0)
11496	. S QUA=$ P(X,U,3),C ON=$P(X,U, 2)
11497	"RTN","BPS SCRLG",334 ,0)
11498	. ; This should not happen, b ut if the qualifier is null, s et it
11499	"RTN","BPS SCRLG",335 ,0)
11500	. ; to " Z"_concate nated with a unique number so that it fo llows the
11501	"RTN","BPS SCRLG",336 ,0)
11502	. ; othe r qualifie rs. Per t he D0 stan dard, qual ifiers can be 1-9 an d
11503	"RTN","BPS SCRLG",337 ,0)
11504	. ; A-Z. ECL limi ts this to 1-9 but a n future E CL may ext end this.
11505	"RTN","BPS SCRLG",338 ,0)
11506	. I QUA=" " S L=L+1, QUA="Z"_L
11507	"RTN","BPS SCRLG",339 ,0)
11508	. S BPMTM P(QUA)=CON _U_TXT
11509	"RTN","BPS SCRLG",340 ,0)
11510	I '$D(BPM TMP) Q
11511	"RTN","BPS SCRLG",341 ,0)
11512	S L=0,(QU A,NEXT)="" F S QUA= $O(BPMTMP( QUA)) Q:QU A="" D
11513	"RTN","BPS SCRLG",342 ,0)
11514	. S CON=$ P(BPMTMP(Q UA),U,1),T XT=$P(BPMT MP(QUA),U, 2)
11515	"RTN","BPS SCRLG",343 ,0)
11516	. I NEXT= "+" S BPAD DMSG(L)=BP ADDMSG(L)_ TXT,NEXT=C ON Q
11517	"RTN","BPS SCRLG",344 ,0)
11518	. S L=L+1 ,BPADDMSG( L)=TXT,NEX T=CON
11519	"RTN","BPS SCRLG",345 ,0)
11520	Q
11521	"RTN","BPS SCRLG",346 ,0)
11522	;
11523	"RTN","BPS SCRLG",347 ,0)
11524	DURTEXT(BP IEN03) ;
11525	"RTN","BPS SCRLG",348 ,0)
11526	; DUR FRE E TEXT MES SAGE from first inst ance of DU R PPS RESP ONSE
11527	"RTN","BPS SCRLG",349 ,0)
11528	Q $P($G(^ BPSR(BPIEN 03,1000,1, 567.01,1,0 )),U,9)
11529	"RTN","BPS SCRLG",350 ,0)
11530	;
11531	"RTN","BPS SCRLG",351 ,0)
11532	DURREAS(BP IEN03) ;
11533	"RTN","BPS SCRLG",352 ,0)
11534	; REASON FOR SERVIC E CODE fro m first in stance of DUR PPS RE SPONSE
11535	"RTN","BPS SCRLG",353 ,0)
11536	Q $$GET1^ DIQ(900231 3.1101,"1, 1,"_BPIEN0 3_",",439)
11537	"RTN","BPS SCRLG",354 ,0)
11538	;
11539	"RTN","BPS SCRLG",355 ,0)
11540	DURADD(BPI EN03) ;
11541	"RTN","BPS SCRLG",356 ,0)
11542	; DUR ADD ITIONAL TE XT from fi rst instan ce of DUR PPS RESPON SE
11543	"RTN","BPS SCRLG",357 ,0)
11544	Q $P($G(^ BPSR(BPIEN 03,1000,1, 567.01,1,1 )),U)
11545	"RTN","BPS SCRLG",358 ,0)
11546	;
11547	"RTN","BPS SCRLG",359 ,0)
11548	;Payer HP ID from re sponse ** BPS1*18 IB ICR #60 61
11549	"RTN","BPS SCRLG",360 ,0)
11550	HPID(BPIEN 03,BP57) ;
11551	"RTN","BPS SCRLG",361 ,0)
11552	N BPHPD
11553	"RTN","BPS SCRLG",362 ,0)
11554	Q:$P($G(^ BPSR(BPIEN 03,560)),U ,8)'="01" ""
11555	"RTN","BPS SCRLG",363 ,0)
11556	S BPHPD=$ P($G(^BPSR (BPIEN03,5 60)),U,9)
11557	"RTN","BPS SCRLG",364 ,0)
11558	; 6/25/14 no valida tion of HP ID for thi s screen
11559	"RTN","BPS SCRLG",365 ,0)
11560	;S:BPHPD' ="" BPHPD= BPHPD_$P($ $HOD^IBCNH UT1(BPHPD, BP57),U,3)
11561	"RTN","BPS SCRLG",366 ,0)
11562	Q BPHPD
11563	"RTN","BPS SCRLG",367 ,0)
11564	;
11565	"RTN","BPS SCRLG",368 ,0)
11566	RXCOB57(BP IEN57) ;
11567	"RTN","BPS SCRLG",369 ,0)
11568	N BPCOB
11569	"RTN","BPS SCRLG",370 ,0)
11570	S BPCOB=+ $P($G(^BPS TL(BPIEN57 ,0)),U,14)
11571	"RTN","BPS SCRLG",371 ,0)
11572	Q $S(BPCO B=2:"SECON DARY",BPCO B=3:"TERTI ARY",1:"PR IMARY")
11573	"RTN","BPS SCRLG",372 ,0)
11574	;
11575	"RTN","BPS SCRLG",373 ,0)
11576	;Display other paye r(s)
11577	"RTN","BPS SCRLG",374 ,0)
11578	DISPPYR(BP LN,BPIEN03 ) ;
11579	"RTN","BPS SCRLG",375 ,0)
11580	N PYR,PYR DATA,BPSTR 1
11581	"RTN","BPS SCRLG",376 ,0)
11582	S PYR=0 F S PYR=$O (^BPSR(BPI EN03,1000, 1,355.01,P YR)) Q:'PY R D
11583	"RTN","BPS SCRLG",377 ,0)
11584	. S PYRDA TA=^BPSR(B PIEN03,100 0,1,355.01 ,PYR,1)
11585	"RTN","BPS SCRLG",378 ,0)
11586	. S BPSTR 1="Other P ayer Infor mation ("_ PYR_")(#"_ BPIEN03_") "
11587	"RTN","BPS SCRLG",379 ,0)
11588	. D SETLI NE(.BPLN,B PSTR1_$$LI NE^BPSSCRU 3(79-$L(BP STR1),"-") )
11589	"RTN","BPS SCRLG",380 ,0)
11590	. D SETLI NE(.BPLN," Other Paye r ID Count : "_$$PYRI DCNT(BPIEN 03,PYR))
11591	"RTN","BPS SCRLG",381 ,0)
11592	. D SETLI NE(.BPLN," Other Paye r ID: "_$P (PYRDATA,U ,3))
11593	"RTN","BPS SCRLG",382 ,0)
11594	. D SETLI NE(.BPLN," Other Paye r Coverage Type: "_$ P(PYRDATA, U,1))
11595	"RTN","BPS SCRLG",383 ,0)
11596	. D SETLI NE(.BPLN," Other Paye r ID Quali fier: "_$P (PYRDATA,U ,2))
11597	"RTN","BPS SCRLG",384 ,0)
11598	. D SETLI NE(.BPLN," Other Paye r Help Des k Phone Nu mber: "_$P (PYRDATA,U ,8))
11599	"RTN","BPS SCRLG",385 ,0)
11600	. D SETLI NE(.BPLN," Other Paye r Processo r Control Number: "_ $P(PYRDATA ,U,4))
11601	"RTN","BPS SCRLG",386 ,0)
11602	. D SETLI NE(.BPLN," Other Paye r Effectiv e Date: "_ $P(PYRDATA ,U,10))
11603	"RTN","BPS SCRLG",387 ,0)
11604	. D SETLI NE(.BPLN," Other Paye r Terminat ion Date: "_$P(PYRDA TA,U,11))
11605	"RTN","BPS SCRLG",388 ,0)
11606	. D SETLI NE(.BPLN," Other Paye r Person C ode: "_$P( PYRDATA,U, 7))
11607	"RTN","BPS SCRLG",389 ,0)
11608	. D SETLI NE(.BPLN," Other Paye r Patient Relationsh ip Code: " _$P(PYRDAT A,U,9))
11609	"RTN","BPS SCRLG",390 ,0)
11610	. D SETLI NE(.BPLN," Other Paye r Cardhold er ID: "_$ P(PYRDATA, U,5))
11611	"RTN","BPS SCRLG",391 ,0)
11612	. D SETLI NE(.BPLN," Other Paye r Group ID : "_$P(PYR DATA,U,6))
11613	"RTN","BPS SCRLG",392 ,0)
11614	Q
11615	"RTN","BPS SCRLG",393 ,0)
11616	;
11617	"RTN","BPS SCRLG",394 ,0)
11618	PYRIDCNT(B PIEN03,PYR ) ;
11619	"RTN","BPS SCRLG",395 ,0)
11620	Q $P($G(^ BPSR(BPIEN 03,1000,1, 355.01,PYR ,0)),U)
11621	"RTN","BPS SCRRJ")
11622	0^12^B1305 46871
11623	"RTN","BPS SCRRJ",1,0 )
11624	BPSSCRRJ ; ALB/ESG - ECME OPECC Reject In formation ;02-SEP-20 15
11625	"RTN","BPS SCRRJ",2,0 )
11626	;;1.0;E C LAIMS MGMT ENGINE; 20,22;JU N 2004;Bui ld 15
11627	"RTN","BPS SCRRJ",3,0 )
11628	;;Per VA Directive 6402, this routine s hould not be modifie d.
11629	"RTN","BPS SCRRJ",4,0 )
11630	;
11631	"RTN","BPS SCRRJ",5,0 )
11632	; ICR# 47 01 for cal l to $$RXS ITE^PSOBPS UT
11633	"RTN","BPS SCRRJ",6,0 )
11634	; ICR# 47 05 for cal l to $$GET NDC^PSONDC UT
11635	"RTN","BPS SCRRJ",7,0 )
11636	; ICR# 47 11 for cal l to DP^PS ORXVW
11637	"RTN","BPS SCRRJ",8,0 )
11638	; ICR# 62 27 for cal l to REJCO M^PSOREJU4
11639	"RTN","BPS SCRRJ",9,0 )
11640	; ICR# 62 28 for cal l to MP^PS OREJU4 and PI^PSOREJ U4
11641	"RTN","BPS SCRRJ",10, 0)
11642	; ICR# 67 68 for cal l to $$TAX ID^IBCEF75
11643	"RTN","BPS SCRRJ",11, 0)
11644	;
11645	"RTN","BPS SCRRJ",12, 0)
11646	Q
11647	"RTN","BPS SCRRJ",13, 0)
11648	;
11649	"RTN","BPS SCRRJ",14, 0)
11650	EN ; -- ma in entry p oint for B PS OPECC R EJECT INFO RMATION
11651	"RTN","BPS SCRRJ",15, 0)
11652	N BPSEL,D FN,PSODFN, BPINSIEN,B PORI59,RXR EF,RXIEN,R XFIL,LINE, VALMHDR,RX ,FILL
11653	"RTN","BPS SCRRJ",16, 0)
11654	W "OPECC Reject Inf ormation"
11655	"RTN","BPS SCRRJ",17, 0)
11656	D FULL^VA LM1
11657	"RTN","BPS SCRRJ",18, 0)
11658	S BPSEL=$ $ASKLINE^B PSSCRU4("S elect item ","C","Ple ase select a single Rx line.")
11659	"RTN","BPS SCRRJ",19, 0)
11660	I BPSEL<1 G ENX
11661	"RTN","BPS SCRRJ",20, 0)
11662	S (DFN,PS ODFN)=+$P( BPSEL,U,2) ; pati ent DFN
11663	"RTN","BPS SCRRJ",21, 0)
11664	S BPINSIE N=+$P(BPSE L,U,3) ; insu rance ien
11665	"RTN","BPS SCRRJ",22, 0)
11666	S BPORI59 =$P(BPSEL, U,4) I 'BP ORI59 G EN X ; BPS Transactio n ien
11667	"RTN","BPS SCRRJ",23, 0)
11668	S RXREF=$ $RXREF^BPS SCRU2(BPOR I59)
11669	"RTN","BPS SCRRJ",24, 0)
11670	S RXIEN=$ P(RXREF,U, 1) I 'RXIE N G ENX ; pres cription i en
11671	"RTN","BPS SCRRJ",25, 0)
11672	S RXFIL=$ P(RXREF,U, 2) ; fill #
11673	"RTN","BPS SCRRJ",26, 0)
11674	;
11675	"RTN","BPS SCRRJ",27, 0)
11676	; the cla im must ei ther be re jected or non-billab le to be e ligible fo r this act ion
11677	"RTN","BPS SCRRJ",28, 0)
11678	I '$$REJE CTED^BPSSC R02(BPORI5 9),'$$NB^B PSSCR03(BP ORI59) D G ENX
11679	"RTN","BPS SCRRJ",29, 0)
11680	. W !!,"T his claim is not a v alid selec tion for t he OPECC R eject Info rmation sc reen."
11681	"RTN","BPS SCRRJ",30, 0)
11682	. W !,"Th is screen is for eit her reject ed claims or non-bil lable clai ms."
11683	"RTN","BPS SCRRJ",31, 0)
11684	. D PAUSE ^VALM1
11685	"RTN","BPS SCRRJ",32, 0)
11686	. Q
11687	"RTN","BPS SCRRJ",33, 0)
11688	;
11689	"RTN","BPS SCRRJ",34, 0)
11690	D EN^VALM ("BPS OPEC C REJECT I NFORMATION ")
11691	"RTN","BPS SCRRJ",35, 0)
11692	ENX ;
11693	"RTN","BPS SCRRJ",36, 0)
11694	S VALMBCK ="R"
11695	"RTN","BPS SCRRJ",37, 0)
11696	Q
11697	"RTN","BPS SCRRJ",38, 0)
11698	;
11699	"RTN","BPS SCRRJ",39, 0)
11700	;
11701	"RTN","BPS SCRRJ",40, 0)
11702	INIT ; -- init varia bles and l ist array
11703	"RTN","BPS SCRRJ",41, 0)
11704	;
11705	"RTN","BPS SCRRJ",42, 0)
11706	K ^TMP("B PSSCRRJ",$ J),^TMP("P SOPI",$J)
11707	"RTN","BPS SCRRJ",43, 0)
11708	S LINE=0, VALMCNT=0
11709	"RTN","BPS SCRRJ",44, 0)
11710	S (DFN,PS ODFN)=+$P( $G(^BPST(B PORI59,0)) ,U,6)
11711	"RTN","BPS SCRRJ",45, 0)
11712	;
11713	"RTN","BPS SCRRJ",46, 0)
11714	D REJ ; ma in reject informatio n
11715	"RTN","BPS SCRRJ",47, 0)
11716	D BPSCOM ; ec me opecc c omments
11717	"RTN","BPS SCRRJ",48, 0)
11718	D PSOCOM ; ps o pharmaci st comment s
11719	"RTN","BPS SCRRJ",49, 0)
11720	D INS ; in surance in formation
11721	"RTN","BPS SCRRJ",50, 0)
11722	;
11723	"RTN","BPS SCRRJ",51, 0)
11724	INITX ;
11725	"RTN","BPS SCRRJ",52, 0)
11726	Q
11727	"RTN","BPS SCRRJ",53, 0)
11728	;
11729	"RTN","BPS SCRRJ",54, 0)
11730	REJ ; main reject in formation data captu re and dis play
11731	"RTN","BPS SCRRJ",55, 0)
11732	;
11733	"RTN","BPS SCRRJ",56, 0)
11734	N BBTXT,R XCOB,ELIG, STATUS,RES PIEN,BPPOS ,BPRJ,BPN, RSPREC,Z,D G,CODE,DES C,BPSNAF,B PPMSG,BPAR R,PREFIX,T XTLN,BPADD MSG,PAMSG, TX
11735	"RTN","BPS SCRRJ",57, 0)
11736	S BBTXT=" "
11737	"RTN","BPS SCRRJ",58, 0)
11738	S RXCOB=+ $P($G(^BPS T(BPORI59, 0)),U,14) I 'RXCOB S RXCOB=1
11739	"RTN","BPS SCRRJ",59, 0)
11740	I $$BBILL ^BPSBUTL(R XIEN,RXFIL ,RXCOB) S BBTXT=" BA CK-BILL"
11741	"RTN","BPS SCRRJ",60, 0)
11742	E I $$RE SUBMIT^BPS BUTL(RXIEN ,RXFIL,RXC OB) S BBTX T=" RESUBM ISSION"
11743	"RTN","BPS SCRRJ",61, 0)
11744	S ELIG=$P ($G(^BPST( BPORI59,9) ),U,4)
11745	"RTN","BPS SCRRJ",62, 0)
11746	S ELIG=$S (ELIG="C": "CHAMPVA", ELIG="T":" TRICARE",1 :"Veteran" )
11747	"RTN","BPS SCRRJ",63, 0)
11748	D SETLN(" REJECT Inf ormation ( "_ELIG_") "_BBTXT,1, 1)
11749	"RTN","BPS SCRRJ",64, 0)
11750	;
11751	"RTN","BPS SCRRJ",65, 0)
11752	; for non -billable entries di splay some custom in formation and get ou t
11753	"RTN","BPS SCRRJ",66, 0)
11754	; most of this sect ion will n ot work fo r non-bill ables beca use there is no ECME claim or response
11755	"RTN","BPS SCRRJ",67, 0)
11756	I $$NB^BP SSCR03(BPO RI59) D G REJX
11757	"RTN","BPS SCRRJ",68, 0)
11758	. D SETLN ("Current ECME Statu s: N/A for Non-Billa ble Entry" )
11759	"RTN","BPS SCRRJ",69, 0)
11760	. D SETLN ($$EREJTXT ^BPSSCR03( BPORI59))
11761	"RTN","BPS SCRRJ",70, 0)
11762	. Q
11763	"RTN","BPS SCRRJ",71, 0)
11764	;
11765	"RTN","BPS SCRRJ",72, 0)
11766	; the res t of this procedure is for a n ormal reje cted claim /response
11767	"RTN","BPS SCRRJ",73, 0)
11768	;
11769	"RTN","BPS SCRRJ",74, 0)
11770	S STATUS= $P($$STATU S^BPSOSRX( RXIEN,RXFI L,,,RXCOB) ,U,1)
11771	"RTN","BPS SCRRJ",75, 0)
11772	D SETLN(" Current EC ME Status: "_STATUS)
11773	"RTN","BPS SCRRJ",76, 0)
11774	;
11775	"RTN","BPS SCRRJ",77, 0)
11776	I '$$GRES PPOS^BPSSC RU3(BPORI5 9,.RESPIEN ,.BPPOS) D G INITX
11777	"RTN","BPS SCRRJ",78, 0)
11778	. D SETLN ("No ECME Response i nformation can be fo und.")
11779	"RTN","BPS SCRRJ",79, 0)
11780	. Q
11781	"RTN","BPS SCRRJ",80, 0)
11782	;
11783	"RTN","BPS SCRRJ",81, 0)
11784	I '$G(RES PIEN) D G INITX
11785	"RTN","BPS SCRRJ",82, 0)
11786	. D SETLN ("SYSTEM E RROR: No E CME Respon se informa tion can b e found.")
11787	"RTN","BPS SCRRJ",83, 0)
11788	. Q
11789	"RTN","BPS SCRRJ",84, 0)
11790	;
11791	"RTN","BPS SCRRJ",85, 0)
11792	; get the number of rejects o n file and the rejec t codes/de scriptions
11793	"RTN","BPS SCRRJ",86, 0)
11794	K BPRJ S BPN=0
11795	"RTN","BPS SCRRJ",87, 0)
11796	D GETRJCO D^BPSSCRU3 (BPORI59,. BPRJ,.BPN, 74,"")
11797	"RTN","BPS SCRRJ",88, 0)
11798	I BPN D ; if t here are r ejects
11799	"RTN","BPS SCRRJ",89, 0)
11800	. S RSPRE C=$P($G(^B PSR(RESPIE N,0)),U,2) ; dat e/time res ponse rece ived
11801	"RTN","BPS SCRRJ",90, 0)
11802	. D SETLN ("Reject"_ $S(BPN>1:" s",1:"")_" received from Payer on "_$$FM TE^XLFDT(R SPREC,"5ZP S")_"."),S ETLN(" ")
11803	"RTN","BPS SCRRJ",91, 0)
11804	. D SETLN (" Code Descriptio n")
11805	"RTN","BPS SCRRJ",92, 0)
11806	. S Z=0 F S Z=$O(B PRJ(Z)) Q: 'Z D
11807	"RTN","BPS SCRRJ",93, 0)
11808	.. S DG=$ G(BPRJ(Z)) ,CODE=$P(D G,":",1),D ESC=$P(DG, ":",2,99)
11809	"RTN","BPS SCRRJ",94, 0)
11810	.. D SETL N($J(CODE, 5)_" - "_D ESC)
11811	"RTN","BPS SCRRJ",95, 0)
11812	.. Q
11813	"RTN","BPS SCRRJ",96, 0)
11814	. D SETLN (" ")
11815	"RTN","BPS SCRRJ",97, 0)
11816	. Q
11817	"RTN","BPS SCRRJ",98, 0)
11818	I 'BPN D SETLN("No Reject Inf ormation w as found." ),SETLN(" ")
11819	"RTN","BPS SCRRJ",99, 0)
11820	;
11821	"RTN","BPS SCRRJ",100 ,0)
11822	; get and display n ext availa ble fill d ate from t he respons e file
11823	"RTN","BPS SCRRJ",101 ,0)
11824	S BPSNAF= $$NFLDT^BP SBUTL(RXIE N,RXFIL,RX COB)
11825	"RTN","BPS SCRRJ",102 ,0)
11826	I BPSNAF' ="" D SETL N("Next Av ail Fill: "_$$FMTE^X LFDT(BPSNA F,"5DZ"))
11827	"RTN","BPS SCRRJ",103 ,0)
11828	;
11829	"RTN","BPS SCRRJ",104 ,0)
11830	; get and display p ayer messa ge (504-F4 )
11831	"RTN","BPS SCRRJ",105 ,0)
11832	S BPPMSG= $$MESSAGE^ BPSSCRLG(R ESPIEN) ; payer m essage (50 4-F4)
11833	"RTN","BPS SCRRJ",106 ,0)
11834	D WRAPTXT (BPPMSG,62 ,.BPARR)
11835	"RTN","BPS SCRRJ",107 ,0)
11836	S BPN=0 F S BPN=$O (BPARR(BPN )) Q:'BPN D
11837	"RTN","BPS SCRRJ",108 ,0)
11838	. S PREFI X=$S(BPN=1 :"Payer Me ssage :", 1:"")
11839	"RTN","BPS SCRRJ",109 ,0)
11840	. S TXTLN =$$LJ^XLFS TR(PREFIX, 17)_$G(BPA RR(BPN,0))
11841	"RTN","BPS SCRRJ",110 ,0)
11842	. D SETLN (TXTLN)
11843	"RTN","BPS SCRRJ",111 ,0)
11844	. Q
11845	"RTN","BPS SCRRJ",112 ,0)
11846	;
11847	"RTN","BPS SCRRJ",113 ,0)
11848	; get and display p ayer addit ional mess age (526-F Q)
11849	"RTN","BPS SCRRJ",114 ,0)
11850	K BPADDMS G
11851	"RTN","BPS SCRRJ",115 ,0)
11852	D ADDMESS ^BPSSCRLG( RESPIEN,1, .BPADDMSG)
11853	"RTN","BPS SCRRJ",116 ,0)
11854	S PAMSG=" "
11855	"RTN","BPS SCRRJ",117 ,0)
11856	S BPN=0 F S BPN=$O (BPADDMSG( BPN)) Q:'B PN S TX=$ G(BPADDMSG (BPN)),PAM SG=$S(PAMS G="":TX,1: PAMSG_" "_ TX)
11857	"RTN","BPS SCRRJ",118 ,0)
11858	D WRAPTXT (PAMSG,62, .BPARR)
11859	"RTN","BPS SCRRJ",119 ,0)
11860	S BPN=0 F S BPN=$O (BPARR(BPN )) Q:'BPN D
11861	"RTN","BPS SCRRJ",120 ,0)
11862	. S PREFI X=$S(BPN=1 :"Payer Ad dl Msg :", 1:"")
11863	"RTN","BPS SCRRJ",121 ,0)
11864	. S TXTLN =$$LJ^XLFS TR(PREFIX, 17)_$G(BPA RR(BPN,0))
11865	"RTN","BPS SCRRJ",122 ,0)
11866	. D SETLN (TXTLN)
11867	"RTN","BPS SCRRJ",123 ,0)
11868	. Q
11869	"RTN","BPS SCRRJ",124 ,0)
11870	;
11871	"RTN","BPS SCRRJ",125 ,0)
11872	REJX ;
11873	"RTN","BPS SCRRJ",126 ,0)
11874	D SETLN(" "),SETLN( " ")
11875	"RTN","BPS SCRRJ",127 ,0)
11876	Q
11877	"RTN","BPS SCRRJ",128 ,0)
11878	;
11879	"RTN","BPS SCRRJ",129 ,0)
11880	BPSCOM ; d isplay ful l opecc co mments her e
11881	"RTN","BPS SCRRJ",130 ,0)
11882	N CMTDT,Z N,CDAT,CDA TE,CUSER,R XFLG,TXT,C TXT,L,TXTL N
11883	"RTN","BPS SCRRJ",131 ,0)
11884	D SETLN(" OPECC COMM ENTS",1,1)
11885	"RTN","BPS SCRRJ",132 ,0)
11886	;
11887	"RTN","BPS SCRRJ",133 ,0)
11888	I '$O(^BP ST(BPORI59 ,11,0)) D SETLN(" T here are n o comments found for this sect ion.") G B PSCOMX
11889	"RTN","BPS SCRRJ",134 ,0)
11890	;
11891	"RTN","BPS SCRRJ",135 ,0)
11892	S CMTDT=" " F S CM TDT=$O(^BP ST(BPORI59 ,11,"B",CM TDT),-1) Q :'CMTDT S ZN=" " F S ZN=$O(^ BPST(BPORI 59,11,"B", CMTDT,ZN), -1) Q:'ZN D
11893	"RTN","BPS SCRRJ",136 ,0)
11894	. S CDAT= $G(^BPST(B PORI59,11, ZN,0))
11895	"RTN","BPS SCRRJ",137 ,0)
11896	. S CDATE =$$FMTE^XL FDT(CMTDT, "2ZMP") ; extern al date/ti me of comm ent
11897	"RTN","BPS SCRRJ",138 ,0)
11898	. S CUSER =$P($G(^VA (200,+$P(C DAT,U,2),0 )),U,1) ; user n ame who en tered comm ent
11899	"RTN","BPS SCRRJ",139 ,0)
11900	. S RXFLG =$S($P(CDA T,U,4):" ( Pharm)",1: "") ; flag t hat says i f opecc co mment shou ld be disp layed on P SO RI scre en
11901	"RTN","BPS SCRRJ",140 ,0)
11902	. S TXT=C DATE_RXFLG _" - "_$P( CDAT,U,3)_ " ("_CUSER _")"
11903	"RTN","BPS SCRRJ",141 ,0)
11904	. D WRAPT XT(TXT,76, .CTXT)
11905	"RTN","BPS SCRRJ",142 ,0)
11906	. S L=0 F S L=$O(C TXT(L)) Q: 'L D
11907	"RTN","BPS SCRRJ",143 ,0)
11908	.. S TXTL N=$S(L=1:" - ",1:" ")_$G(CTXT (L,0))
11909	"RTN","BPS SCRRJ",144 ,0)
11910	.. D SETL N(TXTLN)
11911	"RTN","BPS SCRRJ",145 ,0)
11912	.. Q
11913	"RTN","BPS SCRRJ",146 ,0)
11914	. Q
11915	"RTN","BPS SCRRJ",147 ,0)
11916	;
11917	"RTN","BPS SCRRJ",148 ,0)
11918	BPSCOMX ;
11919	"RTN","BPS SCRRJ",149 ,0)
11920	D SETLN(" "),SETLN( " ")
11921	"RTN","BPS SCRRJ",150 ,0)
11922	Q
11923	"RTN","BPS SCRRJ",151 ,0)
11924	;
11925	"RTN","BPS SCRRJ",152 ,0)
11926	PSOCOM ; d isplay the PSO comme nts from t he pharmac ist
11927	"RTN","BPS SCRRJ",153 ,0)
11928	N RXCOB,C OM,REJ,NUM REJ,REJIEN ,REJDESC,C OMDT,Z1,CD AT,CDATE,C USER,TXT,C TXT,L,TXTL N
11929	"RTN","BPS SCRRJ",154 ,0)
11930	;
11931	"RTN","BPS SCRRJ",155 ,0)
11932	S RXCOB=+ $P($G(^BPS T(BPORI59, 0)),U,14) I 'RXCOB S RXCOB=1
11933	"RTN","BPS SCRRJ",156 ,0)
11934	D REJCOM^ PSOREJU4(R XIEN,RXFIL ,RXCOB,.CO M) ; b uild the P SO comment s array fo r this Rx/ fill/cob ( ICR# 6227)
11935	"RTN","BPS SCRRJ",157 ,0)
11936	;
11937	"RTN","BPS SCRRJ",158 ,0)
11938	D SETLN(" PHARMACIST COMMENTS" ,1,1)
11939	"RTN","BPS SCRRJ",159 ,0)
11940	;
11941	"RTN","BPS SCRRJ",160 ,0)
11942	S REJ="" F NUMREJ=0 :1 S REJ=$ O(COM(REJ) ) Q:REJ="" ; cou nt the num ber of rej ect codes that have PSO commen ts
11943	"RTN","BPS SCRRJ",161 ,0)
11944	I 'NUMREJ D SETLN(" There ar e no comme nts found for this s ection.") G PSOCOMX
11945	"RTN","BPS SCRRJ",162 ,0)
11946	;
11947	"RTN","BPS SCRRJ",163 ,0)
11948	S REJ="" F S REJ=$ O(COM(REJ) ) Q:REJ="" D
11949	"RTN","BPS SCRRJ",164 ,0)
11950	. ;
11951	"RTN","BPS SCRRJ",165 ,0)
11952	. ; if th ere are 2 or more re ject codes that have comments, then disp lay the re ject code/ descriptio n here
11953	"RTN","BPS SCRRJ",166 ,0)
11954	. I NUMRE J>1 D
11955	"RTN","BPS SCRRJ",167 ,0)
11956	.. S REJI EN=+$O(^BP SF(9002313 .93,"B",RE J,""),-1) ; rej ect code i nternal IE N
11957	"RTN","BPS SCRRJ",168 ,0)
11958	.. S REJD ESC=$P($G( ^BPSF(9002 313.93,REJ IEN,0)),U, 2) ; rej ect descri ption
11959	"RTN","BPS SCRRJ",169 ,0)
11960	.. D SETL N(REJ_" - "_REJDESC)
11961	"RTN","BPS SCRRJ",170 ,0)
11962	.. Q
11963	"RTN","BPS SCRRJ",171 ,0)
11964	. ;
11965	"RTN","BPS SCRRJ",172 ,0)
11966	. S COMDT =" " F S COMDT=$O(C OM(REJ,COM DT),-1) Q: 'COMDT S Z1=" " F S Z1=$O(CO M(REJ,COMD T,Z1),-1) Q:'Z1 D
11967	"RTN","BPS SCRRJ",173 ,0)
11968	.. S CDAT =$G(COM(RE J,COMDT,Z1 ))
11969	"RTN","BPS SCRRJ",174 ,0)
11970	.. S CDAT E=$$FMTE^X LFDT($P(CD AT,U,1),"2 ZMP")
11971	"RTN","BPS SCRRJ",175 ,0)
11972	.. S CUSE R=$P($G(^V A(200,+$P( CDAT,U,2), 0)),U,1)
11973	"RTN","BPS SCRRJ",176 ,0)
11974	.. S TXT= CDATE_" - "_$P(CDAT, U,3)_" ("_ CUSER_")"
11975	"RTN","BPS SCRRJ",177 ,0)
11976	.. D WRAP TXT(TXT,76 ,.CTXT)
11977	"RTN","BPS SCRRJ",178 ,0)
11978	.. S L=0 F S L=$O( CTXT(L)) Q :'L D
11979	"RTN","BPS SCRRJ",179 ,0)
11980	... S TXT LN=$S(L=1: "- ",1:" ")_$G(CTX T(L,0))
11981	"RTN","BPS SCRRJ",180 ,0)
11982	... D SET LN(TXTLN)
11983	"RTN","BPS SCRRJ",181 ,0)
11984	... Q
11985	"RTN","BPS SCRRJ",182 ,0)
11986	.. Q
11987	"RTN","BPS SCRRJ",183 ,0)
11988	. ;
11989	"RTN","BPS SCRRJ",184 ,0)
11990	. ; if th ere are mo re reject codes, dis play a bla nk line he re before the next r eject code
11991	"RTN","BPS SCRRJ",185 ,0)
11992	. I $O(CO M(REJ))'=" " D SETLN( " ")
11993	"RTN","BPS SCRRJ",186 ,0)
11994	. Q
11995	"RTN","BPS SCRRJ",187 ,0)
11996	;
11997	"RTN","BPS SCRRJ",188 ,0)
11998	PSOCOMX ;
11999	"RTN","BPS SCRRJ",189 ,0)
12000	D SETLN(" "),SETLN( " ")
12001	"RTN","BPS SCRRJ",190 ,0)
12002	Q
12003	"RTN","BPS SCRRJ",191 ,0)
12004	;
12005	"RTN","BPS SCRRJ",192 ,0)
12006	INS ; gath er and sho w insuranc e informat ion
12007	"RTN","BPS SCRRJ",193 ,0)
12008	N BPSINS, IENS,INSNA ME,RXCOB,B PSPOL,BPSE FDT
12009	"RTN","BPS SCRRJ",194 ,0)
12010	S BPSINS= +$$GET1^DI Q(9002313. 59,BPORI59 ,901,"I") I 'BPSINS S BPSINS=1
12011	"RTN","BPS SCRRJ",195 ,0)
12012	S IENS=BP SINS_","_B PORI59_","
12013	"RTN","BPS SCRRJ",196 ,0)
12014	S RXCOB=+ $P($G(^BPS T(BPORI59, 0)),U,14) I 'RXCOB S RXCOB=1
12015	"RTN","BPS SCRRJ",197 ,0)
12016	;
12017	"RTN","BPS SCRRJ",198 ,0)
12018	S INSNAME =$$LJ^XLFS TR($$GET1^ DIQ(900231 3.59902,IE NS,902.24) ,32)
12019	"RTN","BPS SCRRJ",199 ,0)
12020	I RXCOB=2 S INSNAME =INSNAME_" Coord. Of Benefits: SECONDARY"
12021	"RTN","BPS SCRRJ",200 ,0)
12022	S BPSPOL= +$$GET1^DI Q(9002313. 59902,IENS ,902.35,"I ") ; pt insuran ce 2.312 s ubfile ien
12023	"RTN","BPS SCRRJ",201 ,0)
12024	S BPSEFDT =$S(BPSPOL :+$P($G(^D PT(DFN,.31 2,BPSPOL,0 )),U,8)\1, 1:"") ; policy eff ective dat e
12025	"RTN","BPS SCRRJ",202 ,0)
12026	I BPSEFDT S BPSEFDT =$$FMTE^XL FDT(BPSEFD T,"5DZ") ; external p olicy effe ctive date
12027	"RTN","BPS SCRRJ",203 ,0)
12028	;
12029	"RTN","BPS SCRRJ",204 ,0)
12030	D SETLN(" INSURANCE Informatio n",1,1)
12031	"RTN","BPS SCRRJ",205 ,0)
12032	D SETLN(" Insurance : "_I NSNAME)
12033	"RTN","BPS SCRRJ",206 ,0)
12034	D SETLN(" Contact : "_$ $GET1^DIQ( 9002313.59 902,IENS,9 02.26))
12035	"RTN","BPS SCRRJ",207 ,0)
12036	D SETLN(" BIN : "_$ $GET1^DIQ( 9002313.59 902,IENS,9 02.03))
12037	"RTN","BPS SCRRJ",208 ,0)
12038	D SETLN(" PCN : "_$ $GET1^DIQ( 9002313.59 902,IENS,9 02.04))
12039	"RTN","BPS SCRRJ",209 ,0)
12040	D SETLN(" Group Numb er : "_$ $GET1^DIQ( 9002313.59 902,IENS,9 02.05))
12041	"RTN","BPS SCRRJ",210 ,0)
12042	D SETLN(" Cardholder ID : "_$ $GET1^DIQ( 9002313.59 902,IENS,9 02.06))
12043	"RTN","BPS SCRRJ",211 ,0)
12044	D SETLN(" Effective Date : "_B PSEFDT)
12045	"RTN","BPS SCRRJ",212 ,0)
12046	;
12047	"RTN","BPS SCRRJ",213 ,0)
12048	INSX ;
12049	"RTN","BPS SCRRJ",214 ,0)
12050	D SETLN(" "),SETLN( " ")
12051	"RTN","BPS SCRRJ",215 ,0)
12052	Q
12053	"RTN","BPS SCRRJ",216 ,0)
12054	;
12055	"RTN","BPS SCRRJ",217 ,0)
12056	WRAPTXT(X, DIWR,RET) ; wrap tex t in varia ble X with right mar gin DIWR, return in array RET
12057	"RTN","BPS SCRRJ",218 ,0)
12058	N %,DIW,D IWF,DIWI,D IWL,DIWT,D IWTC,DIWX, DN,I,Z
12059	"RTN","BPS SCRRJ",219 ,0)
12060	K ^UTILIT Y($J,"W"), RET
12061	"RTN","BPS SCRRJ",220 ,0)
12062	S DIWL=1
12063	"RTN","BPS SCRRJ",221 ,0)
12064	D ^DIWP
12065	"RTN","BPS SCRRJ",222 ,0)
12066	M RET=^UT ILITY($J," W",1)
12067	"RTN","BPS SCRRJ",223 ,0)
12068	K ^UTILIT Y($J,"W")
12069	"RTN","BPS SCRRJ",224 ,0)
12070	WRAPX ;
12071	"RTN","BPS SCRRJ",225 ,0)
12072	Q
12073	"RTN","BPS SCRRJ",226 ,0)
12074	;
12075	"RTN","BPS SCRRJ",227 ,0)
12076	HELP ; -- help code
12077	"RTN","BPS SCRRJ",228 ,0)
12078	S X="?" D DISP^XQOR M1 W !!
12079	"RTN","BPS SCRRJ",229 ,0)
12080	Q
12081	"RTN","BPS SCRRJ",230 ,0)
12082	;
12083	"RTN","BPS SCRRJ",231 ,0)
12084	EXIT ; -- exit code
12085	"RTN","BPS SCRRJ",232 ,0)
12086	K ^TMP("B PSSCRRJ",$ J),^TMP("P SOPI",$J)
12087	"RTN","BPS SCRRJ",233 ,0)
12088	Q
12089	"RTN","BPS SCRRJ",234 ,0)
12090	;
12091	"RTN","BPS SCRRJ",235 ,0)
12092	SETLN(TEXT ,REV,UND,H IG) ; set a line int o the List Man array
12093	"RTN","BPS SCRRJ",236 ,0)
12094	I $G(TEXT )="" S TEX T=" "
12095	"RTN","BPS SCRRJ",237 ,0)
12096	I $L(TEXT )>80 S TEX T=$E(TEXT, 1,80)
12097	"RTN","BPS SCRRJ",238 ,0)
12098	S LINE=LI NE+1
12099	"RTN","BPS SCRRJ",239 ,0)
12100	D SET^VAL M10(LINE,T EXT)
12101	"RTN","BPS SCRRJ",240 ,0)
12102	S VALMCNT =LINE
12103	"RTN","BPS SCRRJ",241 ,0)
12104	;
12105	"RTN","BPS SCRRJ",242 ,0)
12106	I $G(REV) D G SETL NX
12107	"RTN","BPS SCRRJ",243 ,0)
12108	. D CNTRL ^VALM10(LI NE,1,$L(TE XT),IORVON ,IOINORM)
12109	"RTN","BPS SCRRJ",244 ,0)
12110	. I $G(UN D) D CNTRL ^VALM10(LI NE,$L(TEXT )+1,80,IOU ON,IOINORM )
12111	"RTN","BPS SCRRJ",245 ,0)
12112	. Q
12113	"RTN","BPS SCRRJ",246 ,0)
12114	;
12115	"RTN","BPS SCRRJ",247 ,0)
12116	I $G(UND) D CNTRL^V ALM10(LINE ,1,80,IOUO N,IOINORM)
12117	"RTN","BPS SCRRJ",248 ,0)
12118	;
12119	"RTN","BPS SCRRJ",249 ,0)
12120	I $G(HIG) D CNTRL^V ALM10(LINE ,HIG,80,IO INHI_$S($G (UND):IOUO N,1:""),IO INORM)
12121	"RTN","BPS SCRRJ",250 ,0)
12122	;
12123	"RTN","BPS SCRRJ",251 ,0)
12124	SETLNX ;
12125	"RTN","BPS SCRRJ",252 ,0)
12126	Q
12127	"RTN","BPS SCRRJ",253 ,0)
12128	;
12129	"RTN","BPS SCRRJ",254 ,0)
12130	HDR ; -- h eader code
12131	"RTN","BPS SCRRJ",255 ,0)
12132	S VALMHDR (1)=$$DVIN FO(RXIEN,R XFIL) ; div ision, npi , ncpdp da ta
12133	"RTN","BPS SCRRJ",256 ,0)
12134	S VALMHDR (2)=$$PTIN FO(RXIEN) ; Pat ient data
12135	"RTN","BPS SCRRJ",257 ,0)
12136	S VALMHDR (3)=$$RXIN FO1(RXIEN, RXFIL) ; Rx data part 1
12137	"RTN","BPS SCRRJ",258 ,0)
12138	S VALMHDR (4)=$$RXIN FO2(RXIEN, RXFIL) ; Rx data part 2
12139	"RTN","BPS SCRRJ",259 ,0)
12140	Q
12141	"RTN","BPS SCRRJ",260 ,0)
12142	;
12143	"RTN","BPS SCRRJ",261 ,0)
12144	DVINFO(RX, RFL) ; hea der divisi on data
12145	"RTN","BPS SCRRJ",262 ,0)
12146	;Input: ( r) RX - Rx IEN (#5 2)
12147	"RTN","BPS SCRRJ",263 ,0)
12148	; ( o) RFL - Refill #
12149	"RTN","BPS SCRRJ",264 ,0)
12150	N BPSTAXI D,DVIEN,DV INFO,NCPNP I
12151	"RTN","BPS SCRRJ",265 ,0)
12152	S DVINFO= "Division : "_$E($$G ET1^DIQ(90 02313.59,B PORI59,11) ,1,15) ; P harmacy Di vision nam e from BPS Transacti on
12153	"RTN","BPS SCRRJ",266 ,0)
12154	;Display both NPI a nd NCPDP n umbers
12155	"RTN","BPS SCRRJ",267 ,0)
12156	S DVIEN=+ $$RXSITE^P SOBPSUT(RX ,RFL) ; ICR# 4 701
12157	"RTN","BPS SCRRJ",268 ,0)
12158	S NCPNPI= $$DIVNCPDP ^BPSBUTL(D VIEN)
12159	"RTN","BPS SCRRJ",269 ,0)
12160	S $E(DVIN FO,28)="NP I: "_$P(NC PNPI,U,2)
12161	"RTN","BPS SCRRJ",270 ,0)
12162	S $E(DVIN FO,44)="NC PDP: "_$P( NCPNPI,U,1 )
12163	"RTN","BPS SCRRJ",271 ,0)
12164	S BPSTAXI D=$P($$TAX ID^IBCEF75 ,U,2) ; ICR# 6 768
12165	"RTN","BPS SCRRJ",272 ,0)
12166	S $E(DVIN FO,62)="TA X ID: "_$E (BPSTAXID, 1,2)_"-"_$ E(BPSTAXID ,3,$L(BPST AXID))
12167	"RTN","BPS SCRRJ",273 ,0)
12168	Q DVINFO
12169	"RTN","BPS SCRRJ",274 ,0)
12170	;
12171	"RTN","BPS SCRRJ",275 ,0)
12172	PTINFO(RX) ; header patient da ta
12173	"RTN","BPS SCRRJ",276 ,0)
12174	;Input: ( r) RX - Rx IEN (#5 2)
12175	"RTN","BPS SCRRJ",277 ,0)
12176	N DFN,VAD M,PTINFO,S SN4
12177	"RTN","BPS SCRRJ",278 ,0)
12178	S DFN=+$P ($G(^BPST( BPORI59,0) ),U,6)
12179	"RTN","BPS SCRRJ",279 ,0)
12180	D DEM^VAD PT S SSN4= $P($G(VADM (2)),U,2)
12181	"RTN","BPS SCRRJ",280 ,0)
12182	S PTINFO= "Patient : "_$E($G( VADM(1)),1 ,24)_"("_$ E(SSN4,$L( SSN4)-3,$L (SSN4))_") "
12183	"RTN","BPS SCRRJ",281 ,0)
12184	S PTINFO= PTINFO_" Sex: "_$P( $G(VADM(5) ),U,1)
12185	"RTN","BPS SCRRJ",282 ,0)
12186	S $E(PTIN FO,61)="DO B: "_$P($G (VADM(3)), U,2)_"("_$ P($G(VADM( 4)),U,1)_" )"
12187	"RTN","BPS SCRRJ",283 ,0)
12188	Q PTINFO
12189	"RTN","BPS SCRRJ",284 ,0)
12190	;
12191	"RTN","BPS SCRRJ",285 ,0)
12192	RXINFO1(RX ,FILL) ; h eader Rx d ata part 1
12193	"RTN","BPS SCRRJ",286 ,0)
12194	N RXINFO, RXDOS,PSOE T
12195	"RTN","BPS SCRRJ",287 ,0)
12196	D GETDAT^ BPSBUTL(RX ,FILL,,.RX DOS) ; Get Date of S ervice fro m BPS CLAI M field 40 1
12197	"RTN","BPS SCRRJ",288 ,0)
12198	S RXINFO= "Rx# : "_$$RXNU M^BPSSCRU2 (RX)_"/"_F ILL
12199	"RTN","BPS SCRRJ",289 ,0)
12200	S PSOET=$ $NB^BPSSCR 03(BPORI59 ) ; TRI/CVA non-billab le entry
12201	"RTN","BPS SCRRJ",290 ,0)
12202	S $E(RXIN FO,27)="EC ME#: "_$S( PSOET:"",1 :$P($$CLAI M^BPSBUTL( RX,FILL),U ,6))
12203	"RTN","BPS SCRRJ",291 ,0)
12204	S $E(RXIN FO,49)="Da te of Serv ice: "_$S( PSOET:"",1 :$$FMTE^XL FDT(RXDOS) ) ; Use DO S from BPS Claims fi eld 401
12205	"RTN","BPS SCRRJ",292 ,0)
12206	Q RXINFO
12207	"RTN","BPS SCRRJ",293 ,0)
12208	;
12209	"RTN","BPS SCRRJ",294 ,0)
12210	RXINFO2(RX ,FILL) ; h eader Rx d ata part 2
12211	"RTN","BPS SCRRJ",295 ,0)
12212	N RXINFO, DRG,CMOP
12213	"RTN","BPS SCRRJ",296 ,0)
12214	S DRG=+$$ RXAPI1^BPS UTIL1(RX,6 ,"I") ; drug ien
12215	"RTN","BPS SCRRJ",297 ,0)
12216	S CMOP=$$ DRUGDIE^BP SUTIL1(DRG ,213,"I") ; cmop dis pense fiel d in the D rug file ( 0/1)
12217	"RTN","BPS SCRRJ",298 ,0)
12218	S RXINFO= $S(CMOP:"C MOP ",1:"" )_"Drug"
12219	"RTN","BPS SCRRJ",299 ,0)
12220	S $E(RXIN FO,10)=": "_$E($$RXA PI1^BPSUTI L1(RX,6),1 ,43) ; drug nam e
12221	"RTN","BPS SCRRJ",300 ,0)
12222	;
12223	"RTN","BPS SCRRJ",301 ,0)
12224	S $E(RXIN FO,56)="ND C Code: "_ $$GETNDC^P SONDCUT(RX ,FILL) ; ICR# 470 5
12225	"RTN","BPS SCRRJ",302 ,0)
12226	Q RXINFO
12227	"RTN","BPS SCRRJ",303 ,0)
12228	;
12229	"RTN","BPS SCRRJ",304 ,0)
12230	VER ; sele ction of V iew ePharm acy Rx fro m the BPS OPECC reje ct informa tion scree n
12231	"RTN","BPS SCRRJ",305 ,0)
12232	N BPSVRX
12233	"RTN","BPS SCRRJ",306 ,0)
12234	D FULL^VA LM1
12235	"RTN","BPS SCRRJ",307 ,0)
12236	S BPSVRX( "RXIEN")=$ G(RXIEN)
12237	"RTN","BPS SCRRJ",308 ,0)
12238	S BPSVRX( "FILL#")=$ G(RXFIL)
12239	"RTN","BPS SCRRJ",309 ,0)
12240	D ^BPSVRX
12241	"RTN","BPS SCRRJ",310 ,0)
12242	VERX ;
12243	"RTN","BPS SCRRJ",311 ,0)
12244	S VALMBCK ="R"
12245	"RTN","BPS SCRRJ",312 ,0)
12246	Q
12247	"RTN","BPS SCRRJ",313 ,0)
12248	;
12249	"RTN","BPS SCRRJ",314 ,0)
12250	VIEW ; act ion for Vi ew Rx on t he BPS OPE CC reject informatio n screen
12251	"RTN","BPS SCRRJ",315 ,0)
12252	N VALMCNT ,LINE,VALM HDR,TITLE, PSOVDA,DA, PS,DFN,PSO DFN
12253	"RTN","BPS SCRRJ",316 ,0)
12254	S TITLE=V ALM("TITLE ")
12255	"RTN","BPS SCRRJ",317 ,0)
12256	S (PSOVDA ,DA)=RXIEN ,PS="REJEC T"
12257	"RTN","BPS SCRRJ",318 ,0)
12258	;
12259	"RTN","BPS SCRRJ",319 ,0)
12260	; - DO st ructure us ed to avoi d losing k ey variabl es in this routine
12261	"RTN","BPS SCRRJ",320 ,0)
12262	D
12263	"RTN","BPS SCRRJ",321 ,0)
12264	. N RXIEN ,RXFIL,BPO RI59,TITLE
12265	"RTN","BPS SCRRJ",322 ,0)
12266	. D DP^PS ORXVW ; ICR# 47 11
12267	"RTN","BPS SCRRJ",323 ,0)
12268	. Q
12269	"RTN","BPS SCRRJ",324 ,0)
12270	;
12271	"RTN","BPS SCRRJ",325 ,0)
12272	S VALMBCK ="R",VALM( "TITLE")=T ITLE
12273	"RTN","BPS SCRRJ",326 ,0)
12274	Q
12275	"RTN","BPS SCRRJ",327 ,0)
12276	;
12277	"RTN","BPS SCRRJ",328 ,0)
12278	MP(RXIEN,R XFIL) ; en try point for Medica tion Profi le action on OPECC r eject info rmation sc reen
12279	"RTN","BPS SCRRJ",329 ,0)
12280	N VALMCNT ,LINE,VALM HDR,DFN,PS ODFN,BPORI 59
12281	"RTN","BPS SCRRJ",330 ,0)
12282	D MP^PSOR EJU4(RXIEN ,RXFIL) ; ICR# 6 228
12283	"RTN","BPS SCRRJ",331 ,0)
12284	S VALMBCK ="R"
12285	"RTN","BPS SCRRJ",332 ,0)
12286	Q
12287	"RTN","BPS SCRRJ",333 ,0)
12288	;
12289	"RTN","BPS SCRRJ",334 ,0)
12290	PI(RXIEN,R XFIL) ; en try point for Patien t Informat ion action on OPECC reject inf ormation s creen
12291	"RTN","BPS SCRRJ",335 ,0)
12292	N VALMCNT ,LINE,VALM HDR,DFN,PS ODFN,BPORI 59
12293	"RTN","BPS SCRRJ",336 ,0)
12294	D PI^PSOR EJU4(RXIEN ,RXFIL) ; ICR# 6 228
12295	"RTN","BPS SCRRJ",337 ,0)
12296	S VALMBCK ="R"
12297	"RTN","BPS SCRRJ",338 ,0)
12298	Q
12299	"RTN","BPS SCRRJ",339 ,0)
12300	;
12301	"RTN","BPS SCRSL")
12302	0^3^B16566 806
12303	"RTN","BPS SCRSL",1,0 )
12304	BPSSCRSL ; BHAM ISC/S S - ECME S CREEN SORT LIST ;05- APR-05
12305	"RTN","BPS SCRSL",2,0 )
12306	;;1.0;E C LAIMS MGMT ENGINE; 1,7,11,20, 22;JUN 2 004;Build 15
12307	"RTN","BPS SCRSL",3,0 )
12308	;;Per VA Directive 6402, this routine s hould not be modifie d.
12309	"RTN","BPS SCRSL",4,0 )
12310	;USER SCR EEN
12311	"RTN","BPS SCRSL",5,0 )
12312	;
12313	"RTN","BPS SCRSL",6,0 )
12314	;This sof tware is u sing PARAM ETER TOOLS (see XT7 .326) to store user 's setting s:
12315	"RTN","BPS SCRSL",7,0 )
12316	;PARAMETE R DEFINITI ON NAME="B PS USRSCR" (file #89 89.51, IA# 2263)
12317	"RTN","BPS SCRSL",8,0 )
12318	;ENTITY i s "USR" , i.e. IEN i n ^VA(200 -- see de finition f or "BPS US RSCR"
12319	"RTN","BPS SCRSL",9,0 )
12320	;INSTANCE s are as f ollows:
12321	"RTN","BPS SCRSL",10, 0)
12322	;1.01 ONE /ALL USERS --'U' ONE USER, 'A' ALL; Disp lay claims for ONE o r ALL user s
12323	"RTN","BPS SCRSL",11, 0)
12324	;1.02 ONE /ALL PATIE NTS --'P' FOR ONE PA TIENT; 'A' FOR ALL; Display cl aims for O NE/ALL PAT IENTS
12325	"RTN","BPS SCRSL",12, 0)
12326	;1.03 ONE /ALL RX -- 'R' FOR ON E RX; 'A' FOR ALL; D isplay cla ims for ON E or ALL R X
12327	"RTN","BPS SCRSL",13, 0)
12328	;1.04 HOU RS/DAYS -- 'D' FOR D AYS; 'H' F OR HOURS; Use HOURS or DAYS to specify t imeframe
12329	"RTN","BPS SCRSL",14, 0)
12330	;1.05 TIM EFRAME -- NUMBER Dep ends on th e value of the field "USR SCR HOURS/DAYS " this fie ld will
12331	"RTN","BPS SCRSL",15, 0)
12332	;store th e default number of HOURS from NOW or DA YS from TO DAY to sel ect claims to displa y
12333	"RTN","BPS SCRSL",16, 0)
12334	;1.06 REJ ECTED/PAYA BLE --'R' FOR REJECT S; 'P' FOR PAYABLES; 'U' FOR U NSTRANDED; 'A' FOR A LL; Displa y Rejects or Payable s or Unstr anded or A LL claims
12335	"RTN","BPS SCRSL",17, 0)
12336	;1.07 REL EASED/NOT RELEASED - -'R' FOR R ELEASED; ' N' FOR NON -RELEASED; 'A' FOR A LL; Displa y Released Rxs or No n-Released Rxs or AL L
12337	"RTN","BPS SCRSL",18, 0)
12338	;1.08 CMO P/MAIL/WIN DOW --'C' FOR CMOP; 'M' FOR MA IL;'W' FOR WINDOW;'A ' FOR ALL; Display C MOP or Mai l or Windo w or ALL R xs
12339	"RTN","BPS SCRSL",19, 0)
12340	;1.09 REA LTIME/BACK BILL --'R' FOR REALT IME; 'B' F OR BACKBIL LS; 'P' FO R PRO OPTI ON; 'R' FO R RESUBMIS SION; 'A' FOR ALL;
12341	"RTN","BPS SCRSL",20, 0)
12342	; Dis play (R)ea lTime, (B) ackbills, (P)RO Opti on, Re(S)u bmission o r (A)LL
12343	"RTN","BPS SCRSL",21, 0)
12344	;1.1 REJE CT CODE/AL L --'R' FO R REJECT C ODE; 'A' F OR ALL; Di splay Spec ific Rejec t Code or ALL Reject
12345	"RTN","BPS SCRSL",22, 0)
12346	;Codes 0 means ALL Reject Cod es otherwi se - Rejec t Code val ue
12347	"RTN","BPS SCRSL",23, 0)
12348	;1.11 SPE CIFIC/ALL INSURANCES --'I' FOR SPECIFIC INSURANCE( S);'A' FOR ALL; Disp lay Specif ic Insuran ce Company (s) or All null - AL L otherwis e - pointe r to INSUR ANCE COMPA NY file #3 6
12349	"RTN","BPS SCRSL",24, 0)
12350	;1.12 SOR T LIST --' T' FOR TRA NSACTION D ATE;'D' FO R DIVISION ; 'I' FOR INSURANCE; 'C' FOR R EJECT CODE ;
12351	"RTN","BPS SCRSL",25, 0)
12352	;'P' FOR PATIENT NA ME -- 'N' FOR DRUG N AME; 'B' F OR BILL TY PE (BB/P2/ RT/RS); 'L ' FOR FILL LOCATION;
12353	"RTN","BPS SCRSL",26, 0)
12354	;'R' FOR RELEASED/N ON-RELEASE D -- 'A' F OR ACTIVE/ DISCONTINU ED; the fi eld used t o sort cla ims in the list
12355	"RTN","BPS SCRSL",27, 0)
12356	;1.13 ALL ECME PHAR MACY DIVIS IONS --'D' FOR DIVIS ION; 'A' F OR ALL;
12357	"RTN","BPS SCRSL",28, 0)
12358	;1.14 SEL ECTED INSU RANCE -- S ingle, or multiple, insurance( s) to sele ct claims for the Us er Screen, to store INSURANCE COMPANY po inter (#36 )
12359	"RTN","BPS SCRSL",29, 0)
12360	;1.15 SEL ECTED REJE CTED CODE --POINTER TO BPS NCP DP REJECT CODES FILE (#9002313 .93) Rejec t code sel ected by t he user to filter cl aims.
12361	"RTN","BPS SCRSL",30, 0)
12362	;1.16 SEL ECTED USER -- POINTE R TO NEW P ERSON FILE (#200) Se lected use r for the user scree n
12363	"RTN","BPS SCRSL",31, 0)
12364	;1.17 SEL ECTED PATI ENT -- POI NTER TO PA TIENT FILE (#2) Sele cted patie nt for the User Scre en
12365	"RTN","BPS SCRSL",32, 0)
12366	;1.18 SEL ECTED RX - - POINTER TO PRESCRI PTION FILE (#52) Sel ected RX
12367	"RTN","BPS SCRSL",33, 0)
12368	;1.19 NON -BILLABLE TRI/CVA EN TRIES OPEN /CLOSED/AL L -- 'O' O pen; 'C' C losed; 'A' All
12369	"RTN","BPS SCRSL",34, 0)
12370	;2 ECM E PHARMACY DIVISION -- the lis t of POINT ERs TO BPS PHARMACIE S FILE (#9 002313.56) separated by "^"
12371	"RTN","BPS SCRSL",35, 0)
12372	;2.01 ELI GIBILITY T YPE --'V' FOR VETERA N;'T' FOR TRICARE;'C ' FOR CHAM PVA;'A' FO R ALL; Dis play claim s for spec ific Eligi bility Typ e or ALL
12373	"RTN","BPS SCRSL",36, 0)
12374	;2.02 OPE N/CLOSED/A LL --'O' O PEN CLAIMS ;'C' CLOSE D CLAIMS;' A' FOR ALL ; Display Open, Clos ed, or ALL claims
12375	"RTN","BPS SCRSL",37, 0)
12376	;2.03 SUB MISSION TY PE --'B' B ILLING REQ UESTS;'R' REVERSALS; 'A' FOR AL L; Display specific submission type clai ms or ALL
12377	"RTN","BPS SCRSL",38, 0)
12378	;2.04 INS URANCES -- List of P OINTERs to the INSUR ANCE COMPA NY FILE (# 36) separa ted by ";"
12379	"RTN","BPS SCRSL",39, 0)
12380	;should s tart and e nd with "; ", example : ";4;5;"
12381	"RTN","BPS SCRSL",40, 0)
12382	;
12383	"RTN","BPS SCRSL",41, 0)
12384	;NOTE: us e D ^XPARE DIT to add /edit valu es
12385	"RTN","BPS SCRSL",42, 0)
12386	;
12387	"RTN","BPS SCRSL",43, 0)
12388	;*****
12389	"RTN","BPS SCRSL",44, 0)
12390	SL ;
12391	"RTN","BPS SCRSL",45, 0)
12392	D FULL^VA LM1
12393	"RTN","BPS SCRSL",46, 0)
12394	W @IOF
12395	"RTN","BPS SCRSL",47, 0)
12396	K BPARR
12397	"RTN","BPS SCRSL",48, 0)
12398	I +$G(DUZ )=0 D ERRM SG^BPSSCRC V("Unknown User") Q
12399	"RTN","BPS SCRSL",49, 0)
12400	N BPDUZ7
12401	"RTN","BPS SCRSL",50, 0)
12402	S BPDUZ7= +DUZ
12403	"RTN","BPS SCRSL",51, 0)
12404	;always g et current profile f rom the fi le
12405	"RTN","BPS SCRSL",52, 0)
12406	;D READPR FP(.BPARR, +DUZ)
12407	"RTN","BPS SCRSL",53, 0)
12408	D READPRO F(.BPARR,+ BPDUZ7)
12409	"RTN","BPS SCRSL",54, 0)
12410	D SAVEVIE W^BPSSCR01 (.BPARR)
12411	"RTN","BPS SCRSL",55, 0)
12412	;edit cur rent profi le
12413	"RTN","BPS SCRSL",56, 0)
12414	D EDITPRO F(.BPARR,. BPDUZ7)
12415	"RTN","BPS SCRSL",57, 0)
12416	D SAVEVIE W^BPSSCR01 (.BPARR)
12417	"RTN","BPS SCRSL",58, 0)
12418	;save it if necessa ry only fo r SORT LIS T field
12419	"RTN","BPS SCRSL",59, 0)
12420	;(so we u sed a sepa rate array for this and save i t only)
12421	"RTN","BPS SCRSL",60, 0)
12422	N BPSRT S BPSRT(1.1 2)=BPARR(1 .12)
12423	"RTN","BPS SCRSL",61, 0)
12424	D ENDEDIT (.BPSRT,+B PDUZ7)
12425	"RTN","BPS SCRSL",62, 0)
12426	D SAVEVIE W^BPSSCR01 (.BPARR)
12427	"RTN","BPS SCRSL",63, 0)
12428	;redraw s creen
12429	"RTN","BPS SCRSL",64, 0)
12430	D REDRAW^ BPSSCRUD(" Updating s creen...")
12431	"RTN","BPS SCRSL",65, 0)
12432	Q
12433	"RTN","BPS SCRSL",66, 0)
12434	;
12435	"RTN","BPS SCRSL",67, 0)
12436	;input:
12437	"RTN","BPS SCRSL",68, 0)
12438	;BPARRAY - array th at all set tings:
12439	"RTN","BPS SCRSL",69, 0)
12440	; in th e form BPA RRAY(insta nce in "BP S USRSCR" parameter tool entry ) = value
12441	"RTN","BPS SCRSL",70, 0)
12442	;BPDUZ7 - DUZ
12443	"RTN","BPS SCRSL",71, 0)
12444	EDITPROF(B PARR,BPDUZ 7) ;
12445	"RTN","BPS SCRSL",72, 0)
12446	N BP1
12447	"RTN","BPS SCRSL",73, 0)
12448	N BPRET
12449	"RTN","BPS SCRSL",74, 0)
12450	N BPSTR
12451	"RTN","BPS SCRSL",75, 0)
12452	S BPSTR=" S^T:TRANSA CTION DATE ;D:DIVISIO N;I:INSURA NCE;C:REJE CT CODE;P: PATIENT NA ME;N:DRUG NAME;B:BIL L TYPE (BB /P2/RT/RS) ;L:FILL LO CATION;R:R ELEASED/NO N-RELEASED ;A:ACTIVE/ DISCONTINU ED"
12453	"RTN","BPS SCRSL",76, 0)
12454	I $$EDITF LD^BPSSCRC V(1.12,+BP DUZ7,BPSTR ,"ENTER SO RT TYPE"," TRANSACTIO N DATE",.B PARR)=-1 S BPDUZ7=0 Q
12455	"RTN","BPS SCRSL",77, 0)
12456	Q
12457	"RTN","BPS SCRSL",78, 0)
12458	;
12459	"RTN","BPS SCRSL",79, 0)
12460	;input:
12461	"RTN","BPS SCRSL",80, 0)
12462	;BPARRAY - array th at all set tings:
12463	"RTN","BPS SCRSL",81, 0)
12464	;in the f orm BPARRA Y(instance in "BPS U SRSCR" par ameter too l entry) = value
12465	"RTN","BPS SCRSL",82, 0)
12466	;BPDUZ7 - DUZ
12467	"RTN","BPS SCRSL",83, 0)
12468	;
12469	"RTN","BPS SCRSL",84, 0)
12470	ENDEDIT(BP ARRAY,BPDU Z7) ;
12471	"RTN","BPS SCRSL",85, 0)
12472	S BPARRAY ("TEMPCV") =1 ; D efault as Temporary View defin ed
12473	"RTN","BPS SCRSL",86, 0)
12474	I $$PROMP T^BPSSCRCV ("S^Y:YES; N:NO","DO YOU WANT T O SAVE THI S VIEW AS YOUR PREFE RRED VIEW (Y/N)?","" )="Y" D
12475	"RTN","BPS SCRSL",87, 0)
12476	. D FILEA LL^BPSSCRC V(.BPARRAY ,BPDUZ7)
12477	"RTN","BPS SCRSL",88, 0)
12478	. K BPARR AY("TEMPCV ") ; User agre ed to save view as p referred - Remove TE MPCV flag
12479	"RTN","BPS SCRSL",89, 0)
12480	Q
12481	"RTN","BPS SCRSL",90, 0)
12482	;read pro file infor mation (us ed in othe r routines as well)
12483	"RTN","BPS SCRSL",91, 0)
12484	;input:
12485	"RTN","BPS SCRSL",92, 0)
12486	;BPDUZ7 - DUZ
12487	"RTN","BPS SCRSL",93, 0)
12488	;input/ou tput:
12489	"RTN","BPS SCRSL",94, 0)
12490	;BPARRAY - to retur n back pro file infor mation, as reference
12491	"RTN","BPS SCRSL",95, 0)
12492	;see desc ription in the top o f the rout ine
12493	"RTN","BPS SCRSL",96, 0)
12494	READPROF(B PARRAY,BPD UZ7) ;
12495	"RTN","BPS SCRSL",97, 0)
12496	N RETV,RE TARR,BPFLD NO,BPDIV,B P1
12497	"RTN","BPS SCRSL",98, 0)
12498	N RECIENS
12499	"RTN","BPS SCRSL",99, 0)
12500	S RECIENS =BPDUZ7_", "
12501	"RTN","BPS SCRSL",100 ,0)
12502	F BPFLDNO =1.01,1.02 ,1.03,1.04 ,1.05,1.06 ,1.07,1.08 ,1.09,1.1, 1.11,1.12, 1.13,1.14, 1.15,1.16, 1.17,1.18, 1.19,2.01, 2.02,2.03, 2.04 D
12503	"RTN","BPS SCRSL",101 ,0)
12504	. S RETV= $$GETPARAM (BPFLDNO,+ BPDUZ7)
12505	"RTN","BPS SCRSL",102 ,0)
12506	. S BPARR AY(BPFLDNO )=RETV
12507	"RTN","BPS SCRSL",103 ,0)
12508	I BPARRAY (1.13)="D" D
12509	"RTN","BPS SCRSL",104 ,0)
12510	. S BPARR AY("DIVS") =$$GETPARA M(2,+BPDUZ 7)
12511	"RTN","BPS SCRSL",105 ,0)
12512	I BPARRAY (1.11)="I" D
12513	"RTN","BPS SCRSL",106 ,0)
12514	. S BPARR AY("INS")= $$GETPARAM (2.04,+BPD UZ7)
12515	"RTN","BPS SCRSL",107 ,0)
12516	Q
12517	"RTN","BPS SCRSL",108 ,0)
12518	;
12519	"RTN","BPS SCRSL",109 ,0)
12520	SORTTYPE(B PSTYPE) ;
12521	"RTN","BPS SCRSL",110 ,0)
12522	Q:(BPSTYP E="T") "Tr ansaction Date"
12523	"RTN","BPS SCRSL",111 ,0)
12524	Q:(BPSTYP E="D") "EC ME divisio n"
12525	"RTN","BPS SCRSL",112 ,0)
12526	Q:(BPSTYP E="I") "In surance"
12527	"RTN","BPS SCRSL",113 ,0)
12528	Q:(BPSTYP E="C") "Re ject Code"
12529	"RTN","BPS SCRSL",114 ,0)
12530	Q:(BPSTYP E="P") "Pa tient Name "
12531	"RTN","BPS SCRSL",115 ,0)
12532	Q:(BPSTYP E="N") "Dr ug Name"
12533	"RTN","BPS SCRSL",116 ,0)
12534	Q:(BPSTYP E="B") "Cl aim's Orig in (BB/P2/ RT/RS)"
12535	"RTN","BPS SCRSL",117 ,0)
12536	Q:(BPSTYP E="L") "Fi ll Locatio n"
12537	"RTN","BPS SCRSL",118 ,0)
12538	Q:(BPSTYP E="R") "Re leased/Non -released"
12539	"RTN","BPS SCRSL",119 ,0)
12540	Q:(BPSTYP E="A") "Ac tive/Disco ntinued"
12541	"RTN","BPS SCRSL",120 ,0)
12542	Q ""
12543	"RTN","BPS SCRSL",121 ,0)
12544	;
12545	"RTN","BPS SCRSL",122 ,0)
12546	;
12547	"RTN","BPS SCRSL",123 ,0)
12548	GETPARAM(B PFLDNO,BPD UZ) ;
12549	"RTN","BPS SCRSL",124 ,0)
12550	Q $$GET^X PAR(BPDUZ_ ";VA(200," ,"BPS USRS CR",BPFLDN O,"I")
12551	"RTN","BPS SCRSL",125 ,0)
12552	;
12553	"RTN","BPS SCRSL",126 ,0)
12554	;save val ue of the parameter
12555	"RTN","BPS SCRSL",127 ,0)
12556	SAVEPAR(BP FLDNO,BPDU Z,BPVAL) ;
12557	"RTN","BPS SCRSL",128 ,0)
12558	D EN^XPAR (BPDUZ_";V A(200,","B PS USRSCR" ,BPFLDNO,B PVAL,.BPER R)
12559	"RTN","BPS SCRSL",129 ,0)
12560	I BPERR'= "0" W !,BP ERR,! Q 0
12561	"RTN","BPS SCRSL",130 ,0)
12562	Q 1
12563	"RTN","BPS SCRSL",131 ,0)
12564	;
12565	"RTN","BPS TEST")
12566	0^8^B22752 9281
12567	"RTN","BPS TEST",1,0)
12568	BPSTEST ;O AK/ELZ - E CME TESTIN G TOOL ;11 /15/07 09 :55
12569	"RTN","BPS TEST",2,0)
12570	;;1.0;E C LAIMS MGMT ENGINE; 6,7,8,10,1 1,15,19,20 ,22;JUN 2004;Build 15
12571	"RTN","BPS TEST",3,0)
12572	;;Per VA Directive 6402, this routine s hould not be modifie d.
12573	"RTN","BPS TEST",4,0)
12574	;
12575	"RTN","BPS TEST",5,0)
12576	; Look at BPSTEST1 for additi onal docum entation o f the Test ing Tool
12577	"RTN","BPS TEST",6,0)
12578	;
12579	"RTN","BPS TEST",7,0)
12580	GETOVER(KE Y1,KEY2,BP SORESP,BPS WHERE,BPST YPE,BPPAYS EQ) ;
12581	"RTN","BPS TEST",8,0)
12582	; called by BPSNCPD P to enter overrides for a par ticular RX
12583	"RTN","BPS TEST",9,0)
12584	; INPUT
12585	"RTN","BPS TEST",10,0 )
12586	; KEY1 - Pr escription IEN/Patie nt IEN
12587	"RTN","BPS TEST",11,0 )
12588	; KEY2 - Fi ll Number/ Policy Num ber
12589	"RTN","BPS TEST",12,0 )
12590	; BPSO RESP - Pr evious res ponse when this clai m was proc essed
12591	"RTN","BPS TEST",13,0 )
12592	; BPSW HERE - RX Action pa ssed into BPSNCPDP
12593	"RTN","BPS TEST",14,0 )
12594	; BPST YPE - R (Reversal) , S (Submi ssion), E (Eligibili ty)
12595	"RTN","BPS TEST",15,0 )
12596	; BPPA YSEQ - pa yer sequen ce 1 - pri mary, 2 - secondary
12597	"RTN","BPS TEST",16,0 )
12598	; OUTPUT
12599	"RTN","BPS TEST",17,0 )
12600	; None - Table B PS PAYER R ESPONSE OV ERRIDE ent ry is crea ted.
12601	"RTN","BPS TEST",18,0 )
12602	;
12603	"RTN","BPS TEST",19,0 )
12604	N BPSTRAN S,BPSTIEN, BPSSRESP,D IC,X,Y,DIR ,DIK,DA
12605	"RTN","BPS TEST",20,0 )
12606	;
12607	"RTN","BPS TEST",21,0 )
12608	; Check i f testing is enabled
12609	"RTN","BPS TEST",22,0 )
12610	I '$$CHEC K() Q
12611	"RTN","BPS TEST",23,0 )
12612	;
12613	"RTN","BPS TEST",24,0 )
12614	; Option can not be run for D ate of Dea th option as it caus es errors
12615	"RTN","BPS TEST",25,0 )
12616	I $G(XQY0 )["DG DEAT H ENTRY" W !,"The te sting tool can not b e run from Date of D eath optio n" Q
12617	"RTN","BPS TEST",26,0 )
12618	;
12619	"RTN","BPS TEST",27,0 )
12620	; Do not run for ba ckground j obs
12621	"RTN","BPS TEST",28,0 )
12622	I $D(ZTQU EUED)!(",A REV,CRLB,C RLR,CRLX,C RRL,PC,PL, "[(","_BPS WHERE_",") ) Q
12623	"RTN","BPS TEST",29,0 )
12624	;
12625	"RTN","BPS TEST",30,0 )
12626	; Create Transactio n Number
12627	"RTN","BPS TEST",31,0 )
12628	S BPSTRAN S=$$IEN59^ BPSOSRX(KE Y1,KEY2,$S ($G(BPPAYS EQ)>0:+BPP AYSEQ,1:1) )
12629	"RTN","BPS TEST",32,0 )
12630	;
12631	"RTN","BPS TEST",33,0 )
12632	; Lookup the record in the BP S PAYER RE SPONSE OVE RRIDE tabl e
12633	"RTN","BPS TEST",34,0 )
12634	S DIC=900 2313.32,DI C(0)="",X= BPSTRANS
12635	"RTN","BPS TEST",35,0 )
12636	D ^DIC
12637	"RTN","BPS TEST",36,0 )
12638	S BPSTIEN =+Y
12639	"RTN","BPS TEST",37,0 )
12640	;
12641	"RTN","BPS TEST",38,0 )
12642	; Prompt if user wa nts to do overrides
12643	"RTN","BPS TEST",39,0 )
12644	W !!,"Pay er Overrid es are ena bled at th is site. If this is productio n environm ent,"
12645	"RTN","BPS TEST",40,0 )
12646	W !,"do n ot enter o verrides ( enter No a t the next prompt) a nd disable this"
12647	"RTN","BPS TEST",41,0 )
12648	W !,"func tionality in the BPS SETUP tab le."
12649	"RTN","BPS TEST",42,0 )
12650	W !!,"Ent ering No a t the next prompt wi ll delete any curren t override s for the"
12651	"RTN","BPS TEST",43,0 )
12652	W !,"requ est, if th ey exist." ,!
12653	"RTN","BPS TEST",44,0 )
12654	S DIR(0)= "SA^Y:Yes; N:No"
12655	"RTN","BPS TEST",45,0 )
12656	S DIR("A" )="Do you want to en ter overri des for th is request ? ",DIR("B ")="NO"
12657	"RTN","BPS TEST",46,0 )
12658	D ^DIR
12659	"RTN","BPS TEST",47,0 )
12660	;
12661	"RTN","BPS TEST",48,0 )
12662	; If no, delete the transacti on (if it exists) an d quit
12663	"RTN","BPS TEST",49,0 )
12664	I Y'="Y" D:BPSTIEN' =-1 Q
12665	"RTN","BPS TEST",50,0 )
12666	. S DIK=" ^BPS(90023 13.32,",DA =BPSTIEN
12667	"RTN","BPS TEST",51,0 )
12668	. D ^DIK
12669	"RTN","BPS TEST",52,0 )
12670	;
12671	"RTN","BPS TEST",53,0 )
12672	; If the record doe s not exis t, create it
12673	"RTN","BPS TEST",54,0 )
12674	I BPSTIEN =-1 S BPST IEN=$$CREA TE(BPSTRAN S)
12675	"RTN","BPS TEST",55,0 )
12676	I BPSTIEN =-1 W !,"F ailed to c reate the BPS PAYER RESPONSE O VERRIDE re cord",! Q
12677	"RTN","BPS TEST",56,0 )
12678	;
12679	"RTN","BPS TEST",57,0 )
12680	; If BPST YPE is 'S' (submissi on) and ol d response is 'E Pay able', cha nge BPSTYP E to 'RS'
12681	"RTN","BPS TEST",58,0 )
12682	; But don 't change BPSTYPE to 'RS' if t he BPSWHER E value is "ERWV" wh ich is the Resubmit Without Re versal act ion (BPS1 20)
12683	"RTN","BPS TEST",59,0 )
12684	I BPSTYPE ="S",BPSWH ERE'="ERWV ",BPSORESP ="E PAYABL E"!(BPSORE SP="E DUPL ICATE")!(B PSORESP="E REVERSAL REJECTED") !(BPSORESP ="E REVERS AL UNSTRAN DED") S BP STYPE="RS"
12685	"RTN","BPS TEST",60,0 )
12686	;
12687	"RTN","BPS TEST",61,0 )
12688	; Update with the B PSTYPE
12689	"RTN","BPS TEST",62,0 )
12690	D FILE("^ BPS(900231 3.32,",BPS TIEN,.02,B PSTYPE)
12691	"RTN","BPS TEST",63,0 )
12692	;
12693	"RTN","BPS TEST",64,0 )
12694	; Message for RS
12695	"RTN","BPS TEST",65,0 )
12696	I BPSTYPE ="RS" D
12697	"RTN","BPS TEST",66,0 )
12698	. W !!,"T his submis sion may a lso have a reversal so you wil l be promp ted for th e"
12699	"RTN","BPS TEST",67,0 )
12700	. W !,"re versal ove rrides."
12701	"RTN","BPS TEST",68,0 )
12702	;
12703	"RTN","BPS TEST",69,0 )
12704	; If BPST YPE is equ al to 'E', then prom pt for eli gibility r esponse
12705	"RTN","BPS TEST",70,0 )
12706	I BPSTYPE ["E" D
12707	"RTN","BPS TEST",71,0 )
12708	. W !!,"E ligibility Questions "
12709	"RTN","BPS TEST",72,0 )
12710	. D PROMP T(BPSTIEN, .08,"A")
12711	"RTN","BPS TEST",73,0 )
12712	. N BPSRE SP
12713	"RTN","BPS TEST",74,0 )
12714	. S BPSRE SP=$$GET1^ DIQ(900231 3.32,BPSTI EN_",",.08 ,"I")
12715	"RTN","BPS TEST",75,0 )
12716	. I BPSRE SP="R" D R EJECTS(BPS TIEN) ; BP S122
12717	"RTN","BPS TEST",76,0 )
12718	;
12719	"RTN","BPS TEST",77,0 )
12720	; If BPST YPE contai ns 'R', th en prompt for revers al respons e
12721	"RTN","BPS TEST",78,0 )
12722	I BPSTYPE ["R" D
12723	"RTN","BPS TEST",79,0 )
12724	. W !!,"R eversal Qu estions"
12725	"RTN","BPS TEST",80,0 )
12726	. D PROMP T(BPSTIEN, .05,"A")
12727	"RTN","BPS TEST",81,0 )
12728	. N BPSRE SP
12729	"RTN","BPS TEST",82,0 )
12730	. S BPSRE SP=$$GET1^ DIQ(900231 3.32,BPSTI EN_",",.05 ,"I")
12731	"RTN","BPS TEST",83,0 )
12732	. I BPSRE SP="R" D E NREVRJ(BPS TRANS)
12733	"RTN","BPS TEST",84,0 )
12734	;
12735	"RTN","BPS TEST",85,0 )
12736	; If BPST YPE contai ns 'S', do submissio n response
12737	"RTN","BPS TEST",86,0 )
12738	I BPSTYPE ["S" D
12739	"RTN","BPS TEST",87,0 )
12740	. W !!,"S ubmission Questions"
12741	"RTN","BPS TEST",88,0 )
12742	. D PROMP T(BPSTIEN, .03,"P")
12743	"RTN","BPS TEST",89,0 )
12744	. S BPSSR ESP=$$GET1 ^DIQ(90023 13.32,BPST IEN_",",.0 3,"I")
12745	"RTN","BPS TEST",90,0 )
12746	. I BPSSR ESP="P"!(B PSSRESP="D ") D PROMP T(BPSTIEN, .04,40) ; tota l amount p aid (509-F 9)
12747	"RTN","BPS TEST",91,0 )
12748	. I BPSSR ESP="P"!(B PSSRESP="D ") D PROMP T(BPSTIEN, .06,9) ; copa y amount ( 518-FI)
12749	"RTN","BPS TEST",92,0 )
12750	. I BPSSR ESP="R" D REJECTS(BP STIEN) ; B PS122
12751	"RTN","BPS TEST",93,0 )
12752	. ;
12753	"RTN","BPS TEST",94,0 )
12754	. ; This section is for new D 1-E7 field s and othe r fields s o we can t est that t hey are fi led correc tly
12755	"RTN","BPS TEST",95,0 )
12756	. ; At so me point, these can probably b e removed
12757	"RTN","BPS TEST",96,0 )
12758	. I BPSSR ESP="P"!(B PSSRESP="D ")!(BPSSRE SP="R") D
12759	"RTN","BPS TEST",97,0 )
12760	.. ;
12761	"RTN","BPS TEST",98,0 )
12762	.. ; Ask if user wa nts to ent er data fo r addition al respons e file fie lds - Quit if user s ays no
12763	"RTN","BPS TEST",99,0 )
12764	.. N DIR, DTOUT,DUOU T,DIROUT,D IRUT
12765	"RTN","BPS TEST",100, 0)
12766	.. S DIR( 0)="YA",DI R("A")="Po pulate Add itional Re sponse Fie lds? ",DIR ("B")="No" W ! D ^DI R
12767	"RTN","BPS TEST",101, 0)
12768	.. I Y'=1 Q
12769	"RTN","BPS TEST",102, 0)
12770	.. ;
12771	"RTN","BPS TEST",103, 0)
12772	.. ; Over rides to t est functi onality of BPS120
12773	"RTN","BPS TEST",104, 0)
12774	.. D PROM PT(BPSTIEN ,.15,0) ; Ing redient Co st Paid (5 06)
12775	"RTN","BPS TEST",105, 0)
12776	.. D PROM PT(BPSTIEN ,.16,0) ; Dis pensing Fe e Paid (50 7)
12777	"RTN","BPS TEST",106, 0)
12778	.. D PROM PT(BPSTIEN ,.17,0) ; Rem aining Ded uctible Am ount (513)
12779	"RTN","BPS TEST",107, 0)
12780	.. D PROM PT(BPSTIEN ,.18,0) ; Amo unt Applie d to Perio dic Deduct ible (517)
12781	"RTN","BPS TEST",108, 0)
12782	.. ;
12783	"RTN","BPS TEST",109, 0)
12784	.. ; Addi tional ove rrides for D1-D9 (BP S115)
12785	"RTN","BPS TEST",110, 0)
12786	.. D PROM PT(BPSTIEN ,.09,"") ; nex t availabl e fill dat e
12787	"RTN","BPS TEST",111, 0)
12788	.. D PROM PT(BPSTIEN ,.1,"") ; adj udicated p ayment typ e
12789	"RTN","BPS TEST",112, 0)
12790	.. ;
12791	"RTN","BPS TEST",113, 0)
12792	.. ; Addi tional ove rrides for E0-E6 (BP S119)
12793	"RTN","BPS TEST",114, 0)
12794	.. D PROM PT(BPSTIEN ,2.01,"04" ) ; % s ales tax b asis pd
12795	"RTN","BPS TEST",115, 0)
12796	.. D PROM PT(BPSTIEN ,2.02,11) ; oth er amount paid quali fier
12797	"RTN","BPS TEST",116, 0)
12798	.. D PROM PT(BPSTIEN ,2.03,"01" ) ; pay er id qual ifier
12799	"RTN","BPS TEST",117, 0)
12800	.. D PROM PT(BPSTIEN ,2.04,"") ; hel p desk pho ne# ext
12801	"RTN","BPS TEST",118, 0)
12802	.. D PROM PT(BPSTIEN ,2.05,"") ; pro service f ee cont/re im amt
12803	"RTN","BPS TEST",119, 0)
12804	.. D PROM PT(BPSTIEN ,2.06,"") ; oth er payer h elp desk p hone# ext
12805	"RTN","BPS TEST",120, 0)
12806	.. D PROM PT(BPSTIEN ,2.07,"") ; res ponse inte rmed auth type id
12807	"RTN","BPS TEST",121, 0)
12808	.. D PROM PT(BPSTIEN ,2.08,"") ; res ponse inte rmed auth id
12809	"RTN","BPS TEST",122, 0)
12810	.. D PROM PT(BPSTIEN ,3.01,"") ; res ponse inte rmed messa ge
12811	"RTN","BPS TEST",123, 0)
12812	.. ;
12813	"RTN","BPS TEST",124, 0)
12814	.. ; E7 o verrides ( BPS120)
12815	"RTN","BPS TEST",125, 0)
12816	.. D PROM PT(BPSTIEN ,.11,"") ; quan limit per speci fic time p eriod
12817	"RTN","BPS TEST",126, 0)
12818	.. D PROM PT(BPSTIEN ,.12,"") ; quan limit time peri od
12819	"RTN","BPS TEST",127, 0)
12820	.. D PROM PT(BPSTIEN ,.13,"") ; days supp limit per specific t ime period
12821	"RTN","BPS TEST",128, 0)
12822	.. D PROM PT(BPSTIEN ,.14,"") ; days supp limit time period
12823	"RTN","BPS TEST",129, 0)
12824	.. ; Over rides to t est functi onality - BPS122
12825	"RTN","BPS TEST",130, 0)
12826	.. D PROM PT(BPSTIEN ,2.09,"") ; reconcilia tion id
12827	"RTN","BPS TEST",131, 0)
12828	;
12829	"RTN","BPS TEST",132, 0)
12830	W ! D PRO MPT(BPSTIE N,.07,0)
12831	"RTN","BPS TEST",133, 0)
12832	Q
12833	"RTN","BPS TEST",134, 0)
12834	;
12835	"RTN","BPS TEST",135, 0)
12836	SETOVER(BP STRANS,BPS TYPE,BPSDA TA) ;
12837	"RTN","BPS TEST",136, 0)
12838	; called by BPSECMP S to set t he overrid e data
12839	"RTN","BPS TEST",137, 0)
12840	; Input
12841	"RTN","BPS TEST",138, 0)
12842	; BPST RANS - Tra nsaction I EN
12843	"RTN","BPS TEST",139, 0)
12844	; BPST YPE - B1 for submis sion, B2 f or reversa ls
12845	"RTN","BPS TEST",140, 0)
12846	; Output
12847	"RTN","BPS TEST",141, 0)
12848	; BPSD ATA - P assed by r eference a nd updated with appr opriate ov errides
12849	"RTN","BPS TEST",142, 0)
12850	;
12851	"RTN","BPS TEST",143, 0)
12852	N BPSTIEN ,BPSRRESP, BPSSRESP,B PSPAID,BPS RCNT,BPSRI EN,BPSRCOD E,BPSRCD,B PSCOPAY,BP SXXXX,BPSU NDEF
12853	"RTN","BPS TEST",144, 0)
12854	N BPSAJPA Y,BPSNFLDT ,BPSX
12855	"RTN","BPS TEST",145, 0)
12856	N BPS506, BPS507,BPS 513,BPS517
12857	"RTN","BPS TEST",146, 0)
12858	;
12859	"RTN","BPS TEST",147, 0)
12860	; Check t he Test Fl ag in set in BPS SET UP
12861	"RTN","BPS TEST",148, 0)
12862	I '$$CHEC K() Q
12863	"RTN","BPS TEST",149, 0)
12864	;
12865	"RTN","BPS TEST",150, 0)
12866	; Check i f the Tran saction Nu mber is de fined in B PS RESPONS E OVERRIDE S
12867	"RTN","BPS TEST",151, 0)
12868	S BPSTIEN =$O(^BPS(9 002313.32, "B",BPSTRA NS,""))
12869	"RTN","BPS TEST",152, 0)
12870	I BPSTIEN ="" Q
12871	"RTN","BPS TEST",153, 0)
12872	;
12873	"RTN","BPS TEST",154, 0)
12874	; If a el igibility, check for specific reversal o verrides a nd set
12875	"RTN","BPS TEST",155, 0)
12876	I BPSTYPE ="E1" D Q
12877	"RTN","BPS TEST",156, 0)
12878	. S BPSRR ESP=$$GET1 ^DIQ(90023 13.32,BPST IEN_",",.0 8,"I")
12879	"RTN","BPS TEST",157, 0)
12880	. ;
12881	"RTN","BPS TEST",158, 0)
12882	. ; If th e response is Strand ed, force an <UNDEF> error
12883	"RTN","BPS TEST",159, 0)
12884	. I BPSRR ESP="S" S BPSXXXX=BP SUNDEF
12885	"RTN","BPS TEST",160, 0)
12886	. I BPSRR ESP]"" S B PSDATA(1,1 12)=BPSRRE SP
12887	"RTN","BPS TEST",161, 0)
12888	. S BPSDA TA(9002313 .03,900231 3.03,"+1," ,501)=$S(B PSRRESP="R ":"R",1:"A ")
12889	"RTN","BPS TEST",162, 0)
12890	. ;
12891	"RTN","BPS TEST",163, 0)
12892	. ; If th e response is accept ed, delete the rejec t code cou nt and cod es
12893	"RTN","BPS TEST",164, 0)
12894	. I BPSRR ESP="A" K BPSDATA(1, 510),BPSDA TA(1,511)
12895	"RTN","BPS TEST",165, 0)
12896	. ;
12897	"RTN","BPS TEST",166, 0)
12898	. ; If th e response is reject ed, delete the rejec tions retu rned by pa yers
12899	"RTN","BPS TEST",167, 0)
12900	. ; and put in th e ones ent ered by th e user
12901	"RTN","BPS TEST",168, 0)
12902	. I BPSRR ESP="R" D
12903	"RTN","BPS TEST",169, 0)
12904	.. K BPSD ATA(1,509) ,BPSDATA(1 ,511)
12905	"RTN","BPS TEST",170, 0)
12906	.. S BPSR CNT=0
12907	"RTN","BPS TEST",171, 0)
12908	.. S BPSR IEN=0 F S BPSRIEN=$ O(^BPS(900 2313.32,BP STIEN,1,BP SRIEN)) Q: +BPSRIEN=0 D
12909	"RTN","BPS TEST",172, 0)
12910	... S BPS RCODE=$P($ G(^BPS(900 2313.32,BP STIEN,1,BP SRIEN,0)), "^",1)
12911	"RTN","BPS TEST",173, 0)
12912	... ; Inc rement cou nter and s tore
12913	"RTN","BPS TEST",174, 0)
12914	... I BPS RCODE]"" D
12915	"RTN","BPS TEST",175, 0)
12916	.... S BP SRCD=$$GET 1^DIQ(9002 313.93,BPS RCODE_",", .01,"E")
12917	"RTN","BPS TEST",176, 0)
12918	.... I BP SRCD]"" S BPSRCNT=BP SRCNT+1,BP SDATA(1,51 1,BPSRCNT) =BPSRCD
12919	"RTN","BPS TEST",177, 0)
12920	.. ; Stor e total nu mber of re jections
12921	"RTN","BPS TEST",178, 0)
12922	.. S BPSD ATA(1,510) =BPSRCNT
12923	"RTN","BPS TEST",179, 0)
12924	;
12925	"RTN","BPS TEST",180, 0)
12926	; If a re versal, ch eck for sp ecific rev ersal over rides and set
12927	"RTN","BPS TEST",181, 0)
12928	I BPSTYPE ="B2" D
12929	"RTN","BPS TEST",182, 0)
12930	. S BPSRR ESP=$$GET1 ^DIQ(90023 13.32,BPST IEN_",",.0 5,"I")
12931	"RTN","BPS TEST",183, 0)
12932	. ;
12933	"RTN","BPS TEST",184, 0)
12934	. ; If th e response is Strand ed, force an <UNDEF> error
12935	"RTN","BPS TEST",185, 0)
12936	. I BPSRR ESP="S" S BPSXXXX=BP SUNDEF
12937	"RTN","BPS TEST",186, 0)
12938	. I BPSRR ESP]"" S B PSDATA(1,1 12)=$S(BPS RRESP="D": "S",1:BPSR RESP)
12939	"RTN","BPS TEST",187, 0)
12940	. S BPSDA TA(9002313 .03,900231 3.03,"+1," ,501)=$S(B PSRRESP="R ":"R",1:"A ")
12941	"RTN","BPS TEST",188, 0)
12942	. ;
12943	"RTN","BPS TEST",189, 0)
12944	. ; If th e response is accept ed or dupl icate, kil l the reje ct code co unt and co des
12945	"RTN","BPS TEST",190, 0)
12946	. I BPSRR ESP="A"!(B PSRRESP="D ") K BPSDA TA(1,510), BPSDATA(1, 511)
12947	"RTN","BPS TEST",191, 0)
12948	. ;
12949	"RTN","BPS TEST",192, 0)
12950	. ; If th e response is reject ed, set th e reject c odes
12951	"RTN","BPS TEST",193, 0)
12952	. I BPSRR ESP="R" D SETREJ(BPS TRANS)
12953	"RTN","BPS TEST",194, 0)
12954	;
12955	"RTN","BPS TEST",195, 0)
12956	; If a su bmission, check for specific s ubmission overrides and set
12957	"RTN","BPS TEST",196, 0)
12958	I BPSTYPE ="B1" D
12959	"RTN","BPS TEST",197, 0)
12960	. ; Get s ubmission response
12961	"RTN","BPS TEST",198, 0)
12962	. S BPSSR ESP=$$GET1 ^DIQ(90023 13.32,BPST IEN_",",.0 3,"I")
12963	"RTN","BPS TEST",199, 0)
12964	. ;
12965	"RTN","BPS TEST",200, 0)
12966	. ; If th e response is Strand ed, force an <UNDEF> error
12967	"RTN","BPS TEST",201, 0)
12968	. I BPSSR ESP="S" S BPSXXXX=BP SUNDEF
12969	"RTN","BPS TEST",202, 0)
12970	. ;
12971	"RTN","BPS TEST",203, 0)
12972	. ; If BP SSRESP exi sts, file it
12973	"RTN","BPS TEST",204, 0)
12974	. I BPSSR ESP]"" D
12975	"RTN","BPS TEST",205, 0)
12976	.. S BPSD ATA(1,112) =BPSSRESP
12977	"RTN","BPS TEST",206, 0)
12978	.. S BPSD ATA(900231 3.03,90023 13.03,"+1, ",501)=$S( BPSSRESP=" R":"R",1:" A")
12979	"RTN","BPS TEST",207, 0)
12980	.. ; If p ayable or duplicate, get the B PSPAID amo unt and fi le it if i t
12981	"RTN","BPS TEST",208, 0)
12982	.. ; exis ts. Also delete any reject co des
12983	"RTN","BPS TEST",209, 0)
12984	.. I BPSS RESP="P"!( BPSSRESP=" D") D
12985	"RTN","BPS TEST",210, 0)
12986	... S BPS PAID=$$GET 1^DIQ(9002 313.32,BPS TIEN_",",. 04,"I")
12987	"RTN","BPS TEST",211, 0)
12988	... I BPS PAID]"" S BPSDATA(1, 509)=$$DFF ^BPSECFM(B PSPAID,8) ; 509 Total amount pai d
12989	"RTN","BPS TEST",212, 0)
12990	... ;
12991	"RTN","BPS TEST",213, 0)
12992	... K BPS DATA(1,510 ),BPSDATA( 1,511) ; kill R eject Coun t (510) an d Reject C ode (511)
12993	"RTN","BPS TEST",214, 0)
12994	... ;
12995	"RTN","BPS TEST",215, 0)
12996	... S BPS COPAY=$$GE T1^DIQ(900 2313.32,BP STIEN_",", .06,"I")
12997	"RTN","BPS TEST",216, 0)
12998	... I BPS COPAY]"" S BPSDATA(1 ,518)=$$DF F^BPSECFM( BPSCOPAY,8 ) ; 518 Copay Amount
12999	"RTN","BPS TEST",217, 0)
13000	... ;
13001	"RTN","BPS TEST",218, 0)
13002	... S BPS 506=$$GET1 ^DIQ(90023 13.32,BPST IEN_",",.1 5,"I")
13003	"RTN","BPS TEST",219, 0)
13004	... I BPS 506]"" S B PSDATA(1,5 06)=$$DFF^ BPSECFM(BP S506,8) ; 506 Ingred ient Cost Paid
13005	"RTN","BPS TEST",220, 0)
13006	... ;
13007	"RTN","BPS TEST",221, 0)
13008	... S BPS 507=$$GET1 ^DIQ(90023 13.32,BPST IEN_",",.1 6,"I")
13009	"RTN","BPS TEST",222, 0)
13010	... I BPS 507]"" S B PSDATA(1,5 07)=$$DFF^ BPSECFM(BP S507,8) ; 507 Dispen sing Fee P aid
13011	"RTN","BPS TEST",223, 0)
13012	... ;
13013	"RTN","BPS TEST",224, 0)
13014	... S BPS 513=$$GET1 ^DIQ(90023 13.32,BPST IEN_",",.1 7,"I")
13015	"RTN","BPS TEST",225, 0)
13016	... I BPS 513]"" S B PSDATA(1,5 13)=$$DFF^ BPSECFM(BP S513,8) ; 513 Remain ing Deduct ible Amoun t
13017	"RTN","BPS TEST",226, 0)
13018	... ;
13019	"RTN","BPS TEST",227, 0)
13020	... S BPS 517=$$GET1 ^DIQ(90023 13.32,BPST IEN_",",.1 8,"I")
13021	"RTN","BPS TEST",228, 0)
13022	... I BPS 517]"" S B PSDATA(1,5 17)=$$DFF^ BPSECFM(BP S517,8) ; 517 Amount Applied t o Periodic Deductibl e
13023	"RTN","BPS TEST",229, 0)
13024	... Q
13025	"RTN","BPS TEST",230, 0)
13026	.. ;
13027	"RTN","BPS TEST",231, 0)
13028	.. I BPSS RESP="P"!( BPSSRESP=" D")!(BPSSR ESP="R") D
13029	"RTN","BPS TEST",232, 0)
13030	... ; D1- D9 fields (BPS115)
13031	"RTN","BPS TEST",233, 0)
13032	... S BPS AJPAY=$$GE T1^DIQ(900 2313.32,BP STIEN_",", .1,"I") ; Adjudicate d Payment Type
13033	"RTN","BPS TEST",234, 0)
13034	... I BPS AJPAY]"" S BPSDATA(1 ,1028)=$$N FF^BPSECFM (BPSAJPAY, 2)
13035	"RTN","BPS TEST",235, 0)
13036	... S BPS NFLDT=$$GE T1^DIQ(900 2313.32,BP STIEN_",", .09,"I") ; Override N ext Availa ble Fill
13037	"RTN","BPS TEST",236, 0)
13038	... I BPS NFLDT]"" S BPSDATA(1 ,2004)=$$D TF1^BPSECF M(BPSNFLDT )
13039	"RTN","BPS TEST",237, 0)
13040	... ;
13041	"RTN","BPS TEST",238, 0)
13042	... ; E0- E6 overrid es (BPS1 19)
13043	"RTN","BPS TEST",239, 0)
13044	... ; PER CENTAGE SA LES TAX BA SIS PAID
13045	"RTN","BPS TEST",240, 0)
13046	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",2.01 ,"I")
13047	"RTN","BPS TEST",241, 0)
13048	... I BPS X]"" S BPS DATA(1,561 )=BPSX
13049	"RTN","BPS TEST",242, 0)
13050	... ; OTH ER AMOUNT PAID QUALI FIER and a ssociated field
13051	"RTN","BPS TEST",243, 0)
13052	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",2.02 ,"I")
13053	"RTN","BPS TEST",244, 0)
13054	... I BPS X]"" S BPS DATA(1,564 ,1)=$$NFF^ BPSECFM(BP SX,2),BPSD ATA(1,565, 1)=$$DFF^B PSECFM(5.6 4,8),BPSDA TA(1,563)= 1
13055	"RTN","BPS TEST",245, 0)
13056	... ; PAY ER ID QUAL IFIER
13057	"RTN","BPS TEST",246, 0)
13058	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",2.03 ,"I")
13059	"RTN","BPS TEST",247, 0)
13060	... I BPS X]"" S BPS DATA(90023 13.03,9002 313.03,"+1 ,",568)=BP SX
13061	"RTN","BPS TEST",248, 0)
13062	... ; HEL P DESK TEL EPHONE NUM BER EXTENS ION
13063	"RTN","BPS TEST",249, 0)
13064	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",2.04 ,"I")
13065	"RTN","BPS TEST",250, 0)
13066	... I BPS X]"" S BPS DATA(1,"20 22")=$$NFF ^BPSECFM(B PSX,8)
13067	"RTN","BPS TEST",251, 0)
13068	... ; PRO FESSIONAL SERVICE FE E CONTRACT ED/REIMURS EMENT AMOU NT
13069	"RTN","BPS TEST",252, 0)
13070	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",2.05 ,"I")
13071	"RTN","BPS TEST",253, 0)
13072	... I BPS X]"" S BPS DATA(1,"20 33")=$$DFF ^BPSECFM(B PSX,8)
13073	"RTN","BPS TEST",254, 0)
13074	... ; OTH ER PAYER H ELPDESK TE LEPHONE EX TENSION
13075	"RTN","BPS TEST",255, 0)
13076	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",2.06 ,"I")
13077	"RTN","BPS TEST",256, 0)
13078	... I BPS X]"" S BPS DATA(1,"20 23",1)=$$N FF^BPSECFM (BPSX,8),B PSDATA(1,3 38,1)="01"
13079	"RTN","BPS TEST",257, 0)
13080	... ; RES PONSE INTE RMEDIARY A UTHORIZATI ON TYPE ID and assoc iated fiel ds
13081	"RTN","BPS TEST",258, 0)
13082	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",2.07 ,"I")
13083	"RTN","BPS TEST",259, 0)
13084	... I BPS X]"" S BPS DATA(1,"20 53",1)=$$N FF^BPSECFM (BPSX,2),B PSDATA(1,2 052)=1
13085	"RTN","BPS TEST",260, 0)
13086	... ; RES PONSE INTE RMEDIARY A UTHORIZATI ON ID and associated fields
13087	"RTN","BPS TEST",261, 0)
13088	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",2.08 ,"I")
13089	"RTN","BPS TEST",262, 0)
13090	... I BPS X]"" S BPS DATA(1,"20 54",1)=$$A NFF^BPSECF M(BPSX,20) ,BPSDATA(1 ,2052)=1
13091	"RTN","BPS TEST",263, 0)
13092	... ; INT ERMEDIARY MESSAGE an d associat ed fields
13093	"RTN","BPS TEST",264, 0)
13094	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",3.01 ,"I")
13095	"RTN","BPS TEST",265, 0)
13096	... I BPS X]"" S BPS DATA(1,"20 51",1)=$$A NFF^BPSECF M(BPSX,200 ),BPSDATA( 1,2052)=1
13097	"RTN","BPS TEST",266, 0)
13098	... ; (BP S122)
13099	"RTN","BPS TEST",267, 0)
13100	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",2.09 ,"I") ; B9 8-34 recon ciliation id
13101	"RTN","BPS TEST",268, 0)
13102	... I BPS X]"" S BPS DATA(1,"20 98")=$$ANF F^BPSECFM( BPSX,30)
13103	"RTN","BPS TEST",269, 0)
13104	... ;
13105	"RTN","BPS TEST",270, 0)
13106	... ; E7 overrides (BPS120)
13107	"RTN","BPS TEST",271, 0)
13108	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",.11, "I") I BPS X'="" D ; B88-3R quantity limit per spec time period
13109	"RTN","BPS TEST",272, 0)
13110	.... S BP SDATA(1,20 87)=1 ; count f ield
13111	"RTN","BPS TEST",273, 0)
13112	.... S BP SDATA(1,20 88,1)=$$NF F^BPSECFM( BPSX,10) ; data fr om overrid e file
13113	"RTN","BPS TEST",274, 0)
13114	.... Q
13115	"RTN","BPS TEST",275, 0)
13116	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",.12, "I") I BPS X'="" D ; B89-3S quantity limit time period
13117	"RTN","BPS TEST",276, 0)
13118	.... S BP SDATA(1,20 87)=1 ; count f ield
13119	"RTN","BPS TEST",277, 0)
13120	.... S BP SDATA(1,20 89,1)=$$NF F^BPSECFM( BPSX,5) ; data fr om overrid e file
13121	"RTN","BPS TEST",278, 0)
13122	.... Q
13123	"RTN","BPS TEST",279, 0)
13124	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",.13, "I") I BPS X'="" D ; B91-3W days supp ly limit p er spec ti me period
13125	"RTN","BPS TEST",280, 0)
13126	.... S BP SDATA(1,20 90)=1 ; count f ield
13127	"RTN","BPS TEST",281, 0)
13128	.... S BP SDATA(1,20 91,1)=$$NF F^BPSECFM( BPSX,3) ; data fr om overrid e file
13129	"RTN","BPS TEST",282, 0)
13130	.... Q
13131	"RTN","BPS TEST",283, 0)
13132	... S BPS X=$$GET1^D IQ(9002313 .32,BPSTIE N_",",.14, "I") I BPS X'="" D ; B92-3X days supp ly limit t ime period
13133	"RTN","BPS TEST",284, 0)
13134	.... S BP SDATA(1,20 90)=1 ; count f ield
13135	"RTN","BPS TEST",285, 0)
13136	.... S BP SDATA(1,20 92,1)=$$NF F^BPSECFM( BPSX,5) ; data fr om overrid e file
13137	"RTN","BPS TEST",286, 0)
13138	.... Q
13139	"RTN","BPS TEST",287, 0)
13140	... Q
13141	"RTN","BPS TEST",288, 0)
13142	.. ;
13143	"RTN","BPS TEST",289, 0)
13144	.. ; If r ejected, g et the rej ection cod e and file them
13145	"RTN","BPS TEST",290, 0)
13146	.. ; Also , delete t he BPSPAID amount
13147	"RTN","BPS TEST",291, 0)
13148	.. I BPSS RESP="R" D
13149	"RTN","BPS TEST",292, 0)
13150	... ; Del ete old re jections a nd BPSPAID amount
13151	"RTN","BPS TEST",293, 0)
13152	... K BPS DATA(1,509 ),BPSDATA( 1,511)
13153	"RTN","BPS TEST",294, 0)
13154	... ; Loo p through rejections and store
13155	"RTN","BPS TEST",295, 0)
13156	... S BPS RCNT=0
13157	"RTN","BPS TEST",296, 0)
13158	... S BPS RIEN=0 F S BPSRIEN= $O(^BPS(90 02313.32,B PSTIEN,1,B PSRIEN)) Q :+BPSRIEN= 0 D
13159	"RTN","BPS TEST",297, 0)
13160	.... S BP SRCODE=$P( $G(^BPS(90 02313.32,B PSTIEN,1,B PSRIEN,0)) ,"^",1)
13161	"RTN","BPS TEST",298, 0)
13162	.... ; In crement co unter and store
13163	"RTN","BPS TEST",299, 0)
13164	.... I BP SRCODE]"" D
13165	"RTN","BPS TEST",300, 0)
13166	..... S B PSRCD=$$GE T1^DIQ(900 2313.93,BP SRCODE_"," ,.01,"E")
13167	"RTN","BPS TEST",301, 0)
13168	..... I B PSRCD]"" S BPSRCNT=B PSRCNT+1,B PSDATA(1,5 11,BPSRCNT )=BPSRCD
13169	"RTN","BPS TEST",302, 0)
13170	... ; Sto re total n umber of r ejections
13171	"RTN","BPS TEST",303, 0)
13172	... S BPS DATA(1,510 )=BPSRCNT
13173	"RTN","BPS TEST",304, 0)
13174	Q
13175	"RTN","BPS TEST",305, 0)
13176	;
13177	"RTN","BPS TEST",306, 0)
13178	SELOVER ;
13179	"RTN","BPS TEST",307, 0)
13180	; Used to create ov errides fo r prescrip tion that will proce ssed in th e
13181	"RTN","BPS TEST",308, 0)
13182	; backgro und (CMOP, auto-reve rsals). T he user is prompted for the
13183	"RTN","BPS TEST",309, 0)
13184	; prescri ption and other info rmation an d then cal ls GETOVER . It is c alled
13185	"RTN","BPS TEST",310, 0)
13186	; by opti on BPS PRO VIDER RESP ONSE OVERR IDES
13187	"RTN","BPS TEST",311, 0)
13188	;
13189	"RTN","BPS TEST",312, 0)
13190	; This do es not wor k for elig ibility bu t we don't do them i n the back ground
13191	"RTN","BPS TEST",313, 0)
13192	; right now.
13193	"RTN","BPS TEST",314, 0)
13194	;
13195	"RTN","BPS TEST",315, 0)
13196	N BPSRXIE N,BPSRXNM, BPSRXFL,BP SRFL,BPSOR ESP,BPSTYP E,BPSRXARR ,BPSRARR,D IC,Y,DIR
13197	"RTN","BPS TEST",316, 0)
13198	;
13199	"RTN","BPS TEST",317, 0)
13200	; Check i f test mod e is on
13201	"RTN","BPS TEST",318, 0)
13202	I '$$CHEC K() Q
13203	"RTN","BPS TEST",319, 0)
13204	;
13205	"RTN","BPS TEST",320, 0)
13206	; Prompt for the Pr escription
13207	"RTN","BPS TEST",321, 0)
13208	S BPSRXIE N=$$PROMPT RX^BPSUTIL 1 Q:BPSRXI EN<1
13209	"RTN","BPS TEST",322, 0)
13210	D RXAPI^B PSUTIL1(BP SRXIEN,".0 1;22","BPS RXARR","IE ")
13211	"RTN","BPS TEST",323, 0)
13212	S BPSRXNM =$G(BPSRXA RR(52,BPSR XIEN,.01," E"))
13213	"RTN","BPS TEST",324, 0)
13214	;
13215	"RTN","BPS TEST",325, 0)
13216	; Prompt for Fill/R efill
13217	"RTN","BPS TEST",326, 0)
13218	S DIR(0)= "S^0:"_$G( BPSRXARR(5 2,BPSRXIEN ,22,"E"))
13219	"RTN","BPS TEST",327, 0)
13220	F BPSRFL= 1:1 D RXSU BF^BPSUTIL 1(BPSRXIEN ,52,52.1,B PSRFL,.01, "BPSRARR", "E") Q:$G( BPSRARR(52 .1,BPSRFL, .01,"E"))= "" D
13221	"RTN","BPS TEST",328, 0)
13222	. S DIR(0 )=DIR(0)_" ;"_BPSRFL_ ":"_BPSRAR R(52.1,BPS RFL,.01,"E ")
13223	"RTN","BPS TEST",329, 0)
13224	S DIR("A" )="Select fill/refil l for pres cription " _BPSRXNM,D IR("B")=0
13225	"RTN","BPS TEST",330, 0)
13226	D ^DIR
13227	"RTN","BPS TEST",331, 0)
13228	I Y'=+Y Q
13229	"RTN","BPS TEST",332, 0)
13230	S BPSRXFL =Y
13231	"RTN","BPS TEST",333, 0)
13232	;
13233	"RTN","BPS TEST",334, 0)
13234	; Prompt for BPSTYP E
13235	"RTN","BPS TEST",335, 0)
13236	S DIR(0)= "S^R:Rever sal;RS:Res ubmit with Reversal; S:Submit"
13237	"RTN","BPS TEST",336, 0)
13238	S DIR("A" )="Enter B PSTYPE of transactio n",DIR("B" )="SUBMIT"
13239	"RTN","BPS TEST",337, 0)
13240	D ^DIR
13241	"RTN","BPS TEST",338, 0)
13242	I ",R,RS, S,"'[","_Y _"," Q
13243	"RTN","BPS TEST",339, 0)
13244	S BPSTYPE =Y
13245	"RTN","BPS TEST",340, 0)
13246	;
13247	"RTN","BPS TEST",341, 0)
13248	; Set up parameters
13249	"RTN","BPS TEST",342, 0)
13250	S BPSORES P=""
13251	"RTN","BPS TEST",343, 0)
13252	I BPSTYPE ="RS" S BP STYPE="S", BPSORESP=" E PAYABLE"
13253	"RTN","BPS TEST",344, 0)
13254	;
13255	"RTN","BPS TEST",345, 0)
13256	; Call GE TOVER
13257	"RTN","BPS TEST",346, 0)
13258	D GETOVER (BPSRXIEN, BPSRXFL,BP SORESP,"", BPSTYPE)
13259	"RTN","BPS TEST",347, 0)
13260	Q
13261	"RTN","BPS TEST",348, 0)
13262	;
13263	"RTN","BPS TEST",349, 0)
13264	CHECK() ;
13265	"RTN","BPS TEST",350, 0)
13266	; Check i f Test Mod e is ON in the BPS S etup table
13267	"RTN","BPS TEST",351, 0)
13268	; Also ca lled by BP SNCPDP and BPSEMCPS
13269	"RTN","BPS TEST",352, 0)
13270	;
13271	"RTN","BPS TEST",353, 0)
13272	;IA#4440
13273	"RTN","BPS TEST",354, 0)
13274	Q $S($$PR OD^XUPROD: 0,1:$P($G( ^BPS(90023 13.99,1,0) ),"^",3))
13275	"RTN","BPS TEST",355, 0)
13276	;
13277	"RTN","BPS TEST",356, 0)
13278	CREATE(BPS TRANS) ;
13279	"RTN","BPS TEST",357, 0)
13280	; Create the Overri de record
13281	"RTN","BPS TEST",358, 0)
13282	;
13283	"RTN","BPS TEST",359, 0)
13284	N DIC,X,Y ,BPSTIEN,D A
13285	"RTN","BPS TEST",360, 0)
13286	S DIC=900 2313.32,DI C(0)="L",X =BPSTRANS
13287	"RTN","BPS TEST",361, 0)
13288	D ^DIC
13289	"RTN","BPS TEST",362, 0)
13290	S BPSTIEN =+Y
13291	"RTN","BPS TEST",363, 0)
13292	Q BPSTIEN
13293	"RTN","BPS TEST",364, 0)
13294	;
13295	"RTN","BPS TEST",365, 0)
13296	FILE(DIE,D A,BPSFLD,B PSDATA) ;
13297	"RTN","BPS TEST",366, 0)
13298	; File in the Overr ide record
13299	"RTN","BPS TEST",367, 0)
13300	;
13301	"RTN","BPS TEST",368, 0)
13302	N DR,X,Y
13303	"RTN","BPS TEST",369, 0)
13304	S DR=BPSF LD_"///"_B PSDATA
13305	"RTN","BPS TEST",370, 0)
13306	L +@(DIE_ DA_")"):0 I $T D ^DI E L -@(DIE _DA_")") Q
13307	"RTN","BPS TEST",371, 0)
13308	W !?5,"An other user is editin g this ent ry."
13309	"RTN","BPS TEST",372, 0)
13310	Q
13311	"RTN","BPS TEST",373, 0)
13312	;
13313	"RTN","BPS TEST",374, 0)
13314	PROMPT(DA, BPSFLD,BPS DFLT) ;
13315	"RTN","BPS TEST",375, 0)
13316	; Prompt for a spec ific field and set t he data
13317	"RTN","BPS TEST",376, 0)
13318	;
13319	"RTN","BPS TEST",377, 0)
13320	N DIE,DR, DTOUT,X,Y
13321	"RTN","BPS TEST",378, 0)
13322	S DIE="^B PS(9002313 .32,",DR=B PSFLD_"//" _BPSDFLT
13323	"RTN","BPS TEST",379, 0)
13324	L +@(DIE_ DA_")"):0 I $T D ^DI E L -@(DIE _DA_")") Q
13325	"RTN","BPS TEST",380, 0)
13326	W !?5,"An other user is editin g this ent ry."
13327	"RTN","BPS TEST",381, 0)
13328	Q
13329	"RTN","BPS TEST",382, 0)
13330	;
13331	"RTN","BPS TEST",383, 0)
13332	REJECTS(BP STIEN) ; B PS122
13333	"RTN","BPS TEST",384, 0)
13334	N DA,DIE, DR,DTOUT,X ,Y
13335	"RTN","BPS TEST",385, 0)
13336	; Delete all entrie s from the reject mu ltiple so user doesn 't have to manually delete
13337	"RTN","BPS TEST",386, 0)
13338	; The rej ect code p rompt will have a de fault valu e of '07'
13339	"RTN","BPS TEST",387, 0)
13340	K ^BPS(90 02313.32,B PSTIEN,1)
13341	"RTN","BPS TEST",388, 0)
13342	; Prompt for Reject Code(s) a nd set the data
13343	"RTN","BPS TEST",389, 0)
13344	S DA=BPST IEN,DIE="^ BPS(900231 3.32,",DR= 1_"//07"
13345	"RTN","BPS TEST",390, 0)
13346	L +@(DIE_ DA_")"):0 I $T D ^DI E L -@(DIE _DA_")") Q
13347	"RTN","BPS TEST",391, 0)
13348	W !?5,"An other user is editin g this ent ry."
13349	"RTN","BPS TEST",392, 0)
13350	Q
13351	"RTN","BPS TEST",393, 0)
13352	;
13353	"RTN","BPS TEST",394, 0)
13354	SETDELAY(B PSTRANS) ;
13355	"RTN","BPS TEST",395, 0)
13356	; Input
13357	"RTN","BPS TEST",396, 0)
13358	; BPST RANS - Tra nsaction I EN
13359	"RTN","BPS TEST",397, 0)
13360	; Check t he Test Fl ag in set in BPS SET UP
13361	"RTN","BPS TEST",398, 0)
13362	I '$$CHEC K() Q 0
13363	"RTN","BPS TEST",399, 0)
13364	N BPSDELA Y,BPSTIEN, BPSTIME
13365	"RTN","BPS TEST",400, 0)
13366	; Check i f the Tran saction Nu mber is de fined in B PS RESPONS E OVERRIDE S
13367	"RTN","BPS TEST",401, 0)
13368	S BPSTIEN =$O(^BPS(9 002313.32, "B",BPSTRA NS,""))
13369	"RTN","BPS TEST",402, 0)
13370	I BPSTIEN ="" Q 0
13371	"RTN","BPS TEST",403, 0)
13372	S BPSDELA Y=$$GET1^D IQ(9002313 .32,BPSTIE N_",",.07, "I")*60
13373	"RTN","BPS TEST",404, 0)
13374	I BPSDELA Y'>0 Q 0
13375	"RTN","BPS TEST",405, 0)
13376	S BPSTIME =$$FMADD^X LFDT($$NOW ^XLFDT,,,, BPSDELAY)
13377	"RTN","BPS TEST",406, 0)
13378	I BPSTIME >0 D Q BP STIME
13379	"RTN","BPS TEST",407, 0)
13380	. ;schedu le a task to run RUN NING^BPSOS RX
13381	"RTN","BPS TEST",408, 0)
13382	. N ZTRTN ,ZTDTH,ZTI O,ZTSK
13383	"RTN","BPS TEST",409, 0)
13384	. S ZTRTN ="RUNECME^ BPSTEST",Z TDESC="BPS TEST: ECME testing t ool"
13385	"RTN","BPS TEST",410, 0)
13386	. S ZTDTH =$$FMADD^X LFDT($$NOW ^XLFDT,,,, BPSDELAY+1 0),ZTIO=""
13387	"RTN","BPS TEST",411, 0)
13388	. D ^%ZTL OAD
13389	"RTN","BPS TEST",412, 0)
13390	Q 0
13391	"RTN","BPS TEST",413, 0)
13392	;
13393	"RTN","BPS TEST",414, 0)
13394	RUNECME ;
13395	"RTN","BPS TEST",415, 0)
13396	D RUNNING ^BPSOSRX()
13397	"RTN","BPS TEST",416, 0)
13398	Q
13399	"RTN","BPS TEST",417, 0)
13400	;get the reversal r eject from the ^XTMP and set B PSDATA to override d ata
13401	"RTN","BPS TEST",418, 0)
13402	SETREJ(BPS TRANS) ;
13403	"RTN","BPS TEST",419, 0)
13404	N BPSREJ
13405	"RTN","BPS TEST",420, 0)
13406	S BPSREJ= $G(^XTMP(" BPSTEST",B PSTRANS))
13407	"RTN","BPS TEST",421, 0)
13408	I BPSREJ= "" Q
13409	"RTN","BPS TEST",422, 0)
13410	S BPSDATA (1,511,1)= BPSREJ
13411	"RTN","BPS TEST",423, 0)
13412	S BPSDATA (1,510)=1
13413	"RTN","BPS TEST",424, 0)
13414	Q
13415	"RTN","BPS TEST",425, 0)
13416	;enter a reversal r eject
13417	"RTN","BPS TEST",426, 0)
13418	ENREVRJ(BP STRANS) ;
13419	"RTN","BPS TEST",427, 0)
13420	N BPRJCOD E,TMSTAMP
13421	"RTN","BPS TEST",428, 0)
13422	S BPRJCOD E=$$PROMPT ^BPSSCRU4( "Enter a r eject code for rever sal")
13423	"RTN","BPS TEST",429, 0)
13424	I $P(BPRJ CODE,U)="" Q
13425	"RTN","BPS TEST",430, 0)
13426	I $P(BPRJ CODE,U)=0 Q
13427	"RTN","BPS TEST",431, 0)
13428	N X,X1,X2
13429	"RTN","BPS TEST",432, 0)
13430	S X1=DT,X 2=2 D C^%D TC
13431	"RTN","BPS TEST",433, 0)
13432	S ^XTMP(" BPSTEST",0 )=X_U_DT_U _"ECME TES TING TOOL, SEE BPSTE ST ROUTINE "
13433	"RTN","BPS TEST",434, 0)
13434	S ^XTMP(" BPSTEST",B PSTRANS)=$ P(BPRJCODE ,U)
13435	"RTN","BPS TEST",435, 0)
13436	Q
13437	"RTN","BPS TEST",436, 0)
13438	;
13439	"RTN","BPS TEST1")
13440	0^11^B1964 24
13441	"RTN","BPS TEST1",1,0 )
13442	BPSTEST1 ; OAK/ELZ - ECME TESTI NG TOOL ;1 1/15/07 0 9:55
13443	"RTN","BPS TEST1",2,0 )
13444	;;1.0;E C LAIMS MGMT ENGINE; 6,7,8,10,1 1,15,19,20 ,22;JUN 2004;Build 15
13445	"RTN","BPS TEST1",3,0 )
13446	;;Per VA Directive 6402, this routine s hould not be modifie d.
13447	"RTN","BPS TEST1",4,0 )
13448	;
13449	"RTN","BPS TEST1",5,0 )
13450	Q
13451	"RTN","BPS TEST1",6,0 )
13452	;
13453	"RTN","BPS TEST1",7,0 )
13454	; Overvie w
13455	"RTN","BPS TEST1",8,0 )
13456	; ======= =
13457	"RTN","BPS TEST1",9,0 )
13458	;
13459	"RTN","BPS TEST1",10, 0)
13460	; When a production instance of VistA s ends a cla im, the cl aim is
13461	"RTN","BPS TEST1",11, 0)
13462	; sent to FSC and t hen to the clearingh ouse, whic h sends th e claim to
13463	"RTN","BPS TEST1",12, 0)
13464	; the app ropriate p ayer. The payer's r esponse is returned to the
13465	"RTN","BPS TEST1",13, 0)
13466	; clearin ghouse and then to F SC, who re turns the response t o the site
13467	"RTN","BPS TEST1",14, 0)
13468	; which s ent the cl aim.
13469	"RTN","BPS TEST1",15, 0)
13470	;
13471	"RTN","BPS TEST1",16, 0)
13472	; When a non-produc tion insta nce of Vis tA sends a claim, it goes to F SC
13473	"RTN","BPS TEST1",17, 0)
13474	; and the n to the c learinghou se test be d. Becaus e the clai m is flagg ed
13475	"RTN","BPS TEST1",18, 0)
13476	; as bein g a test c laim, the clearingho use does n ot send th e claim to a
13477	"RTN","BPS TEST1",19, 0)
13478	; payer. The clear inghouse r eturns to FSC a boil er-plate r esponse,
13479	"RTN","BPS TEST1",20, 0)
13480	; indicat ing the cl aim was ac cepted and paid. FS C returns the respon se
13481	"RTN","BPS TEST1",21, 0)
13482	; to the non-produc tion insta nce of Vis tA which s ent the cl aim. A non -productio n
13483	"RTN","BPS TEST1",22, 0)
13484	; instanc e of VistA includes any accoun t used by a developm ent team f or
13485	"RTN","BPS TEST1",23, 0)
13486	; develop ment and t esting of new enhanc ements.
13487	"RTN","BPS TEST1",24, 0)
13488	;
13489	"RTN","BPS TEST1",25, 0)
13490	; The ECM E Testing Tool (^BPS TEST) allo ws users i n a non-pr oduction
13491	"RTN","BPS TEST1",26, 0)
13492	; VistA t o override some of t he fields on the def ault respo nse return ed
13493	"RTN","BPS TEST1",27, 0)
13494	; by the clearingho use. The Testing To ol does no t affect t he outgoin g
13495	"RTN","BPS TEST1",28, 0)
13496	; claim d ata. The purpose of the Testi ng Tool is to facili tate testi ng
13497	"RTN","BPS TEST1",29, 0)
13498	; by allo wing the u ser to man ipulate th e default response r eturned by
13499	"RTN","BPS TEST1",30, 0)
13500	; the cle aringhouse when send ing test c laims.
13501	"RTN","BPS TEST1",31, 0)
13502	;
13503	"RTN","BPS TEST1",32, 0)
13504	; The Tes ting Tool does not e ver run on productio n VistAs, only on no n-
13505	"RTN","BPS TEST1",33, 0)
13506	; product ion instan ces of Vis tA.
13507	"RTN","BPS TEST1",34, 0)
13508	;
13509	"RTN","BPS TEST1",35, 0)
13510	; Invokin g the Test ing Tool
13511	"RTN","BPS TEST1",36, 0)
13512	; ======= ========== ========
13513	"RTN","BPS TEST1",37, 0)
13514	;
13515	"RTN","BPS TEST1",38, 0)
13516	; Two thi ngs must b e true in order for the Testin g Tool to be invoked :
13517	"RTN","BPS TEST1",39, 0)
13518	; The sys tem must n ot be a pr oduction s ystem (i.e . $$PROD^ XUPROD mus t
13519	"RTN","BPS TEST1",40, 0)
13520	; be fals e); and th e field PA YER RESPON SE TEST MO DE on the file BPS
13521	"RTN","BPS TEST1",41, 0)
13522	; SETUP m ust be set to 1/On. The Testi ng Tool ma y not be i nvoked fro m a
13523	"RTN","BPS TEST1",42, 0)
13524	; product ion system , and on n on-product ion accoun ts, the PA YER RESPON SE
13525	"RTN","BPS TEST1",43, 0)
13526	; TEST MO DE fields must be se t to 1/On to make us e of the T esting Too l.
13527	"RTN","BPS TEST1",44, 0)
13528	;
13529	"RTN","BPS TEST1",45, 0)
13530	; While t est/mirror accounts at product ion sites are non-pr oduction
13531	"RTN","BPS TEST1",46, 0)
13532	; systems , the Test ing Tool w ill never be used in these sys tems since
13533	"RTN","BPS TEST1",47, 0)
13534	; the fie ld PAYER R ESPONSE TE ST MODE wi ll never b e set to 1 /On. Thes e
13535	"RTN","BPS TEST1",48, 0)
13536	; account s generall y do not h ave ePharm acy commun ication se t up with
13537	"RTN","BPS TEST1",49, 0)
13538	; FSC, so they will never sen d test cla ims.
13539	"RTN","BPS TEST1",50, 0)
13540	;
13541	"RTN","BPS TEST1",51, 0)
13542	; Using t he Testing Tool
13543	"RTN","BPS TEST1",52, 0)
13544	; ======= ========== =====
13545	"RTN","BPS TEST1",53, 0)
13546	;
13547	"RTN","BPS TEST1",54, 0)
13548	; There a re several VistA men u options and action s that can initiate the
13549	"RTN","BPS TEST1",55, 0)
13550	; submiss ion of a c laim. If the proces s is a for eground pr ocess, the n
13551	"RTN","BPS TEST1",56, 0)
13552	; just be fore the b uilding an d sending of the cla im, the us er is give n
13553	"RTN","BPS TEST1",57, 0)
13554	; the opt ion of ent ering resp onse overr ides (if t he system is a non-
13555	"RTN","BPS TEST1",58, 0)
13556	; product ion system , and the PAYER RESP ONSE TEST MODE field is set to
13557	"RTN","BPS TEST1",59, 0)
13558	; 1/On). The user may also e nter respo nse overri des for an Eligibili ty
13559	"RTN","BPS TEST1",60, 0)
13560	; transac tion or a Reversal.
13561	"RTN","BPS TEST1",61, 0)
13562	;
13563	"RTN","BPS TEST1",62, 0)
13564	; The Tes ting Tool does allow for overr ides to be entered f or a claim
13565	"RTN","BPS TEST1",63, 0)
13566	; which w ill be sub mitted in the backgr ound. The menu opti on BPS SEL ECT
13567	"RTN","BPS TEST1",64, 0)
13568	; OVERRID ES allows the user t o enter ov errides wh ich will t hen be
13569	"RTN","BPS TEST1",65, 0)
13570	; applied to the in coming cla im respons e when the claim is submitted in
13571	"RTN","BPS TEST1",66, 0)
13572	; the bac kground (s uch as CMO P or auto- reversal). This men u option d oes
13573	"RTN","BPS TEST1",67, 0)
13574	; not exi st in prod uction sys tems.
13575	"RTN","BPS TEST1",68, 0)
13576	;
13577	"RTN","BPS TEST1",69, 0)
13578	; The cla im submiss ion code w ill call t he subrout ine GETOVE R^BPSTEST,
13579	"RTN","BPS TEST1",70, 0)
13580	; which w ill indica te to the user that payer over rides are enabled at
13581	"RTN","BPS TEST1",71, 0)
13582	; that si te. The s ystem will prompt th e user "Do you want to enter
13583	"RTN","BPS TEST1",72, 0)
13584	; overrid es for thi s request? ". If the user ente rs "No", t hen they w ill
13585	"RTN","BPS TEST1",73, 0)
13586	; not rec eive any f urther pro mpts relat ed to the Testing To ol. No
13587	"RTN","BPS TEST1",74, 0)
13588	; values on the inc oming resp onse will be overrid den with a ny user-
13589	"RTN","BPS TEST1",75, 0)
13590	; entered values. If the use r enters " Yes", then the syste m will all ow
13591	"RTN","BPS TEST1",76, 0)
13592	; the use r to enter override values for a variety of fields , for
13593	"RTN","BPS TEST1",77, 0)
13594	; example : Respons e (rejecte d, paid, d uplicate, stranded), Total Amo unt
13595	"RTN","BPS TEST1",78, 0)
13596	; Paid, C opay Amoun t, Ingredi ent Cost P aid, Next Available Fill Date,
13597	"RTN","BPS TEST1",79, 0)
13598	; Payer I D Qualifie r, etc.
13599	"RTN","BPS TEST1",80, 0)
13600	;
13601	"RTN","BPS TEST1",81, 0)
13602	; When th e incoming claim res ponse come s in, the system par ses the
13603	"RTN","BPS TEST1",82, 0)
13604	; values and stores them in t he file BP S RESPONSE S. (Data fields may
13605	"RTN","BPS TEST1",83, 0)
13606	; also be stored on the REJEC T INFO sub -file of t he PRESCRI PTIONS fil e.)
13607	"RTN","BPS TEST1",84, 0)
13608	; If the system is a non-prod uction sys tem, and t he PAYER R ESPONSE TE ST
13609	"RTN","BPS TEST1",85, 0)
13610	; MODE fi eld is set to 1/On, then the s ubroutine PARSE^BPSE CMPS will
13611	"RTN","BPS TEST1",86, 0)
13612	; call SE TOVER^BPST EST. If a ny overrid es had bee n entered for the cl aim
13613	"RTN","BPS TEST1",87, 0)
13614	; respons e, those v alues will override the values received from the
13615	"RTN","BPS TEST1",88, 0)
13616	; clearin ghouse on the claim response.
13617	"RTN","BPS TEST1",89, 0)
13618	;
13619	"RTN","BPS VRX3")
13620	0^4^B51860 614
13621	"RTN","BPS VRX3",1,0)
13622	BPSVRX3 ;A ITC/PD - P rint Repor t from VER ;5/2/2017
13623	"RTN","BPS VRX3",2,0)
13624	;;1.0;E C LAIMS MGMT ENGINE; 22;;Buil d 15
13625	"RTN","BPS VRX3",3,0)
13626	;;Per VA Directive 6402, this routine s hould not be modifie d.
13627	"RTN","BPS VRX3",4,0)
13628	;
13629	"RTN","BPS VRX3",5,0)
13630	Q
13631	"RTN","BPS VRX3",6,0)
13632	;
13633	"RTN","BPS VRX3",7,0)
13634	REPORT ; S elect and print sect ions of th e list.
13635	"RTN","BPS VRX3",8,0)
13636	;
13637	"RTN","BPS VRX3",9,0)
13638	; Allow t he user to select on e or more sections o f the VER list to
13639	"RTN","BPS VRX3",10,0 )
13640	; print t o the spec ified devi ce.
13641	"RTN","BPS VRX3",11,0 )
13642	;
13643	"RTN","BPS VRX3",12,0 )
13644	N BPSJOB, BPSLIST
13645	"RTN","BPS VRX3",13,0 )
13646	S BPSJOB= $J
13647	"RTN","BPS VRX3",14,0 )
13648	D FULL^VA LM1
13649	"RTN","BPS VRX3",15,0 )
13650	;
13651	"RTN","BPS VRX3",16,0 )
13652	LIST I '$$ SELECT(.BP SLIST) G R EXIT
13653	"RTN","BPS VRX3",17,0 )
13654	;
13655	"RTN","BPS VRX3",18,0 )
13656	I '$$DEVI CE() G REX IT:$$STOP, LIST
13657	"RTN","BPS VRX3",19,0 )
13658	;
13659	"RTN","BPS VRX3",20,0 )
13660	REXIT ; Ex it point.
13661	"RTN","BPS VRX3",21,0 )
13662	;
13663	"RTN","BPS VRX3",22,0 )
13664	Q
13665	"RTN","BPS VRX3",23,0 )
13666	;
13667	"RTN","BPS VRX3",24,0 )
13668	SELECT(BPS LIST) ; Al low user t o select s ections of the list to be prin ted.
13669	"RTN","BPS VRX3",25,0 )
13670	;
13671	"RTN","BPS VRX3",26,0 )
13672	; This fu nction ret urns a 1 i f the user entered o ne or more sections
13673	"RTN","BPS VRX3",27,0 )
13674	; to be p rinted, 0 if no sele ction was made.
13675	"RTN","BPS VRX3",28,0 )
13676	; This fu nction exp ects the f ollowing v ariables t o exist:
13677	"RTN","BPS VRX3",29,0 )
13678	; - BPSJO B will be set to the $J of the current j ob, if for eground,
13679	"RTN","BPS VRX3",30,0 )
13680	; or th e job whic h launched this back ground job , if backg round.
13681	"RTN","BPS VRX3",31,0 )
13682	; - BPSVR X("LISTNAV ",Section# ) = Beginn ing Line#
13683	"RTN","BPS VRX3",32,0 )
13684	; where Section# is a numbe r, 1-14, c orrespondi ng to a se ction of t he
13685	"RTN","BPS VRX3",33,0 )
13686	; ListMan list, and Beginning Line# is the first line of th at section .
13687	"RTN","BPS VRX3",34,0 )
13688	;
13689	"RTN","BPS VRX3",35,0 )
13690	; Returns the BPSLI ST array w ith a list of one or more sect ions:
13691	"RTN","BPS VRX3",36,0 )
13692	; BPS LIST(Secti on#) = Fir st Line ^ Last Line
13693	"RTN","BPS VRX3",37,0 )
13694	; Where F irst Line and Last L ine are th e first an d last lin es of
13695	"RTN","BPS VRX3",38,0 )
13696	; that se ction in t he list an d Section# can be on e or more numbers
13697	"RTN","BPS VRX3",39,0 )
13698	; from 1 to 14, eac h correspo nding to a section:
13699	"RTN","BPS VRX3",40,0 )
13700	; 8 - AP, TPJI Account P rofile
13701	"RTN","BPS VRX3",41,0 )
13702	; 3 - BE, Bill ing Events
13703	"RTN","BPS VRX3",42,0 )
13704	; 7 - CI, TPJI Claim Inf o
13705	"RTN","BPS VRX3",43,0 )
13706	; 2 - CL, Clai m Log
13707	"RTN","BPS VRX3",44,0 )
13708	; 9 - CM, TPJI AR Commen t History
13709	"RTN","BPS VRX3",45,0 )
13710	; 4 - CR, Clai ms Respons e Inquiry Report
13711	"RTN","BPS VRX3",46,0 )
13712	; 10 - ER, TPJI ECME Rx I nformation
13713	"RTN","BPS VRX3",47,0 )
13714	; 11 - ES, Elig ibility St atus
13715	"RTN","BPS VRX3",48,0 )
13716	; 12 - EV, Elig ibility Ve rification
13717	"RTN","BPS VRX3",49,0 )
13718	; 5 - IN, Insu rance
13719	"RTN","BPS VRX3",50,0 )
13720	; 6 - LB, List of Bills
13721	"RTN","BPS VRX3",51,0 )
13722	; 14 - MP, Medi cation Pro file
13723	"RTN","BPS VRX3",52,0 )
13724	; 13 - SD, Sens itive Drug
13725	"RTN","BPS VRX3",53,0 )
13726	; 1 - VW, View Rx
13727	"RTN","BPS VRX3",54,0 )
13728	;
13729	"RTN","BPS VRX3",55,0 )
13730	N BPSLC,B PSLISTNAV, BPSSECBEGI N,BPSSECEN D,BPSSECNU M,BPSSECLI ST,BPSSEL
13731	"RTN","BPS VRX3",56,0 )
13732	N BPSUC,B PSX,BPSY,D A,DIR,DIRO UT,DIRUT,D TOUT,DUOUT ,X,Y
13733	"RTN","BPS VRX3",57,0 )
13734	;
13735	"RTN","BPS VRX3",58,0 )
13736	S BPSSECL IST=",AP,B E,CI,CL,CM ,CR,ER,ES, EV,IN,LB,M P,SD,VW,"
13737	"RTN","BPS VRX3",59,0 )
13738	S BPSLIST NAV("AP")= 8
13739	"RTN","BPS VRX3",60,0 )
13740	S BPSLIST NAV("BE")= 3
13741	"RTN","BPS VRX3",61,0 )
13742	S BPSLIST NAV("CI")= 7
13743	"RTN","BPS VRX3",62,0 )
13744	S BPSLIST NAV("CL")= 2
13745	"RTN","BPS VRX3",63,0 )
13746	S BPSLIST NAV("CM")= 9
13747	"RTN","BPS VRX3",64,0 )
13748	S BPSLIST NAV("CR")= 4
13749	"RTN","BPS VRX3",65,0 )
13750	S BPSLIST NAV("ER")= 10
13751	"RTN","BPS VRX3",66,0 )
13752	S BPSLIST NAV("ES")= 11
13753	"RTN","BPS VRX3",67,0 )
13754	S BPSLIST NAV("EV")= 12
13755	"RTN","BPS VRX3",68,0 )
13756	S BPSLIST NAV("IN")= 5
13757	"RTN","BPS VRX3",69,0 )
13758	S BPSLIST NAV("LB")= 6
13759	"RTN","BPS VRX3",70,0 )
13760	S BPSLIST NAV("MP")= 14
13761	"RTN","BPS VRX3",71,0 )
13762	S BPSLIST NAV("SD")= 13
13763	"RTN","BPS VRX3",72,0 )
13764	S BPSLIST NAV("VW")= 1
13765	"RTN","BPS VRX3",73,0 )
13766	;
13767	"RTN","BPS VRX3",74,0 )
13768	S BPSUC=" ABCDEFGHIJ KLMNOPQRST UVWXYZ"
13769	"RTN","BPS VRX3",75,0 )
13770	S BPSLC=" abcdefghij klmnopqrst uvwxyz"
13771	"RTN","BPS VRX3",76,0 )
13772	;
13773	"RTN","BPS VRX3",77,0 )
13774	; Display the list of actions to the us er once, u pon execut ing the PR option.
13775	"RTN","BPS VRX3",78,0 )
13776	; List ca n be re-di splayed to the user by enterin g ??.
13777	"RTN","BPS VRX3",79,0 )
13778	W !
13779	"RTN","BPS VRX3",80,0 )
13780	W !,"VW V iew Rx CR C RI Report CI T PJI Claim Info ER T PJI ECME R x"
13781	"RTN","BPS VRX3",81,0 )
13782	W !,"CL C laim Log IN I nsurance AP T PJI Acct P ro ES E lig Status "
13783	"RTN","BPS VRX3",82,0 )
13784	W !,"BE B illing Eve nts LB L ist of Bil ls CM T PJI AR Com m EV E lig Verif"
13785	"RTN","BPS VRX3",83,0 )
13786	W !
13787	"RTN","BPS VRX3",84,0 )
13788	;
13789	"RTN","BPS VRX3",85,0 )
13790	SELECT1 ; Prompt use r for sect ion(s) to print.
13791	"RTN","BPS VRX3",86,0 )
13792	;
13793	"RTN","BPS VRX3",87,0 )
13794	S DIR(0)= "FO^0:40"
13795	"RTN","BPS VRX3",88,0 )
13796	S DIR("A" )="Select Report to Print"
13797	"RTN","BPS VRX3",89,0 )
13798	S DIR("?" ,1)=" Sele ct one or many repor t(s) to pr int, separ ated by co mmas. When all"
13799	"RTN","BPS VRX3",90,0 )
13800	S DIR("?" ,2)=" repo rts have b een select ed, hit en ter withou t making a nother sel ection."
13801	"RTN","BPS VRX3",91,0 )
13802	S DIR("?" ,3)=" Exam ple: "
13803	"RTN","BPS VRX3",92,0 )
13804	S DIR("?" ,4)=" Sel ect Report to Print: VW,IN,CM"
13805	"RTN","BPS VRX3",93,0 )
13806	S DIR("?" )=" Selec t Report t o Print: E S"
13807	"RTN","BPS VRX3",94,0 )
13808	S DIR("?? ")="^D HEL P^BPSVRX3"
13809	"RTN","BPS VRX3",95,0 )
13810	;
13811	"RTN","BPS VRX3",96,0 )
13812	D ^DIR
13813	"RTN","BPS VRX3",97,0 )
13814	;
13815	"RTN","BPS VRX3",98,0 )
13816	; If user enters "^ " or "^^", or it tim es out, cl ear out th e
13817	"RTN","BPS VRX3",99,0 )
13818	; list an d skip to end.
13819	"RTN","BPS VRX3",100, 0)
13820	;
13821	"RTN","BPS VRX3",101, 0)
13822	I $D(DTOU T)!$D(DUOU T) K BPSLI ST G SELEC TQ
13823	"RTN","BPS VRX3",102, 0)
13824	;
13825	"RTN","BPS VRX3",103, 0)
13826	; If user entered n othing, sk ip to end.
13827	"RTN","BPS VRX3",104, 0)
13828	;
13829	"RTN","BPS VRX3",105, 0)
13830	I X="" G SELECTQ
13831	"RTN","BPS VRX3",106, 0)
13832	;
13833	"RTN","BPS VRX3",107, 0)
13834	; Convert any lower case to u pper case
13835	"RTN","BPS VRX3",108, 0)
13836	S X=$TR(X ,BPSLC,BPS UC)
13837	"RTN","BPS VRX3",109, 0)
13838	;
13839	"RTN","BPS VRX3",110, 0)
13840	F BPSX=1: 1:$L(X,"," ) D
13841	"RTN","BPS VRX3",111, 0)
13842	. S BPSSE L=$P(X,"," ,BPSX)
13843	"RTN","BPS VRX3",112, 0)
13844	. I BPSSE CLIST'[(", "_BPSSEL_" ,") W !,*7 ," ",BPSSE L," is not a valid e ntry." Q
13845	"RTN","BPS VRX3",113, 0)
13846	. S BPSSE CNUM=BPSLI STNAV(BPSS EL)
13847	"RTN","BPS VRX3",114, 0)
13848	. I $D(BP SLIST(BPSS ECNUM)) W !,*7," ",B PSSEL," al ready sele cted." Q
13849	"RTN","BPS VRX3",115, 0)
13850	. S BPSSE CBEGIN=$G( BPSVRX("LI STNAV",BPS SECNUM))
13851	"RTN","BPS VRX3",116, 0)
13852	. S BPSY= $O(BPSVRX( "LISTNAV", BPSSECNUM) )
13853	"RTN","BPS VRX3",117, 0)
13854	. I BPSY' ="" S BPSS ECEND=$G(B PSVRX("LIS TNAV",BPSY ))-1
13855	"RTN","BPS VRX3",118, 0)
13856	. E S BP SSECEND=$O (^TMP("BPS VRX",BPSJO B,""),-1)
13857	"RTN","BPS VRX3",119, 0)
13858	. S BPSLI ST(BPSSECN UM)=BPSSEC BEGIN_"^"_ BPSSECEND
13859	"RTN","BPS VRX3",120, 0)
13860	. Q
13861	"RTN","BPS VRX3",121, 0)
13862	;
13863	"RTN","BPS VRX3",122, 0)
13864	G SELECT1
13865	"RTN","BPS VRX3",123, 0)
13866	;
13867	"RTN","BPS VRX3",124, 0)
13868	SELECTQ ;
13869	"RTN","BPS VRX3",125, 0)
13870	I '$D(BPS LIST) Q 0
13871	"RTN","BPS VRX3",126, 0)
13872	Q 1
13873	"RTN","BPS VRX3",127, 0)
13874	;
13875	"RTN","BPS VRX3",128, 0)
13876	DEVICE() ; Prompt us er for out put device .
13877	"RTN","BPS VRX3",129, 0)
13878	; Functio n return v alues:
13879	"RTN","BPS VRX3",130, 0)
13880	; 1 - U ser select ed a devic e.
13881	"RTN","BPS VRX3",131, 0)
13882	; 0 - U ser exited out.
13883	"RTN","BPS VRX3",132, 0)
13884	;
13885	"RTN","BPS VRX3",133, 0)
13886	N BPSRETU RN,DIR,POP ,X,Y,ZTDES C,ZTQUEUED ,ZTREQ,ZTR TN,ZTSAVE, ZTSK
13887	"RTN","BPS VRX3",134, 0)
13888	S BPSRETU RN=1
13889	"RTN","BPS VRX3",135, 0)
13890	;
13891	"RTN","BPS VRX3",136, 0)
13892	S ZTRTN=" PRINT^BPSV RX3"
13893	"RTN","BPS VRX3",137, 0)
13894	S ZTDESC= "VER View Prescripti on Report"
13895	"RTN","BPS VRX3",138, 0)
13896	S ZTSAVE( "BPS*")=""
13897	"RTN","BPS VRX3",139, 0)
13898	;
13899	"RTN","BPS VRX3",140, 0)
13900	D EN^XUTM DEVQ(ZTRTN ,ZTDESC,.Z TSAVE,"QM" ,1)
13901	"RTN","BPS VRX3",141, 0)
13902	I POP S B PSRETURN=0
13903	"RTN","BPS VRX3",142, 0)
13904	I $G(ZTSK ) W !!,"Re port compi lation has started w ith task# ",ZTSK,"." ,! S DIR(0 )="E" D ^D IR
13905	"RTN","BPS VRX3",143, 0)
13906	;
13907	"RTN","BPS VRX3",144, 0)
13908	Q BPSRETU RN
13909	"RTN","BPS VRX3",145, 0)
13910	;
13911	"RTN","BPS VRX3",146, 0)
13912	STOP() ; Determine if user w ishes to e xit out of the optio n entirely .
13913	"RTN","BPS VRX3",147, 0)
13914	; Functio n return v alues:
13915	"RTN","BPS VRX3",148, 0)
13916	; 1 - Y es, exit e ntirely.
13917	"RTN","BPS VRX3",149, 0)
13918	; 0 - N o, do not exit but r eturn to t he previou s question .
13919	"RTN","BPS VRX3",150, 0)
13920	;
13921	"RTN","BPS VRX3",151, 0)
13922	N DIR,DIR UT,Y
13923	"RTN","BPS VRX3",152, 0)
13924	;
13925	"RTN","BPS VRX3",153, 0)
13926	S DIR(0)= "Y"
13927	"RTN","BPS VRX3",154, 0)
13928	S DIR("A" )="Do you want to ex it out of this optio n entirely "
13929	"RTN","BPS VRX3",155, 0)
13930	S DIR("B" )="YES"
13931	"RTN","BPS VRX3",156, 0)
13932	S DIR("?" ,1)=" Ent er YES to immediatel y exit out of this o ption."
13933	"RTN","BPS VRX3",157, 0)
13934	S DIR("?" )=" Enter NO to ret urn to the previous question."
13935	"RTN","BPS VRX3",158, 0)
13936	W !
13937	"RTN","BPS VRX3",159, 0)
13938	D ^DIR
13939	"RTN","BPS VRX3",160, 0)
13940	I $D(DIRU T) S Y=1
13941	"RTN","BPS VRX3",161, 0)
13942	Q Y
13943	"RTN","BPS VRX3",162, 0)
13944	;
13945	"RTN","BPS VRX3",163, 0)
13946	PRINT ; Pr int sectio ns of the list.
13947	"RTN","BPS VRX3",164, 0)
13948	;
13949	"RTN","BPS VRX3",165, 0)
13950	; BPSLIST will be a n array of one or mo re section s from the existing
13951	"RTN","BPS VRX3",166, 0)
13952	; ListMan list stor ed in ^TMP ("BPSVRX", $J). Form at of BPSL IST:
13953	"RTN","BPS VRX3",167, 0)
13954	; BPS LIST(Secti on#) = Fir st Line ^ Last Line
13955	"RTN","BPS VRX3",168, 0)
13956	; Where F irst Line and Last L ine are th e first an d last lin es of
13957	"RTN","BPS VRX3",169, 0)
13958	; that se ction in t he list an d Section# can be on e or more numbers
13959	"RTN","BPS VRX3",170, 0)
13960	; from 1 to 14, eac h correspo nding to a section:
13961	"RTN","BPS VRX3",171, 0)
13962	; 8 - AP, TPJI Account P rofile
13963	"RTN","BPS VRX3",172, 0)
13964	; 3 - BE, Bill ing Events
13965	"RTN","BPS VRX3",173, 0)
13966	; 7 - CI, TPJI Claim Inf o
13967	"RTN","BPS VRX3",174, 0)
13968	; 2 - CL, Clai m Log
13969	"RTN","BPS VRX3",175, 0)
13970	; 9 - CM, TPJI AR Commen t History
13971	"RTN","BPS VRX3",176, 0)
13972	; 4 - CR, Clai ms Respons e Inquiry Report
13973	"RTN","BPS VRX3",177, 0)
13974	; 10 - ER, TPJI ECME Rx I nformation
13975	"RTN","BPS VRX3",178, 0)
13976	; 11 - ES, Elig ibility St atus
13977	"RTN","BPS VRX3",179, 0)
13978	; 12 - EV, Elig ibility Ve rification
13979	"RTN","BPS VRX3",180, 0)
13980	; 5 - IN, Insu rance
13981	"RTN","BPS VRX3",181, 0)
13982	; 6 - LB, List of Bills
13983	"RTN","BPS VRX3",182, 0)
13984	; 14 - MP, Medi cation Pro file
13985	"RTN","BPS VRX3",183, 0)
13986	; 13 - SD, Sens itive Drug
13987	"RTN","BPS VRX3",184, 0)
13988	; 1 - VW, View Rx
13989	"RTN","BPS VRX3",185, 0)
13990	; BPSJOB will be se t to the $ J of the c urrent job , if foreg round,
13991	"RTN","BPS VRX3",186, 0)
13992	; or the job which launched t his backgr ound job, if backgro und.
13993	"RTN","BPS VRX3",187, 0)
13994	;
13995	"RTN","BPS VRX3",188, 0)
13996	N BPSCRT, BPSBEGIN,B PSDASHES,B PSEND,BPSL INE,BPSPAG E,BPSSECTI ON,BPSSTOP
13997	"RTN","BPS VRX3",189, 0)
13998	;
13999	"RTN","BPS VRX3",190, 0)
14000	S BPSCRT= $S(IOST["C -":1,1:0)
14001	"RTN","BPS VRX3",191, 0)
14002	S BPSPAGE =0,BPSSTOP =0,$P(BPSD ASHES,"=", 79)=""
14003	"RTN","BPS VRX3",192, 0)
14004	;
14005	"RTN","BPS VRX3",193, 0)
14006	S BPSSECT ION=""
14007	"RTN","BPS VRX3",194, 0)
14008	F S BPSS ECTION=$O( BPSLIST(BP SSECTION)) Q:BPSSECT ION="" D Q:BPSSTOP
14009	"RTN","BPS VRX3",195, 0)
14010	. S BPSBE GIN=$P(BPS LIST(BPSSE CTION),U,1 )
14011	"RTN","BPS VRX3",196, 0)
14012	. S BPSEN D=$P(BPSLI ST(BPSSECT ION),U,2)
14013	"RTN","BPS VRX3",197, 0)
14014	. ;
14015	"RTN","BPS VRX3",198, 0)
14016	. ; Displ ay the hea der at the top of ea ch section .
14017	"RTN","BPS VRX3",199, 0)
14018	. ;
14019	"RTN","BPS VRX3",200, 0)
14020	. D HEADE R
14021	"RTN","BPS VRX3",201, 0)
14022	. ;
14023	"RTN","BPS VRX3",202, 0)
14024	. S BPSLI NE=BPSBEGI N-1
14025	"RTN","BPS VRX3",203, 0)
14026	. F S BP SLINE=$O(^ TMP("BPSVR X",BPSJOB, BPSLINE)) Q:'BPSLINE Q:BPSLIN E>BPSEND D Q:BPSST OP
14027	"RTN","BPS VRX3",204, 0)
14028	. . ;
14029	"RTN","BPS VRX3",205, 0)
14030	. . I $Y+ 3>IOSL D H EADER I BP SSTOP Q
14031	"RTN","BPS VRX3",206, 0)
14032	. . ;
14033	"RTN","BPS VRX3",207, 0)
14034	. . W !,^ TMP("BPSVR X",BPSJOB, BPSLINE,0)
14035	"RTN","BPS VRX3",208, 0)
14036	. . ;
14037	"RTN","BPS VRX3",209, 0)
14038	. . Q
14039	"RTN","BPS VRX3",210, 0)
14040	. Q
14041	"RTN","BPS VRX3",211, 0)
14042	;
14043	"RTN","BPS VRX3",212, 0)
14044	I BPSSTOP G PRINTQ
14045	"RTN","BPS VRX3",213, 0)
14046	I $Y+4>IO SL D HEADE R I BPSSTO P G PRINTQ
14047	"RTN","BPS VRX3",214, 0)
14048	W !!?5,"* End of Report * "
14049	"RTN","BPS VRX3",215, 0)
14050	I BPSCRT S DIR(0)=" E" W ! D ^ DIR K DIR
14051	"RTN","BPS VRX3",216, 0)
14052	;
14053	"RTN","BPS VRX3",217, 0)
14054	PRINTQ ;
14055	"RTN","BPS VRX3",218, 0)
14056	;
14057	"RTN","BPS VRX3",219, 0)
14058	I $D(ZTQU EUED) S ZT REQ="@" ; If queued , purge th e task aft er exiting .
14059	"RTN","BPS VRX3",220, 0)
14060	;
14061	"RTN","BPS VRX3",221, 0)
14062	Q
14063	"RTN","BPS VRX3",222, 0)
14064	;
14065	"RTN","BPS VRX3",223, 0)
14066	HEADER ; P rint the h eader.
14067	"RTN","BPS VRX3",224, 0)
14068	;
14069	"RTN","BPS VRX3",225, 0)
14070	N BPSX
14071	"RTN","BPS VRX3",226, 0)
14072	;
14073	"RTN","BPS VRX3",227, 0)
14074	; If PAGE (i.e. not the first page) and device is the scree n, do an
14075	"RTN","BPS VRX3",228, 0)
14076	; end-of- page reade r call. I f PAGE or screen out put, do a form feed.
14077	"RTN","BPS VRX3",229, 0)
14078	; If this is the fi rst page ( 'BPSPAGE), and devic e is file or printer
14079	"RTN","BPS VRX3",230, 0)
14080	; ('BPSCR T), reset the left m argin ($C( 13)).
14081	"RTN","BPS VRX3",231, 0)
14082	;
14083	"RTN","BPS VRX3",232, 0)
14084	I BPSPAGE ,BPSCRT S DIR(0)="E" D ^DIR K DIR I 'Y S BPSSTOP=1 G HEADERQ
14085	"RTN","BPS VRX3",233, 0)
14086	I BPSPAGE !BPSCRT W @IOF
14087	"RTN","BPS VRX3",234, 0)
14088	I 'BPSPAG E,'BPSCRT W $C(13)
14089	"RTN","BPS VRX3",235, 0)
14090	S BPSPAGE =BPSPAGE+1
14091	"RTN","BPS VRX3",236, 0)
14092	;
14093	"RTN","BPS VRX3",237, 0)
14094	; Write t he report header.
14095	"RTN","BPS VRX3",238, 0)
14096	;
14097	"RTN","BPS VRX3",239, 0)
14098	W "View P harmacy Rx Report",? 70,"Page: ",BPSPAGE, !
14099	"RTN","BPS VRX3",240, 0)
14100	;
14101	"RTN","BPS VRX3",241, 0)
14102	S BPSX=0
14103	"RTN","BPS VRX3",242, 0)
14104	F S BPSX =$O(VALMHD R(BPSX)) Q :'BPSX W VALMHDR(BP SX),!
14105	"RTN","BPS VRX3",243, 0)
14106	W BPSDASH ES
14107	"RTN","BPS VRX3",244, 0)
14108	;
14109	"RTN","BPS VRX3",245, 0)
14110	HEADERQ ;
14111	"RTN","BPS VRX3",246, 0)
14112	Q
14113	"RTN","BPS VRX3",247, 0)
14114	;
14115	"RTN","BPS VRX3",248, 0)
14116	HELP ; ?? Help - Dis play Optio ns
14117	"RTN","BPS VRX3",249, 0)
14118	W !,"VW V iew Rx CR C RI Report CI T PJI Claim Info ER T PJI ECME R x"
14119	"RTN","BPS VRX3",250, 0)
14120	W !,"CL C laim Log IN I nsurance AP T PJI Acct P ro ES E lig Status "
14121	"RTN","BPS VRX3",251, 0)
14122	W !,"BE B illing Eve nts LB L ist of Bil ls CM T PJI AR Com m EV E lig Verif"
14123	"RTN","BPS VRX3",252, 0)
14124	W !
14125	"RTN","BPS VRX3",253, 0)
14126	W !," Sel ect one or many repo rt(s) to p rint, sepa rated by c ommas. Whe n all"
14127	"RTN","BPS VRX3",254, 0)
14128	W !," rep orts have been selec ted, hit e nter witho ut making another se lection."
14129	"RTN","BPS VRX3",255, 0)
14130	W !," Exa mple: "
14131	"RTN","BPS VRX3",256, 0)
14132	W !," Se lect Repor t to Print : VW,IN,CM "
14133	"RTN","BPS VRX3",257, 0)
14134	W !," Se lect Repor t to Print : ES"
14135	"RTN","BPS VRX3",258, 0)
14136	Q
14137	"SEC","^DI C",9002313 .91,900231 3.91,0,"AU DIT")
14138	@
14139	"SEC","^DI C",9002313 .91,900231 3.91,0,"DD ")
14140	@
14141	"SEC","^DI C",9002313 .91,900231 3.91,0,"DE L")
14142	@
14143	"SEC","^DI C",9002313 .91,900231 3.91,0,"LA YGO")
14144	@
14145	"SEC","^DI C",9002313 .91,900231 3.91,0,"RD ")
14146	Pp
14147	"SEC","^DI C",9002313 .91,900231 3.91,0,"WR ")
14148	@
14149	"UP",90023 13.02,9002 313.0201,- 1)
14150	9002313.02 ^400
14151	"UP",90023 13.02,9002 313.0201,0 )
14152	9002313.02 01
14153	"UP",90023 13.03,9002 313.0301,- 1)
14154	9002313.03 ^1000
14155	"UP",90023 13.03,9002 313.0301,0 )
14156	9002313.03 01
14157	"VER")
14158	8.0^22.2
14159	"^DD",9002 313.02,900 2313.0201, 2095,0)
14160	FACILITY I D QUALIFIE R^FJ2^^B90 ;5^K:$L(X) >2!($L(X)< 1) X
14161	"^DD",9002 313.02,900 2313.0201, 2095,3)
14162	Answer mus t be 1-2 c haracters in length.
14163	"^DD",9002 313.02,900 2313.0201, 2095,21,0)
14164	^^2^2^3170 530^
14165	"^DD",9002 313.02,900 2313.0201, 2095,21,1, 0)
14166	Code quali fying the 'Facility ID' (336-8 C). NCPDP standard f ield B95-3 Z.
14167	"^DD",9002 313.02,900 2313.0201, 2095,21,2, 0)
14168	Blank=Not Specified, 1=Facilit y Type 2 N PI, 2= Oth er
14169	"^DD",9002 313.02,900 2313.0201, 2095,"DT")
14170	3170530
14171	"^DD",9002 313.03,900 2313.0301, 2098,0)
14172	RECONCILIA TION ID^FJ 30^^B98;1^ K:$L(X)>30 !($L(X)<1) X
14173	"^DD",9002 313.03,900 2313.0301, 2098,3)
14174	Answer mus t be 1-30 characters in length .
14175	"^DD",9002 313.03,900 2313.0301, 2098,21,0)
14176	^^1^1^3170 530^
14177	"^DD",9002 313.03,900 2313.0301, 2098,21,1, 0)
14178	This will be used to store NCP DP field B 98-34 (Rec onciliatio n ID).
14179	"^DD",9002 313.03,900 2313.0301, 2098,"DT")
14180	3170530
14181	"^DD",9002 313.32,900 2313.32,2. 09,0)
14182	RECONCILIA TION ID^FJ 30^^2;9^K: $L(X)>30!( $L(X)<1) X
14183	"^DD",9002 313.32,900 2313.32,2. 09,3)
14184	Answer mus t be 1-30 characters in length .
14185	"^DD",9002 313.32,900 2313.32,2. 09,21,0)
14186	^^4^4^3170 530^
14187	"^DD",9002 313.32,900 2313.32,2. 09,21,1,0)
14188	This is th e override value tha t will be used for t he payer r esponse fo r
14189	"^DD",9002 313.32,900 2313.32,2. 09,21,2,0)
14190	billing re quests. Th e value wi ll be used to popula te the REC ONCILIATIO N
14191	"^DD",9002 313.32,900 2313.32,2. 09,21,3,0)
14192	ID (#2098) field of RESPONSES (#9002313. 0301) subf ile of the BPS
14193	"^DD",9002 313.32,900 2313.32,2. 09,21,4,0)
14194	RESPONSES (#9002313. 03) file. This corre sponds to NCPDP code B98-34.
14195	"^DD",9002 313.32,900 2313.32,2. 09,"DT")
14196	3170530
14197	"^DD",9002 313.56,900 2313.56,.0 9,0)
14198	AUTO-REVER SE PARAMET ER^RNJ2,0^ ^0;9^K:+X' =X!(X>10)! (X<3)!(X?. E1"."1N.N) X
14199	"^DD",9002 313.56,900 2313.56,.0 9,3)
14200	Enter a nu mber from 3 to 10. 5 is the su ggested se tting.
14201	"^DD",9002 313.56,900 2313.56,.0 9,21,0)
14202	^.001^11^1 1^3170605^ ^^
14203	"^DD",9002 313.56,900 2313.56,.0 9,21,1,0)
14204	ECME shall use the f ollowing A UTO-REVERS E site par ameter whe n
14205	"^DD",9002 313.56,900 2313.56,.0 9,21,2,0)
14206	determinin g whether non-releas ed prescri ption clai ms (that h ave return ed
14207	"^DD",9002 313.56,900 2313.56,.0 9,21,3,0)
14208	a PAYABLE response) are to be automatica lly REVERS ED.
14209	"^DD",9002 313.56,900 2313.56,.0 9,21,4,0)
14210
14211	"^DD",9002 313.56,900 2313.56,.0 9,21,5,0)
14212	The AUTO-R EVERSE sit e paramete r is set f or the num ber of day s that
14213	"^DD",9002 313.56,900 2313.56,.0 9,21,6,0)
14214	ECME will wait befor e the clai m is autom atically R EVERSED. T he user
14215	"^DD",9002 313.56,900 2313.56,.0 9,21,7,0)
14216	is allowed to enter a number f rom 3 to 1 0.
14217	"^DD",9002 313.56,900 2313.56,.0 9,21,8,0)
14218	5 is the s uggested s etting.
14219	"^DD",9002 313.56,900 2313.56,.0 9,21,9,0)
14220
14221	"^DD",9002 313.56,900 2313.56,.0 9,21,10,0)
14222	ECME will wait the e ntered num ber of day s before R EVERSING t he
14223	"^DD",9002 313.56,900 2313.56,.0 9,21,11,0)
14224	non-releas ed Rx with a PAYABLE response.
14225	"^DD",9002 313.56,900 2313.56,.0 9,"DT")
14226	3170601
14227	"^DD",9002 313.91,900 2313.91,0)
14228	FIELD^^1^1 3
14229	"^DD",9002 313.91,900 2313.91,0, "DDA")
14230	N
14231	"^DD",9002 313.91,900 2313.91,0, "DT")
14232	3130222
14233	"^DD",9002 313.91,900 2313.91,0, "ID",.03)
14234	W " ",$P (^(0),U,3)
14235	"^DD",9002 313.91,900 2313.91,0, "IX","B",9 002313.91, .01)
14236
14237	"^DD",9002 313.91,900 2313.91,0, "IX","C",9 002313.91, .03)
14238
14239	"^DD",9002 313.91,900 2313.91,0, "IX","D",9 002313.91, .06)
14240
14241	"^DD",9002 313.91,900 2313.91,0, "NM","BPS NCPDP FIEL D DEFS")
14242
14243	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.311,.01 )
14244
14245	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.3121,.0 1)
14246
14247	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.5111,.0 1)
14248
14249	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9205,.0 2)
14250
14251	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9206,.0 2)
14252
14253	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9207,.0 2)
14254
14255	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9208,.0 2)
14256
14257	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9209,.0 2)
14258
14259	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.921,.02 )
14260
14261	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9213,.0 2)
14262
14263	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9214,.0 2)
14264
14265	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9215,.0 2)
14266
14267	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9216,.0 2)
14268
14269	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9217,.0 2)
14270
14271	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9218,.0 2)
14272
14273	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9219,.0 2)
14274
14275	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.922,.02 )
14276
14277	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9223,.0 2)
14278
14279	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9224,.0 2)
14280
14281	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9225,.0 2)
14282
14283	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9227,.0 2)
14284
14285	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9228,.0 2)
14286
14287	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.9229,.0 2)
14288
14289	"^DD",9002 313.91,900 2313.91,0, "PT",90023 13.923,.02 )
14290
14291	"^DD",9002 313.91,900 2313.91,0, "VRPK")
14292	BPS
14293	"^DD",9002 313.91,900 2313.91,.0 1,0)
14294	NCPDP FIEL D NUMBER^R FX^^0;1^K: $L(X)>6!($ L(X)<3) X
14295	"^DD",9002 313.91,900 2313.91,.0 1,1,0)
14296	^.1
14297	"^DD",9002 313.91,900 2313.91,.0 1,1,1,0)
14298	9002313.91 ^B
14299	"^DD",9002 313.91,900 2313.91,.0 1,1,1,1)
14300	S ^BPSF(90 02313.91," B",$E(X,1, 30),DA)=""
14301	"^DD",9002 313.91,900 2313.91,.0 1,1,1,2)
14302	K ^BPSF(90 02313.91," B",$E(X,1, 30),DA)
14303	"^DD",9002 313.91,900 2313.91,.0 1,3)
14304	Enter the NCPDP fiel d number ( either 0-9 97, 2 Deci mal Digits or 3 Alph anumerics) .
14305	"^DD",9002 313.91,900 2313.91,.0 1,21,0)
14306	^^1^1^3101 014^
14307	"^DD",9002 313.91,900 2313.91,.0 1,21,1,0)
14308	This is th e NCPDP fi eld number as specif ied in the NCPDP dat a dictiona ry.
14309	"^DD",9002 313.91,900 2313.91,.0 1,"DT")
14310	3170227
14311	"^DD",9002 313.91,900 2313.91,.0 3,0)
14312	NAME^F^^0; 3^K:$L(X)> 30!($L(X)< 3) X
14313	"^DD",9002 313.91,900 2313.91,.0 3,1,0)
14314	^.1
14315	"^DD",9002 313.91,900 2313.91,.0 3,1,1,0)
14316	9002313.91 ^C
14317	"^DD",9002 313.91,900 2313.91,.0 3,1,1,1)
14318	S ^BPSF(90 02313.91," C",$E(X,1, 30),DA)=""
14319	"^DD",9002 313.91,900 2313.91,.0 3,1,1,2)
14320	K ^BPSF(90 02313.91," C",$E(X,1, 30),DA)
14321	"^DD",9002 313.91,900 2313.91,.0 3,1,1,"DT" )
14322	3001007
14323	"^DD",9002 313.91,900 2313.91,.0 3,3)
14324	Answer mus t be 3-30 characters in length .
14325	"^DD",9002 313.91,900 2313.91,.0 3,21,0)
14326	^^2^2^3071 227^
14327	"^DD",9002 313.91,900 2313.91,.0 3,21,1,0)
14328	Descriptiv e name the tells wha t the fiel d is withi n the phar macy
14329	"^DD",9002 313.91,900 2313.91,.0 3,21,2,0)
14330	environmen t.
14331	"^DD",9002 313.91,900 2313.91,.0 3,"DT")
14332	3071227
14333	"^DD",9002 313.91,900 2313.91,.0 4,0)
14334	FORMAT^S^N :NUMERIC;A /N:ALPHA/N UMERIC;D:S IGNED NUME RIC;^0;4^Q
14335	"^DD",9002 313.91,900 2313.91,.0 4,3)
14336	Enter the field's fo rmat type.
14337	"^DD",9002 313.91,900 2313.91,.0 4,21,0)
14338	^^1^1^3071 227^
14339	"^DD",9002 313.91,900 2313.91,.0 4,21,1,0)
14340	This is th e format o f the fiel d used wit hin the NC PDP standa rd.
14341	"^DD",9002 313.91,900 2313.91,.0 4,"DT")
14342	3071227
14343	"^DD",9002 313.91,900 2313.91,.0 6,0)
14344	ID^F^^5;1^ K:$L(X)>2! ($L(X)<2) X
14345	"^DD",9002 313.91,900 2313.91,.0 6,1,0)
14346	^.1
14347	"^DD",9002 313.91,900 2313.91,.0 6,1,1,0)
14348	9002313.91 ^D
14349	"^DD",9002 313.91,900 2313.91,.0 6,1,1,1)
14350	S ^BPSF(90 02313.91," D",$E(X,1, 30),DA)=""
14351	"^DD",9002 313.91,900 2313.91,.0 6,1,1,2)
14352	K ^BPSF(90 02313.91," D",$E(X,1, 30),DA)
14353	"^DD",9002 313.91,900 2313.91,.0 6,1,1,"%D" ,0)
14354	^^3^3^3020 807^
14355	"^DD",9002 313.91,900 2313.91,.0 6,1,1,"%D" ,1,0)
14356	Cross refe rence of t he 5.1 Fie ld ID. Th is cross r eference w ill be use d in
14357	"^DD",9002 313.91,900 2313.91,.0 6,1,1,"%D" ,2,0)
14358	the proces sing of th e response as a mean s of trans lating the value to a
14359	"^DD",9002 313.91,900 2313.91,.0 6,1,1,"%D" ,3,0)
14360	field numb er.
14361	"^DD",9002 313.91,900 2313.91,.0 6,1,1,"DT" )
14362	3020807
14363	"^DD",9002 313.91,900 2313.91,.0 6,3)
14364	Answer mus t be 2 cha racters in length.
14365	"^DD",9002 313.91,900 2313.91,.0 6,21,0)
14366	^^3^3^3071 227^
14367	"^DD",9002 313.91,900 2313.91,.0 6,21,1,0)
14368	The same a s the .02 field, but for speci fic use wh en creatin g 5.1
14369	"^DD",9002 313.91,900 2313.91,.0 6,21,2,0)
14370	claims. T he 5.1 fie lds were s eparated b ecause 3.x and 5.1 c laims were
14371	"^DD",9002 313.91,900 2313.91,.0 6,21,3,0)
14372	being subm itted conc urrently.
14373	"^DD",9002 313.91,900 2313.91,.0 6,"DT")
14374	3071227
14375	"^DD",9002 313.91,900 2313.91,.0 7,0)
14376	LENGTH^NJ4 ,0^^5;2^K: +X'=X!(X>9 999)!(X<1) !(X?.E1"." 1.N) X
14377	"^DD",9002 313.91,900 2313.91,.0 7,3)
14378	Type a num ber betwee n 1 and 99 99, 0 Deci mal Digits
14379	"^DD",9002 313.91,900 2313.91,.0 7,21,0)
14380	^^1^1^3040 121^
14381	"^DD",9002 313.91,900 2313.91,.0 7,21,1,0)
14382	Length of the field from the 5 .1 NCPDP s tandard.
14383	"^DD",9002 313.91,900 2313.91,.0 7,"DT")
14384	3071227
14385	"^DD",9002 313.91,900 2313.91,.0 8,0)
14386	D0 LENGTH^ NJ3,0^^0;8 ^K:+X'=X!( X>999)!(X< 1)!(X?.E1" ."1N.N) X
14387	"^DD",9002 313.91,900 2313.91,.0 8,3)
14388	Enter the length of the NCPDP field per the NCPDP data dicti onary (1-9 99).
14389	"^DD",9002 313.91,900 2313.91,.0 8,21,0)
14390	^^2^2^3101 014^
14391	"^DD",9002 313.91,900 2313.91,.0 8,21,1,0)
14392	This is th e NCPDP le ngth as sp ecified in the NCPDP Telecommu nication
14393	"^DD",9002 313.91,900 2313.91,.0 8,21,2,0)
14394	Standard v ersion D.0 data dict ionary.
14395	"^DD",9002 313.91,900 2313.91,.0 8,"DT")
14396	3101014
14397	"^DD",9002 313.91,900 2313.91,.0 9,0)
14398	D0 FORMAT^ S^N:NUMERI C;A/N:ALPH ANUMERIC;D :SIGNED NU MERIC;^0;9 ^Q
14399	"^DD",9002 313.91,900 2313.91,.0 9,3)
14400	Enter the data type for the fi eld based on the NCP DP data di ctionary.
14401	"^DD",9002 313.91,900 2313.91,.0 9,21,0)
14402	^^2^2^3101 014^
14403	"^DD",9002 313.91,900 2313.91,.0 9,21,1,0)
14404	This is th e NCPDP da ta type as specified in the NC PDP Teleco mmunicatio n
14405	"^DD",9002 313.91,900 2313.91,.0 9,21,2,0)
14406	Standard v ersion D.0 data dict ionary.
14407	"^DD",9002 313.91,900 2313.91,.0 9,"DT")
14408	3101014
14409	"^DD",9002 313.91,900 2313.91,1, 0)
14410	VISTA FIEL D NUMBER^N J4,0^^5;3^ K:+X'=X!(X >2999)!(X< 1001)!(X?. E1"."1.N) X
14411	"^DD",9002 313.91,900 2313.91,1, 3)
14412	Type a num ber betwee n 1001 and 2999, 0 d ecimal dig its.
14413	"^DD",9002 313.91,900 2313.91,1, 21,0)
14414	^^5^5^3130 424^
14415	"^DD",9002 313.91,900 2313.91,1, 21,1,0)
14416	This is th e VistA fi eld number used in B PS CLAIMS file #9002 313.02 and BPS
14417	"^DD",9002 313.91,900 2313.91,1, 21,2,0)
14418	RESPONSES file #9002 313.03. On ly used fo r NCPDP nu mbers wher e the firs t
14419	"^DD",9002 313.91,900 2313.91,1, 21,3,0)
14420	piece of t he NCPDP n umber is n on-numeric .
14421	"^DD",9002 313.91,900 2313.91,1, 21,4,0)
14422
14423	"^DD",9002 313.91,900 2313.91,1, 21,5,0)
14424	For exampl e, NCPDP f ield B04-B T - Next A vailable F ill Date.
14425	"^DD",9002 313.91,900 2313.91,1, "DT")
14426	3130424
14427	"^DD",9002 313.91,900 2313.91,1. 01,0)
14428	STANDARD N CPDP FIELD NAME^F^^1 ;1^K:$L(X) >100!($L(X )<1) X
14429	"^DD",9002 313.91,900 2313.91,1. 01,3)
14430	Enter the full NCPDP field nam e based on the NCPDP data dict ionary (1- 100 charac ters).
14431	"^DD",9002 313.91,900 2313.91,1. 01,21,0)
14432	^^3^3^3101 014^
14433	"^DD",9002 313.91,900 2313.91,1. 01,21,1,0)
14434	This field is used f or those N CPDP field names tha t were too long to f it
14435	"^DD",9002 313.91,900 2313.91,1. 01,21,2,0)
14436	in the NAM E (#.03) f ield. For those fie lds, this field will
14437	"^DD",9002 313.91,900 2313.91,1. 01,21,3,0)
14438	have the f ull NCPDP field name .
14439	"^DD",9002 313.91,900 2313.91,1. 01,"DT")
14440	3110706
14441	"^DD",9002 313.91,900 2313.91,10 ,0)
14442	GET CODE^9 002313.910 1^^10;0
14443	"^DD",9002 313.91,900 2313.91,10 ,3)
14444	Enter the M code to extract th e data for this fiel d.
14445	"^DD",9002 313.91,900 2313.91,10 ,9)
14446	@
14447	"^DD",9002 313.91,900 2313.91,10 ,21,0)
14448	^.001^2^2^ 3101001^^
14449	"^DD",9002 313.91,900 2313.91,10 ,21,1,0)
14450	M code tha t tells th e BPS syst em where t o find the
14451	"^DD",9002 313.91,900 2313.91,10 ,21,2,0)
14452	particular piece of data for t his field.
14453	"^DD",9002 313.91,900 2313.91,10 ,"DT")
14454	3071227
14455	"^DD",9002 313.91,900 2313.91,20 ,0)
14456	D0 FORMAT CODE^90023 13.9102^^2 0;0
14457	"^DD",9002 313.91,900 2313.91,20 ,9)
14458	@
14459	"^DD",9002 313.91,900 2313.91,20 ,21,0)
14460	^^4^4^3101 014^
14461	"^DD",9002 313.91,900 2313.91,20 ,21,1,0)
14462	This field holds the M code us ed to form at the dat a accordin g to the
14463	"^DD",9002 313.91,900 2313.91,20 ,21,2,0)
14464	specificat ions of th e NCPDP Te lecommunic ation Stan dard versi on D.0 dat a
14465	"^DD",9002 313.91,900 2313.91,20 ,21,3,0)
14466	dictionary . For ins tance, alp hanumeric fields are right-pad ded with
14467	"^DD",9002 313.91,900 2313.91,20 ,21,4,0)
14468	spaces up to the len gth of the specified by the NC PDP standa rd.
14469	"^DD",9002 313.91,900 2313.91,20 ,"DT")
14470	3101005
14471	"^DD",9002 313.91,900 2313.91,30 ,0)
14472	SET CODE^9 002313.910 3^^30;0
14473	"^DD",9002 313.91,900 2313.91,30 ,3)
14474	Enter the M code for the field 's data st orage.
14475	"^DD",9002 313.91,900 2313.91,30 ,9)
14476	@
14477	"^DD",9002 313.91,900 2313.91,30 ,21,0)
14478	^^1^1^3040 326^
14479	"^DD",9002 313.91,900 2313.91,30 ,21,1,0)
14480	M code to store the data in th e appropri ate segmen t within t he claim.
14481	"^DD",9002 313.91,900 2313.91,30 ,"DT")
14482	3071227
14483	"^DD",9002 313.91,900 2313.91,40 ,0)
14484	FORMAT COD E^9002313. 9104^^25;0
14485	"^DD",9002 313.91,900 2313.91,40 ,3)
14486	Enter the M code to format the data in N CPDP forma t.
14487	"^DD",9002 313.91,900 2313.91,40 ,9)
14488	@
14489	"^DD",9002 313.91,900 2313.91,40 ,21,0)
14490	^^2^2^3071 227^
14491	"^DD",9002 313.91,900 2313.91,40 ,21,1,0)
14492	M code to format the data befo re storing it in the claim. 5 .1 was
14493	"^DD",9002 313.91,900 2313.91,40 ,21,2,0)
14494	separate b ecause 3.2 and 5.1 c laims were being sub mitted at the same t ime.
14495	"^DD",9002 313.91,900 2313.91,40 ,"DT")
14496	3071227
14497	"^DD",9002 313.91,900 2313.9101, 0)
14498	GET CODE S UB-FIELD^^ .01^1
14499	"^DD",9002 313.91,900 2313.9101, 0,"DT")
14500	3071227
14501	"^DD",9002 313.91,900 2313.9101, 0,"NM","GE T CODE")
14502
14503	"^DD",9002 313.91,900 2313.9101, 0,"UP")
14504	9002313.91
14505	"^DD",9002 313.91,900 2313.9101, .01,0)
14506	GET CODE^W L^^0;1^Q
14507	"^DD",9002 313.91,900 2313.9101, .01,3)
14508	Enter the M code to extract th e data for this fiel d.
14509	"^DD",9002 313.91,900 2313.9101, .01,9)
14510	@
14511	"^DD",9002 313.91,900 2313.9101, .01,"DT")
14512	3071227
14513	"^DD",9002 313.91,900 2313.9102, 0)
14514	D0 FORMAT CODE SUB-F IELD^^.01^ 1
14515	"^DD",9002 313.91,900 2313.9102, 0,"DT")
14516	3100721
14517	"^DD",9002 313.91,900 2313.9102, 0,"NM","D0 FORMAT CO DE")
14518
14519	"^DD",9002 313.91,900 2313.9102, 0,"UP")
14520	9002313.91
14521	"^DD",9002 313.91,900 2313.9102, .01,0)
14522	D0 FORMAT CODE^WLx^^ 0;1^Q
14523	"^DD",9002 313.91,900 2313.9102, .01,"DT")
14524	3101014
14525	"^DD",9002 313.91,900 2313.9103, 0)
14526	SET CODE S UB-FIELD^^ .01^1
14527	"^DD",9002 313.91,900 2313.9103, 0,"DT")
14528	2950420
14529	"^DD",9002 313.91,900 2313.9103, 0,"NM","SE T CODE")
14530
14531	"^DD",9002 313.91,900 2313.9103, 0,"UP")
14532	9002313.91
14533	"^DD",9002 313.91,900 2313.9103, .01,0)
14534	SET CODE^W L^^0;1^Q
14535	"^DD",9002 313.91,900 2313.9103, .01,3)
14536	Enter the M code for the field 's data st orage.
14537	"^DD",9002 313.91,900 2313.9103, .01,9)
14538	@
14539	"^DD",9002 313.91,900 2313.9103, .01,"DT")
14540	3071227
14541	"^DD",9002 313.91,900 2313.9104, 0)
14542	FORMAT COD E SUB-FIEL D^^.01^1
14543	"^DD",9002 313.91,900 2313.9104, 0,"DT")
14544	3020724
14545	"^DD",9002 313.91,900 2313.9104, 0,"NM","FO RMAT CODE" )
14546
14547	"^DD",9002 313.91,900 2313.9104, 0,"UP")
14548	9002313.91
14549	"^DD",9002 313.91,900 2313.9104, .01,0)
14550	FORMAT COD E^WL^^0;1^ Q
14551	"^DD",9002 313.91,900 2313.9104, .01,3)
14552	Enter the M code to format the data in N CPDP forma t.
14553	"^DD",9002 313.91,900 2313.9104, .01,9)
14554	@
14555	"^DD",9002 313.91,900 2313.9104, .01,"DT")
14556	3071227
14557	"^DIC",900 2313.91,90 02313.91,0 )
14558	BPS NCPDP FIELD DEFS ^9002313.9 1
14559	"^DIC",900 2313.91,90 02313.91,0 ,"GL")
14560	^BPSF(9002 313.91,
14561	"^DIC",900 2313.91,90 02313.91," %",0)
14562	^1.005^^0
14563	"^DIC",900 2313.91,90 02313.91," %","B","AB SP",1)
14564
14565	"^DIC",900 2313.91,90 02313.91," %D",0)
14566	^1.001^4^4 ^3100925^^ ^^
14567	"^DIC",900 2313.91,90 02313.91," %D",1,0)
14568	The NCPDP Data Dicti onary Indi vidual fie lds which combine in to formatt ed
14569	"^DIC",900 2313.91,90 02313.91," %D",2,0)
14570	packets.
14571	"^DIC",900 2313.91,90 02313.91," %D",3,0)
14572
14573	"^DIC",900 2313.91,90 02313.91," %D",4,0)
14574	Per VHA Di rective 20 04-038, th is file de finition s hould not be modifie d.
14575	"^DIC",900 2313.91,"B ","BPS NCP DP FIELD D EFS",90023 13.91)
14576
14577	INSTALL NAME
14578	PSO7.047 8
14579	"BLD",1052 5,0)
14580	PSO7.047 8^OUTPATIE NT PHARMAC Y^0^317062 9^y
14581	"BLD",1052 5,1,0)
14582	^^1^1^3170 504^
14583	"BLD",1052 5,1,1,0)
14584	MCCF EDI T AS EPHARMA CY BUILD 2
14585	"BLD",1052 5,4,0)
14586	^9.64PA^52 ^1
14587	"BLD",1052 5,4,52,0)
14588	52
14589	"BLD",1052 5,4,52,2,0 )
14590	^9.641^52. 25^1
14591	"BLD",1052 5,4,52,2,5 2.25,0)
14592	REJECT INF O (sub-fi le)
14593	"BLD",1052 5,4,52,2,5 2.25,1,0)
14594	^9.6411^34 ^1
14595	"BLD",1052 5,4,52,2,5 2.25,1,34, 0)
14596	PCN
14597	"BLD",1052 5,4,52,222 )
14598	y^y^p^^^^n ^^n
14599	"BLD",1052 5,4,52,224 )
14600
14601	"BLD",1052 5,4,"APDD" ,52,52.25)
14602
14603	"BLD",1052 5,4,"APDD" ,52,52.25, 34)
14604
14605	"BLD",1052 5,4,"B",52 ,52)
14606
14607	"BLD",1052 5,6.3)
14608	15
14609	"BLD",1052 5,"ABPKG")
14610	n
14611	"BLD",1052 5,"INIT")
14612	POST^PSO7P 478
14613	"BLD",1052 5,"KRN",0)
14614	^9.67PA^77 9.2^20
14615	"BLD",1052 5,"KRN",.4 ,0)
14616	.4
14617	"BLD",1052 5,"KRN",.4 01,0)
14618	.401
14619	"BLD",1052 5,"KRN",.4 02,0)
14620	.402
14621	"BLD",1052 5,"KRN",.4 03,0)
14622	.403
14623	"BLD",1052 5,"KRN",.5 ,0)
14624	.5
14625	"BLD",1052 5,"KRN",.8 4,0)
14626	.84
14627	"BLD",1052 5,"KRN",3. 6,0)
14628	3.6
14629	"BLD",1052 5,"KRN",3. 8,0)
14630	3.8
14631	"BLD",1052 5,"KRN",9. 2,0)
14632	9.2
14633	"BLD",1052 5,"KRN",9. 8,0)
14634	9.8
14635	"BLD",1052 5,"KRN",9. 8,"NM",0)
14636	^9.68A^5^5
14637	"BLD",1052 5,"KRN",9. 8,"NM",1,0 )
14638	PSORXRP2^^ 0^B3762798 6
14639	"BLD",1052 5,"KRN",9. 8,"NM",2,0 )
14640	PSOREJU3^^ 0^B9804234 5
14641	"BLD",1052 5,"KRN",9. 8,"NM",3,0 )
14642	PSOREJU2^^ 0^B6373167 9
14643	"BLD",1052 5,"KRN",9. 8,"NM",4,0 )
14644	PSOREJP1^^ 0^B2023722 94
14645	"BLD",1052 5,"KRN",9. 8,"NM",5,0 )
14646	PSOREJUT^^ 0^B1135324 40
14647	"BLD",1052 5,"KRN",9. 8,"NM","B" ,"PSOREJP1 ",4)
14648
14649	"BLD",1052 5,"KRN",9. 8,"NM","B" ,"PSOREJU2 ",3)
14650
14651	"BLD",1052 5,"KRN",9. 8,"NM","B" ,"PSOREJU3 ",2)
14652
14653	"BLD",1052 5,"KRN",9. 8,"NM","B" ,"PSOREJUT ",5)
14654
14655	"BLD",1052 5,"KRN",9. 8,"NM","B" ,"PSORXRP2 ",1)
14656
14657	"BLD",1052 5,"KRN",19 ,0)
14658	19
14659	"BLD",1052 5,"KRN",19 .1,0)
14660	19.1
14661	"BLD",1052 5,"KRN",10 1,0)
14662	101
14663	"BLD",1052 5,"KRN",10 1,"NM",0)
14664	^9.68A^^
14665	"BLD",1052 5,"KRN",40 9.61,0)
14666	409.61
14667	"BLD",1052 5,"KRN",77 1,0)
14668	771
14669	"BLD",1052 5,"KRN",77 9.2,0)
14670	779.2
14671	"BLD",1052 5,"KRN",87 0,0)
14672	870
14673	"BLD",1052 5,"KRN",89 89.51,0)
14674	8989.51
14675	"BLD",1052 5,"KRN",89 89.52,0)
14676	8989.52
14677	"BLD",1052 5,"KRN",89 94,0)
14678	8994
14679	"BLD",1052 5,"KRN","B ",.4,.4)
14680
14681	"BLD",1052 5,"KRN","B ",.401,.40 1)
14682
14683	"BLD",1052 5,"KRN","B ",.402,.40 2)
14684
14685	"BLD",1052 5,"KRN","B ",.403,.40 3)
14686
14687	"BLD",1052 5,"KRN","B ",.5,.5)
14688
14689	"BLD",1052 5,"KRN","B ",.84,.84)
14690
14691	"BLD",1052 5,"KRN","B ",3.6,3.6)
14692
14693	"BLD",1052 5,"KRN","B ",3.8,3.8)
14694
14695	"BLD",1052 5,"KRN","B ",9.2,9.2)
14696
14697	"BLD",1052 5,"KRN","B ",9.8,9.8)
14698
14699	"BLD",1052 5,"KRN","B ",19,19)
14700
14701	"BLD",1052 5,"KRN","B ",19.1,19. 1)
14702
14703	"BLD",1052 5,"KRN","B ",101,101)
14704
14705	"BLD",1052 5,"KRN","B ",409.61,4 09.61)
14706
14707	"BLD",1052 5,"KRN","B ",771,771)
14708
14709	"BLD",1052 5,"KRN","B ",779.2,77 9.2)
14710
14711	"BLD",1052 5,"KRN","B ",870,870)
14712
14713	"BLD",1052 5,"KRN","B ",8989.51, 8989.51)
14714
14715	"BLD",1052 5,"KRN","B ",8989.52, 8989.52)
14716
14717	"BLD",1052 5,"KRN","B ",8994,899 4)
14718
14719	"BLD",1052 5,"QUES",0 )
14720	^9.62^^
14721	"BLD",1052 5,"REQB",0 )
14722	^9.611^^
14723	"FIA",52)
14724	PRESCRIPTI ON
14725	"FIA",52,0 )
14726	^PSRX(
14727	"FIA",52,0 ,0)
14728	52Is
14729	"FIA",52,0 ,1)
14730	y^y^p^^^^n ^^n
14731	"FIA",52,0 ,10)
14732
14733	"FIA",52,0 ,11)
14734
14735	"FIA",52,0 ,"RLRO")
14736
14737	"FIA",52,0 ,"VR")
14738	7.0^PSO
14739	"FIA",52,5 2)
14740	1
14741	"FIA",52,5 2.25)
14742	1
14743	"FIA",52,5 2.25,34)
14744
14745	"INIT")
14746	POST^PSO7P 478
14747	"MBREQ")
14748	1
14749	"PKG",170, -1)
14750	1^1
14751	"PKG",170, 0)
14752	OUTPATIENT PHARMACY^ PSO^OUTPAT IENT LABEL S, PROFILE , INVENTOR Y, PRESCRI PTIONS
14753	"PKG",170, 22,0)
14754	^9.49I^1^1
14755	"PKG",170, 22,1,0)
14756	7.0^297121 6^2981113^ 1
14757	"PKG",170, 22,1,"PAH" ,1,0)
14758	478^317062 9^52082463 9
14759	"PKG",170, 22,1,"PAH" ,1,1,0)
14760	^^1^1^3170 629
14761	"PKG",170, 22,1,"PAH" ,1,1,1,0)
14762	MCCF EDI T AS EPHARMA CY BUILD 2
14763	"QUES","XP F1",0)
14764	Y
14765	"QUES","XP F1","??")
14766	^D REP^XPD H
14767	"QUES","XP F1","A")
14768	Shall I wr ite over y our \|FLAG\| File
14769	"QUES","XP F1","B")
14770	YES
14771	"QUES","XP F1","M")
14772	D XPF1^XPD IQ
14773	"QUES","XP F2",0)
14774	Y
14775	"QUES","XP F2","??")
14776	^D DTA^XPD H
14777	"QUES","XP F2","A")
14778	Want my da ta \|FLAG\| yours
14779	"QUES","XP F2","B")
14780	YES
14781	"QUES","XP F2","M")
14782	D XPF2^XPD IQ
14783	"QUES","XP I1",0)
14784	YO
14785	"QUES","XP I1","??")
14786	^D INHIBIT ^XPDH
14787	"QUES","XP I1","A")
14788	Want KIDS to INHIBIT LOGONs du ring the i nstall
14789	"QUES","XP I1","B")
14790	NO
14791	"QUES","XP I1","M")
14792	D XPI1^XPD IQ
14793	"QUES","XP M1",0)
14794	PO^VA(200, :EM
14795	"QUES","XP M1","??")
14796	^D MG^XPDH
14797	"QUES","XP M1","A")
14798	Enter the Coordinato r for Mail Group '\|F LAG\|'
14799	"QUES","XP M1","B")
14800
14801	"QUES","XP M1","M")
14802	D XPM1^XPD IQ
14803	"QUES","XP O1",0)
14804	Y
14805	"QUES","XP O1","??")
14806	^D MENU^XP DH
14807	"QUES","XP O1","A")
14808	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
14809	"QUES","XP O1","B")
14810	NO
14811	"QUES","XP O1","M")
14812	D XPO1^XPD IQ
14813	"QUES","XP Z1",0)
14814	Y
14815	"QUES","XP Z1","??")
14816	^D OPT^XPD H
14817	"QUES","XP Z1","A")
14818	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
14819	"QUES","XP Z1","B")
14820	NO
14821	"QUES","XP Z1","M")
14822	D XPZ1^XPD IQ
14823	"QUES","XP Z2",0)
14824	Y
14825	"QUES","XP Z2","??")
14826	^D RTN^XPD H
14827	"QUES","XP Z2","A")
14828	Want to MO VE routine s to other CPUs
14829	"QUES","XP Z2","B")
14830	NO
14831	"QUES","XP Z2","M")
14832	D XPZ2^XPD IQ
14833	"RTN")
14834	6
14835	"RTN","PSO 7P478")
14836	0^^B629747 2
14837	"RTN","PSO 7P478",1,0 )
14838	PSO7P478 ; AITC/PD - Post-insta ll for PSO 7478 ;6/ 15/2017
14839	"RTN","PSO 7P478",2,0 )
14840	;;7.0;OUT PATIENT PH ARMACY;4 78;;Buil d 15
14841	"RTN","PSO 7P478",3,0 )
14842	; Referen ce to BPSN CPD3 suppo rted by IA 4560
14843	"RTN","PSO 7P478",4,0 )
14844	;
14845	"RTN","PSO 7P478",5,0 )
14846	Q
14847	"RTN","PSO 7P478",6,0 )
14848	;
14849	"RTN","PSO 7P478",7,0 )
14850	POST ; Pos t-install functions are coded here.
14851	"RTN","PSO 7P478",8,0 )
14852	;
14853	"RTN","PSO 7P478",9,0 )
14854	D MES^XPD UTL(" Sta rting post -install o f PSO747 8")
14855	"RTN","PSO 7P478",10, 0)
14856	D PCN
14857	"RTN","PSO 7P478",11, 0)
14858	D BMES^XP DUTL(" Fi nished pos t-install of PSO74 78")
14859	"RTN","PSO 7P478",12, 0)
14860	Q
14861	"RTN","PSO 7P478",13, 0)
14862	;
14863	"RTN","PSO 7P478",14, 0)
14864	PCN ;Updat e PCN on P RESCRIPTIO N reject m ultiple
14865	"RTN","PSO 7P478",15, 0)
14866	;
14867	"RTN","PSO 7P478",16, 0)
14868	N CNT,COB ,DAT,DCNT, DUR,RX,RN, RSPIEN,DA, DR,DIE
14869	"RTN","PSO 7P478",17, 0)
14870	D BMES^XP DUTL(" U pdating PC N Numbers" )
14871	"RTN","PSO 7P478",18, 0)
14872	S CNT=0
14873	"RTN","PSO 7P478",19, 0)
14874	S DCNT=0
14875	"RTN","PSO 7P478",20, 0)
14876	S DAT=0 F S DAT=$O (^PSRX("RE JDAT",DAT) ) Q:'DAT D
14877	"RTN","PSO 7P478",21, 0)
14878	. S RX="" F S RX=$ O(^PSRX("R EJDAT",DAT ,RX)) Q:'R X D
14879	"RTN","PSO 7P478",22, 0)
14880	.. S RN=" " F S RN= $O(^PSRX(" REJDAT",DA T,RX,RN)) Q:'RN D
14881	"RTN","PSO 7P478",23, 0)
14882	... I $L( $P($G(^PSR X(RX,"REJ" ,RN,2)),"^ ",10))=10 Q
14883	"RTN","PSO 7P478",24, 0)
14884	... S RSP IEN=$P($G( ^PSRX(RX," REJ",RN,0) ),"^",11) I 'RSPIEN Q
14885	"RTN","PSO 7P478",25, 0)
14886	... S COB =$P($G(^PS RX(RX,"REJ ",RN,2))," ^",7) I CO B="" S COB =1
14887	"RTN","PSO 7P478",26, 0)
14888	... K DUR D DURRESP ^BPSNCPD3( RSPIEN,.DU R,COB) ; ICR# 45 60
14889	"RTN","PSO 7P478",27, 0)
14890	... I $L( DUR(COB,"P CN"))'=10 Q
14891	"RTN","PSO 7P478",28, 0)
14892	... S DIE ="^PSRX("_ RX_",""REJ "",",DA(1) =RX,DA=RN, DR=34_"/// /"_DUR(COB ,"PCN")
14893	"RTN","PSO 7P478",29, 0)
14894	... D ^DI E K DA,DR, DIE
14895	"RTN","PSO 7P478",30, 0)
14896	... S CNT =CNT+1
14897	"RTN","PSO 7P478",31, 0)
14898	... I CNT #1000=0 W "." S DCNT =DCNT+1
14899	"RTN","PSO 7P478",32, 0)
14900	... I DCN T=76 W ! S DCNT=0
14901	"RTN","PSO 7P478",33, 0)
14902	D MES^XPD UTL(" - "_CNT_" e ntries upd ated")
14903	"RTN","PSO 7P478",34, 0)
14904	D MES^XPD UTL(" - Done with updating PCN Number s")
14905	"RTN","PSO 7P478",35, 0)
14906	;
14907	"RTN","PSO 7P478",36, 0)
14908	D MAIL(CN T) ; Send mail mess age
14909	"RTN","PSO 7P478",37, 0)
14910	Q
14911	"RTN","PSO 7P478",38, 0)
14912	;
14913	"RTN","PSO 7P478",39, 0)
14914	MAIL(PCNCN T) ; Send mail messa ge
14915	"RTN","PSO 7P478",40, 0)
14916	N CNT,MSG ,XMY,XMDUZ ,DIFROM,XM SUB,XMTEXT
14917	"RTN","PSO 7P478",41, 0)
14918	S XMY(DUZ )=""
14919	"RTN","PSO 7P478",42, 0)
14920	S XMSUB=" PSO7.047 8 Post ins tall is co mplete",XM DUZ="Patch PSO7.04 78"
14921	"RTN","PSO 7P478",43, 0)
14922	S XMTEXT= "MSG("
14923	"RTN","PSO 7P478",44, 0)
14924	S CNT=1,M SG(CNT)=""
14925	"RTN","PSO 7P478",45, 0)
14926	S CNT=CNT +1,MSG(CNT )="Patch P SO7.0478 post inst all routin e has comp leted."
14927	"RTN","PSO 7P478",46, 0)
14928	S CNT=CNT +1,MSG(CNT )=""
14929	"RTN","PSO 7P478",47, 0)
14930	S CNT=CNT +1,MSG(CNT )="Updated "_PCNCNT_ " records in the REJ ECT INFO s ub-file of the PRESC RIPTION fi le."
14931	"RTN","PSO 7P478",48, 0)
14932	S CNT=CNT +1,MSG(CNT )=""
14933	"RTN","PSO 7P478",49, 0)
14934	S CNT=CNT +1,MSG(CNT )="For mor e informat ion about this post install, r eview the patch desc ription."
14935	"RTN","PSO 7P478",50, 0)
14936	D ^XMD
14937	"RTN","PSO 7P478",51, 0)
14938	Q
14939	"RTN","PSO REJP1")
14940	0^4^B20237 2294
14941	"RTN","PSO REJP1",1,0 )
14942	PSOREJP1 ; BIRM/MFR - Third Par ty Reject Display Sc reen ;04/2 9/05
14943	"RTN","PSO REJP1",2,0 )
14944	;;7.0;OUT PATIENT PH ARMACY;1 48,247,260 ,281,287,2 89,290,358 ,359,385,4 03,421,427 ,448,478 ;DEC 1997; Build 15
14945	"RTN","PSO REJP1",3,0 )
14946	;Referenc e to File 9002313.93 - BPS NCP DP REJECT CODES supp orted by I A 4720
14947	"RTN","PSO REJP1",4,0 )
14948	;Referenc e to ^PS(5 9.7 suppor ted by IA 694
14949	"RTN","PSO REJP1",5,0 )
14950	;Referenc e to ^PSDR UG("AQ" su pported by IA 3165
14951	"RTN","PSO REJP1",6,0 )
14952	;Referenc e to File 9002313.25 supported by IA 506 4
14953	"RTN","PSO REJP1",7,0 )
14954	;Referenc e to BPSNC PD3 suppor ted by IA 4560
14955	"RTN","PSO REJP1",8,0 )
14956	;Referenc e to ^BPSV RX support ed by IA 5 723
14957	"RTN","PSO REJP1",9,0 )
14958	;Referenc e to $$BBI LL^BPSBUTL and $$RES UBMIT^BPSB UTL suppor ted by IA 4719
14959	"RTN","PSO REJP1",10, 0)
14960	;
14961	"RTN","PSO REJP1",11, 0)
14962	EN(RX,REJ, CHANGE) ; Entry poin t
14963	"RTN","PSO REJP1",12, 0)
14964	;
14965	"RTN","PSO REJP1",13, 0)
14966	; - DO NO T change t he IF logi c below as both of t hem might get execut ed (intent ional)
14967	"RTN","PSO REJP1",14, 0)
14968	N FILL,LA STLN,PSOTR IC,PSOCODE ,PSOTCODE
14969	"RTN","PSO REJP1",15, 0)
14970	S FILL=+$ $GET1^DIQ( 52.25,REJ_ ","_RX,5)
14971	"RTN","PSO REJP1",16, 0)
14972	S PSOTRIC =$$TRIC(RX ,FILL),PSO CODE=$$GET 1^DIQ(52.2 5,REJ_","_ RX,.01)
14973	"RTN","PSO REJP1",17, 0)
14974	S PSOTCOD E=0 S:PSOC ODE'=79&(P SOCODE'=88 )&(PSOTRIC ) PSOTCODE =1
14975	"RTN","PSO REJP1",18, 0)
14976	I $$CLOSE D(RX,REJ) D EN^VALM( "PSO REJEC T DISPLAY - RESOLVED ")
14977	"RTN","PSO REJP1",19, 0)
14978	I '$$CLOS ED(RX,REJ) &(PSOTRIC) D EN^VALM ("PSO REJE CT TRICARE ") ;cnf, PSO7358 , replace PSOTCODE w ith PSOTRI C
14979	"RTN","PSO REJP1",20, 0)
14980	I '$$CLOS ED(RX,REJ) &('PSOTCOD E)&('PSOTR IC) D EN^V ALM("PSO R EJECT DISP LAY") ;c nf, PSO7 358, add P SOTRIC che ck
14981	"RTN","PSO REJP1",21, 0)
14982	D FULL^VA LM1
14983	"RTN","PSO REJP1",22, 0)
14984	Q
14985	"RTN","PSO REJP1",23, 0)
14986	;
14987	"RTN","PSO REJP1",24, 0)
14988	HDR ; - Bu ilds the H eader sect ion
14989	"RTN","PSO REJP1",25, 0)
14990	N LINE1,L INE2,X
14991	"RTN","PSO REJP1",26, 0)
14992	S VALMHDR (1)=$$DVIN FO^PSOREJU 2(RX,FILL, 1),VALMHDR (2)=$$PTIN FO^PSOREJU 2(RX,1)
14993	"RTN","PSO REJP1",27, 0)
14994	;cnf, PSO 7358, ad d REJ to p arameter l ist for RX INFO^PSORE JP3
14995	"RTN","PSO REJP1",28, 0)
14996	S VALMHDR (3)=$$RXIN FO^PSOREJP 3(RX,FILL, 1),VALMHDR (4)=$$RXIN FO^PSOREJP 3(RX,FILL, 2,REJ)
14997	"RTN","PSO REJP1",29, 0)
14998	Q
14999	"RTN","PSO REJP1",30, 0)
15000	;
15001	"RTN","PSO REJP1",31, 0)
15002	TRIC(RX,RF L,PSOTRIC) ; - Retur n 1 for TR ICARE, 2 f or CHAMPVA or 0 (zer o) for not TRICARE o r CHAMPVA
15003	"RTN","PSO REJP1",32, 0)
15004	I '$D(RFL ) S RFL=$$ LSTRFL^PSO BPSU1(RX)
15005	"RTN","PSO REJP1",33, 0)
15006	S PSOTRIC ="",PSOTRI C=$S(RFL=0 &($$GET1^D IQ(52,RX_" ,",85,"I") ="T"):1,$$ GET1^DIQ(5 2.1,RFL_", "_RX_",",8 5,"I")="T" :1,RFL=0&( $$GET1^DIQ (52,RX_"," ,85,"I")=" C"):2,$$GE T1^DIQ(52. 1,RFL_","_ RX_",",85, "I")="C":2 ,1:0)
15007	"RTN","PSO REJP1",34, 0)
15008	Q PSOTRIC
15009	"RTN","PSO REJP1",35, 0)
15010	;
15011	"RTN","PSO REJP1",36, 0)
15012	ELIGDISP(R X,RFL) ; R eturn eith er CHAMPVA or TRICAR E for disp lay
15013	"RTN","PSO REJP1",37, 0)
15014	; purpose s, or null if neithe r
15015	"RTN","PSO REJP1",38, 0)
15016	N PSOELIG
15017	"RTN","PSO REJP1",39, 0)
15018	S PSOELIG =$$TRIC(RX ,RFL)
15019	"RTN","PSO REJP1",40, 0)
15020	Q $S(PSOE LIG=1:"TRI CARE",PSOE LIG=2:"CHA MPVA",1:"" )
15021	"RTN","PSO REJP1",41, 0)
15022	;
15023	"RTN","PSO REJP1",42, 0)
15024	ELIGTCV(RX ,RFL,CAPS) ; Return either CHA MPVA, TRIC ARE, or Ve teran/VETE RAN for el igibility display (P SO7448)
15025	"RTN","PSO REJP1",43, 0)
15026	; if CAPS =1 then re turn "Vete ran" in al l caps
15027	"RTN","PSO REJP1",44, 0)
15028	; Note if the reque sted refil l has been deleted, then the m essage "N/ A - Fill D eleted" wi ll be retu rned
15029	"RTN","PSO REJP1",45, 0)
15030	N PSOELIG ,VET,DELMS G
15031	"RTN","PSO REJP1",46, 0)
15032	S DELMSG= "N/A - Fil l Deleted"
15033	"RTN","PSO REJP1",47, 0)
15034	S PSOELIG =$$TRIC(RX ,RFL),VET= "Veteran" I $G(CAPS) S VET="VE TERAN"
15035	"RTN","PSO REJP1",48, 0)
15036	I RFL>0,' $D(^PSRX(R X,1,RFL,0) ) S PSOELI G=3
15037	"RTN","PSO REJP1",49, 0)
15038	Q $S(PSOE LIG=1:"TRI CARE",PSOE LIG=2:"CHA MPVA",PSOE LIG=3:DELM SG,1:VET)
15039	"RTN","PSO REJP1",50, 0)
15040	;
15041	"RTN","PSO REJP1",51, 0)
15042	INIT ; Bui lds the Bo dy section
15043	"RTN","PSO REJP1",52, 0)
15044	N DATA,LI NE
15045	"RTN","PSO REJP1",53, 0)
15046	I '$D(FIL L) S FILL= +$$GET1^DI Q(52.25,RE J_","_RX,5 ) ; PSO* 7*448 obta in fill# f rom 52.25 subfile if not defin ed
15047	"RTN","PSO REJP1",54, 0)
15048	I '$$CLOS ED(RX,REJ) S VALM("T ITLE")="Re ject Infor mation ("_ $$ELIGTCV( RX,FILL)_" )"
15049	"RTN","PSO REJP1",55, 0)
15050	I $$CLOSE D(RX,REJ) S VALM("TI TLE")="Rej ect Inform ation (RES OLVED)"
15051	"RTN","PSO REJP1",56, 0)
15052	F I=1:1:$ G(LASTLN) D RESTORE^ VALM10(I)
15053	"RTN","PSO REJP1",57, 0)
15054	K ^TMP("P SOREJP1",$ J) S VALMC NT=0,LINE= 0
15055	"RTN","PSO REJP1",58, 0)
15056	D GET^PSO REJU2(RX,F ILL,.DATA, REJ,1)
15057	"RTN","PSO REJP1",59, 0)
15058	D REJ ; Dis play the R EJECT Info rmation
15059	"RTN","PSO REJP1",60, 0)
15060	D OTH ; Dis play the O ther Rejec ts Informa tion
15061	"RTN","PSO REJP1",61, 0)
15062	D COM^PSO REJP3 ; Dis play the C omment
15063	"RTN","PSO REJP1",62, 0)
15064	D INS ; Dis play the I nsurance I nformation
15065	"RTN","PSO REJP1",63, 0)
15066	D CLS ; Dis play the R esolution Informatio n
15067	"RTN","PSO REJP1",64, 0)
15068	S VALMCNT =LINE
15069	"RTN","PSO REJP1",65, 0)
15070	Q
15071	"RTN","PSO REJP1",66, 0)
15072	;
15073	"RTN","PSO REJP1",67, 0)
15074	REJ ; - DU R Informat ion
15075	"RTN","PSO REJP1",68, 0)
15076	N TYPE,PF LDT,TREJ,T DATA,PSOET ,PSONAF,PS OCOB,PSOTX T,PSOECME S TDATA=""
15077	"RTN","PSO REJP1",69, 0)
15078	;
15079	"RTN","PSO REJP1",70, 0)
15080	; LH;PSO* 7*448 - Di splay 'RES UBMISSION' where 'BA CK-BILL' c urrently
15081	"RTN","PSO REJP1",71, 0)
15082	; display s if the c laim was r esubmitted from the ECME User Screen.
15083	"RTN","PSO REJP1",72, 0)
15084	; To faci litate thi s, the fun ction $$RE SUBMIT^BPS BUTL was c reated.
15085	"RTN","PSO REJP1",73, 0)
15086	;
15087	"RTN","PSO REJP1",74, 0)
15088	; Back Bi ll indicat or - PSO7 421
15089	"RTN","PSO REJP1",75, 0)
15090	S PSOTXT= "",PSOCOB= $G(DATA(RE J,"COB")), PSOCOB=$S( PSOCOB="SE CONDARY":2 ,PSOCOB="T ERTIARY":3 ,1:1)
15091	"RTN","PSO REJP1",76, 0)
15092	I $$BBILL ^BPSBUTL(R X,FILL,PSO COB) S PSO TXT=" BACK -BILL"
15093	"RTN","PSO REJP1",77, 0)
15094	E I $$RE SUBMIT^BPS BUTL(RX,FI LL,PSOCOB) S PSOTXT= " RESUBMIS SION" ; I A 4719.
15095	"RTN","PSO REJP1",78, 0)
15096	D SETLN(" REJECT Inf ormation ( "_$$ELIGTC V(RX,FILL) _") "_PSOT XT,1,1)
15097	"RTN","PSO REJP1",79, 0)
15098	S PSOECME =$$STATUS^ PSOBPSUT(R X,FILL)
15099	"RTN","PSO REJP1",80, 0)
15100	I PSOECME ="E PAYABL E" D
15101	"RTN","PSO REJP1",81, 0)
15102	. D SETLN ("Reject T ype : " ,,,18)
15103	"RTN","PSO REJP1",82, 0)
15104	. D SETLN ("Reject S tatus : * * E PAYABL E **",,,18 )
15105	"RTN","PSO REJP1",83, 0)
15106	. Q
15107	"RTN","PSO REJP1",84, 0)
15108	E D
15109	"RTN","PSO REJP1",85, 0)
15110	. S TYPE= $S($G(DATA (REJ,"CODE "))=79:"79 - REFILL TOO SOON", 1:"")
15111	"RTN","PSO REJP1",86, 0)
15112	. I TYPE= "" S TYPE= DATA(REJ," CODE")_" - "_$E($$EX P(DATA(REJ ,"CODE")), 1,23)_"-"
15113	"RTN","PSO REJP1",87, 0)
15114	. D SETLN ("Reject T ype : " _TYPE_" re ceived on "_$$FMTE^X LFDT($G(DA TA(REJ,"DA TE/TIME")) ),,,18)
15115	"RTN","PSO REJP1",88, 0)
15116	. ;cnf, P SO7358, if TRICARE /CHAMPVA n on-billabl e then res et Status line
15117	"RTN","PSO REJP1",89, 0)
15118	. S PSOET =$$PSOET^P SOREJP3(RX ,FILL)
15119	"RTN","PSO REJP1",90, 0)
15120	. I PSOET D SETLN(" Status : NO CLAIM SUBM ITTED")
15121	"RTN","PSO REJP1",91, 0)
15122	. I 'PSOE T D SETLN( "Reject St atus : "_ $G(DATA(RE J,"STATUS" ))_" - "_P SOECME,,,1 8)
15123	"RTN","PSO REJP1",92, 0)
15124	. Q
15125	"RTN","PSO REJP1",93, 0)
15126	S PSONAF= $$NFLDT^BP SBUTL(RX,F ILL) ; IA 4719
15127	"RTN","PSO REJP1",94, 0)
15128	I PSONAF' ="" D SETL N("Next Av ail Fill: "_$$FMTE^X LFDT(PSONA F),,,18) ; PSO7421
15129	"RTN","PSO REJP1",95, 0)
15130	D SET("PA YER MESSAG E",63)
15131	"RTN","PSO REJP1",96, 0)
15132	D SET("RE ASON",63)
15133	"RTN","PSO REJP1",97, 0)
15134	S PFLDT=$ $FMTE^XLFD T($G(DATA( REJ,"PLAN PREVIOUS F ILL DATE") ))
15135	"RTN","PSO REJP1",98, 0)
15136	D SET("DU R TEXT",63 ,$S(PFLDT= "":1,1:0))
15137	"RTN","PSO REJP1",99, 0)
15138	I PFLDT'= "" D SETLN ("Last Fil l Date : " _PFLDT_" ( from payer )",,1,18)
15139	"RTN","PSO REJP1",100 ,0)
15140	Q
15141	"RTN","PSO REJP1",101 ,0)
15142	;
15143	"RTN","PSO REJP1",102 ,0)
15144	OTH ; - Ot her Reject s Informat ion
15145	"RTN","PSO REJP1",103 ,0)
15146	N LST,I,R JC,J,LAST
15147	"RTN","PSO REJP1",104 ,0)
15148	S LST=$G( DATA(REJ," OTHER REJE CTS")) I L ST="" Q
15149	"RTN","PSO REJP1",105 ,0)
15150	D SETLN()
15151	"RTN","PSO REJP1",106 ,0)
15152	D SETLN(" OTHER REJE CTS",1,1)
15153	"RTN","PSO REJP1",107 ,0)
15154	F I=1:1:$ L(LST,",") S RJC=$P( LST,",",I) D
15155	"RTN","PSO REJP1",108 ,0)
15156	. S LAST= 1 F J=(I+1 ):1:$L(LST ,",") I $P (LST,",",J )'="" S LA ST=0 Q
15157	"RTN","PSO REJP1",109 ,0)
15158	. I RJC'= "" D SETLN (RJC_" - " _$$EXP(RJC ),,$S(LAST :1,1:0),6)
15159	"RTN","PSO REJP1",110 ,0)
15160	Q
15161	"RTN","PSO REJP1",111 ,0)
15162	;
15163	"RTN","PSO REJP1",112 ,0)
15164	INS ; - In surance In formation
15165	"RTN","PSO REJP1",113 ,0)
15166	D SETLN()
15167	"RTN","PSO REJP1",114 ,0)
15168	D SETLN(" INSURANCE Informatio n",1,1)
15169	"RTN","PSO REJP1",115 ,0)
15170	N PSOINS, PSOINS1,I, PSOBINPCN
15171	"RTN","PSO REJP1",116 ,0)
15172	S PSOINS= $G(DATA(RE J,"INSURAN CE NAME"))
15173	"RTN","PSO REJP1",117 ,0)
15174	F I=1:1:( 50-($L(PSO INS)+18)) S PSOINS=P SOINS_" "
15175	"RTN","PSO REJP1",118 ,0)
15176	S PSOINS1 =$G(DATA(R EJ,"COB"))
15177	"RTN","PSO REJP1",119 ,0)
15178	I PSOINS1 ="SECONDAR Y" S PSOIN S=PSOINS_" Coord. Of Benefits: "_PSOINS1
15179	"RTN","PSO REJP1",120 ,0)
15180	D SETLN(" Insurance : "_P SOINS,,,18 )
15181	"RTN","PSO REJP1",121 ,0)
15182	D SETLN(" Contact : "_$ G(DATA(REJ ,"PLAN CON TACT")),,, 18)
15183	"RTN","PSO REJP1",122 ,0)
15184	S PSOBINP CN=$G(DATA (REJ,"BIN" ))_"/ "_$G (DATA(REJ, "PCN"))
15185	"RTN","PSO REJP1",123 ,0)
15186	D SETLN(" BIN/ PCN : "_P SOBINPCN,, ,18)
15187	"RTN","PSO REJP1",124 ,0)
15188	D SETLN(" Group Numb er : "_$ G(DATA(REJ ,"GROUP NU MBER")),,, 18)
15189	"RTN","PSO REJP1",125 ,0)
15190	D SETLN(" Cardholder ID : "_$ G(DATA(REJ ,"CARDHOLD ER ID")),, 1,18)
15191	"RTN","PSO REJP1",126 ,0)
15192	Q
15193	"RTN","PSO REJP1",127 ,0)
15194	;
15195	"RTN","PSO REJP1",128 ,0)
15196	CLS ; - Re solution I nformation
15197	"RTN","PSO REJP1",129 ,0)
15198	N X
15199	"RTN","PSO REJP1",130 ,0)
15200	I '$$CLOS ED(RX,REJ) Q
15201	"RTN","PSO REJP1",131 ,0)
15202	D SETLN()
15203	"RTN","PSO REJP1",132 ,0)
15204	D SETLN(" RESOLUTION Informati on",1,1)
15205	"RTN","PSO REJP1",133 ,0)
15206	D SETLN(" Resolved B y : "_$ G(DATA(REJ ,"CLOSED B Y")),,,18)
15207	"RTN","PSO REJP1",134 ,0)
15208	D SETLN(" Date/Time : "_$ G(DATA(REJ ,"CLOSED D ATE/TIME") ),,,18)
15209	"RTN","PSO REJP1",135 ,0)
15210	I $G(DATA (REJ,"CLOS E COMMENTS "))'="" D SET("CLOSE COMMENTS" ,63)
15211	"RTN","PSO REJP1",136 ,0)
15212	I $G(DATA (REJ,"COD1 "))'="" D SETLN("Rea son for Sv c : "_$$OV RX^PSOREJU 1(1,$G(DAT A(REJ,"COD 1"))),,,18 )
15213	"RTN","PSO REJP1",137 ,0)
15214	I $G(DATA (REJ,"COD2 "))'="" D SETLN("Pro fes. Svc : "_$$OV RX^PSOREJU 1(2,$G(DAT A(REJ,"COD 2"))),,,18 )
15215	"RTN","PSO REJP1",138 ,0)
15216	I $G(DATA (REJ,"COD3 "))'="" D SETLN("Res ult of Svc : "_$$OV RX^PSOREJU 1(3,$G(DAT A(REJ,"COD 3"))),,,18 )
15217	"RTN","PSO REJP1",139 ,0)
15218	I $G(DATA (REJ,"CLA CODE"))'=" " D
15219	"RTN","PSO REJP1",140 ,0)
15220	. N CLAPN TR S CLAPN TR=$$GET1^ DIQ(52.25, REJ_","_RX _",",24,"I ")
15221	"RTN","PSO REJP1",141 ,0)
15222	. S X=DAT A(REJ,"CLA CODE")_" - "_$$GET1 ^DIQ(90023 13.25,CLAP NTR,".02")
15223	"RTN","PSO REJP1",142 ,0)
15224	. D SETLN ("Clarific . Code : " _X,,,18)
15225	"RTN","PSO REJP1",143 ,0)
15226	I $G(DATA (REJ,"PRIO R AUTH TYP E"))'="" D
15227	"RTN","PSO REJP1",144 ,0)
15228	. S X=$$G ET1^DIQ(52 .25,REJ_", "_RX,25,"I ")_" - "_( DATA(REJ," PRIOR AUTH TYPE"))
15229	"RTN","PSO REJP1",145 ,0)
15230	. D SETLN ("Prior Au th.Type: " _X,,,18),S ETLN("Prio r Auth. # : "_DATA( REJ,"PRIOR AUTH NUMB ER"),,,18)
15231	"RTN","PSO REJP1",146 ,0)
15232	D SETLN(" Reason : "_$ G(DATA(REJ ,"CLOSE RE ASON")),,1 ,18)
15233	"RTN","PSO REJP1",147 ,0)
15234	Q
15235	"RTN","PSO REJP1",148 ,0)
15236	;
15237	"RTN","PSO REJP1",149 ,0)
15238	;
15239	"RTN","PSO REJP1",150 ,0)
15240	SET(FIELD, L,UND) ; S ets the li nes for fi elds that require te xt wrappin g
15241	"RTN","PSO REJP1",151 ,0)
15242	N TXT,T
15243	"RTN","PSO REJP1",152 ,0)
15244	S TXT=DAT A(REJ,FIEL D) I $L(TX T)'>L D SE TLN($$LABE L(FIELD)_T XT,,$S($G( UND):1,1:0 ),80-L) Q
15245	"RTN","PSO REJP1",153 ,0)
15246	F I=1:1 Q :TXT="" D
15247	"RTN","PSO REJP1",154 ,0)
15248	. I I=1 D SETLN($$L ABEL(FIELD )_$E(TXT,1 ,L),,,80-L ) S TXT=$E (TXT,L+1,9 99) Q
15249	"RTN","PSO REJP1",155 ,0)
15250	. S T="", $E(T,81-L) =$E(TXT,1, L) D SETLN (T,,$S($E( TXT,L+1,99 9)=""&$G(U ND):1,1:0) ,80-L) S T XT=$E(TXT, L+1,999)
15251	"RTN","PSO REJP1",156 ,0)
15252	Q
15253	"RTN","PSO REJP1",157 ,0)
15254	;
15255	"RTN","PSO REJP1",158 ,0)
15256	LABEL(FIEL D) ; Sets the label for the fi eld
15257	"RTN","PSO REJP1",159 ,0)
15258	I FIELD=" REASON" Q "Reason Co de : "
15259	"RTN","PSO REJP1",160 ,0)
15260	I FIELD=" PAYER MESS AGE" Q "Pa yer Addl M sg : "
15261	"RTN","PSO REJP1",161 ,0)
15262	I FIELD=" DUR TEXT" Q $S(+$$IS DUR^PSOREJ P5(RX,REJ) :"+DUR Tex t : " ,1:"DUR Te xt : ")
15263	"RTN","PSO REJP1",162 ,0)
15264	I FIELD=" CLOSE COMM ENTS" Q "C omments : "
15265	"RTN","PSO REJP1",163 ,0)
15266	Q ""
15267	"RTN","PSO REJP1",164 ,0)
15268	;
15269	"RTN","PSO REJP1",165 ,0)
15270	VIEW ; - R x View hid den action
15271	"RTN","PSO REJP1",166 ,0)
15272	N VALMCNT ,TITLE
15273	"RTN","PSO REJP1",167 ,0)
15274	I $G(PSOB ACK) D Q
15275	"RTN","PSO REJP1",168 ,0)
15276	. S VALMS G="Not ava ilable thr ough Backd oor!",VALM BCK="R"
15277	"RTN","PSO REJP1",169 ,0)
15278	S TITLE=V ALM("TITLE ")
15279	"RTN","PSO REJP1",170 ,0)
15280	;
15281	"RTN","PSO REJP1",171 ,0)
15282	; - DO st ructure us ed to avoi d losing v ariables R X,FILL,REJ ,LINE,TITL E
15283	"RTN","PSO REJP1",172 ,0)
15284	DO
15285	"RTN","PSO REJP1",173 ,0)
15286	. N PSOVD A,DA,PS
15287	"RTN","PSO REJP1",174 ,0)
15288	. S (PSOV DA,DA)=RX, PS="REJECT "
15289	"RTN","PSO REJP1",175 ,0)
15290	. N RX,RE J,FILL,LIN E,TITLE D DP^PSORXVW
15291	"RTN","PSO REJP1",176 ,0)
15292	;
15293	"RTN","PSO REJP1",177 ,0)
15294	S VALMBCK ="R",VALM( "TITLE")=T ITLE
15295	"RTN","PSO REJP1",178 ,0)
15296	Q
15297	"RTN","PSO REJP1",179 ,0)
15298	;
15299	"RTN","PSO REJP1",180 ,0)
15300	EDT ; - Rx Edit hidd en action
15301	"RTN","PSO REJP1",181 ,0)
15302	N VALMCNT ,TITLE
15303	"RTN","PSO REJP1",182 ,0)
15304	I $G(PSOB ACK) D Q
15305	"RTN","PSO REJP1",183 ,0)
15306	. S VALMS G="Not ava ilable thr ough Backd oor!",VALM BCK="R"
15307	"RTN","PSO REJP1",184 ,0)
15308	S TITLE=V ALM("TITLE ")
15309	"RTN","PSO REJP1",185 ,0)
15310	;
15311	"RTN","PSO REJP1",186 ,0)
15312	; - DO st ructure us ed to avoi d losing v ariables R X,FILL,REJ ,LINE,TITL E
15313	"RTN","PSO REJP1",187 ,0)
15314	DO
15315	"RTN","PSO REJP1",188 ,0)
15316	. N PSOSI TE,ORN,PSO PAR,PSOLIS T,PSOREJCT
15317	"RTN","PSO REJP1",189 ,0)
15318	. S PSOSI TE=$$RXSIT E^PSOBPSUT (RX,FILL), ORN=RX
15319	"RTN","PSO REJP1",190 ,0)
15320	. S PSOPA R=$G(^PS(5 9,PSOSITE, 1)),PSOLIS T(1)=ORN_" ,"
15321	"RTN","PSO REJP1",191 ,0)
15322	. ; Varia ble PSOREJ CT is used so that E PH^PSORXED T has the RX 'passed ' by this routine
15323	"RTN","PSO REJP1",192 ,0)
15324	. S PSORE JCT=RX_U_F ILL
15325	"RTN","PSO REJP1",193 ,0)
15326	. N RX,RE J,FILL,LIN E,TITLE D EPH^PSORXE DT
15327	"RTN","PSO REJP1",194 ,0)
15328	;
15329	"RTN","PSO REJP1",195 ,0)
15330	K VALMBCK I $$CLOSE D(RX,REJ), $D(PSOSTFL T),PSOSTFL T="U" S CH ANGE=1 Q
15331	"RTN","PSO REJP1",196 ,0)
15332	S VALMBCK ="R",VALM( "TITLE")=T ITLE
15333	"RTN","PSO REJP1",197 ,0)
15334	Q
15335	"RTN","PSO REJP1",198 ,0)
15336	;
15337	"RTN","PSO REJP1",199 ,0)
15338	OVR ; - Ov erride a R EJECT acti on
15339	"RTN","PSO REJP1",200 ,0)
15340	N PSOET
15341	"RTN","PSO REJP1",201 ,0)
15342	I $$CLOSE D(RX,REJ,1 ) Q
15343	"RTN","PSO REJP1",202 ,0)
15344	;cnf, PSO 7358
15345	"RTN","PSO REJP1",203 ,0)
15346	S PSOET=$ $PSOET^PSO REJP3(RX,F ILL)
15347	"RTN","PSO REJP1",204 ,0)
15348	I PSOET S VALMSG="O VR not all owed for " _$$ELIGDIS P(RX,FILL) _" Non-Bil lable clai m.",VALMBC K="R" Q
15349	"RTN","PSO REJP1",205 ,0)
15350	N COD1,CO D2,COD3
15351	"RTN","PSO REJP1",206 ,0)
15352	D FULL^VA LM1 W !
15353	"RTN","PSO REJP1",207 ,0)
15354	S COD1=$$ OVRCOD^PSO REJU1(1,$$ GET1^DIQ(5 2.25,REJ_" ,"_RX,14)) I COD1="^ "!(COD1="" ) S VALMBC K="R" Q
15355	"RTN","PSO REJP1",208 ,0)
15356	S COD2=$$ OVRCOD^PSO REJU1(2) I COD2="^" S VALMBCK= "R" Q
15357	"RTN","PSO REJP1",209 ,0)
15358	S COD3=$$ OVRCOD^PSO REJU1(3) I COD3="^" S VALMBCK= "R" Q
15359	"RTN","PSO REJP1",210 ,0)
15360	D OVRDSP^ PSOREJU1(C OD1_"^"_CO D2_"^"_COD 3)
15361	"RTN","PSO REJP1",211 ,0)
15362	D SEND^PS OREJP3(COD 1_"^"_COD2 _"^"_COD3, ,,PSOET)
15363	"RTN","PSO REJP1",212 ,0)
15364	Q
15365	"RTN","PSO REJP1",213 ,0)
15366	;
15367	"RTN","PSO REJP1",214 ,0)
15368	RES ; - Re -submit a claim acti on
15369	"RTN","PSO REJP1",215 ,0)
15370	N PSOET
15371	"RTN","PSO REJP1",216 ,0)
15372	I $$CLOSE D(RX,REJ,1 ) Q
15373	"RTN","PSO REJP1",217 ,0)
15374	;cnf, PSO 7358
15375	"RTN","PSO REJP1",218 ,0)
15376	S PSOET=$ $PSOET^PSO REJP3(RX,F ILL)
15377	"RTN","PSO REJP1",219 ,0)
15378	D FULL^VA LM1 W !
15379	"RTN","PSO REJP1",220 ,0)
15380	D SEND^PS OREJP3(,,, PSOET)
15381	"RTN","PSO REJP1",221 ,0)
15382	Q
15383	"RTN","PSO REJP1",222 ,0)
15384	;
15385	"RTN","PSO REJP1",223 ,0)
15386	CLA ; - Su bmit Clari fication C ode
15387	"RTN","PSO REJP1",224 ,0)
15388	N CLA,PSO ET
15389	"RTN","PSO REJP1",225 ,0)
15390	I $$CLOSE D(RX,REJ,1 ) Q
15391	"RTN","PSO REJP1",226 ,0)
15392	;cnf, PSO 7358
15393	"RTN","PSO REJP1",227 ,0)
15394	S PSOET=$ $PSOET^PSO REJP3(RX,F ILL)
15395	"RTN","PSO REJP1",228 ,0)
15396	I PSOET S VALMSG="C LA not all owed for " _$$ELIGDIS P(RX,FILL) _" Non-Bil lable clai m.",VALMBC K="R" Q
15397	"RTN","PSO REJP1",229 ,0)
15398	D FULL^VA LM1 W !
15399	"RTN","PSO REJP1",230 ,0)
15400	; Prompt for the Su bmission C larificati on Codes ( up to thre e)
15401	"RTN","PSO REJP1",231 ,0)
15402	S CLA=$$C LA^PSOREJU 1() I CLA= "^"!(CLA=" ") S VALMB CK="R" Q
15403	"RTN","PSO REJP1",232 ,0)
15404	W ! D SEN D^PSOREJP3 (,CLA,,PSO ET)
15405	"RTN","PSO REJP1",233 ,0)
15406	Q
15407	"RTN","PSO REJP1",234 ,0)
15408	;
15409	"RTN","PSO REJP1",235 ,0)
15410	PA ; - Sub mit Prior Authorizat ion
15411	"RTN","PSO REJP1",236 ,0)
15412	N PA,PSOE T
15413	"RTN","PSO REJP1",237 ,0)
15414	I $$CLOSE D(RX,REJ,1 ) Q
15415	"RTN","PSO REJP1",238 ,0)
15416	;cnf, PSO 7358
15417	"RTN","PSO REJP1",239 ,0)
15418	S PSOET=$ $PSOET^PSO REJP3(RX,F ILL)
15419	"RTN","PSO REJP1",240 ,0)
15420	I PSOET S VALMSG="P A not allo wed for "_ $$ELIGDISP (RX,FILL)_ " Non-Bill able claim .",VALMBCK ="R" Q
15421	"RTN","PSO REJP1",241 ,0)
15422	D FULL^VA LM1 W !
15423	"RTN","PSO REJP1",242 ,0)
15424	; Prompt for Prior Auth field s
15425	"RTN","PSO REJP1",243 ,0)
15426	S PA=$$PA ^PSOREJU2( ) I PA="^" S VALMBCK ="R" Q
15427	"RTN","PSO REJP1",244 ,0)
15428	W ! D SEN D^PSOREJP3 (,,PA,PSOE T)
15429	"RTN","PSO REJP1",245 ,0)
15430	Q
15431	"RTN","PSO REJP1",246 ,0)
15432	;
15433	"RTN","PSO REJP1",247 ,0)
15434	MP ; - Pat ient Medic ation Prof ile
15435	"RTN","PSO REJP1",248 ,0)
15436	I $G(PSOB ACK) D Q
15437	"RTN","PSO REJP1",249 ,0)
15438	. S VALMS G="Not ava ilable thr ough Backd oor!",VALM BCK="R"
15439	"RTN","PSO REJP1",250 ,0)
15440	N SITE,PA TIENT
15441	"RTN","PSO REJP1",251 ,0)
15442	D FULL^VA LM1 W !
15443	"RTN","PSO REJP1",252 ,0)
15444	S SITE=+$ $RXSITE^PS OBPSUT(RX, FILL) S:$G (PSOSITE) SITE=PSOSI TE
15445	"RTN","PSO REJP1",253 ,0)
15446	S PATIENT =+$$GET1^D IQ(52,RX,2 ,"I")
15447	"RTN","PSO REJP1",254 ,0)
15448	D LST^PSO PMP0(SITE, PATIENT) S VALMBCK=" R"
15449	"RTN","PSO REJP1",255 ,0)
15450	Q
15451	"RTN","PSO REJP1",256 ,0)
15452	;
15453	"RTN","PSO REJP1",257 ,0)
15454	EXIT ;
15455	"RTN","PSO REJP1",258 ,0)
15456	K ^TMP("P SOREJP1",$ J)
15457	"RTN","PSO REJP1",259 ,0)
15458	Q
15459	"RTN","PSO REJP1",260 ,0)
15460	;
15461	"RTN","PSO REJP1",261 ,0)
15462	SETLN(TEXT ,REV,UND,H IG) ; Sets a line to be displa yed in the Body sect ion
15463	"RTN","PSO REJP1",262 ,0)
15464	N X
15465	"RTN","PSO REJP1",263 ,0)
15466	S:$G(TEXT )="" $E(TE XT,80)=""
15467	"RTN","PSO REJP1",264 ,0)
15468	S:$L(TEXT )>80 TEXT= $E(TEXT,1, 80)
15469	"RTN","PSO REJP1",265 ,0)
15470	S LINE=LI NE+1,^TMP( "PSOREJP1" ,$J,LINE,0 )=$G(TEXT)
15471	"RTN","PSO REJP1",266 ,0)
15472	;
15473	"RTN","PSO REJP1",267 ,0)
15474	I LINE>$G (LASTLN) D SAVE^VALM 10(LINE) S LASTLN=LI NE
15475	"RTN","PSO REJP1",268 ,0)
15476	;
15477	"RTN","PSO REJP1",269 ,0)
15478	I $G(REV) D Q
15479	"RTN","PSO REJP1",270 ,0)
15480	. D CNTRL ^VALM10(LI NE,1,$L(TE XT),IORVON ,IOINORM)
15481	"RTN","PSO REJP1",271 ,0)
15482	. I $G(UN D) D CNTRL ^VALM10(LI NE,$L(TEXT )+1,80,IOU ON,IOINORM )
15483	"RTN","PSO REJP1",272 ,0)
15484	I $G(UND) D CNTRL^V ALM10(LINE ,1,80,IOUO N,IOINORM)
15485	"RTN","PSO REJP1",273 ,0)
15486	I $G(HIG) D
15487	"RTN","PSO REJP1",274 ,0)
15488	. D CNTRL ^VALM10(LI NE,HIG,80, IOINHI_$S( $G(UND):IO UON,1:""), IOINORM)
15489	"RTN","PSO REJP1",275 ,0)
15490	Q
15491	"RTN","PSO REJP1",276 ,0)
15492	HELP ;
15493	"RTN","PSO REJP1",277 ,0)
15494	Q
15495	"RTN","PSO REJP1",278 ,0)
15496	;
15497	"RTN","PSO REJP1",279 ,0)
15498	CLOSED(RX, REJ,MSG) ; Returns w hether the REJECT is RESOLVED or NOT
15499	"RTN","PSO REJP1",280 ,0)
15500	I $$GET1^ DIQ(52.25, REJ_","_RX ,10,"I") D :$G(MSG) Q 1
15501	"RTN","PSO REJP1",281 ,0)
15502	. S VALMS G="This Re ject is ma rked resol ved!",VALM BCK="R" W $C(7)
15503	"RTN","PSO REJP1",282 ,0)
15504	Q 0
15505	"RTN","PSO REJP1",283 ,0)
15506	;
15507	"RTN","PSO REJP1",284 ,0)
15508	REOPN(RX,R EJ) ; Retu rns whethe r the REJE CT was RE- OPENED or NOT
15509	"RTN","PSO REJP1",285 ,0)
15510	Q $S($$GE T1^DIQ(52. 25,REJ_"," _RX,23)="" :0,1:1)
15511	"RTN","PSO REJP1",286 ,0)
15512	;
15513	"RTN","PSO REJP1",287 ,0)
15514	EXP(CODE) ; - Return s the expl anation fi eld (.02) for a reje ct code
15515	"RTN","PSO REJP1",288 ,0)
15516	; Input: (r) CODE - .01 fie ld (Code) value from file 9002 313.93
15517	"RTN","PSO REJP1",289 ,0)
15518	; Output: .02 field (Explanat ion) value from file 9002313.9 3
15519	"RTN","PSO REJP1",290 ,0)
15520	N DIC,X,Y
15521	"RTN","PSO REJP1",291 ,0)
15522	S DIC=900 2313.93,DI C(0)="Z",X =CODE D ^D IC
15523	"RTN","PSO REJP1",292 ,0)
15524	Q $P($G(Y (0)),"^",2 )
15525	"RTN","PSO REJP1",293 ,0)
15526	;
15527	"RTN","PSO REJP1",294 ,0)
15528	OUT(RX) ; - Supporte d call by outside PR OTOCOLs to act on sp ecific REJ ECTs
15529	"RTN","PSO REJP1",295 ,0)
15530	N I,RFL,D ATA,REJ,PS OBACK,VALM CNT,RXN
15531	"RTN","PSO REJP1",296 ,0)
15532	I '$D(^XU SEC("PSORP H",DUZ)) D Q
15533	"RTN","PSO REJP1",297 ,0)
15534	. S VALMS G="PSORPH key requir ed to use the REJ ac tion.",VAL MBCK="R"
15535	"RTN","PSO REJP1",298 ,0)
15536	I $G(PS)= "REJECT" D
15537	"RTN","PSO REJP1",299 ,0)
15538	. S VALMS G="REJ act ion is not available at this p oint.",VAL MBCK="R"
15539	"RTN","PSO REJP1",300 ,0)
15540	S PSOBACK =1
15541	"RTN","PSO REJP1",301 ,0)
15542	S (RFL,I) =0 F I=1:1 Q:'$D(^PS RX(RX,1,I) ) S RFL=I
15543	"RTN","PSO REJP1",302 ,0)
15544	S X=$$FIN D^PSOREJUT (RX,RFL,.D ATA) S REJ =$O(DATA(" "))
15545	"RTN","PSO REJP1",303 ,0)
15546	I '$G(REJ ) S VALMSG ="Invalid selection! ",VALMBCK= "R" Q
15547	"RTN","PSO REJP1",304 ,0)
15548	D EN(RX,R EJ) S VALM BCK="R"
15549	"RTN","PSO REJP1",305 ,0)
15550	Q
15551	"RTN","PSO REJP1",306 ,0)
15552	;
15553	"RTN","PSO REJP1",307 ,0)
15554	SMA ;Submi t multiple actions
15555	"RTN","PSO REJP1",308 ,0)
15556	N CLA,I,O VR,OVRSTR, PA,REJIEN, DUR,RSC,DU RIEN,REQ,R SUB,PSOET
15557	"RTN","PSO REJP1",309 ,0)
15558	I $$CLOSE D(RX,REJ,1 ) Q
15559	"RTN","PSO REJP1",310 ,0)
15560	S PSOET=$ $PSOET^PSO REJP3(RX,F ILL)
15561	"RTN","PSO REJP1",311 ,0)
15562	I PSOET S VALMSG="S MA not all owed for " _$$ELIGDIS P(RX,FILL) _" Non-Bil lable clai m.",VALMBC K="R" Q
15563	"RTN","PSO REJP1",312 ,0)
15564	D FULL^VA LM1 W !
15565	"RTN","PSO REJP1",313 ,0)
15566	S DURIEN= $P($G(^PSR X(RX,"REJ" ,REJ,0)),U ,11)
15567	"RTN","PSO REJP1",314 ,0)
15568	D DURRESP ^BPSNCPD3( DURIEN,.DU R) ; Refer ence to BP SNCPD3 sup ported by IA 4560
15569	"RTN","PSO REJP1",315 ,0)
15570	;
15571	"RTN","PSO REJP1",316 ,0)
15572	; Prompt for Prior Auth field s
15573	"RTN","PSO REJP1",317 ,0)
15574	S PA=$$PA ^PSOREJU2
15575	"RTN","PSO REJP1",318 ,0)
15576	I PA="^" S VALMBCK= "R" Q ;Us er termina ted or did not answe r
15577	"RTN","PSO REJP1",319 ,0)
15578	;
15579	"RTN","PSO REJP1",320 ,0)
15580	; Prompt for submis sion clari fication c odes (up t o three)
15581	"RTN","PSO REJP1",321 ,0)
15582	W !
15583	"RTN","PSO REJP1",322 ,0)
15584	S CLA=$$C LA^PSOREJU 1
15585	"RTN","PSO REJP1",323 ,0)
15586	I CLA="^" S VALMBCK ="R" Q ;U ser termin ated or di d not answ er
15587	"RTN","PSO REJP1",324 ,0)
15588	;
15589	"RTN","PSO REJP1",325 ,0)
15590	; Check i f DUR Over rides requ ired - PSO 7421
15591	"RTN","PSO REJP1",326 ,0)
15592	S REQ=$$R EQ I REQ=" ^" S VALMB CK="R" Q
15593	"RTN","PSO REJP1",327 ,0)
15594	;
15595	"RTN","PSO REJP1",328 ,0)
15596	; Prompt for DUR Ov errides (u p to 3) - option to delete def ault added - PSO74 21
15597	"RTN","PSO REJP1",329 ,0)
15598	S OVRSTR= "",OVR=""
15599	"RTN","PSO REJP1",330 ,0)
15600	I REQ S R EJIEN=0 F RSUB=1:1:3 D Q:OVR= "^"!(OVR=" ")!(OVR="@ ") S $P(O VRSTR,"~", RSUB)=OVR
15601	"RTN","PSO REJP1",331 ,0)
15602	. I REJIE N]"" S REJ IEN=$O(DUR (1,"DUR PP S",REJIEN) )
15603	"RTN","PSO REJP1",332 ,0)
15604	. S RSC=" " I +REJIE N S RSC=$P ($G(DUR(1, "DUR PPS", REJIEN,"RE ASON FOR S ERVICE COD E"))," ",1 )
15605	"RTN","PSO REJP1",333 ,0)
15606	. S OVR=$ $SMAOVR^PS OREJU1(RSC ,RSUB)
15607	"RTN","PSO REJP1",334 ,0)
15608	I OVR="^" S VALMBCK ="R" Q ;U ser exited or timed- out
15609	"RTN","PSO REJP1",335 ,0)
15610	;
15611	"RTN","PSO REJP1",336 ,0)
15612	W !!,?6," RECAP:"
15613	"RTN","PSO REJP1",337 ,0)
15614	W !,?6,"P rior Autho rization T ype : ",$P(PA, "^")," ", $$DSC^PSOR EJU1(90023 13.26,$P(P A,"^"),.02 )
15615	"RTN","PSO REJP1",338 ,0)
15616	W !,?6,"P rior Autho rization N umber : ",$P(PA, "^",2)
15617	"RTN","PSO REJP1",339 ,0)
15618	W !,?6,"S ubmission Clarificat ion Code 1 : ",$P(CLA ,"~",1)," ",$$DSC^P SOREJU1(90 02313.25,$ P(CLA,"~", 1),.02)
15619	"RTN","PSO REJP1",340 ,0)
15620	I $P(CLA, "~",2)]"" W !,?6,"Su bmission C larificati on Code 2: ",$P(CLA, "~",2)," ",$$DSC^PS OREJU1(900 2313.25,$P (CLA,"~",2 ),.02)
15621	"RTN","PSO REJP1",341 ,0)
15622	I $P(CLA, "~",3)]"" W !,?6,"Su bmission C larificati on Code 3: ",$P(CLA, "~",3)," ",$$DSC^PS OREJU1(900 2313.25,$P (CLA,"~",3 ),.02)
15623	"RTN","PSO REJP1",342 ,0)
15624	W !,?6,"R eason for Service Co de 1 : ",$P($P( OVRSTR,"~" ,1),U,1)," ",$$DSC^ PSOREJU1(9 002313.23, $P($P(OVRS TR,"~",1), U,1),1)
15625	"RTN","PSO REJP1",343 ,0)
15626	W !,?6,"P rofessiona l Service Code 1 : ",$P($P( OVRSTR,"~" ,1),U,2)," ",$$DSC^ PSOREJU1(9 002313.21, $P($P(OVRS TR,"~",1), U,2),1)
15627	"RTN","PSO REJP1",344 ,0)
15628	W !,?6,"R esult of S ervice Cod e 1 : ",$P($P( OVRSTR,"~" ,1),U,3)," ",$$DSC^ PSOREJU1(9 002313.22, $P($P(OVRS TR,"~",1), U,3),1)
15629	"RTN","PSO REJP1",345 ,0)
15630	I $P($P(O VRSTR,"~", 2),U,1)]"" W !,?6,"R eason for Service Co de 2 : ",$P($P( OVRSTR,"~" ,2),U,1)," ",$$DSC^ PSOREJU1(9 002313.23, $P($P(OVRS TR,"~",2), U,1),1)
15631	"RTN","PSO REJP1",346 ,0)
15632	I $P($P(O VRSTR,"~", 2),U,2)]"" W !,?6,"P rofessiona l Service Code 2 : ",$P($P( OVRSTR,"~" ,2),U,2)," ",$$DSC^ PSOREJU1(9 002313.21, $P($P(OVRS TR,"~",2), U,2),1)
15633	"RTN","PSO REJP1",347 ,0)
15634	I $P($P(O VRSTR,"~", 2),U,3)]"" W !,?6,"R esult of S ervice Cod e 2 : ",$P($P( OVRSTR,"~" ,2),U,3)," ",$$DSC^ PSOREJU1(9 002313.22, $P($P(OVRS TR,"~",2), U,3),1)
15635	"RTN","PSO REJP1",348 ,0)
15636	I $P($P(O VRSTR,"~", 3),U,1)]"" W !,?6,"R eason for Service Co de 3 : ",$P($P( OVRSTR,"~" ,3),U,1)," ",$$DSC^ PSOREJU1(9 002313.23, $P($P(OVRS TR,"~",3), U,1),1)
15637	"RTN","PSO REJP1",349 ,0)
15638	I $P($P(O VRSTR,"~", 3),U,2)]"" W !,?6,"P rofessiona l Service Code 3 : ",$P($P( OVRSTR,"~" ,3),U,2)," ",$$DSC^ PSOREJU1(9 002313.21, $P($P(OVRS TR,"~",3), U,2),1)
15639	"RTN","PSO REJP1",350 ,0)
15640	I $P($P(O VRSTR,"~", 3),U,3)]"" W !,?6,"R esult of S ervice Cod e 3 : ",$P($P( OVRSTR,"~" ,3),U,3)," ",$$DSC^ PSOREJU1(9 002313.22, $P($P(OVRS TR,"~",3), U,3),1)
15641	"RTN","PSO REJP1",351 ,0)
15642	W ! D SEN D^PSOREJP3 (OVRSTR,CL A,PA,PSOET )
15643	"RTN","PSO REJP1",352 ,0)
15644	Q
15645	"RTN","PSO REJP1",353 ,0)
15646	;
15647	"RTN","PSO REJP1",354 ,0)
15648	VRX ; View ePharmacy Prescript ion - invo ked from t he Reject Informatio n screen
15649	"RTN","PSO REJP1",355 ,0)
15650	N BPSVRX
15651	"RTN","PSO REJP1",356 ,0)
15652	D FULL^VA LM1
15653	"RTN","PSO REJP1",357 ,0)
15654	S BPSVRX( "RXIEN")=$ G(RX)
15655	"RTN","PSO REJP1",358 ,0)
15656	S BPSVRX( "FILL#")=$ G(FILL)
15657	"RTN","PSO REJP1",359 ,0)
15658	D ^BPSVRX ; DBIA #5723
15659	"RTN","PSO REJP1",360 ,0)
15660	S VALMBCK ="R"
15661	"RTN","PSO REJP1",361 ,0)
15662	Q
15663	"RTN","PSO REJP1",362 ,0)
15664	;
15665	"RTN","PSO REJP1",363 ,0)
15666	VER ; View ePharmacy Prescript ion - invo ked from t he Rx view hidden ac tion of Me dication P rofile
15667	"RTN","PSO REJP1",364 ,0)
15668	N BPSVRX
15669	"RTN","PSO REJP1",365 ,0)
15670	K ^TMP("B PSVRX-PSO VIEW RX",$ J)
15671	"RTN","PSO REJP1",366 ,0)
15672	D FULL^VA LM1
15673	"RTN","PSO REJP1",367 ,0)
15674	;
15675	"RTN","PSO REJP1",368 ,0)
15676	; save th e current PSO Rx dis play array and heade r
15677	"RTN","PSO REJP1",369 ,0)
15678	M ^TMP("B PSVRX-PSO VIEW RX",$ J,"PSOHDR" )=^TMP("PS OHDR",$J)
15679	"RTN","PSO REJP1",370 ,0)
15680	M ^TMP("B PSVRX-PSO VIEW RX",$ J,"PSOAL") =^TMP("PSO AL",$J)
15681	"RTN","PSO REJP1",371 ,0)
15682	;
15683	"RTN","PSO REJP1",372 ,0)
15684	S BPSVRX( "RXIEN")=$ G(RXN) ; Rx ien p tr file 52
15685	"RTN","PSO REJP1",373 ,0)
15686	D ^BPSVRX ; DBIA #5723
15687	"RTN","PSO REJP1",374 ,0)
15688	;
15689	"RTN","PSO REJP1",375 ,0)
15690	; restore the PSO R x display array and header upo n return
15691	"RTN","PSO REJP1",376 ,0)
15692	I '$D(^TM P("PSOHDR" ,$J)) M ^T MP("PSOHDR ",$J)=^TMP ("BPSVRX-P SO VIEW RX ",$J,"PSOH DR")
15693	"RTN","PSO REJP1",377 ,0)
15694	I '$D(^TM P("PSOAL", $J)) M ^TM P("PSOAL", $J)=^TMP(" BPSVRX-PSO VIEW RX", $J,"PSOAL" )
15695	"RTN","PSO REJP1",378 ,0)
15696	;
15697	"RTN","PSO REJP1",379 ,0)
15698	S VALMBCK ="R"
15699	"RTN","PSO REJP1",380 ,0)
15700	K ^TMP("B PSVRX-PSO VIEW RX",$ J)
15701	"RTN","PSO REJP1",381 ,0)
15702	Q
15703	"RTN","PSO REJP1",382 ,0)
15704	;
15705	"RTN","PSO REJP1",383 ,0)
15706	REQ() ;Pro mpt if DUR Rejects a re require d
15707	"RTN","PSO REJP1",384 ,0)
15708	N DIR,DTO UT,DTOUT,D IRUT,DIROU T,X,Y
15709	"RTN","PSO REJP1",385 ,0)
15710	S DIR("?" )="Enter N o if Reaso n Codes ar e not requ ired. Ente r Yes to p roceed and enter up to 3 sets of overrid e Reason C odes. To d elete defa ult Reason Codes, en ter ""@"". "
15711	"RTN","PSO REJP1",386 ,0)
15712	S DIR("A" )="Enter D UR codes", DIR(0)="Y" ,DIR("B")= "YES" W ! D ^DIR
15713	"RTN","PSO REJP1",387 ,0)
15714	I $D(DIRU T)!$D(DIRO UT) Q "^" ;User exit ed or time d-out
15715	"RTN","PSO REJP1",388 ,0)
15716	Q Y
15717	"RTN","PSO REJU2")
15718	0^3^B63731 679
15719	"RTN","PSO REJU2",1,0 )
15720	PSOREJU2 ; BIRM/MFR - BPS (ECME ) - Clinic al Rejects Utilities (1) ;10/1 5/04
15721	"RTN","PSO REJU2",2,0 )
15722	;;7.0;OUT PATIENT PH ARMACY;1 48,260,287 ,341,290,3 58,359,385 ,403,421,4 27,478;D EC 1997;Bu ild 15
15723	"RTN","PSO REJU2",3,0 )
15724	;Referenc e to $$TAX ID^IBCEF75 supported by IA 676 8
15725	"RTN","PSO REJU2",4,0 )
15726	;Referenc e to $$DIV NCPDP^BPSB UTL suppor ted by IA 4719
15727	"RTN","PSO REJU2",5,0 )
15728	;Referenc e to File 9002313.23 - BPS NCP DP REASON FOR SERVIC E CODE sup ported by IA 4714
15729	"RTN","PSO REJU2",6,0 )
15730	;
15731	"RTN","PSO REJU2",7,0 )
15732	GET(RX,RFL ,REJDATA,R EJID,OKCL, CODE,RRRFL G) ; get r eject data from subf ile 52.25
15733	"RTN","PSO REJU2",8,0 )
15734	; Input: (r) RX - Rx IEN (# 52)
15735	"RTN","PSO REJU2",9,0 )
15736	; (o) RFL - Refill # (Default: most recen t)
15737	"RTN","PSO REJU2",10, 0)
15738	; (r) REJDA TA(REJECT IEN,FIELD) - Array w here these Reject fi elds will be returne d:
15739	"RTN","PSO REJU2",11, 0)
15740	; "BIN" - Payer B IN number
15741	"RTN","PSO REJU2",12, 0)
15742	; "PCN" - Process or Control Number
15743	"RTN","PSO REJU2",13, 0)
15744	; "CODE " - Reject Code (79 or 88)
15745	"RTN","PSO REJU2",14, 0)
15746	; "DATE /TIME" - D ATE/TIME R eject was detected
15747	"RTN","PSO REJU2",15, 0)
15748	; "PAYE R MESSAGE" - Message returned by the pay er
15749	"RTN","PSO REJU2",16, 0)
15750	; "REAS ON" - Reje ct Reason descriptio n (from pa yer)
15751	"RTN","PSO REJU2",17, 0)
15752	; "INSU RANCE NAME " - Patien t's Insura nce Compan y Name
15753	"RTN","PSO REJU2",18, 0)
15754	; "INSU RANCE POIN TER" - Pat ient Insur ance Compa ny Pointer
15755	"RTN","PSO REJU2",19, 0)
15756	; "COB" - Coordin ation of B enefits
15757	"RTN","PSO REJU2",20, 0)
15758	; "GROU P NAME" - Patient's Insurance Group Name
15759	"RTN","PSO REJU2",21, 0)
15760	; "GROU P NUMBER" - Patient' s Insuranc e Group Nu mber
15761	"RTN","PSO REJU2",22, 0)
15762	; "CARD HOLDER ID" - Patient 's Insuran ce Cardhol der ID
15763	"RTN","PSO REJU2",23, 0)
15764	; "PLAN CONTACT" - Plan's C ontact (eg ., "1-800- ...")
15765	"RTN","PSO REJU2",24, 0)
15766	; "PLAN PREVIOUS FILL DATE" - Last ti me Rx was paid by pa yer
15767	"RTN","PSO REJU2",25, 0)
15768	; "STAT US" - REJE CTS status ("OPEN/UN RESOLVED" or "CLOSED /RESOLVED" )
15769	"RTN","PSO REJU2",26, 0)
15770	; "DUR TEXT" - Pa yer's DUR descriptio n
15771	"RTN","PSO REJU2",27, 0)
15772	; "DUR ADD MSG TE XT" - Paye r's DUR ad ditional d escription
15773	"RTN","PSO REJU2",28, 0)
15774	; "OTHE R REJECTS" - Other R ejects on the same r esponse
15775	"RTN","PSO REJU2",29, 0)
15776	; "REAS ON SVC COD E" - Reaso n for Serv ice Code
15777	"RTN","PSO REJU2",30, 0)
15778	; If REJECT is closed, the follo wing field s will be returned:
15779	"RTN","PSO REJU2",31, 0)
15780	; "CLA CODE" - Cl arificatio n Code sub mitted
15781	"RTN","PSO REJU2",32, 0)
15782	; "PRIO R AUTH TYP E" - Prior Authoriza tion Type
15783	"RTN","PSO REJU2",33, 0)
15784	; "PRIO R AUTH NUM BER" - Pri or Authori zation Typ e
15785	"RTN","PSO REJU2",34, 0)
15786	; "CLOS ED DATE/TI ME" - DATE /TIME Reje ct was clo sed
15787	"RTN","PSO REJU2",35, 0)
15788	; "CLOS ED BY" - N ame of the user resp onsible fo r closing Reject
15789	"RTN","PSO REJU2",36, 0)
15790	; "CLOS E REASON" - Reason f or closing Reject (t ext)
15791	"RTN","PSO REJU2",37, 0)
15792	; "CLOS E COMMENTS " - User e ntered com ments at c lose
15793	"RTN","PSO REJU2",38, 0)
15794	; (o) REJID - REJECT IEN in the PRESCRIPT ION file f or retriev e this REJ ECT
15795	"RTN","PSO REJU2",39, 0)
15796	; (o) OKCL - If set t o 1, CLOSE D REJECTs will also be returne d
15797	"RTN","PSO REJU2",40, 0)
15798	; (o) CODE - Only REJ ECTs with this CODE should be returned
15799	"RTN","PSO REJU2",41, 0)
15800	; (o) RRRFL G - If set to 1 with CODE pres ent, also return Rej ect Resolu tion Requi red REJECT s
15801	"RTN","PSO REJU2",42, 0)
15802	; If set to 1 and CODE not p assed, the n only ret urn RRR RE JECTs
15803	"RTN","PSO REJU2",43, 0)
15804	;
15805	"RTN","PSO REJU2",44, 0)
15806	N REJS,AR RAY,REJFLD ,IDX,COM,Z
15807	"RTN","PSO REJU2",45, 0)
15808	;
15809	"RTN","PSO REJU2",46, 0)
15810	I '$D(RFL ) S RFL=$$ LSTRFL^PSO BPSU1(RX)
15811	"RTN","PSO REJU2",47, 0)
15812	;
15813	"RTN","PSO REJU2",48, 0)
15814	K REJDATA
15815	"RTN","PSO REJU2",49, 0)
15816	I '$O(^PS RX(RX,"REJ ",0)) Q
15817	"RTN","PSO REJU2",50, 0)
15818	;
15819	"RTN","PSO REJU2",51, 0)
15820	K REJS S RFL=+$G(RF L)
15821	"RTN","PSO REJU2",52, 0)
15822	I $G(REJI D) D
15823	"RTN","PSO REJU2",53, 0)
15824	. I +$P($ G(^PSRX(RX ,"REJ",REJ ID,0)),"^" ,4)'=RFL Q
15825	"RTN","PSO REJU2",54, 0)
15826	. I '$G(O KCL),$P($G (^PSRX(RX, "REJ",REJI D,0)),"^", 5) Q
15827	"RTN","PSO REJU2",55, 0)
15828	. S REJS( REJID)=""
15829	"RTN","PSO REJU2",56, 0)
15830	E D
15831	"RTN","PSO REJU2",57, 0)
15832	. S IDX=9 99
15833	"RTN","PSO REJU2",58, 0)
15834	. F S ID X=$O(^PSRX (RX,"REJ", IDX),-1) Q :'IDX D
15835	"RTN","PSO REJU2",59, 0)
15836	. . I +$P ($G(^PSRX( RX,"REJ",I DX,0)),"^" ,4)'=RFL Q
15837	"RTN","PSO REJU2",60, 0)
15838	. . I '$G (OKCL),$P( $G(^PSRX(R X,"REJ",ID X,0)),"^", 5) Q
15839	"RTN","PSO REJU2",61, 0)
15840	. . S REJ S(IDX)=""
15841	"RTN","PSO REJU2",62, 0)
15842	I '$D(REJ S) Q
15843	"RTN","PSO REJU2",63, 0)
15844	;
15845	"RTN","PSO REJU2",64, 0)
15846	S IDX=0
15847	"RTN","PSO REJU2",65, 0)
15848	F S IDX= $O(REJS(ID X)) Q:'IDX D
15849	"RTN","PSO REJU2",66, 0)
15850	. N SKIP
15851	"RTN","PSO REJU2",67, 0)
15852	. K ARRAY D GETS^DI Q(52.25,ID X_","_RX_" ,","*","", "ARRAY")
15853	"RTN","PSO REJU2",68, 0)
15854	. K REJFL D M REJFLD =ARRAY(52. 25,IDX_"," _RX_",")
15855	"RTN","PSO REJU2",69, 0)
15856	. ;
15857	"RTN","PSO REJU2",70, 0)
15858	. ; check CODE and RRRFLG to see if we want this reject dat a
15859	"RTN","PSO REJU2",71, 0)
15860	. S SKIP= 0 ; def ault is to include i t
15861	"RTN","PSO REJU2",72, 0)
15862	. I $G(CO DE)'="",RE JFLD(.01)' =CODE S SK IP=1 ; CODE exis ts and doe sn't match this reje ct
15863	"RTN","PSO REJU2",73, 0)
15864	. I SKIP, $G(RRRFLG) ,$G(REJFLD (30))="YES " S SKIP=0 ; but incl ude these if RRRFLG is true an d this is an RRR rej ect
15865	"RTN","PSO REJU2",74, 0)
15866	. I $G(CO DE)="",$G( RRRFLG),$G (REJFLD(30 ))'="YES" S SKIP=1 ; want only RRR rejec ts in this case
15867	"RTN","PSO REJU2",75, 0)
15868	. I SKIP Q ; get out if we 're skippi ng this on e
15869	"RTN","PSO REJU2",76, 0)
15870	. ;
15871	"RTN","PSO REJU2",77, 0)
15872	. S REJDA TA(IDX,"CO DE")=$G(RE JFLD(.01))
15873	"RTN","PSO REJU2",78, 0)
15874	. S REJDA TA(IDX,"DA TE/TIME")= $G(REJFLD( 1))
15875	"RTN","PSO REJU2",79, 0)
15876	. S REJDA TA(IDX,"PA YER MESSAG E")=$G(REJ FLD(2))
15877	"RTN","PSO REJU2",80, 0)
15878	. S REJDA TA(IDX,"RE ASON")=$G( REJFLD(3))
15879	"RTN","PSO REJU2",81, 0)
15880	. S REJDA TA(IDX,"PH ARMACIST") =$G(REJFLD (4))
15881	"RTN","PSO REJU2",82, 0)
15882	. S REJDA TA(IDX,"IN SURANCE NA ME")=$G(RE JFLD(20))
15883	"RTN","PSO REJU2",83, 0)
15884	. S REJDA TA(IDX,"IN SURANCE PO INTER")=$G (REJFLD(33 )) ;PSO*4 27
15885	"RTN","PSO REJU2",84, 0)
15886	. S REJDA TA(IDX,"CO B")=$G(REJ FLD(27))
15887	"RTN","PSO REJU2",85, 0)
15888	. S REJDA TA(IDX,"GR OUP NAME") =$G(REJFLD (6))
15889	"RTN","PSO REJU2",86, 0)
15890	. S REJDA TA(IDX,"GR OUP NUMBER ")=$G(REJF LD(21))
15891	"RTN","PSO REJU2",87, 0)
15892	. S REJDA TA(IDX,"BI N")=$G(REJ FLD(29))
15893	"RTN","PSO REJU2",88, 0)
15894	. S REJDA TA(IDX,"PC N")=$G(REJ FLD(34))
15895	"RTN","PSO REJU2",89, 0)
15896	. S REJDA TA(IDX,"CA RDHOLDER I D")=$G(REJ FLD(22))
15897	"RTN","PSO REJU2",90, 0)
15898	. S REJDA TA(IDX,"PL AN CONTACT ")=$G(REJF LD(7))
15899	"RTN","PSO REJU2",91, 0)
15900	. S REJDA TA(IDX,"PL AN PREVIOU S FILL DAT E")=$G(REJ FLD(8))
15901	"RTN","PSO REJU2",92, 0)
15902	. S REJDA TA(IDX,"ST ATUS")=$G( REJFLD(9))
15903	"RTN","PSO REJU2",93, 0)
15904	. S REJDA TA(IDX,"OT HER REJECT S")=$G(REJ FLD(17))
15905	"RTN","PSO REJU2",94, 0)
15906	. S REJDA TA(IDX,"DU R TEXT")=$ G(REJFLD(1 8))
15907	"RTN","PSO REJU2",95, 0)
15908	. S REJDA TA(IDX,"DU R ADD MSG TEXT")=$G( REJFLD(28) )
15909	"RTN","PSO REJU2",96, 0)
15910	. S REJDA TA(IDX,"RE ASON SVC C ODE")=$G(R EJFLD(14))
15911	"RTN","PSO REJU2",97, 0)
15912	. S REJDA TA(IDX,"RE SPONSE IEN ")=$G(REJF LD(16))
15913	"RTN","PSO REJU2",98, 0)
15914	. S REJDA TA(IDX,"RR R FLAG")=$ G(REJFLD(3 0)) ;PSO* 421
15915	"RTN","PSO REJU2",99, 0)
15916	. S REJDA TA(IDX,"RR R THRESHOL D AMT")=$G (REJFLD(31 )) ;PSO*4 21
15917	"RTN","PSO REJU2",100 ,0)
15918	. S REJDA TA(IDX,"RR R GROSS AM T DUE")=$G (REJFLD(32 )) ;PSO*4 21
15919	"RTN","PSO REJU2",101 ,0)
15920	. I '$G(O KCL) Q
15921	"RTN","PSO REJU2",102 ,0)
15922	. S REJDA TA(IDX,"CL OSED DATE/ TIME")=$G( REJFLD(10) )
15923	"RTN","PSO REJU2",103 ,0)
15924	. S REJDA TA(IDX,"CL OSED BY")= $G(REJFLD( 11))
15925	"RTN","PSO REJU2",104 ,0)
15926	. S REJDA TA(IDX,"CL OSE REASON ")=$G(REJF LD(12))
15927	"RTN","PSO REJU2",105 ,0)
15928	. S REJDA TA(IDX,"CL OSE COMMEN TS")=$G(RE JFLD(13))
15929	"RTN","PSO REJU2",106 ,0)
15930	. S REJDA TA(IDX,"CO D1")=$G(RE JFLD(14))
15931	"RTN","PSO REJU2",107 ,0)
15932	. S REJDA TA(IDX,"CO D2")=$G(RE JFLD(15))
15933	"RTN","PSO REJU2",108 ,0)
15934	. S REJDA TA(IDX,"CO D3")=$G(RE JFLD(19))
15935	"RTN","PSO REJU2",109 ,0)
15936	. S REJDA TA(IDX,"CL A CODE")=$ G(REJFLD(2 4))
15937	"RTN","PSO REJU2",110 ,0)
15938	. S REJDA TA(IDX,"PR IOR AUTH T YPE")=$G(R EJFLD(25))
15939	"RTN","PSO REJU2",111 ,0)
15940	. S REJDA TA(IDX,"PR IOR AUTH N UMBER")=$G (REJFLD(26 ))
15941	"RTN","PSO REJU2",112 ,0)
15942	. S COM=0 F S COM= $O(^PSRX(R X,"REJ",ID X,"COM",CO M)) Q:'COM D
15943	"RTN","PSO REJU2",113 ,0)
15944	. . S Z=^ PSRX(RX,"R EJ",IDX,"C OM",COM,0)
15945	"RTN","PSO REJU2",114 ,0)
15946	. . S REJ DATA(IDX," COMMENTS", COM,"DATE/ TIME")=$P( Z,"^")
15947	"RTN","PSO REJU2",115 ,0)
15948	. . S REJ DATA(IDX," COMMENTS", COM,"USER" )=$P(Z,"^" ,2)
15949	"RTN","PSO REJU2",116 ,0)
15950	. . S REJ DATA(IDX," COMMENTS", COM,"COMME NTS")=$P(Z ,"^",3)
15951	"RTN","PSO REJU2",117 ,0)
15952	Q
15953	"RTN","PSO REJU2",118 ,0)
15954	;
15955	"RTN","PSO REJU2",119 ,0)
15956	HELP(OPTS) ; Display the Help Text for t he DUR han dling opti ons (OVERR IDE/IGNORE /STOP/QUIT )
15957	"RTN","PSO REJU2",120 ,0)
15958	;
15959	"RTN","PSO REJU2",121 ,0)
15960	I OPTS["O " D
15961	"RTN","PSO REJU2",122 ,0)
15962	. W !?1," (O)verride - This op tion will provide th e prompts for the co de sets ne eded to"
15963	"RTN","PSO REJU2",123 ,0)
15964	. W !?1," overrid e this rej ect and ge t a payabl e 3rd part y claim. B efore"
15965	"RTN","PSO REJU2",124 ,0)
15966	. W !?1," you sel ect this o ption, you may need to call th e 3rd part y payer"
15967	"RTN","PSO REJU2",125 ,0)
15968	. W !?1," to dete rmine whic h code set s are need ed to over ride a par ticular"
15969	"RTN","PSO REJU2",126 ,0)
15970	. W !?1," reject. Once the proper ove rride is a ccepted th e label wi ll print"
15971	"RTN","PSO REJU2",127 ,0)
15972	. W !?1," and the prescript ion can be filled."
15973	"RTN","PSO REJU2",128 ,0)
15974	;
15975	"RTN","PSO REJU2",129 ,0)
15976	I OPTS["I " D
15977	"RTN","PSO REJU2",130 ,0)
15978	. W !?1," (I)gnore - Choosin g Ignore w ill by-pas s 3rd part y processi ng and wil l allow"
15979	"RTN","PSO REJU2",131 ,0)
15980	. W !?1," you to print a la bel and fi ll the pre scription. This esse ntially"
15981	"RTN","PSO REJU2",132 ,0)
15982	. W !?1," ignores the clini cal safety issues su ggested by the 3rd p arty"
15983	"RTN","PSO REJU2",133 ,0)
15984	. W !?1," payer a nd will NO T result i n a payabl e claim."
15985	"RTN","PSO REJU2",134 ,0)
15986	;
15987	"RTN","PSO REJU2",135 ,0)
15988	I OPTS["Q " D
15989	"RTN","PSO REJU2",136 ,0)
15990	. W !?1," (Q)uit - Choosin g Quit wil l postpone the proce ssing of t his prescr iption"
15991	"RTN","PSO REJU2",137 ,0)
15992	. W !?1," until t his 3rd pa rty reject is resolv ed. A labe l will not be"
15993	"RTN","PSO REJU2",138 ,0)
15994	. W !?1," printed for this prescripti on and it can not be filled/di spensed"
15995	"RTN","PSO REJU2",139 ,0)
15996	. W !?1," until t his reject is resolv ed. Reject s can be r esolved th rough"
15997	"RTN","PSO REJU2",140 ,0)
15998	. W !?1," the Wor klist opti on under t he ePharma cy menu."
15999	"RTN","PSO REJU2",141 ,0)
16000	Q
16001	"RTN","PSO REJU2",142 ,0)
16002	;
16003	"RTN","PSO REJU2",143 ,0)
16004	DVINFO(RX, RFL,LM) ; Returns he ader displ ayable Div ision Info rmation
16005	"RTN","PSO REJU2",144 ,0)
16006	;Input: ( r) RX - Rx IEN (#5 2)
16007	"RTN","PSO REJU2",145 ,0)
16008	; ( o) RFL - Refill # ( Default: m ost recent )
16009	"RTN","PSO REJU2",146 ,0)
16010	; ( o) LM - ListManage r format? (1 - Yes / 0 - No) - Default: 0
16011	"RTN","PSO REJU2",147 ,0)
16012	N TXT,DVI NFO,NCPNPI ,DVIEN,PSO TAXID
16013	"RTN","PSO REJU2",148 ,0)
16014	S DVIEN=+ $$RXSITE^P SOBPSUT(RX ,RFL)
16015	"RTN","PSO REJU2",149 ,0)
16016	S DVINFO= "Division : "_$E($$G ET1^DIQ(59 ,DVIEN,.01 ),1,15)
16017	"RTN","PSO REJU2",150 ,0)
16018	;Display both NPI a nd NCPDP n umbers - P SO7.0421
16019	"RTN","PSO REJU2",151 ,0)
16020	S NCPNPI= $$DIVNCPDP ^BPSBUTL(D VIEN)
16021	"RTN","PSO REJU2",152 ,0)
16022	S $E(DVIN FO,28)="NP I: "_$P(NC PNPI,U,2)
16023	"RTN","PSO REJU2",153 ,0)
16024	S $E(DVIN FO,44)="NC PDP: "_$P( NCPNPI,U)
16025	"RTN","PSO REJU2",154 ,0)
16026	S PSOTAXI D=$P($$TAX ID^IBCEF75 ,U,2) ; IA 6768
16027	"RTN","PSO REJU2",155 ,0)
16028	S $E(DVIN FO,62)="TA X ID: "_$E (PSOTAXID, 1,2)_"-"_$ E(PSOTAXID ,3,$L(PSOT AXID))
16029	"RTN","PSO REJU2",156 ,0)
16030	Q DVINFO
16031	"RTN","PSO REJU2",157 ,0)
16032	;
16033	"RTN","PSO REJU2",158 ,0)
16034	PTINFO(RX, LM) ; Retu rns header displayab le Patient Informati on
16035	"RTN","PSO REJU2",159 ,0)
16036	;Input: ( r) RX - Rx IEN (#5 2)
16037	"RTN","PSO REJU2",160 ,0)
16038	; ( o) LM - ListManage r format? (1 - Yes / 0 - No) - Default: 0
16039	"RTN","PSO REJU2",161 ,0)
16040	N DFN,VAD M,PTINFO,S SN4
16041	"RTN","PSO REJU2",162 ,0)
16042	S DFN=$$G ET1^DIQ(52 ,RX,2,"I") D DEM^VAD PT S SSN4= $P($G(VADM (2)),"^",2 )
16043	"RTN","PSO REJU2",163 ,0)
16044	S PTINFO= "Patient : "_$E($G( VADM(1)),1 ,$S($G(LM) :24,1:20)) _"("_$E(SS N4,$L(SSN4 )-3,$L(SSN 4))_")"
16045	"RTN","PSO REJU2",164 ,0)
16046	S PTINFO= PTINFO_" Sex: "_$P( $G(VADM(5) ),"^")
16047	"RTN","PSO REJU2",165 ,0)
16048	S $E(PTIN FO,$S($G(L M):61,1:54 ))="DOB: " _$P($G(VAD M(3)),"^", 2)_"("_$P( $G(VADM(4) ),"^")_")"
16049	"RTN","PSO REJU2",166 ,0)
16050	Q PTINFO
16051	"RTN","PSO REJU2",167 ,0)
16052	;
16053	"RTN","PSO REJU2",168 ,0)
16054	RETRXF(RX, RFL,ONOFF) ; - Set/R eset the R e-transmis sion flag
16055	"RTN","PSO REJU2",169 ,0)
16056	;Input: ( r) RX - Rx IEN (# 52)
16057	"RTN","PSO REJU2",170 ,0)
16058	; ( r) RFL - Refill IE N (#52.1)
16059	"RTN","PSO REJU2",171 ,0)
16060	; ( o) ONOFF - Turn flag ON or OFF (1 - ON / 0 - OFF) (Default: OFF)
16061	"RTN","PSO REJU2",172 ,0)
16062	I RFL>0,' $D(^PSRX(R X,1,RFL,0) ) QUIT
16063	"RTN","PSO REJU2",173 ,0)
16064	N DA,DIE, DR
16065	"RTN","PSO REJU2",174 ,0)
16066	S DR="82/ //"_$S($G( ONOFF):"YE S",1:"@")
16067	"RTN","PSO REJU2",175 ,0)
16068	I 'RFL S DA=RX,DIE= "^PSRX("
16069	"RTN","PSO REJU2",176 ,0)
16070	I RFL S D A(1)=RX,DA =RFL,DIE=" ^PSRX("_RX _",1,"
16071	"RTN","PSO REJU2",177 ,0)
16072	D ^DIE
16073	"RTN","PSO REJU2",178 ,0)
16074	Q
16075	"RTN","PSO REJU2",179 ,0)
16076	;
16077	"RTN","PSO REJU2",180 ,0)
16078	REASON(TXT ) ; Extrac ts the Rea son for se rvice code from the REASON tex t field
16079	"RTN","PSO REJU2",181 ,0)
16080	; Input: (r) TXT - Reason te xt (e.g., NN Reason for Servic e Code Tex t)
16081	"RTN","PSO REJU2",182 ,0)
16082	;Output: REASON - NN (if on valid and on file ( #9002313.2 3), null o therwise)
16083	"RTN","PSO REJU2",183 ,0)
16084	N REASON, DIC,X,Y
16085	"RTN","PSO REJU2",184 ,0)
16086	S REASON= $P(TXT," " ) I $L(REA SON)'=2 Q ""
16087	"RTN","PSO REJU2",185 ,0)
16088	S DIC=900 2313.23,X= REASON D ^ DIC I Y<0 Q ""
16089	"RTN","PSO REJU2",186 ,0)
16090	Q REASON
16091	"RTN","PSO REJU2",187 ,0)
16092	;
16093	"RTN","PSO REJU2",188 ,0)
16094	SETOPN(RX, REJ) ; - S et the Rej ect RE-OPE NED flag t o YES
16095	"RTN","PSO REJU2",189 ,0)
16096	;Input: ( r) RX - Rx IEN (# 52)
16097	"RTN","PSO REJU2",190 ,0)
16098	; ( r) REJ - Reject IE N (#52.25)
16099	"RTN","PSO REJU2",191 ,0)
16100	;
16101	"RTN","PSO REJU2",192 ,0)
16102	I '$D(^PS RX(RX,"REJ ",REJ)) Q
16103	"RTN","PSO REJU2",193 ,0)
16104	N DIE,DA, DR
16105	"RTN","PSO REJU2",194 ,0)
16106	S DIE="^P SRX("_RX_" ,""REJ""," ,DA(1)=RX, DA=REJ,DR= "23///YES" D ^DIE
16107	"RTN","PSO REJU2",195 ,0)
16108	Q
16109	"RTN","PSO REJU2",196 ,0)
16110	;
16111	"RTN","PSO REJU2",197 ,0)
16112	PRT(FIELD, P,L) ; Set s the line s for fiel ds that re quire text wrapping
16113	"RTN","PSO REJU2",198 ,0)
16114	;Input: F IELD - Sub script nam e from the DATA(REJ, FIELD) arr ay
16115	"RTN","PSO REJU2",199 ,0)
16116	; P - Pos ition wher e the cont ent should be printe d
16117	"RTN","PSO REJU2",200 ,0)
16118	; L - Len ght of the text on e ach line
16119	"RTN","PSO REJU2",201 ,0)
16120	N TXT,I
16121	"RTN","PSO REJU2",202 ,0)
16122	S TXT=DAT A(REJ,FIEL D) I $L(TX T)'>L W ?P ,TXT Q
16123	"RTN","PSO REJU2",203 ,0)
16124	F I=1:1 Q :TXT="" D
16125	"RTN","PSO REJU2",204 ,0)
16126	. I I=1 W ?P,$E(TXT ,1,L),! S TXT=$E(TXT ,L+1,999) Q
16127	"RTN","PSO REJU2",205 ,0)
16128	. W ?P,$E (TXT,1,L) S TXT=$E(T XT,L+1,999 ) W:TXT'=" " !
16129	"RTN","PSO REJU2",206 ,0)
16130	Q
16131	"RTN","PSO REJU2",207 ,0)
16132	;
16133	"RTN","PSO REJU2",208 ,0)
16134	PA() ; - A sk for Pri or Authori zation Typ e and Numb er
16135	"RTN","PSO REJU2",209 ,0)
16136	; Called by PA^PSOR EJP1 (PA a cton) and SMA^PSOREJ P1 (SMA ac tion)
16137	"RTN","PSO REJU2",210 ,0)
16138	;
16139	"RTN","PSO REJU2",211 ,0)
16140	;Output:( PAT^PAN) P AT - Prior Authoriza tion Type
16141	"RTN","PSO REJU2",212 ,0)
16142	; ( See DD Fil e #9002313 .26 for po ssible val ues)
16143	"RTN","PSO REJU2",213 ,0)
16144	; P AN - Prior Authoriza tion Numbe r (11 digi ts)
16145	"RTN","PSO REJU2",214 ,0)
16146	;
16147	"RTN","PSO REJU2",215 ,0)
16148	N DIC,DIR ,DIROUT,DI RUT,DTOUT, DUOUT,PAN, PAT,X,Y
16149	"RTN","PSO REJU2",216 ,0)
16150	S DIC("B" )=0
16151	"RTN","PSO REJU2",217 ,0)
16152	S DIC(0)= "QEAM",DIC =9002313.2 6,DIC("A") ="Prior Au thorizatio n Type: "
16153	"RTN","PSO REJU2",218 ,0)
16154	D ^DIC
16155	"RTN","PSO REJU2",219 ,0)
16156	I ($D(DUO UT))!($D(D TOUT))!(Y= -1) Q "^" ;Check fo r "^" or t imeout
16157	"RTN","PSO REJU2",220 ,0)
16158	S PAT=$P( Y,U,2)
16159	"RTN","PSO REJU2",221 ,0)
16160	;
16161	"RTN","PSO REJU2",222 ,0)
16162	K DIR,DIC ,X,Y
16163	"RTN","PSO REJU2",223 ,0)
16164	S DIR(0)= "52.25,26" ,DIR("A")= "Prior Aut horization Number"
16165	"RTN","PSO REJU2",224 ,0)
16166	S DIR("?" )="^D PANH LP^PSOREJU 2",DIR("?? ")=""
16167	"RTN","PSO REJU2",225 ,0)
16168	D ^DIR I (Y["^")!$D (DTOUT) Q "^"
16169	"RTN","PSO REJU2",226 ,0)
16170	S PAN=Y
16171	"RTN","PSO REJU2",227 ,0)
16172	Q (PAT_"^ "_PAN)
16173	"RTN","PSO REJU2",228 ,0)
16174	;
16175	"RTN","PSO REJU2",229 ,0)
16176	PANHLP ; P rior Autho rization N umber Help
16177	"RTN","PSO REJU2",230 ,0)
16178	W "OR you may leave it blank if the cla im does no t require a number."
16179	"RTN","PSO REJU2",231 ,0)
16180	Q
16181	"RTN","PSO REJU3")
16182	0^2^B98042 345
16183	"RTN","PSO REJU3",1,0 )
16184	PSOREJU3 ; BIRM/LJE - BPS (ECME ) - Clinic al Rejects Utilities (3) ;04/2 5/08
16185	"RTN","PSO REJU3",2,0 )
16186	;;7.0;OUT PATIENT PH ARMACY;2 87,290,358 ,359,385,4 21,427,448 ,478;DEC 1997;Buil d 15
16187	"RTN","PSO REJU3",3,0 )
16188	;Referenc es to 9002 313.99 sup ported by IA 4305
16189	"RTN","PSO REJU3",4,0 )
16190	;Referenc e to $$CLA IM^BPSBUTL supported by IA 471 9
16191	"RTN","PSO REJU3",5,0 )
16192	;Referenc e to LOG^B PSOSL supp orted by I CR# 6764
16193	"RTN","PSO REJU3",6,0 )
16194	;Referenc e to IEN59 ^BPSOSRX s upported b y ICR# 441 2
16195	"RTN","PSO REJU3",7,0 )
16196	;
16197	"RTN","PSO REJU3",8,0 )
16198	Q
16199	"RTN","PSO REJU3",9,0 )
16200	;
16201	"RTN","PSO REJU3",10, 0)
16202	TRICCHK(RX ,RFL,RESP, FROM,RVTX) ;check to see if Rx is non-bi llable or in an "In Progress" state on E CME
16203	"RTN","PSO REJU3",11, 0)
16204	; Input: (r) RX - Rx IEN (# 52)
16205	"RTN","PSO REJU3",12, 0)
16206	; (r) RFL - REFILL
16207	"RTN","PSO REJU3",13, 0)
16208	; (o) RESP - Response from $$EN ^BPSNCPDP api
16209	"RTN","PSO REJU3",14, 0)
16210	; TRICC HK assumes that the calling ro utine has validated that the f ill is TRI CARE or CH AMPVA.
16211	"RTN","PSO REJU3",15, 0)
16212	;
16213	"RTN","PSO REJU3",16, 0)
16214	; - \Nee d to be mi ndful of f oreground and backgr ound proce ssing.
16215	"RTN","PSO REJU3",17, 0)
16216	;
16217	"RTN","PSO REJU3",18, 0)
16218	N ESTAT,E TOUT,NFROM ,PSOBEI
16219	"RTN","PSO REJU3",19, 0)
16220	I '$D(FRO M) S FROM= ""
16221	"RTN","PSO REJU3",20, 0)
16222	S ESTAT=$ P(RESP,"^" ,4)
16223	"RTN","PSO REJU3",21, 0)
16224	S NFROM=0
16225	"RTN","PSO REJU3",22, 0)
16226	I FROM="P L"!(FROM=" PC") S NFR OM=1
16227	"RTN","PSO REJU3",23, 0)
16228	Q:ESTAT[" PAYABLE"!( ESTAT["REJ ECTED")
16229	"RTN","PSO REJU3",24, 0)
16230	S PSOBEI= $$ELIGDISP ^PSOREJP1( RX,RFL)
16231	"RTN","PSO REJU3",25, 0)
16232	;
16233	"RTN","PSO REJU3",26, 0)
16234	D LOG^BPS OSL($$IEN5 9^BPSOSRX( RX,RFL),$T (+0)_"-TRI CCHK, ESTA T="_ESTAT) ; ICR#s 4412,6764
16235	"RTN","PSO REJU3",27, 0)
16236	I ESTAT[" IN PROGRES S",FROM="P C" D LOG^B PSOSL($$IE N59^BPSOSR X(RX,RFL), $T(+0)_"-W ould have noted in A ctivity Lo g that Rx was left i n CMOP sus pense") Q ; ICR#s 4 412,6764
16237	"RTN","PSO REJU3",28, 0)
16238	;
16239	"RTN","PSO REJU3",29, 0)
16240	I ESTAT[" IN PROGRES S",FROM="R RL"!($G(RV TX)="RX RE LEASE-NDC CHANGE") D Q
16241	"RTN","PSO REJU3",30, 0)
16242	. I 'NFRO M D
16243	"RTN","PSO REJU3",31, 0)
16244	. . W !!, PSOBEI_" P rescriptio n "_$$GET1 ^DIQ(52,RX ,".01")_" cannot be released u ntil ECME 'IN PROGRE SS'"
16245	"RTN","PSO REJU3",32, 0)
16246	. . W !," status is resolved p ayable.",! !
16247	"RTN","PSO REJU3",33, 0)
16248	;
16249	"RTN","PSO REJU3",34, 0)
16250	I $D(RESP ) D Q
16251	"RTN","PSO REJU3",35, 0)
16252	. I +RESP =6 W:'NFRO M&('$G(CMO P)) !!,"In active ECM E "_PSOBEI ,!! D Q
16253	"RTN","PSO REJU3",36, 0)
16254	. . S ACT ="Inactive ECME "_PS OBEI D RXA CT^PSOBPSU 2(RX,RFL,A CT,"M",DUZ )
16255	"RTN","PSO REJU3",37, 0)
16256	. I +RESP =2!(+RESP= 3) N PSONB ILL S PSON BILL=1 D T RIC2 Q
16257	"RTN","PSO REJU3",38, 0)
16258	. I +RESP =4!(ESTAT[ "IN PROGRE SS") N PSO NPROG S PS ONPROG=1 D TRIC2 Q
16259	"RTN","PSO REJU3",39, 0)
16260	Q
16261	"RTN","PSO REJU3",40, 0)
16262	;
16263	"RTN","PSO REJU3",41, 0)
16264	TRIC2 ;
16265	"RTN","PSO REJU3",42, 0)
16266	N ACTION, REJCOD,REJ ,DIR,DIRUT ,REA,DA,PS CAN,PSOTRI C,ZZZ
16267	"RTN","PSO REJU3",43, 0)
16268	S PSOTRIC =1,REJ=999 9999999
16269	"RTN","PSO REJU3",44, 0)
16270	I $G(CMOP )&($G(PSON PROG)) D T ACT Q
16271	"RTN","PSO REJU3",45, 0)
16272	Q:$G(CMOP )
16273	"RTN","PSO REJU3",46, 0)
16274	I 'NFROM D DISPLAY( RX,REJ)
16275	"RTN","PSO REJU3",47, 0)
16276	I 'NFROM& ($G(PSONPR OG)) D D SUSP Q
16277	"RTN","PSO REJU3",48, 0)
16278	. W !!,"T his prescr iption wil l be suspe nded. Aft er the thi rd party c laim is re solved,"
16279	"RTN","PSO REJU3",49, 0)
16280	. W !,"it may be pr inted or p ulled earl y from sus pense.",!
16281	"RTN","PSO REJU3",50, 0)
16282	. R !!,"P ress <RETU RN> to con tinue...", ZZZ:60,!
16283	"RTN","PSO REJU3",51, 0)
16284	I NFROM&( $G(PSONPRO G)) D TACT Q
16285	"RTN","PSO REJU3",52, 0)
16286	Q:NFROM
16287	"RTN","PSO REJU3",53, 0)
16288	TRIC3 ;
16289	"RTN","PSO REJU3",54, 0)
16290	D MSG
16291	"RTN","PSO REJU3",55, 0)
16292	I FROM="P L"!(FROM=" PC") D SUS P Q
16293	"RTN","PSO REJU3",56, 0)
16294	;cnf, PSO 7358, ad d code for options
16295	"RTN","PSO REJU3",57, 0)
16296	N ACTION, DIR,DIRUT, OPTS,DEF,C OM
16297	"RTN","PSO REJU3",58, 0)
16298	TRIC4 S DI R(0)="SO^" ,DIR("A")= "",OPTS="D Q",DEF="D"
16299	"RTN","PSO REJU3",59, 0)
16300	N PSORESP
16301	"RTN","PSO REJU3",60, 0)
16302	S PSORESP =$P($G(RES P),U,2)
16303	"RTN","PSO REJU3",61, 0)
16304	I PSORESP ["NO ACTIV E/VALID RO I" S DEF=" Q" ;IB ro utine IBNC PDP1 conta ins this t ext.
16305	"RTN","PSO REJU3",62, 0)
16306	;referenc e to ^XUSE C( support ed by IA 1 0076
16307	"RTN","PSO REJU3",63, 0)
16308	I $D(^XUS EC("PSO TR ICARE/CHAM PVA",DUZ)) S OPTS=OP TS_"I" ;PS O7.0358, if user h as securit y key, inc lude IGNOR E in TRICA RE/CHAMPVA options
16309	"RTN","PSO REJU3",64, 0)
16310	S:(OPTS[" D") DIR(0) =DIR(0)_"D :(D)iscont inue - DO NOT FILL P RESCRIPTIO N;",DIR("A ")=DIR("A" )_"(D)isco ntinue,"
16311	"RTN","PSO REJU3",65, 0)
16312	S:(OPTS[" Q") DIR(0) =DIR(0)_"Q :(Q)UIT - SEND TO WO RKLIST (RE QUIRES INT ERVENTION) ;",DIR("A" )=DIR("A") _"(Q)uit,"
16313	"RTN","PSO REJU3",66, 0)
16314	S:(OPTS[" I") DIR(0) =DIR(0)_"I :(I)GNORE - FILL Rx WITHOUT CL AIM SUBMIS SION;",DIR ("A")=DIR( "A")_"(I)g nore,"
16315	"RTN","PSO REJU3",67, 0)
16316	S $E(DIR( 0),$L(DIR( 0)))="",$E (DIR("A"), $L(DIR("A" )))="",DIR ("??")="^D HELP^PSOR EJU2("""_O PTS_""")"
16317	"RTN","PSO REJU3",68, 0)
16318	S:$G(DEF) '="" DIR(" B")=DEF D ^DIR I $D( DIRUT) S Y ="Q" W !
16319	"RTN","PSO REJU3",69, 0)
16320	;
16321	"RTN","PSO REJU3",70, 0)
16322	S ACTION= Y
16323	"RTN","PSO REJU3",71, 0)
16324	I ACTION= "D" S ACTI ON=$$DC^PS OREJU1(RX, ACTION) ;cnf, PSO 7358
16325	"RTN","PSO REJU3",72, 0)
16326	I ACTION= "Q" D WRKL ST^PSOREJU 4(RX,RFL,, DUZ,DT,1," ",RESP) ;cnf, PSO 7358
16327	"RTN","PSO REJU3",73, 0)
16328	I ACTION= "I" G TRIC 4:'$$CONT^ PSOREJU1() S COM=$$T COM^PSOREJ P3(RX,RFL) G TRIC4:C OM="^" G T RIC4:'$$SI G^PSOREJU1 () D
16329	"RTN","PSO REJU3",74, 0)
16330	. D CLOSE ^PSOREJUT( RX,RFL,REJ ,DUZ,6,COM ) ;TRICA RE/CHAMPVA non-billa ble should have only 1 reject - eT/eC
16331	"RTN","PSO REJU3",75, 0)
16332	. D AUDIT ^PSOTRI(RX ,RFL,,COM, $S($$PSOET ^PSOREJP3( RX,RFL):"N ",1:"R"),$ P(RESP,"^" ,3))
16333	"RTN","PSO REJU3",76, 0)
16334	Q
16335	"RTN","PSO REJU3",77, 0)
16336	;
16337	"RTN","PSO REJU3",78, 0)
16338	MSG ;
16339	"RTN","PSO REJU3",79, 0)
16340	W !!,"Thi s is a non -billable "_$$ELIGDI SP^PSOREJP 1(RX,RFL)_ " prescrip tion." ;cnf, PSO* 7*358
16341	"RTN","PSO REJU3",80, 0)
16342	Q
16343	"RTN","PSO REJU3",81, 0)
16344	SUSP ;Susp ense Rx du e to IN PR OGRESS sta tus in ECM E
16345	"RTN","PSO REJU3",82, 0)
16346	N DA,ACT, RX0,SD,RXS ,PSOWFLG,D IK,RXN,XFL AG,RXP,DD, DO,X,Y,DIC ,VALMSG,CO MM,LFD,DFL G,RXCMOP
16347	"RTN","PSO REJU3",83, 0)
16348	N PSOQFLA G,PSORXZD, PSOQFLAG,P SOKSPPL,PS OZXPPL,PSO ZXPI,RXLTO P
16349	"RTN","PSO REJU3",84, 0)
16350	S DA=RX D SUS^PSORX L1
16351	"RTN","PSO REJU3",85, 0)
16352	TACT ;
16353	"RTN","PSO REJU3",86, 0)
16354	S ACT=$$E LIGDISP^PS OREJP1(RX, RFL)_"-Rx placed on Suspense d ue to"_$S( $G(PSONPRO G):" ECME IN PROGRES S status", $G(PSONBIL L):"the Rx being Non -billable" ,1:"")
16355	"RTN","PSO REJU3",87, 0)
16356	I '$G(DUZ ) N DUZ S DUZ=.5
16357	"RTN","PSO REJU3",88, 0)
16358	D RXACT^P SOBPSU2(RX ,RFL,ACT," M",DUZ)
16359	"RTN","PSO REJU3",89, 0)
16360	Q
16361	"RTN","PSO REJU3",90, 0)
16362	;
16363	"RTN","PSO REJU3",91, 0)
16364	DISPLAY(RX ,REJ,KEY,R RR) ; - Di splays REJ ECT inform ation
16365	"RTN","PSO REJU3",92, 0)
16366	; Input: (r) RX - Rx IEN (# 52)
16367	"RTN","PSO REJU3",93, 0)
16368	; (r) REJ - REJECT ID (IEN)
16369	"RTN","PSO REJU3",94, 0)
16370	; (o) KEY - Display " Press any KEY to con tinue..." (1-YES/0-N O) (Defaul t: 0)
16371	"RTN","PSO REJU3",95, 0)
16372	; (o) RRR - Reject Re solution R equired in formation Flag(0/1) ^Threshold Amt^Gross Amt Due (Default: 0)
16373	"RTN","PSO REJU3",96, 0)
16374	; If Flag = 0, there is no Reje ct Resolut ion Requir ed reject code. Par ameter add ed with PS O*421
16375	"RTN","PSO REJU3",97, 0)
16376	;
16377	"RTN","PSO REJU3",98, 0)
16378	Q:$G(NFRO M)
16379	"RTN","PSO REJU3",99, 0)
16380	I '$G(RX) !'$G(REJ) Q
16381	"RTN","PSO REJU3",100 ,0)
16382	I '$D(^PS RX(RX,"REJ ",REJ))&(' $G(PSONBIL L))&('$G(P SONPROG)) Q
16383	"RTN","PSO REJU3",101 ,0)
16384	;
16385	"RTN","PSO REJU3",102 ,0)
16386	N DATA,RF L,LINE,%
16387	"RTN","PSO REJU3",103 ,0)
16388	S RFL=+$$ GET1^DIQ(5 2.25,REJ_" ,"_RX,5)
16389	"RTN","PSO REJU3",104 ,0)
16390	I '$G(PSO NBILL)&('$ G(PSONPROG )) D GET^P SOREJU2(RX ,RFL,.DATA ,REJ) I '$ D(DATA(REJ )) Q
16391	"RTN","PSO REJU3",105 ,0)
16392	;
16393	"RTN","PSO REJU3",106 ,0)
16394	D HDR
16395	"RTN","PSO REJU3",107 ,0)
16396	S $P(LINE ,"-",74)=" " W !?3,LI NE
16397	"RTN","PSO REJU3",108 ,0)
16398	W !?3,$$D VINFO(RX,R FL)
16399	"RTN","PSO REJU3",109 ,0)
16400	W !?3,$$P TINFO^PSOR EJU2(RX)
16401	"RTN","PSO REJU3",110 ,0)
16402	W !?3,"Rx /Drug : " ,$$GET1^DI Q(52,RX,.0 1),"/",RFL ," - ",$E( $$GET1^DIQ (52,RX,6), 1,20),?54
16403	"RTN","PSO REJU3",111 ,0)
16404	W:'$G(PSO NBILL)&('$ G(PSONPROG )) "ECME#: ",$P($$CL AIM^BPSBUT L(RX,RFL), U,6)
16405	"RTN","PSO REJU3",112 ,0)
16406	D TYPE G DISP2:$G(P SONBILL)!( $G(PSONPRO G))
16407	"RTN","PSO REJU3",113 ,0)
16408	I $G(DATA (REJ,"PAYE R MESSAGE" ))'="" W ! ?3,"Payer Message: " D PRT^PSO REJU2("PAY ER MESSAGE ",18,58)
16409	"RTN","PSO REJU3",114 ,0)
16410	I $G(DATA (REJ,"DUR TEXT"))'=" " W !?3,"D UR Text : ",DATA (REJ,"DUR TEXT")
16411	"RTN","PSO REJU3",115 ,0)
16412	W !?3,"In surance : ",DATA( REJ,"INSUR ANCE NAME" ),?50,"Con tact: ",DA TA(REJ,"PL AN CONTACT ")
16413	"RTN","PSO REJU3",116 ,0)
16414	W !?3,"Gr oup Name : ",DATA( REJ,"GROUP NAME"),?4 5,"Group N umber: ",D ATA(REJ,"G ROUP NUMBE R")
16415	"RTN","PSO REJU3",117 ,0)
16416	I $G(DATA (REJ,"CARD HOLDER ID" ))'="" W ! ?3,"Cardho lder ID: " ,DATA(REJ, "CARDHOLDE R ID")
16417	"RTN","PSO REJU3",118 ,0)
16418	I DATA(RE J,"PLAN PR EVIOUS FIL L DATE")'= "" D
16419	"RTN","PSO REJU3",119 ,0)
16420	. W !?3," Last Fill Dt.: ",DAT A(REJ,"PLA N PREVIOUS FILL DATE ")
16421	"RTN","PSO REJU3",120 ,0)
16422	. W:DATA( REJ,"PLAN PREVIOUS F ILL DATE") '="" " ( from payer )"
16423	"RTN","PSO REJU3",121 ,0)
16424	I $G(RRR) D ;adde d with PSO *421
16425	"RTN","PSO REJU3",122 ,0)
16426	. W !!?3, "Reject Re solution R equired"
16427	"RTN","PSO REJU3",123 ,0)
16428	. W !?3," Gross Amou nt Due ($" _$J($P(RRR ,U,3)*100\ 1/100,0,2) _") is gre ater than or equal t o"
16429	"RTN","PSO REJU3",124 ,0)
16430	. W !?3," Threshold Dollar Amo unt ($"_$P (RRR,U,2)_ ")"
16431	"RTN","PSO REJU3",125 ,0)
16432	. W !?3," Please sel ect Quit t o resolve this rejec t on the R eject Work list."
16433	"RTN","PSO REJU3",126 ,0)
16434	DISP2 ;
16435	"RTN","PSO REJU3",127 ,0)
16436	W !?3,LIN E,$C(7) I $G(KEY) W !?3,"Press <RETURN> to continu e..." R %: DTIME W !
16437	"RTN","PSO REJU3",128 ,0)
16438	Q
16439	"RTN","PSO REJU3",129 ,0)
16440	;
16441	"RTN","PSO REJU3",130 ,0)
16442	TYPE ;
16443	"RTN","PSO REJU3",131 ,0)
16444	I $G(PSON BILL)!($G( PSONPROG)) D Q
16445	"RTN","PSO REJU3",132 ,0)
16446	. D NOW^% DTC S Y=% D DD^%DT
16447	"RTN","PSO REJU3",133 ,0)
16448	. W !?3," Date/Time: "_$$FMTE^ XLFDT(Y)
16449	"RTN","PSO REJU3",134 ,0)
16450	. W !?3," Reason : ",$S($G(P SONBILL):" Drug not b illable.", $G(PSONPRO G):"ECME S tatus is i n an 'IN P ROGRESS' s tate and c annot be f illed",1:" ")
16451	"RTN","PSO REJU3",135 ,0)
16452	;
16453	"RTN","PSO REJU3",136 ,0)
16454	I $G(DATA (REJ,"REAS ON"))'="" W !?3,"Rea son : " D PRT^PSOR EJU2("REAS ON",14,62)
16455	"RTN","PSO REJU3",137 ,0)
16456	N RTXT,OC ODE,OTXT,I
16457	"RTN","PSO REJU3",138 ,0)
16458	S (OTXT,R TXT,OCODE) ="",RTXT=$ S(DATA(REJ ,"CODE")=7 9:"REFILL TOO SOON", DATA(REJ," CODE")=88: "DUR REJEC T",1:$$EXP ^PSOREJP1( DATA(REJ," CODE")))_" ("_DATA(R EJ,"CODE") _")"
16459	"RTN","PSO REJU3",139 ,0)
16460	F I=1:1 S OCODE=$P( DATA(REJ," OTHER REJE CTS"),",", I) Q:OCODE ="" D
16461	"RTN","PSO REJU3",140 ,0)
16462	. S OTXT= OTXT_", "_ $S(OCODE=7 9:"REFILL TOO SOON", OCODE=88:" DUR REJECT ",1:$$EXP^ PSOREJP1(O CODE))_" ( "_OCODE_") "
16463	"RTN","PSO REJU3",141 ,0)
16464	S RTXT=RT XT_OTXT_". Received on "_$$FM TE^XLFDT($ G(DATA(REJ ,"DATE/TIM E")))_"."
16465	"RTN","PSO REJU3",142 ,0)
16466	S OTXT=""
16467	"RTN","PSO REJU3",143 ,0)
16468	W !?3,"Re ject(s): " D WRAP(RT XT,14)
16469	"RTN","PSO REJU3",144 ,0)
16470	Q
16471	"RTN","PSO REJU3",145 ,0)
16472	;
16473	"RTN","PSO REJU3",146 ,0)
16474	WRAP(PSOTX T,INDENT) ;
16475	"RTN","PSO REJU3",147 ,0)
16476	N I,K,PSO WRAP,PSOMA RG
16477	"RTN","PSO REJU3",148 ,0)
16478	S PSOWRAP =1,PSOMARG =$S('$G(PS ORM):80,$D (IOM):IOM, 1:80)-(IND ENT+5)
16479	"RTN","PSO REJU3",149 ,0)
16480	W1 S:$L(PS OTXT)<PSOM ARG PSOWRA P(PSOWRAP) =PSOTXT I $L(PSOTXT) '<PSOMARG F I=PSOMAR G:-1:0 I $ E(PSOTXT,I )?1P S PSO WRAP(PSOWR AP)=$E(PSO TXT,1,I),P SOTXT=$E(P SOTXT,I+1, 999),PSOWR AP=PSOWRAP +1 G W1
16481	"RTN","PSO REJU3",150 ,0)
16482	F K=1:1:P SOWRAP W ? INDENT,PSO WRAP(K),!
16483	"RTN","PSO REJU3",151 ,0)
16484	Q
16485	"RTN","PSO REJU3",152 ,0)
16486	;
16487	"RTN","PSO REJU3",153 ,0)
16488	HDR ; Disp lay the re ject notif ication sc reen heade r
16489	"RTN","PSO REJU3",154 ,0)
16490	N ELDSP,T AB
16491	"RTN","PSO REJU3",155 ,0)
16492	S ELDSP=$ $ELIGTCV^P SOREJP1(RX ,RFL,1) ; returns T RICARE, CH AMPVA or V ETERAN
16493	"RTN","PSO REJU3",156 ,0)
16494	I $L(ELDS P) S ELDSP =ELDSP_" - " ; Add the " - " for C VA/TRI onl y
16495	"RTN","PSO REJU3",157 ,0)
16496	;
16497	"RTN","PSO REJU3",158 ,0)
16498	I $G(PSON BILL) S TA B=$S($L(EL DSP):24,1: 29) W !!?T AB,"* "_ ELDSP_"NON -BILLABLE *" Q
16499	"RTN","PSO REJU3",159 ,0)
16500	I $G(PSON PROG) S TA B=$S($L(EL DSP):18,1: 23) W !!?T AB,"* "_ ELDSP_"'IN PROGRESS' ECME stat us *" Q
16501	"RTN","PSO REJU3",160 ,0)
16502	S TAB=$S( $L(ELDSP): 11,1:16) W !!?TAB,"* "_ELDSP _"REJECT R ECEIVED FR OM THIRD P ARTY PAYER *"
16503	"RTN","PSO REJU3",161 ,0)
16504	Q
16505	"RTN","PSO REJU3",162 ,0)
16506	;
16507	"RTN","PSO REJU3",163 ,0)
16508	SUBMIT(RXI EN,RFCNT,P SOTRIC) ;c alled from PSOCAN2 ( routine si ze exceede d)
16509	"RTN","PSO REJU3",164 ,0)
16510	N SUBMITE S SUBMITE =$$SUBMIT^ PSOBPSUT(R XIEN)
16511	"RTN","PSO REJU3",165 ,0)
16512	I SUBMITE D
16513	"RTN","PSO REJU3",166 ,0)
16514	. N ACTIO N
16515	"RTN","PSO REJU3",167 ,0)
16516	. D ECMES ND^PSOBPSU 1(RXIEN,,, $S($O(^PSR X(RXIEN,1, 0)):"RF",1 :"OF"))
16517	"RTN","PSO REJU3",168 ,0)
16518	. ; Quit if there i s an unres olved TRIC ARE or CHA MPVA non-b illable re ject code, PSO7358
16519	"RTN","PSO REJU3",169 ,0)
16520	. I $$PSO ET^PSOREJP 3(RXIEN) S ACTION="Q " Q
16521	"RTN","PSO REJU3",170 ,0)
16522	. I $$FIN D^PSOREJUT (RXIEN) S ACTION=$$H DLG^PSOREJ U1(RXIEN,, "79,88","O F","IOQ"," Q")
16523	"RTN","PSO REJU3",171 ,0)
16524	I 'SUBMIT E&(PSOTRIC ) D
16525	"RTN","PSO REJU3",172 ,0)
16526	. I $$STA TUS^PSOBPS UT(RXIEN,R FCNT)'["PA YABLE" D T RICCHK(RXI EN,RFCNT)
16527	"RTN","PSO REJU3",173 ,0)
16528	Q
16529	"RTN","PSO REJU3",174 ,0)
16530	;
16531	"RTN","PSO REJU3",175 ,0)
16532	TRISTA(RX, RFL,RESP,F ROM,RVTX) ;called fr om suspens e
16533	"RTN","PSO REJU3",176 ,0)
16534	N ETOUT,E STAT,TRESP ,TSTAT,PSO TRIC
16535	"RTN","PSO REJU3",177 ,0)
16536	S:'$D(RES P) RESP=""
16537	"RTN","PSO REJU3",178 ,0)
16538	S (ESTAT, PSOTRIC)=" ",PSOTRIC= $$TRIC^PSO REJP1(RX,R FL,PSOTRIC )
16539	"RTN","PSO REJU3",179 ,0)
16540	Q:'PSOTRI C 0
16541	"RTN","PSO REJU3",180 ,0)
16542	S TRESP=R ESP,ESTAT= $P(TRESP," ^",4) S:ES TAT="" EST AT=$$STATU S^PSOBPSUT (RX,RFL)
16543	"RTN","PSO REJU3",181 ,0)
16544	Q:ESTAT[" E PAYABLE" 0
16545	"RTN","PSO REJU3",182 ,0)
16546	I $$TRIAU D(RX,RFL) Q 0 ;if T RICARE or CHAMPVA Rx is in aud it due to override o r bypass, allow to p rint from suspense, cnf
16547	"RTN","PSO REJU3",183 ,0)
16548	I +RESP=2 ,$$BYPASS^ PSOBPSU1($ P(RESP,"^" ,3),$P(RES P,"^",2)) Q 0 ;if 'Bypass' R X, allow t o print fr om suspens e, cnf
16549	"RTN","PSO REJU3",184 ,0)
16550	Q:ESTAT[" E REJECTED " 1 ;reje cted TRICA RE or CHAM PVA is not allowed t o print fr om suspens e
16551	"RTN","PSO REJU3",185 ,0)
16552	;if 'in p rogress' ( 4) or not billable ( 2,3) don't allow to print from suspense (IA 4415 V alues)
16553	"RTN","PSO REJU3",186 ,0)
16554	I '$D(RES P)!($P(RES P,"^",1)=" ")!($G(RES P)="") D
16555	"RTN","PSO REJU3",187 ,0)
16556	. S TSTAT =$$STATUS^ PSOBPSUT(R X,RFL) S T RESP=$S(TS TAT["IN PR OGRESS":4, TSTAT["NOT BILLABLE" :2,1:0)
16557	"RTN","PSO REJU3",188 ,0)
16558	. S $P(TR ESP,"^",4) =TSTAT
16559	"RTN","PSO REJU3",189 ,0)
16560	;
16561	"RTN","PSO REJU3",190 ,0)
16562	I +TRESP= 2!(+TRESP= 3) D WRKLS T^PSOREJU4 (RX,RFL,"" ,DUZ,DT,1, "",RESP) Q 1 ;send TRICARE or CHAMPVA n on billabl e to workl ist (pseud o reject), cnf
16563	"RTN","PSO REJU3",191 ,0)
16564	I +TRESP= 4!(ESTAT[" IN PROGRES S") Q 1
16565	"RTN","PSO REJU3",192 ,0)
16566	Q 0
16567	"RTN","PSO REJU3",193 ,0)
16568	;
16569	"RTN","PSO REJU3",194 ,0)
16570	TRIAUD(RXI EN,RXFILL) ;is RXIEN in the TR ICARE/CHAM PVA audit and no ope n rejects ;cnf
16571	"RTN","PSO REJU3",195 ,0)
16572	; RXIEN w ill only b e in TRICA RE/CHAMPVA audit if a bypass o r override has occur red and re jects are closed
16573	"RTN","PSO REJU3",196 ,0)
16574	; returns 0 if RX IEN is not in TRICAR E/CHAMPVA audit at a ll or not in audit f or right f ill number
16575	"RTN","PSO REJU3",197 ,0)
16576	; rejec ts must be closed fo r 0 to be returned
16577	"RTN","PSO REJU3",198 ,0)
16578	; 1 if RX IEN is in TRICARE/CH AMPVA audi t for the right fill number an d rejects are closed
16579	"RTN","PSO REJU3",199 ,0)
16580	;
16581	"RTN","PSO REJU3",200 ,0)
16582	N X,AUDIE N,REJIEN
16583	"RTN","PSO REJU3",201 ,0)
16584	S X=0,AUD IEN=""
16585	"RTN","PSO REJU3",202 ,0)
16586	I '$D(^PS (52.87,"C" ,RXIEN)) Q X ;RXIE N is not i n the TRIC ARE/CHAMPV A audit
16587	"RTN","PSO REJU3",203 ,0)
16588	;
16589	"RTN","PSO REJU3",204 ,0)
16590	I $G(RXFI LL)="" S R XFILL=$$LS TRFL^PSOBP SU1(RXIEN) ;Get lat est fill i f not pass ed in
16591	"RTN","PSO REJU3",205 ,0)
16592	;
16593	"RTN","PSO REJU3",206 ,0)
16594	;check au dit entrie s for righ t fill num ber
16595	"RTN","PSO REJU3",207 ,0)
16596	F S AUDI EN=$O(^PS( 52.87,"C", RXIEN,AUDI EN)) Q:AUD IEN="" I RXFILL=$$G ET1^DIQ(52 .87,AUDIEN ,2) S X=1 Q
16597	"RTN","PSO REJU3",208 ,0)
16598	I 'X Q X
16599	"RTN","PSO REJU3",209 ,0)
16600	;
16601	"RTN","PSO REJU3",210 ,0)
16602	;make sur e rejects are closed
16603	"RTN","PSO REJU3",211 ,0)
16604	S REJIEN= 0
16605	"RTN","PSO REJU3",212 ,0)
16606	F S REJI EN=$O(^PSR X(RXIEN,"R EJ",REJIEN )) Q:'+REJ IEN D I 'X Q ;I 'X, then t he reject is not clo sed
16607	"RTN","PSO REJU3",213 ,0)
16608	. S X=$$C LOSED^PSOR EJP1(RXIEN ,REJIEN,0)
16609	"RTN","PSO REJU3",214 ,0)
16610	;
16611	"RTN","PSO REJU3",215 ,0)
16612	Q X
16613	"RTN","PSO REJU3",216 ,0)
16614	;
16615	"RTN","PSO REJU3",217 ,0)
16616	ECMECHK(RX ,FILL) ;
16617	"RTN","PSO REJU3",218 ,0)
16618	; This fu nction ret urns a '1' if any of the condi tions belo w are met:
16619	"RTN","PSO REJU3",219 ,0)
16620	; - RX has an un resolved D UR or Refi ll Too Soo n reject
16621	"RTN","PSO REJU3",220 ,0)
16622	; - RX has an un resolved R eject Reso lution Req uired (RRR ) reject ( only for V eteran and original fill)
16623	"RTN","PSO REJU3",221 ,0)
16624	; - RX is TRICAR E/CHAMPVA and has an y unresolv ed reject
16625	"RTN","PSO REJU3",222 ,0)
16626	; - RX is TRICAR E/CHAMPVA and IN PRO GRESS
16627	"RTN","PSO REJU3",223 ,0)
16628	; This is used by f unctions s uch as PPL ADD^PSOSUP OE to dete rmine if
16629	"RTN","PSO REJU3",224 ,0)
16630	; a lab el should be printed (we do no t want a l abel for t he conditi ons)
16631	"RTN","PSO REJU3",225 ,0)
16632	;
16633	"RTN","PSO REJU3",226 ,0)
16634	; Incomin g Paramete rs:
16635	"RTN","PSO REJU3",227 ,0)
16636	; RX - Internal I EN of the Prescripti on File (r equired)
16637	"RTN","PSO REJU3",228 ,0)
16638	; FILL - Fill Num ber (optio nal, defau lts to las t fill if not passed in)
16639	"RTN","PSO REJU3",229 ,0)
16640	; Returns :
16641	"RTN","PSO REJU3",230 ,0)
16642	; 0 - N one of the condition s exists
16643	"RTN","PSO REJU3",231 ,0)
16644	; 1 - O ne of the conditions above is met
16645	"RTN","PSO REJU3",232 ,0)
16646	;
16647	"RTN","PSO REJU3",233 ,0)
16648	I '$G(RX) Q 0
16649	"RTN","PSO REJU3",234 ,0)
16650	I $G(FILL )="" S FIL L=$$LSTRFL ^PSOBPSU1( RX)
16651	"RTN","PSO REJU3",235 ,0)
16652	;
16653	"RTN","PSO REJU3",236 ,0)
16654	; DUR or Refill Too Soon or R RR rejects
16655	"RTN","PSO REJU3",237 ,0)
16656	I $$FIND^ PSOREJUT(R X,FILL,"", "79,88",,1 ) Q 1
16657	"RTN","PSO REJU3",238 ,0)
16658	;
16659	"RTN","PSO REJU3",239 ,0)
16660	; If not TRICARE/CH AMPVA, qui t with 0 a s the rest of the ch ecks
16661	"RTN","PSO REJU3",240 ,0)
16662	; are a ll TRICARE /CHAMPVA d ependent
16663	"RTN","PSO REJU3",241 ,0)
16664	I '$$TRIC ^PSOREJP1( RX,FILL) Q 0
16665	"RTN","PSO REJU3",242 ,0)
16666	;
16667	"RTN","PSO REJU3",243 ,0)
16668	; No labe l for TRIC ARE/CHAMPV A with unr esolved re jects
16669	"RTN","PSO REJU3",244 ,0)
16670	I $$FIND^ PSOREJUT(R X,FILL,,,1 ) Q 1 ; 5th parame ter to $$F IND also f inds non-b illable TR I/CVA reje cts
16671	"RTN","PSO REJU3",245 ,0)
16672	;
16673	"RTN","PSO REJU3",246 ,0)
16674	;No label for TRICA RE/CHAMPVA claims th at are IN PROGRESS
16675	"RTN","PSO REJU3",247 ,0)
16676	I $P($$ST ATUS^PSOBP SUT(RX,FIL L),U)="IN PROGRESS" Q 1
16677	"RTN","PSO REJU3",248 ,0)
16678	Q 0
16679	"RTN","PSO REJU3",249 ,0)
16680	;
16681	"RTN","PSO REJU3",250 ,0)
16682	DVINFO(RX, RFL,LM) ; Returns he ader displ ayable Div ision Info rmation
16683	"RTN","PSO REJU3",251 ,0)
16684	;Input: ( r) RX - Rx IEN (#5 2)
16685	"RTN","PSO REJU3",252 ,0)
16686	; ( o) RFL - Refill # ( Default: m ost recent )
16687	"RTN","PSO REJU3",253 ,0)
16688	; ( o) LM - ListManage r format? (1 - Yes / 0 - No) - Default: 0
16689	"RTN","PSO REJU3",254 ,0)
16690	N TXT,DVI NFO,NCPNPI ,DVIEN
16691	"RTN","PSO REJU3",255 ,0)
16692	S DVIEN=+ $$RXSITE^P SOBPSUT(RX ,RFL)
16693	"RTN","PSO REJU3",256 ,0)
16694	S DVINFO= "Division : "_$$GET1 ^DIQ(59,DV IEN,.01)
16695	"RTN","PSO REJU3",257 ,0)
16696	;Display both NPI a nd NCPDP n umbers - P SO7.0421
16697	"RTN","PSO REJU3",258 ,0)
16698	S NCPNPI= $$DIVNCPDP ^BPSBUTL(D VIEN)
16699	"RTN","PSO REJU3",259 ,0)
16700	S $E(DVIN FO,33)="NP I: "_$P(NC PNPI,U,2)
16701	"RTN","PSO REJU3",260 ,0)
16702	S $E(DVIN FO,$S($G(L M):59,1:52 ))="NCPDP: "_$P(NCPN PI,U)
16703	"RTN","PSO REJU3",261 ,0)
16704	Q DVINFO
16705	"RTN","PSO REJUT")
16706	0^5^B11353 2440
16707	"RTN","PSO REJUT",1,0 )
16708	PSOREJUT ; BIRM/MFR - BPS (ECME ) - Clinic al Rejects Utilities ;06/07/05
16709	"RTN","PSO REJUT",2,0 )
16710	;;7.0;OUT PATIENT PH ARMACY;1 48,247,260 ,287,289,2 90,358,359 ,385,403,4 21,427,448 ,478;DEC 1997;Buil d 15
16711	"RTN","PSO REJUT",3,0 )
16712	;Referenc e to DUR1^ BPSNCPD3 s upported b y IA 4560
16713	"RTN","PSO REJUT",4,0 )
16714	;Referenc e to $$ADD COMM^BPSBU TL support ed by IA 4 719
16715	"RTN","PSO REJUT",5,0 )
16716	;
16717	"RTN","PSO REJUT",6,0 )
16718	SAVE(RX,RF L,REJ,REOP EN) ; - Sa ves DUR In formation in the fil e 52
16719	"RTN","PSO REJUT",7,0 )
16720	; Input: (r) RX - Rx IEN (# 52)
16721	"RTN","PSO REJUT",8,0 )
16722	; (o) RFL - Refill # (Default: most recen t)
16723	"RTN","PSO REJUT",9,0 )
16724	; (o) REOPE N - value of 1 means claim bei ng reopene d; null or no value passed mea ns reopen claim func tionality not being used
16725	"RTN","PSO REJUT",10, 0)
16726	; (r) REJ - Array con taining in formation about the REJECT on the follow ing subscr ipts:
16727	"RTN","PSO REJUT",11, 0)
16728	; "BIN" - B IN Number
16729	"RTN","PSO REJUT",12, 0)
16730	; "PCN" - P CN Number
16731	"RTN","PSO REJUT",13, 0)
16732	; "CODE" - Reject C ode (79 or 88)
16733	"RTN","PSO REJUT",14, 0)
16734	; "DATE/TIM E" - Dat e/Time Rej ect Detect ed
16735	"RTN","PSO REJUT",15, 0)
16736	; "PAYER ME SSAGE" - M essage ret urned by P ayer (up t o 140 char s long)
16737	"RTN","PSO REJUT",16, 0)
16738	; "REASON" - Reject R eason (up to 100 cha rs long)
16739	"RTN","PSO REJUT",17, 0)
16740	; "DUR TEXT " - Payer' s DUR desc ription
16741	"RTN","PSO REJUT",18, 0)
16742	; "DUR ADD MSG TEXT" - Payer's DUR additi onal messa ge text de scription
16743	"RTN","PSO REJUT",19, 0)
16744	; "INSURANC E NAME" - Patient's Insurance Company Na me
16745	"RTN","PSO REJUT",20, 0)
16746	; "INSURANC E POINTER" - Patient 's Insuran ce Company IEN
16747	"RTN","PSO REJUT",21, 0)
16748	; "GROUP NA ME" - Pati ent's Insu rance Grou p Name
16749	"RTN","PSO REJUT",22, 0)
16750	; "GROUP NU MBER" - Pa tient's In surance Gr oup Number
16751	"RTN","PSO REJUT",23, 0)
16752	; "CARDHOLD ER ID" - P atient's I nsurance C ardholder ID
16753	"RTN","PSO REJUT",24, 0)
16754	; "COB" - C oordinatio n of Benef its
16755	"RTN","PSO REJUT",25, 0)
16756	; "PLAN CON TACT" - Pa tient's In surance Pl an Contact (1-800)
16757	"RTN","PSO REJUT",26, 0)
16758	; "PREVIOUS FILL" - P lan's Prev ious Fill Date
16759	"RTN","PSO REJUT",27, 0)
16760	; "OTHER RE JECTS" - O ther Rejec ts with sa me Respons e
16761	"RTN","PSO REJUT",28, 0)
16762	; "PHARMACI ST" - Phar macist DUZ
16763	"RTN","PSO REJUT",29, 0)
16764	; "RESPONSE IEN" - Po inter to t he RESPONS E file in ECME
16765	"RTN","PSO REJUT",30, 0)
16766	; "REASON S VC CODE" - Reason fo r Service Code (poin ter to BPS NCPDP REA SON FOR SE RVICE CODE )
16767	"RTN","PSO REJUT",31, 0)
16768	; "RE-OPENE D" - Re-Op en Flag
16769	"RTN","PSO REJUT",32, 0)
16770	; "RRR FLAG " - Reject Resolutio n Required indicator (expectin g 1/0 into SAVE)
16771	"RTN","PSO REJUT",33, 0)
16772	; "RRR THRE SHOLD AMT" - Reject Resolution Required Dollar Thr eshold
16773	"RTN","PSO REJUT",34, 0)
16774	; "RRR GROS S AMT DUE" - Reject Resolution Required Gross Amou nt Due
16775	"RTN","PSO REJUT",35, 0)
16776	;Output: REJ("REJEC T IEN")
16777	"RTN","PSO REJUT",36, 0)
16778	N %,DIC,D R,DA,X,DIN UM,DD,DO,D LAYGO,ERR
16779	"RTN","PSO REJUT",37, 0)
16780	I '$D(RFL ) S RFL=$$ LSTRFL^PSO BPSU1(RX)
16781	"RTN","PSO REJUT",38, 0)
16782	I '$G(PSO DIV) S PSO DIV=$$RXSI TE^PSOBPSU T(RX,RFL)
16783	"RTN","PSO REJUT",39, 0)
16784	S REJ("BI N")=$E($G( REJ("BIN") ),1,6)
16785	"RTN","PSO REJUT",40, 0)
16786	S REJ("PC N")=$G(REJ ("PCN"))
16787	"RTN","PSO REJUT",41, 0)
16788	S REJ("CO DE")=$G(RE J("CODE"))
16789	"RTN","PSO REJUT",42, 0)
16790	;
16791	"RTN","PSO REJUT",43, 0)
16792	; convert REJ("RRR FLAG") int o internal format (1 /0) if nec essary. Wh en coming into SAVE from the R e-open Rej ect
16793	"RTN","PSO REJUT",44, 0)
16794	; action, this flag is in the external format (YE S/NO). e sg - 3/29/ 16 - PSO7 448
16795	"RTN","PSO REJUT",45, 0)
16796	I $G(REJ( "RRR FLAG" ))="YES" S REJ("RRR FLAG")=1
16797	"RTN","PSO REJUT",46, 0)
16798	I $G(REJ( "RRR FLAG" ))="NO" S REJ("RRR F LAG")=0
16799	"RTN","PSO REJUT",47, 0)
16800	;
16801	"RTN","PSO REJUT",48, 0)
16802	;Ignore t his additi onal Check if reject is Reject Resolutio n Required reject - PSO7421
16803	"RTN","PSO REJUT",49, 0)
16804	I '$G(REJ ("RRR FLAG ")),REJ("C ODE")'=79& (REJ("CODE ")'=88)&(' $G(PSOTRIC ))&('$G(RE OPEN)) S E RR=$$EVAL^ PSOREJU4(P SODIV,REJ( "CODE"),$G (OPECC)) Q :'+ERR
16805	"RTN","PSO REJUT",50, 0)
16806	S REJ("PA YER MESSAG E")=$E($G( REJ("PAYER MESSAGE") ),1,140),R EJ("REASON ")=$E($G(R EJ("REASON ")),1,100)
16807	"RTN","PSO REJUT",51, 0)
16808	S REJ("DU R TEXT")=$ E($G(REJ(" DUR TEXT") ),1,100),R EJ("DUR AD D MSG TEXT ")=$E($G(R EJ("DUR AD D MSG TEXT ")),1,100) ,REJ("GROU P NAME")=$ E($G(REJ(" GROUP NAME ")),1,30)
16809	"RTN","PSO REJUT",52, 0)
16810	S REJ("IN SURANCE NA ME")=$E($G (REJ("INSU RANCE NAME ")),1,30), REJ("PLAN CONTACT")= $E($G(REJ( "PLAN CONT ACT")),1,3 0)
16811	"RTN","PSO REJUT",53, 0)
16812	S REJ("GR OUP NUMBER ")=$E($G(R EJ("GROUP NUMBER")), 1,30),REJ( "OTHER REJ ECTS")=$E( $G(REJ("OT HER REJECT S")),1,15)
16813	"RTN","PSO REJUT",54, 0)
16814	S REJ("CA RDHOLDER I D")=$E($G( REJ("CARDH OLDER ID") ),1,20),RE J("COB")=$ G(REJ("COB "))
16815	"RTN","PSO REJUT",55, 0)
16816	I $G(REJ( "DATE/TIME "))="" D N OW^%DTC S REJ("DATE/ TIME")=%
16817	"RTN","PSO REJUT",56, 0)
16818	S DIC="^P SRX("_RX_" ,""REJ""," ,DA(1)=RX, DIC(0)=""
16819	"RTN","PSO REJUT",57, 0)
16820	S X=$G(RE J("CODE")) ,DINUM=$O( ^PSRX(RX," REJ",9999) ,-1)+1
16821	"RTN","PSO REJUT",58, 0)
16822	S DIC("DR ")="1///"_ $G(REJ("DA TE/TIME")) _";2///"_R EJ("PAYER MESSAGE")_ ";3///"_RE J("REASON" )_";4////" _$G(REJ("P HARMACIST" ))_";5///" _RFL
16823	"RTN","PSO REJUT",59, 0)
16824	S DIC("DR ")=DIC("DR ")_";6///" _REJ("GROU P NAME")_" ;7///"_REJ ("PLAN CON TACT")_";8 ///"_$G(RE J("PREVIOU S FILL"))
16825	"RTN","PSO REJUT",60, 0)
16826	S DIC("DR ")=DIC("DR ")_";9///0 ;14///"_$G (REJ("REAS ON SVC COD E"))_";16/ //"_$G(REJ ("RESPONSE IEN"))
16827	"RTN","PSO REJUT",61, 0)
16828	S DIC("DR ")=DIC("DR ")_";17/// "_$G(REJ(" OTHER REJE CTS"))_";1 8///"_REJ( "DUR TEXT" )_";20///" _REJ("INSU RANCE NAME ")
16829	"RTN","PSO REJUT",62, 0)
16830	S DIC("DR ")=DIC("DR ")_";21/// "_REJ("GRO UP NUMBER" )_";22///" _REJ("CARD HOLDER ID" )_";23///" _$G(REJ("R E-OPENED") )
16831	"RTN","PSO REJUT",63, 0)
16832	S DIC("DR ")=DIC("DR ")_";27/// "_REJ("COB ")
16833	"RTN","PSO REJUT",64, 0)
16834	S DIC("DR ")=DIC("DR ")_";28/// "_REJ("DUR ADD MSG T EXT")
16835	"RTN","PSO REJUT",65, 0)
16836	S DIC("DR ")=DIC("DR ")_";29/// "_REJ("BIN ")
16837	"RTN","PSO REJUT",66, 0)
16838	S DIC("DR ")=DIC("DR ")_";34/// "_REJ("PCN ")
16839	"RTN","PSO REJUT",67, 0)
16840	;Update R eject Reso lution Req uired fiel ds - PSO7 421
16841	"RTN","PSO REJUT",68, 0)
16842	I $G(REJ( "RRR FLAG" )) D
16843	"RTN","PSO REJUT",69, 0)
16844	.S DIC("D R")=DIC("D R")_";30// /"_REJ("RR R FLAG")
16845	"RTN","PSO REJUT",70, 0)
16846	.S DIC("D R")=DIC("D R")_";31// /"_REJ("RR R THRESHOL D AMT")
16847	"RTN","PSO REJUT",71, 0)
16848	.S DIC("D R")=DIC("D R")_";32// /"_REJ("RR R GROSS AM T DUE")
16849	"RTN","PSO REJUT",72, 0)
16850	S DIC("DR ")=DIC("DR ")_";33/// "_REJ("INS URANCE POI NTER")
16851	"RTN","PSO REJUT",73, 0)
16852	F L +^PS RX(RX):5 Q :$T H 15
16853	"RTN","PSO REJUT",74, 0)
16854	K DD,DO D FILE^DICN K DD,DO S REJ("REJE CT IEN")=+ Y
16855	"RTN","PSO REJUT",75, 0)
16856	S REJ("OV ERRIDE MSG ")=$G(DATA ("OVERRIDE MSG"))
16857	"RTN","PSO REJUT",76, 0)
16858	;Comments use POSTM ASTER as u ser for au to transfe rs - PSO7 421
16859	"RTN","PSO REJUT",77, 0)
16860	I REJ("OV ERRIDE MSG ")'="" D
16861	"RTN","PSO REJUT",78, 0)
16862	.N ORIGIN S ORIGIN= $G(DUZ)
16863	"RTN","PSO REJUT",79, 0)
16864	.S:REJ("O VERRIDE MS G")["Autom atically t ransferred " ORIGIN=. 5
16865	"RTN","PSO REJUT",80, 0)
16866	.D SAVECO M^PSOREJP3 (RX,REJ("R EJECT IEN" ),REJ("OVE RRIDE MSG" ),$G(REJ(" DATE/TIME" )),ORIGIN)
16867	"RTN","PSO REJUT",81, 0)
16868	.;Insert comment fo r Transfer and RRR R ejects - P SO7421
16869	"RTN","PSO REJUT",82, 0)
16870	.I REJ("O VERRIDE MS G")["Autom atically t ransferred " D
16871	"RTN","PSO REJUT",83, 0)
16872	..N X,TXT
16873	"RTN","PSO REJUT",84, 0)
16874	..S TXT=" Auto Send to Pharmac y Worklist due to Tr ansfer Rej ect Code"
16875	"RTN","PSO REJUT",85, 0)
16876	..I $G(RE J("RRR FLA G")) S TXT ="Auto Sen d to Pharm acy Workli st due to Reject Res olution Re quired Cod e"
16877	"RTN","PSO REJUT",86, 0)
16878	..I $G(PS OTRIC) S T XT="Auto S end to Pha rmacy Work list & OPE CC - CVA/T RI"
16879	"RTN","PSO REJUT",87, 0)
16880	..S X=$$A DDCOMM^BPS BUTL(RX,RF L,TXT,1) ; IA 4719
16881	"RTN","PSO REJUT",88, 0)
16882	L -^PSRX( RX)
16883	"RTN","PSO REJUT",89, 0)
16884	Q
16885	"RTN","PSO REJUT",90, 0)
16886	;
16887	"RTN","PSO REJUT",91, 0)
16888	CLSALL(RX, RFL,USR,RE A,COM,COD1 ,COD2,COD3 ,CLA,PA) ; Close/Res olve All R ejects
16889	"RTN","PSO REJUT",92, 0)
16890	;Input: ( r) RX - Rx IEN (#5 2)
16891	"RTN","PSO REJUT",93, 0)
16892	; ( o) RFL - Refill # ( Default: m ost recent )
16893	"RTN","PSO REJUT",94, 0)
16894	; ( o) USR - User DUZ r esponsible for closi ng all rej ects
16895	"RTN","PSO REJUT",95, 0)
16896	; ( r) REA - Close REAS ON code
16897	"RTN","PSO REJUT",96, 0)
16898	; ( o) COM - Close COMM ENTS
16899	"RTN","PSO REJUT",97, 0)
16900	; ( o) COD1 - First set of DUR ove rrides (Re ason Code^ Profession al Code^Re sult Code)
16901	"RTN","PSO REJUT",98, 0)
16902	; ( o) COD2 - Second set of DUR ov errides (R eason Code ^Professio nal Code^R esult Code )
16903	"RTN","PSO REJUT",99, 0)
16904	; ( o) COD3 - Third set of DUR ove rrides (Re ason Code^ Profession al Code^Re sult Code)
16905	"RTN","PSO REJUT",100 ,0)
16906	; ( o) CLA - NCPDP Clar ification Code for o verriding RTS and DU R REJECTS
16907	"RTN","PSO REJUT",101 ,0)
16908	; ( o) PA - NCPDP Prio r Authoriz ation Type and Numbe r (separat ed by "^")
16909	"RTN","PSO REJUT",102 ,0)
16910	N REJ,REJ DATA,DIE,D R,DA
16911	"RTN","PSO REJUT",103 ,0)
16912	I '$D(RFL ) S RFL=$$ LSTRFL^PSO BPSU1(RX)
16913	"RTN","PSO REJUT",104 ,0)
16914	; - Closi ng OPEN/UN RESOLVED r ejects
16915	"RTN","PSO REJUT",105 ,0)
16916	I $$FIND( RX,RFL,.RE JDATA,,1) D
16917	"RTN","PSO REJUT",106 ,0)
16918	. S REJ=" " F S REJ =$O(REJDAT A(REJ)) Q: 'REJ D
16919	"RTN","PSO REJUT",107 ,0)
16920	. . D CLO SE(RX,RFL, REJ,USR,RE A,$G(COM), $G(COD1),$ G(COD2),$G (COD3),$G( CLA),$G(PA ))
16921	"RTN","PSO REJUT",108 ,0)
16922	Q
16923	"RTN","PSO REJUT",109 ,0)
16924	;
16925	"RTN","PSO REJUT",110 ,0)
16926	CLOSE(RX,R FL,REJ,USR ,REA,COM,C OD1,COD2,C OD3,CLA,PA ,IGNR) ; - Mark a DU R/REFILL T OO SOON re ject RESOL VED
16927	"RTN","PSO REJUT",111 ,0)
16928	; Input: (r) RX - Rx IEN (# 52)
16929	"RTN","PSO REJUT",112 ,0)
16930	; (o) RFL - Refill # (Default: most recen t)
16931	"RTN","PSO REJUT",113 ,0)
16932	; (r) REJ - REJECT ID (IEN)
16933	"RTN","PSO REJUT",114 ,0)
16934	; (o) USR - User (fil e #200 IEN ) responsi ble for cl osing the REJECT
16935	"RTN","PSO REJUT",115 ,0)
16936	; (r) REA - Reason fo r closing the REJECT (52.25,1 2):
16937	"RTN","PSO REJUT",116 ,0)
16938	; 1:CLA IM RE-SUBM ITTED
16939	"RTN","PSO REJUT",117 ,0)
16940	; 2:RX ON HOLD
16941	"RTN","PSO REJUT",118 ,0)
16942	; 3:RX SUSPENDED
16943	"RTN","PSO REJUT",119 ,0)
16944	; 4:RX RETURNED T O STOCK
16945	"RTN","PSO REJUT",120 ,0)
16946	; 5:RX DELETED
16947	"RTN","PSO REJUT",121 ,0)
16948	; 6:IGN ORED - NO RESUBMISSI ON
16949	"RTN","PSO REJUT",122 ,0)
16950	; 7:RX DISCONTINU ED
16951	"RTN","PSO REJUT",123 ,0)
16952	; 8:RX EDITED
16953	"RTN","PSO REJUT",124 ,0)
16954	; 99:OTH ER
16955	"RTN","PSO REJUT",125 ,0)
16956	; (o) COM - Close co mments man ually ente red by the user
16957	"RTN","PSO REJUT",126 ,0)
16958	; (o) COD1 - First se t of DUR o verrides ( Reason Cod e^Professi onal Code^ Result Cod e)
16959	"RTN","PSO REJUT",127 ,0)
16960	; (o) COD2 - Second s et of DUR overrides (Reason Co de^Profess ional Code ^Result Co de)
16961	"RTN","PSO REJUT",128 ,0)
16962	; (o) COD3 - Third se t of DUR o verrides ( Reason Cod e^Professi onal Code^ Result Cod e)
16963	"RTN","PSO REJUT",129 ,0)
16964	; (o) CLA - NCPDP Cl arificatio n Code for overridin g RTS and DUR REJECT S
16965	"RTN","PSO REJUT",130 ,0)
16966	; (o) PA - NCPDP Pr ior Author ization Ty pe and Num ber (separ ated by "^ ")
16967	"RTN","PSO REJUT",131 ,0)
16968	; (o) IGNR - Ignore F lag; 1=IGN ORE, 0=NOT IGNORE
16969	"RTN","PSO REJUT",132 ,0)
16970	;
16971	"RTN","PSO REJUT",133 ,0)
16972	I '$G(RX) !'$G(REJ) Q
16973	"RTN","PSO REJUT",134 ,0)
16974	I '$D(RFL ) S RFL=$$ LSTRFL^PSO BPSU1(RX)
16975	"RTN","PSO REJUT",135 ,0)
16976	I '$D(^PS RX(RX,"REJ ",REJ)) Q
16977	"RTN","PSO REJUT",136 ,0)
16978	I $$GET1^ DIQ(52.25, REJ_","_RX ,5)'=+$G(R FL) Q
16979	"RTN","PSO REJUT",137 ,0)
16980	S:'$G(REA ) REA=99 S COM=$TR($ G(COM),";^ ",",,")
16981	"RTN","PSO REJUT",138 ,0)
16982	N DQ,DA,D IE,DR,X,Y, REJCOM,I,S MACOM,SMA
16983	"RTN","PSO REJUT",139 ,0)
16984	D NOW^%DT C
16985	"RTN","PSO REJUT",140 ,0)
16986	S REJCOM= "AUTOMATIC ALLY CLOSE D" I REA'= 1 S REJCOM =COM
16987	"RTN","PSO REJUT",141 ,0)
16988	S DA(1)=R X,DA=REJ,D IE="^PSRX( "_RX_",""R EJ"","
16989	"RTN","PSO REJUT",142 ,0)
16990	S DR="9// /1;10///"_ %_";11//// "_$G(USR)_ ";12///"_R EA_";13/// "_REJCOM_" ;14///"_$P ($G(COD1), "^")_";15/ //"_$P($G( COD1),"^", 2)
16991	"RTN","PSO REJUT",143 ,0)
16992	S DR=DR_" ;19///"_$P ($G(COD1), "^",3)_";2 4///"_$G(C LA)_";25// /"_$P($G(P A),"^")_"; 26///"_$P( $G(PA),"^" ,2)
16993	"RTN","PSO REJUT",144 ,0)
16994	D ^DIE
16995	"RTN","PSO REJUT",145 ,0)
16996	; Quit if this is a "eT" (non -billable TRICARE) o r "eC" (no n-billable CHAMPVA)
16997	"RTN","PSO REJUT",146 ,0)
16998	Q:$$PSOET ^PSOREJP3( RX,RFL)
16999	"RTN","PSO REJUT",147 ,0)
17000	;
17001	"RTN","PSO REJUT",148 ,0)
17002	; Add com ment to th e ECME Use r Screen
17003	"RTN","PSO REJUT",149 ,0)
17004	; First c heck if th is is has more than one overri de value f rom the SM A action o f the reje ct worklis t
17005	"RTN","PSO REJUT",150 ,0)
17006	; If it i s, we will need to e nter multi ple commen ts
17007	"RTN","PSO REJUT",151 ,0)
17008	S SMA=0
17009	"RTN","PSO REJUT",152 ,0)
17010	I $G(COD1 )]"",$G(CL A)]"" S SM A=1
17011	"RTN","PSO REJUT",153 ,0)
17012	I $G(COD1 )]"",$G(PA )]"" S SMA =1
17013	"RTN","PSO REJUT",154 ,0)
17014	I $G(CLA) ]"",$G(PA) ]"" S SMA= 1
17015	"RTN","PSO REJUT",155 ,0)
17016	I SMA D Q
17017	"RTN","PSO REJUT",156 ,0)
17018	. I $G(CO D1)]"" D
17019	"RTN","PSO REJUT",157 ,0)
17020	.. S SMAC OM=$TR("DU R Override Codes "_$ G(COD1)_"~ "_$G(COD2) _"~"_$G(CO D3)_" subm itted.","^ ","/")
17021	"RTN","PSO REJUT",158 ,0)
17022	.. S X=$$ ADDCOMM^BP SBUTL(RX,R FL,SMACOM)
17023	"RTN","PSO REJUT",159 ,0)
17024	. I $G(CL A)]"" D
17025	"RTN","PSO REJUT",160 ,0)
17026	.. S SMAC OM="Clarif ication Co de(s) "_CL A_" submit ted."
17027	"RTN","PSO REJUT",161 ,0)
17028	.. S X=$$ ADDCOMM^BP SBUTL(RX,R FL,SMACOM)
17029	"RTN","PSO REJUT",162 ,0)
17030	. I $G(PA )]"" D
17031	"RTN","PSO REJUT",163 ,0)
17032	.. S SMAC OM="Prior Authorizat ion Code ( "_$P(PA,"^ ")_"/"_$P( PA,"^",2)_ ") submitt ed."
17033	"RTN","PSO REJUT",164 ,0)
17034	.. S X=$$ ADDCOMM^BP SBUTL(RX,R FL,SMACOM)
17035	"RTN","PSO REJUT",165 ,0)
17036	. S SMACO M="Multipl e actions taken to r esolve. Se e comments for detai ls."
17037	"RTN","PSO REJUT",166 ,0)
17038	. S X=$$A DDCOMM^BPS BUTL(RX,RF L,SMACOM)
17039	"RTN","PSO REJUT",167 ,0)
17040	;
17041	"RTN","PSO REJUT",168 ,0)
17042	; If not SMA, fall through to here and enter one comment
17043	"RTN","PSO REJUT",169 ,0)
17044	; If IGNR flag is s et, add th at to the comment st ring befor e sending
17045	"RTN","PSO REJUT",170 ,0)
17046	S X=$$ADD COMM^BPSBU TL(RX,RFL, $S($G(IGNR ):"IGNORED - ",1:"") _COM)
17047	"RTN","PSO REJUT",171 ,0)
17048	Q
17049	"RTN","PSO REJUT",172 ,0)
17050	;
17051	"RTN","PSO REJUT",173 ,0)
17052	FIND(RX,RF L,REJDATA, CODE,BESC, RRRFLG) ; - Returns whether a Rx/fill co ntains UNR ESOLVED re jects
17053	"RTN","PSO REJUT",174 ,0)
17054	; Input: (r) RX - R x IEN (#52 )
17055	"RTN","PSO REJUT",175 ,0)
17056	; (o) RFL - Refill # (If not passed, lo ok origina l and all refills)
17057	"RTN","PSO REJUT",176 ,0)
17058	; (o) COD E - Can be null, a s pecific Re ject Code( s) to be c hecked or multiple c odes separ ated by co mma's
17059	"RTN","PSO REJUT",177 ,0)
17060	; (o) BES C - Bypass ECME Stat us Check ( default be havior is to do the check); pa ss 1 to sk ip the che ck below
17061	"RTN","PSO REJUT",178 ,0)
17062	; We nee d to skip this check when look ing for no n-ECME bil lable reje cts (eT or eC for ex ample)
17063	"RTN","PSO REJUT",179 ,0)
17064	; (o) RRR FLG - Pass a 1 in th is paramet er to also look for any unreso lved Rejec t Resoluti on Require d (RRR)
17065	"RTN","PSO REJUT",180 ,0)
17066	; reje cts when C ODE is als o passed. If CODE i s not pass ed in, the n pass a 1 here to O NLY look f or
17067	"RTN","PSO REJUT",181 ,0)
17068	; unre solved RRR rejects.
17069	"RTN","PSO REJUT",182 ,0)
17070	; The default he re is 0 if not passe d.
17071	"RTN","PSO REJUT",183 ,0)
17072	;
17073	"RTN","PSO REJUT",184 ,0)
17074	; Output: 1 - Rx co ntains unr esolved Re jects
17075	"RTN","PSO REJUT",185 ,0)
17076	; 0 - Rx do es not con tain unres olved Reje cts
17077	"RTN","PSO REJUT",186 ,0)
17078	; .REJDA TA - Array containin g the Reje ct(s) data (see GET^ PSOREJU2 f or fields documentat ion)
17079	"RTN","PSO REJUT",187 ,0)
17080	;
17081	"RTN","PSO REJUT",188 ,0)
17082	N RCODE,I ,REJS
17083	"RTN","PSO REJUT",189 ,0)
17084	S REJS=0, RCODE=""
17085	"RTN","PSO REJUT",190 ,0)
17086	K REJDATA
17087	"RTN","PSO REJUT",191 ,0)
17088	I '$G(BES C),$G(RFL) ,$$STATUS^ PSOBPSUT(R X,RFL)="" Q 0
17089	"RTN","PSO REJUT",192 ,0)
17090	I $G(CODE )]"",CODE[ "," S REJS =$$MULTI^P SOREJU4(RX ,$G(RFL),. REJDATA,$G (CODE),REJ S,+$G(RRRF LG)) G FEN D
17091	"RTN","PSO REJUT",193 ,0)
17092	S REJS=$$ SINGLE^PSO REJU4(RX,$ G(RFL),.RE JDATA,$G(C ODE),REJS, +$G(RRRFLG ))
17093	"RTN","PSO REJUT",194 ,0)
17094	FEND ;
17095	"RTN","PSO REJUT",195 ,0)
17096	Q $S(REJS :1,1:0)
17097	"RTN","PSO REJUT",196 ,0)
17098	;
17099	"RTN","PSO REJUT",197 ,0)
17100	SYNC(RX,RF L,USR,RXCO B) ;
17101	"RTN","PSO REJUT",198 ,0)
17102	; Input: (r) RX - Rx IEN (# 52)
17103	"RTN","PSO REJUT",199 ,0)
17104	; (o) RFL - Refill # (Default: most recen t)
17105	"RTN","PSO REJUT",200 ,0)
17106	; (o) USR - User usin g the syst em when th is routine is called
17107	"RTN","PSO REJUT",201 ,0)
17108	; (o) RXCOB - Coordin ation of B enefits co de
17109	"RTN","PSO REJUT",202 ,0)
17110	I '$G(RXC OB) S RXCO B=1
17111	"RTN","PSO REJUT",203 ,0)
17112	N REJ,REJ S,REJLST,I ,IDX,CODE, DATA,TXT,P SOTRIC,ERR ,PSODIV,OP ECC,OVREJ, ESH
17113	"RTN","PSO REJUT",204 ,0)
17114	N REJRRR, RRRVAL ; P SO7421
17115	"RTN","PSO REJUT",205 ,0)
17116	L +^PSRX( "REJ",RX): 0 Q:'$T
17117	"RTN","PSO REJUT",206 ,0)
17118	I '$D(RFL ) S RFL=$$ LSTRFL^PSO BPSU1(RX)
17119	"RTN","PSO REJUT",207 ,0)
17120	S PSODIV= $$RXSITE^P SOBPSUT(RX ,RFL)
17121	"RTN","PSO REJUT",208 ,0)
17122	D DUR1^BP SNCPD3(RX, RFL,.REJ," ",RXCOB)
17123	"RTN","PSO REJUT",209 ,0)
17124	S PSOTRIC ="" S:$G(R EJ(1,"ELIG BLT"))="T" PSOTRIC=1 S:$G(REJ( 1,"ELIGBLT "))="C" PS OTRIC=2 S: PSOTRIC="" PSOTRIC=$ $TRIC^PSOR EJP1(RX,RF L,.PSOTRIC )
17125	"RTN","PSO REJUT",210 ,0)
17126	K REJS S (OPECC,IDX ,ERR)=""
17127	"RTN","PSO REJUT",211 ,0)
17128	F S IDX= $O(REJ(IDX )) Q:IDX=" " S TXT=$ G(REJ(IDX, "REJ CODE LST")) D
17129	"RTN","PSO REJUT",212 ,0)
17130	. F I=1:1 :$L(TXT,", ") S CODE= $P(TXT,"," ,I),OVREJ= "" D
17131	"RTN","PSO REJUT",213 ,0)
17132	. . I COD E="" Q
17133	"RTN","PSO REJUT",214 ,0)
17134	. . I ",M 6,M8,99,NN ,"[(","_CO DE_",") S ESH="",ESH =$$DUR^PSO BPSU2(RX,R FL) Q:'ESH &('PSOTRIC )
17135	"RTN","PSO REJUT",215 ,0)
17136	. . ;Addi tional che ck for Rej ect Resolu tion Requi red includ ed - PSO7 421
17137	"RTN","PSO REJUT",216 ,0)
17138	. . I COD E'="79"&(C ODE'="88") &('$G(PSOT RIC)) S ER R=$$EVAL^P SOREJU4(PS ODIV,CODE, OPECC,RX,R FL,RXCOB,. RRRVAL) Q: '+ERR
17139	"RTN","PSO REJUT",217 ,0)
17140	. . I +$G (ERR) S OV REJ=1 S:+$ G(RRRVAL) REJRRR(IDX )=RRRVAL
17141	"RTN","PSO REJUT",218 ,0)
17142	. . I $$D UP^PSOREJU 1(RX,+$$CL EAN^PSOREJ U1($G(REJ( IDX,"RESPO NSE IEN")) )) Q
17143	"RTN","PSO REJUT",219 ,0)
17144	. . S REJ S(IDX,CODE )=OVREJ
17145	"RTN","PSO REJUT",220 ,0)
17146	I '$D(REJ S) L -^PSR X("REJ",RX ) Q
17147	"RTN","PSO REJUT",221 ,0)
17148	SYNC2 ;
17149	"RTN","PSO REJUT",222 ,0)
17150	S (IDX,CO DE)="" F S IDX=$O(R EJS(IDX)) Q:IDX="" D
17151	"RTN","PSO REJUT",223 ,0)
17152	. F S CO DE=$O(REJS (IDX,CODE) ) Q:CODE=" " K DATA D
17153	"RTN","PSO REJUT",224 ,0)
17154	. . ;Addi tional che ck for Rej ect Resolu tion Requi red - PSO* 7*421
17155	"RTN","PSO REJUT",225 ,0)
17156	. . I 'OP ECC&(CODE' [79)&(CODE '[88) D
17157	"RTN","PSO REJUT",226 ,0)
17158	. . .I '+ $G(REJRRR( IDX)) S DA TA("OVERRI DE MSG")=" Automatica lly transf erred due to overrid e for reje ct code." Q
17159	"RTN","PSO REJUT",227 ,0)
17160	. . .;Rej ect Resolu tion Requi red fields
17161	"RTN","PSO REJUT",228 ,0)
17162	. . .S DA TA("RRR FL AG")=1
17163	"RTN","PSO REJUT",229 ,0)
17164	. . .S DA TA("RRR GR OSS AMT DU E")=$P(REJ RRR(IDX),U ,2)
17165	"RTN","PSO REJUT",230 ,0)
17166	. . .S DA TA("RRR TH RESHOLD AM T")=$P(REJ RRR(IDX),U ,3)
17167	"RTN","PSO REJUT",231 ,0)
17168	. . .S DA TA("OVERRI DE MSG")=" Automatica lly transf erred due to Reject Resolution Required reject cod e"
17169	"RTN","PSO REJUT",232 ,0)
17170	. . I OPE CC&(CODE'[ 79)&(CODE' [88) S DAT A("OVERRID E MSG")="T ransferred by "_$S(C ODE["eT":" ",CODE["eC ":"",1:"OP ECC.") ; cnf,PSO7. 0358
17171	"RTN","PSO REJUT",233 ,0)
17172	. . I $D( COMMTXT) S :COMMTXT'= "" DATA("O VERRIDE MS G")=DATA(" OVERRIDE M SG")_" "_$ $CLEAN^PSO REJU1($P(C OMMTXT,":" ,2))
17173	"RTN","PSO REJUT",234 ,0)
17174	. . S DAT A("DUR TEX T")=$$CLEA N^PSOREJU1 ($G(REJ(ID X,"DUR FRE E TEXT DES C")))
17175	"RTN","PSO REJUT",235 ,0)
17176	. . S DAT A("DUR ADD MSG TEXT" )=$$CLEAN^ PSOREJU1($ G(REJ(IDX, "DUR ADD M SG TEXT")) )
17177	"RTN","PSO REJUT",236 ,0)
17178	. . ; In NCPDP D0, the Payer Additional Message i s a repeat ing field and we wan t to displ ay as much of the
17179	"RTN","PSO REJUT",237 ,0)
17180	. . ; d ata on the reject in formation screen as possible s o we put t he message s together up to the field
17181	"RTN","PSO REJUT",238 ,0)
17182	. . ; l ength of 1 40
17183	"RTN","PSO REJUT",239 ,0)
17184	. . N CNT ,MSG
17185	"RTN","PSO REJUT",240 ,0)
17186	. . S CNT ="",DATA(" PAYER MESS AGE")=""
17187	"RTN","PSO REJUT",241 ,0)
17188	. . F S CNT=$O(REJ (IDX,"PAYE R MESSAGE" ,CNT)) Q:C NT=""!($L( DATA("PAYE R MESSAGE" ))>140) D
17189	"RTN","PSO REJUT",242 ,0)
17190	. . . S M SG=$$CLEAN ^PSOREJU1( REJ(IDX,"P AYER MESSA GE",CNT))
17191	"RTN","PSO REJUT",243 ,0)
17192	. . . I M SG]"" S DA TA("PAYER MESSAGE")= DATA("PAYE R MESSAGE" )_MSG_" "
17193	"RTN","PSO REJUT",244 ,0)
17194	. . ; Cal l CLEAN ag ain to str ip the ext ra trailin g spaces w e might ha ve added
17195	"RTN","PSO REJUT",245 ,0)
17196	. . S DAT A("PAYER M ESSAGE")=$ $CLEAN^PSO REJU1(DATA ("PAYER ME SSAGE"))
17197	"RTN","PSO REJUT",246 ,0)
17198	. . S DAT A("CODE")= CODE,DATA( "REASON")= $$CLEAN^PS OREJU1($G( REJ(IDX,"R EASON")))
17199	"RTN","PSO REJUT",247 ,0)
17200	. . S DAT A("PHARMAC IST")=$G(U SR),DATA(" INSURANCE NAME")=$$C LEAN^PSORE JU1($G(REJ (IDX,"INSU RANCE NAME ")))
17201	"RTN","PSO REJUT",248 ,0)
17202	. . S DAT A("INSURAN CE POINTER ")=$$CLEAN ^PSOREJU1( $G(REJ(IDX ,"INSURANC E POINTER" )))
17203	"RTN","PSO REJUT",249 ,0)
17204	. . S DAT A("GROUP N AME")=$$CL EAN^PSOREJ U1($G(REJ( IDX,"GROUP NAME"))), DATA("GROU P NUMBER") =$$CLEAN^P SOREJU1($G (REJ(IDX," GROUP NUMB ER")))
17205	"RTN","PSO REJUT",250 ,0)
17206	. . S DAT A("CARDHOL DER ID")=$ $CLEAN^PSO REJU1($G(R EJ(IDX,"CA RDHOLDER I D"))),DATA ("PLAN CON TACT")=$$C LEAN^PSORE JU1($G(REJ (IDX,"PLAN CONTACT") ))
17207	"RTN","PSO REJUT",251 ,0)
17208	. . S DAT A("PREVIOU S FILL")=$ $CLEAN^PSO REJU1($$DA T^PSOREJU1 ($G(REJ(ID X,"PREVIOU S FILL DAT E"))))
17209	"RTN","PSO REJUT",252 ,0)
17210	. . S DAT A("OTHER R EJECTS")=$ $CLEAN^PSO REJU1($$OT H^PSOREJU1 (CODE,$G(R EJ(IDX,"RE J CODE LST "))))
17211	"RTN","PSO REJUT",253 ,0)
17212	. . S DAT A("RESPONS E IEN")=+$ $CLEAN^PSO REJU1($G(R EJ(IDX,"RE SPONSE IEN ")))
17213	"RTN","PSO REJUT",254 ,0)
17214	. . S DAT A("REASON SVC CODE") =$$REASON^ PSOREJU2($ G(REJ(IDX, "REASON")) ),DATA("CO B")=IDX
17215	"RTN","PSO REJUT",255 ,0)
17216	. . S DAT A("MESSAGE ")=$$CLEAN ^PSOREJU1( $G(REJ(IDX ,"MESSAGE" )))
17217	"RTN","PSO REJUT",256 ,0)
17218	. . S DAT A("DUR RES PONSE DATA ")=$$CLEAN ^PSOREJU1( $G(REJ(IDX ,"DUR RESP ONSE DATA" )))
17219	"RTN","PSO REJUT",257 ,0)
17220	. . S DAT A("BIN")=$ $CLEAN^PSO REJU1($G(R EJ(IDX,"BI N")))
17221	"RTN","PSO REJUT",258 ,0)
17222	. . S DAT A("PCN")=$ $CLEAN^PSO REJU1($G(R EJ(IDX,"PC N")))
17223	"RTN","PSO REJUT",259 ,0)
17224	. . D SAV E(RX,RFL,. DATA)
17225	"RTN","PSO REJUT",260 ,0)
17226	L -^PSRX( "REJ",RX)
17227	"RTN","PSO REJUT",261 ,0)
17228	Q
17229	"RTN","PSO RXRP2")
17230	0^1^B37627 986
17231	"RTN","PSO RXRP2",1,0 )
17232	PSORXRP2 ; BIR/SAB-ma in menu en try reprin t of a Rx label ;10/ 5/07 7:45a m
17233	"RTN","PSO RXRP2",2,0 )
17234	;;7.0;OUT PATIENT PH ARMACY;1 1,27,120,1 38,135,156 ,185,280,2 51,367,478 ;DEC 199 7;Build 15
17235	"RTN","PSO RXRP2",3,0 )
17236	;External reference s PSOL and PSOUL^PSS LOCK suppo rted by DB IA 2789
17237	"RTN","PSO RXRP2",4,0 )
17238	;External reference ^PS(55 su pported by DBIA 2228
17239	"RTN","PSO RXRP2",5,0 )
17240	;External reference to ^PSDRU G supporte d by DBIA 221
17241	"RTN","PSO RXRP2",6,0 )
17242	I '$D(PSO PAR) D ^PS OLSET I '$ D(PSOPAR) G KILL
17243	"RTN","PSO RXRP2",7,0 )
17244	LRP N PSOD ISP,PSOMGR EP,PSOFILL
17245	"RTN","PSO RXRP2",8,0 )
17246	K REPRINT W !! S DI C("S")="I $P($G(^(0) ),""^"",2) ,$D(^(""ST A"")),$P($ G(^(""STA" ")),""^"") <10",DIC=" ^PSRX(",DI C("A")="Re print Pres cription L abel: ",DI C(0)="QEAZ " D ^DIC K P,DIC("A" ) I Y<0!(" ^"[X) K PC OM,PCOMX G KILL
17247	"RTN","PSO RXRP2",9,0 )
17248	S (PPL,DA ,RX,PSORPR X)=+Y,PDA= Y(0),RXF=0 ,ZD(DA)=DT ,REPRINT=1 ,STA=+$G(^ PSRX(+Y,"S TA"))
17249	"RTN","PSO RXRP2",10, 0)
17250	; PSO74 78
17251	"RTN","PSO RXRP2",11, 0)
17252	S PSOFILL =$$LSTRFL^ PSOBPSU1(P SORPRX)
17253	"RTN","PSO RXRP2",12, 0)
17254	I $$FIND^ PSOREJUT(P SORPRX,PSO FILL) W $C (7),!,"NOT ALLOWED! Rx has OPE N 3rd Part y Payer Re ject." D K ILL G LRP
17255	"RTN","PSO RXRP2",13, 0)
17256	D PSOL^PS SLOCK(PSOR PRX) I '$G (PSOMSG) W !!,$S($P( $G(PSOMSG) ,"^",2)'=" ":$P($G(PS OMSG),"^", 2),1:"Anot her person is editin g this ord er."),! K PSOMSG G L RP
17257	"RTN","PSO RXRP2",14, 0)
17258	I $P(^PSR X(RX,"STA" ),"^")=14 W $C(7),!, "Cannot Re print! Dis continued by Provide r." D ULR, KILL Q
17259	"RTN","PSO RXRP2",15, 0)
17260	I $P(^PSR X(RX,"STA" ),"^")=15 W $C(7),!, "Cannot Re print! Dis continued due to edi ting." D U LR,KILL Q
17261	"RTN","PSO RXRP2",16, 0)
17262	I $P(^PSR X(RX,"STA" ),"^")=16 W $C(7),!, "Cannot Re print! Pla ced on HOL D by Provi der." D UL R,KILL Q
17263	"RTN","PSO RXRP2",17, 0)
17264	I DT>$P(^ PSRX(RX,2) ,"^",6) D D ULR,KIL L G LRP
17265	"RTN","PSO RXRP2",18, 0)
17266	.W !,$C(7 ),"Medicat ion Expire d on "_$E( $P(^PSRX(R X,2),"^",6 ),4,5)_"-" _$E($P(^(2 ),"^",6),6 ,7)_"-"_$E ($P(^(2)," ^",6),2,3) I $P(^PSR X(DA,"STA" ),"^")<11 S $P(^PSRX (DA,"STA") ,"^")=11 D
17267	"RTN","PSO RXRP2",19, 0)
17268	..S COMM= "Medicatio n Expired on "_$E($P (^PSRX(RX, 2),"^",6), 4,5)_"-"_$ E($P(^(2), "^",6),6,7 )_"-"_$E($ P(^(2),"^" ,6),2,3) D EN^PSOHLS N1(DA,"SC" ,"ZE",COMM ) K COMM
17269	"RTN","PSO RXRP2",20, 0)
17270	S DFN=$P( PDA,"^",2) D DEM^VAD PT I $P(VA DM(6),"^", 2)]"" D G LRP
17271	"RTN","PSO RXRP2",21, 0)
17272	.W $C(7), !!,$P(^DPT ($P(PDA,"^ ",2),0),"^ ")_" Died "_$P(VADM( 6),"^",2)_ ".",!
17273	"RTN","PSO RXRP2",22, 0)
17274	.S $P(^PS RX(RX,"STA "),"^")=12 ,PCOM="Pat ient Expir ed "_$P(VA DM(6),"^", 2),ST="C" D EN^PSOHL SN1(RX,"OD ","",PCOM, "A")
17275	"RTN","PSO RXRP2",23, 0)
17276	.D ACT1,U LR,KILL
17277	"RTN","PSO RXRP2",24, 0)
17278	S X=$O(^P S(52.5,"B" ,DA,0)) I X,'$G(^PS( 52.5,X,"P" )) W !,$C( 7),"Rx may NOT be pr inted usin g this opt ion, use S USPENSE FU NCTIONS Op tions." K X D ULR,KI LL G LRP
17279	"RTN","PSO RXRP2",25, 0)
17280	I $G(X)'> 0 G GOOD
17281	"RTN","PSO RXRP2",26, 0)
17282	S XX=$P($ G(^PS(52.5 ,X,0)),U,7 ) I $G(XX) ']"" G GOO D
17283	"RTN","PSO RXRP2",27, 0)
17284	I $G(XX)= "Q" W !,"R X CAN NOT BE PRINTED using thi s option, use SUSPEN SE FUNCTIO NS Options ." K X,XX D ULR,KILL G LRP
17285	"RTN","PSO RXRP2",28, 0)
17286	I $G(XX)= "L" W !,"R X is being transmitt ed to the CMOP and c an not be reprinted now." K X, XX D ULR,K ILL G LRP
17287	"RTN","PSO RXRP2",29, 0)
17288	GOOD K X
17289	"RTN","PSO RXRP2",30, 0)
17290	I $D(^PS( 52.4,DA)) W !,"Presc ription is Non-Verif ied",!! D ULR,KILL G LRP
17291	"RTN","PSO RXRP2",31, 0)
17292	S DFN=$P( ^PSRX(DA,0 ),"^",2) I $D(^PS(52 .4,"AREF", DFN,DA)) W !,"Prescr iption is waiting fo r others t o be verif ied",!! D ULR,KILL G LRP
17293	"RTN","PSO RXRP2",32, 0)
17294	I $G(PSOD IV),$D(^PS RX(DA,2)), +$P(^(2)," ^",9),+$P( ^(2),"^",9 )'=PSOSITE S PSPOP=0 ,PSPRXN=DA D CHK1^PS OUTLA I PS POP D ULR, KILL G LRP
17295	"RTN","PSO RXRP2",33, 0)
17296	I STA=3 W !?3,"Pres cription i s on Hold" D ULR,KIL L G LRP
17297	"RTN","PSO RXRP2",34, 0)
17298	I STA=4 W !?3,"Pres cription i s Pending Due to Dru g Interact ions" D UL R,KILL G L RP
17299	"RTN","PSO RXRP2",35, 0)
17300	I STA=12 W !?3,"Pre scription is Discont inued" D U LR,KILL G LRP
17301	"RTN","PSO RXRP2",36, 0)
17302	I $G(^PS( 55,"ASTALK ",DFN)) W !,"Patient is a Scri pTalk pati ent. Use S cripTalk l abel for p rescriptio n bottle." ,!
17303	"RTN","PSO RXRP2",37, 0)
17304	D ICN^PSO DPT(DFN)
17305	"RTN","PSO RXRP2",38, 0)
17306	S COPIES= $S($P(PDA, "^",18)]"" :$P(PDA,"^ ",18),1:1)
17307	"RTN","PSO RXRP2",39, 0)
17308	K DIR S D IR("A")="N umber of C opies? ",D IR("B")=CO PIES,DIR(0 )="N^1:99: 0",DIR("?" )="Enter t he number of copies you want ( 1 TO 99)"
17309	"RTN","PSO RXRP2",40, 0)
17310	D ^DIR K DIR I $D(D IRUT) D UL R,KILL G L RP
17311	"RTN","PSO RXRP2",41, 0)
17312	S COPIES= Y
17313	"RTN","PSO RXRP2",42, 0)
17314	K DIR S D IR("A")="P rint adhes ive portio n of label only? ",D IR(0)="Y", DIR("B")=" No",DIR("? ",1)="If e ntire labe l, includi ng trailer s are to p rint press RETURN fo r default. "
17315	"RTN","PSO RXRP2",43, 0)
17316	S DIR("?" )="Else if only bott le and mai ling label s are to p rint enter Y or YES. " D ^DIR K DIR I $D( DUOUT) D U LR,KILL G LRP
17317	"RTN","PSO RXRP2",44, 0)
17318	I $D(DIRU T) D ULR G KILL
17319	"RTN","PSO RXRP2",45, 0)
17320	S SIDE=Y
17321	"RTN","PSO RXRP2",46, 0)
17322	I $P(PSOP AR,"^",30) ,$$GET1^DI Q(59,PSOSI TE_",",105 ,"I")=2.4 D
17323	"RTN","PSO RXRP2",47, 0)
17324	.I $S($P( PSOPAR,"^" ,30)=3:1,$ P(PSOPAR," ^",30)=4:1 ,1:0),'$$G ET1^DIQ(50 ,$P(PDA,"^ ",6),28,"I ") Q
17325	"RTN","PSO RXRP2",48, 0)
17326	.K DIR,DI RUT S DIR( "A")="Do y ou want to resend to Dispensin g System D evice",DIR (0)="Y",DI R("B")="No " D ^DIR K DIR Q:$D( DIRUT) S PSODISP=$S (Y:0,1:1)
17327	"RTN","PSO RXRP2",49, 0)
17328	I $D(DIRU T) D ULR,K ILL G LRP
17329	"RTN","PSO RXRP2",50, 0)
17330	;
17331	"RTN","PSO RXRP2",51, 0)
17332	; FDA Med ication Gu ide Reprin t
17333	"RTN","PSO RXRP2",52, 0)
17334	I $$GET1^ DIQ(59,PSO SITE,134)' ="",$$MGON FILE^PSOFD AUT(DA) D I $D(DIRU T) D ULR,K ILL G LRP
17335	"RTN","PSO RXRP2",53, 0)
17336	. K DIR,D IRUT S DIR ("A")="Rep rint the F DA Medicat ion Guide" ,DIR(0)="Y ",DIR("B") ="No"
17337	"RTN","PSO RXRP2",54, 0)
17338	. D ^DIR K DIR Q:$D (DIRUT) S PSOMGREP= Y
17339	"RTN","PSO RXRP2",55, 0)
17340	;
17341	"RTN","PSO RXRP2",56, 0)
17342	D ACT I $ D(DIRUT) D ULR,KILL G LRP
17343	"RTN","PSO RXRP2",57, 0)
17344	I $D(PCOM ) D ULR,KI LL G LRP
17345	"RTN","PSO RXRP2",58, 0)
17346	F I=1,2,4 ,6,7,9,13, 16 S P(I)= $P(PDA,"^" ,I)
17347	"RTN","PSO RXRP2",59, 0)
17348	S P(6)=+P (6) I $D(^ PSRX(DA,"T N")),^("TN ")]"" S P( 6)=^("TN")
17349	"RTN","PSO RXRP2",60, 0)
17350	W !!,"Rx # "_P(1),? 23,$E(P(13 ),4,5)_"/" _$E(P(13), 6,7)_"/"_$ E(P(13),2, 3),!,$S($D (^DPT(+P(2 ),0)):$P(^ (0),"^"),1 :"Not on F ile"),?30, "#"_P(7),!
17351	"RTN","PSO RXRP2",61, 0)
17352	I $P($G(^ PSRX(DA,"S IG")),"^", 2) S D=0 D K D,FSIG
17353	"RTN","PSO RXRP2",62, 0)
17354	.D FSIG^P SOUTLA("R" ,DA,75) F S D=$O(FS IG(D)) W ! ,FSIG(D) Q :'$O(FSIG( D))
17355	"RTN","PSO RXRP2",63, 0)
17356	E D EN3^ PSOUTLA1(D A,75) S D= 0 F S D=$ O(BSIG(D)) W !,BSIG( D) Q:'$O(B SIG(D))
17357	"RTN","PSO RXRP2",64, 0)
17358	K D,BSIG
17359	"RTN","PSO RXRP2",65, 0)
17360	;PSO728 0 If Trade name, don 't lookup in ^PSDRUG
17361	"RTN","PSO RXRP2",66, 0)
17362	W !!,$S($ G(^PSRX(DA ,"TN"))]"" :P(6),(P(6 )=+P(6))&$ D(^PSDRUG( P(6),0)):$ P(^(0),"^" ),1:P(6)), ! S PHYS=$ S($D(^VA(2 00,+P(4),0 )):$P(^(0) ,"^"),1:"U nknown") W PHYS K PH YS
17363	"RTN","PSO RXRP2",67, 0)
17364	W ?25,$S( $D(^VA(200 ,+P(16),0) ):$P(^(0), "^"),1:"Un known"),!, "# of Refi lls: "_$G( P(9))
17365	"RTN","PSO RXRP2",68, 0)
17366	I $G(RX) D
17367	"RTN","PSO RXRP2",69, 0)
17368	.S RXRP(R X)=1_"^"_C OPIES_"^"_ SIDE
17369	"RTN","PSO RXRP2",70, 0)
17370	.I $G(PSO MGREP)=1 S RXRP(RX," MG")=1
17371	"RTN","PSO RXRP2",71, 0)
17372	.I $G(PSO DISP)=1 S RXRP(RX,"R P")=1
17373	"RTN","PSO RXRP2",72, 0)
17374	.S RXFL(R X)=0 F ZZZ =0:0 S ZZZ =$O(^PSRX( RX,1,ZZZ)) Q:'ZZZ S RXFL(RX)= ZZZ
17375	"RTN","PSO RXRP2",73, 0)
17376	D @$S($P( $G(PSOPAR) ,"^",26):" ^PSORXL",1 :"Q^PSORXL ") K PSPOP ,PPL,COPIE S,SIDE,REP RINT,PCOM, IOP,PSL,PS NP,ZZZ,RXF L(+$G(RX)) D ULR,KIL L G LRP
17377	"RTN","PSO RXRP2",74, 0)
17378	;
17379	"RTN","PSO RXRP2",75, 0)
17380	ACT K DIR S DIR("A") ="Comments : ",DIR(0) ="FA^5:60" ,DIR("?")= "5-60 char acters inp ut require d for acti vity log." S:$G(PCOM X)]"" DIR( "B")=$G(PC OMX)
17381	"RTN","PSO RXRP2",76, 0)
17382	D ^DIR K DIR Q:$D(D IRUT)!($D( DIROUT)) S (PCOM,PC OMX)=X
17383	"RTN","PSO RXRP2",77, 0)
17384	I '$D(PSO CLC) S PSO CLC=DUZ
17385	"RTN","PSO RXRP2",78, 0)
17386	ACT1 S RXF =0 F J=0:0 S J=$O(^P SRX(DA,1,J )) Q:'J S RXF=J S:J >5 RXF=J+1
17387	"RTN","PSO RXRP2",79, 0)
17388	S IR=0 F J=0:0 S J= $O(^PSRX(D A,"A",J)) Q:'J S IR =J
17389	"RTN","PSO RXRP2",80, 0)
17390	S IR=IR+1 ,^PSRX(DA, "A",0)="^5 2.3DA^"_IR _"^"_IR
17391	"RTN","PSO RXRP2",81, 0)
17392	D NOW^%DT C S ^PSRX( DA,"A",IR, 0)=%_"^"_$ S($G(ST)'= "C":"W",1: "C")_"^"_D UZ_"^"_RXF _"^"_PCOM_ $S($G(ST)' ="C":" ("_ COPIES_" C OPIES)",1: ""),PCOMX= PCOM K PC, IR,PS,PCOM ,XX,%,%H,% I,RXF
17393	"RTN","PSO RXRP2",82, 0)
17394	S:$P(^PSR X(DA,2),"^ ",15)&($G( ST)'="C") $P(^PSRX(D A,2),"^",1 4)=1
17395	"RTN","PSO RXRP2",83, 0)
17396	Q
17397	"RTN","PSO RXRP2",84, 0)
17398	;
17399	"RTN","PSO RXRP2",85, 0)
17400	KILL K %,D IR,DUOUT,D TOUT,DIROU T,DIRUT,C, DA,DIC,I,J ,JJJ,K,RX, RXF,X,Y,Z, ZD,DFN,P,P DA,PSPRXN, COPIES,SID E,PPL,REPR INT,PSXSTA T,PSORPRX, PSOMSG D K VA^VADPT Q
17401	"RTN","PSO RXRP2",86, 0)
17402	;
17403	"RTN","PSO RXRP2",87, 0)
17404	ULR ;
17405	"RTN","PSO RXRP2",88, 0)
17406	I $G(PSOR PRX) D PSO UL^PSSLOCK (PSORPRX)
17407	"RTN","PSO RXRP2",89, 0)
17408	Q
17409	"UP",52,52 .25,-1)
17410	52^REJ
17411	"UP",52,52 .25,0)
17412	52.25
17413	"VER")
17414	8.0^22.2
17415	"^DD",52,5 2.25,34,0)
17416	PCN^FJ10^^ 2;10^K:$L( X)>10!($L( X)<1) X
17417	"^DD",52,5 2.25,34,3)
17418	Answer mus t be 1-10 characters in length .
17419	"^DD",52,5 2.25,34,21 ,0)
17420	^.001^1^1^ 3170628^^
17421	"^DD",52,5 2.25,34,21 ,1,0)
17422	Number whi ch will un iquely ide ntify the submitter of the cla im.
17423	"^DD",52,5 2.25,34,"D T")
17424	3170628
17425	INSTALL NAME
17426	PSX2.081
17427	"BLD",1052 7,0)
17428	PSX2.081 ^CMOP^0^31 70629^y
17429	"BLD",1052 7,1,0)
17430	^^1^1^3170 504^
17431	"BLD",1052 7,1,1,0)
17432	MCCF EDI T AS EPHARMA CY BUILD 2
17433	"BLD",1052 7,4,0)
17434	^9.64PA^^
17435	"BLD",1052 7,6.3)
17436	15
17437	"BLD",1052 7,"ABPKG")
17438	n
17439	"BLD",1052 7,"KRN",0)
17440	^9.67PA^77 9.2^20
17441	"BLD",1052 7,"KRN",.4 ,0)
17442	.4
17443	"BLD",1052 7,"KRN",.4 01,0)
17444	.401
17445	"BLD",1052 7,"KRN",.4 02,0)
17446	.402
17447	"BLD",1052 7,"KRN",.4 03,0)
17448	.403
17449	"BLD",1052 7,"KRN",.5 ,0)
17450	.5
17451	"BLD",1052 7,"KRN",.8 4,0)
17452	.84
17453	"BLD",1052 7,"KRN",3. 6,0)
17454	3.6
17455	"BLD",1052 7,"KRN",3. 8,0)
17456	3.8
17457	"BLD",1052 7,"KRN",9. 2,0)
17458	9.2
17459	"BLD",1052 7,"KRN",9. 8,0)
17460	9.8
17461	"BLD",1052 7,"KRN",9. 8,"NM",0)
17462	^9.68A^4^4
17463	"BLD",1052 7,"KRN",9. 8,"NM",1,0 )
17464	PSXBPSMS^^ 0^B3346682 7
17465	"BLD",1052 7,"KRN",9. 8,"NM",2,0 )
17466	PSXRPPL1^^ 0^B5479360 1
17467	"BLD",1052 7,"KRN",9. 8,"NM",3,0 )
17468	PSXRPPL2^^ 0^B7202940 9
17469	"BLD",1052 7,"KRN",9. 8,"NM",4,0 )
17470	PSXRPPL^^0 ^B68822537
17471	"BLD",1052 7,"KRN",9. 8,"NM","B" ,"PSXBPSMS ",1)
17472
17473	"BLD",1052 7,"KRN",9. 8,"NM","B" ,"PSXRPPL" ,4)
17474
17475	"BLD",1052 7,"KRN",9. 8,"NM","B" ,"PSXRPPL1 ",2)
17476
17477	"BLD",1052 7,"KRN",9. 8,"NM","B" ,"PSXRPPL2 ",3)
17478
17479	"BLD",1052 7,"KRN",19 ,0)
17480	19
17481	"BLD",1052 7,"KRN",19 ,"NM",0)
17482	^9.68A^^
17483	"BLD",1052 7,"KRN",19 .1,0)
17484	19.1
17485	"BLD",1052 7,"KRN",10 1,0)
17486	101
17487	"BLD",1052 7,"KRN",40 9.61,0)
17488	409.61
17489	"BLD",1052 7,"KRN",77 1,0)
17490	771
17491	"BLD",1052 7,"KRN",77 9.2,0)
17492	779.2
17493	"BLD",1052 7,"KRN",87 0,0)
17494	870
17495	"BLD",1052 7,"KRN",89 89.51,0)
17496	8989.51
17497	"BLD",1052 7,"KRN",89 89.52,0)
17498	8989.52
17499	"BLD",1052 7,"KRN",89 94,0)
17500	8994
17501	"BLD",1052 7,"KRN","B ",.4,.4)
17502
17503	"BLD",1052 7,"KRN","B ",.401,.40 1)
17504
17505	"BLD",1052 7,"KRN","B ",.402,.40 2)
17506
17507	"BLD",1052 7,"KRN","B ",.403,.40 3)
17508
17509	"BLD",1052 7,"KRN","B ",.5,.5)
17510
17511	"BLD",1052 7,"KRN","B ",.84,.84)
17512
17513	"BLD",1052 7,"KRN","B ",3.6,3.6)
17514
17515	"BLD",1052 7,"KRN","B ",3.8,3.8)
17516
17517	"BLD",1052 7,"KRN","B ",9.2,9.2)
17518
17519	"BLD",1052 7,"KRN","B ",9.8,9.8)
17520
17521	"BLD",1052 7,"KRN","B ",19,19)
17522
17523	"BLD",1052 7,"KRN","B ",19.1,19. 1)
17524
17525	"BLD",1052 7,"KRN","B ",101,101)
17526
17527	"BLD",1052 7,"KRN","B ",409.61,4 09.61)
17528
17529	"BLD",1052 7,"KRN","B ",771,771)
17530
17531	"BLD",1052 7,"KRN","B ",779.2,77 9.2)
17532
17533	"BLD",1052 7,"KRN","B ",870,870)
17534
17535	"BLD",1052 7,"KRN","B ",8989.51, 8989.51)
17536
17537	"BLD",1052 7,"KRN","B ",8989.52, 8989.52)
17538
17539	"BLD",1052 7,"KRN","B ",8994,899 4)
17540
17541	"BLD",1052 7,"QUES",0 )
17542	^9.62^^
17543	"BLD",1052 7,"REQB",0 )
17544	^9.611^^
17545	"MBREQ")
17546	1
17547	"PKG",519, -1)
17548	1^1
17549	"PKG",519, 0)
17550	CMOP^PSX^C onsolidate d Mail Out patient Ph armacy
17551	"PKG",519, 22,0)
17552	^9.49I^1^1
17553	"PKG",519, 22,1,0)
17554	2.0^297041 1^2970412^ 1
17555	"PKG",519, 22,1,"PAH" ,1,0)
17556	81^3170629 ^520824639
17557	"PKG",519, 22,1,"PAH" ,1,1,0)
17558	^^1^1^3170 629
17559	"PKG",519, 22,1,"PAH" ,1,1,1,0)
17560	MCCF EDI T AS EPHARMA CY BUILD 2
17561	"QUES","XP F1",0)
17562	Y
17563	"QUES","XP F1","??")
17564	^D REP^XPD H
17565	"QUES","XP F1","A")
17566	Shall I wr ite over y our \|FLAG\| File
17567	"QUES","XP F1","B")
17568	YES
17569	"QUES","XP F1","M")
17570	D XPF1^XPD IQ
17571	"QUES","XP F2",0)
17572	Y
17573	"QUES","XP F2","??")
17574	^D DTA^XPD H
17575	"QUES","XP F2","A")
17576	Want my da ta \|FLAG\| yours
17577	"QUES","XP F2","B")
17578	YES
17579	"QUES","XP F2","M")
17580	D XPF2^XPD IQ
17581	"QUES","XP I1",0)
17582	YO
17583	"QUES","XP I1","??")
17584	^D INHIBIT ^XPDH
17585	"QUES","XP I1","A")
17586	Want KIDS to INHIBIT LOGONs du ring the i nstall
17587	"QUES","XP I1","B")
17588	NO
17589	"QUES","XP I1","M")
17590	D XPI1^XPD IQ
17591	"QUES","XP M1",0)
17592	PO^VA(200, :EM
17593	"QUES","XP M1","??")
17594	^D MG^XPDH
17595	"QUES","XP M1","A")
17596	Enter the Coordinato r for Mail Group '\|F LAG\|'
17597	"QUES","XP M1","B")
17598
17599	"QUES","XP M1","M")
17600	D XPM1^XPD IQ
17601	"QUES","XP O1",0)
17602	Y
17603	"QUES","XP O1","??")
17604	^D MENU^XP DH
17605	"QUES","XP O1","A")
17606	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
17607	"QUES","XP O1","B")
17608	NO
17609	"QUES","XP O1","M")
17610	D XPO1^XPD IQ
17611	"QUES","XP Z1",0)
17612	Y
17613	"QUES","XP Z1","??")
17614	^D OPT^XPD H
17615	"QUES","XP Z1","A")
17616	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
17617	"QUES","XP Z1","B")
17618	NO
17619	"QUES","XP Z1","M")
17620	D XPZ1^XPD IQ
17621	"QUES","XP Z2",0)
17622	Y
17623	"QUES","XP Z2","??")
17624	^D RTN^XPD H
17625	"QUES","XP Z2","A")
17626	Want to MO VE routine s to other CPUs
17627	"QUES","XP Z2","B")
17628	NO
17629	"QUES","XP Z2","M")
17630	D XPZ2^XPD IQ
17631	"RTN")
17632	4
17633	"RTN","PSX BPSMS")
17634	0^1^B33466 827
17635	"RTN","PSX BPSMS",1,0 )
17636	PSXBPSMS ; BIRM/BSR - BPS (ECME ) Utilitie s ;10/29/9 8 2:13 PM
17637	"RTN","PSX BPSMS",2,0 )
17638	;;2.0;CMO P;48,77, 81;11 Ap r 97;Build 15
17639	"RTN","PSX BPSMS",3,0 )
17640	;Referenc e to $$RXF LDT^PSOBPS UT support ed by IA 4 701
17641	"RTN","PSX BPSMS",4,0 )
17642	;Referenc e to LOG^B PSOSL supp orted by I CR# 6764
17643	"RTN","PSX BPSMS",5,0 )
17644	;Referenc e to IEN59 ^BPSOSRX s upported b y ICR# 441 2
17645	"RTN","PSX BPSMS",6,0 )
17646	;Referenc e to ELIGD ISP^PSOREJ P1 support ed by ICR# 6763
17647	"RTN","PSX BPSMS",7,0 )
17648	;
17649	"RTN","PSX BPSMS",8,0 )
17650	; PSXBPSM S sends an email at the conclu sion of th e CMOP pro cess to
17651	"RTN","PSX BPSMS",9,0 )
17652	; communi cate to th e users wh ich prescr iptions we re left in the
17653	"RTN","PSX BPSMS",10, 0)
17654	; suspens e queue an d not sent to the CM OP facilit y. There are two
17655	"RTN","PSX BPSMS",11, 0)
17656	; scenari os that co uld lead t o this; ei ther the p rescriptio n is
17657	"RTN","PSX BPSMS",12, 0)
17658	; non-bil lable, or a response from the third part y payer wa s not
17659	"RTN","PSX BPSMS",13, 0)
17660	; receive d by the t ime the CM OP process stopped w aiting for
17661	"RTN","PSX BPSMS",14, 0)
17662	; respons es (see SD T^PSXRPPL and CHKDFN ^PSXRPPL2) . Each of the
17663	"RTN","PSX BPSMS",15, 0)
17664	; prescri ptions lis ted in ^TM P("PSXEPHI N" are inc luded in t his email.
17665	"RTN","PSX BPSMS",16, 0)
17666	; That gl obal is se t only in EPH^PSXRPP L2, which is called only
17667	"RTN","PSX BPSMS",17, 0)
17668	; by EPHA RM^PSXRPPL 2.
17669	"RTN","PSX BPSMS",18, 0)
17670	;
17671	"RTN","PSX BPSMS",19, 0)
17672	EN ;Main e ntry point .
17673	"RTN","PSX BPSMS",20, 0)
17674	N DFN,DIV ,EMCNT,ORC NT,PATCNT, PATNM,PSXA CTIVITY,PT LST,RFL,RX ,SSN,VADM
17675	"RTN","PSX BPSMS",21, 0)
17676	K ^TMP("P SXEPHOUT", $J)
17677	"RTN","PSX BPSMS",22, 0)
17678	S ^XTMP(" PSXBPSMS", 0)=$$FMADD ^XLFDT(DT, 35)_"^"_DT
17679	"RTN","PSX BPSMS",23, 0)
17680	S (EMCNT, ORCNT,PATC NT)=0
17681	"RTN","PSX BPSMS",24, 0)
17682	;
17683	"RTN","PSX BPSMS",25, 0)
17684	S DIV=""
17685	"RTN","PSX BPSMS",26, 0)
17686	F S DIV= $O(^TMP("P SXEPHIN",$ J,DIV)) Q: DIV="" D
17687	"RTN","PSX BPSMS",27, 0)
17688	. D HEADE R(DIV)
17689	"RTN","PSX BPSMS",28, 0)
17690	. S RX=""
17691	"RTN","PSX BPSMS",29, 0)
17692	. F S RX =$O(^TMP(" PSXEPHIN", $J,DIV,RX) ) Q:RX="" D
17693	"RTN","PSX BPSMS",30, 0)
17694	. . S RFL =+$G(^TMP( "PSXEPHIN" ,$J,DIV,RX ))
17695	"RTN","PSX BPSMS",31, 0)
17696	. . S ^XT MP("PSXBPS MS",1,RX,R FL,DT)=""
17697	"RTN","PSX BPSMS",32, 0)
17698	. . ;
17699	"RTN","PSX BPSMS",33, 0)
17700	. . ; Add an entry to the dev eloper's l og, BPS LO G, file# 9 002313.12.
17701	"RTN","PSX BPSMS",34, 0)
17702	. . ;
17703	"RTN","PSX BPSMS",35, 0)
17704	. . D LOG ^BPSOSL($$ IEN59^BPSO SRX(RX,RFL ),$T(+0)_" -Prescript ion being left on CM OP queue") ; ICR #4 412,6764
17705	"RTN","PSX BPSMS",36, 0)
17706	. . ;
17707	"RTN","PSX BPSMS",37, 0)
17708	. . ; Add an entry to the Act ivity Log for this R x (sub-fil e# 52.3).
17709	"RTN","PSX BPSMS",38, 0)
17710	. . ;
17711	"RTN","PSX BPSMS",39, 0)
17712	. . I $$S TATUS^PSOB PSUT(RX,RF L)="IN PRO GRESS" D ; ICR #470 1
17713	"RTN","PSX BPSMS",40, 0)
17714	. . . S P SXACTIVITY =$$ELIGDIS P^PSOREJP1 (RX,RFL)_" -Rx placed on Suspen se due to ECME IN PR OGRESS sta tus" ; IC R #6763
17715	"RTN","PSX BPSMS",41, 0)
17716	. . . D R XACT^PSOBP SU2(RX,RFL ,PSXACTIVI TY,"M",DUZ ) ; ICR # 4970
17717	"RTN","PSX BPSMS",42, 0)
17718	. . ;
17719	"RTN","PSX BPSMS",43, 0)
17720	. . ; Det ermine the SSN and P atient Nam e.
17721	"RTN","PSX BPSMS",44, 0)
17722	. . ;
17723	"RTN","PSX BPSMS",45, 0)
17724	. . S DFN =+$P(^PSRX (RX,0),"^" ,2) D DEM^ VADPT
17725	"RTN","PSX BPSMS",46, 0)
17726	. . S SSN =$E($P(VAD M(2),U),6, 9),PATNM=( VADM(1))
17727	"RTN","PSX BPSMS",47, 0)
17728	. . ;
17729	"RTN","PSX BPSMS",48, 0)
17730	. . ; Inc rement the count of orders (Rx s) and uni que patien ts.
17731	"RTN","PSX BPSMS",49, 0)
17732	. . ;
17733	"RTN","PSX BPSMS",50, 0)
17734	. . S ORC NT=$G(ORCN T)+1
17735	"RTN","PSX BPSMS",51, 0)
17736	. . D PAT CNT(PATNM_ SSN)
17737	"RTN","PSX BPSMS",52, 0)
17738	. . ;
17739	"RTN","PSX BPSMS",53, 0)
17740	. . D FOR MAT
17741	"RTN","PSX BPSMS",54, 0)
17742	. D FOOTE R(DIV)
17743	"RTN","PSX BPSMS",55, 0)
17744	D MAIL,CL EAN
17745	"RTN","PSX BPSMS",56, 0)
17746	Q
17747	"RTN","PSX BPSMS",57, 0)
17748	;
17749	"RTN","PSX BPSMS",58, 0)
17750	; Format Row
17751	"RTN","PSX BPSMS",59, 0)
17752	FORMAT ;
17753	"RTN","PSX BPSMS",60, 0)
17754	N LTXT
17755	"RTN","PSX BPSMS",61, 0)
17756	S LTXT=$$ GET1^DIQ(5 2,RX,.01)_ "/"_RFL
17757	"RTN","PSX BPSMS",62, 0)
17758	S $E(LTXT ,17)=$E(PA TNM,1,18)_ "("_SSN_") ",$E(LTXT, 42)=$E($$G ET1^DIQ(52 ,RX,6),1,2 3)
17759	"RTN","PSX BPSMS",63, 0)
17760	S $E(LTXT ,67)=$$TRA NS(RX,RFL)
17761	"RTN","PSX BPSMS",64, 0)
17762	D STORELN (LTXT)
17763	"RTN","PSX BPSMS",65, 0)
17764	Q
17765	"RTN","PSX BPSMS",66, 0)
17766	;
17767	"RTN","PSX BPSMS",67, 0)
17768	;Count pa tients.
17769	"RTN","PSX BPSMS",68, 0)
17770	PATCNT(NAM SSN) ;
17771	"RTN","PSX BPSMS",69, 0)
17772	I '$D(PTL ST(NAMSSN) ) D
17773	"RTN","PSX BPSMS",70, 0)
17774	.S PTLST( NAMSSN)=""
17775	"RTN","PSX BPSMS",71, 0)
17776	.S PATCNT =$G(PATCNT )+1
17777	"RTN","PSX BPSMS",72, 0)
17778	Q
17779	"RTN","PSX BPSMS",73, 0)
17780	;
17781	"RTN","PSX BPSMS",74, 0)
17782	;Build he ader.
17783	"RTN","PSX BPSMS",75, 0)
17784	HEADER(DIV ) ;
17785	"RTN","PSX BPSMS",76, 0)
17786	D STORELN ("Division : "_$$GET1 ^DIQ(59,DI V,.01))
17787	"RTN","PSX BPSMS",77, 0)
17788	D STORELN ($TR($J("" ,79)," "," -"))
17789	"RTN","PSX BPSMS",78, 0)
17790	D STORELN (" NOT TRANSMITTE D")
17791	"RTN","PSX BPSMS",79, 0)
17792	D STORELN ("RX#/Fill PA TIENT(LAST 4) DRUG 1S T DT #DAY S")
17793	"RTN","PSX BPSMS",80, 0)
17794	D STORELN ($TR($J("" ,79)," "," -"))
17795	"RTN","PSX BPSMS",81, 0)
17796	Q
17797	"RTN","PSX BPSMS",82, 0)
17798	;
17799	"RTN","PSX BPSMS",83, 0)
17800	;Output p atient cou nt & presc riptions c ount & div ision numb er
17801	"RTN","PSX BPSMS",84, 0)
17802	FOOTER(DIV N) ;
17803	"RTN","PSX BPSMS",85, 0)
17804	D STORELN (" ")
17805	"RTN","PSX BPSMS",86, 0)
17806	D STORELN ("Total "_ $$GET1^DIQ (59,DIVN,. 01)_": "_P ATCNT_" Pa tients and "_ORCNT_" Prescript ions.")
17807	"RTN","PSX BPSMS",87, 0)
17808	D STORELN (" ")
17809	"RTN","PSX BPSMS",88, 0)
17810	K PTLST S (ORCNT,PA TCNT)=0
17811	"RTN","PSX BPSMS",89, 0)
17812	Q
17813	"RTN","PSX BPSMS",90, 0)
17814	;
17815	"RTN","PSX BPSMS",91, 0)
17816	; MAIL bu ilds the e mail messa ge and sen ds it to u sers who h old the
17817	"RTN","PSX BPSMS",92, 0)
17818	; key PSX MAIL (or P SXCMOPMGR) .
17819	"RTN","PSX BPSMS",93, 0)
17820	;
17821	"RTN","PSX BPSMS",94, 0)
17822	MAIL ;
17823	"RTN","PSX BPSMS",95, 0)
17824	;
17825	"RTN","PSX BPSMS",96, 0)
17826	N DIV,M1, PSBMSG,SIT ES,USER,XM DUZ,XMSUB, XMTEXT,XMY ,Y
17827	"RTN","PSX BPSMS",97, 0)
17828	;
17829	"RTN","PSX BPSMS",98, 0)
17830	S PSBMSG( 1)="The pr escription s listed i n this mes sage did n ot transmi t to CMOP for one of "
17831	"RTN","PSX BPSMS",99, 0)
17832	S PSBMSG( 2)="the re asons belo w:"
17833	"RTN","PSX BPSMS",100 ,0)
17834	S PSBMSG( 3)=" "
17835	"RTN","PSX BPSMS",101 ,0)
17836	S PSBMSG( 4)=" A respon se from th e third pa rty payer was not re ceived"
17837	"RTN","PSX BPSMS",102 ,0)
17838	S PSBMSG( 5)=" "
17839	"RTN","PSX BPSMS",103 ,0)
17840	S PSBMSG( 6)=" OR"
17841	"RTN","PSX BPSMS",104 ,0)
17842	S PSBMSG( 7)=" "
17843	"RTN","PSX BPSMS",105 ,0)
17844	S PSBMSG( 8)=" The pres criptions are non-bi llable in VistA"
17845	"RTN","PSX BPSMS",106 ,0)
17846	S PSBMSG( 9)=" "
17847	"RTN","PSX BPSMS",107 ,0)
17848	S PSBMSG( 10)="The p rescriptio ns will re main in th e CMOP que ue and wil l transmit when the"
17849	"RTN","PSX BPSMS",108 ,0)
17850	S PSBMSG( 11)="respo nse from t he third p arty payer is receiv ed, or the non-billa ble issue"
17851	"RTN","PSX BPSMS",109 ,0)
17852	S PSBMSG( 12)="is re solved. E xamples of non-billa ble issues are presc riptions f or"
17853	"RTN","PSX BPSMS",110 ,0)
17854	S PSBMSG( 13)="sensi tive medic ations tha t need Rel ease of In formation and prescr iptions"
17855	"RTN","PSX BPSMS",111 ,0)
17856	S PSBMSG( 14)="for n on-billabl e drugs (e .g., OTC p roducts fo r CHAMPVA and TRICAR E patients )."
17857	"RTN","PSX BPSMS",112 ,0)
17858	S PSBMSG( 15)=" "
17859	"RTN","PSX BPSMS",113 ,0)
17860	S M1=16
17861	"RTN","PSX BPSMS",114 ,0)
17862	;
17863	"RTN","PSX BPSMS",115 ,0)
17864	S Y=""
17865	"RTN","PSX BPSMS",116 ,0)
17866	F S Y=$O (^TMP("PSX EPHOUT",$J ,"M",Y)) Q :Y="" D
17867	"RTN","PSX BPSMS",117 ,0)
17868	. S PSBMS G(M1)=$P(^ TMP("PSXEP HOUT",$J," M",Y),"^")
17869	"RTN","PSX BPSMS",118 ,0)
17870	. S M1=M1 +1
17871	"RTN","PSX BPSMS",119 ,0)
17872	;
17873	"RTN","PSX BPSMS",120 ,0)
17874	; Setup t he list of recipient s (XMY). Send the e mail to al l users
17875	"RTN","PSX BPSMS",121 ,0)
17876	; holding the secur ity key PS XMAIL, if any; other wise, send to all
17877	"RTN","PSX BPSMS",122 ,0)
17878	; users h olding the key PSXCM OPMGR.
17879	"RTN","PSX BPSMS",123 ,0)
17880	;
17881	"RTN","PSX BPSMS",124 ,0)
17882	S USER=0
17883	"RTN","PSX BPSMS",125 ,0)
17884	I $D(^XUS EC("PSXMAI L")) D
17885	"RTN","PSX BPSMS",126 ,0)
17886	.F S USE R=$O(^XUSE C("PSXMAIL ",USER)) Q :'USER S XMY(USER)= ""
17887	"RTN","PSX BPSMS",127 ,0)
17888	E D
17889	"RTN","PSX BPSMS",128 ,0)
17890	.F S USE R=$O(^XUSE C("PSXCMOP MGR",USER) ) Q:'USER S XMY(USE R)=""
17891	"RTN","PSX BPSMS",129 ,0)
17892	;
17893	"RTN","PSX BPSMS",130 ,0)
17894	; Set the subject ( XMSUB), in dicate the array con taining th e text of
17895	"RTN","PSX BPSMS",131 ,0)
17896	; the mes sage is PS BMSG, and set the se nder to be POSTMASTE R (.5).
17897	"RTN","PSX BPSMS",132 ,0)
17898	;
17899	"RTN","PSX BPSMS",133 ,0)
17900	S DIV="", SITES=""
17901	"RTN","PSX BPSMS",134 ,0)
17902	F S DIV= $O(^TMP("P SXEPHIN",$ J,DIV)) Q: DIV="" S SITES=SITE S_$$GET1^D IQ(59,DIV_ ",",.01,"E ")_","
17903	"RTN","PSX BPSMS",135 ,0)
17904	S XMSUB=$ E("ePharma cy CMOP No t TRANSMIT TED Rxs - "_$E(SITES ,1,$L(SITE S)-1),1,65 )
17905	"RTN","PSX BPSMS",136 ,0)
17906	S XMTEXT= "PSBMSG("
17907	"RTN","PSX BPSMS",137 ,0)
17908	S XMDUZ=. 5
17909	"RTN","PSX BPSMS",138 ,0)
17910	;
17911	"RTN","PSX BPSMS",139 ,0)
17912	D ^XMD
17913	"RTN","PSX BPSMS",140 ,0)
17914	;
17915	"RTN","PSX BPSMS",141 ,0)
17916	Q
17917	"RTN","PSX BPSMS",142 ,0)
17918	;
17919	"RTN","PSX BPSMS",143 ,0)
17920	;Store E- mail line for later use.
17921	"RTN","PSX BPSMS",144 ,0)
17922	STORELN(LI NE) ;
17923	"RTN","PSX BPSMS",145 ,0)
17924	S EMCNT=E MCNT+1
17925	"RTN","PSX BPSMS",146 ,0)
17926	S ^TMP("P SXEPHOUT", $J,"M",EMC NT)=LINE
17927	"RTN","PSX BPSMS",147 ,0)
17928	Q
17929	"RTN","PSX BPSMS",148 ,0)
17930	;
17931	"RTN","PSX BPSMS",149 ,0)
17932	TRANS(RX,R FL) ;
17933	"RTN","PSX BPSMS",150 ,0)
17934	I '$G(RX) Q ""
17935	"RTN","PSX BPSMS",151 ,0)
17936	I $G(RFL) ="" Q ""
17937	"RTN","PSX BPSMS",152 ,0)
17938	N TDT,CNT ,FDT
17939	"RTN","PSX BPSMS",153 ,0)
17940	S CNT=0,F DT=9999999
17941	"RTN","PSX BPSMS",154 ,0)
17942	S TDT="" F S TDT=$ O(^XTMP("P SXBPSMS",1 ,RX,RFL,TD T)) Q:'TDT D
17943	"RTN","PSX BPSMS",155 ,0)
17944	. S CNT=C NT+1
17945	"RTN","PSX BPSMS",156 ,0)
17946	S FDT=$O( ^XTMP("PSX BPSMS",1,R X,RFL,""))
17947	"RTN","PSX BPSMS",157 ,0)
17948	I FDT=999 9999 S FDT =" "
17949	"RTN","PSX BPSMS",158 ,0)
17950	E S FDT= $E(FDT,4,5 )_"/"_$E(F DT,6,7)_"/ "_($E(FDT, 2,3))
17951	"RTN","PSX BPSMS",159 ,0)
17952	Q FDT_$E( " ",1,5 -$L(CNT))_ CNT
17953	"RTN","PSX BPSMS",160 ,0)
17954	;
17955	"RTN","PSX BPSMS",161 ,0)
17956	;Clean al l remainin g arrays a nd variabl es
17957	"RTN","PSX BPSMS",162 ,0)
17958	;Purge ^X TMP data o lder than 30 days
17959	"RTN","PSX BPSMS",163 ,0)
17960	CLEAN ;
17961	"RTN","PSX BPSMS",164 ,0)
17962	K ^TMP("P SXEPHOUT", $J),^TMP(" PSXEPHIN", $J)
17963	"RTN","PSX BPSMS",165 ,0)
17964	; Purge ^ XTMP data older than 30 days
17965	"RTN","PSX BPSMS",166 ,0)
17966	N FDT,RX, RFL,TDT
17967	"RTN","PSX BPSMS",167 ,0)
17968	S FDT=$$F MADD^XLFDT (DT,-30)
17969	"RTN","PSX BPSMS",168 ,0)
17970	S RX="" F S RX=$O( ^XTMP("PSX BPSMS",1,R X)) Q:'RX D
17971	"RTN","PSX BPSMS",169 ,0)
17972	. S RFL=" " F S RFL =$O(^XTMP( "PSXBPSMS" ,1,RX,RFL) ) Q:RFL="" D
17973	"RTN","PSX BPSMS",170 ,0)
17974	.. S TDT= "" F S TD T=$O(^XTMP ("PSXBPSMS ",1,RX,RFL ,TDT)) Q:' TDT D
17975	"RTN","PSX BPSMS",171 ,0)
17976	... I TDT <FDT K ^XT MP("PSXBPS MS",1,RX,R FL,TDT)
17977	"RTN","PSX BPSMS",172 ,0)
17978	Q
17979	"RTN","PSX RPPL")
17980	0^4^B68822 537
17981	"RTN","PSX RPPL",1,0)
17982	PSXRPPL ;B IR/WPB,BAB -Gathers d ata for th e CMOP Tra nsmission ;13 Mar 20 02 10:31 AM
17983	"RTN","PSX RPPL",2,0)
17984	;;2.0;CMO P;3,23,3 3,28,40,42 ,41,48,62, 58,66,65,6 9,70,81; 11 Apr 97; Build 15
17985	"RTN","PSX RPPL",3,0)
17986	;Referenc e to ^PS(5 2.5, supp orted by D BIA #1978
17987	"RTN","PSX RPPL",4,0)
17988	;Referenc e to ^PSRX ( supp orted by D BIA #1977
17989	"RTN","PSX RPPL",5,0)
17990	;Referenc e to ^PSOH LSN1 supp orted by D BIA #2385
17991	"RTN","PSX RPPL",6,0)
17992	;Referenc e to ^PSOR XL supp orted by D BIA #1969
17993	"RTN","PSX RPPL",7,0)
17994	;Referenc e to ^PSOL SET supp orted by D BIA #1973
17995	"RTN","PSX RPPL",8,0)
17996	;Referenc e to %ZIS( 1 supp orted by D BIA #290
17997	"RTN","PSX RPPL",9,0)
17998	;Referenc e to %ZIS( 2 supp orted by D BIA #2247
17999	"RTN","PSX RPPL",10,0 )
18000	;Referenc e to ^PSSL OCK supp orted by D BIA #2789
18001	"RTN","PSX RPPL",11,0 )
18002	;Referenc e to ^XTMP ("ORLK-" s upported b y DBIA #40 01
18003	"RTN","PSX RPPL",12,0 )
18004	;Referenc e to ^BPSU TIL supp orted by D BIA #4410
18005	"RTN","PSX RPPL",13,0 )
18006	;Referenc e to ^PS(5 9 supp orted by D BIA #1976
18007	"RTN","PSX RPPL",14,0 )
18008	;Referenc e to $$SEL PRT^PSOFDA UT support ed by DBIA #5740
18009	"RTN","PSX RPPL",15,0 )
18010	;
18011	"RTN","PSX RPPL",16,0 )
18012	;Called f rom PSXRSU S -Builds ^PSX(550.2 ,,15,"C" , and retur ns to PSXR SUS or PSX RTRAN
18013	"RTN","PSX RPPL",17,0 )
18014	;
18015	"RTN","PSX RPPL",18,0 )
18016	SDT ;
18017	"RTN","PSX RPPL",19,0 )
18018	K ^TMP($J ,"PSX"),^T MP($J,"PSX DFN")
18019	"RTN","PSX RPPL",20,0 )
18020	K PSXBAT, ZCNT
18021	"RTN","PSX RPPL",21,0 )
18022	I $D(XRTL ) D T0^%ZO SV
18023	"RTN","PSX RPPL",22,0 )
18024	S PSXTDIV =PSOSITE,P SXTYP=$S(+ $G(PSXCS): "C",1:"N")
18025	"RTN","PSX RPPL",23,0 )
18026	;
18027	"RTN","PSX RPPL",24,0 )
18028	; - Submi tting pres criptions to ECME (E lectronic Claims Mgm t Engine) - 3rd pary
18029	"RTN","PSX RPPL",25,0 )
18030	I $$ECMEO N^BPSUTIL( PSXTDIV),$ $CMOPON^BP SUTIL(PSXT DIV) D
18031	"RTN","PSX RPPL",26,0 )
18032	. N BPSCN T S BPSCNT =$$SBTECME ^PSXRPPL1( PSXTYP,PSX TDIV,PRTDT ,PSXDTRG)
18033	"RTN","PSX RPPL",27,0 )
18034	. ; - Wai t 15 secon ds per pre scription sent to EC ME (max of 2 hours)
18035	"RTN","PSX RPPL",28,0 )
18036	. I BPSCN T>0 H 60+$ S((BPSCNT* 15)>7200:7 200,1:(BPS CNT*15))
18037	"RTN","PSX RPPL",29,0 )
18038	;
18039	"RTN","PSX RPPL",30,0 )
18040	; - Trans mitting pr escription to CMOP ( up to THRO UGH DATE)
18041	"RTN","PSX RPPL",31,0 )
18042	K ^TMP("P SXEPHIN",$ J)
18043	"RTN","PSX RPPL",32,0 )
18044	S SDT=0 F S SDT=$O (^PS(52.5, "CMP","Q", PSXTYP,PSX TDIV,SDT)) S XDFN=0 Q:(SDT>PRT DT)!(SDT'> 0) D
18045	"RTN","PSX RPPL",33,0 )
18046	. F S XD FN=$O(^PS( 52.5,"CMP" ,"Q",PSXTY P,PSXTDIV, SDT,XDFN)) S REC=0 Q :(XDFN'>0) !(XDFN="") D
18047	"RTN","PSX RPPL",34,0 )
18048	. . F S REC=$O(^PS (52.5,"CMP ","Q",PSXT YP,PSXTDIV ,SDT,XDFN, REC)) Q:(R EC'>0)!(RE C="") D
18049	"RTN","PSX RPPL",35,0 )
18050	. . . D G ETDATA D:$ G(RXN) PSO UL^PSSLOCK (RXN),OERR LOCK(RXN)
18051	"RTN","PSX RPPL",36,0 )
18052	;
18053	"RTN","PSX RPPL",37,0 )
18054	; - Pulli ng prescri ptions ahe ad (parame ter in OUT PATIENT SI TE file #5 9)
18055	"RTN","PSX RPPL",38,0 )
18056	I $G(PSXB AT),'$G(PS XRTRAN) D CHKDFN^PSX RPPL2(PRTD T)
18057	"RTN","PSX RPPL",39,0 )
18058	I $G(PSXB AT),'$G(PS XRTRAN) D CHKDFN
18059	"RTN","PSX RPPL",40,0 )
18060	;
18061	"RTN","PSX RPPL",41,0 )
18062	; - Sends a Mailman message i f there we re transmi ssion prob lems with the 3rd Pa rty Payer
18063	"RTN","PSX RPPL",42,0 )
18064	I $D(^TMP ("PSXEPHIN ",$J)) D ^ PSXBPSMS K ^TMP("PSX EPHIN",$J)
18065	"RTN","PSX RPPL",43,0 )
18066	;
18067	"RTN","PSX RPPL",44,0 )
18068	EXIT ;
18069	"RTN","PSX RPPL",45,0 )
18070	K SDT,DFN ,REC,RXNUM ,PSXOK,FIL NUM,REF,PN AME,CNAME, DIE,DR,NDF N,%,CNT,CO M,DTTM,FIL L,JJ,PRTDT ,PSXDIV,XD FN,NFLAG,C IND,XDFN
18071	"RTN","PSX RPPL",46,0 )
18072	K CHKDT,D AYS,DRUG,D RUGCHK,NM, OPDT,PHARC LK,PHY,PST AT,PTRA,PT RB,QTY,REL ,RXERR,RXF ,SFN,PSXDG ST,PSXMC,P SXMDT
18073	"RTN","PSX RPPL",47,0 )
18074	S:$D(XRT0 ) XRTN=$T( +0) D:$D(X RT0) T1^%Z OSV
18075	"RTN","PSX RPPL",48,0 )
18076	K ^TMP("P SXEPHIN",$ J)
18077	"RTN","PSX RPPL",49,0 )
18078	Q
18079	"RTN","PSX RPPL",50,0 )
18080	GETDATA ;S creens rxs and build s data
18081	"RTN","PSX RPPL",51,0 )
18082	;PSXOK=1: NOT CMOP D RUG OR DO NOT MAIL,2 :TRADENAME ,3:WINDOW, 4:PRINTED, 5:NOT SUSP ENDED
18083	"RTN","PSX RPPL",52,0 )
18084	;PSXOK=6: ALREADY RE LEASED,7:D IFFERENT D IVISION,8: BAD DATA I N 52.5
18085	"RTN","PSX RPPL",53,0 )
18086	;9:CS Mis match,10:D EA 1 or 2
18087	"RTN","PSX RPPL",54,0 )
18088	I '$D(^PS (52.5,REC, 0)) K ^PS( 52.5,"AQ", SDT,XDFN,R EC),^PS(52 .5,"CMP"," Q",PSXTYP, PSXTDIV,SD T,XDFN,REC ) Q
18089	"RTN","PSX RPPL",55,0 )
18090	I $P(^PS( 52.5,REC,0 ),"^",7)=" " K ^PS(52 .5,"AQ",SD T,XDFN,REC ),^PS(52.5 ,"CMP","Q" ,PSXTYP,PS XTDIV,SDT, XDFN,REC) Q
18091	"RTN","PSX RPPL",56,0 )
18092	I ($P(^PS (52.5,REC, 0),"^",3)' =XDFN) K ^ PS(52.5,"A Q",SDT,XDF N,REC),^PS (52.5,"CMP ","Q",PSXT YP,PSXTDIV ,SDT,XDFN, REC) Q
18093	"RTN","PSX RPPL",57,0 )
18094	N DFN S D FN=XDFN D DEM^VADPT
18095	"RTN","PSX RPPL",58,0 )
18096	I $G(VADM (6))'="" D DELETE K VADM Q
18097	"RTN","PSX RPPL",59,0 )
18098	S PSXOK=0 ,NFLAG=0
18099	"RTN","PSX RPPL",60,0 )
18100	S RXN=$P( $G(^PS(52. 5,REC,0)), "^",1) I R XN="" S PS XOK=8 Q
18101	"RTN","PSX RPPL",61,0 )
18102	S RFL=+$$ GET1^DIQ(5 2.5,REC,9, "I")
18103	"RTN","PSX RPPL",62,0 )
18104	I '$D(^TM P($J,"PSXB AI",DFN)) D
18105	"RTN","PSX RPPL",63,0 )
18106	.S PSXGOO D=$$ADDROK ^PSXMISC1( RXN)
18107	"RTN","PSX RPPL",64,0 )
18108	.I 'PSXGO OD S PSXFI RST=1 D I 'PSXFIRST S PSXOK=8
18109	"RTN","PSX RPPL",65,0 )
18110	..D CHKAC T^PSXMISC1 (RXN)
18111	"RTN","PSX RPPL",66,0 )
18112	I PSXOK=8 K RXN Q
18113	"RTN","PSX RPPL",67,0 )
18114	;
18115	"RTN","PSX RPPL",68,0 )
18116	N EPHQT S EPHQT=0
18117	"RTN","PSX RPPL",69,0 )
18118	I $$PATCH ^XPDUTL("P SO7.0148 ") D EPHAR M^PSXRPPL2 I EPHQT Q
18119	"RTN","PSX RPPL",70,0 )
18120	D CHKDATA ^PSXMISC1
18121	"RTN","PSX RPPL",71,0 )
18122	SET Q:(PSX OK=7)!(PSX OK=8)!(PSX OK=9)
18123	"RTN","PSX RPPL",72,0 )
18124	S PNAME=$ G(VADM(1))
18125	"RTN","PSX RPPL",73,0 )
18126	I ($G(PSX CSRX)=1)&( $G(PSXCS)= 1) S ^XTMP ("PSXCS",P SOSITE,DT, RXN)=""
18127	"RTN","PSX RPPL",74,0 )
18128	I (PSXOK= 0)&(PSXFLA G=1) S ^TM P($J,"PSXD FN",XDFN)= "",NFLAG=4 D DQUE,RX 550215 Q
18129	"RTN","PSX RPPL",75,0 )
18130	I (PSXOK= 0)&(PSXFLA G=2) D RX5 50215 Q
18131	"RTN","PSX RPPL",76,0 )
18132	I (PSXOK> 0)&(PSXOK< 7)!(PSXOK= 10) D DELE TE Q
18133	"RTN","PSX RPPL",77,0 )
18134	Q
18135	"RTN","PSX RPPL",78,0 )
18136	;
18137	"RTN","PSX RPPL",79,0 )
18138	DELETE ; d eletes the CMOP STAT US field i n PS(52.5, reindex ' AC' x-ref
18139	"RTN","PSX RPPL",80,0 )
18140	L +^PS(52 .5,REC):60 0 Q:'$T
18141	"RTN","PSX RPPL",81,0 )
18142	N DR,DIE, DA S DIE=" ^PS(52.5," ,DA=REC,DR ="3///@" D ^DIE
18143	"RTN","PSX RPPL",82,0 )
18144	S ^PS(52. 5,"AC",$P( ^PS(52.5,R EC,0),"^", 3),$P(^PS( 52.5,REC,0 ),"^",2),R EC)=""
18145	"RTN","PSX RPPL",83,0 )
18146	L -^PS(52 .5,REC)
18147	"RTN","PSX RPPL",84,0 )
18148	Q
18149	"RTN","PSX RPPL",85,0 )
18150	;the rest of the su b-routines go throug h the ^PSX (550.2,,15 ,"C"
18151	"RTN","PSX RPPL",86,0 )
18152	;global a nd checks for RXs wi thin the d ays ahead range and
18153	"RTN","PSX RPPL",87,0 )
18154	;builds t he ^PSX(55 0.2,PSXBAT ,
18155	"RTN","PSX RPPL",88,0 )
18156	CHKDFN ; u se the pat ient 'C' i ndex under RX multip le in file 550.2 to GET dfn to gather Pa tients' fu ture RXs
18157	"RTN","PSX RPPL",89,0 )
18158	I '$D(^PS X(550.2,PS XBAT,15,"C ")) Q
18159	"RTN","PSX RPPL",90,0 )
18160	S PSXPTNM ="" F S P SXPTNM=$O( ^PSX(550.2 ,PSXBAT,15 ,"C",PSXPT NM)) Q:PSX PTNM="" D
18161	"RTN","PSX RPPL",91,0 )
18162	. S XDFN= 0 F S XDF N=$O(^PSX( 550.2,PSXB AT,"15","C ",PSXPTNM, XDFN)) Q:( XDFN'>0) D
18163	"RTN","PSX RPPL",92,0 )
18164	. . S SDT =PRTDT F S SDT=$O(^ PS(52.5,"C MP","Q",PS XTYP,PSXTD IV,SDT)),N DFN=0 Q:(S DT>PSXDTRG )!(SDT="") D
18165	"RTN","PSX RPPL",93,0 )
18166	. . . F S NDFN=$O( ^PS(52.5," CMP","Q",P SXTYP,PSXT DIV,SDT,ND FN)),REC=0 Q:NDFN'>0 I NDFN=X DFN D
18167	"RTN","PSX RPPL",94,0 )
18168	. . . . F S REC=$O (^PS(52.5, "CMP","Q", PSXTYP,PSX TDIV,SDT,N DFN,REC)) Q:REC'>0 D
18169	"RTN","PSX RPPL",95,0 )
18170	. . . . . D GETDATA D:$G(RXN) PSOUL^PSS LOCK(RXN), OERRLOCK(R XN)
18171	"RTN","PSX RPPL",96,0 )
18172	Q
18173	"RTN","PSX RPPL",97,0 )
18174	;
18175	"RTN","PSX RPPL",98,0 )
18176	BEGIN ; Se lect print device
18177	"RTN","PSX RPPL",99,0 )
18178	I '$D(PSO PAR) D ^PS OLSET
18179	"RTN","PSX RPPL",100, 0)
18180	I $D(PSOL AP),($G(PS OLAP)'=ION ) S PSLION =PSOLAP G PROFILE
18181	"RTN","PSX RPPL",101, 0)
18182	W ! S %ZI S("A")="PR INTER 'LAB EL' DEVICE : ",%ZIS( "B")="",%Z IS="MQN" D ^%ZIS S P SLION=ION G:POP EXIT
18183	"RTN","PSX RPPL",102, 0)
18184	I $G(IOST )["C-" W ! ,"You must select a printer!", ! G BEGIN
18185	"RTN","PSX RPPL",103, 0)
18186	F J=0,1 S @("PSOBAR "_J)="" I $D(^%ZIS(2 ,^%ZIS(1,I OS,"SUBTYP E"),"BAR"_ J)) S @("P SOBAR"_J)= ^("BAR"_J)
18187	"RTN","PSX RPPL",104, 0)
18188	S PSOBARS =PSOBAR1]" "&(PSOBAR0 ]"")&$P(PS OPAR,"^",1 9)
18189	"RTN","PSX RPPL",105, 0)
18190	K PSOION, J D ^%ZISC I $D(IO(" Q")) K IO( "Q")
18191	"RTN","PSX RPPL",106, 0)
18192	;
18193	"RTN","PSX RPPL",107, 0)
18194	PROFILE I $D(PSOPROP ),($G(PSOP ROP)'=ION) G FDAMG
18195	"RTN","PSX RPPL",108, 0)
18196	I $P(PSOP AR,"^",8) S %ZIS="MN Q",%ZIS("A ")="Select PROFILE P RINTER: " D ^%ZIS K %ZIS,IO("Q "),IOP G:P OP EXIT S PSOPROP=IO N D ^%ZISC
18197	"RTN","PSX RPPL",109, 0)
18198	I $G(PSOP ROP)=ION W !,"You mu st select a printer! ",! G PROF ILE
18199	"RTN","PSX RPPL",110, 0)
18200	;
18201	"RTN","PSX RPPL",111, 0)
18202	FDAMG ; Se lects FDA Medication Guide Pri nter
18203	"RTN","PSX RPPL",112, 0)
18204	I $$GET1^ DIQ(59,PSO SITE,134)' ="" N FDAP RT S FDAPR T="" D I FDAPRT="^" !($G(PSOFD APT)="") S POP=1 G E XIT
18205	"RTN","PSX RPPL",113, 0)
18206	. F D Q :FDAPRT'=" "
18207	"RTN","PSX RPPL",114, 0)
18208	. . S FDA PRT=$$SELP RT^PSOFDAU T($P($G(PS OFDAPT),"^ "))
18209	"RTN","PSX RPPL",115, 0)
18210	. . I FDA PRT="" W $ C(7),!,"Yo u must sel ect a vali d FDA Medi cation Gui de printer ."
18211	"RTN","PSX RPPL",116, 0)
18212	. I FDAPR T'="",(FDA PRT'="^") S PSOFDAPT =FDAPRT
18213	"RTN","PSX RPPL",117, 0)
18214	Q
18215	"RTN","PSX RPPL",118, 0)
18216	;
18217	"RTN","PSX RPPL",119, 0)
18218	PRT ; w au to error t rapping
18219	"RTN","PSX RPPL",120, 0)
18220	D NOW^%DT C S DTTM=% K %
18221	"RTN","PSX RPPL",121, 0)
18222	S NM="" F S NM=$O( ^PSX(550.2 ,PSXBAT,15 ,"C",NM)) Q:NM="" D DFN,PPL ; gather pat ient RXs, print pati ent RXs
18223	"RTN","PSX RPPL",122, 0)
18224	S DIK="^P SX(550.2," ,DA=PSXBAT D ^DIK K PSXBAT
18225	"RTN","PSX RPPL",123, 0)
18226	K CHKDT,C IND,DAYS,D RUG,DRUGCH K,NFLAG,NM ,ORD,PDT,P HARCLK,PHY ,PSTAT,PTR A,PTRB,QTY ,REL,RXERR ,RXF,SFN,S IG,SITE,SU S,SUSPT
18227	"RTN","PSX RPPL",124, 0)
18228	Q
18229	"RTN","PSX RPPL",125, 0)
18230	DFN S DFN= 0,NFLAG=2
18231	"RTN","PSX RPPL",126, 0)
18232	F S DFN= $O(^PSX(55 0.2,PSXBAT ,15,"C",NM ,DFN)),RXN =0 Q:(DFN= "")!(DFN'> 0) D
18233	"RTN","PSX RPPL",127, 0)
18234	.F S RXN =$O(^PSX(5 50.2,PSXBA T,15,"C",N M,DFN,RXN) ),RXF="" Q :(RXN="")! (RXN'>0) D
18235	"RTN","PSX RPPL",128, 0)
18236	..F S RX F=$O(^PSX( 550.2,PSXB AT,15,"C", NM,DFN,RXN ,RXF)) Q:R XF="" D B LD
18237	"RTN","PSX RPPL",129, 0)
18238	Q
18239	"RTN","PSX RPPL",130, 0)
18240	BLD ;
18241	"RTN","PSX RPPL",131, 0)
18242	S BATRXDA =$O(^PSX(5 50.2,PSXBA T,15,"B",R XN,0)) D N OW^%DTC S DTTM=%
18243	"RTN","PSX RPPL",132, 0)
18244	S REC=$P( ^PSX(550.2 ,PSXBAT,15 ,BATRXDA,0 ),U,5),SUS =$O(^PS(52 .5,"B",RXN ,0))
18245	"RTN","PSX RPPL",133, 0)
18246	I SUS=REC ,+SUS'=0 I 1 ;rx sti ll valid i n suspense
18247	"RTN","PSX RPPL",134, 0)
18248	E D Q ;rx gone
18249	"RTN","PSX RPPL",135, 0)
18250	. N DA,DI K S DIK=55 0.2,DA(1)= PSXBAT,DA= BATRXDA
18251	"RTN","PSX RPPL",136, 0)
18252	. D ^DIK
18253	"RTN","PSX RPPL",137, 0)
18254	S PSOSU(D FN,SUS)=RX N,RXCNTR=$ G(RXCNTR)+ 1,NFLAG=2
18255	"RTN","PSX RPPL",138, 0)
18256	S $P(^PSR X(RXN,0),U ,15)=0,$P( ^PSRX(RXN, "STA"),U,1 )=0
18257	"RTN","PSX RPPL",139, 0)
18258	K % S COM ="CMOP Sus pense Labe l "_$S($G( ^PS(52.5,S US,"P"))=0 :"Printed" ,$G(^PS(52 .5,SUS,"P" ))="":"Pri nted",1:"R eprinted") _$S($G(^PS RX(RXN,"TY PE"))>0:" (PARTIAL)" ,1:"")
18259	"RTN","PSX RPPL",140, 0)
18260	D EN^PSOH LSN1(RXN," SC","ZU",C OM)
18261	"RTN","PSX RPPL",141, 0)
18262	S DA=SUS D DQUE K D A
18263	"RTN","PSX RPPL",142, 0)
18264	ACTLOG F J J=0:0 S JJ =$O(^PSRX( RXN,"A",JJ )) Q:'JJ S CNT=JJ
18265	"RTN","PSX RPPL",143, 0)
18266	S RFCNT=0 F RF=0:0 S RF=$O(^P SRX(RXN,1, RF)) Q:'RF S RFCNT= $S(RF<6:RF ,1:RF+1)
18267	"RTN","PSX RPPL",144, 0)
18268	S CNT=CNT +1,^PSRX(R XN,"A",0)= "^52.3DA^" _CNT_"^"_C NT
18269	"RTN","PSX RPPL",145, 0)
18270	LOCK L +^P SRX(RXN):6 00 G:'$T L OCK
18271	"RTN","PSX RPPL",146, 0)
18272	S ^PSRX(R XN,"A",CNT ,0)=DTTM_" ^S^"_DUZ_" ^"_RFCNT_" ^"_COM L - ^PSRX(RXN)
18273	"RTN","PSX RPPL",147, 0)
18274	K CNT,COM ,RFCNT,%,J J,RF,Y,RXC NTR
18275	"RTN","PSX RPPL",148, 0)
18276	Q
18277	"RTN","PSX RPPL",149, 0)
18278	PPL K PPL, PPL1 S ORD ="" F S O RD=$O(PSOS U(ORD)) Q: (ORD="")!( ORD'>0) D PPL1
18279	"RTN","PSX RPPL",150, 0)
18280	Q
18281	"RTN","PSX RPPL",151, 0)
18282	PPL1 ; pri nt patient labels
18283	"RTN","PSX RPPL",152, 0)
18284	F SFN=0:0 S SFN=$O( PSOSU(ORD, SFN)) Q:'S FN D
18285	"RTN","PSX RPPL",153, 0)
18286	. S:$L($G (PPL))<240 PPL=$P(PS OSU(ORD,SF N),"^")_", "_$G(PPL)
18287	"RTN","PSX RPPL",154, 0)
18288	. S:$L($G (PPL))>239 PPL1=$P(P SOSU(ORD,S FN),"^")_" ,"_$G(PPL1 )
18289	"RTN","PSX RPPL",155, 0)
18290	. S DFN=$ P(^PS(52.5 ,SFN,0),"^ ",3)
18291	"RTN","PSX RPPL",156, 0)
18292	S SUSPT=1 ,PSNP=$S($ P(PSOPAR," ^",8):1,1: 0) S:$D(PS OPROP) PFI O=PSOPROP
18293	"RTN","PSX RPPL",157, 0)
18294	D QLBL^PS ORXL
18295	"RTN","PSX RPPL",158, 0)
18296	I $D(PPL1 ) S PSNP=0 ,PPL=PPL1 D QLBL^PSO RXL
18297	"RTN","PSX RPPL",159, 0)
18298	K PPL,PPL 1,PSOSU(OR D)
18299	"RTN","PSX RPPL",160, 0)
18300	Q
18301	"RTN","PSX RPPL",161, 0)
18302	DQUE ; set s the CMOP indicator field, an d printed field in 5 2.5
18303	"RTN","PSX RPPL",162, 0)
18304	L +^PS(52 .5,REC):60 0 G:'$T DQ UE
18305	"RTN","PSX RPPL",163, 0)
18306	I NFLAG=4 D
18307	"RTN","PSX RPPL",164, 0)
18308	. S DA=RE C,DIE="^PS (52.5,",DR ="3////L;4 ////"_DT D ^DIE K DI E,DA,DR L -^PS(52.5, REC) ; th e rest mov ed into PS XRTR
18309	"RTN","PSX RPPL",165, 0)
18310	S CIND=$S (NFLAG=1:" X",NFLAG=2 :"P",NFLAG =3:"@",1:0 )
18311	"RTN","PSX RPPL",166, 0)
18312	I $G(NFLA G)'=2 D
18313	"RTN","PSX RPPL",167, 0)
18314	.S DA=REC ,DIE="^PS( 52.5,",DR= "3////"_CI ND_";4//// "_DT
18315	"RTN","PSX RPPL",168, 0)
18316	.D ^DIE K DIE,DA,DR
18317	"RTN","PSX RPPL",169, 0)
18318	.S ^PS(52 .5,REC,"P" )=1,^PS(52 .5,"ADL",D T,REC)=""
18319	"RTN","PSX RPPL",170, 0)
18320	I $G(NFLA G)=2 D ;p rint label cycle
18321	"RTN","PSX RPPL",171, 0)
18322	. S DA=RE C,DIE="^PS (52.5,",DR ="3////"_C IND_";4/// /"_DTTM_"; 5////"_DUZ _";7////"_ RXCNTR
18323	"RTN","PSX RPPL",172, 0)
18324	. D ^DIE K DIE,DA,D R
18325	"RTN","PSX RPPL",173, 0)
18326	. S ^PS(5 2.5,REC,"P ")=1,^PS(5 2.5,"ADL", $E($P(^PS( 52.5,REC,0 ),"^",8),1 ,7),REC)=" "
18327	"RTN","PSX RPPL",174, 0)
18328	L -^PS(52 .5,REC)
18329	"RTN","PSX RPPL",175, 0)
18330	I $G(NFLA G)=2 D EN^ PSOHLSN1(R XN,"SC","Z U","CMOP S uspense La bel Printe d")
18331	"RTN","PSX RPPL",176, 0)
18332	Q
18333	"RTN","PSX RPPL",177, 0)
18334	RX550215 ; put RX in to RX mult iple TRANS 550.215 f or PSXBAT
18335	"RTN","PSX RPPL",178, 0)
18336	I '$G(PSX BAT) D BAT CH^PSXRSYU ; first t ime throug h create b atch, & re turn PSXBA T
18337	"RTN","PSX RPPL",179, 0)
18338	K DD,DO,D IC,DA,DR,D 0
18339	"RTN","PSX RPPL",180, 0)
18340	S:'$D(^PS X(550.2,PS XBAT,15,0) ) ^PSX(550 .2,PSXBAT, 15,0)="^55 0.215P^^"
18341	"RTN","PSX RPPL",181, 0)
18342	S X=RXN,D A(1)=PSXBA T
18343	"RTN","PSX RPPL",182, 0)
18344	S DIC="^P SX(550.2," _PSXBAT_", 15,",DIC(" DR")=".02/ ///^S X=RX F;.03////^ S X=DFN;.0 5////^S X= REC",DIC(0 )="ZF"
18345	"RTN","PSX RPPL",183, 0)
18346	D FILE^DI CN
18347	"RTN","PSX RPPL",184, 0)
18348	S PSXRXTD A=+Y ;RX D A within P SXBAT 'T'r ansmission
18349	"RTN","PSX RPPL",185, 0)
18350	K DD,DO,D IC,DA,DR,D 0
18351	"RTN","PSX RPPL",186, 0)
18352	Q
18353	"RTN","PSX RPPL",187, 0)
18354	OERRLOCK(R XN) ; set XTMP for O ERR/CPRS o rder locki ng
18355	"RTN","PSX RPPL",188, 0)
18356	I $G(PSXB AT),$G(RXN ),$G(PSXRX TDA) I 1
18357	"RTN","PSX RPPL",189, 0)
18358	E Q
18359	"RTN","PSX RPPL",190, 0)
18360	I $P(^PSX (550.2,PSX BAT,15,PSX RXTDA,0),U ,1)'=RXN Q
18361	"RTN","PSX RPPL",191, 0)
18362	RXNSET ; s et ^XTMP(" ORLK-"_ORD ER per IA 4001 needs RXN
18363	"RTN","PSX RPPL",192, 0)
18364	Q:'$G(RXN )
18365	"RTN","PSX RPPL",193, 0)
18366	N ORD,NOW ,NOW1 S OR D=+$P($G(^ PSRX(+$G(R XN),"OR1") ),"^",2)
18367	"RTN","PSX RPPL",194, 0)
18368	Q:'ORD
18369	"RTN","PSX RPPL",195, 0)
18370	S NOW=$$N OW^XLFDT,N OW1=$$FMAD D^XLFDT(NO W,1)
18371	"RTN","PSX RPPL",196, 0)
18372	S ^XTMP(" ORLK-"_+OR D,0)=NOW1_ U_NOW_"^CP RS/CMOP RX /Order Loc k",^(1)=DU Z_U_$J
18373	"RTN","PSX RPPL",197, 0)
18374	Q
18375	"RTN","PSX RPPL",198, 0)
18376	RXNCLEAR ; needs RXN
18377	"RTN","PSX RPPL",199, 0)
18378	Q:'$G(RXN )
18379	"RTN","PSX RPPL",200, 0)
18380	N ORD S O RD=+$P($G( ^PSRX(+$G( RXN),"OR1" )),"^",2) Q:'ORD
18381	"RTN","PSX RPPL",201, 0)
18382	I $D(^XTM P("ORLK-"_ ORD,0)),^( 0)["CPRS/C MOP" K ^XT MP("ORLK-" _ORD)
18383	"RTN","PSX RPPL",202, 0)
18384	Q
18385	"RTN","PSX RPPL1")
18386	0^2^B54793 601
18387	"RTN","PSX RPPL1",1,0 )
18388	PSXRPPL1 ; BIR/WPB - Resets Sus pense to P rint/Trans mit ;10/02 /97
18389	"RTN","PSX RPPL1",2,0 )
18390	;;2.0;CMO P;*3,48,6 2,66,65,69 ,73,74,81 *;11 Apr 9 7;Build 15
18391	"RTN","PSX RPPL1",3,0 )
18392	;Referenc e to ^PSRX ( supporte d by DBIA #1977
18393	"RTN","PSX RPPL1",4,0 )
18394	;Referenc e to File #59 suppo rted by DB IA #1976
18395	"RTN","PSX RPPL1",5,0 )
18396	;Referenc e to PSOSU RST suppo rted by DB IA #1970
18397	"RTN","PSX RPPL1",6,0 )
18398	;Referenc e to ^PS(5 2.5, suppo rted by DB IA #1978
18399	"RTN","PSX RPPL1",7,0 )
18400	;Referenc e to ^BPSU TIL suppo rted by DB IA #4410
18401	"RTN","PSX RPPL1",8,0 )
18402	;Referenc e to ^PSSL OCK suppo rted by DB IA #2789
18403	"RTN","PSX RPPL1",9,0 )
18404	;Referenc e to ^PSOB PSUT suppo rted by DB IA #4701
18405	"RTN","PSX RPPL1",10, 0)
18406	;Referenc e to ^PSOB PSU1 suppo rted by DB IA #4702
18407	"RTN","PSX RPPL1",11, 0)
18408	;Referenc e to ^PSOR EJUT suppo rted by DB IA #4706
18409	"RTN","PSX RPPL1",12, 0)
18410	;Referenc e to ^PSOR EJU3 suppo rted by DB IA #5186
18411	"RTN","PSX RPPL1",13, 0)
18412	;Referenc e to ^PSOB PSU2 suppo rted by DB IA #4970
18413	"RTN","PSX RPPL1",14, 0)
18414	;Referenc e to ^PSOS ULB1 suppo rted by DB IA #2478
18415	"RTN","PSX RPPL1",15, 0)
18416	;Referenc e to LOG^B PSOSL supp orted by I CR# 6764
18417	"RTN","PSX RPPL1",16, 0)
18418	;Referenc e to IEN59 ^BPSOSRX s upported b y ICR# 441 2
18419	"RTN","PSX RPPL1",17, 0)
18420	;
18421	"RTN","PSX RPPL1",18, 0)
18422	;This rou tine will reset the Queued fla gs and the printed f lags in
18423	"RTN","PSX RPPL1",19, 0)
18424	;PS(52.5 to 'Queued ' and 'Pri nted' resp ectively a nd either retransmit s
18425	"RTN","PSX RPPL1",20, 0)
18426	;the data to the CM OP or prin ts the lab els.
18427	"RTN","PSX RPPL1",21, 0)
18428	START ;ini tializes l ocal varia bles
18429	"RTN","PSX RPPL1",22, 0)
18430	I '$D(^XU SEC("PSXCM OPMGR",DUZ )) W !,"Yo u are not authorized to use th is option! " Q
18431	"RTN","PSX RPPL1",23, 0)
18432	I '$D(^XU SEC("PSX X MIT",DUZ)) W !,"You are not au thorized t o use this option!" Q
18433	"RTN","PSX RPPL1",24, 0)
18434	S SWITCH= 0
18435	"RTN","PSX RPPL1",25, 0)
18436	K ^TMP($J ,"PSX")
18437	"RTN","PSX RPPL1",26, 0)
18438	QRY ;initi al message and optio n menu
18439	"RTN","PSX RPPL1",27, 0)
18440	W !
18441	"RTN","PSX RPPL1",28, 0)
18442	S DIR(0)= "NAO^1:3:0 ",DIR("A") ="Select ( 1, 2, 3): ",DIR("A" ,1)=" 1 - Reset CMO P Batches for Transm ission"
18443	"RTN","PSX RPPL1",29, 0)
18444	S DIR("A" ,2)=" 2 - Reprint C MOP Batche s",DIR("A" ,4)=" 3 - Standard Reprint Ba tches from Suspense"
18445	"RTN","PSX RPPL1",30, 0)
18446	S DIR("?" )="Enter a number be tween 1 an d 3.",DIR( "??")=$S($ G(PSXVER): "^D HELP^P SXSRP",1:" ^D MSG2^PS XRHLP") D ^DIR K DIR G:(Y<0)!( $D(DIRUT)) EXIT S RE PLY=Y K Y, X
18447	"RTN","PSX RPPL1",31, 0)
18448	I REPLY=1 S (PSXTRA NS,PSXFLAG ,SWITCH)=1 G:$G(PSXV ER) ^PSXSR ST G:'$G(P SXVER) BEG IN
18449	"RTN","PSX RPPL1",32, 0)
18450	I REPLY=2 S (PSXTRA NS,PSXFLAG ,SWITCH)=2 G:$G(PSXV ER) ^PSXSR ST G:'$G(P SXVER) BEG IN
18451	"RTN","PSX RPPL1",33, 0)
18452	I REPLY=3 S PSXFLG= 1 G START^ PSOSURST
18453	"RTN","PSX RPPL1",34, 0)
18454	K REPLY
18455	"RTN","PSX RPPL1",35, 0)
18456	Q
18457	"RTN","PSX RPPL1",36, 0)
18458	BEGIN ;con firms CMOP processin g, if Yes, checks fo r active s ite and st atus
18459	"RTN","PSX RPPL1",37, 0)
18460	;in the C MOP System file, if not an act ive site o r the syst em status
18461	"RTN","PSX RPPL1",38, 0)
18462	;is not s topped the routine e xits and p rocessing stops
18463	"RTN","PSX RPPL1",39, 0)
18464	W !
18465	"RTN","PSX RPPL1",40, 0)
18466	S DIR(0)= "Y",DIR("B ")="NO",DI R("A")="Ar e you sure you want to continu e",DIR("?" ,1)="No - Exits."
18467	"RTN","PSX RPPL1",41, 0)
18468	S DIR("?" )=$S(SWITC H=1:"Yes - Transmits data to t he CMOP.", SWITCH=2:" Yes - Prin ts labels. ",1:0) D ^ DIR K DIR G:(Y=0)!($ D(DIRUT)) EXIT K Y
18469	"RTN","PSX RPPL1",42, 0)
18470	S STATUS= $P($G(^PSX (550,+PSXS YS,0)),"^" ,3) I STAT US'="H" W !,"There i s another job in pro cess, plea se try aga in later." G EXIT
18471	"RTN","PSX RPPL1",43, 0)
18472	ASK ;gets date for t he resets
18473	"RTN","PSX RPPL1",44, 0)
18474	K BEGDATE ,ENDDATE W !!,?10,$S ($G(SWITCH )=1:"RESET and TRANS MIT CMOP D ATA",$G(SW ITCH)=2:"R ESET and R EPRINT CMO P LABELS", 1:""),!!!, "** Date Selection **",!!
18475	"RTN","PSX RPPL1",45, 0)
18476	ASK1 I SWI TCH=1 S %D T="AEX",%D T("A")=" BEGIN DAT E: " D ^% DT K %DT,% DT("A") G: Y<0 EXIT S PRTDT=Y
18477	"RTN","PSX RPPL1",46, 0)
18478	I SWITCH= 2 S %DT="A EX",%DT("A ")=" BEG IN DATE: " D ^%DT K %DT,%DT(" A") G:Y<0 EXIT S PRT DT=Y
18479	"RTN","PSX RPPL1",47, 0)
18480	W !! S %D T="AEX",%D T("A")=" ENDING DA TE: " D ^ %DT Q:Y<0 S PSXDTRG =Y K %DT,% DT("A")
18481	"RTN","PSX RPPL1",48, 0)
18482	I $G(PRTD T)>$G(PSXD TRG) W !," Begin Date must be b efore Endi ng Date!" G ASK1
18483	"RTN","PSX RPPL1",49, 0)
18484	I '$O(^PS (52.5,"AP" ,PRTDT-1)) !($O(^(0)) >PSXDTRG) W !!,$S(SW ITCH=1:"No thing to T ransmit.", SWITCH=2:" Nothing to Reprint." ,1:0) G EX IT
18485	"RTN","PSX RPPL1",50, 0)
18486	D SDT S P SXERFLG=0
18487	"RTN","PSX RPPL1",51, 0)
18488	I SWITCH= 1 D PSXTRA NS Q
18489	"RTN","PSX RPPL1",52, 0)
18490	I SWITCH= 2 D PRINT Q
18491	"RTN","PSX RPPL1",53, 0)
18492	S PSXSTAT ="H" D PSX STAT^PSXRS YU
18493	"RTN","PSX RPPL1",54, 0)
18494	G EXIT
18495	"RTN","PSX RPPL1",55, 0)
18496	PSXTRANS ;
18497	"RTN","PSX RPPL1",56, 0)
18498	W !!
18499	"RTN","PSX RPPL1",57, 0)
18500	S DIR(0)= "Y",DIR("B ")="YES",D IR("A")="D O YOU WISH TO TRANSM IT TO THE CMOP NOW", DIR("?",1) ="No - Exi ts the opt ion.",DIR( "?")="Yes - Transmit s to the C MOP." D ^D IR K DIR Q :(Y=0)!($D (DIRUT)) K Y
18501	"RTN","PSX RPPL1",58, 0)
18502	S PSXSTAT ="T" D PSX STAT^PSXRS YU,ASK^PSX RSUS
18503	"RTN","PSX RPPL1",59, 0)
18504	Q
18505	"RTN","PSX RPPL1",60, 0)
18506	PRINT ;
18507	"RTN","PSX RPPL1",61, 0)
18508	W !!
18509	"RTN","PSX RPPL1",62, 0)
18510	S DIR(0)= "Y",DIR("B ")="YES",D IR("A")="D O YOU WISH REPRINT C MOP LABELS NOW",DIR( "?",1)="No - Exits t he option. ",DIR("?") ="Yes - Re prints CMO P labels." D ^DIR K DIR Q:(Y=0 )!($D(DIRU T)) K Y
18511	"RTN","PSX RPPL1",63, 0)
18512	S PSXSTAT ="T" D PSX STAT^PSXRS YU,ASK^PSX RSUS
18513	"RTN","PSX RPPL1",64, 0)
18514	Q
18515	"RTN","PSX RPPL1",65, 0)
18516	SDT ;the f ollowing s ubroutines go throug h the PS(5 2.5 global and pull the
18517	"RTN","PSX RPPL1",66, 0)
18518	;data nee ded to res et the Que ued/Printe d nodes
18519	"RTN","PSX RPPL1",67, 0)
18520	S SDT=PRT DT-1 F S SDT=$O(^PS (52.5,"AP" ,SDT)),DFN =0 Q:(SDT> PSXDTRG)!( SDT="") D DFN
18521	"RTN","PSX RPPL1",68, 0)
18522	Q
18523	"RTN","PSX RPPL1",69, 0)
18524	DFN ;
18525	"RTN","PSX RPPL1",70, 0)
18526	F S DFN= $O(^PS(52. 5,"AP",SDT ,DFN)),REC =0 Q:(DFN= "")!(DFN'> 0) D REC
18527	"RTN","PSX RPPL1",71, 0)
18528	Q
18529	"RTN","PSX RPPL1",72, 0)
18530	REC ;
18531	"RTN","PSX RPPL1",73, 0)
18532	F S REC= $O(^PS(52. 5,"AP",SDT ,DFN,REC)) Q:(REC'>0 )!(REC="") D:$G(^PS (52.5,REC, 0)) CHECK
18533	"RTN","PSX RPPL1",74, 0)
18534	K ZDIV
18535	"RTN","PSX RPPL1",75, 0)
18536	Q
18537	"RTN","PSX RPPL1",76, 0)
18538	CHECK ;
18539	"RTN","PSX RPPL1",77, 0)
18540	S STAT=$P ($G(^PS(52 .5,REC,0)) ,U,7),PRIN T=$G(^PS(5 2.5,REC,"P ")),PSXPTR =$P($G(^PS (52.5,REC, 0)),U,1)
18541	"RTN","PSX RPPL1",78, 0)
18542	S RXF="" F XXF=0:0 S XXF=$O(^ PSRX(PSXPT R,1,XXF)) Q:XXF'>0 S RXF=XXF
18543	"RTN","PSX RPPL1",79, 0)
18544	S ZDIV=$S ($G(RXF)>0 :$P($G(^PS RX(PSXPTR, 1,RXF,0)), U,9),1:$P( $G(^PSRX(P SXPTR,2)), U,9)) I $G (ZDIV)'=$G (PSOSITE) Q
18545	"RTN","PSX RPPL1",80, 0)
18546	S:RXF'="" GONE=$P($ G(^PSRX(PS XPTR,1,RXF ,0)),U,18)
18547	"RTN","PSX RPPL1",81, 0)
18548	S:RXF="" GONE=$P($G (^PSRX(PSX PTR,2)),U, 13)
18549	"RTN","PSX RPPL1",82, 0)
18550	I (STAT=" P")&(PRINT =1)&($G(GO NE)="") D RESET
18551	"RTN","PSX RPPL1",83, 0)
18552	K GONE,RX F,XXF
18553	"RTN","PSX RPPL1",84, 0)
18554	Q
18555	"RTN","PSX RPPL1",85, 0)
18556	RESET ;res ets the Qu eued/Print ed flags t o Queued a nd not Pri nted
18557	"RTN","PSX RPPL1",86, 0)
18558	L +^PS(52 .5,REC):DT IME Q:'$T
18559	"RTN","PSX RPPL1",87, 0)
18560	S DIE="^P S(52.5,",D A=REC,DR=" 2////2;3// //Q" D ^DI E L -^PS(5 2.5,REC) K DIE,DR,DA
18561	"RTN","PSX RPPL1",88, 0)
18562	S:$G(PSXV ER) $P(^PS RX(PSXPTR, "STA"),U,1 )=5 S:'$G( PSXVER) $P (^PSRX(PSX PTR,0),U,1 5)=5 K ^PS (52.5,"AC" ,DFN,SDT,R EC)
18563	"RTN","PSX RPPL1",89, 0)
18564	Q
18565	"RTN","PSX RPPL1",90, 0)
18566	PRTERR ; a uto error trap for p rt cmop lo cal
18567	"RTN","PSX RPPL1",91, 0)
18568	S XXERR=$ $EC^%ZOSV
18569	"RTN","PSX RPPL1",92, 0)
18570	S PSXDIVN M=$$GET1^D IQ(59,PSOS ITE,.01)
18571	"RTN","PSX RPPL1",93, 0)
18572	;save an image of t he transie nt file 55 0.1 for 2 days
18573	"RTN","PSX RPPL1",94, 0)
18574	D NOW^%DT C S DTTM=%
18575	"RTN","PSX RPPL1",95, 0)
18576	S X=$$FMA DD^XLFDT(D T,+2) S ^X TMP("PSXER R "_DTTM,0 )=X_U_DT_U _"CMOP "_X XERR
18577	"RTN","PSX RPPL1",96, 0)
18578	M ^XTMP(" PSXERR "_D TTM,550.1) =^PSX(550. 1)
18579	"RTN","PSX RPPL1",97, 0)
18580	S XMSUB=" CMOP Error "_PSXDIVN M_" "_$$GE T1^DIQ(550 .2,+$G(PSX BAT),.01)
18581	"RTN","PSX RPPL1",98, 0)
18582	D GRP1^PS XNOTE
18583	"RTN","PSX RPPL1",99, 0)
18584	;S XMY(DU Z)=""
18585	"RTN","PSX RPPL1",100 ,0)
18586	S XMTEXT= "TEXT("
18587	"RTN","PSX RPPL1",101 ,0)
18588	S TEXT(1, 0)=$S($G(P SXCS):"",1 :"NON-")_" CS CMOP Pr int Local encountere d the foll owing erro r. Please investigat e"
18589	"RTN","PSX RPPL1",102 ,0)
18590	S TEXT(2, 0)="Divisi on: "_PSXDIV NM
18591	"RTN","PSX RPPL1",103 ,0)
18592	S TEXT(3, 0)="Type/B atch "_$S($G( PSXCS):"CS ",1:"NON-C S")_" / "_ $$GET1^DIQ (550.2,$G( PSXBAT),.0 1)
18593	"RTN","PSX RPPL1",104 ,0)
18594	S TEXT(4, 0)="Error: "_XXERR
18595	"RTN","PSX RPPL1",105 ,0)
18596	S TEXT(5, 0)="This b atch has b een set to closed."
18597	"RTN","PSX RPPL1",106 ,0)
18598	S TEXT(6, 0)="Call N VS to inve stigate wh ich prescr iptions ha ve been pr inted and which are yet to pri nt."
18599	"RTN","PSX RPPL1",107 ,0)
18600	S TEXT(7, 0)="A copy of file 5 50.1 can b e found in ^XTMP(""P SXERR "_DT TM_""")"
18601	"RTN","PSX RPPL1",108 ,0)
18602	D ^%ZTER
18603	"RTN","PSX RPPL1",109 ,0)
18604	D ^XMD
18605	"RTN","PSX RPPL1",110 ,0)
18606	I $G(PSXB AT) D
18607	"RTN","PSX RPPL1",111 ,0)
18608	. N DA,DI E,DR S DIE ="^PSX(550 .2,",DA=PS XBAT,DR="1 ////4"
18609	"RTN","PSX RPPL1",112 ,0)
18610	. D ^DIE
18611	"RTN","PSX RPPL1",113 ,0)
18612	G UNWIND^ %ZTER
18613	"RTN","PSX RPPL1",114 ,0)
18614	;
18615	"RTN","PSX RPPL1",115 ,0)
18616	SBTECME(PS XTP,PSXDV, THRDT,PULL DT) ; - Su mitting pr escription s to EMCE (3rd Party Billing)
18617	"RTN","PSX RPPL1",116 ,0)
18618	;Input: P SXTP - Ty pe of pres criptions "C" - Cont rolled Sub s / "N" No n-Controll ed Subs
18619	"RTN","PSX RPPL1",117 ,0)
18620	; P SXDV - Po inter to D IVSION fil e (#59)
18621	"RTN","PSX RPPL1",118 ,0)
18622	; T HRDT - T+ N when sch eduling th e THROUGH DATE to ru n CMOP Tra nsmission
18623	"RTN","PSX RPPL1",119 ,0)
18624	; P ULLDT - T+ N+PULL DAY S paramete r in file# 59, OUTPA TIENT SITE
18625	"RTN","PSX RPPL1",120 ,0)
18626	;Output:S BTECME- Nu mber of pr escription s submitte d to ECME
18627	"RTN","PSX RPPL1",121 ,0)
18628	;
18629	"RTN","PSX RPPL1",122 ,0)
18630	N PSOLRX, REC,RESP,R FL,RX,SBTE CME,SDT,XD FN
18631	"RTN","PSX RPPL1",123 ,0)
18632	;
18633	"RTN","PSX RPPL1",124 ,0)
18634	I '$$ECME ON^BPSUTIL (PSXDV)!'$ $CMOPON^BP SUTIL(PSXD V) Q
18635	"RTN","PSX RPPL1",125 ,0)
18636	K ^TMP("P SXEPHDFN", $J)
18637	"RTN","PSX RPPL1",126 ,0)
18638	S (SDT,SB TECME)=0
18639	"RTN","PSX RPPL1",127 ,0)
18640	F S SDT= $O(^PS(52. 5,"CMP","Q ",PSXTP,PS XDV,SDT)) S XDFN=0 Q :(SDT>PULL DT)!(SDT'> 0) D
18641	"RTN","PSX RPPL1",128 ,0)
18642	. F S XD FN=$O(^PS( 52.5,"CMP" ,"Q",PSXTP ,PSXDV,SDT ,XDFN)) S REC=0 Q:(X DFN'>0)!(X DFN="") D
18643	"RTN","PSX RPPL1",129 ,0)
18644	. . F S REC=$O(^PS (52.5,"CMP ","Q",PSXT P,PSXDV,SD T,XDFN,REC )) Q:(REC' >0)!(REC=" ") D
18645	"RTN","PSX RPPL1",130 ,0)
18646	. . . S ( PSOLRX,RX) =+$$GET1^D IQ(52.5,RE C,.01,"I") I 'RX Q
18647	"RTN","PSX RPPL1",131 ,0)
18648	. . . S R FL=$$GET1^ DIQ(52.5,R EC,9,"I") I RFL="" S RFL=$$LST RFL^PSOBPS U1(RX)
18649	"RTN","PSX RPPL1",132 ,0)
18650	. . . I $ $XMIT^PSXB PSUT(REC) D
18651	"RTN","PSX RPPL1",133 ,0)
18652	. . . . I SDT>THRDT ,'$D(^TMP( "PSXEPHDFN ",$J,XDFN) ) Q
18653	"RTN","PSX RPPL1",134 ,0)
18654	. . . . I $$PATCH^X PDUTL("PSO 7.0148") D
18655	"RTN","PSX RPPL1",135 ,0)
18656	. . . . . I $$RETRX ^PSOBPSUT( RX,RFL),SD T>DT Q
18657	"RTN","PSX RPPL1",136 ,0)
18658	. . . . . I $$DOUBL E(RX,RFL) Q
18659	"RTN","PSX RPPL1",137 ,0)
18660	. . . . . I $$FIND^ PSOREJUT(R X,RFL,,"79 ,88",,1) Q
18661	"RTN","PSX RPPL1",138 ,0)
18662	. . . . . I '$$RETR X^PSOBPSUT (RX,RFL),' $$ECMESTAT ^PSXRPPL2( RX,RFL) Q
18663	"RTN","PSX RPPL1",139 ,0)
18664	. . . . . I $$PATCH ^XPDUTL("P SO7.0289 ") Q:'$$DU R^PSXRPPL2 (RX,RFL) ;ePharm Ho st error h old
18665	"RTN","PSX RPPL1",140 ,0)
18666	. . . . . I $$PATCH ^XPDUTL("P SO7.0289 "),RFL>0,$ $STATUS^PS OBPSUT(RX, RFL-1)'="" Q:'$$DSH^ PSXRPPL2(R EC) ;ePha rm 3/4 day s supply ( refill)
18667	"RTN","PSX RPPL1",141 ,0)
18668	. . . . . I $$PATCH ^XPDUTL("P SO7.0289 "),RFL=0 Q :'$$DSH^PS XRPPL2(REC ) ;ePharm 3/4 days supply (or iginal fil l)
18669	"RTN","PSX RPPL1",142 ,0)
18670	. . . . . D ECMESND ^PSOBPSU1( RX,RFL,"", "PC",,1,,, ,.RESP)
18671	"RTN","PSX RPPL1",143 ,0)
18672	. . . . . ;
18673	"RTN","PSX RPPL1",144 ,0)
18674	. . . . . D LOG^BPS OSL($$IEN5 9^BPSOSRX( RX,RFL),$T (+0)_"-SBT ECME, RESP ="_$P(RESP ,"^",4)) ; ICR #441 2,6764
18675	"RTN","PSX RPPL1",145 ,0)
18676	. . . . . ;
18677	"RTN","PSX RPPL1",146 ,0)
18678	. . . . . I $D(RESP ),'RESP S SBTECME=SB TECME+1
18679	"RTN","PSX RPPL1",147 ,0)
18680	. . . . . S ^TMP("P SXEPHDFN", $J,XDFN)=" "
18681	"RTN","PSX RPPL1",148 ,0)
18682	. . . D P SOUL^PSSLO CK(PSOLRX)
18683	"RTN","PSX RPPL1",149 ,0)
18684	K ^TMP("P SXEPHDFN", $J)
18685	"RTN","PSX RPPL1",150 ,0)
18686	Q SBTECME
18687	"RTN","PSX RPPL1",151 ,0)
18688	;
18689	"RTN","PSX RPPL1",152 ,0)
18690	DOUBLE(RX, RFL) ; Che cks if pre vious fill is still being work ed on by C MOP
18691	"RTN","PSX RPPL1",153 ,0)
18692	;Input: ( r) RX - P rescriptio n IEN
18693	"RTN","PSX RPPL1",154 ,0)
18694	; ( r) RFL - F ill number
18695	"RTN","PSX RPPL1",155 ,0)
18696	;Output: 0 - Pre vious fill not with CMOP / 1 - CMOP work ing on pre vious fill
18697	"RTN","PSX RPPL1",156 ,0)
18698	N CMP,DOU BLE,STS
18699	"RTN","PSX RPPL1",157 ,0)
18700	;
18701	"RTN","PSX RPPL1",158 ,0)
18702	I 'RFL!'$ D(^PSRX(RX ,4)) Q 0
18703	"RTN","PSX RPPL1",159 ,0)
18704	I $$STATU S^PSOBPSUT (RX,RFL-1) ="" Q 0
18705	"RTN","PSX RPPL1",160 ,0)
18706	S DOUBLE= 0,CMP=999
18707	"RTN","PSX RPPL1",161 ,0)
18708	F S CMP= $O(^PSRX(R X,4,CMP),- 1) Q:'CMP D I DOUB LE Q
18709	"RTN","PSX RPPL1",162 ,0)
18710	. I $$GET 1^DIQ(52.0 1,CMP_","_ RX,2,"I")' =(RFL-1) Q
18711	"RTN","PSX RPPL1",163 ,0)
18712	. S STS=$ $GET1^DIQ( 52.01,CMP_ ","_RX,3," I")
18713	"RTN","PSX RPPL1",164 ,0)
18714	. I STS=0 !(STS=2) S DOUBLE=1
18715	"RTN","PSX RPPL1",165 ,0)
18716	Q DOUBLE
18717	"RTN","PSX RPPL1",166 ,0)
18718	;
18719	"RTN","PSX RPPL1",167 ,0)
18720	EXIT ;
18721	"RTN","PSX RPPL1",168 ,0)
18722	K DFN,PSX DAYS,PSXDT RG,SWITCH, STAT,PRINT ,PSXTRANS, REC,REPLY, SDT,X,X1,X 2,Y,ANSWER ,STATUS,PS XFLAG,PSXP TR,PSXSTAT
18723	"RTN","PSX RPPL1",169 ,0)
18724	K DIR,DIR UT,DTOUT,D UOUT,DIROU T
18725	"RTN","PSX RPPL1",170 ,0)
18726	Q
18727	"RTN","PSX RPPL2")
18728	0^3^B72029 409
18729	"RTN","PSX RPPL2",1,0 )
18730	PSXRPPL2 ; BIR/WPB - Print From Suspense Utilities ;06/10/08
18731	"RTN","PSX RPPL2",2,0 )
18732	;;2.0;CMO P;65,69, 73,74,79,8 1;11 Apr 97;Build 15
18733	"RTN","PSX RPPL2",3,0 )
18734	;Referenc e to ^PSRX ( supporte d by DBIA #1977
18735	"RTN","PSX RPPL2",4,0 )
18736	;Referenc e to ^PS(5 2.5, suppo rted by DB IA #1978
18737	"RTN","PSX RPPL2",5,0 )
18738	;Referenc e to ^PSSL OCK suppo rted by DB IA #2789
18739	"RTN","PSX RPPL2",6,0 )
18740	;Referenc e to ^PSOB PSUT suppo rted by DB IA #4701
18741	"RTN","PSX RPPL2",7,0 )
18742	;Referenc e to ^PSOB PSU1 suppo rted by DB IA #4702
18743	"RTN","PSX RPPL2",8,0 )
18744	;Referenc e to ^PSOB PSU2 suppo rted by DB IA #4970
18745	"RTN","PSX RPPL2",9,0 )
18746	;Referenc e to ^PSOR EJUT suppo rted by DB IA #4706
18747	"RTN","PSX RPPL2",10, 0)
18748	;Referenc e to ^PSOR EJU3 suppo rted by DB IA #5186
18749	"RTN","PSX RPPL2",11, 0)
18750	;Referenc e to CHANG E^PSOSUCH1 supported by DBIA # 5427
18751	"RTN","PSX RPPL2",12, 0)
18752	;Referenc e to PREVR X^PSOREJP2 supported by DBIA # 5912
18753	"RTN","PSX RPPL2",13, 0)
18754	;Referenc e to $$BIL LABLE^IBNC PDP suppor ted by DBI A #6243
18755	"RTN","PSX RPPL2",14, 0)
18756	;Referenc e to LOG^B PSOSL supp orted by I CR# 6764
18757	"RTN","PSX RPPL2",15, 0)
18758	;Referenc e to IEN59 ^BPSOSRX s upported b y ICR# 441 2
18759	"RTN","PSX RPPL2",16, 0)
18760	;
18761	"RTN","PSX RPPL2",17, 0)
18762	CHKDFN(THR DT) ; use the patien t 'C' inde x under RX multiple in file 55 0.2 to GET dfn to ga ther Patie nts' futur e RXs
18763	"RTN","PSX RPPL2",18, 0)
18764	;Input: T HRDT - THR OUGH DATE to run CMO P transmis sion
18765	"RTN","PSX RPPL2",19, 0)
18766	;
18767	"RTN","PSX RPPL2",20, 0)
18768	; This pr ocedure as sumes the following variables to exist:
18769	"RTN","PSX RPPL2",21, 0)
18770	; PRTDT = Transmi t/Print da ta through this date
18771	"RTN","PSX RPPL2",22, 0)
18772	; PSXBA T = Batch, pointer t o file#550 .2, CMOP T ransmissio n
18773	"RTN","PSX RPPL2",23, 0)
18774	; PSXDT RG = Pull ahead thro ugh date
18775	"RTN","PSX RPPL2",24, 0)
18776	; PSXTD IV = Divis ion
18777	"RTN","PSX RPPL2",25, 0)
18778	; PSXTY P = "C" if running f or Control led Substa nce, "N" o therwise
18779	"RTN","PSX RPPL2",26, 0)
18780	;
18781	"RTN","PSX RPPL2",27, 0)
18782	N NDFN,PS OLRX,PSXPT NM,REC,RES P,RFL,RX,S BTECME,SDT ,XDFN
18783	"RTN","PSX RPPL2",28, 0)
18784	;
18785	"RTN","PSX RPPL2",29, 0)
18786	I '$D(^PS X(550.2,PS XBAT,15,"C ")) Q
18787	"RTN","PSX RPPL2",30, 0)
18788	S SBTECME =0
18789	"RTN","PSX RPPL2",31, 0)
18790	K ^TMP("P SXEPHDFN", $J)
18791	"RTN","PSX RPPL2",32, 0)
18792	S PSXPTNM =""
18793	"RTN","PSX RPPL2",33, 0)
18794	F S PSXP TNM=$O(^PS X(550.2,PS XBAT,15,"C ",PSXPTNM) ) Q:PSXPTN M="" D
18795	"RTN","PSX RPPL2",34, 0)
18796	. S XDFN= 0
18797	"RTN","PSX RPPL2",35, 0)
18798	. F S XD FN=$O(^PSX (550.2,PSX BAT,"15"," C",PSXPTNM ,XDFN)) Q: (XDFN'>0) D
18799	"RTN","PSX RPPL2",36, 0)
18800	. . S SDT =PRTDT
18801	"RTN","PSX RPPL2",37, 0)
18802	. . F S SDT=$O(^PS (52.5,"CMP ","Q",PSXT YP,PSXTDIV ,SDT)) Q:( SDT>PSXDTR G)!(SDT="" ) D
18803	"RTN","PSX RPPL2",38, 0)
18804	. . . S N DFN=0
18805	"RTN","PSX RPPL2",39, 0)
18806	. . . F S NDFN=$O( ^PS(52.5," CMP","Q",P SXTYP,PSXT DIV,SDT,ND FN)) Q:NDF N'>0 I ND FN=XDFN D
18807	"RTN","PSX RPPL2",40, 0)
18808	. . . . S REC=0
18809	"RTN","PSX RPPL2",41, 0)
18810	. . . . F S REC=$O (^PS(52.5, "CMP","Q", PSXTYP,PSX TDIV,SDT,N DFN,REC)) Q:REC'>0 D
18811	"RTN","PSX RPPL2",42, 0)
18812	. . . . . S (PSOLRX ,RX)=+$$GE T1^DIQ(52. 5,REC,.01, "I") I 'RX Q
18813	"RTN","PSX RPPL2",43, 0)
18814	. . . . . S RFL=$$G ET1^DIQ(52 .5,REC,9," I") I RFL= "" S RFL=$ $LSTRFL^PS OBPSU1(RX)
18815	"RTN","PSX RPPL2",44, 0)
18816	. . . . . I $$XMIT^ PSXBPSUT(R EC) D
18817	"RTN","PSX RPPL2",45, 0)
18818	. . . . . . I SDT>T HRDT,'$D(^ TMP("PSXEP HDFN",$J,X DFN)) Q
18819	"RTN","PSX RPPL2",46, 0)
18820	. . . . . . I $$PAT CH^XPDUTL( "PSO7.01 48") D
18821	"RTN","PSX RPPL2",47, 0)
18822	. . . . . . . I $$R ETRX^PSOBP SUT(RX,RFL ),SDT>DT Q
18823	"RTN","PSX RPPL2",48, 0)
18824	. . . . . . . I $$D OUBLE^PSXR PPL1(RX,RF L) Q
18825	"RTN","PSX RPPL2",49, 0)
18826	. . . . . . . I $$F IND^PSOREJ UT(RX,RFL, ,"79,88",, 1) Q
18827	"RTN","PSX RPPL2",50, 0)
18828	. . . . . . . I '$$ RETRX^PSOB PSUT(RX,RF L),$$ECMES TAT(RX,RFL ) Q
18829	"RTN","PSX RPPL2",51, 0)
18830	. . . . . . . I $$P ATCH^XPDUT L("PSO7.0 289"),'$$ DUR(RX,RFL ),'$$DSH(R EC) Q
18831	"RTN","PSX RPPL2",52, 0)
18832	. . . . . . . D ECM ESND^PSOBP SU1(RX,RFL ,"","PC",, 1,,,,.RESP )
18833	"RTN","PSX RPPL2",53, 0)
18834	. . . . . . . ;
18835	"RTN","PSX RPPL2",54, 0)
18836	. . . . . . . D LOG ^BPSOSL($$ IEN59^BPSO SRX(RX,RFL ),$T(+0)_" -CHKDFN, R ESP="_$P(R ESP,"^",4) ) ; ICR # 4412,6764
18837	"RTN","PSX RPPL2",55, 0)
18838	. . . . . . . ;
18839	"RTN","PSX RPPL2",56, 0)
18840	. . . . . . . I $D( RESP),'RES P S SBTECM E=SBTECME+ 1
18841	"RTN","PSX RPPL2",57, 0)
18842	. . . . . . . S ^TM P("PSXEPHD FN",$J,XDF N)=""
18843	"RTN","PSX RPPL2",58, 0)
18844	. . . . . D PSOUL^P SSLOCK(PSO LRX)
18845	"RTN","PSX RPPL2",59, 0)
18846	K ^TMP("P SXEPHDFN", $J)
18847	"RTN","PSX RPPL2",60, 0)
18848	I SBTECME >0 H 60+$S ((SBTECME* 15)>7200:7 200,1:(SBT ECME*15))
18849	"RTN","PSX RPPL2",61, 0)
18850	Q
18851	"RTN","PSX RPPL2",62, 0)
18852	;
18853	"RTN","PSX RPPL2",63, 0)
18854	; EPHARM is called only by GE TDATA^PSXR PPL. The variable E PHQT is
18855	"RTN","PSX RPPL2",64, 0)
18856	; Newed i n GETDATA. If EPHQT is set to 1 here, t hen GETDAT A does
18857	"RTN","PSX RPPL2",65, 0)
18858	; not con tinue proc essing the current R x/Fill; th is Rx/Fill will
18859	"RTN","PSX RPPL2",66, 0)
18860	; not be sent to CM OP if EPHQ T is set t o 1 here.
18861	"RTN","PSX RPPL2",67, 0)
18862	;
18863	"RTN","PSX RPPL2",68, 0)
18864	EPHARM ; - ePharmacy checks fo r third pa rty billin g
18865	"RTN","PSX RPPL2",69, 0)
18866	;
18867	"RTN","PSX RPPL2",70, 0)
18868	; If CMOP is still processing the previ ous fill ( $$DOUBLE), or if the
18869	"RTN","PSX RPPL2",71, 0)
18870	; RE-TRAN SMIT flag is 'Yes' a nd the sen d date is in the fut ure, or if
18871	"RTN","PSX RPPL2",72, 0)
18872	; this pr escription has an un resolved 7 9,88, or R RR reject, then Set
18873	"RTN","PSX RPPL2",73, 0)
18874	; EPHQT t o 1 and Qu it. This Rx/Fill wi ll not be sent to CM OP.
18875	"RTN","PSX RPPL2",74, 0)
18876	;
18877	"RTN","PSX RPPL2",75, 0)
18878	I $$DOUBL E^PSXRPPL1 (RXN,RFL) S EPHQT=1 Q
18879	"RTN","PSX RPPL2",76, 0)
18880	I $$RETRX ^PSOBPSUT( RXN,RFL),S DT>DT S EP HQT=1 Q
18881	"RTN","PSX RPPL2",77, 0)
18882	I $$FIND^ PSOREJUT(R XN,RFL,,"7 9,88",,1) S EPHQT=1 Q
18883	"RTN","PSX RPPL2",78, 0)
18884	;
18885	"RTN","PSX RPPL2",79, 0)
18886	; $$TRIST A performs checks sp ecific to TRICARE/CH AMPVA. If the claim
18887	"RTN","PSX RPPL2",80, 0)
18888	; was rej ected or i s still "I N PROGRESS ", or if i t is non-b illable,
18889	"RTN","PSX RPPL2",81, 0)
18890	; then ad d this Rx to the ^TM P("PSXEPHI N") array and quit.
18891	"RTN","PSX RPPL2",82, 0)
18892	;
18893	"RTN","PSX RPPL2",83, 0)
18894	I $$PATCH ^XPDUTL("P SO7.0287 "),$$TRIST A^PSOREJU3 (RXN,RFL,. RESP,"PC") D EPH Q
18895	"RTN","PSX RPPL2",84, 0)
18896	;
18897	"RTN","PSX RPPL2",85, 0)
18898	; If the claim is s till "IN P ROGRESS", then add t his Rx to the
18899	"RTN","PSX RPPL2",86, 0)
18900	; ^TMP("P SXEPHIN") array and quit.
18901	"RTN","PSX RPPL2",87, 0)
18902	;
18903	"RTN","PSX RPPL2",88, 0)
18904	I $$STATU S^PSOBPSUT (RXN,RFL)= "IN PROGRE SS" D EPH Q
18905	"RTN","PSX RPPL2",89, 0)
18906	;
18907	"RTN","PSX RPPL2",90, 0)
18908	; If this Prescript ion violat es the 3/4 supply (i .e. if it is too soo n
18909	"RTN","PSX RPPL2",91, 0)
18910	; to refi ll), then Set EPHQT to 1 and Q uit. This Rx/Fill w ill not be
18911	"RTN","PSX RPPL2",92, 0)
18912	; sent to CMOP.
18913	"RTN","PSX RPPL2",93, 0)
18914	;
18915	"RTN","PSX RPPL2",94, 0)
18916	I $$PATCH ^XPDUTL("P SO7.0289 "),'$$DSH( REC) S EPH QT=1 Q
18917	"RTN","PSX RPPL2",95, 0)
18918	;
18919	"RTN","PSX RPPL2",96, 0)
18920	; If ther e is a hos t reject f or this Rx /Fill, the n add this Rx to the
18921	"RTN","PSX RPPL2",97, 0)
18922	; ^TMP("P SXEPHIN") array and quit.
18923	"RTN","PSX RPPL2",98, 0)
18924	;
18925	"RTN","PSX RPPL2",99, 0)
18926	I $$PATCH ^XPDUTL("P SO7.0289 "),'$$DUR( RXN,RFL) D EPH Q
18927	"RTN","PSX RPPL2",100 ,0)
18928	Q
18929	"RTN","PSX RPPL2",101 ,0)
18930	;
18931	"RTN","PSX RPPL2",102 ,0)
18932	; EPH is called onl y by EPHAR M, above. It adds a prescript ions to th e
18933	"RTN","PSX RPPL2",103 ,0)
18934	; ^TMP("P SXEPHIN") array. Of those Pre scriptions not sent to the CMO P
18935	"RTN","PSX RPPL2",104 ,0)
18936	; facilit y and left in the su spense que ue, some a re added t o this
18937	"RTN","PSX RPPL2",105 ,0)
18938	; array. Those in this array will be l isted in t he email s ent to use rs
18939	"RTN","PSX RPPL2",106 ,0)
18940	; indicat ing that t hey were l eft in the queue (se e ^PSXBPSM S). That
18941	"RTN","PSX RPPL2",107 ,0)
18942	; email s tates thes e Rxs were not trans mitted to the CMOP f acility
18943	"RTN","PSX RPPL2",108 ,0)
18944	; because either a) a respons e from the payer was not recei ved, or b)
18945	"RTN","PSX RPPL2",109 ,0)
18946	; the Rx is non-bil lable.
18947	"RTN","PSX RPPL2",110 ,0)
18948	;
18949	"RTN","PSX RPPL2",111 ,0)
18950	EPH ; - St ore Rx not xmitted t o CMOP in XTMP file for MailMa n message.
18951	"RTN","PSX RPPL2",112 ,0)
18952	S ^TMP("P SXEPHIN",$ J,$$RXSITE ^PSOBPSUT( RXN),RXN)= RFL,EPHQT= 1
18953	"RTN","PSX RPPL2",113 ,0)
18954	Q
18955	"RTN","PSX RPPL2",114 ,0)
18956	;
18957	"RTN","PSX RPPL2",115 ,0)
18958	;Descript ion:
18959	"RTN","PSX RPPL2",116 ,0)
18960	;This fun ction chec ks the Rx' s ECME Sta tus to det ermine if it's accep table to r esubmit
18961	"RTN","PSX RPPL2",117 ,0)
18962	;based on reject co des associ ated with a previous submissio n. If Rx w as rejecte d with
18963	"RTN","PSX RPPL2",118 ,0)
18964	;host rej ect errors , and no o ther rejec ts exist, then it's OK to resu bmit to EC ME.
18965	"RTN","PSX RPPL2",119 ,0)
18966	;Input: R X = Prescr iption fil e #52 IEN
18967	"RTN","PSX RPPL2",120 ,0)
18968	; RFL = R efill numb er
18969	"RTN","PSX RPPL2",121 ,0)
18970	;Returns: 1 = OK to resubmit
18971	"RTN","PSX RPPL2",122 ,0)
18972	;0 = Don' t resubmit
18973	"RTN","PSX RPPL2",123 ,0)
18974	ECMESTAT(R X,RFL) ;
18975	"RTN","PSX RPPL2",124 ,0)
18976	I '$$PATC H^XPDUTL(" PSO7.014 8") Q 0
18977	"RTN","PSX RPPL2",125 ,0)
18978	N STATUS, HERR,CHDAT
18979	"RTN","PSX RPPL2",126 ,0)
18980	S STATUS= $$STATUS^P SOBPSUT(RX ,RFL)
18981	"RTN","PSX RPPL2",127 ,0)
18982	; Never s ubmitted b efore, OK to resubmi t
18983	"RTN","PSX RPPL2",128 ,0)
18984	I STATUS= ""!(STATUS ["UNSTRAND ED") Q 1
18985	"RTN","PSX RPPL2",129 ,0)
18986	; If stat us other t han E REJE CTED, don' t resubmit
18987	"RTN","PSX RPPL2",130 ,0)
18988	I STATUS' ="E REJECT ED" Q 0
18989	"RTN","PSX RPPL2",131 ,0)
18990	; check f or a previ ous host r eject:
18991	"RTN","PSX RPPL2",132 ,0)
18992	; 1 - if host reje ct date ex pired allo w to print ; 0 - if n ot expired don't pri nt
18993	"RTN","PSX RPPL2",133 ,0)
18994	; 2 - if not def ined allow to contin ue with ev aluation f or new hos t reject
18995	"RTN","PSX RPPL2",134 ,0)
18996	S CHDAT=$ $CHHEDT(RX ,RFL) Q:CH DAT=1 1 Q: CHDAT=0 0
18997	"RTN","PSX RPPL2",135 ,0)
18998	;****** ****** ****** ****** ****** ****** ****** ****** ****** ****** *
18999	"RTN","PSX RPPL2",136 ,0)
19000	; NOTE: MAKE SURE THAT IGNO RED REJECT S WILL PRO CESS WHENE VER MODIFI CATIONS AR E MADE TO HOST REJEC T
19001	"RTN","PSX RPPL2",137 ,0)
19002	; Ignored r ejects are handled b y default when this subroutine Q 0 at th e end.
19003	"RTN","PSX RPPL2",138 ,0)
19004	;****** ****** ****** ****** ****** ****** ****** ****** ****** ****** *
19005	"RTN","PSX RPPL2",139 ,0)
19006	; check host rejec ts
19007	"RTN","PSX RPPL2",140 ,0)
19008	S HERR=$$ HOSTREJ(RX ,RFL,0)
19009	"RTN","PSX RPPL2",141 ,0)
19010	I HERR&(C HDAT=2) D SHDTLOG(RX ,RFL) Q 0 ;Host rej ect and no suspense hold date defined ye t; define it and don 't resubmi t
19011	"RTN","PSX RPPL2",142 ,0)
19012	I HERR&(C HDAT) Q 1 ;Host rej ect & susp ense hold date has e xpired; re submit
19013	"RTN","PSX RPPL2",143 ,0)
19014	Q 0 ;NOT E - IF YOU CHANGE TH IS Q 0, IG NORED REJE CTS WILL R ESUBMIT AN D REJECT A GAIN WHICH IS VERY B AD.
19015	"RTN","PSX RPPL2",144 ,0)
19016	;
19017	"RTN","PSX RPPL2",145 ,0)
19018	;Descript ion:
19019	"RTN","PSX RPPL2",146 ,0)
19020	;This fun ction dete rmines whe ther the R X SUSPENSE has a DAY S SUPPLY H OLD
19021	"RTN","PSX RPPL2",147 ,0)
19022	;conditio n.
19023	"RTN","PSX RPPL2",148 ,0)
19024	;Input: R EC = Point er to Susp ense file (#52.5)
19025	"RTN","PSX RPPL2",149 ,0)
19026	;Returns: 1 or 0
19027	"RTN","PSX RPPL2",150 ,0)
19028	;1 (one) if 3/4 of days suppl y has elap sed.
19029	"RTN","PSX RPPL2",151 ,0)
19030	;0 (zero) is return ed if 3/4 of days su pply has n ot elapsed .
19031	"RTN","PSX RPPL2",152 ,0)
19032	;
19033	"RTN","PSX RPPL2",153 ,0)
19034	DSH(REC) ; ePharmacy API to che ck for 3/4 days supp ly hold
19035	"RTN","PSX RPPL2",154 ,0)
19036	N PSINSUR ,PSARR,SHD T,DSHOLD,D SHDT,PS0,C OMM,DIE,DA ,DR,RXIEN, RFL,DAYSSU P,LSTFIL,P TDFN,IBINS ,DRG
19037	"RTN","PSX RPPL2",155 ,0)
19038	N SFN,SDT ,ELIG,PREV RX
19039	"RTN","PSX RPPL2",156 ,0)
19040	S DSHOLD= 1,PS0=^PS( 52.5,REC,0 ),RXIEN=$P (PS0,U,1), RFL=$P(PS0 ,U,13)
19041	"RTN","PSX RPPL2",157 ,0)
19042	S LSTFIL= $$LSTRFL^P SOBPSU1(RX IEN),PTDFN =$$GET1^DI Q(52,RXIEN ,"2","I")
19043	"RTN","PSX RPPL2",158 ,0)
19044	I RFL="" S RFL=LSTF IL
19045	"RTN","PSX RPPL2",159 ,0)
19046	S IBSTAT= $$INSUR^IB BAPI(PTDFN ,,"E",.IBI NS,"1"),DR G=$$GET1^D IQ(52,RXIE N,"6","I")
19047	"RTN","PSX RPPL2",160 ,0)
19048	S ELIG=$S (RFL:$P($G (^PSRX(+RX IEN,1,RFL, "EPH")),U, 5),1:$P($G (^PSRX(+RX IEN,"EPH") ),U,5))
19049	"RTN","PSX RPPL2",161 ,0)
19050	;
19051	"RTN","PSX RPPL2",162 ,0)
19052	; Don't h old Rx whe re the pre vious fill was not e billable
19053	"RTN","PSX RPPL2",163 ,0)
19054	I LSTFIL> 0,$$STATUS ^BPSOSRX(R XIEN,LSTFI L-1)="" Q DSHOLD
19055	"RTN","PSX RPPL2",164 ,0)
19056	; Don't h old when t he Rx has SC/EI flag ged
19057	"RTN","PSX RPPL2",165 ,0)
19058	I $P($G(^ PSRX(RXIEN ,"ICD",1,0 )),U,2,10) [1 Q DSHOL D
19059	"RTN","PSX RPPL2",166 ,0)
19060	; Don't h old rx if drug is no n-billable
19061	"RTN","PSX RPPL2",167 ,0)
19062	I '$$BILL ABLE^IBNCP DP(DRG,ELI G) Q DSHOL D ; IA# 62 43
19063	"RTN","PSX RPPL2",168 ,0)
19064	; Don't h old if no insurance
19065	"RTN","PSX RPPL2",169 ,0)
19066	I 'IBSTAT !(IBSTAT=- 1) Q DSHOL D
19067	"RTN","PSX RPPL2",170 ,0)
19068	;
19069	"RTN","PSX RPPL2",171 ,0)
19070	S DSHDT=$ $DSHDT(RXI EN,RFL) ; 3/4 of day s supply d ate
19071	"RTN","PSX RPPL2",172 ,0)
19072	S PREVRX= $P(DSHDT,U ,2)
19073	"RTN","PSX RPPL2",173 ,0)
19074	S DSHDT=$ P(DSHDT,U)
19075	"RTN","PSX RPPL2",174 ,0)
19076	I DSHDT>D T S DSHOLD =0 D
19077	"RTN","PSX RPPL2",175 ,0)
19078	. I DSHDT '=$P(PS0,U ,14) D ; Update Sus pense Hold Date and Activity L og
19079	"RTN","PSX RPPL2",176 ,0)
19080	. . ; MRD ;PSX2.07 9 - If a p revious Rx is used i n the 3/4 days' supp ly
19081	"RTN","PSX RPPL2",177 ,0)
19082	. . ; cal culation, capture th at Rx in t he activit y log.
19083	"RTN","PSX RPPL2",178 ,0)
19084	. . S COM M="3/4 of Days Suppl y SUSPENSE HOLD unti l "_$$FMTE ^XLFDT(DSH DT,"2D")
19085	"RTN","PSX RPPL2",179 ,0)
19086	. . I PRE VRX'="" S COMM=COMM_ " (prior R x "_PREVRX _")"
19087	"RTN","PSX RPPL2",180 ,0)
19088	. . S COM M=COMM_"."
19089	"RTN","PSX RPPL2",181 ,0)
19090	. . S DAY SSUP=$$LFD S(RXIEN)
19091	"RTN","PSX RPPL2",182 ,0)
19092	. . D RXA CT^PSOBPSU 2(RXIEN,RF L,COMM,"S" ,+$G(DUZ)) ; Update Activity L og
19093	"RTN","PSX RPPL2",183 ,0)
19094	. . S DR= "10///^S X =DSHDT",DI E="^PS(52. 5,",DA=REC D ^DIE ; File Suspe nse Hold D ate
19095	"RTN","PSX RPPL2",184 ,0)
19096	. . N DA, DIE,DR,PSO X,SFN,INDT ,DEAD,RXRE C,SUB,XOK, OLD
19097	"RTN","PSX RPPL2",185 ,0)
19098	. . S DA= REC,DIE="^ PS(52.5,", DR=".02/// "_DSHDT D ^DIE
19099	"RTN","PSX RPPL2",186 ,0)
19100	. . S SFN =REC,DEAD= 0,INDT=DSH DT D CHANG E^PSOSUCH1 (RXIEN,RFL )
19101	"RTN","PSX RPPL2",187 ,0)
19102	. . Q
19103	"RTN","PSX RPPL2",188 ,0)
19104	. Q
19105	"RTN","PSX RPPL2",189 ,0)
19106	Q DSHOLD
19107	"RTN","PSX RPPL2",190 ,0)
19108	;
19109	"RTN","PSX RPPL2",191 ,0)
19110	DSHDT(RXIE N,RFL) ; e Pharmacy f unction to determine the 3/4 o f the days supply da te
19111	"RTN","PSX RPPL2",192 ,0)
19112	; Input: RXIEN = Pr escription file #52 ien
19113	"RTN","PSX RPPL2",193 ,0)
19114	; RFL = fi ll#
19115	"RTN","PSX RPPL2",194 ,0)
19116	; Returns : DATE val ue of last date of s ervice plu s 3/4 of d ays supply
19117	"RTN","PSX RPPL2",195 ,0)
19118	; PREVRX = Previous R x if PREVR X^PSOREJP2 identifie d one that
19119	"RTN","PSX RPPL2",196 ,0)
19120	; should be used in th e 3/4 days ' supply c alculation .
19121	"RTN","PSX RPPL2",197 ,0)
19122	;
19123	"RTN","PSX RPPL2",198 ,0)
19124	N FILLDT, DAYSSUP,DS H34,PREVRX
19125	"RTN","PSX RPPL2",199 ,0)
19126	I '$D(^PS RX(RXIEN,0 )) Q -1
19127	"RTN","PSX RPPL2",200 ,0)
19128	I $G(RFL) ="" Q -1
19129	"RTN","PSX RPPL2",201 ,0)
19130	;
19131	"RTN","PSX RPPL2",202 ,0)
19132	D PREVRX^ PSOREJP2(R XIEN,RFL,, .FILLDT,.D AYSSUP,.PR EVRX) ; DBIA #59 12
19133	"RTN","PSX RPPL2",203 ,0)
19134	I FILLDT= "" Q -1
19135	"RTN","PSX RPPL2",204 ,0)
19136	;
19137	"RTN","PSX RPPL2",205 ,0)
19138	S DSH34=D AYSSUP*.75 ; 3/4 of Days Suppl y
19139	"RTN","PSX RPPL2",206 ,0)
19140	S:DSH34[" ." DSH34=( DSH34+1)\1
19141	"RTN","PSX RPPL2",207 ,0)
19142	; Return last date of service plus 3/4 of Days Su pply date
19143	"RTN","PSX RPPL2",208 ,0)
19144	; and the previous Rx used in the calcu lation, if any.
19145	"RTN","PSX RPPL2",209 ,0)
19146	Q $$FMADD ^XLFDT(FIL LDT,DSH34) _U_PREVRX
19147	"RTN","PSX RPPL2",210 ,0)
19148	;
19149	"RTN","PSX RPPL2",211 ,0)
19150	; Descrip tion: This function returns th e DAYS SUP PLY for th e Latest F ill
19151	"RTN","PSX RPPL2",212 ,0)
19152	; for a P rescriptio n
19153	"RTN","PSX RPPL2",213 ,0)
19154	; Input: RXIEN = Pr escription file #52 IEN
19155	"RTN","PSX RPPL2",214 ,0)
19156	; Returns : DAYS SUP PLY for th e latest f ill
19157	"RTN","PSX RPPL2",215 ,0)
19158	; -1 if RX IEN is not valid
19159	"RTN","PSX RPPL2",216 ,0)
19160	LFDS(RXIEN ) ;
19161	"RTN","PSX RPPL2",217 ,0)
19162	N RXFIL
19163	"RTN","PSX RPPL2",218 ,0)
19164	Q:'$D(^PS RX(RXIEN)) -1
19165	"RTN","PSX RPPL2",219 ,0)
19166	S RXFIL=$ $LSTRFL^PS OBPSU1(RXI EN)
19167	"RTN","PSX RPPL2",220 ,0)
19168	Q $S(RXFI L=0:$P(^PS RX(RXIEN,0 ),U,8),1:$ P(^PSRX(RX IEN,1,RXFI L,0),U,10) )
19169	"RTN","PSX RPPL2",221 ,0)
19170	;
19171	"RTN","PSX RPPL2",222 ,0)
19172	;
19173	"RTN","PSX RPPL2",223 ,0)
19174	;Descript ion: ePhar macy API t o check fo r host err ors.
19175	"RTN","PSX RPPL2",224 ,0)
19176	;Input: R X = Prescr iption fil e #52 IEN
19177	"RTN","PSX RPPL2",225 ,0)
19178	; RFL = R efill numb er
19179	"RTN","PSX RPPL2",226 ,0)
19180	;Returns: A value o f 0 (zero) will be r eturned wh en reject codes M6, M8,
19181	"RTN","PSX RPPL2",227 ,0)
19182	;NN, and 99 are pre sent OR if on susp h old which means the prescripti on should not
19183	"RTN","PSX RPPL2",228 ,0)
19184	;be sent to CMOP. O therwise, a value of 1(one) wi ll be retu rned.
19185	"RTN","PSX RPPL2",229 ,0)
19186	DUR(RX,RFL ) ;
19187	"RTN","PSX RPPL2",230 ,0)
19188	N REJ,IDX ,TXT,CODE, SHCODE,SHD T,CHDAT1
19189	"RTN","PSX RPPL2",231 ,0)
19190	S IDX=""
19191	"RTN","PSX RPPL2",232 ,0)
19192	I '$D(RFL ) S RFL=$$ LSTRFL^PSO BPSU1(RX)
19193	"RTN","PSX RPPL2",233 ,0)
19194	; check f or a previ ous host r eject:
19195	"RTN","PSX RPPL2",234 ,0)
19196	; 1 - if host reje ct date ex pired allo w to print ; 0 - if n ot expired don't pri nt
19197	"RTN","PSX RPPL2",235 ,0)
19198	; 2 - if not def ined allow to contin ue with ev aluation f or new hos t reject
19199	"RTN","PSX RPPL2",236 ,0)
19200	S CHDAT1= $$CHHEDT(R X,RFL) Q:C HDAT1=1 1 Q:CHDAT1=0 0 ;Other wise conti nue on to check for a new host reject
19201	"RTN","PSX RPPL2",237 ,0)
19202	; If a ho st reject exists and no previo us Susp Ho ld Date or log entry ,
19203	"RTN","PSX RPPL2",238 ,0)
19204	; crea te the log entry and hold rx/f ill.
19205	"RTN","PSX RPPL2",239 ,0)
19206	S HERR=$$ HOSTREJ(RX ,RFL,1)
19207	"RTN","PSX RPPL2",240 ,0)
19208	I HERR,SH DT="" D SH DTLOG(RX,R FL) Q 0
19209	"RTN","PSX RPPL2",241 ,0)
19210	Q:HERR 0
19211	"RTN","PSX RPPL2",242 ,0)
19212	Q 1
19213	"RTN","PSX RPPL2",243 ,0)
19214	;
19215	"RTN","PSX RPPL2",244 ,0)
19216	CHHEDT(RX, RFL) ;
19217	"RTN","PSX RPPL2",245 ,0)
19218	; RX = Pr escription File IEN
19219	"RTN","PSX RPPL2",246 ,0)
19220	; RFL = R efill
19221	"RTN","PSX RPPL2",247 ,0)
19222	;Returns:
19223	"RTN","PSX RPPL2",248 ,0)
19224	; 0 = hos t reject d ate not ex pired, 1 - host reje ct has exp ired, 2 - host rejec t not defi ned
19225	"RTN","PSX RPPL2",249 ,0)
19226	;
19227	"RTN","PSX RPPL2",250 ,0)
19228	S SHDT=$$ SHDT(RX,RF L) ; Get s uspense ho ld date fo r rx/refil l
19229	"RTN","PSX RPPL2",251 ,0)
19230	I SHDT'=" " Q:DT'<SH DT 1 Q 0
19231	"RTN","PSX RPPL2",252 ,0)
19232	Q 2
19233	"RTN","PSX RPPL2",253 ,0)
19234	;
19235	"RTN","PSX RPPL2",254 ,0)
19236	;Descript ion: ePhar macy
19237	"RTN","PSX RPPL2",255 ,0)
19238	;This sub routine ch ecks an RX /FILL for Host Rejec t Errors r eturned
19239	"RTN","PSX RPPL2",256 ,0)
19240	;from pre vious ECME submissio ns. The ho st reject errors che cked are M 6, M8, NN, and 99.
19241	"RTN","PSX RPPL2",257 ,0)
19242	;Note tha t host rej ect errors do not pa ss to the pharmacy r eject work list so it 's necessa ry
19243	"RTN","PSX RPPL2",258 ,0)
19244	;to check ECME for these type errors.
19245	"RTN","PSX RPPL2",259 ,0)
19246	;Input:
19247	"RTN","PSX RPPL2",260 ,0)
19248	; RX = Pr escription File IEN
19249	"RTN","PSX RPPL2",261 ,0)
19250	; RFL = R efill
19251	"RTN","PSX RPPL2",262 ,0)
19252	; ONE = E ither 1 or 0 - Defau lts to 1
19253	"RTN","PSX RPPL2",263 ,0)
19254	; If 1, A t least ON E reject c ode associ ated with the RX/FIL L must
19255	"RTN","PSX RPPL2",264 ,0)
19256	; match either M6 , M8, NN, or 99.
19257	"RTN","PSX RPPL2",265 ,0)
19258	; If 0, A LL reject codes must match eit her M6, M8 , NN, or 9 9
19259	"RTN","PSX RPPL2",266 ,0)
19260	;Return:
19261	"RTN","PSX RPPL2",267 ,0)
19262	; RETV = 1 OR 0
19263	"RTN","PSX RPPL2",268 ,0)
19264	; 1 = hos t reject e xists base d on ONE p arameter
19265	"RTN","PSX RPPL2",269 ,0)
19266	; 0 = no host rejec ts exists based on O NE paramet er
19267	"RTN","PSX RPPL2",270 ,0)
19268	HOSTREJ(RX ,RFL,ONE) ;
19269	"RTN","PSX RPPL2",271 ,0)
19270	N REJ,IDX ,TXT,CODE, HRCODE,HRQ UIT,RETV
19271	"RTN","PSX RPPL2",272 ,0)
19272	S IDX="", (RETV,HRQU IT)=0
19273	"RTN","PSX RPPL2",273 ,0)
19274	I ONE="" S ONE=1
19275	"RTN","PSX RPPL2",274 ,0)
19276	D DUR1^BP SNCPD3(RX, RFL,.REJ) ; Get reje ct list fr om last su bmission
19277	"RTN","PSX RPPL2",275 ,0)
19278	F S IDX= $O(REJ(IDX )) Q:IDX=" " D Q:HR QUIT
19279	"RTN","PSX RPPL2",276 ,0)
19280	. S TXT=$ G(REJ(IDX, "REJ CODE LST"))
19281	"RTN","PSX RPPL2",277 ,0)
19282	. F I=1:1 :$L(TXT,", ") S CODE= $P(TXT,"," ,I) D Q:H RQUIT
19283	"RTN","PSX RPPL2",278 ,0)
19284	. . F HRC ODE="M6"," M8","NN",9 9 D Q:HRQ UIT
19285	"RTN","PSX RPPL2",279 ,0)
19286	. . . I C ODE=HRCODE S RETV=1 I ONE S HR QUIT=1 Q
19287	"RTN","PSX RPPL2",280 ,0)
19288	. . . I C ODE'=HRCOD E,RETV=1 S RETV=0,HR QUIT=1 Q
19289	"RTN","PSX RPPL2",281 ,0)
19290	Q RETV
19291	"RTN","PSX RPPL2",282 ,0)
19292	;
19293	"RTN","PSX RPPL2",283 ,0)
19294	;Descript ion: This subroutine sets the EPHARMACY SUSPENSE H OLD DATE f ield
19295	"RTN","PSX RPPL2",284 ,0)
19296	;for the rx or refi ll to tomo rrow and a dds an ent ry to the SUSPENSE A ctivity Lo g.
19297	"RTN","PSX RPPL2",285 ,0)
19298	;Input: R X = Prescr iption Fil e IEN
19299	"RTN","PSX RPPL2",286 ,0)
19300	; RFL = R efill
19301	"RTN","PSX RPPL2",287 ,0)
19302	SHDTLOG(RX ,RFL) ;
19303	"RTN","PSX RPPL2",288 ,0)
19304	N DA,DIE, DR,COMM,SH DT
19305	"RTN","PSX RPPL2",289 ,0)
19306	I '$D(RFL ) S RFL=$$ LSTRFL^PSO BPSU1(RX)
19307	"RTN","PSX RPPL2",290 ,0)
19308	S SHDT=$$ FMADD^XLFD T(DT,1)
19309	"RTN","PSX RPPL2",291 ,0)
19310	S COMM="S USPENSE HO LD until " _$$FMTE^XL FDT(SHDT," 2D")_" due to host r eject erro r."
19311	"RTN","PSX RPPL2",292 ,0)
19312	I RFL=0 S DA=RX,DIE ="^PSRX(", DR="86///" _SHDT D ^D IE
19313	"RTN","PSX RPPL2",293 ,0)
19314	E S DA=R FL,DA(1)=R X,DIE="^PS RX("_DA(1) _",1,",DR= "86///"_SH DT D ^DIE
19315	"RTN","PSX RPPL2",294 ,0)
19316	D RXACT^P SOBPSU2(RX ,RFL,COMM, "S",+$G(DU Z)) ; Crea te Activit y Log entr y
19317	"RTN","PSX RPPL2",295 ,0)
19318	Q
19319	"RTN","PSX RPPL2",296 ,0)
19320	;
19321	"RTN","PSX RPPL2",297 ,0)
19322	;Descript ion: This function r eturns the EPHARMACY SUSPENSE HOLD DATE field
19323	"RTN","PSX RPPL2",298 ,0)
19324	;for the rx or refi ll
19325	"RTN","PSX RPPL2",299 ,0)
19326	;Input: R X = Prescr iption Fil e IEN
19327	"RTN","PSX RPPL2",300 ,0)
19328	; RFL = R efill
19329	"RTN","PSX RPPL2",301 ,0)
19330	SHDT(RX,RF L) ;
19331	"RTN","PSX RPPL2",302 ,0)
19332	N FILE,IE NS
19333	"RTN","PSX RPPL2",303 ,0)
19334	I '$D(RFL ) S RFL=$$ LSTRFL^PSO BPSU1(RX)
19335	"RTN","PSX RPPL2",304 ,0)
19336	S FILE=$S (RFL=0:52, 1:52.1),IE NS=$S(RFL= 0:RX_",",1 :RFL_","_R X_",")
19337	"RTN","PSX RPPL2",305 ,0)
19338	Q $$GET1^ DIQ(FILE,I ENS,86,"I" )
19339	"RTN","PSX RPPL2",306 ,0)
19340	;
19341	"VER")
19342	8.0^22.2
19343	END
19344	END
		19345
		19346
		19347
		19348
		19349
		19350
		19351
		19352
		19353
		19354
		19355
		19356
		19357