2. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 1/10/2017 8:40:25 PM Eastern Standard 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	IB_2_568_PRCA_PSO_BUNDLE_T1.zip	IB_2_568_PRCA_PSO_BUNDLE_T1.KID	Thu Dec 15 16:47:32 2016 UTC
2	IB_2_568_PRCA_PSO_BUNDLE_T1.zip	IB_2_568_PRCA_PSO_BUNDLE_T1.KID	Wed Jan 11 01:01:10 2017 UTC

2.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	57	27316
Changed	56	112
Inserted	0	0
Removed	0	0

2.3 Comparison options

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

2.4 Active regular expressions

No regular expressions were active.

2.5 Comparison detail

	1	KIDS Distr ibution sa ved on Dec 15, 2016@ 09:43:39
	2	HAPE REVEN UE ENHANCE MENTS
	3	KIDS:I B PRCA PSO HAPE REVE NUE 1.0^PR CA4.5315 ^IB2.056 8^PSO7.0 463^
	4
	5	INSTALL NAME
	6	IB PRCA PS O HAPE REV ENUE 1.0
	7	"BLD",1033 6,0)
	8	IB PRCA PS O HAPE REV ENUE 1.0^^ 1^3161215^ y
	9	"BLD",1033 6,6.3)
	10	1
	11	"BLD",1033 6,10,0)
	12	^9.63^3^3
	13	"BLD",1033 6,10,1,0)
	14	PRCA4.53 15^1
	15	"BLD",1033 6,10,2,0)
	16	IB2.0568 ^1
	17	"BLD",1033 6,10,3,0)
	18	PSO7.046 3^1
	19	"BLD",1033 6,10,"B"," IB2.0568 ",2)
	20
	21	"BLD",1033 6,10,"B"," PRCA4.53 15",1)
	22
	23	"BLD",1033 6,10,"B"," PSO7.046 3",3)
	24
	25	"BLD",1033 6,"KRN",0)
	26	^9.67PA^77 9.2^20
	27	"BLD",1033 6,"KRN",.4 ,0)
	28	.4
	29	"BLD",1033 6,"KRN",.4 01,0)
	30	.401
	31	"BLD",1033 6,"KRN",.4 02,0)
	32	.402
	33	"BLD",1033 6,"KRN",.4 03,0)
	34	.403
	35	"BLD",1033 6,"KRN",.5 ,0)
	36	.5
	37	"BLD",1033 6,"KRN",.8 4,0)
	38	.84
	39	"BLD",1033 6,"KRN",3. 6,0)
	40	3.6
	41	"BLD",1033 6,"KRN",3. 8,0)
	42	3.8
	43	"BLD",1033 6,"KRN",9. 2,0)
	44	9.2
	45	"BLD",1033 6,"KRN",9. 8,0)
	46	9.8
	47	"BLD",1033 6,"KRN",19 ,0)
	48	19
	49	"BLD",1033 6,"KRN",19 .1,0)
	50	19.1
	51	"BLD",1033 6,"KRN",10 1,0)
	52	101
	53	"BLD",1033 6,"KRN",40 9.61,0)
	54	409.61
	55	"BLD",1033 6,"KRN",77 1,0)
	56	771
	57	"BLD",1033 6,"KRN",77 9.2,0)
	58	779.2
	59	"BLD",1033 6,"KRN",87 0,0)
	60	870
	61	"BLD",1033 6,"KRN",89 89.51,0)
	62	8989.51
	63	"BLD",1033 6,"KRN",89 89.52,0)
	64	8989.52
	65	"BLD",1033 6,"KRN",89 94,0)
	66	8994
	67	"BLD",1033 6,"KRN","B ",.4,.4)
	68
	69	"BLD",1033 6,"KRN","B ",.401,.40 1)
	70
	71	"BLD",1033 6,"KRN","B ",.402,.40 2)
	72
	73	"BLD",1033 6,"KRN","B ",.403,.40 3)
	74
	75	"BLD",1033 6,"KRN","B ",.5,.5)
	76
	77	"BLD",1033 6,"KRN","B ",.84,.84)
	78
	79	"BLD",1033 6,"KRN","B ",3.6,3.6)
	80
	81	"BLD",1033 6,"KRN","B ",3.8,3.8)
	82
	83	"BLD",1033 6,"KRN","B ",9.2,9.2)
	84
	85	"BLD",1033 6,"KRN","B ",9.8,9.8)
	86
	87	"BLD",1033 6,"KRN","B ",19,19)
	88
	89	"BLD",1033 6,"KRN","B ",19.1,19. 1)
	90
	91	"BLD",1033 6,"KRN","B ",101,101)
	92
	93	"BLD",1033 6,"KRN","B ",409.61,4 09.61)
	94
	95	"BLD",1033 6,"KRN","B ",771,771)
	96
	97	"BLD",1033 6,"KRN","B ",779.2,77 9.2)
	98
	99	"BLD",1033 6,"KRN","B ",870,870)
	100
	101	"BLD",1033 6,"KRN","B ",8989.51, 8989.51)
	102
	103	"BLD",1033 6,"KRN","B ",8989.52, 8989.52)
	104
	105	"BLD",1033 6,"KRN","B ",8994,899 4)
	106
	107	"MBREQ")
	108	0
	109	"QUES","XP F1",0)
	110	Y
	111	"QUES","XP F1","??")
	112	^D REP^XPD H
	113	"QUES","XP F1","A")
	114	Shall I wr ite over y our \|FLAG\| File
	115	"QUES","XP F1","B")
	116	YES
	117	"QUES","XP F1","M")
	118	D XPF1^XPD IQ
	119	"QUES","XP F2",0)
	120	Y
	121	"QUES","XP F2","??")
	122	^D DTA^XPD H
	123	"QUES","XP F2","A")
	124	Want my da ta \|FLAG\| yours
	125	"QUES","XP F2","B")
	126	YES
	127	"QUES","XP F2","M")
	128	D XPF2^XPD IQ
	129	"QUES","XP I1",0)
	130	YO
	131	"QUES","XP I1","??")
	132	^D INHIBIT ^XPDH
	133	"QUES","XP I1","A")
	134	Want KIDS to INHIBIT LOGONs du ring the i nstall
	135	"QUES","XP I1","B")
	136	NO
	137	"QUES","XP I1","M")
	138	D XPI1^XPD IQ
	139	"QUES","XP M1",0)
	140	PO^VA(200, :EM
	141	"QUES","XP M1","??")
	142	^D MG^XPDH
	143	"QUES","XP M1","A")
	144	Enter the Coordinato r for Mail Group '\|F LAG\|'
	145	"QUES","XP M1","B")
	146
	147	"QUES","XP M1","M")
	148	D XPM1^XPD IQ
	149	"QUES","XP O1",0)
	150	Y
	151	"QUES","XP O1","??")
	152	^D MENU^XP DH
	153	"QUES","XP O1","A")
	154	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	155	"QUES","XP O1","B")
	156	NO
	157	"QUES","XP O1","M")
	158	D XPO1^XPD IQ
	159	"QUES","XP Z1",0)
	160	Y
	161	"QUES","XP Z1","??")
	162	^D OPT^XPD H
	163	"QUES","XP Z1","A")
	164	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	165	"QUES","XP Z1","B")
	166	NO
	167	"QUES","XP Z1","M")
	168	D XPZ1^XPD IQ
	169	"QUES","XP Z2",0)
	170	Y
	171	"QUES","XP Z2","??")
	172	^D RTN^XPD H
	173	"QUES","XP Z2","A")
	174	Want to MO VE routine s to other CPUs
	175	"QUES","XP Z2","B")
	176	NO
	177	"QUES","XP Z2","M")
	178	D XPZ2^XPD IQ
	179	"VER")
	180	8.0^22.0
	181	INSTALL NAME
	182	PRCA4.53 15
	183	"BLD",1019 1,0)
	184	PRCA4.53 15^ACCOUNT S RECEIVAB LE^0^31612 15^y
	185	"BLD",1019 1,1,0)
	186	^^367^367^ 3161212^
	187	"BLD",1019 1,1,1,0)
	188
	189	"BLD",1019 1,1,2,0)
	190	IMPORTANT INSTALLATI ON NOTE:
	191	"BLD",1019 1,1,3,0)
	192	---------- ---------- --------
	193	"BLD",1019 1,1,4,0)
	194	This patch is part o f a multi- package bu ild. There are three patches
	195	"BLD",1019 1,1,5,0)
	196	associated with the FY16 HAPE Revenue En hancement project - IB2.0568 ,
	197	"BLD",1019 1,1,6,0)
	198	PRCA4.53 15 and PSO 7.0463. All three patches ar e to be in stalled
	199	"BLD",1019 1,1,7,0)
	200	together a s a bundle , IB_2_568 _PRCA_PSO_ BUNDLE_T1. KID
	201	"BLD",1019 1,1,8,0)
	202
	203	"BLD",1019 1,1,9,0)
	204
	205	"BLD",1019 1,1,10,0)
	206	Descriptio n
	207	"BLD",1019 1,1,11,0)
	208	---------- -
	209	"BLD",1019 1,1,12,0)
	210	The Chief Business O ffice (CBO ) is reque sting syst em enhance ments to
	211	"BLD",1019 1,1,13,0)
	212	The Vetera ns Health Informatio n Systems and Techno logy Archi tecture
	213	"BLD",1019 1,1,14,0)
	214	(VistA) In tegrated B illing (IB ), Account s Receivab le (AR), a nd
	215	"BLD",1019 1,1,15,0)
	216	Outpatient Pharmacy (PSO) soft ware modul es.
	217	"BLD",1019 1,1,16,0)
	218
	219	"BLD",1019 1,1,17,0)
	220	The missio n of the D epartment of Veteran s Affairs (VA), Offi ce of
	221	"BLD",1019 1,1,18,0)
	222	Informatio n & Techno logy (OI&T ), is to p rovide ben efits and services
	223	"BLD",1019 1,1,19,0)
	224	to veteran s of the U nited Stat es Armed F orces. In meeting th ese goals,
	225	"BLD",1019 1,1,20,0)
	226	OIT strive s to provi de high qu ality, eff ective, an d efficien t
	227	"BLD",1019 1,1,21,0)
	228	Informatio n Technolo gy (IT) se rvices to those resp onsible fo r
	229	"BLD",1019 1,1,22,0)
	230	providing care to th e veterans at the po int-of-car e, as well as
	231	"BLD",1019 1,1,23,0)
	232	throughout all the p oints of t he veteran s' health care. The VA depends
	233	"BLD",1019 1,1,24,0)
	234	on Informa tion Manag ement/Info rmationTec hnology (I M/IT) syst ems to mee t
	235	"BLD",1019 1,1,25,0)
	236	mission go als.
	237	"BLD",1019 1,1,26,0)
	238
	239	"BLD",1019 1,1,27,0)
	240	The overal l FY16 HAP E Revenue Enhancemen t project has been f urther
	241	"BLD",1019 1,1,28,0)
	242	divided in to three s ub-project s:
	243	"BLD",1019 1,1,29,0)
	244
	245	"BLD",1019 1,1,30,0)
	246	NSR #20150 506
	247	"BLD",1019 1,1,31,0)
	248	The Revenu e Eligibil ity Enhanc ements Pro ject effor t for the Chief
	249	"BLD",1019 1,1,32,0)
	250	Business O ffice (CBO ), bundles several N SRs with s imilar bus iness
	251	"BLD",1019 1,1,33,0)
	252	needs into a single requiremen ts documen t. Succes sfully add ressing
	253	"BLD",1019 1,1,34,0)
	254	the requir ements con tained wit hin this d ocument wi ll enable the
	255	"BLD",1019 1,1,35,0)
	256	Department of Vetera ns Affairs (VA) to a ppropriate ly bill ce rtain
	257	"BLD",1019 1,1,36,0)
	258	subsets of billable events by correcting , automati ng, or enh ancing
	259	"BLD",1019 1,1,37,0)
	260	current Ve terans Hea lth Inform ation Syst ems and Te chnology A rchitectur e
	261	"BLD",1019 1,1,38,0)
	262	(VistA) sy stems.
	263	"BLD",1019 1,1,39,0)
	264
	265	"BLD",1019 1,1,40,0)
	266	NSR #20150 507
	267	"BLD",1019 1,1,41,0)
	268	The Revenu e Operatio ns Enhance ments Proj ect combin es servera l NSRs,
	269	"BLD",1019 1,1,42,0)
	270	as well. T his effort enables t he Departm ent of Vet erans Affa irs (VA)
	271	"BLD",1019 1,1,43,0)
	272	to improve revenue o peration f unctionali ty related to repaym ent plans,
	273	"BLD",1019 1,1,44,0)
	274	late charg e capture, bill susp ension rea sons, the billing of
	275	"BLD",1019 1,1,45,0)
	276	deactivate d provider s, and the display o f appeal r ights and
	277	"BLD",1019 1,1,46,0)
	278	responsibi lities on the Vetera ns Benefic iary trave l Bill of Collection s
	279	"BLD",1019 1,1,47,0)
	280	form. Imp lementatio n of the p roposed en hancements will make a
	281	"BLD",1019 1,1,48,0)
	282	significan t positive impact on stakehold ers and ta rget users .
	283	"BLD",1019 1,1,49,0)
	284
	285	"BLD",1019 1,1,50,0)
	286	NSR #20150 505
	287	"BLD",1019 1,1,51,0)
	288	The Revenu e Reportin g Enhancem ents Proje ct will en able the V A to
	289	"BLD",1019 1,1,52,0)
	290	improve tr acking and reporting of revenu e, and wil l support revenue
	291	"BLD",1019 1,1,53,0)
	292	reporting business r ules and g uidelines.
	293	"BLD",1019 1,1,54,0)
	294
	295	"BLD",1019 1,1,55,0)
	296
	297	"BLD",1019 1,1,56,0)
	298	PRCA4.53 15 patch e nhancement s, pertine nt to the above NSRs , include:
	299	"BLD",1019 1,1,57,0)
	300
	301	"BLD",1019 1,1,58,0)
	302	1.) By mea ns of the new Enter / Edit Rep ayment Pla n option, the user
	303	"BLD",1019 1,1,59,0)
	304	will creat e the Repa yment Plan by debtor . Note: Th e 'Enter / Edit
	305	"BLD",1019 1,1,60,0)
	306	Repayment Plan' menu option na me will re place the 'Set up Re payment
	307	"BLD",1019 1,1,61,0)
	308	Plan' menu option na me.
	309	"BLD",1019 1,1,62,0)
	310
	311	"BLD",1019 1,1,63,0)
	312	2.) On the Enter / E dit Repaym ent Plan o ption, if the AR Deb tor has
	313	"BLD",1019 1,1,64,0)
	314	Active bil ls, the sy stem will now displa y a select able list of bills
	315	"BLD",1019 1,1,65,0)
	316	for the de btor.
	317	"BLD",1019 1,1,66,0)
	318
	319	"BLD",1019 1,1,67,0)
	320	3.) On the Enter / E dit Repaym ent Plan o ption, whe n displayi ng a list
	321	"BLD",1019 1,1,68,0)
	322	of Active bills for the Debtor , the syst em will di splay step s to the
	323	"BLD",1019 1,1,69,0)
	324	user to se t up the R epayment P lan.
	325	"BLD",1019 1,1,70,0)
	326
	327	"BLD",1019 1,1,71,0)
	328	4.) On the Enter /Ed it Repayme nt Plan op tion, once a Repayme nt Plan
	329	"BLD",1019 1,1,72,0)
	330	has been c reated or modified, the summar y of the R epayment P lan is
	331	"BLD",1019 1,1,73,0)
	332	displayed.
	333	"BLD",1019 1,1,74,0)
	334
	335	"BLD",1019 1,1,75,0)
	336	5.) On the Enter / E dit Repaym ent Plan o ption, the system ch ecks to
	337	"BLD",1019 1,1,76,0)
	338	see if a R epayment P lan has al ready been created f or the Vet eran.
	339	"BLD",1019 1,1,77,0)
	340
	341	"BLD",1019 1,1,78,0)
	342	6.) On the Enter / E dit Repaym ent Plan o ption, whe n choosing to Edit
	343	"BLD",1019 1,1,79,0)
	344	the Repaym ent Plan, all Active bills for the debto r will be displayed
	345	"BLD",1019 1,1,80,0)
	346	allowing t he user to add new A ctive bill s to the R epayment P lan as wel l
	347	"BLD",1019 1,1,81,0)
	348	as change the due da te of firs t payment and/or the repayment amount du e
	349	"BLD",1019 1,1,82,0)
	350	on the Rep ayment Pla n.
	351	"BLD",1019 1,1,83,0)
	352
	353	"BLD",1019 1,1,84,0)
	354	7.) On the Enter / E dit Repaym ent Plan o ption, if the Debtor does not
	355	"BLD",1019 1,1,85,0)
	356	have new A ctive bill s that can be added to the Rep ayment Pla n, the use r
	357	"BLD",1019 1,1,86,0)
	358	will proce ed to iden tify the r epayment a mount due and/or rep ayment
	359	"BLD",1019 1,1,87,0)
	360	amount due date on t he Repayme nt Plan.
	361	"BLD",1019 1,1,88,0)
	362
	363	"BLD",1019 1,1,89,0)
	364	8.) On the Enter / E dit Repaym ent Plan o ption, a d esignated identifier
	365	"BLD",1019 1,1,90,0)
	366	will signi fy when an Active bi ll is part of a Repa yment Plan .
	367	"BLD",1019 1,1,91,0)
	368
	369	"BLD",1019 1,1,92,0)
	370	9.) On the Enter / E dit Repaym ent Plan o ption, the system wi ll display
	371	"BLD",1019 1,1,93,0)
	372	previously made paym ents to th e Repaymen t Plan.
	373	"BLD",1019 1,1,94,0)
	374
	375	"BLD",1019 1,1,95,0)
	376	10.) On th e Enter / Edit Repay ment Plan option, th e User has the optio n
	377	"BLD",1019 1,1,96,0)
	378	to enter D ebtor Comm ents durin g the setu p process.
	379	"BLD",1019 1,1,97,0)
	380
	381	"BLD",1019 1,1,98,0)
	382	11.) The A R Clerk wi ll be able to select Suspended Type from the menu
	383	"BLD",1019 1,1,99,0)
	384	to display in the St atus Listi ng For Bil ls [PRCAL STATUS LIS T] report.
	385	"BLD",1019 1,1,100,0)
	386
	387	"BLD",1019 1,1,101,0)
	388	12.) Statu s Listing For Bills [PRCAL STA TUS LIST] report sha ll be
	389	"BLD",1019 1,1,102,0)
	390	modified t o incorpor ate reason for suspe nsion.
	391	"BLD",1019 1,1,103,0)
	392
	393	"BLD",1019 1,1,104,0)
	394	13.) Provi de the abi lity to lo ck the opt ion to upd ate late p ayment
	395	"BLD",1019 1,1,105,0)
	396	charges (I nterest/Ad min/Penalt y Rates [P RCAF U ADM IN.RATE]) with a new
	397	"BLD",1019 1,1,106,0)
	398	security k ey.
	399	"BLD",1019 1,1,107,0)
	400
	401	"BLD",1019 1,1,108,0)
	402	14.) The s ystem will allow the user to i dentify if the Bill of
	403	"BLD",1019 1,1,109,0)
	404	Collection s letter a pplies to Veterans B eneficiary Travel (F orm 1114).
	405	"BLD",1019 1,1,110,0)
	406
	407	"BLD",1019 1,1,111,0)
	408	15.) The s ystem will print the Notice of Rights an d Responsi bilities
	409	"BLD",1019 1,1,112,0)
	410	when the B ill of Col lections p ertains to Veterans Beneficiar y Travel.
	411	"BLD",1019 1,1,113,0)
	412
	413	"BLD",1019 1,1,114,0)
	414	16.) VistA AR Softwa re Package shall dis continue g eneration of the
	415	"BLD",1019 1,1,115,0)
	416	Mailman me ssage/bull etin, "ARD C Detail R eport for MON/ YYYY" , without
	417	"BLD",1019 1,1,116,0)
	418	interrupti ng any oth er transfe r data wit hin ARDC.
	419	"BLD",1019 1,1,117,0)
	420
	421	"BLD",1019 1,1,118,0)
	422	17.) The V istA AR So ftware Pac kage shall allow the generatio n of a
	423	"BLD",1019 1,1,119,0)
	424	report of bills cont aining the same info rmation as the disco ntinued
	425	"BLD",1019 1,1,120,0)
	426	"ARDC Deta il Report for MON/YY YY" with t he followi ng excepti ons/
	427	"BLD",1019 1,1,121,0)
	428	additions:
	429	"BLD",1019 1,1,122,0)
	430	Th e report s hall inclu de current status bi lls (New B ill, Activ e,
	431	"BLD",1019 1,1,123,0)
	432	Re turned for Amendment , Amended Bill, Open , and Susp ended bill s)
	433	"BLD",1019 1,1,124,0)
	434	on ly;
	435	"BLD",1019 1,1,125,0)
	436
	437	"BLD",1019 1,1,126,0)
	438	Th e report s hall inclu de a colum n for the Fund numbe r associat ed
	439	"BLD",1019 1,1,127,0)
	440	wi th each li ne item on the repor t; and
	441	"BLD",1019 1,1,128,0)
	442
	443	"BLD",1019 1,1,129,0)
	444	Th e report s hall inclu de a colum n for the RSC associ ated with
	445	"BLD",1019 1,1,130,0)
	446	ea ch line it em on the report.
	447	"BLD",1019 1,1,131,0)
	448
	449	"BLD",1019 1,1,132,0)
	450	18.) Curre ntly, when non-healt hcare debt of $25 or greater i s in a
	451	"BLD",1019 1,1,133,0)
	452	delinquent status fo r 180 days , VistA tr ansmits th is debt to TOP
	453	"BLD",1019 1,1,134,0)
	454	(via AITC and DMC) f or initiat ion of the standard collection process.
	455	"BLD",1019 1,1,135,0)
	456	To maintai n complian ce with Th e DATA Act of 2014, the 180-da y date
	457	"BLD",1019 1,1,136,0)
	458	parameter shall be c hanged to 120 days.
	459	"BLD",1019 1,1,137,0)
	460
	461	"BLD",1019 1,1,138,0)
	462	19.) A ne w audit tr ail is nee ded for de tailing ev ents or tr ansactions
	463	"BLD",1019 1,1,139,0)
	464	that have occurred o n healthca re debts r eferred fo r debt col lection, t o
	465	"BLD",1019 1,1,140,0)
	466	effectivel y support Veterans a nd reconci le account s.
	467	"BLD",1019 1,1,141,0)
	468
	469	"BLD",1019 1,1,142,0)
	470	20.) Vist A shall pr ovide enha nced repor ting capab ility, usa bility
	471	"BLD",1019 1,1,143,0)
	472	features, and additi onal data elements f or managin g healthca re debts
	473	"BLD",1019 1,1,144,0)
	474	referred f or debt co llection t o improve VHA's abil ity to pro vide suppo rt
	475	"BLD",1019 1,1,145,0)
	476	to Veteran s and mana ge account s.
	477	"BLD",1019 1,1,146,0)
	478
	479	"BLD",1019 1,1,147,0)
	480	21.) Crea te report to track s top/reacti vate debts . VistA sh all provid e
	481	"BLD",1019 1,1,148,0)
	482	a Stop/Rea ctivate re port to id entify hea lthcare de bts that a re placed
	483	"BLD",1019 1,1,149,0)
	484	in the cor responding status.
	485	"BLD",1019 1,1,150,0)
	486
	487	"BLD",1019 1,1,151,0)
	488	22.) Impr ove automa tion in ma nagement o f debt col lection. V istA shall
	489	"BLD",1019 1,1,152,0)
	490	utilize ex isting fun ctionality , such as List Manag er, and ot her
	491	"BLD",1019 1,1,153,0)
	492	automation capabilit ies to imp rove debt collection managemen t"
	493	"BLD",1019 1,1,154,0)
	494
	495	"BLD",1019 1,1,155,0)
	496	23.) The existing M edication Co-Pay Exe mption Rep ort [PRCAX CO-PAY
	497	"BLD",1019 1,1,156,0)
	498	EXEMPTION REPORT] sh all be mod ified with the follo wing field changes:
	499	"BLD",1019 1,1,157,0)
	500	Ch ange PT ID from full Social Se curity Num ber (SSN) to LastN +
	501	"BLD",1019 1,1,158,0)
	502	4SSN
	503	"BLD",1019 1,1,159,0)
	504	Ad d Rx#
	505	"BLD",1019 1,1,160,0)
	506	Ad d Drug Nam e (first 1 0 to 12 ch aracters)
	507	"BLD",1019 1,1,161,0)
	508	Ad d Fill/Ref ill Date
	509	"BLD",1019 1,1,162,0)
	510	Ad d Effectiv e Date of Exemption
	511	"BLD",1019 1,1,163,0)
	512
	513	"BLD",1019 1,1,164,0)
	514	24.) A ne w Third Pa rty Accoun ts Receiva ble catego ry called
	515	"BLD",1019 1,1,165,0)
	516	'EMERGENCY /HUMANITAR IAN REIMB. ' shall be created i n Accounts Receivabl es
	517	"BLD",1019 1,1,166,0)
	518	with the i nsurer as the respon sible part y.
	519	"BLD",1019 1,1,167,0)
	520
	521	"BLD",1019 1,1,168,0)
	522	25.) A new Third Par ty Account s Receivab le categor y called ' INELIGIBLE
	523	"BLD",1019 1,1,169,0)
	524	HOSP. REIM B' shall b e created in Account s Receivab les with t he insurer
	525	"BLD",1019 1,1,170,0)
	526	as the res ponsible p arty.
	527	"BLD",1019 1,1,171,0)
	528
	529	"BLD",1019 1,1,172,0)
	530	26.) A one -character "Type" fi eld shall be added t o the Clai ms Matchin g
	531	"BLD",1019 1,1,173,0)
	532	Report tha t will ind icate the third-part y claim ca re-type (" I" for
	533	"BLD",1019 1,1,174,0)
	534	Inpatient, "O" for O utpatient, "P" for P rosthetics , and "R" for
	535	"BLD",1019 1,1,175,0)
	536	Prescripti on
	537	"BLD",1019 1,1,176,0)
	538	[Rx]) on t he report of third-p arty bills .
	539	"BLD",1019 1,1,177,0)
	540
	541	"BLD",1019 1,1,178,0)
	542	27.) When a user gen erates a C laims Matc hing Repor t for a pa tient, all
	543	"BLD",1019 1,1,179,0)
	544	records fo r that pat ient are c urrently p roduced on the repor t. At
	545	"BLD",1019 1,1,180,0)
	546	times, use rs need to generate informatio n regardin g only cer tain types
	547	"BLD",1019 1,1,181,0)
	548	of care fo r a patien t. The sy stem shall allow the user to c hoose
	549	"BLD",1019 1,1,182,0)
	550	between pr oducing a Claims Mat ching Repo rt contain ing (1) al l records
	551	"BLD",1019 1,1,183,0)
	552	for a pati ent, or (2 ) only rec ords of a certain ca re type (" I" for
	553	"BLD",1019 1,1,184,0)
	554	Inpatient, "O" for O utpatient, "P" for P rosthetics , or "R" f or
	555	"BLD",1019 1,1,185,0)
	556	Prescripti on [Rx]).
	557	"BLD",1019 1,1,186,0)
	558
	559	"BLD",1019 1,1,187,0)
	560	28.) The C laims Matc hing Repor t, when ex ported, sh all be in a line
	561	"BLD",1019 1,1,188,0)
	562	format so that infor mation on the report may be ea sily expor ted to
	563	"BLD",1019 1,1,189,0)
	564	Microsoft Excel.
	565	"BLD",1019 1,1,190,0)
	566
	567	"BLD",1019 1,1,191,0)
	568
	569	"BLD",1019 1,1,192,0)
	570
	571	"BLD",1019 1,1,193,0)
	572	Concurrent Developme nt / Depen dencies:
	573	"BLD",1019 1,1,194,0)
	574	---------- ---------- ---------- --------
	575	"BLD",1019 1,1,195,0)
	576	N/A
	577	"BLD",1019 1,1,196,0)
	578
	579	"BLD",1019 1,1,197,0)
	580
	581	"BLD",1019 1,1,198,0)
	582	Patch Comp onents:
	583	"BLD",1019 1,1,199,0)
	584	---------- -------
	585	"BLD",1019 1,1,200,0)
	586
	587	"BLD",1019 1,1,201,0)
	588	Files & Fi elds Assoc iated:
	589	"BLD",1019 1,1,202,0)
	590
	591	"BLD",1019 1,1,203,0)
	592	File Name (Number) Field Na me (Number ) New/ Modified/D eleted
	593	"BLD",1019 1,1,204,0)
	594	---------- -------- -------- ---------- - ---- ---------- ------
	595	"BLD",1019 1,1,205,0)
	596	N/A
	597	"BLD",1019 1,1,206,0)
	598
	599	"BLD",1019 1,1,207,0)
	600	Options As sociated:
	601	"BLD",1019 1,1,208,0)
	602
	603	"BLD",1019 1,1,209,0)
	604	Option Nam e Type New/ Modified/D eleted
	605	"BLD",1019 1,1,210,0)
	606	---------- - ---- ---- ---------- ------
	607	"BLD",1019 1,1,211,0)
	608	PRCA ARDC REPORT ROUTINE NEW
	609	"BLD",1019 1,1,212,0)
	610
	611	"BLD",1019 1,1,213,0)
	612	Protocols Associated :
	613	"BLD",1019 1,1,214,0)
	614
	615	"BLD",1019 1,1,215,0)
	616	Protocol N ame New /Modified/ Deleted
	617	"BLD",1019 1,1,216,0)
	618	---------- --- --- ---------- -------
	619	"BLD",1019 1,1,217,0)
	620	N/A
	621	"BLD",1019 1,1,218,0)
	622
	623	"BLD",1019 1,1,219,0)
	624	Templates Associated :
	625	"BLD",1019 1,1,220,0)
	626
	627	"BLD",1019 1,1,221,0)
	628	Template N ame T ype File Name (Num ber) New/Mod/De l
	629	"BLD",1019 1,1,222,0)
	630	---------- --- - --- ---- ---------- ---- ---------- -
	631	"BLD",1019 1,1,223,0)
	632	N/A
	633	"BLD",1019 1,1,224,0)
	634
	635	"BLD",1019 1,1,225,0)
	636	New Servic e Requests (NSRs):
	637	"BLD",1019 1,1,226,0)
	638	---------- ---------- --------
	639	"BLD",1019 1,1,227,0)
	640	20150505 - Revenue R eporting E nhancement s
	641	"BLD",1019 1,1,228,0)
	642	20150506 - Revenue E ligibility Enhanceme nts
	643	"BLD",1019 1,1,229,0)
	644	20150507 - Revenue O perations Enhancemen ts
	645	"BLD",1019 1,1,230,0)
	646
	647	"BLD",1019 1,1,231,0)
	648
	649	"BLD",1019 1,1,232,0)
	650	Patient Sa fety Issue s (PSIs):
	651	"BLD",1019 1,1,233,0)
	652	---------- ---------- ----------
	653	"BLD",1019 1,1,234,0)
	654	N/A
	655	"BLD",1019 1,1,235,0)
	656
	657	"BLD",1019 1,1,236,0)
	658
	659	"BLD",1019 1,1,237,0)
	660	Remedy Tic ket(s) & O verviews:
	661	"BLD",1019 1,1,238,0)
	662	---------- ---------- ---------
	663	"BLD",1019 1,1,239,0)
	664	N/A
	665	"BLD",1019 1,1,240,0)
	666
	667	"BLD",1019 1,1,241,0)
	668	Test Sites :
	669	"BLD",1019 1,1,242,0)
	670	----------
	671	"BLD",1019 1,1,243,0)
	672	Durham VAM C
	673	"BLD",1019 1,1,244,0)
	674
	675	"BLD",1019 1,1,245,0)
	676
	677	"BLD",1019 1,1,246,0)
	678	Software a nd Documen tation Ret rieval Ins tructions:
	679	"BLD",1019 1,1,247,0)
	680	---------- ---------- ---------- ---------- ---------- --
	681	"BLD",1019 1,1,248,0)
	682	Patches fo r this ins tallation are combin ed in host file
	683	"BLD",1019 1,1,249,0)
	684	IB_2_568_P RCA_PSO_BU NDLE_T1.KI D
	685	"BLD",1019 1,1,250,0)
	686
	687	"BLD",1019 1,1,251,0)
	688	Installati on of this host file should be coordinat ed among t he package s
	689	"BLD",1019 1,1,252,0)
	690	affected s ince only one instal lation is necessary.
	691	"BLD",1019 1,1,253,0)
	692
	693	"BLD",1019 1,1,254,0)
	694	The patche s are:
	695	"BLD",1019 1,1,255,0)
	696
	697	"BLD",1019 1,1,256,0)
	698	IB2. 0568
	699	"BLD",1019 1,1,257,0)
	700	PRCA* 4.5*315
	701	"BLD",1019 1,1,258,0)
	702	PSO7 .0463
	703	"BLD",1019 1,1,259,0)
	704
	705	"BLD",1019 1,1,260,0)
	706
	707	"BLD",1019 1,1,261,0)
	708	Sites may retrieve t he KIDS bu ild in one of the fo llowing wa ys:
	709	"BLD",1019 1,1,262,0)
	710
	711	"BLD",1019 1,1,263,0)
	712	(1) The pr eferred me thod is to FTP the f iles from
	713	"BLD",1019 1,1,264,0)
	714	download.D NS .D NS
	715	"BLD",1019 1,1,265,0)
	716	which will transmit the files from the f irst avail able FTP s erver.
	717	"BLD",1019 1,1,266,0)
	718
	719	"BLD",1019 1,1,267,0)
	720	(2) Sites may also e lect to re trieve the patch dir ectly from a specifi c
	721	"BLD",1019 1,1,268,0)
	722	server as follows:
	723	"BLD",1019 1,1,269,0)
	724
	725	"BLD",1019 1,1,270,0)
	726	OIFO FTP ADDRE SS DIRECTORY
	727	"BLD",1019 1,1,271,0)
	728	-------- ------ --------- ---------- ----- ---------- --------
	729	"BLD",1019 1,1,272,0)
	730	Albany DNS . URL anonymous. software
	731	"BLD",1019 1,1,273,0)
	732	Hines DNS . DNS . URL anonymous. software
	733	"BLD",1019 1,1,274,0)
	734	Salt Lake City DNS . URL anonymous. software
	735	"BLD",1019 1,1,275,0)
	736
	737	"BLD",1019 1,1,276,0)
	738
	739	"BLD",1019 1,1,277,0)
	740	Sites may retrieve d ocumentati on directl y using Se cure File Transfer
	741	"BLD",1019 1,1,278,0)
	742	Protocol ( SFTP) from the ANONY MOUS.SOFTW ARE direct ory at the following
	743	"BLD",1019 1,1,279,0)
	744	OI Field O ffices:
	745	"BLD",1019 1,1,280,0)
	746
	747	"BLD",1019 1,1,281,0)
	748	Albany: DNS.URL
	749	"BLD",1019 1,1,282,0)
	750	Hines: DNS .U RL
	751	"BLD",1019 1,1,283,0)
	752	Salt Lake City: DNS . URL
	753	"BLD",1019 1,1,284,0)
	754
	755	"BLD",1019 1,1,285,0)
	756	Documentat ion can al so be foun d on the V A Software Documenta tion
	757	"BLD",1019 1,1,286,0)
	758	Library at :
	759	"BLD",1019 1,1,287,0)
	760	http:// URL /
	761	"BLD",1019 1,1,288,0)
	762
	763	"BLD",1019 1,1,289,0)
	764	Title File Na me FTP Mod e
	765	"BLD",1019 1,1,290,0)
	766	---------- ---------- ---------- ---------- ---------- ---------- ---------- -
	767	"BLD",1019 1,1,291,0)
	768	Accounts R eceivable Technical Manual/Sec urity Guid e
	769	"BLD",1019 1,1,292,0)
	770	prca_4_ 5_tm+r0515 .doc Binar y
	771	"BLD",1019 1,1,293,0)
	772	Accounts R eceivable Deployment , Installa tion,
	773	"BLD",1019 1,1,294,0)
	774	Back- Out, and R ollback Gu ide
	775	"BLD",1019 1,1,295,0)
	776	FY16Re venueARVIP _Deploymen t_Installa tion_Guide .doc Binar y
	777	"BLD",1019 1,1,296,0)
	778
	779	"BLD",1019 1,1,297,0)
	780
	781	"BLD",1019 1,1,298,0)
	782
	783	"BLD",1019 1,1,299,0)
	784	Patch Inst allation:
	785	"BLD",1019 1,1,300,0)
	786
	787	"BLD",1019 1,1,301,0)
	788	Pre/Post I nstallatio n Overview :
	789	"BLD",1019 1,1,302,0)
	790	---------- ---------- ---------- -
	791	"BLD",1019 1,1,303,0)
	792	The post i nstallatio n routine, PRCA315P, is not au tomaticall y deleted
	793	"BLD",1019 1,1,304,0)
	794	as part of the insta llation pr ocess. You may delet e it after
	795	"BLD",1019 1,1,305,0)
	796	installati on if you desire.
	797	"BLD",1019 1,1,306,0)
	798
	799	"BLD",1019 1,1,307,0)
	800	Pre-Instal lation Ins tructions:
	801	"BLD",1019 1,1,308,0)
	802	---------- ---------- ----------
	803	"BLD",1019 1,1,309,0)
	804	N/A
	805	"BLD",1019 1,1,310,0)
	806
	807	"BLD",1019 1,1,311,0)
	808	Installati on Instruc tions:
	809	"BLD",1019 1,1,312,0)
	810	---------- ---------- ------
	811	"BLD",1019 1,1,313,0)
	812	This proce ss will in stall new and update d routines and other
	813	"BLD",1019 1,1,314,0)
	814	components listed ab ove. There is a post -install r outine tha t will add
	815	"BLD",1019 1,1,315,0)
	816	entries to a number of files.
	817	"BLD",1019 1,1,316,0)
	818
	819	"BLD",1019 1,1,317,0)
	820	The patch will be re leased in conjunctio n with an Integrated Billing
	821	"BLD",1019 1,1,318,0)
	822	patch, IB* 4.5568, a nd an Outp atient Pha rmacy patc h, PSO7.0 *463.
	823	"BLD",1019 1,1,319,0)
	824
	825	"BLD",1019 1,1,320,0)
	826	****** ****** ** NOT E **** ****** ****
	827	"BLD",1019 1,1,321,0)
	828	IF A USE R IS ON TH E SYSTEM A ND USING T HESE PROGR AMS
	829	"BLD",1019 1,1,322,0)
	830	AN EDITE D ERROR WI LL OCCUR.
	831	"BLD",1019 1,1,323,0)
	832	The patc h should b e installe d when NO Outpatient
	833	"BLD",1019 1,1,324,0)
	834	Pharmacy users are on the sy stem.
	835	"BLD",1019 1,1,325,0)
	836	****** ****** ****** ****** ****** ****
	837	"BLD",1019 1,1,326,0)
	838
	839	"BLD",1019 1,1,327,0)
	840	Installat ion will t ake less t han 1 minu te.
	841	"BLD",1019 1,1,328,0)
	842
	843	"BLD",1019 1,1,329,0)
	844	Suggested time to i nstall: no n-peak req uirement h ours.
	845	"BLD",1019 1,1,330,0)
	846
	847	"BLD",1019 1,1,331,0)
	848
	849	"BLD",1019 1,1,332,0)
	850	1. Obtai n the file IB_2_568_ PRCA_PSO_B UNDLE_T1.K ID
	851	"BLD",1019 1,1,333,0)
	852
	853	"BLD",1019 1,1,334,0)
	854	2. From the Kernel Installat ion & Dist ribution S ystem menu , select
	855	"BLD",1019 1,1,335,0)
	856	the I nstallatio n menu.
	857	"BLD",1019 1,1,336,0)
	858
	859	"BLD",1019 1,1,337,0)
	860	3. Use L oad a Dist ribution u sing IB_2_ 568_PRCA_P SO_BUNDLE_ T1.KID whe n
	861	"BLD",1019 1,1,338,0)
	862	promp ted to Ent er a Host File name. You may need to ap pend a
	863	"BLD",1019 1,1,339,0)
	864	direc tory name.
	865	"BLD",1019 1,1,340,0)
	866
	867	"BLD",1019 1,1,341,0)
	868	4. From this menu, you may s elect to u se the fol lowing opt ions
	869	"BLD",1019 1,1,342,0)
	870	(when prompted for INSTAL L NAME, en ter IB2.0 568):
	871	"BLD",1019 1,1,343,0)
	872	a . Verify Checksums in Transpo rt Global - This opt ion will
	873	"BLD",1019 1,1,344,0)
	874	allow y ou to ensu re the int egrity of the routin es that ar e
	875	"BLD",1019 1,1,345,0)
	876	in the transport global.
	877	"BLD",1019 1,1,346,0)
	878	b . Print T ransport G lobal - Th is option will allow you to
	879	"BLD",1019 1,1,347,0)
	880	view th e componen ts of the KIDS build .
	881	"BLD",1019 1,1,348,0)
	882	c . Compare Transport Global to Current S ystem - Th is option
	883	"BLD",1019 1,1,349,0)
	884	will al low you to view all changes th at will be made when
	885	"BLD",1019 1,1,350,0)
	886	this pa tch is ins talled. I t compares all compo nents of
	887	"BLD",1019 1,1,351,0)
	888	this pa tch (routi nes, DD's, templates , etc.).
	889	"BLD",1019 1,1,352,0)
	890	d . Backup a Transpor t Global - This opti on will cr eate a
	891	"BLD",1019 1,1,353,0)
	892	backup message of any routi nes export ed with th is patch.
	893	"BLD",1019 1,1,354,0)
	894	It will not backu p any othe r changes such as DD 's or
	895	"BLD",1019 1,1,355,0)
	896	templat es.
	897	"BLD",1019 1,1,356,0)
	898
	899	"BLD",1019 1,1,357,0)
	900	5. When prompted " Want KIDS to INHIBIT LOGONs du ring the i nstall?
	901	"BLD",1019 1,1,358,0)
	902	NO//" respond N O.
	903	"BLD",1019 1,1,359,0)
	904
	905	"BLD",1019 1,1,360,0)
	906	6. When prompted " Want to DI SABLE Sche duled Opti ons, Menu Options,
	907	"BLD",1019 1,1,361,0)
	908	and P rotocols? NO//" resp ond NO.
	909	"BLD",1019 1,1,362,0)
	910
	911	"BLD",1019 1,1,363,0)
	912
	913	"BLD",1019 1,1,364,0)
	914
	915	"BLD",1019 1,1,365,0)
	916	Post-Insta llation In structions :
	917	"BLD",1019 1,1,366,0)
	918	---------- ---------- ---------- -
	919	"BLD",1019 1,1,367,0)
	920	There are no special tasks to perform af ter this p atch insta llation.
	921	"BLD",1019 1,4,0)
	922	^9.64PA^^0
	923	"BLD",1019 1,6.3)
	924	11
	925	"BLD",1019 1,"ABPKG")
	926	n
	927	"BLD",1019 1,"INIT")
	928
	929	"BLD",1019 1,"KRN",0)
	930	^9.67PA^77 9.2^20
	931	"BLD",1019 1,"KRN",.4 ,0)
	932	.4
	933	"BLD",1019 1,"KRN",.4 01,0)
	934	.401
	935	"BLD",1019 1,"KRN",.4 02,0)
	936	.402
	937	"BLD",1019 1,"KRN",.4 03,0)
	938	.403
	939	"BLD",1019 1,"KRN",.5 ,0)
	940	.5
	941	"BLD",1019 1,"KRN",.8 4,0)
	942	.84
	943	"BLD",1019 1,"KRN",3. 6,0)
	944	3.6
	945	"BLD",1019 1,"KRN",3. 8,0)
	946	3.8
	947	"BLD",1019 1,"KRN",9. 2,0)
	948	9.2
	949	"BLD",1019 1,"KRN",9. 8,0)
	950	9.8
	951	"BLD",1019 1,"KRN",9. 8,"NM",0)
	952	^9.68A^11^ 11
	953	"BLD",1019 1,"KRN",9. 8,"NM",1,0 )
	954	PRCAXP^^0^ B23479334
	955	"BLD",1019 1,"KRN",9. 8,"NM",2,0 )
	956	RCDPRTP^^0 ^B12982839
	957	"BLD",1019 1,"KRN",9. 8,"NM",3,0 )
	958	RCDPRTP0^^ 0^B4380991 5
	959	"BLD",1019 1,"KRN",9. 8,"NM",4,0 )
	960	RCDPRTP2^^ 0^B1792475 0
	961	"BLD",1019 1,"KRN",9. 8,"NM",5,0 )
	962	RCRJRCOU^^ 0^B3116950 5
	963	"BLD",1019 1,"KRN",9. 8,"NM",6,0 )
	964	RCRJRCOR^^ 0^B6695057 6
	965	"BLD",1019 1,"KRN",9. 8,"NM",7,0 )
	966	RCMSITE^^0 ^B10167680
	967	"BLD",1019 1,"KRN",9. 8,"NM",8,0 )
	968	PRCABIL1^^ 0^B5200819 0
	969	"BLD",1019 1,"KRN",9. 8,"NM",9,0 )
	970	PRCABD^^0^ B17130552
	971	"BLD",1019 1,"KRN",9. 8,"NM",10, 0)
	972	RCDPRTEX^^ 0^B5894947 3
	973	"BLD",1019 1,"KRN",9. 8,"NM",11, 0)
	974	PRCAPCL^^0 ^B41532110
	975	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"PRCABD", 9)
	976
	977	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"PRCABIL1 ",8)
	978
	979	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"PRCAPCL" ,11)
	980
	981	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"PRCAXP", 1)
	982
	983	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"RCDPRTEX ",10)
	984
	985	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"RCDPRTP" ,2)
	986
	987	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"RCDPRTP0 ",3)
	988
	989	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"RCDPRTP2 ",4)
	990
	991	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"RCMSITE" ,7)
	992
	993	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"RCRJRCOR ",6)
	994
	995	"BLD",1019 1,"KRN",9. 8,"NM","B" ,"RCRJRCOU ",5)
	996
	997	"BLD",1019 1,"KRN",19 ,0)
	998	19
	999	"BLD",1019 1,"KRN",19 ,"NM",0)
	1000	^9.68A^1^1
	1001	"BLD",1019 1,"KRN",19 ,"NM",1,0)
	1002	PRCA ARDC REPORT^^0
	1003	"BLD",1019 1,"KRN",19 ,"NM","B", "PRCA ARDC REPORT",1 )
	1004
	1005	"BLD",1019 1,"KRN",19 .1,0)
	1006	19.1
	1007	"BLD",1019 1,"KRN",19 .1,"NM",0)
	1008	^9.68A^1^1
	1009	"BLD",1019 1,"KRN",19 .1,"NM",1, 0)
	1010	PRCAF LATE CHARGES^^ 0
	1011	"BLD",1019 1,"KRN",19 .1,"NM","B ","PRCAF L ATE CHARGE S",1)
	1012
	1013	"BLD",1019 1,"KRN",10 1,0)
	1014	101
	1015	"BLD",1019 1,"KRN",40 9.61,0)
	1016	409.61
	1017	"BLD",1019 1,"KRN",77 1,0)
	1018	771
	1019	"BLD",1019 1,"KRN",77 9.2,0)
	1020	779.2
	1021	"BLD",1019 1,"KRN",87 0,0)
	1022	870
	1023	"BLD",1019 1,"KRN",89 89.51,0)
	1024	8989.51
	1025	"BLD",1019 1,"KRN",89 89.52,0)
	1026	8989.52
	1027	"BLD",1019 1,"KRN",89 94,0)
	1028	8994
	1029	"BLD",1019 1,"KRN","B ",.4,.4)
	1030
	1031	"BLD",1019 1,"KRN","B ",.401,.40 1)
	1032
	1033	"BLD",1019 1,"KRN","B ",.402,.40 2)
	1034
	1035	"BLD",1019 1,"KRN","B ",.403,.40 3)
	1036
	1037	"BLD",1019 1,"KRN","B ",.5,.5)
	1038
	1039	"BLD",1019 1,"KRN","B ",.84,.84)
	1040
	1041	"BLD",1019 1,"KRN","B ",3.6,3.6)
	1042
	1043	"BLD",1019 1,"KRN","B ",3.8,3.8)
	1044
	1045	"BLD",1019 1,"KRN","B ",9.2,9.2)
	1046
	1047	"BLD",1019 1,"KRN","B ",9.8,9.8)
	1048
	1049	"BLD",1019 1,"KRN","B ",19,19)
	1050
	1051	"BLD",1019 1,"KRN","B ",19.1,19. 1)
	1052
	1053	"BLD",1019 1,"KRN","B ",101,101)
	1054
	1055	"BLD",1019 1,"KRN","B ",409.61,4 09.61)
	1056
	1057	"BLD",1019 1,"KRN","B ",771,771)
	1058
	1059	"BLD",1019 1,"KRN","B ",779.2,77 9.2)
	1060
	1061	"BLD",1019 1,"KRN","B ",870,870)
	1062
	1063	"BLD",1019 1,"KRN","B ",8989.51, 8989.51)
	1064
	1065	"BLD",1019 1,"KRN","B ",8989.52, 8989.52)
	1066
	1067	"BLD",1019 1,"KRN","B ",8994,899 4)
	1068
	1069	"BLD",1019 1,"QDEF")
	1070	^^^^NO^^^^ NO^^NO
	1071	"BLD",1019 1,"QUES",0 )
	1072	^9.62^^
	1073	"BLD",1019 1,"REQB",0 )
	1074	^9.611^8^8
	1075	"BLD",1019 1,"REQB",1 ,0)
	1076	PRCA4.52 39^2
	1077	"BLD",1019 1,"REQB",2 ,0)
	1078	PRCA4.51 03^2
	1079	"BLD",1019 1,"REQB",3 ,0)
	1080	PRCA4.51 51^1
	1081	"BLD",1019 1,"REQB",4 ,0)
	1082	PRCA4.51 86^1
	1083	"BLD",1019 1,"REQB",5 ,0)
	1084	PRCA4.52 76^1
	1085	"BLD",1019 1,"REQB",6 ,0)
	1086	PRCA4.53 03^1
	1087	"BLD",1019 1,"REQB",7 ,0)
	1088	PRCA4.52 33^1
	1089	"BLD",1019 1,"REQB",8 ,0)
	1090	PRCA4.52 98^1
	1091	"BLD",1019 1,"REQB"," B","PRCA4 .5103",2)
	1092
	1093	"BLD",1019 1,"REQB"," B","PRCA4 .5151",3)
	1094
	1095	"BLD",1019 1,"REQB"," B","PRCA4 .5186",4)
	1096
	1097	"BLD",1019 1,"REQB"," B","PRCA4 .5233",7)
	1098
	1099	"BLD",1019 1,"REQB"," B","PRCA4 .5239",1)
	1100
	1101	"BLD",1019 1,"REQB"," B","PRCA4 .5276",5)
	1102
	1103	"BLD",1019 1,"REQB"," B","PRCA4 .5298",8)
	1104
	1105	"BLD",1019 1,"REQB"," B","PRCA4 .5303",6)
	1106
	1107	"KRN",19,1 1653,-1)
	1108	0^1
	1109	"KRN",19,1 1653,0)
	1110	PRCA ARDC REPORT^ARD C Detail R eport^^R^^ ^^^^^^ACCO UNTS RECEI VABLE
	1111	"KRN",19,1 1653,1,0)
	1112	^^2^2^3161 003^
	1113	"KRN",19,1 1653,1,1,0 )
	1114	This repor t was gene rated from the month ly backgou nd proces and genera ted
	1115	"KRN",19,1 1653,1,2,0 )
	1116	a MailMan message. It can now only be r an manuall y through this optio n.
	1117	"KRN",19,1 1653,10.1)
	1118	ARDC Detai ls
	1119	"KRN",19,1 1653,25)
	1120	START^RCRJ RCOU
	1121	"KRN",19,1 1653,"U")
	1122	ARDC DETAI L REPORT
	1123	"KRN",19.1 ,617,-1)
	1124	0^1
	1125	"KRN",19.1 ,617,0)
	1126	PRCAF LATE CHARGES
	1127	"KRN",19.1 ,617,1,0)
	1128	^^2^2^3161 116^
	1129	"KRN",19.1 ,617,1,1,0 )
	1130	This is a key for th e AR actio n in PRCAF U ADMIN.R ATE to all ow edits
	1131	"KRN",19.1 ,617,1,2,0 )
	1132	to the Int erest/Admi n and Pena lty Rates.
	1133	"MBREQ")
	1134	1
	1135	"ORD",3,19 .1)
	1136	19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1
	1137	"ORD",3,19 .1,0)
	1138	SECURITY K EY
	1139	"ORD",18,1 9)
	1140	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	1141	"ORD",18,1 9,0)
	1142	OPTION
	1143	"PKG",53,- 1)
	1144	1^1
	1145	"PKG",53,0 )
	1146	ACCOUNTS R ECEIVABLE^ PRCA^FMS
	1147	"PKG",53,2 0,0)
	1148	^9.402P^1^ 1
	1149	"PKG",53,2 0,1,0)
	1150	2^^PRCAMRG
	1151	"PKG",53,2 0,1,1)
	1152
	1153	"PKG",53,2 0,"B",2,1)
	1154
	1155	"PKG",53,2 2,0)
	1156	^9.49I^1^1
	1157	"PKG",53,2 2,1,0)
	1158	4.5^305111 9^2960627
	1159	"PKG",53,2 2,1,"PAH", 1,0)
	1160	315^316121 5
	1161	"PKG",53,2 2,1,"PAH", 1,1,0)
	1162	^^367^367^ 3161215
	1163	"PKG",53,2 2,1,"PAH", 1,1,1,0)
	1164
	1165	"PKG",53,2 2,1,"PAH", 1,1,2,0)
	1166	IMPORTANT INSTALLATI ON NOTE:
	1167	"PKG",53,2 2,1,"PAH", 1,1,3,0)
	1168	---------- ---------- --------
	1169	"PKG",53,2 2,1,"PAH", 1,1,4,0)
	1170	This patch is part o f a multi- package bu ild. There are three patches
	1171	"PKG",53,2 2,1,"PAH", 1,1,5,0)
	1172	associated with the FY16 HAPE Revenue En hancement project - IB2.0568 ,
	1173	"PKG",53,2 2,1,"PAH", 1,1,6,0)
	1174	PRCA4.53 15 and PSO 7.0463. All three patches ar e to be in stalled
	1175	"PKG",53,2 2,1,"PAH", 1,1,7,0)
	1176	together a s a bundle , IB_2_568 _PRCA_PSO_ BUNDLE_T1. KID
	1177	"PKG",53,2 2,1,"PAH", 1,1,8,0)
	1178
	1179	"PKG",53,2 2,1,"PAH", 1,1,9,0)
	1180
	1181	"PKG",53,2 2,1,"PAH", 1,1,10,0)
	1182	Descriptio n
	1183	"PKG",53,2 2,1,"PAH", 1,1,11,0)
	1184	---------- -
	1185	"PKG",53,2 2,1,"PAH", 1,1,12,0)
	1186	The Chief Business O ffice (CBO ) is reque sting syst em enhance ments to
	1187	"PKG",53,2 2,1,"PAH", 1,1,13,0)
	1188	The Vetera ns Health Informatio n Systems and Techno logy Archi tecture
	1189	"PKG",53,2 2,1,"PAH", 1,1,14,0)
	1190	(VistA) In tegrated B illing (IB ), Account s Receivab le (AR), a nd
	1191	"PKG",53,2 2,1,"PAH", 1,1,15,0)
	1192	Outpatient Pharmacy (PSO) soft ware modul es.
	1193	"PKG",53,2 2,1,"PAH", 1,1,16,0)
	1194
	1195	"PKG",53,2 2,1,"PAH", 1,1,17,0)
	1196	The missio n of the D epartment of Veteran s Affairs (VA), Offi ce of
	1197	"PKG",53,2 2,1,"PAH", 1,1,18,0)
	1198	Informatio n & Techno logy (OI&T ), is to p rovide ben efits and services
	1199	"PKG",53,2 2,1,"PAH", 1,1,19,0)
	1200	to veteran s of the U nited Stat es Armed F orces. In meeting th ese goals,
	1201	"PKG",53,2 2,1,"PAH", 1,1,20,0)
	1202	OIT strive s to provi de high qu ality, eff ective, an d efficien t
	1203	"PKG",53,2 2,1,"PAH", 1,1,21,0)
	1204	Informatio n Technolo gy (IT) se rvices to those resp onsible fo r
	1205	"PKG",53,2 2,1,"PAH", 1,1,22,0)
	1206	providing care to th e veterans at the po int-of-car e, as well as
	1207	"PKG",53,2 2,1,"PAH", 1,1,23,0)
	1208	throughout all the p oints of t he veteran s' health care. The VA depends
	1209	"PKG",53,2 2,1,"PAH", 1,1,24,0)
	1210	on Informa tion Manag ement/Info rmationTec hnology (I M/IT) syst ems to mee t
	1211	"PKG",53,2 2,1,"PAH", 1,1,25,0)
	1212	mission go als.
	1213	"PKG",53,2 2,1,"PAH", 1,1,26,0)
	1214
	1215	"PKG",53,2 2,1,"PAH", 1,1,27,0)
	1216	The overal l FY16 HAP E Revenue Enhancemen t project has been f urther
	1217	"PKG",53,2 2,1,"PAH", 1,1,28,0)
	1218	divided in to three s ub-project s:
	1219	"PKG",53,2 2,1,"PAH", 1,1,29,0)
	1220
	1221	"PKG",53,2 2,1,"PAH", 1,1,30,0)
	1222	NSR #20150 506
	1223	"PKG",53,2 2,1,"PAH", 1,1,31,0)
	1224	The Revenu e Eligibil ity Enhanc ements Pro ject effor t for the Chief
	1225	"PKG",53,2 2,1,"PAH", 1,1,32,0)
	1226	Business O ffice (CBO ), bundles several N SRs with s imilar bus iness
	1227	"PKG",53,2 2,1,"PAH", 1,1,33,0)
	1228	needs into a single requiremen ts documen t. Succes sfully add ressing
	1229	"PKG",53,2 2,1,"PAH", 1,1,34,0)
	1230	the requir ements con tained wit hin this d ocument wi ll enable the
	1231	"PKG",53,2 2,1,"PAH", 1,1,35,0)
	1232	Department of Vetera ns Affairs (VA) to a ppropriate ly bill ce rtain
	1233	"PKG",53,2 2,1,"PAH", 1,1,36,0)
	1234	subsets of billable events by correcting , automati ng, or enh ancing
	1235	"PKG",53,2 2,1,"PAH", 1,1,37,0)
	1236	current Ve terans Hea lth Inform ation Syst ems and Te chnology A rchitectur e
	1237	"PKG",53,2 2,1,"PAH", 1,1,38,0)
	1238	(VistA) sy stems.
	1239	"PKG",53,2 2,1,"PAH", 1,1,39,0)
	1240
	1241	"PKG",53,2 2,1,"PAH", 1,1,40,0)
	1242	NSR #20150 507
	1243	"PKG",53,2 2,1,"PAH", 1,1,41,0)
	1244	The Revenu e Operatio ns Enhance ments Proj ect combin es servera l NSRs,
	1245	"PKG",53,2 2,1,"PAH", 1,1,42,0)
	1246	as well. T his effort enables t he Departm ent of Vet erans Affa irs (VA)
	1247	"PKG",53,2 2,1,"PAH", 1,1,43,0)
	1248	to improve revenue o peration f unctionali ty related to repaym ent plans,
	1249	"PKG",53,2 2,1,"PAH", 1,1,44,0)
	1250	late charg e capture, bill susp ension rea sons, the billing of
	1251	"PKG",53,2 2,1,"PAH", 1,1,45,0)
	1252	deactivate d provider s, and the display o f appeal r ights and
	1253	"PKG",53,2 2,1,"PAH", 1,1,46,0)
	1254	responsibi lities on the Vetera ns Benefic iary trave l Bill of Collection s
	1255	"PKG",53,2 2,1,"PAH", 1,1,47,0)
	1256	form. Imp lementatio n of the p roposed en hancements will make a
	1257	"PKG",53,2 2,1,"PAH", 1,1,48,0)
	1258	significan t positive impact on stakehold ers and ta rget users .
	1259	"PKG",53,2 2,1,"PAH", 1,1,49,0)
	1260
	1261	"PKG",53,2 2,1,"PAH", 1,1,50,0)
	1262	NSR #20150 505
	1263	"PKG",53,2 2,1,"PAH", 1,1,51,0)
	1264	The Revenu e Reportin g Enhancem ents Proje ct will en able the V A to
	1265	"PKG",53,2 2,1,"PAH", 1,1,52,0)
	1266	improve tr acking and reporting of revenu e, and wil l support revenue
	1267	"PKG",53,2 2,1,"PAH", 1,1,53,0)
	1268	reporting business r ules and g uidelines.
	1269	"PKG",53,2 2,1,"PAH", 1,1,54,0)
	1270
	1271	"PKG",53,2 2,1,"PAH", 1,1,55,0)
	1272
	1273	"PKG",53,2 2,1,"PAH", 1,1,56,0)
	1274	PRCA4.53 15 patch e nhancement s, pertine nt to the above NSRs , include:
	1275	"PKG",53,2 2,1,"PAH", 1,1,57,0)
	1276
	1277	"PKG",53,2 2,1,"PAH", 1,1,58,0)
	1278	1.) By mea ns of the new Enter / Edit Rep ayment Pla n option, the user
	1279	"PKG",53,2 2,1,"PAH", 1,1,59,0)
	1280	will creat e the Repa yment Plan by debtor . Note: Th e 'Enter / Edit
	1281	"PKG",53,2 2,1,"PAH", 1,1,60,0)
	1282	Repayment Plan' menu option na me will re place the 'Set up Re payment
	1283	"PKG",53,2 2,1,"PAH", 1,1,61,0)
	1284	Plan' menu option na me.
	1285	"PKG",53,2 2,1,"PAH", 1,1,62,0)
	1286
	1287	"PKG",53,2 2,1,"PAH", 1,1,63,0)
	1288	2.) On the Enter / E dit Repaym ent Plan o ption, if the AR Deb tor has
	1289	"PKG",53,2 2,1,"PAH", 1,1,64,0)
	1290	Active bil ls, the sy stem will now displa y a select able list of bills
	1291	"PKG",53,2 2,1,"PAH", 1,1,65,0)
	1292	for the de btor.
	1293	"PKG",53,2 2,1,"PAH", 1,1,66,0)
	1294
	1295	"PKG",53,2 2,1,"PAH", 1,1,67,0)
	1296	3.) On the Enter / E dit Repaym ent Plan o ption, whe n displayi ng a list
	1297	"PKG",53,2 2,1,"PAH", 1,1,68,0)
	1298	of Active bills for the Debtor , the syst em will di splay step s to the
	1299	"PKG",53,2 2,1,"PAH", 1,1,69,0)
	1300	user to se t up the R epayment P lan.
	1301	"PKG",53,2 2,1,"PAH", 1,1,70,0)
	1302
	1303	"PKG",53,2 2,1,"PAH", 1,1,71,0)
	1304	4.) On the Enter /Ed it Repayme nt Plan op tion, once a Repayme nt Plan
	1305	"PKG",53,2 2,1,"PAH", 1,1,72,0)
	1306	has been c reated or modified, the summar y of the R epayment P lan is
	1307	"PKG",53,2 2,1,"PAH", 1,1,73,0)
	1308	displayed.
	1309	"PKG",53,2 2,1,"PAH", 1,1,74,0)
	1310
	1311	"PKG",53,2 2,1,"PAH", 1,1,75,0)
	1312	5.) On the Enter / E dit Repaym ent Plan o ption, the system ch ecks to
	1313	"PKG",53,2 2,1,"PAH", 1,1,76,0)
	1314	see if a R epayment P lan has al ready been created f or the Vet eran.
	1315	"PKG",53,2 2,1,"PAH", 1,1,77,0)
	1316
	1317	"PKG",53,2 2,1,"PAH", 1,1,78,0)
	1318	6.) On the Enter / E dit Repaym ent Plan o ption, whe n choosing to Edit
	1319	"PKG",53,2 2,1,"PAH", 1,1,79,0)
	1320	the Repaym ent Plan, all Active bills for the debto r will be displayed
	1321	"PKG",53,2 2,1,"PAH", 1,1,80,0)
	1322	allowing t he user to add new A ctive bill s to the R epayment P lan as wel l
	1323	"PKG",53,2 2,1,"PAH", 1,1,81,0)
	1324	as change the due da te of firs t payment and/or the repayment amount du e
	1325	"PKG",53,2 2,1,"PAH", 1,1,82,0)
	1326	on the Rep ayment Pla n.
	1327	"PKG",53,2 2,1,"PAH", 1,1,83,0)
	1328
	1329	"PKG",53,2 2,1,"PAH", 1,1,84,0)
	1330	7.) On the Enter / E dit Repaym ent Plan o ption, if the Debtor does not
	1331	"PKG",53,2 2,1,"PAH", 1,1,85,0)
	1332	have new A ctive bill s that can be added to the Rep ayment Pla n, the use r
	1333	"PKG",53,2 2,1,"PAH", 1,1,86,0)
	1334	will proce ed to iden tify the r epayment a mount due and/or rep ayment
	1335	"PKG",53,2 2,1,"PAH", 1,1,87,0)
	1336	amount due date on t he Repayme nt Plan.
	1337	"PKG",53,2 2,1,"PAH", 1,1,88,0)
	1338
	1339	"PKG",53,2 2,1,"PAH", 1,1,89,0)
	1340	8.) On the Enter / E dit Repaym ent Plan o ption, a d esignated identifier
	1341	"PKG",53,2 2,1,"PAH", 1,1,90,0)
	1342	will signi fy when an Active bi ll is part of a Repa yment Plan .
	1343	"PKG",53,2 2,1,"PAH", 1,1,91,0)
	1344
	1345	"PKG",53,2 2,1,"PAH", 1,1,92,0)
	1346	9.) On the Enter / E dit Repaym ent Plan o ption, the system wi ll display
	1347	"PKG",53,2 2,1,"PAH", 1,1,93,0)
	1348	previously made paym ents to th e Repaymen t Plan.
	1349	"PKG",53,2 2,1,"PAH", 1,1,94,0)
	1350
	1351	"PKG",53,2 2,1,"PAH", 1,1,95,0)
	1352	10.) On th e Enter / Edit Repay ment Plan option, th e User has the optio n
	1353	"PKG",53,2 2,1,"PAH", 1,1,96,0)
	1354	to enter D ebtor Comm ents durin g the setu p process.
	1355	"PKG",53,2 2,1,"PAH", 1,1,97,0)
	1356
	1357	"PKG",53,2 2,1,"PAH", 1,1,98,0)
	1358	11.) The A R Clerk wi ll be able to select Suspended Type from the menu
	1359	"PKG",53,2 2,1,"PAH", 1,1,99,0)
	1360	to display in the St atus Listi ng For Bil ls [PRCAL STATUS LIS T] report.
	1361	"PKG",53,2 2,1,"PAH", 1,1,100,0)
	1362
	1363	"PKG",53,2 2,1,"PAH", 1,1,101,0)
	1364	12.) Statu s Listing For Bills [PRCAL STA TUS LIST] report sha ll be
	1365	"PKG",53,2 2,1,"PAH", 1,1,102,0)
	1366	modified t o incorpor ate reason for suspe nsion.
	1367	"PKG",53,2 2,1,"PAH", 1,1,103,0)
	1368
	1369	"PKG",53,2 2,1,"PAH", 1,1,104,0)
	1370	13.) Provi de the abi lity to lo ck the opt ion to upd ate late p ayment
	1371	"PKG",53,2 2,1,"PAH", 1,1,105,0)
	1372	charges (I nterest/Ad min/Penalt y Rates [P RCAF U ADM IN.RATE]) with a new
	1373	"PKG",53,2 2,1,"PAH", 1,1,106,0)
	1374	security k ey.
	1375	"PKG",53,2 2,1,"PAH", 1,1,107,0)
	1376
	1377	"PKG",53,2 2,1,"PAH", 1,1,108,0)
	1378	14.) The s ystem will allow the user to i dentify if the Bill of
	1379	"PKG",53,2 2,1,"PAH", 1,1,109,0)
	1380	Collection s letter a pplies to Veterans B eneficiary Travel (F orm 1114).
	1381	"PKG",53,2 2,1,"PAH", 1,1,110,0)
	1382
	1383	"PKG",53,2 2,1,"PAH", 1,1,111,0)
	1384	15.) The s ystem will print the Notice of Rights an d Responsi bilities
	1385	"PKG",53,2 2,1,"PAH", 1,1,112,0)
	1386	when the B ill of Col lections p ertains to Veterans Beneficiar y Travel.
	1387	"PKG",53,2 2,1,"PAH", 1,1,113,0)
	1388
	1389	"PKG",53,2 2,1,"PAH", 1,1,114,0)
	1390	16.) VistA AR Softwa re Package shall dis continue g eneration of the
	1391	"PKG",53,2 2,1,"PAH", 1,1,115,0)
	1392	Mailman me ssage/bull etin, "ARD C Detail R eport for MON/ YYYY" , without
	1393	"PKG",53,2 2,1,"PAH", 1,1,116,0)
	1394	interrupti ng any oth er transfe r data wit hin ARDC.
	1395	"PKG",53,2 2,1,"PAH", 1,1,117,0)
	1396
	1397	"PKG",53,2 2,1,"PAH", 1,1,118,0)
	1398	17.) The V istA AR So ftware Pac kage shall allow the generatio n of a
	1399	"PKG",53,2 2,1,"PAH", 1,1,119,0)
	1400	report of bills cont aining the same info rmation as the disco ntinued
	1401	"PKG",53,2 2,1,"PAH", 1,1,120,0)
	1402	"ARDC Deta il Report for MON/YY YY" with t he followi ng excepti ons/
	1403	"PKG",53,2 2,1,"PAH", 1,1,121,0)
	1404	additions:
	1405	"PKG",53,2 2,1,"PAH", 1,1,122,0)
	1406	Th e report s hall inclu de current status bi lls (New B ill, Activ e,
	1407	"PKG",53,2 2,1,"PAH", 1,1,123,0)
	1408	Re turned for Amendment , Amended Bill, Open , and Susp ended bill s)
	1409	"PKG",53,2 2,1,"PAH", 1,1,124,0)
	1410	on ly;
	1411	"PKG",53,2 2,1,"PAH", 1,1,125,0)
	1412
	1413	"PKG",53,2 2,1,"PAH", 1,1,126,0)
	1414	Th e report s hall inclu de a colum n for the Fund numbe r associat ed
	1415	"PKG",53,2 2,1,"PAH", 1,1,127,0)
	1416	wi th each li ne item on the repor t; and
	1417	"PKG",53,2 2,1,"PAH", 1,1,128,0)
	1418
	1419	"PKG",53,2 2,1,"PAH", 1,1,129,0)
	1420	Th e report s hall inclu de a colum n for the RSC associ ated with
	1421	"PKG",53,2 2,1,"PAH", 1,1,130,0)
	1422	ea ch line it em on the report.
	1423	"PKG",53,2 2,1,"PAH", 1,1,131,0)
	1424
	1425	"PKG",53,2 2,1,"PAH", 1,1,132,0)
	1426	18.) Curre ntly, when non-healt hcare debt of $25 or greater i s in a
	1427	"PKG",53,2 2,1,"PAH", 1,1,133,0)
	1428	delinquent status fo r 180 days , VistA tr ansmits th is debt to TOP
	1429	"PKG",53,2 2,1,"PAH", 1,1,134,0)
	1430	(via AITC and DMC) f or initiat ion of the standard collection process.
	1431	"PKG",53,2 2,1,"PAH", 1,1,135,0)
	1432	To maintai n complian ce with Th e DATA Act of 2014, the 180-da y date
	1433	"PKG",53,2 2,1,"PAH", 1,1,136,0)
	1434	parameter shall be c hanged to 120 days.
	1435	"PKG",53,2 2,1,"PAH", 1,1,137,0)
	1436
	1437	"PKG",53,2 2,1,"PAH", 1,1,138,0)
	1438	19.) A ne w audit tr ail is nee ded for de tailing ev ents or tr ansactions
	1439	"PKG",53,2 2,1,"PAH", 1,1,139,0)
	1440	that have occurred o n healthca re debts r eferred fo r debt col lection, t o
	1441	"PKG",53,2 2,1,"PAH", 1,1,140,0)
	1442	effectivel y support Veterans a nd reconci le account s.
	1443	"PKG",53,2 2,1,"PAH", 1,1,141,0)
	1444
	1445	"PKG",53,2 2,1,"PAH", 1,1,142,0)
	1446	20.) Vist A shall pr ovide enha nced repor ting capab ility, usa bility
	1447	"PKG",53,2 2,1,"PAH", 1,1,143,0)
	1448	features, and additi onal data elements f or managin g healthca re debts
	1449	"PKG",53,2 2,1,"PAH", 1,1,144,0)
	1450	referred f or debt co llection t o improve VHA's abil ity to pro vide suppo rt
	1451	"PKG",53,2 2,1,"PAH", 1,1,145,0)
	1452	to Veteran s and mana ge account s.
	1453	"PKG",53,2 2,1,"PAH", 1,1,146,0)
	1454
	1455	"PKG",53,2 2,1,"PAH", 1,1,147,0)
	1456	21.) Crea te report to track s top/reacti vate debts . VistA sh all provid e
	1457	"PKG",53,2 2,1,"PAH", 1,1,148,0)
	1458	a Stop/Rea ctivate re port to id entify hea lthcare de bts that a re placed
	1459	"PKG",53,2 2,1,"PAH", 1,1,149,0)
	1460	in the cor responding status.
	1461	"PKG",53,2 2,1,"PAH", 1,1,150,0)
	1462
	1463	"PKG",53,2 2,1,"PAH", 1,1,151,0)
	1464	22.) Impr ove automa tion in ma nagement o f debt col lection. V istA shall
	1465	"PKG",53,2 2,1,"PAH", 1,1,152,0)
	1466	utilize ex isting fun ctionality , such as List Manag er, and ot her
	1467	"PKG",53,2 2,1,"PAH", 1,1,153,0)
	1468	automation capabilit ies to imp rove debt collection managemen t"
	1469	"PKG",53,2 2,1,"PAH", 1,1,154,0)
	1470
	1471	"PKG",53,2 2,1,"PAH", 1,1,155,0)
	1472	23.) The existing M edication Co-Pay Exe mption Rep ort [PRCAX CO-PAY
	1473	"PKG",53,2 2,1,"PAH", 1,1,156,0)
	1474	EXEMPTION REPORT] sh all be mod ified with the follo wing field changes:
	1475	"PKG",53,2 2,1,"PAH", 1,1,157,0)
	1476	Ch ange PT ID from full Social Se curity Num ber (SSN) to LastN +
	1477	"PKG",53,2 2,1,"PAH", 1,1,158,0)
	1478	4SSN
	1479	"PKG",53,2 2,1,"PAH", 1,1,159,0)
	1480	Ad d Rx#
	1481	"PKG",53,2 2,1,"PAH", 1,1,160,0)
	1482	Ad d Drug Nam e (first 1 0 to 12 ch aracters)
	1483	"PKG",53,2 2,1,"PAH", 1,1,161,0)
	1484	Ad d Fill/Ref ill Date
	1485	"PKG",53,2 2,1,"PAH", 1,1,162,0)
	1486	Ad d Effectiv e Date of Exemption
	1487	"PKG",53,2 2,1,"PAH", 1,1,163,0)
	1488
	1489	"PKG",53,2 2,1,"PAH", 1,1,164,0)
	1490	24.) A ne w Third Pa rty Accoun ts Receiva ble catego ry called
	1491	"PKG",53,2 2,1,"PAH", 1,1,165,0)
	1492	'EMERGENCY /HUMANITAR IAN REIMB. ' shall be created i n Accounts Receivabl es
	1493	"PKG",53,2 2,1,"PAH", 1,1,166,0)
	1494	with the i nsurer as the respon sible part y.
	1495	"PKG",53,2 2,1,"PAH", 1,1,167,0)
	1496
	1497	"PKG",53,2 2,1,"PAH", 1,1,168,0)
	1498	25.) A new Third Par ty Account s Receivab le categor y called ' INELIGIBLE
	1499	"PKG",53,2 2,1,"PAH", 1,1,169,0)
	1500	HOSP. REIM B' shall b e created in Account s Receivab les with t he insurer
	1501	"PKG",53,2 2,1,"PAH", 1,1,170,0)
	1502	as the res ponsible p arty.
	1503	"PKG",53,2 2,1,"PAH", 1,1,171,0)
	1504
	1505	"PKG",53,2 2,1,"PAH", 1,1,172,0)
	1506	26.) A one -character "Type" fi eld shall be added t o the Clai ms Matchin g
	1507	"PKG",53,2 2,1,"PAH", 1,1,173,0)
	1508	Report tha t will ind icate the third-part y claim ca re-type (" I" for
	1509	"PKG",53,2 2,1,"PAH", 1,1,174,0)
	1510	Inpatient, "O" for O utpatient, "P" for P rosthetics , and "R" for
	1511	"PKG",53,2 2,1,"PAH", 1,1,175,0)
	1512	Prescripti on
	1513	"PKG",53,2 2,1,"PAH", 1,1,176,0)
	1514	[Rx]) on t he report of third-p arty bills .
	1515	"PKG",53,2 2,1,"PAH", 1,1,177,0)
	1516
	1517	"PKG",53,2 2,1,"PAH", 1,1,178,0)
	1518	27.) When a user gen erates a C laims Matc hing Repor t for a pa tient, all
	1519	"PKG",53,2 2,1,"PAH", 1,1,179,0)
	1520	records fo r that pat ient are c urrently p roduced on the repor t. At
	1521	"PKG",53,2 2,1,"PAH", 1,1,180,0)
	1522	times, use rs need to generate informatio n regardin g only cer tain types
	1523	"PKG",53,2 2,1,"PAH", 1,1,181,0)
	1524	of care fo r a patien t. The sy stem shall allow the user to c hoose
	1525	"PKG",53,2 2,1,"PAH", 1,1,182,0)
	1526	between pr oducing a Claims Mat ching Repo rt contain ing (1) al l records
	1527	"PKG",53,2 2,1,"PAH", 1,1,183,0)
	1528	for a pati ent, or (2 ) only rec ords of a certain ca re type (" I" for
	1529	"PKG",53,2 2,1,"PAH", 1,1,184,0)
	1530	Inpatient, "O" for O utpatient, "P" for P rosthetics , or "R" f or
	1531	"PKG",53,2 2,1,"PAH", 1,1,185,0)
	1532	Prescripti on [Rx]).
	1533	"PKG",53,2 2,1,"PAH", 1,1,186,0)
	1534
	1535	"PKG",53,2 2,1,"PAH", 1,1,187,0)
	1536	28.) The C laims Matc hing Repor t, when ex ported, sh all be in a line
	1537	"PKG",53,2 2,1,"PAH", 1,1,188,0)
	1538	format so that infor mation on the report may be ea sily expor ted to
	1539	"PKG",53,2 2,1,"PAH", 1,1,189,0)
	1540	Microsoft Excel.
	1541	"PKG",53,2 2,1,"PAH", 1,1,190,0)
	1542
	1543	"PKG",53,2 2,1,"PAH", 1,1,191,0)
	1544
	1545	"PKG",53,2 2,1,"PAH", 1,1,192,0)
	1546
	1547	"PKG",53,2 2,1,"PAH", 1,1,193,0)
	1548	Concurrent Developme nt / Depen dencies:
	1549	"PKG",53,2 2,1,"PAH", 1,1,194,0)
	1550	---------- ---------- ---------- --------
	1551	"PKG",53,2 2,1,"PAH", 1,1,195,0)
	1552	N/A
	1553	"PKG",53,2 2,1,"PAH", 1,1,196,0)
	1554
	1555	"PKG",53,2 2,1,"PAH", 1,1,197,0)
	1556
	1557	"PKG",53,2 2,1,"PAH", 1,1,198,0)
	1558	Patch Comp onents:
	1559	"PKG",53,2 2,1,"PAH", 1,1,199,0)
	1560	---------- -------
	1561	"PKG",53,2 2,1,"PAH", 1,1,200,0)
	1562
	1563	"PKG",53,2 2,1,"PAH", 1,1,201,0)
	1564	Files & Fi elds Assoc iated:
	1565	"PKG",53,2 2,1,"PAH", 1,1,202,0)
	1566
	1567	"PKG",53,2 2,1,"PAH", 1,1,203,0)
	1568	File Name (Number) Field Na me (Number ) New/ Modified/D eleted
	1569	"PKG",53,2 2,1,"PAH", 1,1,204,0)
	1570	---------- -------- -------- ---------- - ---- ---------- ------
	1571	"PKG",53,2 2,1,"PAH", 1,1,205,0)
	1572	N/A
	1573	"PKG",53,2 2,1,"PAH", 1,1,206,0)
	1574
	1575	"PKG",53,2 2,1,"PAH", 1,1,207,0)
	1576	Options As sociated:
	1577	"PKG",53,2 2,1,"PAH", 1,1,208,0)
	1578
	1579	"PKG",53,2 2,1,"PAH", 1,1,209,0)
	1580	Option Nam e Type New/ Modified/D eleted
	1581	"PKG",53,2 2,1,"PAH", 1,1,210,0)
	1582	---------- - ---- ---- ---------- ------
	1583	"PKG",53,2 2,1,"PAH", 1,1,211,0)
	1584	PRCA ARDC REPORT ROUTINE NEW
	1585	"PKG",53,2 2,1,"PAH", 1,1,212,0)
	1586
	1587	"PKG",53,2 2,1,"PAH", 1,1,213,0)
	1588	Protocols Associated :
	1589	"PKG",53,2 2,1,"PAH", 1,1,214,0)
	1590
	1591	"PKG",53,2 2,1,"PAH", 1,1,215,0)
	1592	Protocol N ame New /Modified/ Deleted
	1593	"PKG",53,2 2,1,"PAH", 1,1,216,0)
	1594	---------- --- --- ---------- -------
	1595	"PKG",53,2 2,1,"PAH", 1,1,217,0)
	1596	N/A
	1597	"PKG",53,2 2,1,"PAH", 1,1,218,0)
	1598
	1599	"PKG",53,2 2,1,"PAH", 1,1,219,0)
	1600	Templates Associated :
	1601	"PKG",53,2 2,1,"PAH", 1,1,220,0)
	1602
	1603	"PKG",53,2 2,1,"PAH", 1,1,221,0)
	1604	Template N ame T ype File Name (Num ber) New/Mod/De l
	1605	"PKG",53,2 2,1,"PAH", 1,1,222,0)
	1606	---------- --- - --- ---- ---------- ---- ---------- -
	1607	"PKG",53,2 2,1,"PAH", 1,1,223,0)
	1608	N/A
	1609	"PKG",53,2 2,1,"PAH", 1,1,224,0)
	1610
	1611	"PKG",53,2 2,1,"PAH", 1,1,225,0)
	1612	New Servic e Requests (NSRs):
	1613	"PKG",53,2 2,1,"PAH", 1,1,226,0)
	1614	---------- ---------- --------
	1615	"PKG",53,2 2,1,"PAH", 1,1,227,0)
	1616	20150505 - Revenue R eporting E nhancement s
	1617	"PKG",53,2 2,1,"PAH", 1,1,228,0)
	1618	20150506 - Revenue E ligibility Enhanceme nts
	1619	"PKG",53,2 2,1,"PAH", 1,1,229,0)
	1620	20150507 - Revenue O perations Enhancemen ts
	1621	"PKG",53,2 2,1,"PAH", 1,1,230,0)
	1622
	1623	"PKG",53,2 2,1,"PAH", 1,1,231,0)
	1624
	1625	"PKG",53,2 2,1,"PAH", 1,1,232,0)
	1626	Patient Sa fety Issue s (PSIs):
	1627	"PKG",53,2 2,1,"PAH", 1,1,233,0)
	1628	---------- ---------- ----------
	1629	"PKG",53,2 2,1,"PAH", 1,1,234,0)
	1630	N/A
	1631	"PKG",53,2 2,1,"PAH", 1,1,235,0)
	1632
	1633	"PKG",53,2 2,1,"PAH", 1,1,236,0)
	1634
	1635	"PKG",53,2 2,1,"PAH", 1,1,237,0)
	1636	Remedy Tic ket(s) & O verviews:
	1637	"PKG",53,2 2,1,"PAH", 1,1,238,0)
	1638	---------- ---------- ---------
	1639	"PKG",53,2 2,1,"PAH", 1,1,239,0)
	1640	N/A
	1641	"PKG",53,2 2,1,"PAH", 1,1,240,0)
	1642
	1643	"PKG",53,2 2,1,"PAH", 1,1,241,0)
	1644	Test Sites :
	1645	"PKG",53,2 2,1,"PAH", 1,1,242,0)
	1646	----------
	1647	"PKG",53,2 2,1,"PAH", 1,1,243,0)
	1648	Durham VAM C
	1649	"PKG",53,2 2,1,"PAH", 1,1,244,0)
	1650
	1651	"PKG",53,2 2,1,"PAH", 1,1,245,0)
	1652
	1653	"PKG",53,2 2,1,"PAH", 1,1,246,0)
	1654	Software a nd Documen tation Ret rieval Ins tructions:
	1655	"PKG",53,2 2,1,"PAH", 1,1,247,0)
	1656	---------- ---------- ---------- ---------- ---------- --
	1657	"PKG",53,2 2,1,"PAH", 1,1,248,0)
	1658	Patches fo r this ins tallation are combin ed in host file
	1659	"PKG",53,2 2,1,"PAH", 1,1,249,0)
	1660	IB_2_568_P RCA_PSO_BU NDLE_T1.KI D
	1661	"PKG",53,2 2,1,"PAH", 1,1,250,0)
	1662
	1663	"PKG",53,2 2,1,"PAH", 1,1,251,0)
	1664	Installati on of this host file should be coordinat ed among t he package s
	1665	"PKG",53,2 2,1,"PAH", 1,1,252,0)
	1666	affected s ince only one instal lation is necessary.
	1667	"PKG",53,2 2,1,"PAH", 1,1,253,0)
	1668
	1669	"PKG",53,2 2,1,"PAH", 1,1,254,0)
	1670	The patche s are:
	1671	"PKG",53,2 2,1,"PAH", 1,1,255,0)
	1672
	1673	"PKG",53,2 2,1,"PAH", 1,1,256,0)
	1674	IB2. 0568
	1675	"PKG",53,2 2,1,"PAH", 1,1,257,0)
	1676	PRCA* 4.5*315
	1677	"PKG",53,2 2,1,"PAH", 1,1,258,0)
	1678	PSO7 .0463
	1679	"PKG",53,2 2,1,"PAH", 1,1,259,0)
	1680
	1681	"PKG",53,2 2,1,"PAH", 1,1,260,0)
	1682
	1683	"PKG",53,2 2,1,"PAH", 1,1,261,0)
	1684	Sites may retrieve t he KIDS bu ild in one of the fo llowing wa ys:
	1685	"PKG",53,2 2,1,"PAH", 1,1,262,0)
	1686
	1687	"PKG",53,2 2,1,"PAH", 1,1,263,0)
	1688	(1) The pr eferred me thod is to FTP the f iles from
	1689	"PKG",53,2 2,1,"PAH", 1,1,264,0)
	1690	download.D NS .D NS
	1691	"PKG",53,2 2,1,"PAH", 1,1,265,0)
	1692	which will transmit the files from the f irst avail able FTP s erver.
	1693	"PKG",53,2 2,1,"PAH", 1,1,266,0)
	1694
	1695	"PKG",53,2 2,1,"PAH", 1,1,267,0)
	1696	(2) Sites may also e lect to re trieve the patch dir ectly from a specifi c
	1697	"PKG",53,2 2,1,"PAH", 1,1,268,0)
	1698	server as follows:
	1699	"PKG",53,2 2,1,"PAH", 1,1,269,0)
	1700
	1701	"PKG",53,2 2,1,"PAH", 1,1,270,0)
	1702	OIFO FTP ADDRE SS DIRECTORY
	1703	"PKG",53,2 2,1,"PAH", 1,1,271,0)
	1704	-------- ------ --------- ---------- ----- ---------- --------
	1705	"PKG",53,2 2,1,"PAH", 1,1,272,0)
	1706	Albany DNS . URL anonymous. software
	1707	"PKG",53,2 2,1,"PAH", 1,1,273,0)
	1708	Hines DNS . DNS . URL anonymous. software
	1709	"PKG",53,2 2,1,"PAH", 1,1,274,0)
	1710	Salt Lake City DNS . URL anonymous. software
	1711	"PKG",53,2 2,1,"PAH", 1,1,275,0)
	1712
	1713	"PKG",53,2 2,1,"PAH", 1,1,276,0)
	1714
	1715	"PKG",53,2 2,1,"PAH", 1,1,277,0)
	1716	Sites may retrieve d ocumentati on directl y using Se cure File Transfer
	1717	"PKG",53,2 2,1,"PAH", 1,1,278,0)
	1718	Protocol ( SFTP) from the ANONY MOUS.SOFTW ARE direct ory at the following
	1719	"PKG",53,2 2,1,"PAH", 1,1,279,0)
	1720	OI Field O ffices:
	1721	"PKG",53,2 2,1,"PAH", 1,1,280,0)
	1722
	1723	"PKG",53,2 2,1,"PAH", 1,1,281,0)
	1724	Albany: DNS.URL
	1725	"PKG",53,2 2,1,"PAH", 1,1,282,0)
	1726	Hines: DNS .U RL
	1727	"PKG",53,2 2,1,"PAH", 1,1,283,0)
	1728	Salt Lake City: DNS . URL
	1729	"PKG",53,2 2,1,"PAH", 1,1,284,0)
	1730
	1731	"PKG",53,2 2,1,"PAH", 1,1,285,0)
	1732	Documentat ion can al so be foun d on the V A Software Documenta tion
	1733	"PKG",53,2 2,1,"PAH", 1,1,286,0)
	1734	Library at :
	1735	"PKG",53,2 2,1,"PAH", 1,1,287,0)
	1736	http:// URL /
	1737	"PKG",53,2 2,1,"PAH", 1,1,288,0)
	1738
	1739	"PKG",53,2 2,1,"PAH", 1,1,289,0)
	1740	Title File Na me FTP Mod e
	1741	"PKG",53,2 2,1,"PAH", 1,1,290,0)
	1742	---------- ---------- ---------- ---------- ---------- ---------- ---------- -
	1743	"PKG",53,2 2,1,"PAH", 1,1,291,0)
	1744	Accounts R eceivable Technical Manual/Sec urity Guid e
	1745	"PKG",53,2 2,1,"PAH", 1,1,292,0)
	1746	prca_4_ 5_tm+r0515 .doc Binar y
	1747	"PKG",53,2 2,1,"PAH", 1,1,293,0)
	1748	Accounts R eceivable Deployment , Installa tion,
	1749	"PKG",53,2 2,1,"PAH", 1,1,294,0)
	1750	Back- Out, and R ollback Gu ide
	1751	"PKG",53,2 2,1,"PAH", 1,1,295,0)
	1752	FY16Re venueARVIP _Deploymen t_Installa tion_Guide .doc Binar y
	1753	"PKG",53,2 2,1,"PAH", 1,1,296,0)
	1754
	1755	"PKG",53,2 2,1,"PAH", 1,1,297,0)
	1756
	1757	"PKG",53,2 2,1,"PAH", 1,1,298,0)
	1758
	1759	"PKG",53,2 2,1,"PAH", 1,1,299,0)
	1760	Patch Inst allation:
	1761	"PKG",53,2 2,1,"PAH", 1,1,300,0)
	1762
	1763	"PKG",53,2 2,1,"PAH", 1,1,301,0)
	1764	Pre/Post I nstallatio n Overview :
	1765	"PKG",53,2 2,1,"PAH", 1,1,302,0)
	1766	---------- ---------- ---------- -
	1767	"PKG",53,2 2,1,"PAH", 1,1,303,0)
	1768	The post i nstallatio n routine, PRCA315P, is not au tomaticall y deleted
	1769	"PKG",53,2 2,1,"PAH", 1,1,304,0)
	1770	as part of the insta llation pr ocess. You may delet e it after
	1771	"PKG",53,2 2,1,"PAH", 1,1,305,0)
	1772	installati on if you desire.
	1773	"PKG",53,2 2,1,"PAH", 1,1,306,0)
	1774
	1775	"PKG",53,2 2,1,"PAH", 1,1,307,0)
	1776	Pre-Instal lation Ins tructions:
	1777	"PKG",53,2 2,1,"PAH", 1,1,308,0)
	1778	---------- ---------- ----------
	1779	"PKG",53,2 2,1,"PAH", 1,1,309,0)
	1780	N/A
	1781	"PKG",53,2 2,1,"PAH", 1,1,310,0)
	1782
	1783	"PKG",53,2 2,1,"PAH", 1,1,311,0)
	1784	Installati on Instruc tions:
	1785	"PKG",53,2 2,1,"PAH", 1,1,312,0)
	1786	---------- ---------- ------
	1787	"PKG",53,2 2,1,"PAH", 1,1,313,0)
	1788	This proce ss will in stall new and update d routines and other
	1789	"PKG",53,2 2,1,"PAH", 1,1,314,0)
	1790	components listed ab ove. There is a post -install r outine tha t will add
	1791	"PKG",53,2 2,1,"PAH", 1,1,315,0)
	1792	entries to a number of files.
	1793	"PKG",53,2 2,1,"PAH", 1,1,316,0)
	1794
	1795	"PKG",53,2 2,1,"PAH", 1,1,317,0)
	1796	The patch will be re leased in conjunctio n with an Integrated Billing
	1797	"PKG",53,2 2,1,"PAH", 1,1,318,0)
	1798	patch, IB* 4.5568, a nd an Outp atient Pha rmacy patc h, PSO7.0 *463.
	1799	"PKG",53,2 2,1,"PAH", 1,1,319,0)
	1800
	1801	"PKG",53,2 2,1,"PAH", 1,1,320,0)
	1802	****** ****** ** NOT E **** ****** ****
	1803	"PKG",53,2 2,1,"PAH", 1,1,321,0)
	1804	IF A USE R IS ON TH E SYSTEM A ND USING T HESE PROGR AMS
	1805	"PKG",53,2 2,1,"PAH", 1,1,322,0)
	1806	AN EDITE D ERROR WI LL OCCUR.
	1807	"PKG",53,2 2,1,"PAH", 1,1,323,0)
	1808	The patc h should b e installe d when NO Outpatient
	1809	"PKG",53,2 2,1,"PAH", 1,1,324,0)
	1810	Pharmacy users are on the sy stem.
	1811	"PKG",53,2 2,1,"PAH", 1,1,325,0)
	1812	****** ****** ****** ****** ****** ****
	1813	"PKG",53,2 2,1,"PAH", 1,1,326,0)
	1814
	1815	"PKG",53,2 2,1,"PAH", 1,1,327,0)
	1816	Installat ion will t ake less t han 1 minu te.
	1817	"PKG",53,2 2,1,"PAH", 1,1,328,0)
	1818
	1819	"PKG",53,2 2,1,"PAH", 1,1,329,0)
	1820	Suggested time to i nstall: no n-peak req uirement h ours.
	1821	"PKG",53,2 2,1,"PAH", 1,1,330,0)
	1822
	1823	"PKG",53,2 2,1,"PAH", 1,1,331,0)
	1824
	1825	"PKG",53,2 2,1,"PAH", 1,1,332,0)
	1826	1. Obtai n the file IB_2_568_ PRCA_PSO_B UNDLE_T1.K ID
	1827	"PKG",53,2 2,1,"PAH", 1,1,333,0)
	1828
	1829	"PKG",53,2 2,1,"PAH", 1,1,334,0)
	1830	2. From the Kernel Installat ion & Dist ribution S ystem menu , select
	1831	"PKG",53,2 2,1,"PAH", 1,1,335,0)
	1832	the I nstallatio n menu.
	1833	"PKG",53,2 2,1,"PAH", 1,1,336,0)
	1834
	1835	"PKG",53,2 2,1,"PAH", 1,1,337,0)
	1836	3. Use L oad a Dist ribution u sing IB_2_ 568_PRCA_P SO_BUNDLE_ T1.KID whe n
	1837	"PKG",53,2 2,1,"PAH", 1,1,338,0)
	1838	promp ted to Ent er a Host File name. You may need to ap pend a
	1839	"PKG",53,2 2,1,"PAH", 1,1,339,0)
	1840	direc tory name.
	1841	"PKG",53,2 2,1,"PAH", 1,1,340,0)
	1842
	1843	"PKG",53,2 2,1,"PAH", 1,1,341,0)
	1844	4. From this menu, you may s elect to u se the fol lowing opt ions
	1845	"PKG",53,2 2,1,"PAH", 1,1,342,0)
	1846	(when prompted for INSTAL L NAME, en ter IB2.0 568):
	1847	"PKG",53,2 2,1,"PAH", 1,1,343,0)
	1848	a . Verify Checksums in Transpo rt Global - This opt ion will
	1849	"PKG",53,2 2,1,"PAH", 1,1,344,0)
	1850	allow y ou to ensu re the int egrity of the routin es that ar e
	1851	"PKG",53,2 2,1,"PAH", 1,1,345,0)
	1852	in the transport global.
	1853	"PKG",53,2 2,1,"PAH", 1,1,346,0)
	1854	b . Print T ransport G lobal - Th is option will allow you to
	1855	"PKG",53,2 2,1,"PAH", 1,1,347,0)
	1856	view th e componen ts of the KIDS build .
	1857	"PKG",53,2 2,1,"PAH", 1,1,348,0)
	1858	c . Compare Transport Global to Current S ystem - Th is option
	1859	"PKG",53,2 2,1,"PAH", 1,1,349,0)
	1860	will al low you to view all changes th at will be made when
	1861	"PKG",53,2 2,1,"PAH", 1,1,350,0)
	1862	this pa tch is ins talled. I t compares all compo nents of
	1863	"PKG",53,2 2,1,"PAH", 1,1,351,0)
	1864	this pa tch (routi nes, DD's, templates , etc.).
	1865	"PKG",53,2 2,1,"PAH", 1,1,352,0)
	1866	d . Backup a Transpor t Global - This opti on will cr eate a
	1867	"PKG",53,2 2,1,"PAH", 1,1,353,0)
	1868	backup message of any routi nes export ed with th is patch.
	1869	"PKG",53,2 2,1,"PAH", 1,1,354,0)
	1870	It will not backu p any othe r changes such as DD 's or
	1871	"PKG",53,2 2,1,"PAH", 1,1,355,0)
	1872	templat es.
	1873	"PKG",53,2 2,1,"PAH", 1,1,356,0)
	1874
	1875	"PKG",53,2 2,1,"PAH", 1,1,357,0)
	1876	5. When prompted " Want KIDS to INHIBIT LOGONs du ring the i nstall?
	1877	"PKG",53,2 2,1,"PAH", 1,1,358,0)
	1878	NO//" respond N O.
	1879	"PKG",53,2 2,1,"PAH", 1,1,359,0)
	1880
	1881	"PKG",53,2 2,1,"PAH", 1,1,360,0)
	1882	6. When prompted " Want to DI SABLE Sche duled Opti ons, Menu Options,
	1883	"PKG",53,2 2,1,"PAH", 1,1,361,0)
	1884	and P rotocols? NO//" resp ond NO.
	1885	"PKG",53,2 2,1,"PAH", 1,1,362,0)
	1886
	1887	"PKG",53,2 2,1,"PAH", 1,1,363,0)
	1888
	1889	"PKG",53,2 2,1,"PAH", 1,1,364,0)
	1890
	1891	"PKG",53,2 2,1,"PAH", 1,1,365,0)
	1892	Post-Insta llation In structions :
	1893	"PKG",53,2 2,1,"PAH", 1,1,366,0)
	1894	---------- ---------- ---------- -
	1895	"PKG",53,2 2,1,"PAH", 1,1,367,0)
	1896	There are no special tasks to perform af ter this p atch insta llation.
	1897	"QUES","XP F1",0)
	1898	Y
	1899	"QUES","XP F1","??")
	1900	^D REP^XPD H
	1901	"QUES","XP F1","A")
	1902	Shall I wr ite over y our \|FLAG\| File
	1903	"QUES","XP F1","B")
	1904	YES
	1905	"QUES","XP F1","M")
	1906	D XPF1^XPD IQ
	1907	"QUES","XP F2",0)
	1908	Y
	1909	"QUES","XP F2","??")
	1910	^D DTA^XPD H
	1911	"QUES","XP F2","A")
	1912	Want my da ta \|FLAG\| yours
	1913	"QUES","XP F2","B")
	1914	YES
	1915	"QUES","XP F2","M")
	1916	D XPF2^XPD IQ
	1917	"QUES","XP I1",0)
	1918	YO
	1919	"QUES","XP I1","??")
	1920	^D INHIBIT ^XPDH
	1921	"QUES","XP I1","A")
	1922	Want KIDS to INHIBIT LOGONs du ring the i nstall
	1923	"QUES","XP I1","B")
	1924	NO
	1925	"QUES","XP I1","M")
	1926	D XPI1^XPD IQ
	1927	"QUES","XP M1",0)
	1928	PO^VA(200, :EM
	1929	"QUES","XP M1","??")
	1930	^D MG^XPDH
	1931	"QUES","XP M1","A")
	1932	Enter the Coordinato r for Mail Group '\|F LAG\|'
	1933	"QUES","XP M1","B")
	1934
	1935	"QUES","XP M1","M")
	1936	D XPM1^XPD IQ
	1937	"QUES","XP O1",0)
	1938	Y
	1939	"QUES","XP O1","??")
	1940	^D MENU^XP DH
	1941	"QUES","XP O1","A")
	1942	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	1943	"QUES","XP O1","B")
	1944	NO
	1945	"QUES","XP O1","M")
	1946	D XPO1^XPD IQ
	1947	"QUES","XP Z1",0)
	1948	Y
	1949	"QUES","XP Z1","??")
	1950	^D OPT^XPD H
	1951	"QUES","XP Z1","A")
	1952	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	1953	"QUES","XP Z1","B")
	1954	NO
	1955	"QUES","XP Z1","M")
	1956	D XPZ1^XPD IQ
	1957	"QUES","XP Z2",0)
	1958	Y
	1959	"QUES","XP Z2","??")
	1960	^D RTN^XPD H
	1961	"QUES","XP Z2","A")
	1962	Want to MO VE routine s to other CPUs
	1963	"QUES","XP Z2","B")
	1964	NO
	1965	"QUES","XP Z2","M")
	1966	D XPZ2^XPD IQ
	1967	"RTN")
	1968	11
	1969	"RTN","PRC ABD")
	1970	0^9^B17130 552
	1971	"RTN","PRC ABD",1,0)
	1972	PRCABD ;SF -ISC/RSD-D ISPLAY/PRI NT BILL ;1 2/15/95 1 0:54
	1973	"RTN","PRC ABD",2,0)
	1974	V ;;4.5;Ac counts Rec eivable; 29,57,104, 109,154,23 3,315;20 -MAR-95;Bu ild 11
	1975	"RTN","PRC ABD",3,0)
	1976	;Per VA D irective 6 402, this routine sh ould not b e modified .
	1977	"RTN","PRC ABD",4,0)
	1978	;
	1979	"RTN","PRC ABD",5,0)
	1980	DEV Q:'$D( PRCABT) K ZTSAVE S %ZIS="QM" D ^%ZIS Q: POP G EN: IO=IO(0)
	1981	"RTN","PRC ABD",6,0)
	1982	I $D(IO(" Q")) S ZTR TN=$S(PRCA BT=3:"EN^P RCABD",1:" ^PRCABP"_P RCABT),ZTD TH=$H,ZTSA VE("D0")=" ",ZTSAVE(" PRCABT")=" ",ZTSAVE(" PRCADFM")= "" D ^%ZTL OAD G Q
	1983	"RTN","PRC ABD",7,0)
	1984	U IO
	1985	"RTN","PRC ABD",8,0)
	1986	EN Q:'$D(D 0) S PRCA D0=$G(^PRC A(430,D0,0 )),PRCAD10 =$G(^(100) ),PRCAD14= $G(^(104)) G Q:PRCAD 0=""!(PRCA D10="")
	1987	"RTN","PRC ABD",9,0)
	1988	S $P(PRCA DUL,"-",80 )="-" W @I OF,"BILL # : ",$P(PRC AD0,U,1),? 30,"DATE: " S Y=$P(P RCAD0,U,10 ) D DT W ? 60,"TYPE: ",$P("1081 ^1080^1114 ","^",PRCA BT),!,"DEB TOR: ",?40 ,"BILLING AGENCY: ", !
	1989	"RTN","PRC ABD",10,0)
	1990	S Y=+$P(P RCAD0,U,9) ,X=$S($D(^ RCD(340,Y, 0)):$P(^(0 ),U,1),1:" "),X(1)="" S:X]"" X( 1)=$S($D(@ ("^"_$P(X, ";",2)_+X_ ",0)")):$P (^(0),U,1) ,1:"")
	1991	"RTN","PRC ABD",11,0)
	1992	S PRCADB= $S($D(^RCD (340,+$P(P RCAD0,"^", 9),0)):$P( ^(0),"^"), 1:"") S X= $$DADD^RCA MADD(PRCAD B) K PRCAD B S J=2 D ADD
	1993	"RTN","PRC ABD",12,0)
	1994	S Y=+$P(P RCAD10,U,7 ),X(6)=$P( $G(^RC(342 .1,+Y,0)), "^"),X=$$S ADD^RCFN01 (+Y_";RC(3 42.1,"),J= 7 D ADD F I=1:1:5 I $D(X(I))!( $D(X(I+5)) ) W !?1 W: $D(X(I)) X (I) W ?41 W:$D(X(I+5 )) X(I+5)
	1995	"RTN","PRC ABD",13,0)
	1996	;*** P ROBABLY WA NT TO ENTE R ACCT LIN E INFO HER E ***
	1997	"RTN","PRC ABD",14,0)
	1998	W !!,"CON TROL POINT :"
	1999	"RTN","PRC ABD",15,0)
	2000	W ?17,$P( $G(^PRCA(4 30,D0,11)) ,U)
	2001	"RTN","PRC ABD",16,0)
	2002	W ! W:PRC ABT=1 !?40 ,"AGENCY L OCATION CO DE: ",$P(P RCAD10,U,3 ) W !,"APP ROVING OFF ICIAL: "
	2003	"RTN","PRC ABD",17,0)
	2004	I $P(PRCA D14,U,2)]" " S X=$P(P RCAD14,U,2 ),P=+PRCAD 14,DA=D0 D DE^PRCASI G(.X,P,DA_ +$P(PRCAD0 ,U,3)) W " /ES/ ",X," DATE: " S Y=$P(PR CAD14,U,3) D DT
	2005	"RTN","PRC ABD",18,0)
	2006	W ! F I=0 :0 S I=$O( ^PRCA(430, D0,2,I)) Q :'I I $D( ^(I,0)) S X=^(0) W ! ,"FY: ",$P (X,U,1),?1 2,"APPR. S YMBOL: ",$ P($G(^PRCA (430,D0,11 )),U,17),? 50,"AMOUNT : ",$J($P( X,U,2),10, 2)
	2007	"RTN","PRC ABD",19,0)
	2008	D DES(D0, PRCABT)
	2009	"RTN","PRC ABD",20,0)
	2010	;PRCA4.5 315 Print Beneficia ry Travel Notice
	2011	"RTN","PRC ABD",21,0)
	2012	D BENEPRT ^PRCABIL1
	2013	"RTN","PRC ABD",22,0)
	2014	Q D ^%ZISC K DA,DIWL ,DIWR,DIWF ,FLN,I,J,P ,PRCAD,PRC AD0,PRCAD1 0,PRCAD14, PRCADFM,PR CADI,PRCAD I0,PRCADQ, PRCADUL,X, Y,Z,ZTDTH, ZTRTN,ZTSA VE,%ZIS Q
	2015	"RTN","PRC ABD",23,0)
	2016	DES(D0,PRC ABT) ;also entry fro m letter r outine
	2017	"RTN","PRC ABD",24,0)
	2018	NEW DIWF, DIWL,DIWR, FLN,PRCAD, PRCADI,PRC ADI0,PRCAD Q
	2019	"RTN","PRC ABD",25,0)
	2020	W !! D HD R S (PRCAD Q,PRCADI)= 0
	2021	"RTN","PRC ABD",26,0)
	2022	DESL S PRC ADI=$O(^PR CA(430,D0, 101,PRCADI )) G:'PRCA DI DESQ S PRCADI0=^( PRCADI,0), PRCAD=0,DI WL=1,DIWR= 50,DIWF="" K ^UTILIT Y($J,"W"), FLN
	2023	"RTN","PRC ABD",27,0)
	2024	F S PRCA D=$O(^PRCA (430,D0,10 1,PRCADI,1 ,PRCAD)) Q :'PRCAD S X=$S($D(^ (PRCAD,0)) :^(0),1:"" ) D ^DIWP
	2025	"RTN","PRC ABD",28,0)
	2026	I $D(^UTI LITY($J,"W ",DIWL)) F I=0:0 S I =$O(^UTILI TY($J,"W", DIWL,I)) Q :'I S DIW F=^(I,0) D :'$D(FLN) FLN Q:PRCA DQ I $D(F LN),DIWF'= "" W !,?11 ,DIWF
	2027	"RTN","PRC ABD",29,0)
	2028	I '$D(FLN ) D FLN
	2029	"RTN","PRC ABD",30,0)
	2030	K ^UTILIT Y($J,"W") W !! G:'PR CADQ DESL
	2031	"RTN","PRC ABD",31,0)
	2032	DESQ Q
	2033	"RTN","PRC ABD",32,0)
	2034	FLN ;first line of d etail afte r descript ion
	2035	"RTN","PRC ABD",33,0)
	2036	Q:$D(FLN) D ASK Q: PRCADQ S FLN=1
	2037	"RTN","PRC ABD",34,0)
	2038	W:PRCABT= 2 $P(PRCAD I0,U,7),?1 1 S Y=$P(P RCADI0,U,1 ) D DT
	2039	"RTN","PRC ABD",35,0)
	2040	W ?11 I $ L($G(DIWF) )<25 W DIW F S DIWF=" "
	2041	"RTN","PRC ABD",36,0)
	2042	W:$P(PRCA DI0,U,3)]" " ?37,$J($ S($P(PRCAD I0,U,3)?1" .".N:"0"_$ P(PRCADI0, U,3),1:$P( PRCADI0,U, 3)),8)
	2043	"RTN","PRC ABD",37,0)
	2044	W:$P(PRCA DI0,U,4)]" " ?47,$J($ P(PRCADI0, U,4),12,4) W ?62,$S( $D(^PRCD(4 20.5,+$P(P RCADI0,U,5 ),0)):$P(^ (0),U,1),1 :"")
	2045	"RTN","PRC ABD",38,0)
	2046	W ?65,$J( $P(PRCADI0 ,U,6),15,2 )
	2047	"RTN","PRC ABD",39,0)
	2048	Q
	2049	"RTN","PRC ABD",40,0)
	2050	ASK I $E(I OST,1,2)=" C-",($Y+4) >IOSL W !? 8,"ENTER ' ^' TO HALT : " R X:DT IME S:X["^ "!'$T PRCA DQ=1 Q:PRC ADQ W @IO F D HDR Q
	2051	"RTN","PRC ABD",41,0)
	2052	I $E(IOST ,1,2)'="C- ",($Y+4)>I OSL W @IOF D HDR
	2053	"RTN","PRC ABD",42,0)
	2054	Q
	2055	"RTN","PRC ABD",43,0)
	2056	HDR I PRCA BT=2 W !," ORDER NO." ,?11,"DATE ",?37,"QUA NTITY",?55 ,"COST",?6 1,"PER",?7 4,"AMOUNT"
	2057	"RTN","PRC ABD",44,0)
	2058	E W !," DATE",?11, "DESCRIPTI ON",?37,"Q UANTITY",? 55,"COST", ?61,"PER", ?74,"AMOUN T"
	2059	"RTN","PRC ABD",45,0)
	2060	I '$D(PRC ADUL) S PR CADUL="",$ P(PRCADUL, "_",80)="_ "
	2061	"RTN","PRC ABD",46,0)
	2062	W !,PRCAD UL,! Q
	2063	"RTN","PRC ABD",47,0)
	2064	ADD F I=1: 1:4 S:I<4& ($P(X,U,I) ]"") X(J)= $P(X,U,I), J=J+1 I I= 4 S X(J)=$ P(X,U,4) S :$P(X,U,5) '="" X(J)= X(J)_", "_ $P(X,U,5)_ " "_$P(X,U ,6)
	2065	"RTN","PRC ABD",48,0)
	2066	Q
	2067	"RTN","PRC ABD",49,0)
	2068	DT Q:Y="" W $$SLH^R CFN01(Y,"/ ")_" " Q
	2069	"RTN","PRC ABD",50,0)
	2070	EN1 ;PRINT /DISPLAY B ILL
	2071	"RTN","PRC ABD",51,0)
	2072	EN10 D SVC ^PRCABIL G EN1Q:'$D( PRCAP("S") ) S DIC("S ")="S Z0=$ S($D(^PRCA (430.3,+$P (^(0),U,8) ,0)):$P(^( 0),U,3),1: 0) I Z0=20 5,$D(^PRCA (430,Y,100 )),+$P(^(1 00),U,2)=" _PRCAP("S" )
	2073	"RTN","PRC ABD",52,0)
	2074	D BILLN^P RCAUTL G E N1Q:'$D(PR CABN) S PR CABT=+^PRC A(430,PRCA BN,100) G EN1Q:'PRCA BT S D0=PR CABN,PRCAD FM=1 D DEV ,EN1Q G EN 10
	2075	"RTN","PRC ABD",53,0)
	2076	EN1Q K D0, DIC,PRCA,P RCABN,PRCA DFM,PRCAP, PRCABT,PRC ATY,Z0,ZTS K Q
	2077	"RTN","PRC ABIL1")
	2078	0^8^B52008 190
	2079	"RTN","PRC ABIL1",1,0 )
	2080	PRCABIL1 ; SF-ISC/RSD - ENTER B ILL INFO ; 10/16/96 7:04 PM
	2081	"RTN","PRC ABIL1",2,0 )
	2082	V ;;4.5;Ac counts Rec eivable; 57,64,109, 147,220,27 6,315;20 -MAR-95;Bu ild 11
	2083	"RTN","PRC ABIL1",3,0 )
	2084	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2085	"RTN","PRC ABIL1",4,0 )
	2086	;
	2087	"RTN","PRC ABIL1",5,0 )
	2088	EN1 ;ENTER NEW BILL
	2089	"RTN","PRC ABIL1",6,0 )
	2090	D ST Q:'% N CP
	2091	"RTN","PRC ABIL1",7,0 )
	2092	EN10 D EN^ PRCABIL2 G Q:'$D(PRC ABN) S $P( ^PRCA(430, PRCABN,0), "^",8)=$O( ^PRCA(430. 3,"AC",201 ,0)) D EN G EN10
	2093	"RTN","PRC ABIL1",8,0 )
	2094	EN2 ;EDIT BILL
	2095	"RTN","PRC ABIL1",9,0 )
	2096	EN20 D SVC ^PRCABIL Q :'$D(PRCAP ("S")) S DIC("S")=" S Z0=$S($D (^PRCA(430 .3,+$P(^(0 ),U,8),0)) :$P(^(0),U ,3),1:0) I Z0>199,Z0 <210,'$P($ G(^PRCA(43 0,Y,3)),U, 3),+$P($G( ^(100)),U, 2)="_PRCAP ("S")
	2097	"RTN","PRC ABIL1",10, 0)
	2098	D BILLN^P RCAUTL G Q :'$D(PRCAB N) D EN G EN20
	2099	"RTN","PRC ABIL1",11, 0)
	2100	EN4 ;CANCE L BILL
	2101	"RTN","PRC ABIL1",12, 0)
	2102	EN40 D SVC ^PRCABIL Q :'$D(PRCAP ("S")) S DIC("S")=" S Z0=$S($D (^PRCA(430 .3,+$P(^(0 ),U,8),0)) :$P(^(0),U ,3),1:0) I Z0>199,Z0 <210,$D(^P RCA(430,Y, 100)),+$P( ^(100),U,2 )="_PRCAP( "S")
	2103	"RTN","PRC ABIL1",13, 0)
	2104	D BILLN^P RCAUTL G Q :'$D(PRCAB N)
	2105	"RTN","PRC ABIL1",14, 0)
	2106	YN S %=2 W !," Sure you want to cancel this Bill" D YN^DICN
	2107	"RTN","PRC ABIL1",15, 0)
	2108	I %=0 W ! ,*7,"Answe r 'Yes' or 'No' " G YN
	2109	"RTN","PRC ABIL1",16, 0)
	2110	I %'=1 D Q G EN40
	2111	"RTN","PRC ABIL1",17, 0)
	2112	S $P(^PRC A(430,PRCA BN,0),"^", 14)=DT,$P( ^(0),"^",1 7)=DUZ,$P( ^(9),"^",6 )=$P(^(0), "^",8),PRC A("STATUS" )=$O(^PRCA (430.3,"AC ",210,0)) D UPSTATS^ PRCAUT2 K PRCA("STAT US") D Q G EN40
	2113	"RTN","PRC ABIL1",18, 0)
	2114	EN K PRCAD FM S DA=PR CABN D LCK G Q:'$D(D A)
	2115	"RTN","PRC ABIL1",19, 0)
	2116	S DIE="^P RCA(430,"
	2117	"RTN","PRC ABIL1",20, 0)
	2118	I $D(RCAM END) S X=+ ^PRCA(430, DA,100) I X?1N,X<4,X >0 G FORM
	2119	"RTN","PRC ABIL1",21, 0)
	2120	S DR="100 " D ^DIE G :X'?1N Q
	2121	"RTN","PRC ABIL1",22, 0)
	2122	FORM N PRC ACAT,PRCAF UND,PRCABE NE,PRCACA, PRCATYP,PR CAADD,PRCA NAD,PRCAAD 1D,PRCAAD2 D,PRCACD,P RCASTD
	2123	"RTN","PRC ABIL1",23, 0)
	2124	N PRCAZPD ,PRCAPHD,P RCANM,PRCA PH,PRCAADD 1,PRCAADD2 ,PRCACSZ,P RCACSZD
	2125	"RTN","PRC ABIL1",24, 0)
	2126	S PRCABEN E=0
	2127	"RTN","PRC ABIL1",25, 0)
	2128	S DR="[PR CA BILL "_ $P("1081^1 080^1114", "^",X)_"]" ,PRCABT=X D ^DIE
	2129	"RTN","PRC ABIL1",26, 0)
	2130	S:$D(DUZ) $P(^PRCA( 430,PRCABN ,9),U,8)=D UZ
	2131	"RTN","PRC ABIL1",27, 0)
	2132	S PRCACAT =$P(^PRCA( 430,PRCABN ,0),U,2)
	2133	"RTN","PRC ABIL1",28, 0)
	2134	;PRCA4.5 315 New P rompt for Beneficiar y Travel i f Category is VENDOR
	2135	"RTN","PRC ABIL1",29, 0)
	2136	I PRCACAT =17 D
	2137	"RTN","PRC ABIL1",30, 0)
	2138	.N Y,X
	2139	"RTN","PRC ABIL1",31, 0)
	2140	.W !!
	2141	"RTN","PRC ABIL1",32, 0)
	2142	.S DIR("A ")="IS THI S FOR VETE RANS BENEF ICIARY TRA VEL? "
	2143	"RTN","PRC ABIL1",33, 0)
	2144	.S DIR("? ")="Please answer Ye s or No."
	2145	"RTN","PRC ABIL1",34, 0)
	2146	.S DIR("B ")="NO",DI R(0)="YA^^ "
	2147	"RTN","PRC ABIL1",35, 0)
	2148	.D ^DIR K DIR
	2149	"RTN","PRC ABIL1",36, 0)
	2150	.I Y(0)=" YES" D
	2151	"RTN","PRC ABIL1",37, 0)
	2152	..S PRCAB ENE=1
	2153	"RTN","PRC ABIL1",38, 0)
	2154	..S PRCAC A=$O(^RC(3 42.1,"B"," AGENT CASH IER",0))
	2155	"RTN","PRC ABIL1",39, 0)
	2156	..S PRCAT YP=$P(^RC( 342.1,PRCA CA,0),U,2)
	2157	"RTN","PRC ABIL1",40, 0)
	2158	..S PRCAA DD=$$SADD^ RCFN01(PRC ATYP)
	2159	"RTN","PRC ABIL1",41, 0)
	2160	..I $G(PR CAADD)'="" D
	2161	"RTN","PRC ABIL1",42, 0)
	2162	...S PRCA NAD=$P(PRC AADD,U),PR CAAD1D=$P( PRCAADD,U, 2),PRCAAD2 D=$P(PRCAA DD,U,3),PR CACD=$P(PR CAADD,U,4)
	2163	"RTN","PRC ABIL1",43, 0)
	2164	...S PRCA STD=$P(PRC AADD,U,5), PRCAZPD=$P (PRCAADD,U ,6),PRCAPH D=$P(PRCAA DD,U,7)
	2165	"RTN","PRC ABIL1",44, 0)
	2166	...S PRCA CSZD=PRCAC D_", "_PRC ASTD_" "_ PRCAZPD
	2167	"RTN","PRC ABIL1",45, 0)
	2168	..N Y,X
	2169	"RTN","PRC ABIL1",46, 0)
	2170	..S DIR(" A")="Enter Agent Cas hier Name: "
	2171	"RTN","PRC ABIL1",47, 0)
	2172	..I $G(PR CANAD)'="" S DIR("B" )=PRCANAD
	2173	"RTN","PRC ABIL1",48, 0)
	2174	..S DIR(" ?")="Pleas e enter Ag ent Cashie r Name."
	2175	"RTN","PRC ABIL1",49, 0)
	2176	..S DIR(0 )="FA^^"
	2177	"RTN","PRC ABIL1",50, 0)
	2178	..D ^DIR K DIR
	2179	"RTN","PRC ABIL1",51, 0)
	2180	..S PRCAN M=Y
	2181	"RTN","PRC ABIL1",52, 0)
	2182	..N Y,X
	2183	"RTN","PRC ABIL1",53, 0)
	2184	..S DIR(" A")="Enter Agent Cas hier Phone Number: "
	2185	"RTN","PRC ABIL1",54, 0)
	2186	..I $G(PR CAPHD)'="" S DIR("B" )=PRCAPHD
	2187	"RTN","PRC ABIL1",55, 0)
	2188	..S DIR(" ?")="Pleas e enter a phone numb er."
	2189	"RTN","PRC ABIL1",56, 0)
	2190	..S DIR(0 )="FA^^"
	2191	"RTN","PRC ABIL1",57, 0)
	2192	..D ^DIR K DIR
	2193	"RTN","PRC ABIL1",58, 0)
	2194	..S PRCAP H=Y
	2195	"RTN","PRC ABIL1",59, 0)
	2196	..N Y,X
	2197	"RTN","PRC ABIL1",60, 0)
	2198	..S DIR(" A")="Enter Agent Cas hier Addre ss Line 1: "
	2199	"RTN","PRC ABIL1",61, 0)
	2200	..I $G(PR CAAD1D)'=" " S DIR("B ")=PRCAAD1 D
	2201	"RTN","PRC ABIL1",62, 0)
	2202	..S DIR(" ?")="Pleas e enter Ad dress Line 1."
	2203	"RTN","PRC ABIL1",63, 0)
	2204	..S DIR(0 )="FA^^"
	2205	"RTN","PRC ABIL1",64, 0)
	2206	..D ^DIR K DIR
	2207	"RTN","PRC ABIL1",65, 0)
	2208	..S PRCAA DD1=Y
	2209	"RTN","PRC ABIL1",66, 0)
	2210	..N Y,X
	2211	"RTN","PRC ABIL1",67, 0)
	2212	..S DIR(" A")="Enter Agent Cas hier Addre ss Line 2: "
	2213	"RTN","PRC ABIL1",68, 0)
	2214	..I $G(PR CAAD2D)'=" " S DIR("B ")=PRCAAD2 D
	2215	"RTN","PRC ABIL1",69, 0)
	2216	..S DIR(" ?")="Pleas e enter Ad dress Line 2."
	2217	"RTN","PRC ABIL1",70, 0)
	2218	..S DIR(0 )="FA^^"
	2219	"RTN","PRC ABIL1",71, 0)
	2220	..D ^DIR K DIR
	2221	"RTN","PRC ABIL1",72, 0)
	2222	..S PRCAA DD2=Y
	2223	"RTN","PRC ABIL1",73, 0)
	2224	..N Y,X
	2225	"RTN","PRC ABIL1",74, 0)
	2226	..S DIR(" A")="Enter Agent Cas hier City, State ZI P: "
	2227	"RTN","PRC ABIL1",75, 0)
	2228	..I $G(PR CACSZD)'=" " S DIR("B ")=PRCACSZ D
	2229	"RTN","PRC ABIL1",76, 0)
	2230	..S DIR(" ?")="Pleas e enter Ci ty, State ZIP."
	2231	"RTN","PRC ABIL1",77, 0)
	2232	..S DIR(0 )="FA^^"
	2233	"RTN","PRC ABIL1",78, 0)
	2234	..D ^DIR K DIR
	2235	"RTN","PRC ABIL1",79, 0)
	2236	..S PRCAC SZ=Y
	2237	"RTN","PRC ABIL1",80, 0)
	2238	I PRCACAT >39,PRCACA T<45 D
	2239	"RTN","PRC ABIL1",81, 0)
	2240	.S X=PRCA CAT,PRCAFU ND=$S(X=40 :"05",X=41 :"06",X=42 :"07",X=43 :"08",1:"1 0"),PRCAFU ND=5287_PR CAFUND
	2241	"RTN","PRC ABIL1",82, 0)
	2242	.S DR="25 9////"_"09 ;203////^S X=PRCAFUN D"
	2243	"RTN","PRC ABIL1",83, 0)
	2244	.;I PRCAF UND'=52870 7 S DR=DR_ ";258////1 "
	2245	"RTN","PRC ABIL1",84, 0)
	2246	.D ^DIE
	2247	"RTN","PRC ABIL1",85, 0)
	2248	.Q
	2249	"RTN","PRC ABIL1",86, 0)
	2250	I $P(^PRC A(430,PRCA BN,0),U,9) =""!('$D(^ (100))!('$ D(^(101))) ) D MESG W !,"Bill i s incomple te and mus t be re-ed ited !",*7 G Q
	2251	"RTN","PRC ABIL1",87, 0)
	2252	D EN4^PRC ABIL S PRC AMT1=0,PRC AMTY=0,DIK ="^PRCA(43 0,PRCABN,2 ,"
	2253	"RTN","PRC ABIL1",88, 0)
	2254	F PRCAI=0 :0 S PRCAI =$O(^PRCA( 430,PRCABN ,2,PRCAI)) Q:'PRCAI I $D(^(PR CAI,0)) S X=^(0) I $ P(X,"^",8) ]"" S PRCA MT1=PRCAMT 1+$P(X,"^" ,8),PRCAMT Y=PRCAMTY+ 1
	2255	"RTN","PRC ABIL1",89, 0)
	2256	I 'PRCAMT 1 W !!,"Fi scal Year Amount was not enter ed ! Bill is incomp lete",*7 G Q
	2257	"RTN","PRC ABIL1",90, 0)
	2258	I PRCAMTY >1 W !!,"M ultiple Fi scal Years are not a llowed at this time !",!,"Bill is incomp lete and m ust be re- edited.",* 7 G Q
	2259	"RTN","PRC ABIL1",91, 0)
	2260	;S DIE=DI K,DA(1)=PR CABN,DA=+$ O(^PRCA(43 0,PRCABN,2 ,0)),DR=". 01;7" S:'D A ^PRCA(43 0,PRCABN,2 ,0)="^430. 01" D ^DIE
	2261	"RTN","PRC ABIL1",92, 0)
	2262	I PRCAMT1 '=PRCAMT,P RCABT'=1 W !!,"Fisca l Year Amo unts do no t equal th e total bi ll amount !",!,"Bill is incomp lete and m ust be re- edited !", *7 G Q
	2263	"RTN","PRC ABIL1",93, 0)
	2264	I PRCAMT1 '=PRCAMT,P RCABT=1 D ;
	2265	"RTN","PRC ABIL1",94, 0)
	2266	. N DIE,D A,DR
	2267	"RTN","PRC ABIL1",95, 0)
	2268	. S PRCAM T1=PRCAMT
	2269	"RTN","PRC ABIL1",96, 0)
	2270	. S DIE=" ^PRCA(430, PRCABN,2,"
	2271	"RTN","PRC ABIL1",97, 0)
	2272	. S DA(1) =PRCABN
	2273	"RTN","PRC ABIL1",98, 0)
	2274	. S DA=+$ O(^PRCA(43 0,PRCABN,2 ,0))
	2275	"RTN","PRC ABIL1",99, 0)
	2276	. S DR="1 ///"_PRCAM T1
	2277	"RTN","PRC ABIL1",100 ,0)
	2278	. QUIT:'D A
	2279	"RTN","PRC ABIL1",101 ,0)
	2280	. ;
	2281	"RTN","PRC ABIL1",102 ,0)
	2282	. DO ^DIE
	2283	"RTN","PRC ABIL1",103 ,0)
	2284	;
	2285	"RTN","PRC ABIL1",104 ,0)
	2286	S Y=$P(^P RCA(430,PR CABN,0),"^ ",9),Y=Y_" ^"_$P(^RCD (340,Y,0), "^",1)
	2287	"RTN","PRC ABIL1",105 ,0)
	2288	G:$P(Y,"; ",2)="DPT( "!($P(Y,"; ",2)="DIC( 36,") CONT
	2289	"RTN","PRC ABIL1",106 ,0)
	2290	S PRCANOD E=.11 S:$P (Y,";",2)= "DIC(4," P RCANODE=1 S PRCANODE ="^"_$P(Y, ";",2)_+$P (Y,"^",2)_ ","_PRCANO DE_")",PRC ANODE=$G(@ PRCANODE)
	2291	"RTN","PRC ABIL1",107 ,0)
	2292	I $P(PRCA NODE,"^",1 )="" S DR= $P(Y,"^",2 ),%=1 W !, " (No Stre et Address ) Edit De btor Addre ss: " D YN ^DICN,EN1^ RCAM(DR):% =1 K DIE,D R,DA
	2293	"RTN","PRC ABIL1",108 ,0)
	2294	CONT S Y=^ PRCA(430,P RCABN,0),$ P(Y,"^",3) =PRCAMT,PR CA("STATUS ")=$O(^PRC A(430.3,"A C",205,0)) ,^PRCA(430 ,PRCABN,0) =Y,$P(^PRC A(430,PRCA BN,7),"^") =PRCAMT
	2295	"RTN","PRC ABIL1",109 ,0)
	2296	I '$D(RCA MEND) S DI E="^PRCA(4 30,",DA=PR CABN,DR="8 ////"_PRCA ("STATUS") _"" D ^DIE K DIE,DR, DA
	2297	"RTN","PRC ABIL1",110 ,0)
	2298	DISP S %=1 ,PRCADFM=1 W !," D isplay/Pri nt Bill:"
	2299	"RTN","PRC ABIL1",111 ,0)
	2300	K IOP D Y N^DICN
	2301	"RTN","PRC ABIL1",112 ,0)
	2302	I %=0 W ! ,*7,"Answe r 'Yes' or 'No' " G DISP
	2303	"RTN","PRC ABIL1",113 ,0)
	2304	D ^PRCABD :%=1
	2305	"RTN","PRC ABIL1",114 ,0)
	2306	Q L -^PRCA (430,+$G(P RCABN),0)
	2307	"RTN","PRC ABIL1",115 ,0)
	2308	K %,%Y,A, B,C,D0,DA, DIC,DIE,DI K,DR,I,PRC A,PRCABC,P RCABN,PRCA BT,PRCADFM ,PRCAI,PRC AKCT,PRCAN M,PRCARN,P RCATIME,PR CAMT,PRCAM TY,PRCANM, PRCANODE,P RCAMT1,PRC AMT2,PRCAQ ,PRCAP,PRC AT,PRCATY, PRCAX,X,Y, Z0,ZRTN,ZT SK Q
	2309	"RTN","PRC ABIL1",116 ,0)
	2310	LCK L +^PR CA(430,DA, 0):0 I Q
	2311	"RTN","PRC ABIL1",117 ,0)
	2312	W !,"ANOT HER USER I S EDITING THIS ENTRY !" K DA Q
	2313	"RTN","PRC ABIL1",118 ,0)
	2314	CP ;CONTRO L POINT LO OK-UP
	2315	"RTN","PRC ABIL1",119 ,0)
	2316	N DIC,PRC ,DIE,DA,DR ,X,Y,PRCSI P,PRCSI
	2317	"RTN","PRC ABIL1",120 ,0)
	2318	S PRC("SI TE")=$S($G (PRCA("SIT E")):PRCA( "SITE"),1: $$SITE^RCM SITE)
	2319	"RTN","PRC ABIL1",121 ,0)
	2320	;S PRC("S ITE")=$$SI TE^RCMSITE
	2321	"RTN","PRC ABIL1",122 ,0)
	2322	S DIC("B" )=$P($G(^P RCA(430,PR CABN,11)), U)
	2323	"RTN","PRC ABIL1",123 ,0)
	2324	D CP^PRCS UT I '$G(P RC("CP")) Q
	2325	"RTN","PRC ABIL1",124 ,0)
	2326	I PRC("CP ")<0 Q
	2327	"RTN","PRC ABIL1",125 ,0)
	2328	S $P(^PRC A(430,PRCA BN,11),U)= PRC("CP")
	2329	"RTN","PRC ABIL1",126 ,0)
	2330	Q
	2331	"RTN","PRC ABIL1",127 ,0)
	2332	BENEPRT ;P RCA4.531 5 Benefici ary Travel Notice of Rights an d Responsi bilities
	2333	"RTN","PRC ABIL1",128 ,0)
	2334	I $G(PRCA BENE) D
	2335	"RTN","PRC ABIL1",129 ,0)
	2336	.N LINE,B ENELTR,DIW F,DIWL,DIW R,IOSLSAVE ,PRNT
	2337	"RTN","PRC ABIL1",130 ,0)
	2338	.S BENELT R=$O(^RC(3 43,"B","BE NEFICIARY TRAVEL NOT ICE",0))
	2339	"RTN","PRC ABIL1",131 ,0)
	2340	.K ^UTILI TY($J) ;pr int main b ody text f rom 343
	2341	"RTN","PRC ABIL1",132 ,0)
	2342	.S ^UTILI TY($J,1)=" W "_IOF
	2343	"RTN","PRC ABIL1",133 ,0)
	2344	.S IOSLSA VE=IOSL,IO SL=140
	2345	"RTN","PRC ABIL1",134 ,0)
	2346	.U IO
	2347	"RTN","PRC ABIL1",135 ,0)
	2348	.W #
	2349	"RTN","PRC ABIL1",136 ,0)
	2350	.F LINE=0 :0 S LINE= $O(^RC(343 ,BENELTR,1 ,LINE)) Q: 'LINE S X =$G(^(LINE ,0)) I X]" " W:($Y+2) >IOSL @IOF S DIWL=1, DIWR=80,DI WF="N" D ^ DIWP
	2351	"RTN","PRC ABIL1",137 ,0)
	2352	.D ^DIWW S:$G(PRNT) ="FL" PRNT =1 K ^UTIL ITY($J)
	2353	"RTN","PRC ABIL1",138 ,0)
	2354	.S IOSL=I OSLSAVE
	2355	"RTN","PRC ABIL1",139 ,0)
	2356	.W !,"Loc al Agent C ashier Con tact Infor mation"
	2357	"RTN","PRC ABIL1",140 ,0)
	2358	.W !," A gent Cashi er: ",$G(P RCANM)
	2359	"RTN","PRC ABIL1",141 ,0)
	2360	.W !," Office Pho ne: ",$G(P RCAPH)
	2361	"RTN","PRC ABIL1",142 ,0)
	2362	.W !,"Mai ling Addre ss: ",$G(P RCAADD1)
	2363	"RTN","PRC ABIL1",143 ,0)
	2364	.W !," ",$G(P RCAADD2)
	2365	"RTN","PRC ABIL1",144 ,0)
	2366	.W !," ",$G(P RCACSZ)
	2367	"RTN","PRC ABIL1",145 ,0)
	2368	Q
	2369	"RTN","PRC ABIL1",146 ,0)
	2370	;
	2371	"RTN","PRC ABIL1",147 ,0)
	2372	ST D CKSIT E^PRCAUDT S %=$D(PRC A("CKSITE" )) Q
	2373	"RTN","PRC ABIL1",148 ,0)
	2374	ST1 D SVC^ PRCABIL S %=$S($D(PR CAP("S")): 1,1:0) Q:%
	2375	"RTN","PRC ABIL1",149 ,0)
	2376	K PRCAP Q
	2377	"RTN","PRC ABIL1",150 ,0)
	2378	DIP D SVC^ PRCABIL Q: '$D(PRCAP( "S"))
	2379	"RTN","PRC ABIL1",151 ,0)
	2380	; PRCA4. 5276 - ad d '@' to B ILL NO. in the 'BY' paramter s o that pri ntout does not show it as a so rting fiel d.
	2381	"RTN","PRC ABIL1",152 ,0)
	2382	S FR=PRCA P("S")_",? ,@",TO=PRC AP("S")_", ?",L=0,DIC ="^PRCA(43 0,",FLDS=" [PRCA BILL LIST]",BY ="@INTERNA L(SERVICE) ,@BILL NO. ,FORM TYPE " D EN1^DI P K BY,DHD ,DIC,FLDS, FR,L,PRCAP ,TO Q
	2383	"RTN","PRC ABIL1",153 ,0)
	2384	MESG I $P( ^PRCA(430, PRCABN,0), U,9)="" W !,?3,"Debt or (or Pay er) data i s missing. "
	2385	"RTN","PRC ABIL1",154 ,0)
	2386	I '$D(^PR CA(430,PRC ABN,100)) W !,?3,"Se rvice (or Section) , Form type or Vouche r number d ata is mis sing."
	2387	"RTN","PRC ABIL1",155 ,0)
	2388	I '$D(^PR CA(430,PRC ABN,101)) W !,?3,"Da te of Char ge data do es not exi st."
	2389	"RTN","PRC ABIL1",156 ,0)
	2390	W ! Q
	2391	"RTN","PRC APCL")
	2392	0^11^B4153 2110
	2393	"RTN","PRC APCL",1,0)
	2394	PRCAPCL ;W ASH-ISC@AL TOONA,PA/N YB-Print B ill Status Report ;8 /19/94 10 :21 AM
	2395	"RTN","PRC APCL",2,0)
	2396	V ;;4.5;Ac counts Rec eivable; 72,63,143, 154,315; Mar 20, 19 95;Build 1 1
	2397	"RTN","PRC APCL",3,0)
	2398	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2399	"RTN","PRC APCL",4,0)
	2400	N BAL,BN, CAT,DEAD,D EBT,DIR,DI ROUT,DUOUT ,DP,DP2,HD R,IOP,N430
	2401	"RTN","PRC APCL",5,0)
	2402	N PAGE,PO P,PRCAE,PR CATOT,PRCA TOT2,PRCAT ,PRCAT2,PR CY,RCDOJ,T DT,ST,STT
	2403	"RTN","PRC APCL",6,0)
	2404	S (PAGE,P RCAT,PRCAT 2,PRCATOT, PRCATOT2,H DR)=0
	2405	"RTN","PRC APCL",7,0)
	2406	D NOW^%DT C S Y=% X ^DD("DD") S TDT=Y
	2407	"RTN","PRC APCL",8,0)
	2408	I $G(STAT )="ALL" S STT=0 F S STT=($O(^ PRCA(430.3 ,"AC",STT) )) Q:STT=" " D
	2409	"RTN","PRC APCL",9,0)
	2410	. I STT<1 00!(STT=10 7) Q
	2411	"RTN","PRC APCL",10,0 )
	2412	. S STAT( $O(^PRCA(4 30.3,"AC", STT,0)))=" "
	2413	"RTN","PRC APCL",11,0 )
	2414	. Q
	2415	"RTN","PRC APCL",12,0 )
	2416	S STAT=0 F S STAT= $O(STAT(ST AT)) Q:STA T=""!($D(D IROUT))!($ D(DUOUT)) D
	2417	"RTN","PRC APCL",13,0 )
	2418	. N NDE
	2419	"RTN","PRC APCL",14,0 )
	2420	. D HDR
	2421	"RTN","PRC APCL",15,0 )
	2422	. F PRCAE =0:0 S PRC AE=$O(^PRC A(430,"AC" ,STAT,PRCA E)),X="" Q :'PRCAE!($ D(DIROUT)! ($D(DUOUT) )) I $P($ G(^PRCA(43 0,PRCAE,10 0)),"^",2) [$G(SER),$ S($G(SER): +$G(^PRCA( 430,PRCAE, 100)),1:1) D Q:$D(D IROUT)!($D (DUOUT)) D PRNTL
	2423	"RTN","PRC APCL",16,0 )
	2424	.. I $Y+4 >IOSL D TO P,HDR
	2425	"RTN","PRC APCL",17,0 )
	2426	. I $Y+4> IOSL D TOP ,HDR Q:$D( DIROUT)!($ D(DUOUT))
	2427	"RTN","PRC APCL",18,0 )
	2428	. S DP1=$ S(+DAT>0:+ DAT,1:0)
	2429	"RTN","PRC APCL",19,0 )
	2430	. S DP2=$ S(+$P($G(D AT),"^",2) =0:"",1:+$ P($G(DAT), "^",2))
	2431	"RTN","PRC APCL",20,0 )
	2432	. S ST="" F S ST=$ O(^TMP($J, "PRCAE",ST )) Q:ST="" !($D(DIROU T)!($D(DUO UT))) D
	2433	"RTN","PRC APCL",21,0 )
	2434	.. I STAT =40 D STHD R
	2435	"RTN","PRC APCL",22,0 )
	2436	.. S DP=0 F S DP=$ O(^TMP($J, "PRCAE",ST ,DP)) Q:'D P!($D(DIRO UT)!($D(DU OUT))) D
	2437	"RTN","PRC APCL",23,0 )
	2438	... S BN= "" F S BN =$O(^TMP($ J,"PRCAE", ST,DP,BN)) Q:BN=""!( $D(DIROUT) !($D(DUOUT ))) D
	2439	"RTN","PRC APCL",24,0 )
	2440	.... S ND E=^TMP($J, "PRCAE",ST ,DP,BN)
	2441	"RTN","PRC APCL",25,0 )
	2442	.... S Y= DP X ^DD(" DD") S DP2 =Y K Y
	2443	"RTN","PRC APCL",26,0 )
	2444	.... S RC DOJ=$$REFS T^RCRCUTL( +$O(^PRCA( 430,"B",BN ,0)))
	2445	"RTN","PRC APCL",27,0 )
	2446	.... W $G (DP2),?15, $S(RCDOJ&$ G(BN):$G(B N)_"r",1:$ G(BN)),?30 ,$P(NDE,U, 2),?45,$P( NDE,U,3)
	2447	"RTN","PRC APCL",28,0 )
	2448	.... W ?6 5,$J($P(ND E,U,4),9,2 ),!
	2449	"RTN","PRC APCL",29,0 )
	2450	.... S PR CATOT2=PRC ATOT2+$P(N DE,U,4),PR CAT2=PRCAT 2+1
	2451	"RTN","PRC APCL",30,0 )
	2452	.... S PR CATOT=PRCA TOT+$P(NDE ,U,4),PRCA T=PRCAT+1
	2453	"RTN","PRC APCL",31,0 )
	2454	.... I $Y +4>IOSL D TOP,HDR Q: $D(DIROUT) !($D(DUOUT )) I STAT =40 D STHD R
	2455	"RTN","PRC APCL",32,0 )
	2456	.... K ^T MP($J,"PRC AE",ST,DP, BN)
	2457	"RTN","PRC APCL",33,0 )
	2458	. I X'="^ " W !!!,"S UBTOTAL: " ,$J(PRCATO T2,10,2),! ,"SUBCOUNT : ",$J(PRC AT2,10),?3 0 Q:$D(DIR OUT)!($D(D UOUT))
	2459	"RTN","PRC APCL",34,0 )
	2460	. S (PRCA TOT2,PRCAT 2)=0
	2461	"RTN","PRC APCL",35,0 )
	2462	. Q:$D(DI ROUT)!($D( DUOUT))
	2463	"RTN","PRC APCL",36,0 )
	2464	. I $O(ST AT(STAT))= "" Q
	2465	"RTN","PRC APCL",37,0 )
	2466	. I $O(ST AT(STAT))' ="" W !! D TOP
	2467	"RTN","PRC APCL",38,0 )
	2468	I X'="^" W !!!,"TOT AL: ",$J(P RCATOT,10, 2),!,"COUN T: ",$J(PR CAT,10),!, " MEAN: ", $J($S('PRC AT:0,1:PRC ATOT/PRCAT ),10,2),?3 0,"* -indi cates that patient i s deceased ",!,?30,"r -indicate s that bil l is refer red"
	2469	"RTN","PRC APCL",39,0 )
	2470	W:$E(IOST )="P" @IOF Q
	2471	"RTN","PRC APCL",40,0 )
	2472	TOP ;
	2473	"RTN","PRC APCL",41,0 )
	2474	I $E(IOST )="C" S X= "" S DIR(0 )="E" D ^D IR Q:$D(DI ROUT)!($D( DUOUT))
	2475	"RTN","PRC APCL",42,0 )
	2476	Q2 Q
	2477	"RTN","PRC APCL",43,0 )
	2478	PRNTL ;
	2479	"RTN","PRC APCL",44,0 )
	2480	N BAL,DEA D,DEBT,ST
	2481	"RTN","PRC APCL",45,0 )
	2482	S X=$S($D (^PRCA(430 ,PRCAE,0)) :^(0),1:"" ) G:X="" P Q
	2483	"RTN","PRC APCL",46,0 )
	2484	S BN=$P($ G(X),U),DP =$P($G(X), U,14),PRCY =$P($G(X), U,2) G:BN= "" PQ
	2485	"RTN","PRC APCL",47,0 )
	2486	S BEG=+DA T-1,END=+$ P(DAT,U,2)
	2487	"RTN","PRC APCL",48,0 )
	2488	S ST=999 I STAT=40 D SUST ;PR CA4.5315 /DRF Find suspended type
	2489	"RTN","PRC APCL",49,0 )
	2490	I BEG,DP' >BEG Q
	2491	"RTN","PRC APCL",50,0 )
	2492	I END,DP> END Q
	2493	"RTN","PRC APCL",51,0 )
	2494	I STAT=40 ,$G(PRSELS T)'="",PRS ELST'[("," _ST_",") Q ;PRCA4. 5315/DRF Quit if su spended ty pe is not selected
	2495	"RTN","PRC APCL",52,0 )
	2496	S (CAT,PR CY)=$S(PRC Y="":PRCY, $D(^PRCA(4 30.2,PRCY, 0))#2:$P(^ (0),U),1:P RCY)
	2497	"RTN","PRC APCL",53,0 )
	2498	S PRCY=$S ($D(^RCD(3 40,+$P(X,U ,9),0)):$P (^(0),U),1 :"")
	2499	"RTN","PRC APCL",54,0 )
	2500	I PRCY["D PT" S DFN= +PRCY D DE M^VADPT S: +VADM(6) D EAD="*" D KVAR^VADPT K VA,VADM
	2501	"RTN","PRC APCL",55,0 )
	2502	I PRCY]"" S (DEBT,P RCY)=$S($D (@("^"_$P( PRCY,";",2 )_+PRCY_", 0)")):^(0) ,1:"")
	2503	"RTN","PRC APCL",56,0 )
	2504	S PRCY=$S ($D(^PRCA( 430,PRCAE, 7)):^(7),1 :"")
	2505	"RTN","PRC APCL",57,0 )
	2506	I 'PRCY,( STAT=$O(^P RCA(430.3, "AC",104,0 ))!((STAT= 20)&($G(^P RCA(430,PR CAE,100))) ))
	2507	"RTN","PRC APCL",58,0 )
	2508	S (BAL,PR CY)=$P(PRC Y,U)+$P(PR CY,U,2)+$P (PRCY,U,3) +$P(PRCY,U ,4)+$P(PRC Y,U,5)
	2509	"RTN","PRC APCL",59,0 )
	2510	I DP'="" S ^TMP($J, "PRCAE",ST ,DP,BN)=U_ $E(CAT,1,1 3)_U_$G(DE AD)_$E($P( $G(DEBT),U ),1,15)_U_ $G(BAL)_U_ $G(PRCATOT 2)_U_$G(PR CAT2)
	2511	"RTN","PRC APCL",60,0 )
	2512	I $G(SER) ,(STAT=31! (STAT=32)) S Y=$G(^P RCA(430,PR CAE,3)) D
	2513	"RTN","PRC APCL",61,0 )
	2514	. W:$P(Y, U)]"" !,"D ate: ",$E( $P(Y,U),4, 5),"/",$E( $P(Y,U),6, 7),"/",$E( $P(Y,U),2, 3)
	2515	"RTN","PRC APCL",62,0 )
	2516	. W:$P(Y, U,2)]"" " By: ",$P( $G(^VA(200 ,+$P(Y,U,2 ),0)),U)
	2517	"RTN","PRC APCL",63,0 )
	2518	. W:$P(Y, U,6)]"" " Reason: " ,$P(Y,U,6)
	2519	"RTN","PRC APCL",64,0 )
	2520	. Q
	2521	"RTN","PRC APCL",65,0 )
	2522	I $E(IOST )="",$Y+4> IOSL D TOP
	2523	"RTN","PRC APCL",66,0 )
	2524	PQ Q
	2525	"RTN","PRC APCL",67,0 )
	2526	HDR ;
	2527	"RTN","PRC APCL",68,0 )
	2528	I $E(IOST )="C"!PAGE W @IOF
	2529	"RTN","PRC APCL",69,0 )
	2530	S PAGE=PA GE+1
	2531	"RTN","PRC APCL",70,0 )
	2532	W !,"BILL STATUS LI STING REPO RT"
	2533	"RTN","PRC APCL",71,0 )
	2534	W ?40,$G( TDT),?72,$ G(PAGE)
	2535	"RTN","PRC APCL",72,0 )
	2536	W !,"Sort Criteria for Date L ast Update d Range: " _SC1_" to "_SC2
	2537	"RTN","PRC APCL",73,0 )
	2538	W !,"Date Last",!," Updated", ?15,"Bill no.",?30," Category"
	2539	"RTN","PRC APCL",74,0 )
	2540	W ?50,"De btor",?68, "Balance", !
	2541	"RTN","PRC APCL",75,0 )
	2542	S X="",$P (X,"-",IOM -1)="" W X ,!
	2543	"RTN","PRC APCL",76,0 )
	2544	W !,?5,"S tatus: ",$ P($S($D(^P RCA(430.3, STAT,0)):^ (0),1:""), U)
	2545	"RTN","PRC APCL",77,0 )
	2546	S HDR=1
	2547	"RTN","PRC APCL",78,0 )
	2548	W !!
	2549	"RTN","PRC APCL",79,0 )
	2550	Q
	2551	"RTN","PRC APCL",80,0 )
	2552	DT I Y X ^ DD("DD") S DP2=Y
	2553	"RTN","PRC APCL",81,0 )
	2554	Q
	2555	"RTN","PRC APCL",82,0 )
	2556	STAT(SER) W ! ;Bill Status Lis ting
	2557	"RTN","PRC APCL",83,0 )
	2558	N BEG,CH, DAT,END,I, PRSELST,PR SUS,SC1,SC 2,STAT,STT ,XX
	2559	"RTN","PRC APCL",84,0 )
	2560	K ^TMP($J )
	2561	"RTN","PRC APCL",85,0 )
	2562	S DAT=$$D ATE^RCEVUT L1("")
	2563	"RTN","PRC APCL",86,0 )
	2564	Q:$G(DAT) =-1
	2565	"RTN","PRC APCL",87,0 )
	2566	S BEG=+DA T,END=+$P( DAT,U,2)
	2567	"RTN","PRC APCL",88,0 )
	2568	S SC1=$S( BEG=0:"Fir st",1:BEG- 1) I +$G(S C1) S Y=SC 1+1 X ^DD( "DD") S SC 1=Y
	2569	"RTN","PRC APCL",89,0 )
	2570	S SC2=$S( END=0:"Las t",1:END) I +$G(SC2) S Y=SC2 X ^DD("DD") S SC2=Y
	2571	"RTN","PRC APCL",90,0 )
	2572	S XX=^DD( 433,90,0), XX=$P(XX," ^",3) F I= 1:1 S CH=$ P(XX,";",I ) Q:CH="" S PRSUS($ P(CH,":",1 ))=$P(CH," :",2)
	2573	"RTN","PRC APCL",91,0 )
	2574	D ST
	2575	"RTN","PRC APCL",92,0 )
	2576	Q:STAT="^ "
	2577	"RTN","PRC APCL",93,0 )
	2578	D TSK,Q1
	2579	"RTN","PRC APCL",94,0 )
	2580	Q
	2581	"RTN","PRC APCL",95,0 )
	2582	ST N DIC,X ,Y
	2583	"RTN","PRC APCL",96,0 )
	2584	S DIC="^P RCA(430.3, ",DIC(0)=" QEMZ"
	2585	"RTN","PRC APCL",97,0 )
	2586	S DIC("S" )="I $P(^( 0),""^"",3 )>100,($P( ^(0),""^"" ,3)'=107)"
	2587	"RTN","PRC APCL",98,0 )
	2588	S Y=0 W ! ,"STATUS: "_$S('$O(S TAT("")):" ALL// ",1: "")
	2589	"RTN","PRC APCL",99,0 )
	2590	R X:DTIME I '$T!(X= "^") S STA T="^" Q
	2591	"RTN","PRC APCL",100, 0)
	2592	I ((X="") !(X="ALL") ),'$O(STAT ("")) S (S TAT,X)="AL L" Q
	2593	"RTN","PRC APCL",101, 0)
	2594	I X="" Q
	2595	"RTN","PRC APCL",102, 0)
	2596	D ^DIC S STAT=+Y,SE R=$G(SER)
	2597	"RTN","PRC APCL",103, 0)
	2598	I X["?" W !!,"Enter 'ALL' for all statu s types.", ! G ST
	2599	"RTN","PRC APCL",104, 0)
	2600	I STAT'=" ALL",(+STA T>0) S STA T(+STAT)=" " D:STAT=4 0 SUSTYP G ST
	2601	"RTN","PRC APCL",105, 0)
	2602	G:+STAT<0 ST
	2603	"RTN","PRC APCL",106, 0)
	2604	Q
	2605	"RTN","PRC APCL",107, 0)
	2606	SUSTYP ;If SUSPENDED is chosen , prompt f or which s uspended b ills to di splay PRCA 4.5315/D RF
	2607	"RTN","PRC APCL",108, 0)
	2608	N X,CH,LA ST,PRPRT
	2609	"RTN","PRC APCL",109, 0)
	2610	S LAST=$O (PRSUS("") ,-1),PRSUS (LAST+1)=" ALL OF THE ABOVE"
	2611	"RTN","PRC APCL",110, 0)
	2612	S PRPRT=" Choose fro m SUSPENDE D TYPE:"
	2613	"RTN","PRC APCL",111, 0)
	2614	S PRSELST =$$MLTP0(P RPRT,.PRSU S,1)
	2615	"RTN","PRC APCL",112, 0)
	2616	Q
	2617	"RTN","PRC APCL",113, 0)
	2618	SUST ;Look for suspe nded type for a susp ended bill PRCA4.5 315/DRF
	2619	"RTN","PRC APCL",114, 0)
	2620	N TRANS
	2621	"RTN","PRC APCL",115, 0)
	2622	S TRANS=$ O(^PRCA(43 3,"C",PRCA E,""),-1)
	2623	"RTN","PRC APCL",116, 0)
	2624	S ST=$P($ G(^PRCA(43 3,TRANS,1) ),U,11)
	2625	"RTN","PRC APCL",117, 0)
	2626	I ST="" S ST="NONE"
	2627	"RTN","PRC APCL",118, 0)
	2628	Q
	2629	"RTN","PRC APCL",119, 0)
	2630	STHDR ;Dis play Suspe nded Type PRCA4.53 15/DRF
	2631	"RTN","PRC APCL",120, 0)
	2632	I 'HDR W !
	2633	"RTN","PRC APCL",121, 0)
	2634	W ?30,"Su spend Type : ",$S(ST= "NONE":ST, 1:PRSUS(ST )),!!
	2635	"RTN","PRC APCL",122, 0)
	2636	S HDR=0
	2637	"RTN","PRC APCL",123, 0)
	2638	Q
	2639	"RTN","PRC APCL",124, 0)
	2640	TSK ;
	2641	"RTN","PRC APCL",125, 0)
	2642	N POP,ZTS K
	2643	"RTN","PRC APCL",126, 0)
	2644	W *7,!,"R eport shou ld be QUEU ED it coul d take som e time to run!"
	2645	"RTN","PRC APCL",127, 0)
	2646	S POP=0,% ZIS="MQ" D ^%ZIS G:P OP Q1
	2647	"RTN","PRC APCL",128, 0)
	2648	I '$D(IO( "Q")) U IO D PRCAPCL U IO(0) G Q1
	2649	"RTN","PRC APCL",129, 0)
	2650	S ZTRTN=" ^PRCAPCL"
	2651	"RTN","PRC APCL",130, 0)
	2652	S (ZTSAVE ("BEG"),ZT SAVE("DAT" ),ZTSAVE(" END"),ZTSA VE("SER")) =""
	2653	"RTN","PRC APCL",131, 0)
	2654	S (ZTSAVE ("STAT"),Z TSAVE("STA T("),ZTSAV E("SC1"),Z TSAVE("SC2 "))=""
	2655	"RTN","PRC APCL",132, 0)
	2656	S (ZTSAVE ("PRSELST" ),ZTSAVE(" PRSUS("))= ""
	2657	"RTN","PRC APCL",133, 0)
	2658	S ZTDESC= "Bill Stat us Listing " D ^%ZTLO AD
	2659	"RTN","PRC APCL",134, 0)
	2660	Q1 D ^%ZIS C Q
	2661	"RTN","PRC APCL",135, 0)
	2662	;
	2663	"RTN","PRC APCL",136, 0)
	2664	;Choose m ultiple it ems from a list incl uding valu e 0 - PRCA 4.5315/D RF
	2665	"RTN","PRC APCL",137, 0)
	2666	MLTP0(PRPT ,OPT,ALL) ; Function for multi ple value selection
	2667	"RTN","PRC APCL",138, 0)
	2668	; Input: PRPT - Str ing to be prompted t o the user , before l isting opt ions
	2669	"RTN","PRC APCL",139, 0)
	2670	; OPT - Arr ay contain ing the po ssible ent ries (inde xed by cod e)
	2671	"RTN","PRC APCL",140, 0)
	2672	; Obs : Code mus t be seque ntial star ting with 0
	2673	"RTN","PRC APCL",141, 0)
	2674	; ALL - Fla g indicati ng if the last optio n is ALL O F THE ABOV E
	2675	"RTN","PRC APCL",142, 0)
	2676	;
	2677	"RTN","PRC APCL",143, 0)
	2678	; Output: MLTP - Us er selecti on, i.e. " 1,2,3," or "1," or N ULL (nothi ng
	2679	"RTN","PRC APCL",144, 0)
	2680	; w as selecte d)
	2681	"RTN","PRC APCL",145, 0)
	2682	;
	2683	"RTN","PRC APCL",146, 0)
	2684	N A,DIR,D IRUT,DTOUT ,DUOUT,DIR OUT,I,IX,L ST,MLTP
	2685	"RTN","PRC APCL",147, 0)
	2686	;
	2687	"RTN","PRC APCL",148, 0)
	2688	PRPT S MLT P="",ALL=+ $G(ALL)
	2689	"RTN","PRC APCL",149, 0)
	2690	S LST=$O( OPT(""),-1 )
	2691	"RTN","PRC APCL",150, 0)
	2692	S DIR(0)= "LO^0:"_LS T_"^K:+$P( X,""-"",2) >"_LST_" X "
	2693	"RTN","PRC APCL",151, 0)
	2694	S DIR("A" ,1)=$G(PRP T),DIR("A" ,2)=""
	2695	"RTN","PRC APCL",152, 0)
	2696	S A="",IX =3
	2697	"RTN","PRC APCL",153, 0)
	2698	F S A=$O (OPT(A)) Q:A="" D
	2699	"RTN","PRC APCL",154, 0)
	2700	. S DIR(" A",IX)=" "_A_" - " _$G(OPT(A) ),IX=IX+1
	2701	"RTN","PRC APCL",155, 0)
	2702	S DIR("A" ,IX)="",DI R("A")="Se lect",DIR( "B")=LST,D IR("T")=DT IME W !
	2703	"RTN","PRC APCL",156, 0)
	2704	D ^DIR K DIR I $D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) S M LTP="" G Q T
	2705	"RTN","PRC APCL",157, 0)
	2706	S MLTP=Y K DIROUT,D TOUT,DUOUT ,DIRUT
	2707	"RTN","PRC APCL",158, 0)
	2708	S DIR(0)= "Y",DIR("A ",1)="You have selec ted",DIR(" A",2)=""
	2709	"RTN","PRC APCL",159, 0)
	2710	S A="",IX =3
	2711	"RTN","PRC APCL",160, 0)
	2712	F I=1:1:( $L(MLTP,", ")-1) D
	2713	"RTN","PRC APCL",161, 0)
	2714	. S DIR(" A",IX)=" "_$P(MLT P,",",I)_" - "_$G(OP T($P(MLTP, ",",I)))
	2715	"RTN","PRC APCL",162, 0)
	2716	. S IX=IX +1
	2717	"RTN","PRC APCL",163, 0)
	2718	S DIR("A" ,IX)=""
	2719	"RTN","PRC APCL",164, 0)
	2720	S DIR("A" )="Are you sure",DIR ("B")="NO" ,DIR("T")= DTIME W !
	2721	"RTN","PRC APCL",165, 0)
	2722	D ^DIR K DIR I $D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) S M LTP="" G Q T
	2723	"RTN","PRC APCL",166, 0)
	2724	K DIROUT, DTOUT,DUOU T,DIRUT I 'Y K DIR G PRPT
	2725	"RTN","PRC APCL",167, 0)
	2726	I ALL,MLT P[LST S ML TP="" G QT
	2727	"RTN","PRC APCL",168, 0)
	2728	S MLTP=", "_MLTP
	2729	"RTN","PRC APCL",169, 0)
	2730	;
	2731	"RTN","PRC APCL",170, 0)
	2732	QT Q MLTP
	2733	"RTN","PRC AXP")
	2734	0^1^B23479 334
	2735	"RTN","PRC AXP",1,0)
	2736	PRCAXP ;WA SH-ISC@ALT OONA,PA/TJ K-PRINT RX -COPAY EXE MPTION REP ORT ;10/23 /93 10:01 AM
	2737	"RTN","PRC AXP",2,0)
	2738	V ;;4.5;Ac counts Rec eivable; 315;Mar 20, 1995;B uild 11
	2739	"RTN","PRC AXP",3,0)
	2740	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2741	"RTN","PRC AXP",4,0)
	2742	NEW BEG,E ND,%DT,%ZI S,IOP,POP, Y,%
	2743	"RTN","PRC AXP",5,0)
	2744	BEG W ! D NOW^%DTC S %DT(0)=-% ,%DT="AEXP ",%DT("A") ="Start Da te: " D ^% DT G:Y<0 Q S BEG=Y
	2745	"RTN","PRC AXP",6,0)
	2746	S %DT="AE X",%DT("A" )=" En d Date: ", %DT("B")=" T" D ^%DT G:Y<0 Q S END=Y
	2747	"RTN","PRC AXP",7,0)
	2748	W !!,"You will need a 132 col umn printe r for this report!", !
	2749	"RTN","PRC AXP",8,0)
	2750	W ! K IO( "Q") S %ZI S="MQ" D ^ %ZIS G:POP Q
	2751	"RTN","PRC AXP",9,0)
	2752	I $D(IO(" Q")) S ZTR TN="DQ^PRC AXP",ZTSAV E("BEG")=" ",ZTSAVE(" END")="" D ^%ZTLOAD G Q
	2753	"RTN","PRC AXP",10,0)
	2754	U IO
	2755	"RTN","PRC AXP",11,0)
	2756	DQ ;ENTRY POINT FROM TASK MANA GER FOR PR INTING REP ORT
	2757	"RTN","PRC AXP",12,0)
	2758	NEW Y,TOD AY,PG,I,PR CA,PRCAHDR ,BEGPR,END PR,TRDATE, TRNO,T0,T1 ,BILL,TRAM T,OUT,PTNM ,DFN,CONTI NUE,ID,REC ,TTYPE,VA, PTOT,PGTOT ,TOT,LAST
	2759	"RTN","PRC AXP",13,0)
	2760	COMPUTE ;S ETS TEMPOR ARY GLOBAL FOR PRINT ING
	2761	"RTN","PRC AXP",14,0)
	2762	K ^TMP($J ) S TRDATE =BEG-1,(TO T("D"),TOT ("E"),TOT( "I"))=0,U= "^"
	2763	"RTN","PRC AXP",15,0)
	2764	F S TRDA TE=$O(^PRC A(433,"ACE ",TRDATE)) G PRINT:' TRDATE!($P (TRDATE,". ")>END) S TRNO=0 D
	2765	"RTN","PRC AXP",16,0)
	2766	.F S TRN O=$O(^PRCA (433,"ACE" ,TRDATE,TR NO)) Q:'TR NO D
	2767	"RTN","PRC AXP",17,0)
	2768	..S T0=$G (^PRCA(433 ,TRNO,0)), T1=$G(^(1) ) Q:T0=""
	2769	"RTN","PRC AXP",18,0)
	2770	..S BLNO= $P(T0,U,2) ,TRAMT=$P( T1,U,5),TT YPE=$S($P( T1,U,2)=35 :"D",$P(T1 ,U,2)=1:"I ",1:"E"),E FDT=$P(T1, U,1) ;*31 5 START
	2771	"RTN","PRC AXP",19,0)
	2772	..;S DFN= $P(^PRCA(4 30,BLNO,0) ,U,9),BILL =$P(^(0),U )
	2773	"RTN","PRC AXP",20,0)
	2774	..S P0=$G (^PRCA(430 ,BLNO,0)), DFN=$P(P0, U,9),BILL= $P(P0,U),I BN=0
	2775	"RTN","PRC AXP",21,0)
	2776	..S DFN=$ P(^RCD(340 ,+DFN,0),U ) Q:'DFN!( DFN'["DPT( ") S DFN= +DFN
	2777	"RTN","PRC AXP",22,0)
	2778	..D DEM^V ADPT S PTN M=VADM(1), ID=$E(PTNM ,1)_VA("BI D") S DTH= $S(+VADM(6 ):"*",1:"" ) D KVAR^V ADPT
	2779	"RTN","PRC AXP",23,0)
	2780	..D FNDBI L(TRNO,TTY PE)
	2781	"RTN","PRC AXP",24,0)
	2782	PRINT ;PRI NT REPORT
	2783	"RTN","PRC AXP",25,0)
	2784	S LAST=""
	2785	"RTN","PRC AXP",26,0)
	2786	S Y=BEG X ^DD("DD") S BEGPR=Y
	2787	"RTN","PRC AXP",27,0)
	2788	S Y=END X ^DD("DD") S ENDPR=Y
	2789	"RTN","PRC AXP",28,0)
	2790	S Y=DT X ^DD("DD") S TODAY=Y, PG=0 D HEA D
	2791	"RTN","PRC AXP",29,0)
	2792	I '$D(^TM P($J)) W ! !,"NO EXEM PTIONS FOR THIS TIME PERIOD" G Q
	2793	"RTN","PRC AXP",30,0)
	2794	S PTNM="" F S PTNM =$O(^TMP($ J,PTNM)) Q :PTNM=""!( $D(OUT)) D
	2795	"RTN","PRC AXP",31,0)
	2796	.S DFN=0 F S DFN=$ O(^TMP($J, PTNM,DFN)) Q:'DFN!($ D(OUT)) S CONTINUE= "",PTOT=0 D I PTOT W !,?115," ---------- ---",!,?11 5,$J(+PTOT ,13,2),!
	2797	"RTN","PRC AXP",32,0)
	2798	..S BILL= "" F S BI LL=$O(^TMP ($J,PTNM,D FN,BILL)) Q:BILL=""! ($D(OUT)) D
	2799	"RTN","PRC AXP",33,0)
	2800	...S TRNO =0 F S TR NO=$O(^TMP ($J,PTNM,D FN,BILL,TR NO)) Q:TRN O=""!($D(O UT)) D ;*315 STAR T
	2801	"RTN","PRC AXP",34,0)
	2802	....S CON TINUE=""
	2803	"RTN","PRC AXP",35,0)
	2804	....S RX= 0 F S RX= $O(^TMP($J ,PTNM,DFN, BILL,TRNO, RX)) Q:'RX !($D(OUT)) D
	2805	"RTN","PRC AXP",36,0)
	2806	.....S RE C=^TMP($J, PTNM,DFN,B ILL,TRNO,R X),TRAMT=$ P(REC,U,1) W ! W:$D( CONTINUE) $P(REC,"^" ,4),$E(PTN M,1,25)," ",?28,$P(R EC,U,2),?3 5,BILL,?48 ,TRNO,?56, $P(REC,U,3 )
	2807	"RTN","PRC AXP",37,0)
	2808	.....W ?6 0,$S(RX=1: "",1:$P(RE C,U,5)) W ?70,$E($P( REC,U,6),1 ,17),?90,$ P(REC,U,7) ,?100,$P(R EC,U,8) I $D(CONTINU E),TRNO'=L AST W ?115 ,$J(TRAMT, 13,2)
	2809	"RTN","PRC AXP",38,0)
	2810	.....I $D (CONTINUE) ,TRNO'=LAS T S PTOT=P TOT+TRAMT, PGTOT=+$G( PGTOT)+TRA MT,TOT($S( $P(REC,U,3 )]"":$P(RE C,U,3),1:" UNK"))=$G( TOT($S($P( REC,U,3)]" ":$P(REC,U ,3),1:"UNK ")))+REC ;*315 END
	2811	"RTN","PRC AXP",39,0)
	2812	.....K CO NTINUE S L AST=TRNO D HEAD:($Y+ 4)>IOSL
	2813	"RTN","PRC AXP",40,0)
	2814	G:$D(OUT) Q
	2815	"RTN","PRC AXP",41,0)
	2816	W !,"* -i ndicates p atient is deceased"
	2817	"RTN","PRC AXP",42,0)
	2818	D HEAD:($ Y+7)>IOSL
	2819	"RTN","PRC AXP",43,0)
	2820	W !!,"EXE MPTION TYP ES AND TOT ALS"
	2821	"RTN","PRC AXP",44,0)
	2822	W !!,"D=D ECREASE AD JUSTMENT " ,?35,$J(TO T("D"),13, 2),!,"E=IN TEREST/ADM IN EXEMPTI ON ",?35,$ J(TOT("E") ,13,2),!," I=INCREASE ADJUSTMEN T FOR REFU ND ",?35,$ J(TOT("I") ,13,2)
	2823	"RTN","PRC AXP",45,0)
	2824	I $D(TOT( "UNK")) W !,"UNK=EXE MPTION TYP E UNKNOWN" ,?35,$J(TO T("UNK"),1 3,2)
	2825	"RTN","PRC AXP",46,0)
	2826	W !,?35," ---------- ---",!,?35 ,$J(PGTOT, 13,2)
	2827	"RTN","PRC AXP",47,0)
	2828	K BEG,END ,IO("Q") ; K ^TMP($J)
	2829	"RTN","PRC AXP",48,0)
	2830	Q D ^%ZISC Q
	2831	"RTN","PRC AXP",49,0)
	2832	;
	2833	"RTN","PRC AXP",50,0)
	2834	FNDBIL(TRN O,TTYPE) ;
	2835	"RTN","PRC AXP",51,0)
	2836	N FOUND,C NT,IBN,IB0 ,RR,RX,DRU G,FLDT,EDT ,EFFDT,IBA MT,IBAS,AR TRN
	2837	"RTN","PRC AXP",52,0)
	2838	S (IBN,FO UND,CNT,RX )=0,EDT=""
	2839	"RTN","PRC AXP",53,0)
	2840	F S IBN= $O(^IB("AB IL",BILL,I BN)) Q:IBN ="" D
	2841	"RTN","PRC AXP",54,0)
	2842	.S IB0=^I B(IBN,0),R R=$P(IB0,U ,4),EDT=$P (IB0,U,17) ,IBAMT=$P( IB0,U,7),A RTRN=$P(IB 0,U,12)
	2843	"RTN","PRC AXP",55,0)
	2844	.I EDT="" S EDT=EFD T
	2845	"RTN","PRC AXP",56,0)
	2846	.I EDT="" S EDT=TRD ATE
	2847	"RTN","PRC AXP",57,0)
	2848	.I ARTRN= TRNO S FOU ND=1 D DAT A Q
	2849	"RTN","PRC AXP",58,0)
	2850	.I 'FOUND ,ARTRN="" D DATA
	2851	"RTN","PRC AXP",59,0)
	2852	I CNT=0,R X=0 D
	2853	"RTN","PRC AXP",60,0)
	2854	.I EDT="" S EDT=EFD T
	2855	"RTN","PRC AXP",61,0)
	2856	.I EDT="" S EDT=TRD ATE
	2857	"RTN","PRC AXP",62,0)
	2858	.S EFFDT= $$FMTE^XLF DT(EDT,"2D Z")
	2859	"RTN","PRC AXP",63,0)
	2860	.D SET(1)
	2861	"RTN","PRC AXP",64,0)
	2862	Q
	2863	"RTN","PRC AXP",65,0)
	2864	;
	2865	"RTN","PRC AXP",66,0)
	2866	DATA ; SET UP DATA
	2867	"RTN","PRC AXP",67,0)
	2868	S CNT=CNT +1
	2869	"RTN","PRC AXP",68,0)
	2870	S RIEN=+$ P(RR,"52:" ,2),RFL=+$ P(RR,":",3 )
	2871	"RTN","PRC AXP",69,0)
	2872	S DRUG=$$ FILE^IBRXU TL(RIEN,6, "E"),RX=$$ FILE^IBRXU TL(RIEN,.0 1)
	2873	"RTN","PRC AXP",70,0)
	2874	I RFL>0 S FLDT=$$SU BFILE^IBRX UTL(RIEN,R FL,52,.01)
	2875	"RTN","PRC AXP",71,0)
	2876	I RFL=0 S FLDT=$$FI LE^IBRXUTL (RIEN,22)
	2877	"RTN","PRC AXP",72,0)
	2878	S EFFDT=$ $FMTE^XLFD T(EDT,"2DZ "),FLDT=$$ FMTE^XLFDT (FLDT,"2DZ ")
	2879	"RTN","PRC AXP",73,0)
	2880	I $D(^TMP ($J,PTNM,D FN,BILL,TR NO,RX)) Q
	2881	"RTN","PRC AXP",74,0)
	2882	D SET(RX)
	2883	"RTN","PRC AXP",75,0)
	2884	Q
	2885	"RTN","PRC AXP",76,0)
	2886	;
	2887	"RTN","PRC AXP",77,0)
	2888	SET(RX) ;
	2889	"RTN","PRC AXP",78,0)
	2890	S ^TMP($J ,PTNM,DFN, BILL,TRNO, RX)=TRAMT_ U_ID_U_TTY PE_U_DTH_U _$G(RX)_U_ $G(DRUG)_U _$G(FLDT)_ U_$G(EFFDT )_U_$G(ART RN)_U_$G(I BAS)_U_$G( IBN) ;*31 5 END
	2891	"RTN","PRC AXP",79,0)
	2892	Q
	2893	"RTN","PRC AXP",80,0)
	2894	;
	2895	"RTN","PRC AXP",81,0)
	2896	HEAD ;PRIN TS HEADING
	2897	"RTN","PRC AXP",82,0)
	2898	I PG,$E(I OST,1,2)[" C-" D SCR Q:$D(OUT)
	2899	"RTN","PRC AXP",83,0)
	2900	W @IOF S PG=PG+1
	2901	"RTN","PRC AXP",84,0)
	2902	W !!,"Pg. "_PG,?130 -$L(TODAY) ,TODAY
	2903	"RTN","PRC AXP",85,0)
	2904	S PRCAHDR ="MEDICATI ON CO-PAY EXEMPTION REPORT",PR CA="",$P(P RCA,"",(1 30-$L(PRCA HDR))\2)=" ",PRCAHDR =PRCA_" "_ PRCAHDR_" "_PRCA
	2905	"RTN","PRC AXP",86,0)
	2906	W !,PRCAH DR,!,?53,B EGPR,"-",E NDPR
	2907	"RTN","PRC AXP",87,0)
	2908	W !,?35," BILL",?48, "TRAN.",?5 6,"EXP",?9 0,"FILL/", ?100,"EFFE CTIVE" ;* 315 START
	2909	"RTN","PRC AXP",88,0)
	2910	W !,"PATI ENT",?28," ID",?35,"N UMBER",?48 ,"NUMBER", ?56,"TYP", ?60,"RX",? 70,"DRUG N AME",?90," REFL DT",? 102,"DATE" ,?120,"AMO UNT" ;*31 5 END
	2911	"RTN","PRC AXP",89,0)
	2912	S PRCA="" ,$P(PRCA," -",132)="" W !,PRCA
	2913	"RTN","PRC AXP",90,0)
	2914	S CONTINU E=""
	2915	"RTN","PRC AXP",91,0)
	2916	Q
	2917	"RTN","PRC AXP",92,0)
	2918	;
	2919	"RTN","PRC AXP",93,0)
	2920	SCR ;
	2921	"RTN","PRC AXP",94,0)
	2922	Q:$E(IOST ,1,2)'["C- "
	2923	"RTN","PRC AXP",95,0)
	2924	N DIR,YY, DIRUT,DUOU T,DTOUT,DI ROUT,X,Y
	2925	"RTN","PRC AXP",96,0)
	2926	F YY=$Y:1 :(IOSL-2) W !
	2927	"RTN","PRC AXP",97,0)
	2928	S DIR(0)= "E" D ^DIR I $D(DIRU T)!($D(DTO UT)) S OUT =1
	2929	"RTN","PRC AXP",98,0)
	2930	Q
	2931	"RTN","RCD PRTEX")
	2932	0^10^B5894 9473
	2933	"RTN","RCD PRTEX",1,0 )
	2934	RCDPRTEX ; ALB/LMH - CLAIMS MAT CHING REPO RT EXPORT ;11/21/16
	2935	"RTN","RCD PRTEX",2,0 )
	2936	;;4.5;Acc ounts Rece ivable;3 15;Mar 2 0, 1995;Bu ild 11
	2937	"RTN","RCD PRTEX",3,0 )
	2938	;;Per VHA Directive 2004-038, this rout ine should not be mo dified.
	2939	"RTN","RCD PRTEX",4,0 )
	2940	;
	2941	"RTN","RCD PRTEX",5,0 )
	2942	Q
	2943	"RTN","RCD PRTEX",6,0 )
	2944	;-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----
	2945	"RTN","RCD PRTEX",7,0 )
	2946	; E ntry Point
	2947	"RTN","RCD PRTEX",8,0 )
	2948	; EN - Fo rmat and c reate the Claims Mat ching Repo rt for Exc el export.
	2949	"RTN","RCD PRTEX",9,0 )
	2950	;-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----
	2951	"RTN","RCD PRTEX",10, 0)
	2952	;
	2953	"RTN","RCD PRTEX",11, 0)
	2954	EN ;
	2955	"RTN","RCD PRTEX",12, 0)
	2956	;
	2957	"RTN","RCD PRTEX",13, 0)
	2958	PRINT(RCEX CEL) ;E P
	2959	"RTN","RCD PRTEX",14, 0)
	2960	; Entry p oint for p rinting th e report
	2961	"RTN","RCD PRTEX",15, 0)
	2962	; Input:
	2963	"RTN","RCD PRTEX",16, 0)
	2964	; RCEX CEL - 1 - CSV forma t, 0 other wise
	2965	"RTN","RCD PRTEX",17, 0)
	2966	; ZTQU EUE - De fined if r eport was queued
	2967	"RTN","RCD PRTEX",18, 0)
	2968	; un defined ot herwise
	2969	"RTN","RCD PRTEX",19, 0)
	2970	; ZSTO P - De fined and 1 if compi lation was stopped
	2971	"RTN","RCD PRTEX",20, 0)
	2972	; 0 or undefin ed otherwi se
	2973	"RTN","RCD PRTEX",21, 0)
	2974	;
	2975	"RTN","RCD PRTEX",22, 0)
	2976	; Output: Repo rt is prin ted in tex t format f or Excel ( turn on lo gging)
	2977	"RTN","RCD PRTEX",23, 0)
	2978	;
	2979	"RTN","RCD PRTEX",24, 0)
	2980	;
	2981	"RTN","RCD PRTEX",25, 0)
	2982	N CRT,DIR ,DIROUT,DI RUT,DTOUT, DUOUT,RCST OP
	2983	"RTN","RCD PRTEX",26, 0)
	2984	N PAGE,SE PLINE,X,XX ,Y
	2985	"RTN","RCD PRTEX",27, 0)
	2986	S CRT=$S( IOST["C-": 1,1:0) ; 1 - Print t o Screen, 0 - Otherw ise
	2987	"RTN","RCD PRTEX",28, 0)
	2988	S:RCEXCEL IOSL=9999 99 ; L ong screen length fo r Excel ou tput
	2989	"RTN","RCD PRTEX",29, 0)
	2990	S PAGE=0, RCSTOP=0,$ P(SEPLINE, "-",81)=""
	2991	"RTN","RCD PRTEX",30, 0)
	2992	I '$D(^TM P("RCDPRTP B",$J)) D Q
	2993	"RTN","RCD PRTEX",31, 0)
	2994	. W @IOF, $C(13) ; No d ata was co mpiled
	2995	"RTN","RCD PRTEX",32, 0)
	2996	. W !!?5, "No data f ound for t his report ."
	2997	"RTN","RCD PRTEX",33, 0)
	2998	. I CRT,' $D(ZTQUEUE D) D
	2999	"RTN","RCD PRTEX",34, 0)
	3000	. . S DIR (0)="E"
	3001	"RTN","RCD PRTEX",35, 0)
	3002	. . D ^DI R
	3003	"RTN","RCD PRTEX",36, 0)
	3004	;
	3005	"RTN","RCD PRTEX",37, 0)
	3006	I $G(ZTST OP) D Q ; Compilatio n was halt ed
	3007	"RTN","RCD PRTEX",38, 0)
	3008	. D HDR(" ",CRT,.PAG E,.RCSTOP)
	3009	"RTN","RCD PRTEX",39, 0)
	3010	. W !!?5, "This repo rt was hal ted during compilati on by Task Manager Re quest."
	3011	"RTN","RCD PRTEX",40, 0)
	3012	. I CRT,' $D(ZTQUEUE D) D
	3013	"RTN","RCD PRTEX",41, 0)
	3014	. . S DIR (0)="E"
	3015	"RTN","RCD PRTEX",42, 0)
	3016	. . D ^DI R
	3017	"RTN","RCD PRTEX",43, 0)
	3018	;
	3019	"RTN","RCD PRTEX",44, 0)
	3020	N RCPTID, RCPAT0,RNA ME,RBILL,R CPOST,RCNU M,BILLNUM, BILLFROM,B ILLTO,RXCO V
	3021	"RTN","RCD PRTEX",45, 0)
	3022	N RCIBFN, POSTDATE,R CTYPE,RCTP B0,DOB,RCB NUM,TPB,TP B1,AMT,FPC ,FPC1,CHGT YP,STATUS
	3023	"RTN","RCD PRTEX",46, 0)
	3024	N RCPTID1 ,RCBNUM1,F BH,AMT1,PA YOR,PST,FI LLFROM,FIL LTO,ONHOLD ,RCAMT,RCA MT1
	3025	"RTN","RCD PRTEX",47, 0)
	3026	N RCIBDAT ,STRING,FP C0,TMPSTR1 ,TMPSTR2
	3027	"RTN","RCD PRTEX",48, 0)
	3028	D:RCEXCEL HDR("",CR T,.PAGE,.R CSTOP)
	3029	"RTN","RCD PRTEX",49, 0)
	3030	Q:RCSTOP
	3031	"RTN","RCD PRTEX",50, 0)
	3032	;
	3033	"RTN","RCD PRTEX",51, 0)
	3034	S RCPTID= ""
	3035	"RTN","RCD PRTEX",52, 0)
	3036	F S RCPT ID=$O(^TMP ("RCDPRTPB ",$J,RCPTI D)) Q:RCPT ID="" D
	3037	"RTN","RCD PRTEX",53, 0)
	3038	.S RCPAT0 =$G(^TMP(" RCDPRTPB", $J,RCPTID) )
	3039	"RTN","RCD PRTEX",54, 0)
	3040	.S RNAME= RCPTID
	3041	"RTN","RCD PRTEX",55, 0)
	3042	.; Get th ird party bill numbe r
	3043	"RTN","RCD PRTEX",56, 0)
	3044	.S RCBNUM =0
	3045	"RTN","RCD PRTEX",57, 0)
	3046	.F S RCB NUM=$O(^TM P("RCDPRTP B",$J,RCPT ID,RCBNUM) ) Q:'RCBNU M D
	3047	"RTN","RCD PRTEX",58, 0)
	3048	..S RBILL =RCBNUM ; bil l IFN
	3049	"RTN","RCD PRTEX",59, 0)
	3050	..S RCPOS T=$G(^TMP( "RCDPRTPB" ,$J,RCPTID ,RCBNUM)) ;POSTED DA TE
	3051	"RTN","RCD PRTEX",60, 0)
	3052	..S TPB=0 F S TPB= $O(^TMP("I BRBT",$J,R CBNUM,TPB) ) Q:'TPB D
	3053	"RTN","RCD PRTEX",61, 0)
	3054	...S NAME =$P(RNAME, "^") ; pat ient name
	3055	"RTN","RCD PRTEX",62, 0)
	3056	...S RCTP B0=$G(^TMP ("IBRBT",$ J,RCBNUM,T PB)) ; thi rd party n ode
	3057	"RTN","RCD PRTEX",63, 0)
	3058	...S BILL NUM=$P(RCT PB0,U,4) ; bil l #
	3059	"RTN","RCD PRTEX",64, 0)
	3060	...S PST= $P(RCTPB0, U,5) ; P/S /T
	3061	"RTN","RCD PRTEX",65, 0)
	3062	...S BILL FROM=$P(RC TPB0,U) ; bil l date fro m
	3063	"RTN","RCD PRTEX",66, 0)
	3064	...S BILL TO=$P(RCTP B0,U,2) ; bil l date to
	3065	"RTN","RCD PRTEX",67, 0)
	3066	...S RXCO V=$S('$G(^ TMP("IBRBT ",$J,RBILL )):"NO",1: "YES") ;RX coverage Yes/No
	3067	"RTN","RCD PRTEX",68, 0)
	3068	...S RCIB FN=TPB
	3069	"RTN","RCD PRTEX",69, 0)
	3070	...S PAYO R=$P(RCTPB 0,U,7) ; pa yor
	3071	"RTN","RCD PRTEX",70, 0)
	3072	...S POST DATE=$G(^T MP("RCDPRT PB",$J,RNA ME,RCBNUM) ) ; posted date
	3073	"RTN","RCD PRTEX",71, 0)
	3074	...S RCAM T=$J($P($G (^PRCA(430 ,+TPB,0)), "^",3),5,2 ) ; amt bi lled
	3075	"RTN","RCD PRTEX",72, 0)
	3076	...S RCAM T1=$P($G(^ PRCA(430,+ TPB,7)),"^ ",7) ; amt paid
	3077	"RTN","RCD PRTEX",73, 0)
	3078	...S RCTY PE=$$TYP^I BRFN(TPB) ;Third party bil l type of care
	3079	"RTN","RCD PRTEX",74, 0)
	3080	...S RCTY PE=$S(RCTY PE="":-1,R CTYPE="PR" :"P",RCTYP E="PH":"R" ,1:RCTYPE)
	3081	"RTN","RCD PRTEX",75, 0)
	3082	...;
	3083	"RTN","RCD PRTEX",76, 0)
	3084	...; Writ e third pa rty data t o scratch global
	3085	"RTN","RCD PRTEX",77, 0)
	3086	...I $D(R CBNUM),$D( ^TMP("IBRB F",$J,TPB) )=11 D
	3087	"RTN","RCD PRTEX",78, 0)
	3088	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= $P(RNAME," ^")_"^"
	3089	"RTN","RCD PRTEX",79, 0)
	3090	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_RXCOV_" ^"
	3091	"RTN","RCD PRTEX",80, 0)
	3092	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_"Third Party Bill "_"^"
	3093	"RTN","RCD PRTEX",81, 0)
	3094	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_BILLNUM _"^"
	3095	"RTN","RCD PRTEX",82, 0)
	3096	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_PST_"^^ "
	3097	"RTN","RCD PRTEX",83, 0)
	3098	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_$$STAT( RCIBFN)_"^ "
	3099	"RTN","RCD PRTEX",84, 0)
	3100	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_$$DATE( BILLFROM)_ "^"
	3101	"RTN","RCD PRTEX",85, 0)
	3102	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_$$DATE( BILLTO)_"^ "
	3103	"RTN","RCD PRTEX",86, 0)
	3104	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_$$DATE( POSTDATE)_ "^"
	3105	"RTN","RCD PRTEX",87, 0)
	3106	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_$J(RCAM T,5,2)_"^"
	3107	"RTN","RCD PRTEX",88, 0)
	3108	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_RCAMT1_ "^^"
	3109	"RTN","RCD PRTEX",89, 0)
	3110	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_RCTYPE_ "^^"
	3111	"RTN","RCD PRTEX",90, 0)
	3112	....S ^TM P("IBRBT1" ,$J,RCPTID ,"T",TPB)= ^TMP("IBRB T1",$J,RCP TID,"T",TP B)_$P(PAYO R," ",1,2) _"^"
	3113	"RTN","RCD PRTEX",91, 0)
	3114	....;
	3115	"RTN","RCD PRTEX",92, 0)
	3116	....; Get first par ty charges
	3117	"RTN","RCD PRTEX",93, 0)
	3118	....S FPC =0 F S F PC=$O(^TMP ("IBRBF",$ J,TPB,FPC) ) Q:'FPC D
	3119	"RTN","RCD PRTEX",94, 0)
	3120	.....S FP C0=^TMP("I BRBF",$J,T PB,FPC) ; First par ty node
	3121	"RTN","RCD PRTEX",95, 0)
	3122	.....S BI LLNUM=$P($ G(^TMP("IB RBF",$J,TP B,FPC)),U, 4) ; Bill #
	3123	"RTN","RCD PRTEX",96, 0)
	3124	.....S RC IBDAT=$G(^ TMP("IBRBF ",$J,TPB,F PC)) ; First par ty data
	3125	"RTN","RCD PRTEX",97, 0)
	3126	.....S RC IBFN=$P(RC IBDAT,"^", 4) I RCIBF N S RCIBFN =$O(^PRCA( 430,"B",RC IBFN,0))
	3127	"RTN","RCD PRTEX",98, 0)
	3128	.....S FI LLFROM=$P( $G(^TMP("I BRBF",$J,T PB,FPC)),U ) ; Bill from
	3129	"RTN","RCD PRTEX",99, 0)
	3130	.....S FI LLTO=$P($G (^TMP("IBR BF",$J,TPB ,FPC)),U,2 ) ; Bill to
	3131	"RTN","RCD PRTEX",100 ,0)
	3132	.....S CH GTYP=$P($G (^TMP("IBR BF",$J,TPB ,FPC)),U,6 ) ; Action ty pe
	3133	"RTN","RCD PRTEX",101 ,0)
	3134	.....S ST ATUS=$$STA T(RCIBFN) ; Status
	3135	"RTN","RCD PRTEX",102 ,0)
	3136	.....S ON HOLD=$$OHD T^IBEFURF( FPC) ; # Days On Hold
	3137	"RTN","RCD PRTEX",103 ,0)
	3138	.....S AM T=$P($G(^T MP("IBRBF" ,$J,TPB,FP C)),U,5) ; Amount bi lled
	3139	"RTN","RCD PRTEX",104 ,0)
	3140	.....S RX COV=$S('$G (^TMP("IBR BT",$J,RBI LL)):"NO", 1:"YES") ; Rx covera ge
	3141	"RTN","RCD PRTEX",105 ,0)
	3142	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=$P(RN AME,"^")_" ^"
	3143	"RTN","RCD PRTEX",106 ,0)
	3144	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_"^"
	3145	"RTN","RCD PRTEX",107 ,0)
	3146	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_"First P arty Charg e"_"^"
	3147	"RTN","RCD PRTEX",108 ,0)
	3148	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_BILLNUM_ "^"
	3149	"RTN","RCD PRTEX",109 ,0)
	3150	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_"^"
	3151	"RTN","RCD PRTEX",110 ,0)
	3152	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_CHGTYP_" ^"
	3153	"RTN","RCD PRTEX",111 ,0)
	3154	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_STATUS_" ^"
	3155	"RTN","RCD PRTEX",112 ,0)
	3156	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_$$DATE(F ILLFROM)_" ^"
	3157	"RTN","RCD PRTEX",113 ,0)
	3158	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_$$DATE(F ILLTO)_"^^ "
	3159	"RTN","RCD PRTEX",114 ,0)
	3160	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_AMT_"^^"
	3161	"RTN","RCD PRTEX",115 ,0)
	3162	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_$S($G(^P RCA(430,+R CIBFN,7)): +($P(^(7), "^")+$P(^( 7),"^",2)+ $P(^(7),"^ ",3)+$P(^( 7),"^",4)+ $P(^(7),"^ ",4)),1:0) _"^^"
	3163	"RTN","RCD PRTEX",116 ,0)
	3164	.....S ^T MP("IBRBF1 ",$J,RCPTI D,"F",TPB, FPC)=^TMP( "IBRBF1",$ J,RCPTID," F",TPB,FPC )_ONHOLD_" ^"
	3165	"RTN","RCD PRTEX",117 ,0)
	3166	;
	3167	"RTN","RCD PRTEX",118 ,0)
	3168	; write d ata to scr een
	3169	"RTN","RCD PRTEX",119 ,0)
	3170	;
	3171	"RTN","RCD PRTEX",120 ,0)
	3172	S RCPTID1 =""
	3173	"RTN","RCD PRTEX",121 ,0)
	3174	F S RCPT ID1=$O(^TM P("IBRBT1" ,$J,RCPTID 1)) Q:RCPT ID1="" D
	3175	"RTN","RCD PRTEX",122 ,0)
	3176	.S TPB1=0 F S TPB1 =$O(^TMP(" IBRBT1",$J ,RCPTID1," T",TPB1)) Q:'TPB1 D
	3177	"RTN","RCD PRTEX",123 ,0)
	3178	..W ^TMP( "IBRBT1",$ J,RCPTID1, "T",TPB1), !
	3179	"RTN","RCD PRTEX",124 ,0)
	3180	..S (TMPS TR1,TMPSTR 2)=""
	3181	"RTN","RCD PRTEX",125 ,0)
	3182	.S TPB1=0 F S TPB1 =$O(^TMP(" IBRBF1",$J ,RCPTID1," F",TPB1)) Q:'TPB1 D
	3183	"RTN","RCD PRTEX",126 ,0)
	3184	..S FPC1= 0 F S FPC 1=$O(^TMP( "IBRBF1",$ J,RCPTID1, "F",TPB1,F PC1)) Q:' FPC1 D
	3185	"RTN","RCD PRTEX",127 ,0)
	3186	...S TMPS TR1=^TMP(" IBRBF1",$J ,RCPTID1," F",TPB1,FP C1)
	3187	"RTN","RCD PRTEX",128 ,0)
	3188	...W:TMPS TR2'=TMPST R1 TMPSTR1 ,!
	3189	"RTN","RCD PRTEX",129 ,0)
	3190	...S TMPS TR2=TMPSTR 1
	3191	"RTN","RCD PRTEX",130 ,0)
	3192	Q
	3193	"RTN","RCD PRTEX",131 ,0)
	3194	;
	3195	"RTN","RCD PRTEX",132 ,0)
	3196	STAT(RBILL ) ;AR Stat us
	3197	"RTN","RCD PRTEX",133 ,0)
	3198	I '$G(RCI BFN) Q ""
	3199	"RTN","RCD PRTEX",134 ,0)
	3200	N RCSTAT
	3201	"RTN","RCD PRTEX",135 ,0)
	3202	S RCSTAT= $P($G(^PRC A(430,+RCI BFN,0)),"^ ",8),RCSTA T=$P($G(^P RCA(430.3, +RCSTAT,0) ),"^",2)
	3203	"RTN","RCD PRTEX",136 ,0)
	3204	Q RCSTAT
	3205	"RTN","RCD PRTEX",137 ,0)
	3206	;
	3207	"RTN","RCD PRTEX",138 ,0)
	3208	DATE(X) ; Convert Fi leMan date to mm/dd/ yy
	3209	"RTN","RCD PRTEX",139 ,0)
	3210	Q $S($G(X ):$E(X,4,5 )_"/"_$E(X ,6,7)_"/"_ $E(X,2,3), 1:"")
	3211	"RTN","RCD PRTEX",140 ,0)
	3212	;
	3213	"RTN","RCD PRTEX",141 ,0)
	3214	HDR(RCLAIM ,CRT,PAGE, RCSTOP) ; Print the Report He ader
	3215	"RTN","RCD PRTEX",142 ,0)
	3216	;
	3217	"RTN","RCD PRTEX",143 ,0)
	3218	; Input: RCLA IM - Claim info
	3219	"RTN","RCD PRTEX",144 ,0)
	3220	; CRT - 1 - Print to screen, 0 otherwi se
	3221	"RTN","RCD PRTEX",145 ,0)
	3222	; RCST OP - Stop flag
	3223	"RTN","RCD PRTEX",146 ,0)
	3224	; ZTQU EUED - Defined if report wa s queued
	3225	"RTN","RCD PRTEX",147 ,0)
	3226	; undefined otherwise
	3227	"RTN","RCD PRTEX",148 ,0)
	3228	; Output: RCST OP - 1 - user s topped pri nting, 0 o therwise
	3229	"RTN","RCD PRTEX",149 ,0)
	3230	; ZSTO P - Defined an d 1 if a t ask manage r stop was received
	3231	"RTN","RCD PRTEX",150 ,0)
	3232	; 0 or undef ined other wise
	3233	"RTN","RCD PRTEX",151 ,0)
	3234	;
	3235	"RTN","RCD PRTEX",152 ,0)
	3236	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,VENID,X, Y,Z
	3237	"RTN","RCD PRTEX",153 ,0)
	3238	;
	3239	"RTN","RCD PRTEX",154 ,0)
	3240	; If scre en output or page# e xists, do a form fee d and left margin re set
	3241	"RTN","RCD PRTEX",155 ,0)
	3242	I PAGE!CR T D
	3243	"RTN","RCD PRTEX",156 ,0)
	3244	. W @IOF, $C(13)
	3245	"RTN","RCD PRTEX",157 ,0)
	3246	;
	3247	"RTN","RCD PRTEX",158 ,0)
	3248	S PAGE=PA GE+1 ; Increment Page #
	3249	"RTN","RCD PRTEX",159 ,0)
	3250	;
	3251	"RTN","RCD PRTEX",160 ,0)
	3252	; For Exc el CSV for mat, displ ay the col umn header s only
	3253	"RTN","RCD PRTEX",161 ,0)
	3254	I RCEXCEL D EXCELHD Q
	3255	"RTN","RCD PRTEX",162 ,0)
	3256	;
	3257	"RTN","RCD PRTEX",163 ,0)
	3258	; Check f or a TaskM anager sto p request
	3259	"RTN","RCD PRTEX",164 ,0)
	3260	I $D(ZTQU EUED),$$S^ %ZTLOAD() D Q
	3261	"RTN","RCD PRTEX",165 ,0)
	3262	. S (ZTST OP,RCSTOP) =1
	3263	"RTN","RCD PRTEX",166 ,0)
	3264	. W !!!?5 ,"* Repo rt Halted by TaskMan ager Reque st *"
	3265	"RTN","RCD PRTEX",167 ,0)
	3266	Q
	3267	"RTN","RCD PRTEX",168 ,0)
	3268	;
	3269	"RTN","RCD PRTEX",169 ,0)
	3270	EXCELHD ; Print an E xcel CSV h eader reco rd
	3271	"RTN","RCD PRTEX",170 ,0)
	3272	;
	3273	"RTN","RCD PRTEX",171 ,0)
	3274	; Input: None
	3275	"RTN","RCD PRTEX",172 ,0)
	3276	; Output: Head er line pr inted for CSV format (excel)
	3277	"RTN","RCD PRTEX",173 ,0)
	3278	; :
	3279	"RTN","RCD PRTEX",174 ,0)
	3280	N FBH
	3281	"RTN","RCD PRTEX",175 ,0)
	3282	S STRING= ""
	3283	"RTN","RCD PRTEX",176 ,0)
	3284	S FBH=$$C SV("","Pat ient")
	3285	"RTN","RCD PRTEX",177 ,0)
	3286	S FBH=$$C SV(FBH,"RX Cvg")
	3287	"RTN","RCD PRTEX",178 ,0)
	3288	S FBH=$$C SV(FBH,"Bi ll Type")
	3289	"RTN","RCD PRTEX",179 ,0)
	3290	S FBH=$$C SV(FBH,"Bi ll#")
	3291	"RTN","RCD PRTEX",180 ,0)
	3292	S FBH=$$C SV(FBH,"P/ S/T")
	3293	"RTN","RCD PRTEX",181 ,0)
	3294	S FBH=$$C SV(FBH,"Ch g Type")
	3295	"RTN","RCD PRTEX",182 ,0)
	3296	S FBH=$$C SV(FBH,"St atus")
	3297	"RTN","RCD PRTEX",183 ,0)
	3298	S FBH=$$C SV(FBH,"Bi ll From")
	3299	"RTN","RCD PRTEX",184 ,0)
	3300	S FBH=$$C SV(FBH,"Bi ll To")
	3301	"RTN","RCD PRTEX",185 ,0)
	3302	S FBH=$$C SV(FBH,"Po sted")
	3303	"RTN","RCD PRTEX",186 ,0)
	3304	S FBH=$$C SV(FBH,"Am t Billed")
	3305	"RTN","RCD PRTEX",187 ,0)
	3306	S FBH=$$C SV(FBH,"Am t Pd")
	3307	"RTN","RCD PRTEX",188 ,0)
	3308	S FBH=$$C SV(FBH,"Ba l")
	3309	"RTN","RCD PRTEX",189 ,0)
	3310	S FBH=$$C SV(FBH,"Ca re Type")
	3311	"RTN","RCD PRTEX",190 ,0)
	3312	S FBH=$$C SV(FBH,"On Hold")
	3313	"RTN","RCD PRTEX",191 ,0)
	3314	S FBH=$$C SV(FBH,"Pa yor")
	3315	"RTN","RCD PRTEX",192 ,0)
	3316	W FBH
	3317	"RTN","RCD PRTEX",193 ,0)
	3318	W !
	3319	"RTN","RCD PRTEX",194 ,0)
	3320	Q
	3321	"RTN","RCD PRTEX",195 ,0)
	3322	;
	3323	"RTN","RCD PRTEX",196 ,0)
	3324	CSV(STRING ,DATA) ; B uild the E xcel data string for CSV forma t
	3325	"RTN","RCD PRTEX",197 ,0)
	3326	; Input: STRI NG - Current st ring being built or ""
	3327	"RTN","RCD PRTEX",198 ,0)
	3328	; DATA - New data t o be added to the st ring
	3329	"RTN","RCD PRTEX",199 ,0)
	3330	; Returns : STRI NG - Updated st ring with DATA added
	3331	"RTN","RCD PRTEX",200 ,0)
	3332	; Called From: EXCE LHD
	3333	"RTN","RCD PRTEX",201 ,0)
	3334	;
	3335	"RTN","RCD PRTEX",202 ,0)
	3336	S DATA="" _$TR(DATA, $C(94))
	3337	"RTN","RCD PRTEX",203 ,0)
	3338	S STRING= $S(STRING= "":DATA,1: STRING_"^" _DATA)
	3339	"RTN","RCD PRTEX",204 ,0)
	3340	Q STRING
	3341	"RTN","RCD PRTEX",205 ,0)
	3342	;
	3343	"RTN","RCD PRTP")
	3344	0^2^B12982 839
	3345	"RTN","RCD PRTP",1,0)
	3346	RCDPRTP ;A LB/LDB-CLA IMS MATCHI NG REPORT ;1/11/01 2:03 PM
	3347	"RTN","RCD PRTP",2,0)
	3348	;;4.5;Acc ounts Rece ivable;1 51,186,315 ;Mar 20, 1995;Buil d 11
	3349	"RTN","RCD PRTP",3,0)
	3350	;
	3351	"RTN","RCD PRTP",4,0)
	3352	;
	3353	"RTN","RCD PRTP",5,0)
	3354	EN N DATEE ND,DATESTR T,DIC,DIR, DIRUT,POP, RCAN,RCBIL L,RCDEBT,R CDFN,RCPT, RCSORT,RCQ UIT,%ZIS,Z TDESC,ZTSA VE,ZTRTN,Y
	3355	"RTN","RCD PRTP",6,0)
	3356	W !
	3357	"RTN","RCD PRTP",7,0)
	3358	K DIRUT S DIR(0)="S ^1:Patient ;2:Bill Nu mber;3:Pay ment dates ;4:Receipt Number;5: Care Types ",DIR("A") ="Sort by" D ^DIR K DIR Q:$D(D IRUT)
	3359	"RTN","RCD PRTP",8,0)
	3360	S RCSORT= Y,RCQUIT=" "
	3361	"RTN","RCD PRTP",9,0)
	3362	D @RCSORT Q:RCQUIT W !
	3363	"RTN","RCD PRTP",10,0 )
	3364	K DIRUT S DIR(0)="Y ",DIR("A") ="Include cancelled bills",DIR ("B")="NO" D ^DIR S RCAN=+Y Q: $D(DIRUT)
	3365	"RTN","RCD PRTP",11,0 )
	3366	;
	3367	"RTN","RCD PRTP",12,0 )
	3368	; select device
	3369	"RTN","RCD PRTP",13,0 )
	3370	I $$FORMA T^RCDPRTP0 (.RCEXCEL) G EXCEL
	3371	"RTN","RCD PRTP",14,0 )
	3372	W !!,"Thi s report r equires 13 2 columns. ",!
	3373	"RTN","RCD PRTP",15,0 )
	3374	W ! S %ZI S="Q" D ^% ZIS I POP Q
	3375	"RTN","RCD PRTP",16,0 )
	3376	I $D(IO(" Q")) D D ^%ZTLOAD K IO("Q"),Z TSK Q
	3377	"RTN","RCD PRTP",17,0 )
	3378	.S ZTDESC ="Claims M atching Re port",ZTRT N="DQ^RCDP RTP"
	3379	"RTN","RCD PRTP",18,0 )
	3380	.S ZTSAVE ("RCSORT") =""
	3381	"RTN","RCD PRTP",19,0 )
	3382	.I RCSORT =1 S ZTSAV E("RCDEBT" )="",ZTSAV E("RCDFN") ="",ZTSAVE ("DATE*")= ""
	3383	"RTN","RCD PRTP",20,0 )
	3384	.I RCSORT =2 S ZTSAV E("RCBILL" )="",ZTSAV E("RCDFN") ="",ZTSAVE ("RCDEBT") =""
	3385	"RTN","RCD PRTP",21,0 )
	3386	.I RCSORT =3 S ZTSAV E("DATE*") =""
	3387	"RTN","RCD PRTP",22,0 )
	3388	.I RCSORT =4 S ZTSAV E("RCPT")= ""
	3389	"RTN","RCD PRTP",23,0 )
	3390	.I RCSORT =5 S ZTSAV E("TYPE")= ""
	3391	"RTN","RCD PRTP",24,0 )
	3392	.S ZTSAVE ("RCAN")=" ",ZTSAVE(" ZTREQ")="@ "
	3393	"RTN","RCD PRTP",25,0 )
	3394	W !!,"<> please wa it <>"
	3395	"RTN","RCD PRTP",26,0 )
	3396	;
	3397	"RTN","RCD PRTP",27,0 )
	3398	DQ ; queu ed report starts her e
	3399	"RTN","RCD PRTP",28,0 )
	3400	U IO
	3401	"RTN","RCD PRTP",29,0 )
	3402	K ^TMP("R CDPRTPB",$ J)
	3403	"RTN","RCD PRTP",30,0 )
	3404	K ^TMP("I BRBT",$J)
	3405	"RTN","RCD PRTP",31,0 )
	3406	K ^TMP("I BRBF",$J)
	3407	"RTN","RCD PRTP",32,0 )
	3408	N DAT,RCB IL,RCBIL0, RCNAM,RCPA Y,RCPAY1,R CREC,RCREC 1,RCRECTDA ,RCSSN,RCT YP
	3409	"RTN","RCD PRTP",33,0 )
	3410	D @($S(RC SORT=1:"PA T",RCSORT= 2:"BILL",R CSORT=3:"D ATE",RCSOR T=4:"REC", RCSORT=5:" TYPE")_"^R CDPRTP0")
	3411	"RTN","RCD PRTP",34,0 )
	3412	D EN^RCDP RTP1
	3413	"RTN","RCD PRTP",35,0 )
	3414	K DATESTR T,DATEEND, ^TMP("RCDP RTPB",$J), RCTYPE
	3415	"RTN","RCD PRTP",36,0 )
	3416	D ^%ZISC
	3417	"RTN","RCD PRTP",37,0 )
	3418	Q
	3419	"RTN","RCD PRTP",38,0 )
	3420
	3421	"RTN","RCD PRTP",39,0 )
	3422	;
	3423	"RTN","RCD PRTP",40,0 )
	3424	1 S DIC(0) ="QEAMZ",D IC=340,DIC ("S")="I ^ RCD(340,+Y ,0)[""DPT" "",DIC("A" )="Patient name: " D ^DIC I Y< 0 S RCQUIT =1 Q
	3425	"RTN","RCD PRTP",41,0 )
	3426	S RCDEBT= +Y,RCDFN=+ $P(Y,"^",2 )
	3427	"RTN","RCD PRTP",42,0 )
	3428	D TYPEPIC ^RCDPRTP0( .RCTYPE)
	3429	"RTN","RCD PRTP",43,0 )
	3430	D DATESEL ^RCRJRTRA( "Payment")
	3431	"RTN","RCD PRTP",44,0 )
	3432
	3433	"RTN","RCD PRTP",45,0 )
	3434
	3435	"RTN","RCD PRTP",46,0 )
	3436	I '$G(DAT ESTRT)!('$ G(DATEEND) ) S RCQUIT =1
	3437	"RTN","RCD PRTP",47,0 )
	3438	Q
	3439	"RTN","RCD PRTP",48,0 )
	3440	;
	3441	"RTN","RCD PRTP",49,0 )
	3442	3 D DATESE L^RCRJRTRA ("Payment" )
	3443	"RTN","RCD PRTP",50,0 )
	3444	I '$G(DAT ESTRT)!('$ G(DATEEND) ) S RCQUIT =1
	3445	"RTN","RCD PRTP",51,0 )
	3446	Q
	3447	"RTN","RCD PRTP",52,0 )
	3448	;
	3449	"RTN","RCD PRTP",53,0 )
	3450	2 N DIC,DU OUT
	3451	"RTN","RCD PRTP",54,0 )
	3452	K ^TMP("I BRBF",$J)
	3453	"RTN","RCD PRTP",55,0 )
	3454	S DIC(0)= "QEAM",DIC =430,DIC(" S")="I $P( ^(0),U,2)= 9" D ^DIC I Y<0 S RC QUIT=1 Q
	3455	"RTN","RCD PRTP",56,0 )
	3456	S RCBILL= +Y,RCDFN=$ P($G(^PRCA (430,+RCBI LL,0)),"^" ,7) Q:'RCD FN
	3457	"RTN","RCD PRTP",57,0 )
	3458	S RCDEBT= $O(^RCD(34 0,"B",RCDF N_";DPT(", 0))
	3459	"RTN","RCD PRTP",58,0 )
	3460	I (RCDFN= "")!(RCDEB T="") W !, "This bill has no ma tching fir st party b ills." G 2
	3461	"RTN","RCD PRTP",59,0 )
	3462	D RELBILL ^IBRFN(RCB ILL)
	3463	"RTN","RCD PRTP",60,0 )
	3464	I '$O(^TM P("IBRBF", $J,RCBILL, 0)) W !,"T his bill h as no matc hing first party deb ts." K ^TM P("IBRBF", $J) G 2
	3465	"RTN","RCD PRTP",61,0 )
	3466	K ^TMP("I BRBF",$J)
	3467	"RTN","RCD PRTP",62,0 )
	3468	Q
	3469	"RTN","RCD PRTP",63,0 )
	3470	;
	3471	"RTN","RCD PRTP",64,0 )
	3472	4 N DIC,X, Y
	3473	"RTN","RCD PRTP",65,0 )
	3474	S DIC(0)= "QEAM",DIC =344 D ^DI C I Y<0 S RCQUIT=1 Q
	3475	"RTN","RCD PRTP",66,0 )
	3476	S RCPT=$P (Y,"^",2)
	3477	"RTN","RCD PRTP",67,0 )
	3478	Q
	3479	"RTN","RCD PRTP",68,0 )
	3480	;
	3481	"RTN","RCD PRTP",69,0 )
	3482	5 ; Select care type - added i n patch 31 5
	3483	"RTN","RCD PRTP",70,0 )
	3484	D TYPEPIC ^RCDPRTP0( .RCTYPE)
	3485	"RTN","RCD PRTP",71,0 )
	3486	D DATESEL ^RCRJRTRA( "Payment")
	3487	"RTN","RCD PRTP",72,0 )
	3488	I '$G(DAT ESTRT)!('$ G(DATEEND) ) S RCQUIT =1
	3489	"RTN","RCD PRTP",73,0 )
	3490	Q
	3491	"RTN","RCD PRTP",74,0 )
	3492	;
	3493	"RTN","RCD PRTP",75,0 )
	3494	EXCEL ; E xcel forma t report s tarts here
	3495	"RTN","RCD PRTP",76,0 )
	3496	K ^TMP("R CDPRTPB",$ J)
	3497	"RTN","RCD PRTP",77,0 )
	3498	K ^TMP("I BRBT",$J)
	3499	"RTN","RCD PRTP",78,0 )
	3500	K ^TMP("I BRBF",$J)
	3501	"RTN","RCD PRTP",79,0 )
	3502	K ^TMP("I BRBT1",$J)
	3503	"RTN","RCD PRTP",80,0 )
	3504	K ^TMP("I BRBF1",$J)
	3505	"RTN","RCD PRTP",81,0 )
	3506	N DAT,RCB IL,RCBIL0, RCNAM,RCPA Y,RCPAY1,R CREC,RCREC 1,RCRECTDA ,RCSSN,RCT YP
	3507	"RTN","RCD PRTP",82,0 )
	3508	D @($S(RC SORT=1:"PA T",RCSORT= 2:"BILL",R CSORT=3:"D ATE",RCSOR T=4:"REC", RCSORT=5:" TYPE")_"^R CDPRTP0")
	3509	"RTN","RCD PRTP",83,0 )
	3510	D DEVICE^ RCDPRTP0
	3511	"RTN","RCD PRTP",84,0 )
	3512	K DATESTR T,DATEEND, RCEXCEL,^T MP("RCDPRT PB",$J),^T MP("IBRBT" ,$J)
	3513	"RTN","RCD PRTP",85,0 )
	3514	K ^TMP("I BRBT1",$J) ,^TMP("IBR BF",$J),^T MP("IBRBF1 ",$J),RCTY PE
	3515	"RTN","RCD PRTP",86,0 )
	3516	D ^%ZISC
	3517	"RTN","RCD PRTP",87,0 )
	3518	Q
	3519	"RTN","RCD PRTP",88,0 )
	3520	;
	3521	"RTN","RCD PRTP0")
	3522	0^3^B43809 915
	3523	"RTN","RCD PRTP0",1,0 )
	3524	RCDPRTP0 ; ALB/LDB - CLAIMS MAT CHING REPO RT ;5/24/0 0 10:48 A M
	3525	"RTN","RCD PRTP0",2,0 )
	3526	;;4.5;Acc ounts Rece ivable;1 51,315;M ar 20, 199 5;Build 11
	3527	"RTN","RCD PRTP0",3,0 )
	3528	;
	3529	"RTN","RCD PRTP0",4,0 )
	3530	;
	3531	"RTN","RCD PRTP0",5,0 )
	3532	PAT ;find patient bi lls
	3533	"RTN","RCD PRTP0",6,0 )
	3534	S RCNAM=$ $NAM^RCFN0 1(RCDEBT)
	3535	"RTN","RCD PRTP0",7,0 )
	3536	S RCSSN=$ $SSN^RCFN0 1(RCDEBT)
	3537	"RTN","RCD PRTP0",8,0 )
	3538	S RCBIL=0 F S RCBI L=$O(^PRCA (430,"E",R CDFN,RCBIL )) Q:'RCBI L D
	3539	"RTN","RCD PRTP0",9,0 )
	3540	.I $P($G( ^PRCA(430, +RCBIL,0)) ,"^",2)'=9 Q
	3541	"RTN","RCD PRTP0",10, 0)
	3542	.S RCPAY= 0 F S RCP AY=$O(^PRC A(433,"C", RCBIL,RCPA Y)) Q:'RCP AY D
	3543	"RTN","RCD PRTP0",11, 0)
	3544	..S RCPAY 1=$G(^PRCA (433,+RCPA Y,1)) Q:RC PAY1=""
	3545	"RTN","RCD PRTP0",12, 0)
	3546	..I "^2^3 4^"[("^"_$ P(RCPAY1," ^",2)_"^") ,($P(RCPAY 1,"^",9)'< DATESTRT), ($P(RCPAY1 ,"^",9)<(D ATEEND_".9 99999")) D
	3547	"RTN","RCD PRTP0",13, 0)
	3548	...S DFN= RCDFN D DE M^VADPT,EL IG^VADPT
	3549	"RTN","RCD PRTP0",14, 0)
	3550	...S ^TMP ("RCDPRTPB ",$J,RCNAM )=$P($G(VA DM(3)),"^" ,2)_"^"_$P ($G(VAEL(1 )),"^",2)_ "^"_RCSSN
	3551	"RTN","RCD PRTP0",15, 0)
	3552	...S ^TMP ("RCDPRTPB ",$J,RCNAM ,RCBIL)=$P ($P(RCPAY1 ,"^",9),". ")
	3553	"RTN","RCD PRTP0",16, 0)
	3554	...I RCEX CEL=1 S RC BILL=RCBIL D RELBILL ^IBRFN(RCB ILL)
	3555	"RTN","RCD PRTP0",17, 0)
	3556	...K DFN, VA,VADM,VA EL,VAERR
	3557	"RTN","RCD PRTP0",18, 0)
	3558	K RCDFN,R CDEBT
	3559	"RTN","RCD PRTP0",19, 0)
	3560	Q
	3561	"RTN","RCD PRTP0",20, 0)
	3562	;
	3563	"RTN","RCD PRTP0",21, 0)
	3564	DATE ;find third par ty bills b y date of payments
	3565	"RTN","RCD PRTP0",22, 0)
	3566	N RCDFN,R CDEBT
	3567	"RTN","RCD PRTP0",23, 0)
	3568	F RCTYP=2 ,34 S DAT= (DATESTRT- 1)_".99999 9" F S DA T=$O(^PRCA (433,"AT", RCTYP,DAT) ) Q:'DAT!( DAT>(DATEE ND_".99999 9")) D
	3569	"RTN","RCD PRTP0",24, 0)
	3570	.S RCPAY= 0 F S RCP AY=$O(^PRC A(433,"AT" ,RCTYP,DAT ,RCPAY)) Q :'RCPAY D
	3571	"RTN","RCD PRTP0",25, 0)
	3572	..S RCBIL =$P($G(^PR CA(433,+RC PAY,0)),"^ ",2)
	3573	"RTN","RCD PRTP0",26, 0)
	3574	..S RCBIL 0=$G(^PRCA (430,+RCBI L,0)) Q:RC BIL0=""
	3575	"RTN","RCD PRTP0",27, 0)
	3576	..Q:$P(RC BIL0,"^",2 )'=9
	3577	"RTN","RCD PRTP0",28, 0)
	3578	..S RCDFN =$P(RCBIL0 ,"^",7)
	3579	"RTN","RCD PRTP0",29, 0)
	3580	..S RCDEB T=$O(^RCD( 340,"B",RC DFN_";DPT( ",0)) Q:'R CDEBT
	3581	"RTN","RCD PRTP0",30, 0)
	3582	..S RCNAM =$$NAM^RCF N01(RCDEBT )
	3583	"RTN","RCD PRTP0",31, 0)
	3584	..S RCSSN =$$SSN^RCF N01(RCDEBT )
	3585	"RTN","RCD PRTP0",32, 0)
	3586	..S DFN=R CDFN D DEM ^VADPT,ELI G^VADPT
	3587	"RTN","RCD PRTP0",33, 0)
	3588	..S ^TMP( "RCDPRTPB" ,$J,RCNAM_ "^"_RCDEBT )=$P($G(VA DM(3)),"^" ,2)_"^"_$P ($G(VAEL(1 )),"^",2)_ "^"_RCSSN
	3589	"RTN","RCD PRTP0",34, 0)
	3590	..S ^TMP( "RCDPRTPB" ,$J,RCNAM_ "^"_RCDEBT ,RCBIL)=$P (DAT,".")
	3591	"RTN","RCD PRTP0",35, 0)
	3592	..I RCEXC EL=1 S RCB ILL=RCBIL D RELBILL^ IBRFN(RCBI LL)
	3593	"RTN","RCD PRTP0",36, 0)
	3594	..K DFN,V A,VADM,VAE L,VAERR
	3595	"RTN","RCD PRTP0",37, 0)
	3596	Q
	3597	"RTN","RCD PRTP0",38, 0)
	3598	;
	3599	"RTN","RCD PRTP0",39, 0)
	3600	TYPE ;find third par ty bills b y care typ e
	3601	"RTN","RCD PRTP0",40, 0)
	3602	N RCDFN,R CDEBT,RCTY P
	3603	"RTN","RCD PRTP0",41, 0)
	3604	F RCTYP=2 ,34 S DAT= (DATESTRT- 1)_".99999 9" F S DA T=$O(^PRCA (433,"AT", RCTYP,DAT) ) Q:'DAT!( DAT>(DATEE ND_".99999 9")) D
	3605	"RTN","RCD PRTP0",42, 0)
	3606	.S RCPAY= 0 F S RCP AY=$O(^PRC A(433,"AT" ,RCTYP,DAT ,RCPAY)) Q :'RCPAY D
	3607	"RTN","RCD PRTP0",43, 0)
	3608	..S RCBIL =$P($G(^PR CA(433,+RC PAY,0)),"^ ",2)
	3609	"RTN","RCD PRTP0",44, 0)
	3610	..S RCBIL 0=$G(^PRCA (430,+RCBI L,0)) Q:RC BIL0=""
	3611	"RTN","RCD PRTP0",45, 0)
	3612	..Q:$P(RC BIL0,"^",2 )'=9
	3613	"RTN","RCD PRTP0",46, 0)
	3614	..S RCDFN =$P(RCBIL0 ,"^",7)
	3615	"RTN","RCD PRTP0",47, 0)
	3616	..S RCDEB T=$O(^RCD( 340,"B",RC DFN_";DPT( ",0)) Q:'R CDEBT
	3617	"RTN","RCD PRTP0",48, 0)
	3618	..S RCNAM =$$NAM^RCF N01(RCDEBT )
	3619	"RTN","RCD PRTP0",49, 0)
	3620	..S RCSSN =$$SSN^RCF N01(RCDEBT )
	3621	"RTN","RCD PRTP0",50, 0)
	3622	..S DFN=R CDFN D DEM ^VADPT,ELI G^VADPT
	3623	"RTN","RCD PRTP0",51, 0)
	3624	..K DFN,V A,VADM,VAE L,VAERR,RC BILL,RCTP
	3625	"RTN","RCD PRTP0",52, 0)
	3626	..S RCTYP E=$$TYP^IB RFN(RCBIL) ; added c are type - 315
	3627	"RTN","RCD PRTP0",53, 0)
	3628	..S RCTYP E=$S(RCTYP E="":-1,RC TYPE="PR": "P",RCTYPE ="PH":"R", 1:RCTYPE)
	3629	"RTN","RCD PRTP0",54, 0)
	3630	..I $D(RC TYPE(RCTYP E)) D Q:' RCTYPE
	3631	"RTN","RCD PRTP0",55, 0)
	3632	...S ^TMP ("RCDPRTPB ",$J,RCNAM _"^"_RCDEB T)=$P($G(V ADM(3)),"^ ",2)_"^"_$ P($G(VAEL( 1)),"^",2) _"^"_RCSSN
	3633	"RTN","RCD PRTP0",56, 0)
	3634	...S ^TMP ("RCDPRTPB ",$J,RCNAM _"^"_RCDEB T,RCBIL)=$ P(DAT,".")
	3635	"RTN","RCD PRTP0",57, 0)
	3636	...I RCEX CEL=1 S RC BILL=RCBIL D RELBILL ^IBRFN(RCB ILL)
	3637	"RTN","RCD PRTP0",58, 0)
	3638	Q
	3639	"RTN","RCD PRTP0",59, 0)
	3640	BILL ;set TMP array
	3641	"RTN","RCD PRTP0",60, 0)
	3642	S RCNAM=$ $NAM^RCFN0 1(RCDEBT)
	3643	"RTN","RCD PRTP0",61, 0)
	3644	S RCSSN=$ $SSN^RCFN0 1(RCDEBT)
	3645	"RTN","RCD PRTP0",62, 0)
	3646	S DFN=+$G (^RCD(340, RCDEBT,0))
	3647	"RTN","RCD PRTP0",63, 0)
	3648	D DEM^VAD PT,ELIG^VA DPT
	3649	"RTN","RCD PRTP0",64, 0)
	3650	S RCTP=0 F S RCTP= $O(^PRCA(4 33,"C",RCB ILL,RCTP)) Q:'RCTP I "^2^34^" [("^"_$P($ G(^PRCA(43 3,+RCTP,1) ),"^",2)_" ^") S RCTP (0)=$P($P( $G(^PRCA(4 33,+RCTP,1 )),"^",9), ".")
	3651	"RTN","RCD PRTP0",65, 0)
	3652	S ^TMP("R CDPRTPB",$ J,RCNAM)=$ P($G(VADM( 3)),"^",2) _"^"_$P($G (VAEL(1)), "^",2)_"^" _RCSSN
	3653	"RTN","RCD PRTP0",66, 0)
	3654	S ^TMP("R CDPRTPB",$ J,RCNAM,RC BILL)=RCTP
	3655	"RTN","RCD PRTP0",67, 0)
	3656	I RCEXCEL =1 D RELBI LL^IBRFN(R CBILL)
	3657	"RTN","RCD PRTP0",68, 0)
	3658	K DFN,VA, VADM,VAEL, VAERR,RCBI LL,RCTP
	3659	"RTN","RCD PRTP0",69, 0)
	3660	Q
	3661	"RTN","RCD PRTP0",70, 0)
	3662	;
	3663	"RTN","RCD PRTP0",71, 0)
	3664	REC ;find receipt pa yments
	3665	"RTN","RCD PRTP0",72, 0)
	3666	N RCDEBT, RCDFN,RCRE C1,RCPAY1, RCBIL,RCBI L0,RCDFN,R CDEBT,RCSS N
	3667	"RTN","RCD PRTP0",73, 0)
	3668	S RCREC1= 0 F S RCR EC1=$O(^PR CA(433,"AF ",RCPT,RCR EC1)) Q:'R CREC1 D
	3669	"RTN","RCD PRTP0",74, 0)
	3670	.S RCPAY1 =$G(^PRCA( 433,+RCREC 1,1)) Q:RC PAY1=""
	3671	"RTN","RCD PRTP0",75, 0)
	3672	.S RCBIL= 0 I "^2^34 ^"[("^"_$P (RCPAY1,"^ ",2)_"^") S RCBIL=$P ($G(^PRCA( 433,+RCREC 1,0)),"^", 2)
	3673	"RTN","RCD PRTP0",76, 0)
	3674	.Q:'RCBIL
	3675	"RTN","RCD PRTP0",77, 0)
	3676	.S RCBIL0 =$G(^PRCA( 430,+RCBIL ,0))
	3677	"RTN","RCD PRTP0",78, 0)
	3678	.Q:$P(RCB IL0,"^",2) '=9
	3679	"RTN","RCD PRTP0",79, 0)
	3680	.S RCDFN= $P(RCBIL0, "^",7) Q:' RCDFN
	3681	"RTN","RCD PRTP0",80, 0)
	3682	.S RCDEBT =$O(^RCD(3 40,"B",RCD FN_";DPT(" ,0)) Q:'RC DEBT
	3683	"RTN","RCD PRTP0",81, 0)
	3684	.S RCSSN= $$SSN^RCFN 01(RCDEBT)
	3685	"RTN","RCD PRTP0",82, 0)
	3686	.S RCNAM= $$NAM^RCFN 01(RCDEBT)
	3687	"RTN","RCD PRTP0",83, 0)
	3688	.S DFN=RC DFN D DEM^ VADPT,ELIG ^VADPT
	3689	"RTN","RCD PRTP0",84, 0)
	3690	.S ^TMP(" RCDPRTPB", $J,RCNAM_" ^"_RCDEBT) =$P($G(VAD M(3)),"^", 2)_"^"_$P( $G(VAEL(1) ),"^",2)_" ^"_RCSSN
	3691	"RTN","RCD PRTP0",85, 0)
	3692	.K DFN,VA ,VADM,VAEL ,VAERR
	3693	"RTN","RCD PRTP0",86, 0)
	3694	.S ^TMP(" RCDPRTPB", $J,RCNAM_" ^"_RCDEBT, RCBIL)=$P( $P($G(^PRC A(433,+RCR EC1,1)),"^ ",9),".")
	3695	"RTN","RCD PRTP0",87, 0)
	3696	.I RCEXCE L=1 S RCBI LL=RCBIL D RELBILL^I BRFN(RCBIL L)
	3697	"RTN","RCD PRTP0",88, 0)
	3698	Q
	3699	"RTN","RCD PRTP0",89, 0)
	3700	;
	3701	"RTN","RCD PRTP0",90, 0)
	3702	TYPEPIC(RC TYPE) ; fu nction for user sele ction of c are types
	3703	"RTN","RCD PRTP0",91, 0)
	3704	; RCTYPE is an outp ut array, pass by re ference
	3705	"RTN","RCD PRTP0",92, 0)
	3706	; RCTYPE( type)="" w here type can be (I) npatient, (O)utpatie nt,(P)rost hetics or (R)x (Pres cription)
	3707	"RTN","RCD PRTP0",93, 0)
	3708	; Functio n value is 1 if at l east 1 car e type was selected, 0 otherwi se
	3709	"RTN","RCD PRTP0",94, 0)
	3710	; User ca n select o ne, all or a combina tion of ca re types.
	3711	"RTN","RCD PRTP0",95, 0)
	3712	;
	3713	"RTN","RCD PRTP0",96, 0)
	3714	N DIR,X,Y ,OK,DTOUT, DUOUT,DIRU T,DIROUT,R C
	3715	"RTN","RCD PRTP0",97, 0)
	3716	K RCTYPE
	3717	"RTN","RCD PRTP0",98, 0)
	3718	S OK=1 ; all OK def ault
	3719	"RTN","RCD PRTP0",99, 0)
	3720	F D Q:Y ="ALL"!$D( DIRUT)!(Y= "")
	3721	"RTN","RCD PRTP0",100 ,0)
	3722	. S DIR(0 )="SO"
	3723	"RTN","RCD PRTP0",101 ,0)
	3724	. S RC="; I:"_$$LJ^X LFSTR("Inp atient",15 )_$S($D(RC TYPE("I")) :"SELECTED ",1:"")
	3725	"RTN","RCD PRTP0",102 ,0)
	3726	. S RC=RC _";O:"_$$L J^XLFSTR(" Outpatient ",15)_$S($ D(RCTYPE(" O")):"SELE CTED",1:"" )
	3727	"RTN","RCD PRTP0",103 ,0)
	3728	. S RC=RC _";P:"_$$L J^XLFSTR(" Prosthetic ",15)_$S($ D(RCTYPE(" P")):"SELE CTED",1:"" )
	3729	"RTN","RCD PRTP0",104 ,0)
	3730	. S RC=RC _";R:"_$$L J^XLFSTR(" Prescripti on",15)_$S ($D(RCTYPE ("R")):"SE LECTED",1: "")
	3731	"RTN","RCD PRTP0",105 ,0)
	3732	. S RC=RC _";ALL:All "
	3733	"RTN","RCD PRTP0",106 ,0)
	3734	. S $P(DI R(0),U,2)= RC
	3735	"RTN","RCD PRTP0",107 ,0)
	3736	. I '$D(R CTYPE) S D IR("A")="S elect a Ca re Type",D IR("B")="A LL"
	3737	"RTN","RCD PRTP0",108 ,0)
	3738	. E S DI R("A")="Se lect anoth er Care Ty pe" K DIR( "B")
	3739	"RTN","RCD PRTP0",109 ,0)
	3740	. W ! D ^ DIR K DIR
	3741	"RTN","RCD PRTP0",110 ,0)
	3742	. I Y="AL L" D Q ; all types selected so set & q uit
	3743	"RTN","RCD PRTP0",111 ,0)
	3744	. . F X=" I","O","P" ,"R" S RCT YPE(X)=""
	3745	"RTN","RCD PRTP0",112 ,0)
	3746	. ;
	3747	"RTN","RCD PRTP0",113 ,0)
	3748	. I $D(DI RUT)!(Y="" ) Q
	3749	"RTN","RCD PRTP0",114 ,0)
	3750	. I $D(RC TYPE(Y)) K RCTYPE(Y) Q ; If a lready sel ected, tog gle off & quit
	3751	"RTN","RCD PRTP0",115 ,0)
	3752	. S RCTYP E(Y)="" ; Togg le back on
	3753	"RTN","RCD PRTP0",116 ,0)
	3754	. Q
	3755	"RTN","RCD PRTP0",117 ,0)
	3756	I $D(DUOU T)!$D(DTOU T) S OK=0 ; exit if "^" or time-out
	3757	"RTN","RCD PRTP0",118 ,0)
	3758	I '$D(RCT YPE) S OK= 0 W $C(7)
	3759	"RTN","RCD PRTP0",119 ,0)
	3760	Q OK
	3761	"RTN","RCD PRTP0",120 ,0)
	3762	FORMAT(RCE XCEL) ; ca pture the report for mat from t he user (n ormal or C SV output)
	3763	"RTN","RCD PRTP0",121 ,0)
	3764	; RCEXCEL =0 for nor mal output
	3765	"RTN","RCD PRTP0",122 ,0)
	3766	; RCEXCEL =1 for CSV (\| separa ted values ) for Exce l output
	3767	"RTN","RCD PRTP0",123 ,0)
	3768	; pass pa rameter by reference
	3769	"RTN","RCD PRTP0",124 ,0)
	3770	;
	3771	"RTN","RCD PRTP0",125 ,0)
	3772	N RET,DIR ,X,Y,DTOUT ,DUOUT,DIR UT,DIROUT
	3773	"RTN","RCD PRTP0",126 ,0)
	3774	S RCEXCEL =0,RET=1
	3775	"RTN","RCD PRTP0",127 ,0)
	3776	S DIR(0)= "Y"
	3777	"RTN","RCD PRTP0",128 ,0)
	3778	S DIR("A" )="Do you want to ca pture the output in a CSV form at"
	3779	"RTN","RCD PRTP0",129 ,0)
	3780	S DIR("B" )="NO"
	3781	"RTN","RCD PRTP0",130 ,0)
	3782	S DIR("?" ,1)="If yo u want to capture th e output f rom this r eport in a comma-sep arated"
	3783	"RTN","RCD PRTP0",131 ,0)
	3784	S DIR("?" ,2)="value s (CSV) fo rmat, then answer YE S here. A CSV forma t is somet hing that"
	3785	"RTN","RCD PRTP0",132 ,0)
	3786	S DIR("?" ,3)="could be easily imported into a spr eadsheet p rogram lik e Excel."
	3787	"RTN","RCD PRTP0",133 ,0)
	3788	S DIR("?" ,4)=" "
	3789	"RTN","RCD PRTP0",134 ,0)
	3790	S DIR("?" )="If you just want a normal r eport outp ut, then a nswer NO h ere."
	3791	"RTN","RCD PRTP0",135 ,0)
	3792	W ! D ^DI R K DIR
	3793	"RTN","RCD PRTP0",136 ,0)
	3794	W !!,"Com piling Cla ims Manage ment Repor t. Please wait ... "
	3795	"RTN","RCD PRTP0",137 ,0)
	3796	I $D(DIRU T) S RET=0 W $C(7)
	3797	"RTN","RCD PRTP0",138 ,0)
	3798	S RCEXCEL =Y
	3799	"RTN","RCD PRTP0",139 ,0)
	3800	Q RCEXCEL
	3801	"RTN","RCD PRTP0",140 ,0)
	3802	;
	3803	"RTN","RCD PRTP0",141 ,0)
	3804	DEVICE() ; Device Se lection
	3805	"RTN","RCD PRTP0",142 ,0)
	3806	; RCEXCEL =0 for nor mal output
	3807	"RTN","RCD PRTP0",143 ,0)
	3808	; RCEXCEL =1 for CSV (\| separa ted values ) for Exce l output
	3809	"RTN","RCD PRTP0",144 ,0)
	3810	; pass pa rameter by reference
	3811	"RTN","RCD PRTP0",145 ,0)
	3812	;
	3813	"RTN","RCD PRTP0",146 ,0)
	3814	N ZTRTN,Z TDESC,ZTSA VE,POP,RET ,ZTSK,DIR, X,Y
	3815	"RTN","RCD PRTP0",147 ,0)
	3816	S RET=1
	3817	"RTN","RCD PRTP0",148 ,0)
	3818	I 'RCEXCE L W !!,"Th is report is 132 cha racters wi de. Pleas e choose a n appropri ate device .",!
	3819	"RTN","RCD PRTP0",149 ,0)
	3820	I RCEXCEL D
	3821	"RTN","RCD PRTP0",150 ,0)
	3822	. W !!,"F or CSV out put, turn logging or capture o n now."
	3823	"RTN","RCD PRTP0",151 ,0)
	3824	. W !,"To avoid und esired wra pping of t he data sa ved to the file,"
	3825	"RTN","RCD PRTP0",152 ,0)
	3826	. W !,"pl ease enter ""0;256;9 9999"" at the ""DEVI CE:"" prom pt.",!
	3827	"RTN","RCD PRTP0",153 ,0)
	3828	;
	3829	"RTN","RCD PRTP0",154 ,0)
	3830	S ZTRTN=" PRINT^RCDP RTEX(RCEXC EL)"
	3831	"RTN","RCD PRTP0",155 ,0)
	3832	S ZTDESC= "Claims Ma tching Rep ort"
	3833	"RTN","RCD PRTP0",156 ,0)
	3834	S ZTSAVE( "RCTYPE(") =""
	3835	"RTN","RCD PRTP0",157 ,0)
	3836	S ZTSAVE( "RCBEG")=" "
	3837	"RTN","RCD PRTP0",158 ,0)
	3838	S ZTSAVE( "RCEND")=" "
	3839	"RTN","RCD PRTP0",159 ,0)
	3840	S ZTSAVE( "RCEXCEL") =""
	3841	"RTN","RCD PRTP0",160 ,0)
	3842	D EN^XUTM DEVQ(ZTRTN ,ZTDESC,.Z TSAVE,"QM" ,1)
	3843	"RTN","RCD PRTP0",161 ,0)
	3844	I POP S R ET=0
	3845	"RTN","RCD PRTP0",162 ,0)
	3846	I $G(ZTSK ) W !!,"Re port compi lation has started w ith task# ",ZTSK,"." ,! S DIR(0 )="E" D ^D IR
	3847	"RTN","RCD PRTP0",163 ,0)
	3848	Q RCEXCEL
	3849	"RTN","RCD PRTP0",164 ,0)
	3850	;
	3851	"RTN","RCD PRTP2")
	3852	0^4^B17924 750
	3853	"RTN","RCD PRTP2",1,0 )
	3854	RCDPRTP2 ; ALB/LDB - CLAIMS MAT CHING REPO RT ;1/26/0 1 3:16 PM
	3855	"RTN","RCD PRTP2",2,0 )
	3856	;;4.5;Acc ounts Rece ivable;1 51,276,303 ,315;Mar 20, 1995; Build 11
	3857	"RTN","RCD PRTP2",3,0 )
	3858	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3859	"RTN","RCD PRTP2",4,0 )
	3860	;
	3861	"RTN","RCD PRTP2",5,0 )
	3862	; Referen ce to $$TY P^IBRFN su pported by DBIA# 203 1
	3863	"RTN","RCD PRTP2",6,0 )
	3864	;
	3865	"RTN","RCD PRTP2",7,0 )
	3866	PRINT1 ;
	3867	"RTN","RCD PRTP2",8,0 )
	3868	N REJECT, RCTYP
	3869	"RTN","RCD PRTP2",9,0 )
	3870	I $Y>(IOS L-2) D PAU SE Q:$G(RC Q) D HDR^ RCDPRTP1,H DR1
	3871	"RTN","RCD PRTP2",10, 0)
	3872	; PRCA4. 5276 - ge t EEOB ind icator '%' and attach it to the bill numb er when ap plicable. Adjust rep ort tabs t o make roo m for EEOB indicator '%'.
	3873	"RTN","RCD PRTP2",11, 0)
	3874	N RC430 S RC430=+$O (^PRCA(430 ,"B",""_$P (RCIBDAT," ^",4)_"",0 ))
	3875	"RTN","RCD PRTP2",12, 0)
	3876	S RCEEOB= $$EEOB(RC4 30)
	3877	"RTN","RCD PRTP2",13, 0)
	3878	; #IA 606 0 for $$BI LLREJ^IBJT U6
	3879	"RTN","RCD PRTP2",14, 0)
	3880	S REJECT= $S($$BILLR EJ^IBJTU6( $P($P(RCIB DAT,"^",4) ,"-",2)):" c",1:" ") ;PRCA4.5 303 Add in dicator fo r rejects
	3881	"RTN","RCD PRTP2",15, 0)
	3882	W !,$S(RC TP=RCBILL: "",$D(RCT P(RCTP)):" ",1:" "), $G(RCEEOB) _REJECT_$P (RCIBDAT," ^",4),?17, $P(RCIBDAT ,"^",5),?2 4
	3883	"RTN","RCD PRTP2",16, 0)
	3884	W $$STAT( RCTP),?31, $$DATE(+RC IBDAT),?42 ,$$DATE($P (RCIBDAT," ^",2))
	3885	"RTN","RCD PRTP2",17, 0)
	3886	S Y=$S($G (RCTP(RCTP )):RCTP(RC TP),$G(^TM P("RCDPRTP B",$J,RCNA M,RCBILL)) :^(RCBILL) ,1:"") I R CTP=RCBILL !($D(RCTP( RCTP))) W ?53,$$DATE (Y)
	3887	"RTN","RCD PRTP2",18, 0)
	3888	S RCAMT=$ P($G(^PRCA (430,+RCTP ,0)),"^",3 ),RCAMT1=$ P($G(^PRCA (430,+RCTP ,7)),"^",7 ) W ?64,$J (RCAMT,9,2 )
	3889	"RTN","RCD PRTP2",19, 0)
	3890	W ?76,$J( RCAMT1,9,2 ) S RCAMT( 0)=RCAMT(0 )+RCAMT,RC AMT(1)=RCA MT(1)+RCAM T1
	3891	"RTN","RCD PRTP2",20, 0)
	3892	W ?88,$E( $P(RCIBDAT ,"^",7),1, 25)
	3893	"RTN","RCD PRTP2",21, 0)
	3894	; #IA 203 1 for $$TY P^IBRFN
	3895	"RTN","RCD PRTP2",22, 0)
	3896	S RCTYP=$ $TYP^IBRFN (RCTP) ; g et bill ty pe for an Accounts R eceivable
	3897	"RTN","RCD PRTP2",23, 0)
	3898	; Convert to single character care type s for:
	3899	"RTN","RCD PRTP2",24, 0)
	3900	; (I)npat ient, (O)u tpatient, (R)Prescri ption & (P )rosthetic s
	3901	"RTN","RCD PRTP2",25, 0)
	3902	S RCTYP=$ S(RCTYP="" :-1,RCTYP= "PR":"P",R CTYP="PH": "R",1:RCTY P)
	3903	"RTN","RCD PRTP2",26, 0)
	3904	W ?117,RC TYP
	3905	"RTN","RCD PRTP2",27, 0)
	3906	K RCTP(RC TP)
	3907	"RTN","RCD PRTP2",28, 0)
	3908	Q
	3909	"RTN","RCD PRTP2",29, 0)
	3910	;
	3911	"RTN","RCD PRTP2",30, 0)
	3912	PRINT2 ; Print the detail lin e for a fi rst party bill.
	3913	"RTN","RCD PRTP2",31, 0)
	3914	I $Y>(IOS L-2) D PAU SE Q:$G(RC Q) D HDR^ RCDPRTP1,H DR2
	3915	"RTN","RCD PRTP2",32, 0)
	3916	W !," ",$ P(RCIBDAT, "^",4),?14 ,$P(RCIBDA T,"^",6)
	3917	"RTN","RCD PRTP2",33, 0)
	3918	S RCIBFN= $P(RCIBDAT ,"^",4) I RCIBFN S R CIBFN=$O(^ PRCA(430," B",RCIBFN, 0))
	3919	"RTN","RCD PRTP2",34, 0)
	3920	; PRCA4. 5276 - ad just repor t tabs to make room for EEOB i ndicator ' %'.
	3921	"RTN","RCD PRTP2",35, 0)
	3922	W ?36,$$S TAT(RCIBFN ),?42,$$DA TE(+RCIBDA T),?54,$$D ATE($P(RCI BDAT,"^",2 ))
	3923	"RTN","RCD PRTP2",36, 0)
	3924	W ?66,$J( $P(RCIBDAT ,"^",5),9, 2),?78,$P( RCIBDAT,"^ ",7)
	3925	"RTN","RCD PRTP2",37, 0)
	3926	W ?87,$J( $S($G(^PRC A(430,+RCI BFN,7)):+( $P(^(7),"^ ")+$P(^(7) ,"^",2)+$P (^(7),"^", 3)+$P(^(7) ,"^",4)+$P (^(7),"^", 4)),1:0),9 ,2)
	3927	"RTN","RCD PRTP2",38, 0)
	3928	Q
	3929	"RTN","RCD PRTP2",39, 0)
	3930	;
	3931	"RTN","RCD PRTP2",40, 0)
	3932	;
	3933	"RTN","RCD PRTP2",41, 0)
	3934	PRINT3 ; P rint patie nt detail informatio n.
	3935	"RTN","RCD PRTP2",42, 0)
	3936	I $Y>(IOS L-5) D PAU SE Q:$G(RC Q) D HDR^ RCDPRTP1
	3937	"RTN","RCD PRTP2",43, 0)
	3938	S RCNAM1= ^TMP("RCDP RTPB",$J,R CNAM)
	3939	"RTN","RCD PRTP2",44, 0)
	3940	W !!,RCLI NE
	3941	"RTN","RCD PRTP2",45, 0)
	3942	W !,"NAME : ",$P(RCN AM,"^")," (",$E($P(R CNAM1,"^", 3),6,9)_") "
	3943	"RTN","RCD PRTP2",46, 0)
	3944	W !,"Prim . Elig: ", $P(RCNAM1, "^",2)
	3945	"RTN","RCD PRTP2",47, 0)
	3946	W ?44,"DO B: ",$P(RC NAM1,"^")
	3947	"RTN","RCD PRTP2",48, 0)
	3948	W ?61,"RX COVERAGE: ",$S('$G( ^TMP("IBRB T",$J,RCBI LL)):"NO", 1:"YES")
	3949	"RTN","RCD PRTP2",49, 0)
	3950	W !,RCLIN E
	3951	"RTN","RCD PRTP2",50, 0)
	3952	Q
	3953	"RTN","RCD PRTP2",51, 0)
	3954	;
	3955	"RTN","RCD PRTP2",52, 0)
	3956	HDR1 ;
	3957	"RTN","RCD PRTP2",53, 0)
	3958	W !!,"Thi rd Party B ills: * -> bill for which paym ent was po sted"
	3959	"RTN","RCD PRTP2",54, 0)
	3960	W !,"==== ========== ========== ====="
	3961	"RTN","RCD PRTP2",55, 0)
	3962	; PRCA4. 5276 - ad just repor t tabs to make room for EEOB i ndicator ' %'.
	3963	"RTN","RCD PRTP2",56, 0)
	3964	; PRCA4. 5315 - ad ded 1-char . care typ e (I)npati ent, (O)ut patient, ( R)x or (P) rosthetics ) under ne w Type col umn
	3965	"RTN","RCD PRTP2",57, 0)
	3966	W !!,"Bil l #",?15," P/S/T",?22 ,"Status", ?30,"Bill From",?42, "Bill To", ?53,"Poste d",?63,"Am t Billed", ?76,"Amt P aid",?88," Payor",?11 5,"Type"
	3967	"RTN","RCD PRTP2",58, 0)
	3968	W !,"---- ---------" ,?15,"---- -",?22,"-- ----",?30, "--------- ",?42,"--- -----",?53 ,"-------- ",?63,"--- -------",? 75,"------ ----",?88, "--------- ---------- ------",?1 15,"----"
	3969	"RTN","RCD PRTP2",59, 0)
	3970	Q
	3971	"RTN","RCD PRTP2",60, 0)
	3972	;
	3973	"RTN","RCD PRTP2",61, 0)
	3974	HDR2 ;
	3975	"RTN","RCD PRTP2",62, 0)
	3976	W !!,"Ass ociated Fi rst Party Charges:"
	3977	"RTN","RCD PRTP2",63, 0)
	3978	W !,"==== ========== ========== ======="
	3979	"RTN","RCD PRTP2",64, 0)
	3980	W !," Bil l #",?14," Charge Typ e",?34,"St atus",?42, "From/Fill ",?54,"To/ Rel",?65," Amt Billed ",?78,"On Hold",?87, " Balance "
	3981	"RTN","RCD PRTP2",65, 0)
	3982	W !,"---- -------",? 14,"------ ---------- ",?34,"--- ---",?42," ---------" ,?54,"---- -----",?65 ,"-------- --",?78,"- ------",?8 7," ------ ----"
	3983	"RTN","RCD PRTP2",66, 0)
	3984	Q
	3985	"RTN","RCD PRTP2",67, 0)
	3986	;
	3987	"RTN","RCD PRTP2",68, 0)
	3988	STAT(RCIBF N) ;AR Sta tus
	3989	"RTN","RCD PRTP2",69, 0)
	3990	I '$G(RCI BFN) Q ""
	3991	"RTN","RCD PRTP2",70, 0)
	3992	N RCSTAT
	3993	"RTN","RCD PRTP2",71, 0)
	3994	S RCSTAT= $P($G(^PRC A(430,+RCI BFN,0)),"^ ",8),RCSTA T=$P($G(^P RCA(430.3, +RCSTAT,0) ),"^",2)
	3995	"RTN","RCD PRTP2",72, 0)
	3996	Q RCSTAT
	3997	"RTN","RCD PRTP2",73, 0)
	3998	;
	3999	"RTN","RCD PRTP2",74, 0)
	4000	DATE(X) ; Convert Fi leMan date to mm/dd/ yy
	4001	"RTN","RCD PRTP2",75, 0)
	4002	Q $S($G(X ):$E(X,4,5 )_"/"_$E(X ,6,7)_"/"_ $E(X,2,3), 1:"")
	4003	"RTN","RCD PRTP2",76, 0)
	4004	;
	4005	"RTN","RCD PRTP2",77, 0)
	4006	;
	4007	"RTN","RCD PRTP2",78, 0)
	4008	PAUSE ; Pa ge break.
	4009	"RTN","RCD PRTP2",79, 0)
	4010	I $E(IOST ,1,2)'="C- " Q
	4011	"RTN","RCD PRTP2",80, 0)
	4012	N RCX,DIR ,DIRUT,DUO UT,DTOUT,D IROUT,X,Y
	4013	"RTN","RCD PRTP2",81, 0)
	4014	I IOSL<10 0 F RCX=$Y :1:(IOSL-3 ) W !
	4015	"RTN","RCD PRTP2",82, 0)
	4016	S DIR(0)= "E" D ^DIR I $D(DIRU T)!($D(DUO UT)) S RCQ =1
	4017	"RTN","RCD PRTP2",83, 0)
	4018	Q
	4019	"RTN","RCD PRTP2",84, 0)
	4020	;
	4021	"RTN","RCD PRTP2",85, 0)
	4022	EEOB(RCBIL L) ; PRCA* 4.5*276 - get EEOB i ndicator f or a bill
	4023	"RTN","RCD PRTP2",86, 0)
	4024	; Interac tion with IB file #3 61.1 cover ed by IA # 4051.
	4025	"RTN","RCD PRTP2",87, 0)
	4026	; RCBILL is the IEN of the bi ll in file s #399/#43 0 and must be valid,
	4027	"RTN","RCD PRTP2",88, 0)
	4028	; Exclude an EOB ty pe of MRA when getti ng payment informati on. Return
	4029	"RTN","RCD PRTP2",89, 0)
	4030	; the EEO B indicato r '%' if p ayment act ivity was found.
	4031	"RTN","RCD PRTP2",90, 0)
	4032	;
	4033	"RTN","RCD PRTP2",91, 0)
	4034	N RCEEOB, RCVAL,Z
	4035	"RTN","RCD PRTP2",92, 0)
	4036	I $G(RCBI LL)=0 Q ""
	4037	"RTN","RCD PRTP2",93, 0)
	4038	I '$O(^IB M(361.1,"B ",RCBILL,0 )) Q "" ; no matchi ng entry f or bill
	4039	"RTN","RCD PRTP2",94, 0)
	4040	I $P($G(^ DGCR(399,R CBILL,0)), "^",13)=1 Q "" ;avo id 'ENTERE D/NOT REVI EWED' stat us
	4041	"RTN","RCD PRTP2",95, 0)
	4042	; handle both singl e and mult iple bill entries in file #361 .1
	4043	"RTN","RCD PRTP2",96, 0)
	4044	S Z=0 F S Z=$O(^IB M(361.1,"B ",RCBILL,Z )) Q:'Z D Q:$G(RCE EOB)="%"
	4045	"RTN","RCD PRTP2",97, 0)
	4046	. S RCVAL =$G(^IBM(3 61.1,Z,0))
	4047	"RTN","RCD PRTP2",98, 0)
	4048	. S RCEEO B=$S($P(RC VAL,"^",4) =1:"",$P(R CVAL,"^",4 )=0:"%",1: "")
	4049	"RTN","RCD PRTP2",99, 0)
	4050	Q RCEEOB ; EEOB in dicator fo r 1st/3rd party paym ent on bil l
	4051	"RTN","RCM SITE")
	4052	0^7^B10167 680
	4053	"RTN","RCM SITE",1,0)
	4054	RCMSITE ;A LB/RRG - E DIT SITE P ARAMETERS ;Jul 02, 2 014@15:46: 14
	4055	"RTN","RCM SITE",2,0)
	4056	V ;;4.5;Ac counts Rec eivable;** 173,236,25 3,298,315* *;Mar 20, 1995;Build 11
	4057	"RTN","RCM SITE",3,0)
	4058	;Per VA D irective 6 402, this routine sh ould not b e modified .
	4059	"RTN","RCM SITE",4,0)
	4060	;
	4061	"RTN","RCM SITE",5,0)
	4062	BEG ;Start editing s ite paramt ers
	4063	"RTN","RCM SITE",6,0)
	4064	N DA,DIC, DIE,DLAYGO ,DR,X,Y
	4065	"RTN","RCM SITE",7,0)
	4066	; edit SI TE field ( #.01) in A R SITE PAR AMETER fil e (#342)
	4067	"RTN","RCM SITE",8,0)
	4068	S DIC="^R C(342,",DI C(0)="QEAM L",DLAYGO= 342 D ^DIC I Y>0 S D A=+Y,DR=.0 1,DIE="^RC (342," D ^ DIE
	4069	"RTN","RCM SITE",9,0)
	4070	Q
	4071	"RTN","RCM SITE",10,0 )
	4072	;
	4073	"RTN","RCM SITE",11,0 )
	4074	ALC ;Edit ALC parame ter
	4075	"RTN","RCM SITE",12,0 )
	4076	NEW DIC,D R,DA,Y
	4077	"RTN","RCM SITE",13,0 )
	4078	S DIE="^R C(342,",DA =1,DR=".07 ;31" D ^DI E
	4079	"RTN","RCM SITE",14,0 )
	4080	Q
	4081	"RTN","RCM SITE",15,0 )
	4082	IRS ;Edit IRS OFFSET site para meters
	4083	"RTN","RCM SITE",16,0 )
	4084	NEW DIE,D R,DA,Y
	4085	"RTN","RCM SITE",17,0 )
	4086	I '$D(^RC (342,1,0)) D BEG G:' $D(^RC(342 ,1,0)) Q
	4087	"RTN","RCM SITE",18,0 )
	4088	S DA=1,DR ="[RCMS IR S]",DIE="^ RC(342," D ^DIE
	4089	"RTN","RCM SITE",19,0 )
	4090	Q Q
	4091	"RTN","RCM SITE",20,0 )
	4092	STAT ;Edit NOTIFICAT ION site p arameters
	4093	"RTN","RCM SITE",21,0 )
	4094	NEW DIE,D R,DA,Y
	4095	"RTN","RCM SITE",22,0 )
	4096	I '$D(^RC (342,1,0)) D BEG G:' $D(^RC(342 ,1,0)) Q1
	4097	"RTN","RCM SITE",23,0 )
	4098	S DA=1,DR ="[RCMS NO TIFICATION ]",DIE="^R C(342," D ^DIE
	4099	"RTN","RCM SITE",24,0 )
	4100	Q1 Q
	4101	"RTN","RCM SITE",25,0 )
	4102	GRP ;Edit AR Group P arameters
	4103	"RTN","RCM SITE",26,0 )
	4104	NEW DIE,D R,DA,Y
	4105	"RTN","RCM SITE",27,0 )
	4106	F W ! S DIC(0)="QE AML",DIC=" ^RC(342.1, ",DLAYGO=3 42.1 D ^DI C K DIC G: Y<0 Q3 S D A=+Y,DIE=" ^RC(342.1, ",DR=$P($G (^RC(342.2 ,+$P(^RC(3 42.1,+Y,0) ,"^",2),1) ),"^") I D R]"" D ^DI E
	4107	"RTN","RCM SITE",28,0 )
	4108	Q3 Q
	4109	"RTN","RCM SITE",29,0 )
	4110	DEA ;Deact ive an AR group
	4111	"RTN","RCM SITE",30,0 )
	4112	NEW DIE,D IC,DA,DR,Y ,GRP
	4113	"RTN","RCM SITE",31,0 )
	4114	S DIC="^R C(342.1,", DIC(0)="QE AM",DIC("S ")="I $P(^ (0),""^"", 2)'=7" D ^ DIC Q:Y<0 S GRP=+Y
	4115	"RTN","RCM SITE",32,0 )
	4116	W ! S DIR ("A")="Are you sure you want t o Deactive Group '"_ $P(^RC(342 .1,GRP,0), "^")_"'",D IR(0)="Y", DIR("B")=" NO" D ^DIR K DIR
	4117	"RTN","RCM SITE",33,0 )
	4118	I 'Y W !! ,"* NO A CTION TAKE N *" Q
	4119	"RTN","RCM SITE",34,0 )
	4120	I Y S DIE ="^RC(342. 1,",DA=GRP ,DR=".02// //^S X=7" D ^DIE W ! !,"* Gro up Deactiv ated *"
	4121	"RTN","RCM SITE",35,0 )
	4122	Q
	4123	"RTN","RCM SITE",36,0 )
	4124	SITE() ;Re turn site number
	4125	"RTN","RCM SITE",37,0 )
	4126	Q +$G(^DI C(4,+$P($G (^RC(342,1 ,0)),"^"), 99))
	4127	"RTN","RCM SITE",38,0 )
	4128	INT ;Print Inter/Adm in/Pen eff ective rep ort
	4129	"RTN","RCM SITE",39,0 )
	4130	NEW DIC,B Y,FR,TO,FL DS,L
	4131	"RTN","RCM SITE",40,0 )
	4132	S DIC="^R C(342,",BY =.01,(FR,T O)="",FLDS ="[RCMS IN T/ADM/PEN] ",L=0 D EN 1^DIP
	4133	"RTN","RCM SITE",41,0 )
	4134	Q
	4135	"RTN","RCM SITE",42,0 )
	4136	UPINT ;Upd ate Rate s ite parame ters
	4137	"RTN","RCM SITE",43,0 )
	4138	NEW DIE,D R,DA,Y,IOP
	4139	"RTN","RCM SITE",44,0 )
	4140	S IOP=ION D INT
	4141	"RTN","RCM SITE",45,0 )
	4142	I '$D(^XU SEC("PRCAF LATE CHAR GES",DUZ)) D BMES^XP DUTL("A Se curity Key is requir ed to edit the Inter est/Admin and Penalt y Rates.") Q ;PRCA* 4.5*315 Ad ded Securi ty Key
	4143	"RTN","RCM SITE",46,0 )
	4144	I '$D(^RC (342,1,0)) D BEG G:' $D(^RC(342 ,1,0)) Q4
	4145	"RTN","RCM SITE",47,0 )
	4146	F W ! S DA=1,DR="[ RCMS RATES ]",DIE="^R C(342," D ^DIE Q:$D( Y)
	4147	"RTN","RCM SITE",48,0 )
	4148	Q4 Q
	4149	"RTN","RCM SITE",49,0 )
	4150	;
	4151	"RTN","RCM SITE",50,0 )
	4152	EDILOCK() ; function , Update E DI Lockbox site para meters
	4153	"RTN","RCM SITE",51,0 )
	4154	; returns 1 on succ ess, else "^error me ssage"
	4155	"RTN","RCM SITE",52,0 )
	4156	N RSLT S RSLT=""
	4157	"RTN","RCM SITE",53,0 )
	4158	I '$D(^RC (342,1,0)) D BEG
	4159	"RTN","RCM SITE",54,0 )
	4160	S:'$D(^RC (342,1,0)) RSLT="^no site defi ned" ; ca n't contin ue
	4161	"RTN","RCM SITE",55,0 )
	4162	;
	4163	"RTN","RCM SITE",56,0 )
	4164	Q:RSLT]"" RSLT
	4165	"RTN","RCM SITE",57,0 )
	4166	;
	4167	"RTN","RCM SITE",58,0 )
	4168	N DA,DIE, DR,Y
	4169	"RTN","RCM SITE",59,0 )
	4170	S DA=1,DR ="[RCMS ED I LOCKBOX] ",DIE="^RC (342," D ^ DIE
	4171	"RTN","RCM SITE",60,0 )
	4172	S RSLT=$S ($D(Y):"^u ser aborte d",1:1) ; if Y rema ins from ^ DIE call
	4173	"RTN","RCM SITE",61,0 )
	4174	;
	4175	"RTN","RCM SITE",62,0 )
	4176	Q RSLT ; success
	4177	"RTN","RCM SITE",63,0 )
	4178	;
	4179	"RTN","RCM SITE",64,0 )
	4180	EDITRDDT ; Update # O F DAYS FOR RD ELIG C HG RPT sit e paramete r
	4181	"RTN","RCM SITE",65,0 )
	4182	;This is the number of days f or the Rat ed Disabil ity Eligib ility
	4183	"RTN","RCM SITE",66,0 )
	4184	;Change R eport to b e used whe n the repo rt is sche duled to b e run
	4185	"RTN","RCM SITE",67,0 )
	4186	;on a rec urring bas is. (Added for Hold Debt to DM C Project)
	4187	"RTN","RCM SITE",68,0 )
	4188	N DIE,DR, DA,Y
	4189	"RTN","RCM SITE",69,0 )
	4190	I '$D(^RC (342,1,0)) D BEG G:' $D(^RC(342 ,1,0)) Q6
	4191	"RTN","RCM SITE",70,0 )
	4192	S DA=1,DR ="8.01",DI E="^RC(342 ," D ^DIE
	4193	"RTN","RCM SITE",71,0 )
	4194	Q6 Q
	4195	"RTN","RCM SITE",72,0 )
	4196	;
	4197	"RTN","RCM SITE",73,0 )
	4198	GETRDDAY() ;Return # OF DAYS F OR RD ELIG CHG RPT s ite parame ter
	4199	"RTN","RCM SITE",74,0 )
	4200	Q $$GET1^ DIQ(342,1_ ",",8.01)
	4201	"RTN","RCM SITE",75,0 )
	4202	;
	4203	"RTN","RCM SITE",76,0 )
	4204	EDITRDAY ; Update NUM BER OF DAY S FOR DMC REPORTS si te paramet er.
	4205	"RTN","RCM SITE",77,0 )
	4206	;This is the number of days i n the past bills for episodes
	4207	"RTN","RCM SITE",78,0 )
	4208	;of care will be in cluded for the follo wing repor ts when sc heduled by
	4209	"RTN","RCM SITE",79,0 )
	4210	;IRM to b e run on a recurring basis:
	4211	"RTN","RCM SITE",80,0 )
	4212	; DMC D ebt Validi ty Report
	4213	"RTN","RCM SITE",81,0 )
	4214	; DMC D ebt Validi ty Managem ent Report
	4215	"RTN","RCM SITE",82,0 )
	4216	; Rated Disabilit y Eligibil ity Change Report
	4217	"RTN","RCM SITE",83,0 )
	4218	;The mini mum value for this f ield is 36 5 days (1 year) and the maximu m
	4219	"RTN","RCM SITE",84,0 )
	4220	;value is 3650 days (10 years ). If no v alue is ad ded in thi s field th e
	4221	"RTN","RCM SITE",85,0 )
	4222	;report w ill defaul t to 365 d ays. (Adde d for Hold Debt to D MC Project )
	4223	"RTN","RCM SITE",86,0 )
	4224	N DIE,DR, DA,Y
	4225	"RTN","RCM SITE",87,0 )
	4226	I '$D(^RC (342,1,0)) D BEG G:' $D(^RC(342 ,1,0)) Q7
	4227	"RTN","RCM SITE",88,0 )
	4228	S DA=1,DR ="8.02",DI E="^RC(342 ," D ^DIE
	4229	"RTN","RCM SITE",89,0 )
	4230	Q7 Q
	4231	"RTN","RCM SITE",90,0 )
	4232	;
	4233	"RTN","RCM SITE",91,0 )
	4234	GETRDAY() ;Return NU MBER OF DA YS FOR DMC REPORTS s ite parame ter
	4235	"RTN","RCM SITE",92,0 )
	4236	Q $$GET1^ DIQ(342,1_ ",",8.02)
	4237	"RTN","RCM SITE",93,0 )
	4238	;
	4239	"RTN","RCR JRCOR")
	4240	0^6^B66950 576
	4241	"RTN","RCR JRCOR",1,0 )
	4242	RCRJRCOR ; WISC/RFJ-a r data col lector sum mary repor t ;1 Mar 9 7
	4243	"RTN","RCR JRCOR",2,0 )
	4244	;;4.5;Acc ounts Rece ivable;6 8,96,139,1 03,156,170 ,174,191,2 20,138,239 ;Mar 20, 1995;Buil d 11
	4245	"RTN","RCR JRCOR",3,0 )
	4246	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	4247	"RTN","RCR JRCOR",4,0 )
	4248	Q
	4249	"RTN","RCR JRCOR",5,0 )
	4250	;
	4251	"RTN","RCR JRCOR",6,0 )
	4252	;
	4253	"RTN","RCR JRCOR",7,0 )
	4254	SEND ; se nd data to ndb and d ata to FMS
	4255	"RTN","RCR JRCOR",8,0 )
	4256	N %,AMOUN T,DATEMOYR ,FUND,LINE ,RSC,SPACE ,TOTAL,TOT ALFUN,TOTA LTYP,TYPE, X,XMY,Y
	4257	"RTN","RCR JRCOR",9,0 )
	4258	;
	4259	"RTN","RCR JRCOR",10, 0)
	4260	; ------ ---- send to ndb --- -------
	4261	"RTN","RCR JRCOR",11, 0)
	4262	; data s tored in t mp($j,rcrj rcolndb)
	4263	"RTN","RCR JRCOR",12, 0)
	4264	I '$G(RCR JFAR1) D N DB(PRCASIT E,DATEBEG, DATEEND)
	4265	"RTN","RCR JRCOR",13, 0)
	4266	;
	4267	"RTN","RCR JRCOR",14, 0)
	4268	;
	4269	"RTN","RCR JRCOR",15, 0)
	4270	; ------ ---- send sv to fms ----------
	4271	"RTN","RCR JRCOR",16, 0)
	4272	; data s tored in t mp($j,rcrj rcolsv)
	4273	"RTN","RCR JRCOR",17, 0)
	4274	; rcrjfs v is a fla g set in t he routine rcrjrco f or retrans mission
	4275	"RTN","RCR JRCOR",18, 0)
	4276	; to pre vent accep ted fms do cuments fr om being r esent
	4277	"RTN","RCR JRCOR",19, 0)
	4278	I '$G(RCR JFSV) D ST ARTSV^RCXF MSSV(DATEE ND)
	4279	"RTN","RCR JRCOR",20, 0)
	4280	;
	4281	"RTN","RCR JRCOR",21, 0)
	4282	;
	4283	"RTN","RCR JRCOR",22, 0)
	4284	; ------ ---- send wr to fms ----------
	4285	"RTN","RCR JRCOR",23, 0)
	4286	; data s tored in t mp($j,rcrj rcolwr)
	4287	"RTN","RCR JRCOR",24, 0)
	4288	; rcrjfw r is a fla g set in t he routine rcrjrco f or retrans mission
	4289	"RTN","RCR JRCOR",25, 0)
	4290	; to pre vent accep ted fms do cuments fr om being r esent
	4291	"RTN","RCR JRCOR",26, 0)
	4292	I '$G(RCR JFWR) D ST ARTWR^RCXF MSWR(DATEE ND)
	4293	"RTN","RCR JRCOR",27, 0)
	4294	;
	4295	"RTN","RCR JRCOR",28, 0)
	4296	; ------ ---- send tr to fms ----------
	4297	"RTN","RCR JRCOR",29, 0)
	4298	N RCTRANS
	4299	"RTN","RCR JRCOR",30, 0)
	4300	; this c all return s rctrans array (see rcxfmstx for descri ption)
	4301	"RTN","RCR JRCOR",31, 0)
	4302	; rcrjft r is a fla g set in t he routine rcrjrco f or retrans mission
	4303	"RTN","RCR JRCOR",32, 0)
	4304	; to pre vent accep ted fms do cuments fr om being r esent
	4305	"RTN","RCR JRCOR",33, 0)
	4306	I '$G(RCR JFTR) D ST ARTTR^RCXF MSTX(DATEE ND)
	4307	"RTN","RCR JRCOR",34, 0)
	4308	;
	4309	"RTN","RCR JRCOR",35, 0)
	4310	; ------ ---- send oig extrac t -------- --
	4311	"RTN","RCR JRCOR",36, 0)
	4312	; data s tored in t mp(j,rcrjr oig)
	4313	"RTN","RCR JRCOR",37, 0)
	4314	; get no n-mccf bil ls for ext ract and u ser report
	4315	"RTN","RCR JRCOR",38, 0)
	4316	D NONMCCF ^RCRJROIG( DATEEND)
	4317	"RTN","RCR JRCOR",39, 0)
	4318	; rcrjfo ig is a fl ag set in the routin e rcrjrco for retran smission
	4319	"RTN","RCR JRCOR",40, 0)
	4320	; to pre vent the o ig extract from bein g resent
	4321	"RTN","RCR JRCOR",41, 0)
	4322	I '$G(RCR JFOIG) D O IG^RCRJROI G(DATEEND)
	4323	"RTN","RCR JRCOR",42, 0)
	4324	;
	4325	"RTN","RCR JRCOR",43, 0)
	4326	; genera te a mailm an message to the gr oup showin g the data
	4327	"RTN","RCR JRCOR",44, 0)
	4328	K ^TMP($J ,"RCRJRCOR MM")
	4329	"RTN","RCR JRCOR",45, 0)
	4330	S Y=$E(DA TEEND,1,5) _"00" D DD ^%DT S DAT EMOYR=Y
	4331	"RTN","RCR JRCOR",46, 0)
	4332	S LINE=0, SPACE="",$ P(SPACE," ",80)=""
	4333	"RTN","RCR JRCOR",47, 0)
	4334	D SET("Da ta has bee n collecte d for the month "_DA TEMOYR_". The data has been")
	4335	"RTN","RCR JRCOR",48, 0)
	4336	D SET("tr ansmitted to the fol lowing sys tems:")
	4337	"RTN","RCR JRCOR",49, 0)
	4338	D SET(" " )
	4339	"RTN","RCR JRCOR",50, 0)
	4340	;
	4341	"RTN","RCR JRCOR",51, 0)
	4342	I '$G(RCR JFAR1) D
	4343	"RTN","RCR JRCOR",52, 0)
	4344	. D SET ("NATIONAL DATABASE DATA")
	4345	"RTN","RCR JRCOR",53, 0)
	4346	. D SET ("-------- ---------- ----")
	4347	"RTN","RCR JRCOR",54, 0)
	4348	. D SET ("The data has been sent to th e National Database. For a de tail list" )
	4349	"RTN","RCR JRCOR",55, 0)
	4350	. D SET ("of the d ata sent, please rev iew the Re turn Repor ts which a re sent")
	4351	"RTN","RCR JRCOR",56, 0)
	4352	. D SET ("from the National Database." )
	4353	"RTN","RCR JRCOR",57, 0)
	4354	. D SET (" ")
	4355	"RTN","RCR JRCOR",58, 0)
	4356	;
	4357	"RTN","RCR JRCOR",59, 0)
	4358	I '$G(RCR JFSV) D
	4359	"RTN","RCR JRCOR",60, 0)
	4360	. D SET ("FMS, STA NDARD VOUC HER (SV) D OCUMENT")
	4361	"RTN","RCR JRCOR",61, 0)
	4362	. D SET ("-------- ---------- ---------- -------")
	4363	"RTN","RCR JRCOR",62, 0)
	4364	. D SET ("The foll owing data has been transmitte d to FMS i n the SV d ocument:")
	4365	"RTN","RCR JRCOR",63, 0)
	4366	. D SET (" Revenu e Source C ode Type Amount ")
	4367	"RTN","RCR JRCOR",64, 0)
	4368	. D SET (" ------ ---------- --- ---- ------ ")
	4369	"RTN","RCR JRCOR",65, 0)
	4370	. S TOT AL=0
	4371	"RTN","RCR JRCOR",66, 0)
	4372	. S TYP E="" F S TYPE=$O(^T MP($J,"RCR JRCOLSV",T YPE)) Q:TY PE="" D
	4373	"RTN","RCR JRCOR",67, 0)
	4374	. . I TYPE=17!( TYPE=18) Q ; disp lay the Me dicare tot als later
	4375	"RTN","RCR JRCOR",68, 0)
	4376	. . S TOTALTYP= 0
	4377	"RTN","RCR JRCOR",69, 0)
	4378	. . S FUND="" F S FUND=$ O(^TMP($J, "RCRJRCOLS V",TYPE,FU ND)) Q:FUN D="" D
	4379	"RTN","RCR JRCOR",70, 0)
	4380	. . . S TOTAL FUN=0
	4381	"RTN","RCR JRCOR",71, 0)
	4382	. . . S RSC=" " F S RSC =$O(^TMP($ J,"RCRJRCO LSV",TYPE, FUND,RSC)) Q:RSC="" S AMOUNT= ^(RSC) D
	4383	"RTN","RCR JRCOR",72, 0)
	4384	. . . . D S ET(" "_RS C_" "_$E($ $GETDESC^R CXFMSPR(RS C)_SPACE,1 ,54)_" "_ TYPE_$J(AM OUNT,13,2) )
	4385	"RTN","RCR JRCOR",73, 0)
	4386	. . . . S T OTALFUN=TO TALFUN+AMO UNT
	4387	"RTN","RCR JRCOR",74, 0)
	4388	. . . . S T OTALTYP=TO TALTYP+AMO UNT
	4389	"RTN","RCR JRCOR",75, 0)
	4390	. . . . S T OTAL=TOTAL +AMOUNT
	4391	"RTN","RCR JRCOR",76, 0)
	4392	. . . ;
	4393	"RTN","RCR JRCOR",77, 0)
	4394	. . . N RCFUN D S RCFUND =$S($E(DAT EEND,2,5)< "0410":$E( FUND,1,4)_ "."_$E(FUN D,6),1:$E( FUND,1,4)_ "0"_$E(FUN D,6))
	4395	"RTN","RCR JRCOR",78, 0)
	4396	. . . I TYPE= 21 D SET($ E(" Sub-T otal by Fu nd "_RCFUN D_":"_SPAC E,1,38)_$J (TOTALFUN, 12,2))
	4397	"RTN","RCR JRCOR",79, 0)
	4398	. . ;
	4399	"RTN","RCR JRCOR",80, 0)
	4400	. . D SET(" ------ ----")
	4401	"RTN","RCR JRCOR",81, 0)
	4402	. . D SET(" TO TAL TYPE " _TYPE_$J(T OTALTYP,13 ,2))
	4403	"RTN","RCR JRCOR",82, 0)
	4404	. . D SET(" ")
	4405	"RTN","RCR JRCOR",83, 0)
	4406	. ;
	4407	"RTN","RCR JRCOR",84, 0)
	4408	. ; Dis play Medic are totals and updat e the SV t otal
	4409	"RTN","RCR JRCOR",85, 0)
	4410	. S AMO UNT=+$G(^T MP($J,"RCR JRCOLSV",1 7)),TOTAL= TOTAL+AMOU NT
	4411	"RTN","RCR JRCOR",86, 0)
	4412	. D SET (" M edicare Co ntractual Adjustment TOTAL TYPE 17"_$ J(AMOUNT,1 3,2))
	4413	"RTN","RCR JRCOR",87, 0)
	4414	. S AMO UNT=+$G(^T MP($J,"RCR JRCOLSV",1 8)),TOTAL= TOTAL+AMOU NT
	4415	"RTN","RCR JRCOR",88, 0)
	4416	. D SET (" U nreimbursa ble Medica re Expense TOTAL TYPE 18"_$ J(AMOUNT,1 3,2))
	4417	"RTN","RCR JRCOR",89, 0)
	4418	. D SET (" ")
	4419	"RTN","RCR JRCOR",90, 0)
	4420	. ;
	4421	"RTN","RCR JRCOR",91, 0)
	4422	. D SET (" ---------- ")
	4423	"RTN","RCR JRCOR",92, 0)
	4424	. D SET (" T OTAL SV"_$ J(TOTAL,13 ,2))
	4425	"RTN","RCR JRCOR",93, 0)
	4426	. D SET (" ")
	4427	"RTN","RCR JRCOR",94, 0)
	4428	;
	4429	"RTN","RCR JRCOR",95, 0)
	4430	I '$G(RCR JFWR) D
	4431	"RTN","RCR JRCOR",96, 0)
	4432	. D SET ("FMS, WRI TEOFFS/CON TRACT ADJU STMENTS (W R) DOCUMEN T")
	4433	"RTN","RCR JRCOR",97, 0)
	4434	. D SET ("-------- ---------- ---------- ---------- ---------- -")
	4435	"RTN","RCR JRCOR",98, 0)
	4436	. D SET ("The foll owing data has been transmitte d to FMS i n the WR d ocument:")
	4437	"RTN","RCR JRCOR",99, 0)
	4438	. D SET (" Revenu e Source C ode Type Amount ")
	4439	"RTN","RCR JRCOR",100 ,0)
	4440	. D SET (" ------ ---------- --- ---- ------ ")
	4441	"RTN","RCR JRCOR",101 ,0)
	4442	. S TOT AL=0
	4443	"RTN","RCR JRCOR",102 ,0)
	4444	. S TYP E="" F S TYPE=$O(^T MP($J,"RCR JRCOLWR",T YPE)) Q:TY PE="" D
	4445	"RTN","RCR JRCOR",103 ,0)
	4446	. . S TOTALTYP= 0
	4447	"RTN","RCR JRCOR",104 ,0)
	4448	. . S FUND="" F S FUND=$ O(^TMP($J, "RCRJRCOLW R",TYPE,FU ND)) Q:FUN D="" D
	4449	"RTN","RCR JRCOR",105 ,0)
	4450	. . . S TOTAL FUN=0
	4451	"RTN","RCR JRCOR",106 ,0)
	4452	. . . S RSC=" " F S RSC =$O(^TMP($ J,"RCRJRCO LWR",TYPE, FUND,RSC)) Q:RSC="" S AMOUNT= ^(RSC) D
	4453	"RTN","RCR JRCOR",107 ,0)
	4454	. . . . D S ET(" "_RS C_" "_$E($ $GETDESC^R CXFMSPR(RS C)_SPACE,1 ,54)_" "_ TYPE_$J(AM OUNT,13,2) )
	4455	"RTN","RCR JRCOR",108 ,0)
	4456	. . . . S T OTALFUN=TO TALFUN+AMO UNT
	4457	"RTN","RCR JRCOR",109 ,0)
	4458	. . . . S T OTALTYP=TO TALTYP+AMO UNT
	4459	"RTN","RCR JRCOR",110 ,0)
	4460	. . . . S T OTAL=TOTAL +AMOUNT
	4461	"RTN","RCR JRCOR",111 ,0)
	4462	. . . ;
	4463	"RTN","RCR JRCOR",112 ,0)
	4464	. . . N RCFUN D S RCFUND =$S($E(DAT EEND,2,5)< "0410":$E( FUND,1,4)_ "."_$E(FUN D,6),1:$E( FUND,1,4)_ "0"_$E(FUN D,6))
	4465	"RTN","RCR JRCOR",113 ,0)
	4466	. . . I TYPE= 37 D SET($ E(" Sub-T otal by Fu nd "_RCFUN D_":"_SPAC E,1,38)_$J (TOTALFUN, 12,2))
	4467	"RTN","RCR JRCOR",114 ,0)
	4468	. . ;
	4469	"RTN","RCR JRCOR",115 ,0)
	4470	. . D SET(" ------ ----")
	4471	"RTN","RCR JRCOR",116 ,0)
	4472	. . D SET(" TO TAL TYPE " _TYPE_$J(T OTALTYP,13 ,2))
	4473	"RTN","RCR JRCOR",117 ,0)
	4474	. . D SET(" ")
	4475	"RTN","RCR JRCOR",118 ,0)
	4476	. D SET (" ---------- ")
	4477	"RTN","RCR JRCOR",119 ,0)
	4478	. D SET (" T OTAL WR"_$ J(TOTAL,13 ,2))
	4479	"RTN","RCR JRCOR",120 ,0)
	4480	. D SET (" ")
	4481	"RTN","RCR JRCOR",121 ,0)
	4482	;
	4483	"RTN","RCR JRCOR",122 ,0)
	4484	I '$G(RCR JFTR) D
	4485	"RTN","RCR JRCOR",123 ,0)
	4486	. D SET ("FMS, TRA NSFER FROM MCCF TO H SIF (TR) D OCUMENT")
	4487	"RTN","RCR JRCOR",124 ,0)
	4488	. D SET ("-------- ---------- ---------- ---------- ---------- -")
	4489	"RTN","RCR JRCOR",125 ,0)
	4490	. D SET ("The foll owing data has been transmitte d to FMS i n the TR d ocument:")
	4491	"RTN","RCR JRCOR",126 ,0)
	4492	. D SET (" From F und Fro m RSC To Fund To RSC Amount ")
	4493	"RTN","RCR JRCOR",127 ,0)
	4494	. D SET (" ------ --- --- ----- ------- ------ ---------- ")
	4495	"RTN","RCR JRCOR",128 ,0)
	4496	. I $O( RCTRANS("" ))="" D SE T(" No Do llars to T ransfer.") Q
	4497	"RTN","RCR JRCOR",129 ,0)
	4498	. ;
	4499	"RTN","RCR JRCOR",130 ,0)
	4500	. S FUN D="" F S FUND=$O(RC TRANS(FUND )) Q:FUND= "" D
	4501	"RTN","RCR JRCOR",131 ,0)
	4502	. . S RSC="" F S RSC=$O( RCTRANS(FU ND,RSC)) Q :RSC="" D
	4503	"RTN","RCR JRCOR",132 ,0)
	4504	. . . ; rctr ans(fromfu nd,fromrsc ) = tofund ^ torsc ^ amount
	4505	"RTN","RCR JRCOR",133 ,0)
	4506	. . . S AMOUN T=RCTRANS( FUND,RSC)
	4507	"RTN","RCR JRCOR",134 ,0)
	4508	. . . D SET($ J(FUND,11) _$J(RSC,12 )_$J($P(AM OUNT,"^"), 14)_$J($P( AMOUNT,"^" ,2),10)_$J ($P(AMOUNT ,"^",3),31 ,2))
	4509	"RTN","RCR JRCOR",135 ,0)
	4510	;
	4511	"RTN","RCR JRCOR",136 ,0)
	4512	S XMY("G. RC AR DATA COLLECTOR ")=""
	4513	"RTN","RCR JRCOR",137 ,0)
	4514	S %=$$SEN DMSG("AR D ata Collec tor for "_ DATEMOYR_" Station " _PRCASITE, .XMY)
	4515	"RTN","RCR JRCOR",138 ,0)
	4516	K ^TMP($J ,"RCRJRCOR MM")
	4517	"RTN","RCR JRCOR",139 ,0)
	4518	;
	4519	"RTN","RCR JRCOR",140 ,0)
	4520	; send u sers detai l report
	4521	"RTN","RCR JRCOR",141 ,0)
	4522	;D USERRE PT^RCRJRCO U(DATEMOYR ) ;remove d from bac kround job p315 (FY1 6 HAPE RRE PRCA4.5 315)
	4523	"RTN","RCR JRCOR",142 ,0)
	4524	Q
	4525	"RTN","RCR JRCOR",143 ,0)
	4526	;
	4527	"RTN","RCR JRCOR",144 ,0)
	4528	;
	4529	"RTN","RCR JRCOR",145 ,0)
	4530	NDB(PRCASI TE,DATEBEG ,DATEEND) ; send da ta to the national d atabase
	4531	"RTN","RCR JRCOR",146 ,0)
	4532	N %,BATCN AME,COUNT, CRITERIA,D ATA,LINE,X MY,X,Y
	4533	"RTN","RCR JRCOR",147 ,0)
	4534	K ^TMP($J ,"RCRJRCOR MM")
	4535	"RTN","RCR JRCOR",148 ,0)
	4536	S LINE=2, DATA="D$ "
	4537	"RTN","RCR JRCOR",149 ,0)
	4538	S CRITERI A="" F COU NT=1:1 S C RITERIA=$O (^TMP($J," RCRJRCOLND B",CRITERI A)) Q:CRIT ERIA="" D
	4539	"RTN","RCR JRCOR",150 ,0)
	4540	. S DAT A=DATA_":" _COUNT_"/" _CRITERIA_ "/"_^TMP($ J,"RCRJRCO LNDB",CRIT ERIA)
	4541	"RTN","RCR JRCOR",151 ,0)
	4542	. I $L( DATA)>200 D SET(DATA ) S DATA=" D$ "
	4543	"RTN","RCR JRCOR",152 ,0)
	4544	I DATA'=" D$ " D SET (DATA)
	4545	"RTN","RCR JRCOR",153 ,0)
	4546	;
	4547	"RTN","RCR JRCOR",154 ,0)
	4548	; build the first two contro l lines in mail mess age
	4549	"RTN","RCR JRCOR",155 ,0)
	4550	S Y=DATEB EG D DD^%D T
	4551	"RTN","RCR JRCOR",156 ,0)
	4552	S BATCNAM E="AR1-"_$ E(Y,1,3)_$ E(DATEBEG, 6,7)_$TR($ P(Y,",",2) ," ")
	4553	"RTN","RCR JRCOR",157 ,0)
	4554	S Y=DATEE ND D DD^%D T
	4555	"RTN","RCR JRCOR",158 ,0)
	4556	S BATCNAM E=BATCNAME _"-"_$E(Y, 1,3)_$E(DA TEEND,6,7) _$TR($P(Y, ",",2)," " )
	4557	"RTN","RCR JRCOR",159 ,0)
	4558	S ^TMP($J ,"RCRJRCOR MM",1)="T$ "_PRCASIT E_"$"_BATC NAME_"$$$$ $*"
	4559	"RTN","RCR JRCOR",160 ,0)
	4560	; get en d time (in %)
	4561	"RTN","RCR JRCOR",161 ,0)
	4562	D NOW^%DT C
	4563	"RTN","RCR JRCOR",162 ,0)
	4564	S ^TMP($J ,"RCRJRCOR MM",2)="S$ "_STRTTIM E_"^"_%_"$ 0$"_(COUNT -1)
	4565	"RTN","RCR JRCOR",163 ,0)
	4566	;
	4567	"RTN","RCR JRCOR",164 ,0)
	4568	S XMY("S. PRQN DATA COLLECTION MONITOR@ D NS URL ")=""
	4569	"RTN","RCR JRCOR",165 ,0)
	4570	S %=$$SEN DMSG("AR1 "_$E(DATEE ND,4,5)_"/ "_$E(DATEE ND,2,3)_" NDB DATA F OR SITE "_ PRCASITE,. XMY)
	4571	"RTN","RCR JRCOR",166 ,0)
	4572	K ^TMP($J ,"RCRJRCOR MM")
	4573	"RTN","RCR JRCOR",167 ,0)
	4574	Q
	4575	"RTN","RCR JRCOR",168 ,0)
	4576	;
	4577	"RTN","RCR JRCOR",169 ,0)
	4578	;
	4579	"RTN","RCR JRCOR",170 ,0)
	4580	SUMMARY ; print sum mary repor t in mailm an bulleti n
	4581	"RTN","RCR JRCOR",171 ,0)
	4582	N %,BILLD A,CRITER2, CRITERIA,D ATA0,DFN,L INE,STAT,T OTAL,VA,XM Y
	4583	"RTN","RCR JRCOR",172 ,0)
	4584	K ^TMP($J ,"RCRJRCOR ") ; use d to ident ify test p atients
	4585	"RTN","RCR JRCOR",173 ,0)
	4586	K ^TMP($J ,"RCRJRCOR MM") ; use d to build mailman m essage
	4587	"RTN","RCR JRCOR",174 ,0)
	4588	;
	4589	"RTN","RCR JRCOR",175 ,0)
	4590	; print any test p atient bil ls which h ave not be en closed
	4591	"RTN","RCR JRCOR",176 ,0)
	4592	S BILLDA= 0 F S BIL LDA=$O(^TM P($J,"RCRJ RCOL","CRI T2",1,BILL DA)) Q:'BI LLDA I $D (^(BILLDA, 1)) D
	4593	"RTN","RCR JRCOR",177 ,0)
	4594	. S DAT A0=$G(^PRC A(430,BILL DA,0)),STA T=$P(DATA0 ,"^",8)
	4595	"RTN","RCR JRCOR",178 ,0)
	4596	. I STA T'=16,STAT ='42 Q ; bill not c urrently o pen
	4597	"RTN","RCR JRCOR",179 ,0)
	4598	. S DFN =+$P(DATA0 ,"^",7) I 'DFN Q
	4599	"RTN","RCR JRCOR",180 ,0)
	4600	. D PID ^VADPT
	4601	"RTN","RCR JRCOR",181 ,0)
	4602	. I $E( $TR($G(VA( "PID")),"- "),1,5)="0 0000" S ^T MP($J,"RCR JRCOR","TE ST",BILLDA )=""
	4603	"RTN","RCR JRCOR",182 ,0)
	4604	;
	4605	"RTN","RCR JRCOR",183 ,0)
	4606	I '$D(^TM P($J,"RCRJ RCOR","TES T")) Q
	4607	"RTN","RCR JRCOR",184 ,0)
	4608	;
	4609	"RTN","RCR JRCOR",185 ,0)
	4610	; print data
	4611	"RTN","RCR JRCOR",186 ,0)
	4612	S LINE=0
	4613	"RTN","RCR JRCOR",187 ,0)
	4614	D SET(" " )
	4615	"RTN","RCR JRCOR",188 ,0)
	4616	D SET("Th e followin g bills ar e active a nd linked to test pa tients:")
	4617	"RTN","RCR JRCOR",189 ,0)
	4618	S BILLDA= 0 F S BIL LDA=$O(^TM P($J,"RCRJ RCOR","TES T",BILLDA) ) Q:'BILLD A D SET(" "_$P($G( ^PRCA(430, BILLDA,0)) ,"^")_" (# ",BILLDA_" )")
	4619	"RTN","RCR JRCOR",190 ,0)
	4620	;
	4621	"RTN","RCR JRCOR",191 ,0)
	4622	S XMY("G. RC AR DATA COLLECTOR ")=""
	4623	"RTN","RCR JRCOR",192 ,0)
	4624	S %=$$SEN DMSG("MCCR DATA COLL ECTOR INFO RMATION",. XMY)
	4625	"RTN","RCR JRCOR",193 ,0)
	4626	K ^TMP($J ,"RCRJRCOR ")
	4627	"RTN","RCR JRCOR",194 ,0)
	4628	K ^TMP($J ,"RCRJRCOR MM")
	4629	"RTN","RCR JRCOR",195 ,0)
	4630	Q
	4631	"RTN","RCR JRCOR",196 ,0)
	4632	;
	4633	"RTN","RCR JRCOR",197 ,0)
	4634	;
	4635	"RTN","RCR JRCOR",198 ,0)
	4636	SET(DATA) ; store re port
	4637	"RTN","RCR JRCOR",199 ,0)
	4638	S LINE=LI NE+1,^TMP( $J,"RCRJRC ORMM",LINE )=DATA
	4639	"RTN","RCR JRCOR",200 ,0)
	4640	Q
	4641	"RTN","RCR JRCOR",201 ,0)
	4642	;
	4643	"RTN","RCR JRCOR",202 ,0)
	4644	;
	4645	"RTN","RCR JRCOR",203 ,0)
	4646	SENDMSG(XM SUB,XMY) ; send mes sage with subject an d recipien ts
	4647	"RTN","RCR JRCOR",204 ,0)
	4648	N %X,D0,D 1,D2,DIC,D ICR,DIW,X, XCNP,XMDIS PI,XMDUN,X MDUZ,XMTEX T,XMZ,ZTPA R
	4649	"RTN","RCR JRCOR",205 ,0)
	4650	S XMDUZ=" AR PACKAGE ",XMTEXT=" ^TMP($J,"" RCRJRCORMM "","
	4651	"RTN","RCR JRCOR",206 ,0)
	4652	D ^XMD
	4653	"RTN","RCR JRCOR",207 ,0)
	4654	Q +$G(XMZ )
	4655	"RTN","RCR JRCOU")
	4656	0^5^B31169 505
	4657	"RTN","RCR JRCOU",1,0 )
	4658	RCRJRCOU ; WISC/RFJ-a r data col lector sum mary repor t ;1 Mar 9 7
	4659	"RTN","RCR JRCOU",2,0 )
	4660	;;4.5;Acc ounts Rece ivable;1 03;Mar 2 0, 1995;Bu ild 11
	4661	"RTN","RCR JRCOU",3,0 )
	4662	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	4663	"RTN","RCR JRCOU",4,0 )
	4664	Q
	4665	"RTN","RCR JRCOU",5,0 )
	4666	;
	4667	"RTN","RCR JRCOU",6,0 )
	4668	;ARDC det ailed repo rt - Modif ied to pri nt directl y as per H APE FY16 R RE - PRCA* 4.5*315
	4669	"RTN","RCR JRCOU",7,0 )
	4670	; This i s routine no longer generates a MailMan message!
	4671	"RTN","RCR JRCOU",8,0 )
	4672	; Called by VistA O ption - PR CA ARDC RE PORT (ARDC Det ail Report )
	4673	"RTN","RCR JRCOU",9,0 )
	4674	;
	4675	"RTN","RCR JRCOU",10, 0)
	4676	START ; E ntry point from the Option
	4677	"RTN","RCR JRCOU",11, 0)
	4678	N VAUTSTR ,VAUTB,VAU TNALL,VAUT NI,DIC,Y,S CREEN
	4679	"RTN","RCR JRCOU",12, 0)
	4680	;
	4681	"RTN","RCR JRCOU",13, 0)
	4682	W !!,"ARD C Detail R eport, ple ase select the statu s desired below",!!
	4683	"RTN","RCR JRCOU",14, 0)
	4684	S SCREEN= "^16^18^32 ^38^40^42^ ",DIC="^PR CA(430.3," ,VAUTNI=2, VAUTSTR="S tatus",VAU TVB="VAUTC ",DIC("S") ="I SCREEN [(U_Y_U)" D FIRST^VA UTOMA
	4685	"RTN","RCR JRCOU",15, 0)
	4686	I VAUTC=1 F I=2:1:7 S VAUTC($ P(SCREEN,U ,I))=$P(^P RCA(430.3, $P(SCREEN, U,I),0),U) ;set arr ay equal t o the scre en if ALL was select ed
	4687	"RTN","RCR JRCOU",16, 0)
	4688	Q:'$D(VAU TC)
	4689	"RTN","RCR JRCOU",17, 0)
	4690	W !!,"Thi s report r equires 13 2 columns. ",!
	4691	"RTN","RCR JRCOU",18, 0)
	4692	W ! S %ZI S="Q" D ^% ZIS I POP Q
	4693	"RTN","RCR JRCOU",19, 0)
	4694	I $D(IO(" Q")) D D ^%ZTLOAD W :$D(ZTSK) !,*7,"REQU EST QUEUED ",!,"Task #: ",$G(ZT SK) K ZTDE SC,ZTIO,ZT RTN,ZTSAVE G EXIT
	4695	"RTN","RCR JRCOU",20, 0)
	4696	.S ZTDESC ="ARDC Det ail Report ",ZTRTN="D Q^RCRJRCOU "
	4697	"RTN","RCR JRCOU",21, 0)
	4698	.S ZTSAVE ("VAUTC")= ""
	4699	"RTN","RCR JRCOU",22, 0)
	4700	.S ZTSAVE ("RCRET")= "",ZTSAVE( "ZTREQ")=" @"
	4701	"RTN","RCR JRCOU",23, 0)
	4702	W !!,"<> please wa it <>"
	4703	"RTN","RCR JRCOU",24, 0)
	4704	;
	4705	"RTN","RCR JRCOU",25, 0)
	4706	DQ ; gene rate user detailed r eport
	4707	"RTN","RCR JRCOU",26, 0)
	4708	N DATEEND ,DATE,BILL DA,DATA,RC LINE,RCSPA CE,REPTDAT A,Y,RCBILL N,RCDTAC,R CCAT,RCSTA T,TRANTYP, RCTOT,RCPR IN,RCRSC,R CBILL,PRCA SITE
	4709	"RTN","RCR JRCOU",27, 0)
	4710	N STAT,BI LLDA,RCRSC ,DATA7,REC ORD,RCBAL, ARACTDT,DA TEMOYR,MRA TYPE,POP,R CFUND,RCOT HER,TYPE
	4711	"RTN","RCR JRCOU",28, 0)
	4712	;
	4713	"RTN","RCR JRCOU",29, 0)
	4714	S DATEEND =$$LDATE^R CRJR(DT),D ATEMOYR=$E (DATEEND,1 ,5)_"00"
	4715	"RTN","RCR JRCOU",30, 0)
	4716	S DATE=0
	4717	"RTN","RCR JRCOU",31, 0)
	4718	S PRCASIT E=$$SITE^R CMSITE
	4719	"RTN","RCR JRCOU",32, 0)
	4720	S RCRET=$ NA(^TMP($J ,"RCRJRCOU ")) K @RCR ET ;TEMP GLOBAL FO R REPORT
	4721	"RTN","RCR JRCOU",33, 0)
	4722	;
	4723	"RTN","RCR JRCOU",34, 0)
	4724	S (RCLINE ,STAT)=0 F S STAT=$ O(VAUTC(ST AT)) Q:'ST AT D
	4725	"RTN","RCR JRCOU",35, 0)
	4726	. F S DA TE=$O(^PRC A(430,"ASD T",STAT,DA TE)) Q:'DA TE D
	4727	"RTN","RCR JRCOU",36, 0)
	4728	.. S BILL DA=0 F S BILLDA=$O( ^PRCA(430, "ASDT",STA T,DATE,BIL LDA)) Q:'B ILLDA D
	4729	"RTN","RCR JRCOU",37, 0)
	4730	... I $$A CCK^PRCAAC C(BILLDA), $P($G(^PRC A(430,BILL DA,0)),"^" ,2)'=26 D ;from CU RRENT^RCRJ RCOC
	4731	"RTN","RCR JRCOU",38, 0)
	4732	.... S DA TA=$G(^PRC A(430,BILL DA,0)) Q:' DATA
	4733	"RTN","RCR JRCOU",39, 0)
	4734	.... S (T YPE,TRANTY P,RCRSC,RC FUND,RCPRI N)="",RCBA L=0
	4735	"RTN","RCR JRCOU",40, 0)
	4736	.... ; b ill number
	4737	"RTN","RCR JRCOU",41, 0)
	4738	.... S RC BILLN=$P($ P(DATA,"^" ),"-",2)
	4739	"RTN","RCR JRCOU",42, 0)
	4740	.... ; d ate activa ted
	4741	"RTN","RCR JRCOU",43, 0)
	4742	.... S RC DTAC=$$FMT E^XLFDT(DA TE,2)
	4743	"RTN","RCR JRCOU",44, 0)
	4744	.... ; c ategory
	4745	"RTN","RCR JRCOU",45, 0)
	4746	.... S RC CAT=$E($P( $G(^PRCA(4 30.2,+$P(D ATA,"^",2) ,0)),"^"), 1,18)
	4747	"RTN","RCR JRCOU",46, 0)
	4748	.... ; s tatus
	4749	"RTN","RCR JRCOU",47, 0)
	4750	.... S RC STAT=$E($P ($G(^PRCA( 430.3,+$P( DATA,"^",8 ),0)),"^") ,1,15)
	4751	"RTN","RCR JRCOU",48, 0)
	4752	.... S RE PTDATA=$$B ILLBAL^RCR JRCOB(BILL DA,DATEEND ) ; find s a bills balance an d age - (a s per HDR^ RCDPTPLM)
	4753	"RTN","RCR JRCOU",49, 0)
	4754	.... S TY PE="SV21" I $$ACCK^P RCAACC(BIL LDA) S RCR SC=$$CALCR SC^RCXFMSU R(BILLDA) ; (as per CURRENT^RC RJRCOC)
	4755	"RTN","RCR JRCOU",50, 0)
	4756	.... I $E (RCRSC,1,2 )=86!($E(R CRSC,1,2)= "8S") S TY PE="2A"
	4757	"RTN","RCR JRCOU",51, 0)
	4758	.... ; G et AR Date Active fo r bill
	4759	"RTN","RCR JRCOU",52, 0)
	4760	.... S AR ACTDT=+$P( $P($G(^PRC A(430,BILL DA,6)),"^" ,21),".") ; (a s per STAR T^RCRJRBD)
	4761	"RTN","RCR JRCOU",53, 0)
	4762	.... ; determine Receivable Type: 1=p re-MRA, 2= post-MRA M edicre, 3= post-MRA n on-Medicar e
	4763	"RTN","RCR JRCOU",54, 0)
	4764	.... ; fms report type - TR ANTYP vari able
	4765	"RTN","RCR JRCOU",55, 0)
	4766	.... S MR ATYPE=$$MR ATYPE^IBCE MU2(BILLDA ,ARACTDT) ; (a s per CURR ENT^RCRJRC OC)
	4767	"RTN","RCR JRCOU",56, 0)
	4768	.... ; s et TYPE to 2F for po st-MRA Med icare bill s or to 2L for post- MRA non-Me dicare bil ls (for RH I receivab les only)
	4769	"RTN","RCR JRCOU",57, 0)
	4770	.... I $E (RCRSC,1,2 )=85!($E(R CRSC,1,2)= "8R"),MRAT YPE>1 S TY PE=$S(MRAT YPE=2:"2F" ,1:"2L")
	4771	"RTN","RCR JRCOU",58, 0)
	4772	.... I $E (RCRSC,1,2 )=86!($E(R CRSC,1,2)= "8S") S TY PE="SV21"
	4773	"RTN","RCR JRCOU",59, 0)
	4774	.... S TR ANTYP=$G(T YPE)
	4775	"RTN","RCR JRCOU",60, 0)
	4776	.... ; calculate principal and other (int + adm in) balanc e - calcu lations (a s per NONM CCF^RCRJRO IG)
	4777	"RTN","RCR JRCOU",61, 0)
	4778	.... S DA TA7="",DAT A7=$G(^PRC A(430,BILL DA,7))
	4779	"RTN","RCR JRCOU",62, 0)
	4780	.... S RC PRIN=+$P(D ATA7,"^")
	4781	"RTN","RCR JRCOU",63, 0)
	4782	.... S RC OTHER=$P(D ATA7,"^",2 )+$P(DATA7 ,"^",3)+$P (DATA7,"^" ,4)+$P(DAT A7,"^",5)
	4783	"RTN","RCR JRCOU",64, 0)
	4784	.... ; in some b ills, the principal and other balance ma y cancel
	4785	"RTN","RCR JRCOU",65, 0)
	4786	.... ; each othe r. for ex ample prin cipal .08 + interest -.08 = 0
	4787	"RTN","RCR JRCOU",66, 0)
	4788	.... I (R CPRIN+RCOT HER)'>0 S RCPRIN=0
	4789	"RTN","RCR JRCOU",67, 0)
	4790	.... ; t otal
	4791	"RTN","RCR JRCOU",68, 0)
	4792	.... S RC TOT=$P(REP TDATA,"^") +$P(REPTDA TA,"^",2)
	4793	"RTN","RCR JRCOU",69, 0)
	4794	.... ; Ba lance=Tota l-Principa l (quit i f zero)
	4795	"RTN","RCR JRCOU",70, 0)
	4796	.... S RC BAL=RCTOT- RCPRIN Q:R CBAL<1 ;Q uit with t here is no balance d ue
	4797	"RTN","RCR JRCOU",71, 0)
	4798	.... S RC PRIN=$J(RC PRIN,11,2) ,RCBAL=$J( RCBAL,11,2 )
	4799	"RTN","RCR JRCOU",72, 0)
	4800	.... ;Rev enue Servi ce Code
	4801	"RTN","RCR JRCOU",73, 0)
	4802	.... S RC RSC="" I $ $ACCK^PRCA ACC(BILLDA ) S RCRSC= $$CALCRSC^ RCXFMSUR(B ILLDA) ; (a s per CURR ENT^RCRJRC OC)
	4803	"RTN","RCR JRCOU",74, 0)
	4804	.... ;Fun d
	4805	"RTN","RCR JRCOU",75, 0)
	4806	.... S RC FUND=$$GET FUNDB^RCXF MSUF(BILLD A,1)
	4807	"RTN","RCR JRCOU",76, 0)
	4808	.... S RC LINE=RCLIN E+1 ;(rec ord counte r)
	4809	"RTN","RCR JRCOU",77, 0)
	4810	.... S @R CRET@(RCLI NE)=RCBILL N_U_RCDTAC _U_RCCAT_U _RCSTAT_U_ TRANTYP_U_ RCFUND_U_R CRSC_U_RCP RIN_U_RCBA L
	4811	"RTN","RCR JRCOU",78, 0)
	4812	; end of gathering data
	4813	"RTN","RCR JRCOU",79, 0)
	4814	;
	4815	"RTN","RCR JRCOU",80, 0)
	4816	I RCLINE= 0 S PAGE=1 D HDR W ! !!,"The re port found no patien ts with a balance du e for this report" G EXIT
	4817	"RTN","RCR JRCOU",81, 0)
	4818	;
	4819	"RTN","RCR JRCOU",82, 0)
	4820	D PRINT
	4821	"RTN","RCR JRCOU",83, 0)
	4822	;
	4823	"RTN","RCR JRCOU",84, 0)
	4824	EXIT ;comm om exit po int
	4825	"RTN","RCR JRCOU",85, 0)
	4826	D ^%ZISC
	4827	"RTN","RCR JRCOU",86, 0)
	4828	K ^TMP($J ,"RCRJRCOU ")
	4829	"RTN","RCR JRCOU",87, 0)
	4830	Q
	4831	"RTN","RCR JRCOU",88, 0)
	4832	;
	4833	"RTN","RCR JRCOU",89, 0)
	4834	HDR ;Set t he header
	4835	"RTN","RCR JRCOU",90, 0)
	4836	;
	4837	"RTN","RCR JRCOU",91, 0)
	4838	S PAGE=PA GE+1 U IO W @IOF
	4839	"RTN","RCR JRCOU",92, 0)
	4840	W ?50,"AR DC Detaile d Report", ?105,"Page :",PAGE,!
	4841	"RTN","RCR JRCOU",93, 0)
	4842	W "Bill#" ,?12,"AR C reate",?25 ,"AR Categ ory",?45," Bill",?62 ,"FMS",?71 ," Fund",? 82,"RSC",? 92,"Princi pal",?110, "Balance"
	4843	"RTN","RCR JRCOU",94, 0)
	4844	W !,?14," Date",?45 ,"Status", ?61,"Type" ,?71,"Numb er",?95,"A mount",!
	4845	"RTN","RCR JRCOU",95, 0)
	4846	N I F I=1 :1:120 W " -"
	4847	"RTN","RCR JRCOU",96, 0)
	4848	Q
	4849	"RTN","RCR JRCOU",97, 0)
	4850	;
	4851	"RTN","RCR JRCOU",98, 0)
	4852	PRINT ; pr int record s to scree n or print er 132 col umns
	4853	"RTN","RCR JRCOU",99, 0)
	4854	N PAGE S PAGE=0,REC ORD=0
	4855	"RTN","RCR JRCOU",100 ,0)
	4856	F S RECO RD=$O(@RCR ET@(RECORD )) Q:'RECO RD D
	4857	"RTN","RCR JRCOU",101 ,0)
	4858	. I RECOR D=1 D HDR
	4859	"RTN","RCR JRCOU",102 ,0)
	4860	. I $Y+3> IOSL I ($E (IOST,1,2) ="C-")&(IO =IO(0)) S DIR(0)="E" D ^DIR K DIR G:$D(D UOUT)!($D( DTOUT)) EX IT D HDR
	4861	"RTN","RCR JRCOU",103 ,0)
	4862	. W !,$P( @RCRET@(RE CORD),U),? 12,$P(@RCR ET@(RECORD ),U,2),?25 ,$P(@RCRET @(RECORD), U,3),?45,$ P(@RCRET@( RECORD),U, 4),?62,$P( @RCRET@(RE CORD),U,5)
	4863	"RTN","RCR JRCOU",104 ,0)
	4864	. W ?72,$ P(@RCRET@( RECORD),U, 6),?82,$P( @RCRET@(RE CORD),U,7) ,?90,$P(@R CRET@(RECO RD),U,8),? 106,$P(@RC RET@(RECOR D),U,9)
	4865	"RTN","RCR JRCOU",105 ,0)
	4866	Q
	4867	"RTN","RCR JRCOU",106 ,0)
	4868	;
	4869	"RTN","RCR JRCOU",107 ,0)
	4870	; Leaving old entry point in place as a precautio n
	4871	"RTN","RCR JRCOU",108 ,0)
	4872	USERREPT(D ATEMOYR) ; generate user deta iled repor t and send it to Mai lMan
	4873	"RTN","RCR JRCOU",109 ,0)
	4874	Q ;Previ ous entry point, no longer use d.
	4875	"RTN","RCR JRCOU",110 ,0)
	4876	;
	4877	"RTN","RCR JRCOU",111 ,0)
	4878	;END RCRJ RCOU
	4879	"VER")
	4880	8.0^22.0
	4881	INSTALL NAME
	4882	IB2.0568
	4883	"BLD",1019 0,0)
	4884	IB2.0568 ^INTEGRATE D BILLING^ 0^3161215^ y
	4885	"BLD",1019 0,1,0)
	4886	^^313^313^ 3161212^^
	4887	"BLD",1019 0,1,1,0)
	4888
	4889	"BLD",1019 0,1,2,0)
	4890	IMPORTANT INSTALLATI ON NOTE:
	4891	"BLD",1019 0,1,3,0)
	4892	---------- ---------- --------
	4893	"BLD",1019 0,1,4,0)
	4894	This patch is part o f a multi- package bu ild. There are three patches
	4895	"BLD",1019 0,1,5,0)
	4896	associated with the FY16 HAPE Revenue En hancement project -
	4897	"BLD",1019 0,1,6,0)
	4898	IB2.0568 ,PRCA4.5 315 and PS O7.0463. All three patches a re to be
	4899	"BLD",1019 0,1,7,0)
	4900	installed together a s a bundle , IB_2_568 _PRCA_PSO_ BUNDLE_T1. KID
	4901	"BLD",1019 0,1,8,0)
	4902
	4903	"BLD",1019 0,1,9,0)
	4904
	4905	"BLD",1019 0,1,10,0)
	4906	Descriptio n
	4907	"BLD",1019 0,1,11,0)
	4908	---------- -
	4909	"BLD",1019 0,1,12,0)
	4910	The Chief Business O ffice (CBO ) is reque sting syst em enhance ments to
	4911	"BLD",1019 0,1,13,0)
	4912	The Vetera ns Health Informatio n Systems and Techno logy Archi tecture
	4913	"BLD",1019 0,1,14,0)
	4914	(VistA) In tegrated B illing (IB ), Account s Receivab le (AR), a nd
	4915	"BLD",1019 0,1,15,0)
	4916	Outpatient Pharmacy (PSO) soft ware modul es.
	4917	"BLD",1019 0,1,16,0)
	4918
	4919	"BLD",1019 0,1,17,0)
	4920	The missio n of the D epartment of Veteran s Affairs (VA), Offi ce of
	4921	"BLD",1019 0,1,18,0)
	4922	Informatio n & Techno logy (OI&T ), is to p rovide ben efits and services
	4923	"BLD",1019 0,1,19,0)
	4924	to veteran s of the U nited Stat es Armed F orces. In meeting th ese
	4925	"BLD",1019 0,1,20,0)
	4926	goals, OIT strives t o provide high quali ty, effect ive, and e fficient
	4927	"BLD",1019 0,1,21,0)
	4928	Informatio n Technolo gy (IT) se rvices to those resp onsible fo r
	4929	"BLD",1019 0,1,22,0)
	4930	providing care to th e veterans at the po int-of-car e, as well as
	4931	"BLD",1019 0,1,23,0)
	4932	throughout all the p oints of t he veteran s' health care. The VA depends
	4933	"BLD",1019 0,1,24,0)
	4934	on Informa tion Manag ement/Info rmation Te chnology ( IM/IT) sys tems to
	4935	"BLD",1019 0,1,25,0)
	4936	meet missi on goals.
	4937	"BLD",1019 0,1,26,0)
	4938
	4939	"BLD",1019 0,1,27,0)
	4940	The overal l FY16 HAP E Revenue Enhancemen t project has been f urther
	4941	"BLD",1019 0,1,28,0)
	4942	divided in to three s ub-project s:
	4943	"BLD",1019 0,1,29,0)
	4944
	4945	"BLD",1019 0,1,30,0)
	4946	NSR #20150 506
	4947	"BLD",1019 0,1,31,0)
	4948	The Revenu e Eligibil ity Enhanc ements Pro ject effor t for the Chief
	4949	"BLD",1019 0,1,32,0)
	4950	Business O ffice (CBO ), bundles several N SRs with s imilar bus iness
	4951	"BLD",1019 0,1,33,0)
	4952	needs into a single requiremen ts documen t. Succes sfully add ressing
	4953	"BLD",1019 0,1,34,0)
	4954	the requir ements con tained wit hin this d ocument wi ll enable the
	4955	"BLD",1019 0,1,35,0)
	4956	Department of Vetera ns Affairs (VA) to a ppropriate ly bill ce rtain
	4957	"BLD",1019 0,1,36,0)
	4958	subsets of billable events by correcting , automati ng, or enh ancing
	4959	"BLD",1019 0,1,37,0)
	4960	current Ve terans Hea lth Inform ation Syst ems and Te chnology
	4961	"BLD",1019 0,1,38,0)
	4962	Architectu re (VistA) systems.
	4963	"BLD",1019 0,1,39,0)
	4964
	4965	"BLD",1019 0,1,40,0)
	4966	NSR #20150 507
	4967	"BLD",1019 0,1,41,0)
	4968	The Revenu e Operatio ns Enhance ments Proj ect combin es servera l NSRs,
	4969	"BLD",1019 0,1,42,0)
	4970	as well. T his effort enables t he Departm ent of Vet erans Affa irs (VA)
	4971	"BLD",1019 0,1,43,0)
	4972	to improve revenue o peration f unctionali ty related to repaym ent plans,
	4973	"BLD",1019 0,1,44,0)
	4974	late charg e capture, bill susp ension rea sons, the billing of
	4975	"BLD",1019 0,1,45,0)
	4976	deactivate d provider s, and the display o f appeal r ights and
	4977	"BLD",1019 0,1,46,0)
	4978	responsibi lities on the Vetera ns Benefic iary trave l Bill of Collection s
	4979	"BLD",1019 0,1,47,0)
	4980	form. Imp lementatio n of the p roposed en hancements will make a
	4981	"BLD",1019 0,1,48,0)
	4982	significan t positive impact on stakehold ers and ta rget users .
	4983	"BLD",1019 0,1,49,0)
	4984
	4985	"BLD",1019 0,1,50,0)
	4986	NSR #20150 505
	4987	"BLD",1019 0,1,51,0)
	4988	The Revenu e Reportin g Enhancem ents Proje ct will en able the V A to
	4989	"BLD",1019 0,1,52,0)
	4990	improve tr acking and reporting of revenu e, and wil l support revenue
	4991	"BLD",1019 0,1,53,0)
	4992	reporting business r ules and g uidelines.
	4993	"BLD",1019 0,1,54,0)
	4994
	4995	"BLD",1019 0,1,55,0)
	4996
	4997	"BLD",1019 0,1,56,0)
	4998	IB2.0568 patch enh ancements, pertinent to the ab ove NSRs, include:
	4999	"BLD",1019 0,1,57,0)
	5000
	5001	"BLD",1019 0,1,58,0)
	5002	1.) When g enerating the RNB (R easons Not Billable) report, t he
	5003	"BLD",1019 0,1,59,0)
	5004	Integrated Billing s ystem shal l populate the charg es for all types
	5005	"BLD",1019 0,1,60,0)
	5006	of service s provided . Charges will not b e screened by any bi llable
	5007	"BLD",1019 0,1,61,0)
	5008	criteria b ut willind icate the full amoun t as if th e care was to be
	5009	"BLD",1019 0,1,62,0)
	5010	billed.
	5011	"BLD",1019 0,1,63,0)
	5012
	5013	"BLD",1019 0,1,64,0)
	5014	2.) The su b-option C laims Trac king Param eter Edit [IBT EDIT TRACKING
	5015	"BLD",1019 0,1,65,0)
	5016	PARAMETERS ], that cu rrently ha s no key, will be lo cked with a new
	5017	"BLD",1019 0,1,66,0)
	5018	Security K ey called IB PARAMET ER EDIT.
	5019	"BLD",1019 0,1,67,0)
	5020
	5021	"BLD",1019 0,1,68,0)
	5022	3.) The op tion MCCR Site Param eter Displ ay/Edit [I BJ MCCR SI TE
	5023	"BLD",1019 0,1,69,0)
	5024	PARAMETERS ], which i s currentl y locked w ith the IB SUPERVISO R Security
	5025	"BLD",1019 0,1,70,0)
	5026	Key, will be instead locked wi th the new key.
	5027	"BLD",1019 0,1,71,0)
	5028
	5029	"BLD",1019 0,1,72,0)
	5030	4.) The In tegrated B illing sys tem shall create cla ims tracki ng entries
	5031	"BLD",1019 0,1,73,0)
	5032	for previo usly unbil led Prosth etics/DME items when new billa ble
	5033	"BLD",1019 0,1,74,0)
	5034	insurance is entered into the patient's insurance file.
	5035	"BLD",1019 0,1,75,0)
	5036
	5037	"BLD",1019 0,1,76,0)
	5038	5.) A new coverage l imitation field shal l be creat ed in the insurance
	5039	"BLD",1019 0,1,77,0)
	5040	file for P rosthetics . Like th e other ex isting cov erage limi tation
	5041	"BLD",1019 0,1,78,0)
	5042	fields in the insura nce file ( Inpatient, Outpatien t, Pharmac y etc.),
	5043	"BLD",1019 0,1,79,0)
	5044	this field will have the follo wing optio ns:
	5045	"BLD",1019 0,1,80,0)
	5046	0= NOT COVERE D
	5047	"BLD",1019 0,1,81,0)
	5048	1= COVERED
	5049	"BLD",1019 0,1,82,0)
	5050	2= CONDITIONA LCOVERAGE
	5051	"BLD",1019 0,1,83,0)
	5052	Once selec ted, they will show in the pat ient insur ance file as Yes,
	5053	"BLD",1019 0,1,84,0)
	5054	No, or Con ditional.
	5055	"BLD",1019 0,1,85,0)
	5056
	5057	"BLD",1019 0,1,86,0)
	5058	6.) The sy stem shall automatic ally assig n an RNB [ NO PROSTHE TIC
	5059	"BLD",1019 0,1,87,0)
	5060	COVERAGE ( CV22)] for Prostheti cs/DME ite ms if the patient ha s no
	5061	"BLD",1019 0,1,88,0)
	5062	coverage f or Prosthe tics in hi s/her insu rance file .
	5063	"BLD",1019 0,1,89,0)
	5064
	5065	"BLD",1019 0,1,90,0)
	5066	7.) The sy stem shall have a ne w option t o add Pros thetics it ems to
	5067	"BLD",1019 0,1,91,0)
	5068	Manual and Nightly C laims Trac king.
	5069	"BLD",1019 0,1,92,0)
	5070
	5071	"BLD",1019 0,1,93,0)
	5072	8.) Users will be ab le to sele ct Suspend ed Type fr om the men u to
	5073	"BLD",1019 0,1,94,0)
	5074	display in the First Party Fol low- Up [I BJD FOLLOW -UP FIRST PARTY]
	5075	"BLD",1019 0,1,95,0)
	5076	report.
	5077	"BLD",1019 0,1,96,0)
	5078
	5079	"BLD",1019 0,1,97,0)
	5080	9.) First Party Foll ow- Up [IB JD FOLLOW- UP FIRST P ARTY] repo rt shall
	5081	"BLD",1019 0,1,98,0)
	5082	be modifie d to incor porate rea son for su spension.
	5083	"BLD",1019 0,1,99,0)
	5084
	5085	"BLD",1019 0,1,100,0)
	5086	10.) A new warning m essage wil l print to the scree n in the E nter/Edit
	5087	"BLD",1019 0,1,101,0)
	5088	Billing In formation option if an ATTENDI NG, REFERR ING or REN DERING
	5089	"BLD",1019 0,1,102,0)
	5090	Provider h as a PERSO N CLASS - NEW PERSON file (#20 0) - that was
	5091	"BLD",1019 0,1,103,0)
	5092	expirated at the tim e of the D ate of Ser vice.
	5093	"BLD",1019 0,1,104,0)
	5094
	5095	"BLD",1019 0,1,105,0)
	5096	11.) On th e Third Pa rty Joint Inquiry sc reen, one (1) charac ter space
	5097	"BLD",1019 0,1,106,0)
	5098	shall be a dded to th e "Type" f ield so th at it will accommoda te five
	5099	"BLD",1019 0,1,107,0)
	5100	characters (a one-ch aracter cl assificati on indicat or, a forw ard slash
	5101	"BLD",1019 0,1,108,0)
	5102	(/), a one -character component indicator , a forwar d slash (/ ), and a
	5103	"BLD",1019 0,1,109,0)
	5104	one-charac ter care t ype) ("X/X /X"). If a bill con tains pres criptions,
	5105	"BLD",1019 0,1,110,0)
	5106	then an "R " shall be concatena ted to the fifth cha racter sub -type
	5107	"BLD",1019 0,1,111,0)
	5108	position o f the "Typ e" field. If a bill contains p rosthetics , then a
	5109	"BLD",1019 0,1,112,0)
	5110	"P" shall be concate nated to f ifth chara cter sub-t ype positi on of the
	5111	"BLD",1019 0,1,113,0)
	5112	"Type" fie ld.The "Ty pe" field shall cont ain five ( 5) charact ers as
	5113	"BLD",1019 0,1,114,0)
	5114	follows:
	5115	"BLD",1019 0,1,115,0)
	5116	1. "I" for Inpatient or "O" fo r Outpatie nt,
	5117	"BLD",1019 0,1,116,0)
	5118	2. "/" for ward slash character
	5119	"BLD",1019 0,1,117,0)
	5120	3. "P" for Professio nal or "I" for Insti tutional
	5121	"BLD",1019 0,1,118,0)
	5122	4. "/" for ward slash character
	5123	"BLD",1019 0,1,119,0)
	5124	5. "P" for Prostheti cs or "R" for Prescr iptions
	5125	"BLD",1019 0,1,120,0)
	5126
	5127	"BLD",1019 0,1,121,0)
	5128	12.) Three new Third Party Ins urance Rat e Types sh all be cre ated in
	5129	"BLD",1019 0,1,122,0)
	5130	the VistA IB Suite f or the bil lers to ch oose from when billi ng for
	5131	"BLD",1019 0,1,123,0)
	5132	encounters . They are as follow s:
	5133	"BLD",1019 0,1,124,0)
	5134	HU MANITARIAN REIMB. IN S.
	5135	"BLD",1019 0,1,125,0)
	5136	DE NTAL REIMB . INS.
	5137	"BLD",1019 0,1,126,0)
	5138	IN ELIGIBLE R EIMB. INS.
	5139	"BLD",1019 0,1,127,0)
	5140
	5141	"BLD",1019 0,1,128,0)
	5142	13.) Each of the new rate type s above wi ll have th e 'Insurer ' as the
	5143	"BLD",1019 0,1,129,0)
	5144	responsibl e party.
	5145	"BLD",1019 0,1,130,0)
	5146
	5147	"BLD",1019 0,1,131,0)
	5148	14.) Bille rs (revenu e staff) s hould be a ble to ide ntify any remaining
	5149	"BLD",1019 0,1,132,0)
	5150	charges to the patie nt after t he Third P arty payme nts are re ceived for
	5151	"BLD",1019 0,1,133,0)
	5152	Emergency Humanitari an, Inelig ible and D ental serv ices so th ey can
	5153	"BLD",1019 0,1,134,0)
	5154	accomplish balance b illing.
	5155	"BLD",1019 0,1,135,0)
	5156
	5157	"BLD",1019 0,1,136,0)
	5158
	5159	"BLD",1019 0,1,137,0)
	5160
	5161	"BLD",1019 0,1,138,0)
	5162	Concurrent Developme nt / Depen dencies:
	5163	"BLD",1019 0,1,139,0)
	5164	---------- ---------- ---------- --------
	5165	"BLD",1019 0,1,140,0)
	5166	N/A
	5167	"BLD",1019 0,1,141,0)
	5168
	5169	"BLD",1019 0,1,142,0)
	5170
	5171	"BLD",1019 0,1,143,0)
	5172	Patch Comp onents:
	5173	"BLD",1019 0,1,144,0)
	5174	---------- -------
	5175	"BLD",1019 0,1,145,0)
	5176
	5177	"BLD",1019 0,1,146,0)
	5178	Files & Fi elds Assoc iated:
	5179	"BLD",1019 0,1,147,0)
	5180
	5181	"BLD",1019 0,1,148,0)
	5182	File Name (Number) Field Na me (Number ) New/ Modified/D eleted
	5183	"BLD",1019 0,1,149,0)
	5184	---------- -------- -------- ---------- - ---- ---------- ------
	5185	"BLD",1019 0,1,150,0)
	5186	N/A
	5187	"BLD",1019 0,1,151,0)
	5188
	5189	"BLD",1019 0,1,152,0)
	5190	Options As sociated:
	5191	"BLD",1019 0,1,153,0)
	5192
	5193	"BLD",1019 0,1,154,0)
	5194	Option Nam e Type New/ Modified/D eleted
	5195	"BLD",1019 0,1,155,0)
	5196	---------- - ---- ---- ---------- ------
	5197	"BLD",1019 0,1,156,0)
	5198	IBT SUP MA NUALLY QUE PRSTHTCS ROUTINE NEW
	5199	"BLD",1019 0,1,157,0)
	5200
	5201	"BLD",1019 0,1,158,0)
	5202	Protocols Associated :
	5203	"BLD",1019 0,1,159,0)
	5204
	5205	"BLD",1019 0,1,160,0)
	5206	Protocol N ame New /Modified/ Deleted
	5207	"BLD",1019 0,1,161,0)
	5208	---------- --- --- ---------- -------
	5209	"BLD",1019 0,1,162,0)
	5210	N/A
	5211	"BLD",1019 0,1,163,0)
	5212
	5213	"BLD",1019 0,1,164,0)
	5214	Templates Associated :
	5215	"BLD",1019 0,1,165,0)
	5216
	5217	"BLD",1019 0,1,166,0)
	5218	Template N ame T ype File Name (Num ber) New/Mod/De l
	5219	"BLD",1019 0,1,167,0)
	5220	---------- --- - --- ---- ---------- ---- ---------- -
	5221	"BLD",1019 0,1,168,0)
	5222	IBJT ACTIV E LIST L IST NEW
	5223	"BLD",1019 0,1,169,0)
	5224	IBJT INACT IVE LIST L IST NEW
	5225	"BLD",1019 0,1,170,0)
	5226
	5227	"BLD",1019 0,1,171,0)
	5228	New Servic e Requests (NSRs):
	5229	"BLD",1019 0,1,172,0)
	5230	---------- ---------- --------
	5231	"BLD",1019 0,1,173,0)
	5232	20150505 - Revenue R eporting E nhancement s
	5233	"BLD",1019 0,1,174,0)
	5234	20150506 - Revenue E ligibility Enhanceme nts
	5235	"BLD",1019 0,1,175,0)
	5236	20150507 - Revenue O perations Enhancemen ts
	5237	"BLD",1019 0,1,176,0)
	5238
	5239	"BLD",1019 0,1,177,0)
	5240
	5241	"BLD",1019 0,1,178,0)
	5242	Patient Sa fety Issue s (PSIs):
	5243	"BLD",1019 0,1,179,0)
	5244	---------- ---------- ----------
	5245	"BLD",1019 0,1,180,0)
	5246	N/A
	5247	"BLD",1019 0,1,181,0)
	5248
	5249	"BLD",1019 0,1,182,0)
	5250
	5251	"BLD",1019 0,1,183,0)
	5252	Remedy Tic ket(s) & O verviews:
	5253	"BLD",1019 0,1,184,0)
	5254	---------- ---------- ---------
	5255	"BLD",1019 0,1,185,0)
	5256	N/A
	5257	"BLD",1019 0,1,186,0)
	5258
	5259	"BLD",1019 0,1,187,0)
	5260	Test Sites :
	5261	"BLD",1019 0,1,188,0)
	5262	----------
	5263	"BLD",1019 0,1,189,0)
	5264	Durham VAM C
	5265	"BLD",1019 0,1,190,0)
	5266
	5267	"BLD",1019 0,1,191,0)
	5268
	5269	"BLD",1019 0,1,192,0)
	5270	Software a nd Documen tation Ret rieval Ins tructions:
	5271	"BLD",1019 0,1,193,0)
	5272	---------- ---------- ---------- ---------- ---------- --
	5273	"BLD",1019 0,1,194,0)
	5274	Patches fo r this ins tallation are combin ed in host file
	5275	"BLD",1019 0,1,195,0)
	5276	IB_2_568_P RCA_PSO_BU NDLE_T1.KI D
	5277	"BLD",1019 0,1,196,0)
	5278
	5279	"BLD",1019 0,1,197,0)
	5280	Installati on of this host file should be coordinat ed among t he package s
	5281	"BLD",1019 0,1,198,0)
	5282	affected s ince only one instal lation is necessary.
	5283	"BLD",1019 0,1,199,0)
	5284
	5285	"BLD",1019 0,1,200,0)
	5286	The patche s are:
	5287	"BLD",1019 0,1,201,0)
	5288
	5289	"BLD",1019 0,1,202,0)
	5290	IB2. 0568
	5291	"BLD",1019 0,1,203,0)
	5292	PRCA* 4.5*315
	5293	"BLD",1019 0,1,204,0)
	5294	PSO7 .0463
	5295	"BLD",1019 0,1,205,0)
	5296
	5297	"BLD",1019 0,1,206,0)
	5298
	5299	"BLD",1019 0,1,207,0)
	5300	Sites may retrieve t he KIDS bu ild in one of the fo llowing wa ys:
	5301	"BLD",1019 0,1,208,0)
	5302
	5303	"BLD",1019 0,1,209,0)
	5304	(1) The pr eferred me thod is to FTP the f iles from
	5305	"BLD",1019 0,1,210,0)
	5306	download. DNS . DNS which will transmit the files from the f irst
	5307	"BLD",1019 0,1,211,0)
	5308	available FTP server .
	5309	"BLD",1019 0,1,212,0)
	5310
	5311	"BLD",1019 0,1,213,0)
	5312	(2) Sites may also e lect to re trieve the patch dir ectly from a specifi c
	5313	"BLD",1019 0,1,214,0)
	5314	server as follows:
	5315	"BLD",1019 0,1,215,0)
	5316
	5317	"BLD",1019 0,1,216,0)
	5318	OIFO FTP ADDRE SS DIRECTORY
	5319	"BLD",1019 0,1,217,0)
	5320	-------- ------ --------- ---------- ----- ---------- --------
	5321	"BLD",1019 0,1,218,0)
	5322	Albany DNS . URL anonymous. software
	5323	"BLD",1019 0,1,219,0)
	5324	Hines DNS . DNS . URL anonymous. software
	5325	"BLD",1019 0,1,220,0)
	5326	Salt Lake City DNS . URL anonymous. software
	5327	"BLD",1019 0,1,221,0)
	5328
	5329	"BLD",1019 0,1,222,0)
	5330
	5331	"BLD",1019 0,1,223,0)
	5332	Sites may retrieve d ocumentati on directl y using Se cure File Transfer
	5333	"BLD",1019 0,1,224,0)
	5334	Protocol ( SFTP) from the ANONY MOUS.SOFTW ARE direct ory at the following
	5335	"BLD",1019 0,1,225,0)
	5336	OI Field O ffices:
	5337	"BLD",1019 0,1,226,0)
	5338
	5339	"BLD",1019 0,1,227,0)
	5340	Albany: DNS.URL
	5341	"BLD",1019 0,1,228,0)
	5342	Hines: DNS .U RL
	5343	"BLD",1019 0,1,229,0)
	5344	Salt Lake City: DNS . URL
	5345	"BLD",1019 0,1,230,0)
	5346
	5347	"BLD",1019 0,1,231,0)
	5348	Documentat ion can al so be foun d on the V A Software Documenta tion
	5349	"BLD",1019 0,1,232,0)
	5350	Library at :
	5351	"BLD",1019 0,1,233,0)
	5352	http:// URL /
	5353	"BLD",1019 0,1,234,0)
	5354
	5355	"BLD",1019 0,1,235,0)
	5356	Title File Name FTP Mod e
	5357	"BLD",1019 0,1,236,0)
	5358	---------- ---------- ---------- ---------- ---------- ---------- ---------- -
	5359	"BLD",1019 0,1,237,0)
	5360	Integrated Billing U ser Guide ib_2_0_um .doc Binar y
	5361	"BLD",1019 0,1,238,0)
	5362	Integrated Billing T echnical M anual/Secu rity Guide ib_2_0_tm .doc Binar y
	5363	"BLD",1019 0,1,239,0)
	5364	Integrated Billing D eployment, Installat ion,
	5365	"BLD",1019 0,1,240,0)
	5366	Back- Out, and R ollback Gu ide
	5367	"BLD",1019 0,1,241,0)
	5368	FY16Re venueIBVIP _Deploymen t_Installa tion_Guide .doc Binar y
	5369	"BLD",1019 0,1,242,0)
	5370
	5371	"BLD",1019 0,1,243,0)
	5372
	5373	"BLD",1019 0,1,244,0)
	5374
	5375	"BLD",1019 0,1,245,0)
	5376	Patch Inst allation:
	5377	"BLD",1019 0,1,246,0)
	5378
	5379	"BLD",1019 0,1,247,0)
	5380	Pre/Post I nstallatio n Overview :
	5381	"BLD",1019 0,1,248,0)
	5382	---------- ---------- ---------- -
	5383	"BLD",1019 0,1,249,0)
	5384	The post i nstallatio n routine, IBY568PO, is not au tomaticall y deleted
	5385	"BLD",1019 0,1,250,0)
	5386	as part of the insta llation pr ocess. You may delet e it after
	5387	"BLD",1019 0,1,251,0)
	5388	installati on if you desire.
	5389	"BLD",1019 0,1,252,0)
	5390
	5391	"BLD",1019 0,1,253,0)
	5392	Pre-Instal lation Ins tructions:
	5393	"BLD",1019 0,1,254,0)
	5394	---------- ---------- ----------
	5395	"BLD",1019 0,1,255,0)
	5396	N/A
	5397	"BLD",1019 0,1,256,0)
	5398
	5399	"BLD",1019 0,1,257,0)
	5400	Installati on Instruc tions:
	5401	"BLD",1019 0,1,258,0)
	5402	---------- ---------- ------
	5403	"BLD",1019 0,1,259,0)
	5404	This proce ss will in stall new and update d routines and other
	5405	"BLD",1019 0,1,260,0)
	5406	components listed ab ove. There is a post -install r outine tha t will add
	5407	"BLD",1019 0,1,261,0)
	5408	entries to a number of files.
	5409	"BLD",1019 0,1,262,0)
	5410
	5411	"BLD",1019 0,1,263,0)
	5412	The patch will be re leased in conjunctio n with an Accounts R eceivable
	5413	"BLD",1019 0,1,264,0)
	5414	patch, PRC A4.5315 and an Out patient Ph armacy pat ch, PSO7. 0463.
	5415	"BLD",1019 0,1,265,0)
	5416
	5417	"BLD",1019 0,1,266,0)
	5418	****** ****** ** NOT E **** ****** ****
	5419	"BLD",1019 0,1,267,0)
	5420	IF A USE R IS ON TH E SYSTEM A ND USING T HESE PROGR AMS
	5421	"BLD",1019 0,1,268,0)
	5422	AN EDITE D ERROR WI LL OCCUR.
	5423	"BLD",1019 0,1,269,0)
	5424	The patc h should b e installe d when NO Outpatient
	5425	"BLD",1019 0,1,270,0)
	5426	Pharmacy users are on the sy stem.
	5427	"BLD",1019 0,1,271,0)
	5428	****** ****** ****** ****** ****** ****
	5429	"BLD",1019 0,1,272,0)
	5430
	5431	"BLD",1019 0,1,273,0)
	5432	Installat ion will t ake less t han 1 minu te.
	5433	"BLD",1019 0,1,274,0)
	5434
	5435	"BLD",1019 0,1,275,0)
	5436	Suggested time to i nstall: no n-peak req uirement h ours.
	5437	"BLD",1019 0,1,276,0)
	5438
	5439	"BLD",1019 0,1,277,0)
	5440
	5441	"BLD",1019 0,1,278,0)
	5442	1. Obtai n the file IB_2_568_ PRCA_PSO_B UNDLE_T1.K ID.
	5443	"BLD",1019 0,1,279,0)
	5444
	5445	"BLD",1019 0,1,280,0)
	5446	2. From the Kernel Installat ion & Dist ribution S ystem menu , select
	5447	"BLD",1019 0,1,281,0)
	5448	the I nstallatio n menu.
	5449	"BLD",1019 0,1,282,0)
	5450
	5451	"BLD",1019 0,1,283,0)
	5452	3. Use L oad a Dist ribution u sing IB_2_ 568_PRCA_P SO_BUNDLE_ T1.KID whe n
	5453	"BLD",1019 0,1,284,0)
	5454	promp ted to Ent er a Host File name. You may need to ap pend a
	5455	"BLD",1019 0,1,285,0)
	5456	direc tory name.
	5457	"BLD",1019 0,1,286,0)
	5458
	5459	"BLD",1019 0,1,287,0)
	5460	4. From this menu, you may s elect to u se the fol lowing opt ions
	5461	"BLD",1019 0,1,288,0)
	5462	(when prompted for INSTAL L NAME, en ter IB2.0 568):
	5463	"BLD",1019 0,1,289,0)
	5464	a . Verify Checksums in Transpo rt Global - This opt ion will
	5465	"BLD",1019 0,1,290,0)
	5466	allow y ou to ensu re the int egrity of the routin es that
	5467	"BLD",1019 0,1,291,0)
	5468	are in the transp ort global .
	5469	"BLD",1019 0,1,292,0)
	5470	b . Print T ransport G lobal - Th is option will allow you to
	5471	"BLD",1019 0,1,293,0)
	5472	view th e componen ts of the KIDS build .
	5473	"BLD",1019 0,1,294,0)
	5474	c . Compare Transport Global to Current S ystem - Th is option
	5475	"BLD",1019 0,1,295,0)
	5476	will al low you to view all changes th at will be made when
	5477	"BLD",1019 0,1,296,0)
	5478	this pa tch is ins talled. I t compares all compo nents of
	5479	"BLD",1019 0,1,297,0)
	5480	this pa tch (routi nes, DD's, templates , etc.).
	5481	"BLD",1019 0,1,298,0)
	5482	d . Backup a Transpor t Global - This opti on will cr eate a
	5483	"BLD",1019 0,1,299,0)
	5484	backup message of any routi nes export ed with th is patch.
	5485	"BLD",1019 0,1,300,0)
	5486	It will not backu p any othe r changes such as DD 's or
	5487	"BLD",1019 0,1,301,0)
	5488	templat es.
	5489	"BLD",1019 0,1,302,0)
	5490
	5491	"BLD",1019 0,1,303,0)
	5492	5. When prompted " Want KIDS to INHIBIT LOGONs du ring the i nstall?
	5493	"BLD",1019 0,1,304,0)
	5494	NO//" respond NO.
	5495	"BLD",1019 0,1,305,0)
	5496
	5497	"BLD",1019 0,1,306,0)
	5498	6. When prompted " Want to DI SABLE Sche duled Opti ons, Menu Options,
	5499	"BLD",1019 0,1,307,0)
	5500	and P rotocols? NO//" resp ond NO.
	5501	"BLD",1019 0,1,308,0)
	5502
	5503	"BLD",1019 0,1,309,0)
	5504
	5505	"BLD",1019 0,1,310,0)
	5506
	5507	"BLD",1019 0,1,311,0)
	5508	Post-Insta llation In structions :
	5509	"BLD",1019 0,1,312,0)
	5510	---------- ---------- ---------- -
	5511	"BLD",1019 0,1,313,0)
	5512	There are no special tasks to perform af ter this p atch insta llation.
	5513	"BLD",1019 0,4,0)
	5514	^9.64PA^^
	5515	"BLD",1019 0,6.3)
	5516	12
	5517	"BLD",1019 0,"INI")
	5518
	5519	"BLD",1019 0,"INIT")
	5520
	5521	"BLD",1019 0,"KRN",0)
	5522	^9.67PA^77 9.2^20
	5523	"BLD",1019 0,"KRN",.4 ,0)
	5524	.4
	5525	"BLD",1019 0,"KRN",.4 01,0)
	5526	.401
	5527	"BLD",1019 0,"KRN",.4 02,0)
	5528	.402
	5529	"BLD",1019 0,"KRN",.4 03,0)
	5530	.403
	5531	"BLD",1019 0,"KRN",.5 ,0)
	5532	.5
	5533	"BLD",1019 0,"KRN",.8 4,0)
	5534	.84
	5535	"BLD",1019 0,"KRN",3. 6,0)
	5536	3.6
	5537	"BLD",1019 0,"KRN",3. 8,0)
	5538	3.8
	5539	"BLD",1019 0,"KRN",9. 2,0)
	5540	9.2
	5541	"BLD",1019 0,"KRN",9. 8,0)
	5542	9.8
	5543	"BLD",1019 0,"KRN",9. 8,"NM",0)
	5544	^9.68A^10^ 10
	5545	"BLD",1019 0,"KRN",9. 8,"NM",1,0 )
	5546	IBJDB21^^0 ^B12749625 8
	5547	"BLD",1019 0,"KRN",9. 8,"NM",2,0 )
	5548	IBJTLA1^^0 ^B13446872
	5549	"BLD",1019 0,"KRN",9. 8,"NM",3,0 )
	5550	IBTRE2^^0^ B41201696
	5551	"BLD",1019 0,"KRN",9. 8,"NM",4,0 )
	5552	IBTRE20^^0 ^B20248565
	5553	"BLD",1019 0,"KRN",9. 8,"NM",5,0 )
	5554	IBTRKR5^^0 ^B39052603
	5555	"BLD",1019 0,"KRN",9. 8,"NM",6,0 )
	5556	IBCBB11^^0 ^B10836496 3
	5557	"BLD",1019 0,"KRN",9. 8,"NM",7,0 )
	5558	IBJTLB1^^0 ^B13573050
	5559	"BLD",1019 0,"KRN",9. 8,"NM",8,0 )
	5560	IBJDF4^^0^ B58418546
	5561	"BLD",1019 0,"KRN",9. 8,"NM",9,0 )
	5562	IBJDF41^^0 ^B96102587
	5563	"BLD",1019 0,"KRN",9. 8,"NM",10, 0)
	5564	IBJDF42^^0 ^B55869087
	5565	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBCBB11" ,6)
	5566
	5567	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBJDB21" ,1)
	5568
	5569	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBJDF4", 8)
	5570
	5571	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBJDF41" ,9)
	5572
	5573	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBJDF42" ,10)
	5574
	5575	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBJTLA1" ,2)
	5576
	5577	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBJTLB1" ,7)
	5578
	5579	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBTRE2", 3)
	5580
	5581	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBTRE20" ,4)
	5582
	5583	"BLD",1019 0,"KRN",9. 8,"NM","B" ,"IBTRKR5" ,5)
	5584
	5585	"BLD",1019 0,"KRN",19 ,0)
	5586	19
	5587	"BLD",1019 0,"KRN",19 ,"NM",0)
	5588	^9.68A^1^1
	5589	"BLD",1019 0,"KRN",19 ,"NM",1,0)
	5590	IBT SUP MA NUALLY QUE PRSTHTCS^ ^0
	5591	"BLD",1019 0,"KRN",19 ,"NM","B", "IBT SUP M ANUALLY QU E PRSTHTCS ",1)
	5592
	5593	"BLD",1019 0,"KRN",19 .1,0)
	5594	19.1
	5595	"BLD",1019 0,"KRN",10 1,0)
	5596	101
	5597	"BLD",1019 0,"KRN",40 9.61,0)
	5598	409.61
	5599	"BLD",1019 0,"KRN",40 9.61,"NM", 0)
	5600	^9.68A^2^2
	5601	"BLD",1019 0,"KRN",40 9.61,"NM", 1,0)
	5602	IBJT ACTIV E LIST^^0
	5603	"BLD",1019 0,"KRN",40 9.61,"NM", 2,0)
	5604	IBJT INACT IVE LIST^^ 0
	5605	"BLD",1019 0,"KRN",40 9.61,"NM", "B","IBJT ACTIVE LIS T",1)
	5606
	5607	"BLD",1019 0,"KRN",40 9.61,"NM", "B","IBJT INACTIVE L IST",2)
	5608
	5609	"BLD",1019 0,"KRN",77 1,0)
	5610	771
	5611	"BLD",1019 0,"KRN",77 9.2,0)
	5612	779.2
	5613	"BLD",1019 0,"KRN",87 0,0)
	5614	870
	5615	"BLD",1019 0,"KRN",89 89.51,0)
	5616	8989.51
	5617	"BLD",1019 0,"KRN",89 89.52,0)
	5618	8989.52
	5619	"BLD",1019 0,"KRN",89 94,0)
	5620	8994
	5621	"BLD",1019 0,"KRN","B ",.4,.4)
	5622
	5623	"BLD",1019 0,"KRN","B ",.401,.40 1)
	5624
	5625	"BLD",1019 0,"KRN","B ",.402,.40 2)
	5626
	5627	"BLD",1019 0,"KRN","B ",.403,.40 3)
	5628
	5629	"BLD",1019 0,"KRN","B ",.5,.5)
	5630
	5631	"BLD",1019 0,"KRN","B ",.84,.84)
	5632
	5633	"BLD",1019 0,"KRN","B ",3.6,3.6)
	5634
	5635	"BLD",1019 0,"KRN","B ",3.8,3.8)
	5636
	5637	"BLD",1019 0,"KRN","B ",9.2,9.2)
	5638
	5639	"BLD",1019 0,"KRN","B ",9.8,9.8)
	5640
	5641	"BLD",1019 0,"KRN","B ",19,19)
	5642
	5643	"BLD",1019 0,"KRN","B ",19.1,19. 1)
	5644
	5645	"BLD",1019 0,"KRN","B ",101,101)
	5646
	5647	"BLD",1019 0,"KRN","B ",409.61,4 09.61)
	5648
	5649	"BLD",1019 0,"KRN","B ",771,771)
	5650
	5651	"BLD",1019 0,"KRN","B ",779.2,77 9.2)
	5652
	5653	"BLD",1019 0,"KRN","B ",870,870)
	5654
	5655	"BLD",1019 0,"KRN","B ",8989.51, 8989.51)
	5656
	5657	"BLD",1019 0,"KRN","B ",8989.52, 8989.52)
	5658
	5659	"BLD",1019 0,"KRN","B ",8994,899 4)
	5660
	5661	"BLD",1019 0,"QDEF")
	5662	^^^^NO^^^^ NO^^NO
	5663	"BLD",1019 0,"QUES",0 )
	5664	^9.62^^
	5665	"BLD",1019 0,"REQB",0 )
	5666	^9.611^10^ 10
	5667	"BLD",1019 0,"REQB",1 ,0)
	5668	IB2.080^ 1
	5669	"BLD",1019 0,"REQB",2 ,0)
	5670	IB2.061^ 1
	5671	"BLD",1019 0,"REQB",3 ,0)
	5672	IB2.051^ 1
	5673	"BLD",1019 0,"REQB",4 ,0)
	5674	IB2.0153 ^1
	5675	"BLD",1019 0,"REQB",5 ,0)
	5676	IB2.0137 ^1
	5677	"BLD",1019 0,"REQB",6 ,0)
	5678	IB2.0183 ^1
	5679	"BLD",1019 0,"REQB",7 ,0)
	5680	IB2.0276 ^1
	5681	"BLD",1019 0,"REQB",8 ,0)
	5682	IB2.0451 ^1
	5683	"BLD",1019 0,"REQB",9 ,0)
	5684	IB2.0516 ^1
	5685	"BLD",1019 0,"REQB",1 0,0)
	5686	IB2.0530 ^1
	5687	"BLD",1019 0,"REQB"," B","IB2.0 137",5)
	5688
	5689	"BLD",1019 0,"REQB"," B","IB2.0 153",4)
	5690
	5691	"BLD",1019 0,"REQB"," B","IB2.0 183",6)
	5692
	5693	"BLD",1019 0,"REQB"," B","IB2.0 276",7)
	5694
	5695	"BLD",1019 0,"REQB"," B","IB2.0 451",8)
	5696
	5697	"BLD",1019 0,"REQB"," B","IB2.0 51",3)
	5698
	5699	"BLD",1019 0,"REQB"," B","IB2.0 516",9)
	5700
	5701	"BLD",1019 0,"REQB"," B","IB2.0 530",10)
	5702
	5703	"BLD",1019 0,"REQB"," B","IB2.0 61",2)
	5704
	5705	"BLD",1019 0,"REQB"," B","IB2.0 80",1)
	5706
	5707	"KRN",19,1 1784,-1)
	5708	0^1
	5709	"KRN",19,1 1784,0)
	5710	IBT SUP MA NUALLY QUE PRSTHTCS^ Manually A dd Prosthe tics to Cl aims Track ing^^R^^^^ ^^^^INTEGR ATED BILLI NG
	5711	"KRN",19,1 1784,1,0)
	5712	^^5^5^3161 101^
	5713	"KRN",19,1 1784,1,1,0 )
	5714	This optio n allows t he user to select a date range of prosth etics
	5715	"KRN",19,1 1784,1,2,0 )
	5716	encounters and tries to add th em to the Claims tra cking modu le.
	5717	"KRN",19,1 1784,1,3,0 )
	5718
	5719	"KRN",19,1 1784,1,4,0 )
	5720	The option will auto matically queue off a task to add prosth etics and
	5721	"KRN",19,1 1784,1,5,0 )
	5722	when compl ete send t he request ing user a mail mess age.
	5723	"KRN",19,1 1784,25)
	5724	EN^IBTRKR5
	5725	"KRN",19,1 1784,"U")
	5726	MANUALLY A DD PROSTHE TICS TO CL
	5727	"KRN",409. 61,84,-1)
	5728	0^1
	5729	"KRN",409. 61,84,0)
	5730	IBJT ACTIV E LIST^1^^ 80^4^20^1^ 1^Active B ill^IBJT A CTIVE LIST SCREEN ME NU^Third P arty Activ e Bills^1^ ^1
	5731	"KRN",409. 61,84,1)
	5732	^VALM HIDD EN ACTIONS
	5733	"KRN",409. 61,84,"ARR AY")
	5734	^TMP("IBJ TLA",$J)
	5735	"KRN",409. 61,84,"COL ",0)
	5736	^409.621^1 4^14
	5737	"KRN",409. 61,84,"COL ",1,0)
	5738	NUMBER^1^3
	5739	"KRN",409. 61,84,"COL ",2,0)
	5740	BILL^4^9^ Bill #
	5741	"KRN",409. 61,84,"COL ",3,0)
	5742	HD^14^1
	5743	"KRN",409. 61,84,"COL ",4,0)
	5744	STFROM^15^ 8^From
	5745	"KRN",409. 61,84,"COL ",5,0)
	5746	STTO^24^8^ To
	5747	"KRN",409. 61,84,"COL ",6,0)
	5748	TYPE^37^5^ Type
	5749	"KRN",409. 61,84,"COL ",7,0)
	5750	ARST^42^4^ Stat
	5751	"KRN",409. 61,84,"COL ",8,0)
	5752	RATE^47^7^ Rate
	5753	"KRN",409. 61,84,"COL ",9,0)
	5754	CB^55^1
	5755	"KRN",409. 61,84,"COL ",10,0)
	5756	INSUR^56^7 ^Insurer
	5757	"KRN",409. 61,84,"COL ",11,0)
	5758	OAMT^64^8^ Orig Amt
	5759	"KRN",409. 61,84,"COL ",12,0)
	5760	CAMT^73^8^ Curr Amt
	5761	"KRN",409. 61,84,"COL ",13,0)
	5762	REFER^13^1
	5763	"KRN",409. 61,84,"COL ",14,0)
	5764	MT?^33^3^M T?
	5765	"KRN",409. 61,84,"COL ","B","ARS T",7)
	5766
	5767	"KRN",409. 61,84,"COL ","B","BIL L",2)
	5768
	5769	"KRN",409. 61,84,"COL ","B","CAM T",12)
	5770
	5771	"KRN",409. 61,84,"COL ","B","CB" ,9)
	5772
	5773	"KRN",409. 61,84,"COL ","B","HD" ,3)
	5774
	5775	"KRN",409. 61,84,"COL ","B","INS UR",10)
	5776
	5777	"KRN",409. 61,84,"COL ","B","MT? ",14)
	5778
	5779	"KRN",409. 61,84,"COL ","B","NUM BER",1)
	5780
	5781	"KRN",409. 61,84,"COL ","B","OAM T",11)
	5782
	5783	"KRN",409. 61,84,"COL ","B","RAT E",8)
	5784
	5785	"KRN",409. 61,84,"COL ","B","REF ER",13)
	5786
	5787	"KRN",409. 61,84,"COL ","B","STF ROM",4)
	5788
	5789	"KRN",409. 61,84,"COL ","B","STT O",5)
	5790
	5791	"KRN",409. 61,84,"COL ","B","TYP E",6)
	5792
	5793	"KRN",409. 61,84,"FNL ")
	5794	D EXIT^IBJ TLA
	5795	"KRN",409. 61,84,"HDR ")
	5796	D HDR^IBJT LA
	5797	"KRN",409. 61,84,"HLP ")
	5798	D HELP^IBJ TLA
	5799	"KRN",409. 61,84,"INI T")
	5800	D INIT^IBJ TLA
	5801	"KRN",409. 61,95,-1)
	5802	0^2
	5803	"KRN",409. 61,95,0)
	5804	IBJT INACT IVE LIST^1 ^^80^5^20^ 1^1^Inacti ve Bill^IB JT INACTIV E LIST SCR EEN MENU^I nactive Bi lls^1^^1
	5805	"KRN",409. 61,95,1)
	5806	^VALM HIDD EN ACTIONS
	5807	"KRN",409. 61,95,"ARR AY")
	5808	^TMP("IBJ TLB",$J)
	5809	"KRN",409. 61,95,"COL ",0)
	5810	^409.621^1 3^13
	5811	"KRN",409. 61,95,"COL ",1,0)
	5812	NUMBER^1^3
	5813	"KRN",409. 61,95,"COL ",2,0)
	5814	BILL^4^12^ Bill #
	5815	"KRN",409. 61,95,"COL ",3,0)
	5816	HD^17^1
	5817	"KRN",409. 61,95,"COL ",4,0)
	5818	STFROM^18^ 8^From
	5819	"KRN",409. 61,95,"COL ",5,0)
	5820	STTO^27^8^ To
	5821	"KRN",409. 61,95,"COL ",6,0)
	5822	TYPE^36^5^ Type
	5823	"KRN",409. 61,95,"COL ",7,0)
	5824	ARST^41^4^ Stat
	5825	"KRN",409. 61,95,"COL ",8,0)
	5826	RATE^46^7^ Rate
	5827	"KRN",409. 61,95,"COL ",9,0)
	5828	CB^54^1
	5829	"KRN",409. 61,95,"COL ",10,0)
	5830	INSUR^55^7 ^Insurer
	5831	"KRN",409. 61,95,"COL ",11,0)
	5832	OAMT^64^8^ Orig Amt
	5833	"KRN",409. 61,95,"COL ",12,0)
	5834	CAMT^73^8^ Curr Amt
	5835	"KRN",409. 61,95,"COL ",13,0)
	5836	REFER^16^1
	5837	"KRN",409. 61,95,"COL ","B","ARS T",7)
	5838
	5839	"KRN",409. 61,95,"COL ","B","BIL L",2)
	5840
	5841	"KRN",409. 61,95,"COL ","B","CAM T",12)
	5842
	5843	"KRN",409. 61,95,"COL ","B","CB" ,9)
	5844
	5845	"KRN",409. 61,95,"COL ","B","HD" ,3)
	5846
	5847	"KRN",409. 61,95,"COL ","B","INS UR",10)
	5848
	5849	"KRN",409. 61,95,"COL ","B","NUM BER",1)
	5850
	5851	"KRN",409. 61,95,"COL ","B","OAM T",11)
	5852
	5853	"KRN",409. 61,95,"COL ","B","RAT E",8)
	5854
	5855	"KRN",409. 61,95,"COL ","B","REF ER",13)
	5856
	5857	"KRN",409. 61,95,"COL ","B","STF ROM",4)
	5858
	5859	"KRN",409. 61,95,"COL ","B","STT O",5)
	5860
	5861	"KRN",409. 61,95,"COL ","B","TYP E",6)
	5862
	5863	"KRN",409. 61,95,"FNL ")
	5864	D EXIT^IBJ TLB
	5865	"KRN",409. 61,95,"HDR ")
	5866	D HDR^IBJT LB
	5867	"KRN",409. 61,95,"HLP ")
	5868	D HELP^IBJ TLB
	5869	"KRN",409. 61,95,"INI T")
	5870	D INIT^IBJ TLB
	5871	"MBREQ")
	5872	1
	5873	"ORD",17,4 09.61)
	5874	409.61;17; 1;;;;LME1^ XPDIA1;;;L MDEL^XPDIA 1
	5875	"ORD",17,4 09.61,0)
	5876	LIST TEMPL ATE
	5877	"ORD",18,1 9)
	5878	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	5879	"ORD",18,1 9,0)
	5880	OPTION
	5881	"PKG",49,- 1)
	5882	1^1
	5883	"PKG",49,0 )
	5884	INTEGRATED BILLING^I B^INTEGRAT ED BILLING
	5885	"PKG",49,2 0,0)
	5886	^9.402P^1^ 1
	5887	"PKG",49,2 0,1,0)
	5888	2^^IBAXDR
	5889	"PKG",49,2 0,1,1)
	5890
	5891	"PKG",49,2 0,"B",2,1)
	5892
	5893	"PKG",49,2 2,0)
	5894	^9.49I^1^1
	5895	"PKG",49,2 2,1,0)
	5896	2.0^305111 9^2960627
	5897	"PKG",49,2 2,1,"PAH", 1,0)
	5898	568^316121 5
	5899	"PKG",49,2 2,1,"PAH", 1,1,0)
	5900	^^313^313^ 3161215
	5901	"PKG",49,2 2,1,"PAH", 1,1,1,0)
	5902
	5903	"PKG",49,2 2,1,"PAH", 1,1,2,0)
	5904	IMPORTANT INSTALLATI ON NOTE:
	5905	"PKG",49,2 2,1,"PAH", 1,1,3,0)
	5906	---------- ---------- --------
	5907	"PKG",49,2 2,1,"PAH", 1,1,4,0)
	5908	This patch is part o f a multi- package bu ild. There are three patches
	5909	"PKG",49,2 2,1,"PAH", 1,1,5,0)
	5910	associated with the FY16 HAPE Revenue En hancement project -
	5911	"PKG",49,2 2,1,"PAH", 1,1,6,0)
	5912	IB2.0568 ,PRCA4.5 315 and PS O7.0463. All three patches a re to be
	5913	"PKG",49,2 2,1,"PAH", 1,1,7,0)
	5914	installed together a s a bundle , IB_2_568 _PRCA_PSO_ BUNDLE_T1. KID
	5915	"PKG",49,2 2,1,"PAH", 1,1,8,0)
	5916
	5917	"PKG",49,2 2,1,"PAH", 1,1,9,0)
	5918
	5919	"PKG",49,2 2,1,"PAH", 1,1,10,0)
	5920	Descriptio n
	5921	"PKG",49,2 2,1,"PAH", 1,1,11,0)
	5922	---------- -
	5923	"PKG",49,2 2,1,"PAH", 1,1,12,0)
	5924	The Chief Business O ffice (CBO ) is reque sting syst em enhance ments to
	5925	"PKG",49,2 2,1,"PAH", 1,1,13,0)
	5926	The Vetera ns Health Informatio n Systems and Techno logy Archi tecture
	5927	"PKG",49,2 2,1,"PAH", 1,1,14,0)
	5928	(VistA) In tegrated B illing (IB ), Account s Receivab le (AR), a nd
	5929	"PKG",49,2 2,1,"PAH", 1,1,15,0)
	5930	Outpatient Pharmacy (PSO) soft ware modul es.
	5931	"PKG",49,2 2,1,"PAH", 1,1,16,0)
	5932
	5933	"PKG",49,2 2,1,"PAH", 1,1,17,0)
	5934	The missio n of the D epartment of Veteran s Affairs (VA), Offi ce of
	5935	"PKG",49,2 2,1,"PAH", 1,1,18,0)
	5936	Informatio n & Techno logy (OI&T ), is to p rovide ben efits and services
	5937	"PKG",49,2 2,1,"PAH", 1,1,19,0)
	5938	to veteran s of the U nited Stat es Armed F orces. In meeting th ese
	5939	"PKG",49,2 2,1,"PAH", 1,1,20,0)
	5940	goals, OIT strives t o provide high quali ty, effect ive, and e fficient
	5941	"PKG",49,2 2,1,"PAH", 1,1,21,0)
	5942	Informatio n Technolo gy (IT) se rvices to those resp onsible fo r
	5943	"PKG",49,2 2,1,"PAH", 1,1,22,0)
	5944	providing care to th e veterans at the po int-of-car e, as well as
	5945	"PKG",49,2 2,1,"PAH", 1,1,23,0)
	5946	throughout all the p oints of t he veteran s' health care. The VA depends
	5947	"PKG",49,2 2,1,"PAH", 1,1,24,0)
	5948	on Informa tion Manag ement/Info rmation Te chnology ( IM/IT) sys tems to
	5949	"PKG",49,2 2,1,"PAH", 1,1,25,0)
	5950	meet missi on goals.
	5951	"PKG",49,2 2,1,"PAH", 1,1,26,0)
	5952
	5953	"PKG",49,2 2,1,"PAH", 1,1,27,0)
	5954	The overal l FY16 HAP E Revenue Enhancemen t project has been f urther
	5955	"PKG",49,2 2,1,"PAH", 1,1,28,0)
	5956	divided in to three s ub-project s:
	5957	"PKG",49,2 2,1,"PAH", 1,1,29,0)
	5958
	5959	"PKG",49,2 2,1,"PAH", 1,1,30,0)
	5960	NSR #20150 506
	5961	"PKG",49,2 2,1,"PAH", 1,1,31,0)
	5962	The Revenu e Eligibil ity Enhanc ements Pro ject effor t for the Chief
	5963	"PKG",49,2 2,1,"PAH", 1,1,32,0)
	5964	Business O ffice (CBO ), bundles several N SRs with s imilar bus iness
	5965	"PKG",49,2 2,1,"PAH", 1,1,33,0)
	5966	needs into a single requiremen ts documen t. Succes sfully add ressing
	5967	"PKG",49,2 2,1,"PAH", 1,1,34,0)
	5968	the requir ements con tained wit hin this d ocument wi ll enable the
	5969	"PKG",49,2 2,1,"PAH", 1,1,35,0)
	5970	Department of Vetera ns Affairs (VA) to a ppropriate ly bill ce rtain
	5971	"PKG",49,2 2,1,"PAH", 1,1,36,0)
	5972	subsets of billable events by correcting , automati ng, or enh ancing
	5973	"PKG",49,2 2,1,"PAH", 1,1,37,0)
	5974	current Ve terans Hea lth Inform ation Syst ems and Te chnology
	5975	"PKG",49,2 2,1,"PAH", 1,1,38,0)
	5976	Architectu re (VistA) systems.
	5977	"PKG",49,2 2,1,"PAH", 1,1,39,0)
	5978
	5979	"PKG",49,2 2,1,"PAH", 1,1,40,0)
	5980	NSR #20150 507
	5981	"PKG",49,2 2,1,"PAH", 1,1,41,0)
	5982	The Revenu e Operatio ns Enhance ments Proj ect combin es servera l NSRs,
	5983	"PKG",49,2 2,1,"PAH", 1,1,42,0)
	5984	as well. T his effort enables t he Departm ent of Vet erans Affa irs (VA)
	5985	"PKG",49,2 2,1,"PAH", 1,1,43,0)
	5986	to improve revenue o peration f unctionali ty related to repaym ent plans,
	5987	"PKG",49,2 2,1,"PAH", 1,1,44,0)
	5988	late charg e capture, bill susp ension rea sons, the billing of
	5989	"PKG",49,2 2,1,"PAH", 1,1,45,0)
	5990	deactivate d provider s, and the display o f appeal r ights and
	5991	"PKG",49,2 2,1,"PAH", 1,1,46,0)
	5992	responsibi lities on the Vetera ns Benefic iary trave l Bill of Collection s
	5993	"PKG",49,2 2,1,"PAH", 1,1,47,0)
	5994	form. Imp lementatio n of the p roposed en hancements will make a
	5995	"PKG",49,2 2,1,"PAH", 1,1,48,0)
	5996	significan t positive impact on stakehold ers and ta rget users .
	5997	"PKG",49,2 2,1,"PAH", 1,1,49,0)
	5998
	5999	"PKG",49,2 2,1,"PAH", 1,1,50,0)
	6000	NSR #20150 505
	6001	"PKG",49,2 2,1,"PAH", 1,1,51,0)
	6002	The Revenu e Reportin g Enhancem ents Proje ct will en able the V A to
	6003	"PKG",49,2 2,1,"PAH", 1,1,52,0)
	6004	improve tr acking and reporting of revenu e, and wil l support revenue
	6005	"PKG",49,2 2,1,"PAH", 1,1,53,0)
	6006	reporting business r ules and g uidelines.
	6007	"PKG",49,2 2,1,"PAH", 1,1,54,0)
	6008
	6009	"PKG",49,2 2,1,"PAH", 1,1,55,0)
	6010
	6011	"PKG",49,2 2,1,"PAH", 1,1,56,0)
	6012	IB2.0568 patch enh ancements, pertinent to the ab ove NSRs, include:
	6013	"PKG",49,2 2,1,"PAH", 1,1,57,0)
	6014
	6015	"PKG",49,2 2,1,"PAH", 1,1,58,0)
	6016	1.) When g enerating the RNB (R easons Not Billable) report, t he
	6017	"PKG",49,2 2,1,"PAH", 1,1,59,0)
	6018	Integrated Billing s ystem shal l populate the charg es for all types
	6019	"PKG",49,2 2,1,"PAH", 1,1,60,0)
	6020	of service s provided . Charges will not b e screened by any bi llable
	6021	"PKG",49,2 2,1,"PAH", 1,1,61,0)
	6022	criteria b ut willind icate the full amoun t as if th e care was to be
	6023	"PKG",49,2 2,1,"PAH", 1,1,62,0)
	6024	billed.
	6025	"PKG",49,2 2,1,"PAH", 1,1,63,0)
	6026
	6027	"PKG",49,2 2,1,"PAH", 1,1,64,0)
	6028	2.) The su b-option C laims Trac king Param eter Edit [IBT EDIT TRACKING
	6029	"PKG",49,2 2,1,"PAH", 1,1,65,0)
	6030	PARAMETERS ], that cu rrently ha s no key, will be lo cked with a new
	6031	"PKG",49,2 2,1,"PAH", 1,1,66,0)
	6032	Security K ey called IB PARAMET ER EDIT.
	6033	"PKG",49,2 2,1,"PAH", 1,1,67,0)
	6034
	6035	"PKG",49,2 2,1,"PAH", 1,1,68,0)
	6036	3.) The op tion MCCR Site Param eter Displ ay/Edit [I BJ MCCR SI TE
	6037	"PKG",49,2 2,1,"PAH", 1,1,69,0)
	6038	PARAMETERS ], which i s currentl y locked w ith the IB SUPERVISO R Security
	6039	"PKG",49,2 2,1,"PAH", 1,1,70,0)
	6040	Key, will be instead locked wi th the new key.
	6041	"PKG",49,2 2,1,"PAH", 1,1,71,0)
	6042
	6043	"PKG",49,2 2,1,"PAH", 1,1,72,0)
	6044	4.) The In tegrated B illing sys tem shall create cla ims tracki ng entries
	6045	"PKG",49,2 2,1,"PAH", 1,1,73,0)
	6046	for previo usly unbil led Prosth etics/DME items when new billa ble
	6047	"PKG",49,2 2,1,"PAH", 1,1,74,0)
	6048	insurance is entered into the patient's insurance file.
	6049	"PKG",49,2 2,1,"PAH", 1,1,75,0)
	6050
	6051	"PKG",49,2 2,1,"PAH", 1,1,76,0)
	6052	5.) A new coverage l imitation field shal l be creat ed in the insurance
	6053	"PKG",49,2 2,1,"PAH", 1,1,77,0)
	6054	file for P rosthetics . Like th e other ex isting cov erage limi tation
	6055	"PKG",49,2 2,1,"PAH", 1,1,78,0)
	6056	fields in the insura nce file ( Inpatient, Outpatien t, Pharmac y etc.),
	6057	"PKG",49,2 2,1,"PAH", 1,1,79,0)
	6058	this field will have the follo wing optio ns:
	6059	"PKG",49,2 2,1,"PAH", 1,1,80,0)
	6060	0= NOT COVERE D
	6061	"PKG",49,2 2,1,"PAH", 1,1,81,0)
	6062	1= COVERED
	6063	"PKG",49,2 2,1,"PAH", 1,1,82,0)
	6064	2= CONDITIONA LCOVERAGE
	6065	"PKG",49,2 2,1,"PAH", 1,1,83,0)
	6066	Once selec ted, they will show in the pat ient insur ance file as Yes,
	6067	"PKG",49,2 2,1,"PAH", 1,1,84,0)
	6068	No, or Con ditional.
	6069	"PKG",49,2 2,1,"PAH", 1,1,85,0)
	6070
	6071	"PKG",49,2 2,1,"PAH", 1,1,86,0)
	6072	6.) The sy stem shall automatic ally assig n an RNB [ NO PROSTHE TIC
	6073	"PKG",49,2 2,1,"PAH", 1,1,87,0)
	6074	COVERAGE ( CV22)] for Prostheti cs/DME ite ms if the patient ha s no
	6075	"PKG",49,2 2,1,"PAH", 1,1,88,0)
	6076	coverage f or Prosthe tics in hi s/her insu rance file .
	6077	"PKG",49,2 2,1,"PAH", 1,1,89,0)
	6078
	6079	"PKG",49,2 2,1,"PAH", 1,1,90,0)
	6080	7.) The sy stem shall have a ne w option t o add Pros thetics it ems to
	6081	"PKG",49,2 2,1,"PAH", 1,1,91,0)
	6082	Manual and Nightly C laims Trac king.
	6083	"PKG",49,2 2,1,"PAH", 1,1,92,0)
	6084
	6085	"PKG",49,2 2,1,"PAH", 1,1,93,0)
	6086	8.) Users will be ab le to sele ct Suspend ed Type fr om the men u to
	6087	"PKG",49,2 2,1,"PAH", 1,1,94,0)
	6088	display in the First Party Fol low- Up [I BJD FOLLOW -UP FIRST PARTY]
	6089	"PKG",49,2 2,1,"PAH", 1,1,95,0)
	6090	report.
	6091	"PKG",49,2 2,1,"PAH", 1,1,96,0)
	6092
	6093	"PKG",49,2 2,1,"PAH", 1,1,97,0)
	6094	9.) First Party Foll ow- Up [IB JD FOLLOW- UP FIRST P ARTY] repo rt shall
	6095	"PKG",49,2 2,1,"PAH", 1,1,98,0)
	6096	be modifie d to incor porate rea son for su spension.
	6097	"PKG",49,2 2,1,"PAH", 1,1,99,0)
	6098
	6099	"PKG",49,2 2,1,"PAH", 1,1,100,0)
	6100	10.) A new warning m essage wil l print to the scree n in the E nter/Edit
	6101	"PKG",49,2 2,1,"PAH", 1,1,101,0)
	6102	Billing In formation option if an ATTENDI NG, REFERR ING or REN DERING
	6103	"PKG",49,2 2,1,"PAH", 1,1,102,0)
	6104	Provider h as a PERSO N CLASS - NEW PERSON file (#20 0) - that was
	6105	"PKG",49,2 2,1,"PAH", 1,1,103,0)
	6106	expirated at the tim e of the D ate of Ser vice.
	6107	"PKG",49,2 2,1,"PAH", 1,1,104,0)
	6108
	6109	"PKG",49,2 2,1,"PAH", 1,1,105,0)
	6110	11.) On th e Third Pa rty Joint Inquiry sc reen, one (1) charac ter space
	6111	"PKG",49,2 2,1,"PAH", 1,1,106,0)
	6112	shall be a dded to th e "Type" f ield so th at it will accommoda te five
	6113	"PKG",49,2 2,1,"PAH", 1,1,107,0)
	6114	characters (a one-ch aracter cl assificati on indicat or, a forw ard slash
	6115	"PKG",49,2 2,1,"PAH", 1,1,108,0)
	6116	(/), a one -character component indicator , a forwar d slash (/ ), and a
	6117	"PKG",49,2 2,1,"PAH", 1,1,109,0)
	6118	one-charac ter care t ype) ("X/X /X"). If a bill con tains pres criptions,
	6119	"PKG",49,2 2,1,"PAH", 1,1,110,0)
	6120	then an "R " shall be concatena ted to the fifth cha racter sub -type
	6121	"PKG",49,2 2,1,"PAH", 1,1,111,0)
	6122	position o f the "Typ e" field. If a bill contains p rosthetics , then a
	6123	"PKG",49,2 2,1,"PAH", 1,1,112,0)
	6124	"P" shall be concate nated to f ifth chara cter sub-t ype positi on of the
	6125	"PKG",49,2 2,1,"PAH", 1,1,113,0)
	6126	"Type" fie ld.The "Ty pe" field shall cont ain five ( 5) charact ers as
	6127	"PKG",49,2 2,1,"PAH", 1,1,114,0)
	6128	follows:
	6129	"PKG",49,2 2,1,"PAH", 1,1,115,0)
	6130	1. "I" for Inpatient or "O" fo r Outpatie nt,
	6131	"PKG",49,2 2,1,"PAH", 1,1,116,0)
	6132	2. "/" for ward slash character
	6133	"PKG",49,2 2,1,"PAH", 1,1,117,0)
	6134	3. "P" for Professio nal or "I" for Insti tutional
	6135	"PKG",49,2 2,1,"PAH", 1,1,118,0)
	6136	4. "/" for ward slash character
	6137	"PKG",49,2 2,1,"PAH", 1,1,119,0)
	6138	5. "P" for Prostheti cs or "R" for Prescr iptions
	6139	"PKG",49,2 2,1,"PAH", 1,1,120,0)
	6140
	6141	"PKG",49,2 2,1,"PAH", 1,1,121,0)
	6142	12.) Three new Third Party Ins urance Rat e Types sh all be cre ated in
	6143	"PKG",49,2 2,1,"PAH", 1,1,122,0)
	6144	the VistA IB Suite f or the bil lers to ch oose from when billi ng for
	6145	"PKG",49,2 2,1,"PAH", 1,1,123,0)
	6146	encounters . They are as follow s:
	6147	"PKG",49,2 2,1,"PAH", 1,1,124,0)
	6148	HU MANITARIAN REIMB. IN S.
	6149	"PKG",49,2 2,1,"PAH", 1,1,125,0)
	6150	DE NTAL REIMB . INS.
	6151	"PKG",49,2 2,1,"PAH", 1,1,126,0)
	6152	IN ELIGIBLE R EIMB. INS.
	6153	"PKG",49,2 2,1,"PAH", 1,1,127,0)
	6154
	6155	"PKG",49,2 2,1,"PAH", 1,1,128,0)
	6156	13.) Each of the new rate type s above wi ll have th e 'Insurer ' as the
	6157	"PKG",49,2 2,1,"PAH", 1,1,129,0)
	6158	responsibl e party.
	6159	"PKG",49,2 2,1,"PAH", 1,1,130,0)
	6160
	6161	"PKG",49,2 2,1,"PAH", 1,1,131,0)
	6162	14.) Bille rs (revenu e staff) s hould be a ble to ide ntify any remaining
	6163	"PKG",49,2 2,1,"PAH", 1,1,132,0)
	6164	charges to the patie nt after t he Third P arty payme nts are re ceived for
	6165	"PKG",49,2 2,1,"PAH", 1,1,133,0)
	6166	Emergency Humanitari an, Inelig ible and D ental serv ices so th ey can
	6167	"PKG",49,2 2,1,"PAH", 1,1,134,0)
	6168	accomplish balance b illing.
	6169	"PKG",49,2 2,1,"PAH", 1,1,135,0)
	6170
	6171	"PKG",49,2 2,1,"PAH", 1,1,136,0)
	6172
	6173	"PKG",49,2 2,1,"PAH", 1,1,137,0)
	6174
	6175	"PKG",49,2 2,1,"PAH", 1,1,138,0)
	6176	Concurrent Developme nt / Depen dencies:
	6177	"PKG",49,2 2,1,"PAH", 1,1,139,0)
	6178	---------- ---------- ---------- --------
	6179	"PKG",49,2 2,1,"PAH", 1,1,140,0)
	6180	N/A
	6181	"PKG",49,2 2,1,"PAH", 1,1,141,0)
	6182
	6183	"PKG",49,2 2,1,"PAH", 1,1,142,0)
	6184
	6185	"PKG",49,2 2,1,"PAH", 1,1,143,0)
	6186	Patch Comp onents:
	6187	"PKG",49,2 2,1,"PAH", 1,1,144,0)
	6188	---------- -------
	6189	"PKG",49,2 2,1,"PAH", 1,1,145,0)
	6190
	6191	"PKG",49,2 2,1,"PAH", 1,1,146,0)
	6192	Files & Fi elds Assoc iated:
	6193	"PKG",49,2 2,1,"PAH", 1,1,147,0)
	6194
	6195	"PKG",49,2 2,1,"PAH", 1,1,148,0)
	6196	File Name (Number) Field Na me (Number ) New/ Modified/D eleted
	6197	"PKG",49,2 2,1,"PAH", 1,1,149,0)
	6198	---------- -------- -------- ---------- - ---- ---------- ------
	6199	"PKG",49,2 2,1,"PAH", 1,1,150,0)
	6200	N/A
	6201	"PKG",49,2 2,1,"PAH", 1,1,151,0)
	6202
	6203	"PKG",49,2 2,1,"PAH", 1,1,152,0)
	6204	Options As sociated:
	6205	"PKG",49,2 2,1,"PAH", 1,1,153,0)
	6206
	6207	"PKG",49,2 2,1,"PAH", 1,1,154,0)
	6208	Option Nam e Type New/ Modified/D eleted
	6209	"PKG",49,2 2,1,"PAH", 1,1,155,0)
	6210	---------- - ---- ---- ---------- ------
	6211	"PKG",49,2 2,1,"PAH", 1,1,156,0)
	6212	IBT SUP MA NUALLY QUE PRSTHTCS ROUTINE NEW
	6213	"PKG",49,2 2,1,"PAH", 1,1,157,0)
	6214
	6215	"PKG",49,2 2,1,"PAH", 1,1,158,0)
	6216	Protocols Associated :
	6217	"PKG",49,2 2,1,"PAH", 1,1,159,0)
	6218
	6219	"PKG",49,2 2,1,"PAH", 1,1,160,0)
	6220	Protocol N ame New /Modified/ Deleted
	6221	"PKG",49,2 2,1,"PAH", 1,1,161,0)
	6222	---------- --- --- ---------- -------
	6223	"PKG",49,2 2,1,"PAH", 1,1,162,0)
	6224	N/A
	6225	"PKG",49,2 2,1,"PAH", 1,1,163,0)
	6226
	6227	"PKG",49,2 2,1,"PAH", 1,1,164,0)
	6228	Templates Associated :
	6229	"PKG",49,2 2,1,"PAH", 1,1,165,0)
	6230
	6231	"PKG",49,2 2,1,"PAH", 1,1,166,0)
	6232	Template N ame T ype File Name (Num ber) New/Mod/De l
	6233	"PKG",49,2 2,1,"PAH", 1,1,167,0)
	6234	---------- --- - --- ---- ---------- ---- ---------- -
	6235	"PKG",49,2 2,1,"PAH", 1,1,168,0)
	6236	IBJT ACTIV E LIST L IST NEW
	6237	"PKG",49,2 2,1,"PAH", 1,1,169,0)
	6238	IBJT INACT IVE LIST L IST NEW
	6239	"PKG",49,2 2,1,"PAH", 1,1,170,0)
	6240
	6241	"PKG",49,2 2,1,"PAH", 1,1,171,0)
	6242	New Servic e Requests (NSRs):
	6243	"PKG",49,2 2,1,"PAH", 1,1,172,0)
	6244	---------- ---------- --------
	6245	"PKG",49,2 2,1,"PAH", 1,1,173,0)
	6246	20150505 - Revenue R eporting E nhancement s
	6247	"PKG",49,2 2,1,"PAH", 1,1,174,0)
	6248	20150506 - Revenue E ligibility Enhanceme nts
	6249	"PKG",49,2 2,1,"PAH", 1,1,175,0)
	6250	20150507 - Revenue O perations Enhancemen ts
	6251	"PKG",49,2 2,1,"PAH", 1,1,176,0)
	6252
	6253	"PKG",49,2 2,1,"PAH", 1,1,177,0)
	6254
	6255	"PKG",49,2 2,1,"PAH", 1,1,178,0)
	6256	Patient Sa fety Issue s (PSIs):
	6257	"PKG",49,2 2,1,"PAH", 1,1,179,0)
	6258	---------- ---------- ----------
	6259	"PKG",49,2 2,1,"PAH", 1,1,180,0)
	6260	N/A
	6261	"PKG",49,2 2,1,"PAH", 1,1,181,0)
	6262
	6263	"PKG",49,2 2,1,"PAH", 1,1,182,0)
	6264
	6265	"PKG",49,2 2,1,"PAH", 1,1,183,0)
	6266	Remedy Tic ket(s) & O verviews:
	6267	"PKG",49,2 2,1,"PAH", 1,1,184,0)
	6268	---------- ---------- ---------
	6269	"PKG",49,2 2,1,"PAH", 1,1,185,0)
	6270	N/A
	6271	"PKG",49,2 2,1,"PAH", 1,1,186,0)
	6272
	6273	"PKG",49,2 2,1,"PAH", 1,1,187,0)
	6274	Test Sites :
	6275	"PKG",49,2 2,1,"PAH", 1,1,188,0)
	6276	----------
	6277	"PKG",49,2 2,1,"PAH", 1,1,189,0)
	6278	Durham VAM C
	6279	"PKG",49,2 2,1,"PAH", 1,1,190,0)
	6280
	6281	"PKG",49,2 2,1,"PAH", 1,1,191,0)
	6282
	6283	"PKG",49,2 2,1,"PAH", 1,1,192,0)
	6284	Software a nd Documen tation Ret rieval Ins tructions:
	6285	"PKG",49,2 2,1,"PAH", 1,1,193,0)
	6286	---------- ---------- ---------- ---------- ---------- --
	6287	"PKG",49,2 2,1,"PAH", 1,1,194,0)
	6288	Patches fo r this ins tallation are combin ed in host file
	6289	"PKG",49,2 2,1,"PAH", 1,1,195,0)
	6290	IB_2_568_P RCA_PSO_BU NDLE_T1.KI D
	6291	"PKG",49,2 2,1,"PAH", 1,1,196,0)
	6292
	6293	"PKG",49,2 2,1,"PAH", 1,1,197,0)
	6294	Installati on of this host file should be coordinat ed among t he package s
	6295	"PKG",49,2 2,1,"PAH", 1,1,198,0)
	6296	affected s ince only one instal lation is necessary.
	6297	"PKG",49,2 2,1,"PAH", 1,1,199,0)
	6298
	6299	"PKG",49,2 2,1,"PAH", 1,1,200,0)
	6300	The patche s are:
	6301	"PKG",49,2 2,1,"PAH", 1,1,201,0)
	6302
	6303	"PKG",49,2 2,1,"PAH", 1,1,202,0)
	6304	IB2. 0568
	6305	"PKG",49,2 2,1,"PAH", 1,1,203,0)
	6306	PRCA* 4.5*315
	6307	"PKG",49,2 2,1,"PAH", 1,1,204,0)
	6308	PSO7 .0463
	6309	"PKG",49,2 2,1,"PAH", 1,1,205,0)
	6310
	6311	"PKG",49,2 2,1,"PAH", 1,1,206,0)
	6312
	6313	"PKG",49,2 2,1,"PAH", 1,1,207,0)
	6314	Sites may retrieve t he KIDS bu ild in one of the fo llowing wa ys:
	6315	"PKG",49,2 2,1,"PAH", 1,1,208,0)
	6316
	6317	"PKG",49,2 2,1,"PAH", 1,1,209,0)
	6318	(1) The pr eferred me thod is to FTP the f iles from
	6319	"PKG",49,2 2,1,"PAH", 1,1,210,0)
	6320	download. DNS . DNS which will transmit the files from the f irst
	6321	"PKG",49,2 2,1,"PAH", 1,1,211,0)
	6322	available FTP server .
	6323	"PKG",49,2 2,1,"PAH", 1,1,212,0)
	6324
	6325	"PKG",49,2 2,1,"PAH", 1,1,213,0)
	6326	(2) Sites may also e lect to re trieve the patch dir ectly from a specifi c
	6327	"PKG",49,2 2,1,"PAH", 1,1,214,0)
	6328	server as follows:
	6329	"PKG",49,2 2,1,"PAH", 1,1,215,0)
	6330
	6331	"PKG",49,2 2,1,"PAH", 1,1,216,0)
	6332	OIFO FTP ADDRE SS DIRECTORY
	6333	"PKG",49,2 2,1,"PAH", 1,1,217,0)
	6334	-------- ------ --------- ---------- ----- ---------- --------
	6335	"PKG",49,2 2,1,"PAH", 1,1,218,0)
	6336	Albany DNS . URL anonymous. software
	6337	"PKG",49,2 2,1,"PAH", 1,1,219,0)
	6338	Hines DNS . DNS . URL anonymous. software
	6339	"PKG",49,2 2,1,"PAH", 1,1,220,0)
	6340	Salt Lake City DNS . URL anonymous. software
	6341	"PKG",49,2 2,1,"PAH", 1,1,221,0)
	6342
	6343	"PKG",49,2 2,1,"PAH", 1,1,222,0)
	6344
	6345	"PKG",49,2 2,1,"PAH", 1,1,223,0)
	6346	Sites may retrieve d ocumentati on directl y using Se cure File Transfer
	6347	"PKG",49,2 2,1,"PAH", 1,1,224,0)
	6348	Protocol ( SFTP) from the ANONY MOUS.SOFTW ARE direct ory at the following
	6349	"PKG",49,2 2,1,"PAH", 1,1,225,0)
	6350	OI Field O ffices:
	6351	"PKG",49,2 2,1,"PAH", 1,1,226,0)
	6352
	6353	"PKG",49,2 2,1,"PAH", 1,1,227,0)
	6354	Albany: DNS.URL
	6355	"PKG",49,2 2,1,"PAH", 1,1,228,0)
	6356	Hines: DNS .U RL
	6357	"PKG",49,2 2,1,"PAH", 1,1,229,0)
	6358	Salt Lake City: DNS . URL
	6359	"PKG",49,2 2,1,"PAH", 1,1,230,0)
	6360
	6361	"PKG",49,2 2,1,"PAH", 1,1,231,0)
	6362	Documentat ion can al so be foun d on the V A Software Documenta tion
	6363	"PKG",49,2 2,1,"PAH", 1,1,232,0)
	6364	Library at :
	6365	"PKG",49,2 2,1,"PAH", 1,1,233,0)
	6366	http:// URL /
	6367	"PKG",49,2 2,1,"PAH", 1,1,234,0)
	6368
	6369	"PKG",49,2 2,1,"PAH", 1,1,235,0)
	6370	Title File Name FTP Mod e
	6371	"PKG",49,2 2,1,"PAH", 1,1,236,0)
	6372	---------- ---------- ---------- ---------- ---------- ---------- ---------- -
	6373	"PKG",49,2 2,1,"PAH", 1,1,237,0)
	6374	Integrated Billing U ser Guide ib_2_0_um .doc Binar y
	6375	"PKG",49,2 2,1,"PAH", 1,1,238,0)
	6376	Integrated Billing T echnical M anual/Secu rity Guide ib_2_0_tm .doc Binar y
	6377	"PKG",49,2 2,1,"PAH", 1,1,239,0)
	6378	Integrated Billing D eployment, Installat ion,
	6379	"PKG",49,2 2,1,"PAH", 1,1,240,0)
	6380	Back- Out, and R ollback Gu ide
	6381	"PKG",49,2 2,1,"PAH", 1,1,241,0)
	6382	FY16Re venueIBVIP _Deploymen t_Installa tion_Guide .doc Binar y
	6383	"PKG",49,2 2,1,"PAH", 1,1,242,0)
	6384
	6385	"PKG",49,2 2,1,"PAH", 1,1,243,0)
	6386
	6387	"PKG",49,2 2,1,"PAH", 1,1,244,0)
	6388
	6389	"PKG",49,2 2,1,"PAH", 1,1,245,0)
	6390	Patch Inst allation:
	6391	"PKG",49,2 2,1,"PAH", 1,1,246,0)
	6392
	6393	"PKG",49,2 2,1,"PAH", 1,1,247,0)
	6394	Pre/Post I nstallatio n Overview :
	6395	"PKG",49,2 2,1,"PAH", 1,1,248,0)
	6396	---------- ---------- ---------- -
	6397	"PKG",49,2 2,1,"PAH", 1,1,249,0)
	6398	The post i nstallatio n routine, IBY568PO, is not au tomaticall y deleted
	6399	"PKG",49,2 2,1,"PAH", 1,1,250,0)
	6400	as part of the insta llation pr ocess. You may delet e it after
	6401	"PKG",49,2 2,1,"PAH", 1,1,251,0)
	6402	installati on if you desire.
	6403	"PKG",49,2 2,1,"PAH", 1,1,252,0)
	6404
	6405	"PKG",49,2 2,1,"PAH", 1,1,253,0)
	6406	Pre-Instal lation Ins tructions:
	6407	"PKG",49,2 2,1,"PAH", 1,1,254,0)
	6408	---------- ---------- ----------
	6409	"PKG",49,2 2,1,"PAH", 1,1,255,0)
	6410	N/A
	6411	"PKG",49,2 2,1,"PAH", 1,1,256,0)
	6412
	6413	"PKG",49,2 2,1,"PAH", 1,1,257,0)
	6414	Installati on Instruc tions:
	6415	"PKG",49,2 2,1,"PAH", 1,1,258,0)
	6416	---------- ---------- ------
	6417	"PKG",49,2 2,1,"PAH", 1,1,259,0)
	6418	This proce ss will in stall new and update d routines and other
	6419	"PKG",49,2 2,1,"PAH", 1,1,260,0)
	6420	components listed ab ove. There is a post -install r outine tha t will add
	6421	"PKG",49,2 2,1,"PAH", 1,1,261,0)
	6422	entries to a number of files.
	6423	"PKG",49,2 2,1,"PAH", 1,1,262,0)
	6424
	6425	"PKG",49,2 2,1,"PAH", 1,1,263,0)
	6426	The patch will be re leased in conjunctio n with an Accounts R eceivable
	6427	"PKG",49,2 2,1,"PAH", 1,1,264,0)
	6428	patch, PRC A4.5315 and an Out patient Ph armacy pat ch, PSO7. 0463.
	6429	"PKG",49,2 2,1,"PAH", 1,1,265,0)
	6430
	6431	"PKG",49,2 2,1,"PAH", 1,1,266,0)
	6432	****** ****** ** NOT E **** ****** ****
	6433	"PKG",49,2 2,1,"PAH", 1,1,267,0)
	6434	IF A USE R IS ON TH E SYSTEM A ND USING T HESE PROGR AMS
	6435	"PKG",49,2 2,1,"PAH", 1,1,268,0)
	6436	AN EDITE D ERROR WI LL OCCUR.
	6437	"PKG",49,2 2,1,"PAH", 1,1,269,0)
	6438	The patc h should b e installe d when NO Outpatient
	6439	"PKG",49,2 2,1,"PAH", 1,1,270,0)
	6440	Pharmacy users are on the sy stem.
	6441	"PKG",49,2 2,1,"PAH", 1,1,271,0)
	6442	****** ****** ****** ****** ****** ****
	6443	"PKG",49,2 2,1,"PAH", 1,1,272,0)
	6444
	6445	"PKG",49,2 2,1,"PAH", 1,1,273,0)
	6446	Installat ion will t ake less t han 1 minu te.
	6447	"PKG",49,2 2,1,"PAH", 1,1,274,0)
	6448
	6449	"PKG",49,2 2,1,"PAH", 1,1,275,0)
	6450	Suggested time to i nstall: no n-peak req uirement h ours.
	6451	"PKG",49,2 2,1,"PAH", 1,1,276,0)
	6452
	6453	"PKG",49,2 2,1,"PAH", 1,1,277,0)
	6454
	6455	"PKG",49,2 2,1,"PAH", 1,1,278,0)
	6456	1. Obtai n the file IB_2_568_ PRCA_PSO_B UNDLE_T1.K ID.
	6457	"PKG",49,2 2,1,"PAH", 1,1,279,0)
	6458
	6459	"PKG",49,2 2,1,"PAH", 1,1,280,0)
	6460	2. From the Kernel Installat ion & Dist ribution S ystem menu , select
	6461	"PKG",49,2 2,1,"PAH", 1,1,281,0)
	6462	the I nstallatio n menu.
	6463	"PKG",49,2 2,1,"PAH", 1,1,282,0)
	6464
	6465	"PKG",49,2 2,1,"PAH", 1,1,283,0)
	6466	3. Use L oad a Dist ribution u sing IB_2_ 568_PRCA_P SO_BUNDLE_ T1.KID whe n
	6467	"PKG",49,2 2,1,"PAH", 1,1,284,0)
	6468	promp ted to Ent er a Host File name. You may need to ap pend a
	6469	"PKG",49,2 2,1,"PAH", 1,1,285,0)
	6470	direc tory name.
	6471	"PKG",49,2 2,1,"PAH", 1,1,286,0)
	6472
	6473	"PKG",49,2 2,1,"PAH", 1,1,287,0)
	6474	4. From this menu, you may s elect to u se the fol lowing opt ions
	6475	"PKG",49,2 2,1,"PAH", 1,1,288,0)
	6476	(when prompted for INSTAL L NAME, en ter IB2.0 568):
	6477	"PKG",49,2 2,1,"PAH", 1,1,289,0)
	6478	a . Verify Checksums in Transpo rt Global - This opt ion will
	6479	"PKG",49,2 2,1,"PAH", 1,1,290,0)
	6480	allow y ou to ensu re the int egrity of the routin es that
	6481	"PKG",49,2 2,1,"PAH", 1,1,291,0)
	6482	are in the transp ort global .
	6483	"PKG",49,2 2,1,"PAH", 1,1,292,0)
	6484	b . Print T ransport G lobal - Th is option will allow you to
	6485	"PKG",49,2 2,1,"PAH", 1,1,293,0)
	6486	view th e componen ts of the KIDS build .
	6487	"PKG",49,2 2,1,"PAH", 1,1,294,0)
	6488	c . Compare Transport Global to Current S ystem - Th is option
	6489	"PKG",49,2 2,1,"PAH", 1,1,295,0)
	6490	will al low you to view all changes th at will be made when
	6491	"PKG",49,2 2,1,"PAH", 1,1,296,0)
	6492	this pa tch is ins talled. I t compares all compo nents of
	6493	"PKG",49,2 2,1,"PAH", 1,1,297,0)
	6494	this pa tch (routi nes, DD's, templates , etc.).
	6495	"PKG",49,2 2,1,"PAH", 1,1,298,0)
	6496	d . Backup a Transpor t Global - This opti on will cr eate a
	6497	"PKG",49,2 2,1,"PAH", 1,1,299,0)
	6498	backup message of any routi nes export ed with th is patch.
	6499	"PKG",49,2 2,1,"PAH", 1,1,300,0)
	6500	It will not backu p any othe r changes such as DD 's or
	6501	"PKG",49,2 2,1,"PAH", 1,1,301,0)
	6502	templat es.
	6503	"PKG",49,2 2,1,"PAH", 1,1,302,0)
	6504
	6505	"PKG",49,2 2,1,"PAH", 1,1,303,0)
	6506	5. When prompted " Want KIDS to INHIBIT LOGONs du ring the i nstall?
	6507	"PKG",49,2 2,1,"PAH", 1,1,304,0)
	6508	NO//" respond NO.
	6509	"PKG",49,2 2,1,"PAH", 1,1,305,0)
	6510
	6511	"PKG",49,2 2,1,"PAH", 1,1,306,0)
	6512	6. When prompted " Want to DI SABLE Sche duled Opti ons, Menu Options,
	6513	"PKG",49,2 2,1,"PAH", 1,1,307,0)
	6514	and P rotocols? NO//" resp ond NO.
	6515	"PKG",49,2 2,1,"PAH", 1,1,308,0)
	6516
	6517	"PKG",49,2 2,1,"PAH", 1,1,309,0)
	6518
	6519	"PKG",49,2 2,1,"PAH", 1,1,310,0)
	6520
	6521	"PKG",49,2 2,1,"PAH", 1,1,311,0)
	6522	Post-Insta llation In structions :
	6523	"PKG",49,2 2,1,"PAH", 1,1,312,0)
	6524	---------- ---------- ---------- -
	6525	"PKG",49,2 2,1,"PAH", 1,1,313,0)
	6526	There are no special tasks to perform af ter this p atch insta llation.
	6527	"QUES","XP F1",0)
	6528	Y
	6529	"QUES","XP F1","??")
	6530	^D REP^XPD H
	6531	"QUES","XP F1","A")
	6532	Shall I wr ite over y our \|FLAG\| File
	6533	"QUES","XP F1","B")
	6534	YES
	6535	"QUES","XP F1","M")
	6536	D XPF1^XPD IQ
	6537	"QUES","XP F2",0)
	6538	Y
	6539	"QUES","XP F2","??")
	6540	^D DTA^XPD H
	6541	"QUES","XP F2","A")
	6542	Want my da ta \|FLAG\| yours
	6543	"QUES","XP F2","B")
	6544	YES
	6545	"QUES","XP F2","M")
	6546	D XPF2^XPD IQ
	6547	"QUES","XP I1",0)
	6548	YO
	6549	"QUES","XP I1","??")
	6550	^D INHIBIT ^XPDH
	6551	"QUES","XP I1","A")
	6552	Want KIDS to INHIBIT LOGONs du ring the i nstall
	6553	"QUES","XP I1","B")
	6554	NO
	6555	"QUES","XP I1","M")
	6556	D XPI1^XPD IQ
	6557	"QUES","XP M1",0)
	6558	PO^VA(200, :EM
	6559	"QUES","XP M1","??")
	6560	^D MG^XPDH
	6561	"QUES","XP M1","A")
	6562	Enter the Coordinato r for Mail Group '\|F LAG\|'
	6563	"QUES","XP M1","B")
	6564
	6565	"QUES","XP M1","M")
	6566	D XPM1^XPD IQ
	6567	"QUES","XP O1",0)
	6568	Y
	6569	"QUES","XP O1","??")
	6570	^D MENU^XP DH
	6571	"QUES","XP O1","A")
	6572	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	6573	"QUES","XP O1","B")
	6574	NO
	6575	"QUES","XP O1","M")
	6576	D XPO1^XPD IQ
	6577	"QUES","XP Z1",0)
	6578	Y
	6579	"QUES","XP Z1","??")
	6580	^D OPT^XPD H
	6581	"QUES","XP Z1","A")
	6582	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	6583	"QUES","XP Z1","B")
	6584	NO
	6585	"QUES","XP Z1","M")
	6586	D XPZ1^XPD IQ
	6587	"QUES","XP Z2",0)
	6588	Y
	6589	"QUES","XP Z2","??")
	6590	^D RTN^XPD H
	6591	"QUES","XP Z2","A")
	6592	Want to MO VE routine s to other CPUs
	6593	"QUES","XP Z2","B")
	6594	NO
	6595	"QUES","XP Z2","M")
	6596	D XPZ2^XPD IQ
	6597	"RTN")
	6598	10
	6599	"RTN","IBC BB11")
	6600	0^6^B10836 4963
	6601	"RTN","IBC BB11",1,0)
	6602	IBCBB11 ;A LB/AAS/OIF O-BP/PIJ - CONTINUAT ION OF EDI T CHECK RO UTINE ;12 Jun 2006 3:45 PM
	6603	"RTN","IBC BB11",2,0)
	6604	;;2.0;INT EGRATED BI LLING;51 ,343,363,3 71,395,392 ,401,384,4 00,436,432 ,516,568 ;21-MAR-94 ;Build 12
	6605	"RTN","IBC BB11",3,0)
	6606	;Per VA D irective 6 402, this routine sh ould not b e modified .
	6607	"RTN","IBC BB11",4,0)
	6608	;
	6609	"RTN","IBC BB11",5,0)
	6610	WARN(IBDIS P) ; Set w arning in global
	6611	"RTN","IBC BB11",6,0)
	6612	; DISP = warning te xt to disp lay
	6613	"RTN","IBC BB11",7,0)
	6614	;
	6615	"RTN","IBC BB11",8,0)
	6616	N Z
	6617	"RTN","IBC BB11",9,0)
	6618	S Z=+$O(^ TMP($J,"BI LL-WARN"," "),-1)
	6619	"RTN","IBC BB11",10,0 )
	6620	I Z=0 S ^ TMP($J,"BI LL-WARN",1 )=$J("",5) _"Warnin gs:",Z=1
	6621	"RTN","IBC BB11",11,0 )
	6622	S Z=Z+1,^ TMP($J,"BI LL-WARN",Z )=$J("",5) _IBDISP
	6623	"RTN","IBC BB11",12,0 )
	6624	Q
	6625	"RTN","IBC BB11",13,0 )
	6626	;
	6627	"RTN","IBC BB11",14,0 )
	6628	MULTDIV(IB IFN,IBND0) ; Check f or multipl e division s on a bil l ien IBIF N
	6629	"RTN","IBC BB11",15,0 )
	6630	; IBND0 = 0-node of bill
	6631	"RTN","IBC BB11",16,0 )
	6632	;
	6633	"RTN","IBC BB11",17,0 )
	6634	; Functi on returns 1 if more than 1 di vision fou nd on bill
	6635	"RTN","IBC BB11",18,0 )
	6636	N Z,Z0,Z1 ,MULT
	6637	"RTN","IBC BB11",19,0 )
	6638	S MULT=0, Z1=$P(IBND 0,U,22)
	6639	"RTN","IBC BB11",20,0 )
	6640	I Z1 D
	6641	"RTN","IBC BB11",21,0 )
	6642	. S Z=0 F S Z=$O(^ DGCR(399,I BIFN,"RC", Z)) Q:'Z S Z0=$P(^( Z,0),U,7) I Z0,Z0'=Z 1 S MULT=1 Q
	6643	"RTN","IBC BB11",22,0 )
	6644	. S Z=0 F S Z=$O(^ DGCR(399,I BIFN,"CP", Z)) Q:'Z S Z0=$P(^( Z,0),U,6) I Z0,Z0'=Z 1 S MULT=2 Q
	6645	"RTN","IBC BB11",23,0 )
	6646	I 'Z1 S M ULT=3
	6647	"RTN","IBC BB11",24,0 )
	6648	Q MULT
	6649	"RTN","IBC BB11",25,0 )
	6650	;
	6651	"RTN","IBC BB11",26,0 )
	6652	;; PREGNA NCY DX COD ES: V22- V24, V27 -V28, 630*-677 *
	6653	"RTN","IBC BB11",27,0 )
	6654	;; FLU SH OTS PROCED URE CODES: 90724, G0 008, 90732 , G0009
	6655	"RTN","IBC BB11",28,0 )
	6656	;
	6657	"RTN","IBC BB11",29,0 )
	6658	NPICHK ; C heck for r equired NP Is
	6659	"RTN","IBC BB11",30,0 )
	6660	N IBNPIS, IBNONPI,IB NPIREQ,Z,I BNFI,IBTF, IBWC,IBXSA VE,IBPRV,I BLINE,IBPR VNT1,IBPRV NT2
	6661	"RTN","IBC BB11",31,0 )
	6662	;*** pij start IB2 0436 ***
	6663	"RTN","IBC BB11",32,0 )
	6664	N IBRATYP E,IBLEGAL
	6665	"RTN","IBC BB11",33,0 )
	6666	S (IBRATY PE,IBLEGAL )=""
	6667	"RTN","IBC BB11",34,0 )
	6668	S IBRATYP E=$P($G(^D GCR(399,IB IFN,0)),U, 7)
	6669	"RTN","IBC BB11",35,0 )
	6670	; Legal t ypes for t his use.
	6671	"RTN","IBC BB11",36,0 )
	6672	; 7=NO F AULT INS.
	6673	"RTN","IBC BB11",37,0 )
	6674	; 10=TORT FEASOR
	6675	"RTN","IBC BB11",38,0 )
	6676	; 11=WORK ERS' COMP.
	6677	"RTN","IBC BB11",39,0 )
	6678	S IBNFI=$ O(^DGCR(39 9.3,"B","N O FAULT IN S.",0)) S: 'IBNFI IBN FI=7
	6679	"RTN","IBC BB11",40,0 )
	6680	S IBTF=$O (^DGCR(399 .3,"B","TO RT FEASOR" ,0)) S:'IB TF IBTF=10
	6681	"RTN","IBC BB11",41,0 )
	6682	S IBWC=$O (^DGCR(399 .3,"B","WO RKERS' COM P.",0)) S: 'IBWC IBWC =11
	6683	"RTN","IBC BB11",42,0 )
	6684	;
	6685	"RTN","IBC BB11",43,0 )
	6686	I IBRATYP E=IBNFI!(I BRATYPE=IB TF)!(IBRAT YPE=IBWC) D
	6687	"RTN","IBC BB11",44,0 )
	6688	. ; One o f the lega l types - force loca l print
	6689	"RTN","IBC BB11",45,0 )
	6690	. S IBLEG AL=1
	6691	"RTN","IBC BB11",46,0 )
	6692	;* pij end *
	6693	"RTN","IBC BB11",47,0 )
	6694	S IBNPIRE Q=$$NPIREQ ^IBCEP81(D T) ; Chec k if NPI i s required
	6695	"RTN","IBC BB11",48,0 )
	6696	; Check p roviders
	6697	"RTN","IBC BB11",49,0 )
	6698	; IB2.0 432 change d the NPI check to t he new Pro vider Arra y
	6699	"RTN","IBC BB11",50,0 )
	6700	;S IBNPIS =$$PROVNPI ^IBCEF73A( IBIFN,.IBN ONPI)
	6701	"RTN","IBC BB11",51,0 )
	6702	D ALLIDS^ IBCEFP(IBI FN,.IBXSAV E,1)
	6703	"RTN","IBC BB11",52,0 )
	6704	S IBPRV=" "
	6705	"RTN","IBC BB11",53,0 )
	6706	F S IBPR V=$O(IBXSA VE("PROVIN F",IBIFN," C",1,IBPRV )) Q:'IBPR V D
	6707	"RTN","IBC BB11",54,0 )
	6708	. I $P($G (IBXSAVE(" PROVINF",I BIFN,"C",1 ,IBPRV,0)) ,U,4)="" S IBNONPI(I BPRV)=""
	6709	"RTN","IBC BB11",55,0 )
	6710	S IBLINE= ""
	6711	"RTN","IBC BB11",56,0 )
	6712	F S IBLI NE=$O(IBXS AVE("L-PRO V",IBIFN,I BLINE)) Q: 'IBLINE D
	6713	"RTN","IBC BB11",57,0 )
	6714	. S IBPRV =""
	6715	"RTN","IBC BB11",58,0 )
	6716	. F S IB PRV=$O(IBX SAVE("L-PR OV",IBIFN, IBLINE,"C" ,1,IBPRV)) Q:IBPRV=" " D
	6717	"RTN","IBC BB11",59,0 )
	6718	.. I $P($ G(IBXSAVE( "L-PROV",I BIFN,IBLIN E,"C",1,IB PRV,0)),U, 4)="" S IB NONPI(IBPR V)=""
	6719	"RTN","IBC BB11",60,0 )
	6720	I $D(IBNO NPI) S IBP RV="" F S IBPRV=$O( IBNONPI(IB PRV)) Q:'I BPRV D
	6721	"RTN","IBC BB11",61,0 )
	6722	. S IBER= IBER_"IB"_ (140+IBPRV )_";" Q ; If requir ed, set er ror IB25 16
	6723	"RTN","IBC BB11",62,0 )
	6724	; Check o rganizatio ns
	6725	"RTN","IBC BB11",63,0 )
	6726	S IBNONPI =""
	6727	"RTN","IBC BB11",64,0 )
	6728	S IBNPIS= $$ORGNPI^I BCEF73A(IB IFN,.IBNON PI)
	6729	"RTN","IBC BB11",65,0 )
	6730	I $L(IBNO NPI) F Z=1 :1:$L(IBNO NPI,U) D
	6731	"RTN","IBC BB11",66,0 )
	6732	. S IBER= IBER_$P("I B339;^IB34 0;^IB341;" ,U,$P(IBNO NPI,U,Z)) ; DEM;432 Added NPI errors.
	6733	"RTN","IBC BB11",67,0 )
	6734	Q
	6735	"RTN","IBC BB11",68,0 )
	6736	;
	6737	"RTN","IBC BB11",69,0 )
	6738	TAXCHK ; C heck for r equired ta xonomies
	6739	"RTN","IBC BB11",70,0 )
	6740	N IBDT,IB LINE,IBNOT AX,IBNOTAX 1,IBNOTAX2 ,IBPRV,IBT AXS,IBXSAV E,Z
	6741	"RTN","IBC BB11",71,0 )
	6742	;
	6743	"RTN","IBC BB11",72,0 )
	6744	; MRD;IB* 2.0*516 - This check is now mo ot; 'today ' is alway s on or
	6745	"RTN","IBC BB11",73,0 )
	6746	; after M ay 23, 200 8, so taxo nomy codes are alway s required
	6747	"RTN","IBC BB11",74,0 )
	6748	; for cer tain provi ders.
	6749	"RTN","IBC BB11",75,0 )
	6750	;S IBTAXR EQ=$$TAXRE Q^IBCEP81( DT) ; Che ck if taxo nomy is re quired
	6751	"RTN","IBC BB11",76,0 )
	6752	;
	6753	"RTN","IBC BB11",77,0 )
	6754	; Check p roviders
	6755	"RTN","IBC BB11",78,0 )
	6756	; IB2.0 432 change d the Taxo nomy check to the ne w Provider Array
	6757	"RTN","IBC BB11",79,0 )
	6758	;S IBTAXS =$$PROVTAX ^IBCEF73A( IBIFN,.IBN OTAX)
	6759	"RTN","IBC BB11",80,0 )
	6760	D ALLIDS^ IBCEFP(IBI FN,.IBXSAV E,1)
	6761	"RTN","IBC BB11",81,0 )
	6762	S IBPRV=" "
	6763	"RTN","IBC BB11",82,0 )
	6764	F S IBPR V=$O(IBXSA VE("PROVIN F",IBIFN," C",1,IBPRV )) Q:'IBPR V D
	6765	"RTN","IBC BB11",83,0 )
	6766	. I $G(IB XSAVE("PRO VINF",IBIF N,"C",1,IB PRV,"TAXON OMY"))="" D
	6767	"RTN","IBC BB11",84,0 )
	6768	.. S IBNO TAX(IBPRV) =""
	6769	"RTN","IBC BB11",85,0 )
	6770	.. S IBNO TAX1=$P(IB XSAVE("PRO VINF",IBIF N,"C",1,IB PRV),";",1 ) ; New v ariables I BNOTAX1 an d IBNOTAX2 for IB2. 0568 - De activated Provider
	6771	"RTN","IBC BB11",86,0 )
	6772	.. S IBNO TAX2(IBPRV ,IBNOTAX1) =""
	6773	"RTN","IBC BB11",87,0 )
	6774	.. Q
	6775	"RTN","IBC BB11",88,0 )
	6776	. Q
	6777	"RTN","IBC BB11",89,0 )
	6778	;
	6779	"RTN","IBC BB11",90,0 )
	6780	S IBLINE= ""
	6781	"RTN","IBC BB11",91,0 )
	6782	F S IBLI NE=$O(IBXS AVE("L-PRO V",IBIFN,I BLINE)) Q: 'IBLINE D
	6783	"RTN","IBC BB11",92,0 )
	6784	. S IBPRV =""
	6785	"RTN","IBC BB11",93,0 )
	6786	. F S IB PRV=$O(IBX SAVE("L-PR OV",IBIFN, IBLINE,"C" ,1,IBPRV)) Q:IBPRV=" " D
	6787	"RTN","IBC BB11",94,0 )
	6788	.. I $G(I BXSAVE("L- PROV",IBIF N,IBLINE," C",1,IBPRV ,"TAXONOMY "))="" D
	6789	"RTN","IBC BB11",95,0 )
	6790	... S IBN OTAX(IBPRV )=""
	6791	"RTN","IBC BB11",96,0 )
	6792	... S IBN OTAX1=$P(I BXSAVE("L- PROV",IBIF N,IBLINE," C",1,IBPRV ),";",1) ; New vari ables IBNO TAX1 and I BNOTAX2 fo r IB2.05 68 - Deact ivated Pro vider
	6793	"RTN","IBC BB11",97,0 )
	6794	... S IBN OTAX2(IBPR V,IBNOTAX1 )=""
	6795	"RTN","IBC BB11",98,0 )
	6796	... Q
	6797	"RTN","IBC BB11",99,0 )
	6798	.. Q
	6799	"RTN","IBC BB11",100, 0)
	6800	. Q
	6801	"RTN","IBC BB11",101, 0)
	6802	;
	6803	"RTN","IBC BB11",102, 0)
	6804	; IB251 = Referring provider taxonomy m issing.
	6805	"RTN","IBC BB11",103, 0)
	6806	; IB253 = Rendering provider taxonomy m issing.
	6807	"RTN","IBC BB11",104, 0)
	6808	; IB254 = Attending provider taxonomy m issing.
	6809	"RTN","IBC BB11",105, 0)
	6810	;
	6811	"RTN","IBC BB11",106, 0)
	6812	I $D(IBNO TAX) S IBP RV="" F S IBPRV=$O( IBNOTAX(IB PRV)) Q:'I BPRV D
	6813	"RTN","IBC BB11",107, 0)
	6814	. ; Only Referring, Rendering and Atten ding are c urrently s ent to the payer
	6815	"RTN","IBC BB11",108, 0)
	6816	. ;I IBTA XREQ,"134" [IBPRV S I BER=IBER_" IB"_(250+I BPRV)_";" Q ; MRD;I B2.0516 - Always r equired.
	6817	"RTN","IBC BB11",109, 0)
	6818	. I "134" [IBPRV D Q
	6819	"RTN","IBC BB11",110, 0)
	6820	.. S IBER =IBER_"IB" _(250+IBPR V)_";" ; I f required , set erro r
	6821	"RTN","IBC BB11",111, 0)
	6822	.. S IBPR VNT1=$O(IB NOTAX2(IBP RV,"")) ; New check for Deacti vated Prov ider IB2. 0568 next three lin es
	6823	"RTN","IBC BB11",112, 0)
	6824	.. S IBPR VNT2=$$SPE C^IBCEU(IB PRVNT1,IBE VDT)
	6825	"RTN","IBC BB11",113, 0)
	6826	.. I '$G( IBPRVNT2) D WARN($P( "Referring ^Operating ^Rendering ^Attending ^Supervisi ng^^^^Othe r",U,IBPRV )_" Provid er PERSON CLASS/taxo nomy was n ot active at DOS.") ; set war ning
	6827	"RTN","IBC BB11",114, 0)
	6828	. D WARN( "Taxonomy for the "_ $P("referr ing^operat ing^render ing^attend ing^superv ising^^^^o ther",U,IB PRV)_" pro vider has no value") ; Else, set warnin g
	6829	"RTN","IBC BB11",115, 0)
	6830	. Q
	6831	"RTN","IBC BB11",116, 0)
	6832	;
	6833	"RTN","IBC BB11",117, 0)
	6834	; Check o rganizatio ns. The f unction OR GTAX will set IBNOTA X to be a
	6835	"RTN","IBC BB11",118, 0)
	6836	; list of entities missing ta xonomy cod es, if any (n, n^m, n^m^p,
	6837	"RTN","IBC BB11",119, 0)
	6838	; where e ach 1 is s ervice fac ility, 2 i s non-VA s ervice fac ility and
	6839	"RTN","IBC BB11",120, 0)
	6840	; 3 is bi lling prov ider.
	6841	"RTN","IBC BB11",121, 0)
	6842	;
	6843	"RTN","IBC BB11",122, 0)
	6844	S IBNOTAX =""
	6845	"RTN","IBC BB11",123, 0)
	6846	S IBTAXS= $$ORGTAX^I BCEF73A(IB IFN,.IBNOT AX)
	6847	"RTN","IBC BB11",124, 0)
	6848	I $L(IBNO TAX) F Z=1 :1:$L(IBNO TAX,U) D
	6849	"RTN","IBC BB11",125, 0)
	6850	. ; IB167 = Billing Provider taxonomy m issing.
	6851	"RTN","IBC BB11",126, 0)
	6852	. ;I IBTA XREQ,$P(IB NOTAX,U,Z) =3 S IBER= IBER_"IB16 7;" Q ; M RD;IB2.0 516 - Alwa ys require d.
	6853	"RTN","IBC BB11",127, 0)
	6854	. I $P(IB NOTAX,U,Z) =3 S IBER= IBER_"IB16 7;" Q
	6855	"RTN","IBC BB11",128, 0)
	6856	. ; MRD;I B2.0516 - Remove w arning mes sage for m issing tax onomy code for lab o r facility .
	6857	"RTN","IBC BB11",129, 0)
	6858	. ; D WAR N("Taxonom y for the "_$P("Serv ice Facili ty^Non-VA Service Fa cility^Bil ling Provi der",U,$P( IBNOTAX,U, Z))_" has no value") ; Else, set warnin g
	6859	"RTN","IBC BB11",130, 0)
	6860	. Q
	6861	"RTN","IBC BB11",131, 0)
	6862	;
	6863	"RTN","IBC BB11",132, 0)
	6864	Q
	6865	"RTN","IBC BB11",133, 0)
	6866	;
	6867	"RTN","IBC BB11",134, 0)
	6868	VALNDC(IBI FN,IBDFN) ; IB2363 - validat e NDC# bet ween PRESC RIPTION fi le (#52)
	6869	"RTN","IBC BB11",135, 0)
	6870	; and IB BILL/CLAIM S PRESCRIP TION REFIL L file (#3 62.4)
	6871	"RTN","IBC BB11",136, 0)
	6872	; input - IBIFN = i nternal en try number of the bi lling reco rd in the BILL/CLAIM S file (#3 99)
	6873	"RTN","IBC BB11",137, 0)
	6874	; IBDFN = i nternal en try number of patien t record i n the PATI ENT file ( #2)
	6875	"RTN","IBC BB11",138, 0)
	6876	N IBX,IBR XCOL
	6877	"RTN","IBC BB11",139, 0)
	6878	; call pr ogram that determine s if NDC d ifferences exist
	6879	"RTN","IBC BB11",140, 0)
	6880	D VALNDC^ IBEFUNC3(I BIFN,IBDFN ,.IBRXCOL)
	6881	"RTN","IBC BB11",141, 0)
	6882	Q:'$D(IBR XCOL)
	6883	"RTN","IBC BB11",142, 0)
	6884	; at leas t one RX o n the IB r ecord has an NDC dis crepancy
	6885	"RTN","IBC BB11",143, 0)
	6886	S IBX=0 F S IBX=$O (IBRXCOL(I BX)) Q:'IB X D WARN( "NDC# on B ill does n ot equal t he NDC# on Rx "_IBRX COL(IBX))
	6887	"RTN","IBC BB11",144, 0)
	6888	Q
	6889	"RTN","IBC BB11",145, 0)
	6890	;
	6891	"RTN","IBC BB11",146, 0)
	6892	PRIIDCHK ; Check for required Pimarary I D (SSN/EIN )
	6893	"RTN","IBC BB11",147, 0)
	6894	; If the provider i s on the c laim, he m ust have o ne
	6895	"RTN","IBC BB11",148, 0)
	6896	;
	6897	"RTN","IBC BB11",149, 0)
	6898	N IBI,IBZ
	6899	"RTN","IBC BB11",150, 0)
	6900	I $$TXMT^ IBCEF4(IBI FN) D
	6901	"RTN","IBC BB11",151, 0)
	6902	. D F^IBC EF("N-ALL ATT/REND P ROV SSN/EI ","IBZ",,I BIFN)
	6903	"RTN","IBC BB11",152, 0)
	6904	. S IBI=" " F S IBI =$O(^DGCR( 399,IBIFN, "PRV","B", IBI)) Q:IB I="" D
	6905	"RTN","IBC BB11",153, 0)
	6906	.. I $P(I BZ,U,IBI)= "" S IBER= IBER_$S(IB I=1:"IB151 ;",IBI=2:" IB152;",IB I=3!(IBI=4 ):"IB321;" ,IBI=5:"IB 153;",IBI= 9:"IB154;" ,1:"")
	6907	"RTN","IBC BB11",154, 0)
	6908	Q
	6909	"RTN","IBC BB11",155, 0)
	6910	;
	6911	"RTN","IBC BB11",156, 0)
	6912	RXNPI(IBIF N) ; check for multi ple pharma cy npi's o n the same bill
	6913	"RTN","IBC BB11",157, 0)
	6914	N IBORG,I BRXNPI,IBX ,IBY
	6915	"RTN","IBC BB11",158, 0)
	6916	S IBORG=$ $RXSITE^IB CEF73A(IBI FN,.IBORG)
	6917	"RTN","IBC BB11",159, 0)
	6918	S IBX=0 F S IBX=$O (IBORG(IBX )) Q:'IBX S IBY=0 F S IBY=$O (IBORG(IBX ,IBY)) Q:' IBY S IBR XNPI(+IBOR G(IBX,IBY) )=""
	6919	"RTN","IBC BB11",160, 0)
	6920	S (IBX,IB Y)=0 F S IBX=$O(IBR XNPI(IBX)) Q:'IBX S IBY=IBY+1
	6921	"RTN","IBC BB11",161, 0)
	6922	I IBY>1 D WARN("Bil l has pres criptions resulting from "_IBY _" differe nt NPI loc ations")
	6923	"RTN","IBC BB11",162, 0)
	6924	Q
	6925	"RTN","IBC BB11",163, 0)
	6926	;
	6927	"RTN","IBC BB11",164, 0)
	6928	ROICHK(IBI FN,IBDFN,I BINS) ; IB 2.0384 - check pre scriptions that cont ain the
	6929	"RTN","IBC BB11",165, 0)
	6930	; special handling code U aga inst the C laims Trac king ROI f ile (#356. 25)
	6931	"RTN","IBC BB11",166, 0)
	6932	; to see if an ROI is on file
	6933	"RTN","IBC BB11",167, 0)
	6934	; input - IBIFN = I EN of the Bill/Claim s file (#3 99)
	6935	"RTN","IBC BB11",168, 0)
	6936	; IBDFN = I EN of the patient
	6937	"RTN","IBC BB11",169, 0)
	6938	; IBINS = I EN of the payer insu rance comp any (#36)
	6939	"RTN","IBC BB11",170, 0)
	6940	; OUTPUT - 0 = no e rror
	6941	"RTN","IBC BB11",171, 0)
	6942	; 1 = a pr escription is sensit ive and th ere is no ROI on fil e
	6943	"RTN","IBC BB11",172, 0)
	6944	;
	6945	"RTN","IBC BB11",173, 0)
	6946	N IBX,IBY 0,IBRXIEN, IBDT,IBDRU G,ROIQ
	6947	"RTN","IBC BB11",174, 0)
	6948	S ROIQ=0
	6949	"RTN","IBC BB11",175, 0)
	6950	S IBX=0 F S IBX=$O (^IBA(362. 4,"C",IBIF N,IBX)) Q: 'IBX D
	6951	"RTN","IBC BB11",176, 0)
	6952	.S IBY0=^ IBA(362.4, IBX,0),IBR XIEN=$P(IB Y0,U,5) I 'IBRXIEN Q
	6953	"RTN","IBC BB11",177, 0)
	6954	.S IBDT=$ P(IBY0,U,3 ),IBDRUG=$ P(IBY0,U,4 )
	6955	"RTN","IBC BB11",178, 0)
	6956	.D ZERO^I BRXUTL(IBD RUG)
	6957	"RTN","IBC BB11",179, 0)
	6958	.I ^TMP($ J,"IBDRUG" ,IBDRUG,3) ["U" D
	6959	"RTN","IBC BB11",180, 0)
	6960	.. I $$RO I^IBNCPDR4 (IBDFN,IBD RUG,IBINS, IBDT) Q ; ROI is on file
	6961	"RTN","IBC BB11",181, 0)
	6962	.. D WARN ("ROI not on file fo r prescrip tion "_$$R XAPI1^IBNC PUT1(IBRXI EN,.01,"E" ))
	6963	"RTN","IBC BB11",182, 0)
	6964	.. S ROIQ =1
	6965	"RTN","IBC BB11",183, 0)
	6966	ROICHKQ ;
	6967	"RTN","IBC BB11",184, 0)
	6968	K ^TMP($J ,"IBDRUG")
	6969	"RTN","IBC BB11",185, 0)
	6970	Q ROIQ
	6971	"RTN","IBC BB11",186, 0)
	6972	;
	6973	"RTN","IBC BB11",187, 0)
	6974	AMBCK(IBIF N) ; IB 2.0432 - if ambula nce locati on defined , address must be de fined
	6975	"RTN","IBC BB11",188, 0)
	6976	; if ther e is anyth ing entere d in any o f the addr ess fields (either p /up or dro p/off fiel ds), than there need s to be:
	6977	"RTN","IBC BB11",189, 0)
	6978	; Address 1, State and ZIP un less the S tate is no t a US sta te or poss ession, th en zip cod e is not n eeded (CMS 1500 only)
	6979	"RTN","IBC BB11",190, 0)
	6980	; input - IBIFN = I EN of the Bill/Claim s file (#3 99)
	6981	"RTN","IBC BB11",191, 0)
	6982	; OUTPUT - 0 = no e rror
	6983	"RTN","IBC BB11",192, 0)
	6984	; 1 = Erro r
	6985	"RTN","IBC BB11",193, 0)
	6986	;
	6987	"RTN","IBC BB11",194, 0)
	6988	N IBPAMB, IBDAMB,IBA MBR,IBCK
	6989	"RTN","IBC BB11",195, 0)
	6990	S IBAMBR= 0
	6991	"RTN","IBC BB11",196, 0)
	6992	Q:$$INSPR F^IBCEF(IB IFN)'=0 IB AMBR
	6993	"RTN","IBC BB11",197, 0)
	6994	S IBPAMB= $G(^DGCR(3 99,IBIFN," U5")),IBDA MB=$G(^DGC R(399,IBIF N,"U6"))
	6995	"RTN","IBC BB11",198, 0)
	6996	S IBCK(5) =$$NOPUNCT ^IBCEF($P( IBPAMB,U,2 ,6),1),IBC K(6)=$$NOP UNCT^IBCEF ($P(IBDAMB ,U,1,6),1)
	6997	"RTN","IBC BB11",199, 0)
	6998	I IBCK(5) ="",IBCK(6 )="" Q IBA MBR
	6999	"RTN","IBC BB11",200, 0)
	7000	; at this point we know that at least o ne ambulan ce field h as data, s o check to see if al l have dat a
	7001	"RTN","IBC BB11",201, 0)
	7002	I IBCK(5) '="" F I=2 ,4,5 I $P( IBPAMB,U,I )="" S IBA MBR=1
	7003	"RTN","IBC BB11",202, 0)
	7004	I IBCK(6) '="" F I=1 ,2,4,5 I $ P(IBDAMB,U ,I)="" S I BAMBR=1
	7005	"RTN","IBC BB11",203, 0)
	7006	Q:IBAMBR= 1 IBAMBR
	7007	"RTN","IBC BB11",204, 0)
	7008	; now che ck zip cod e. OK to be null if state is not a US P osession
	7009	"RTN","IBC BB11",205, 0)
	7010	F I="IBPA MB","IBDAM B" I $P(I, U,5)'="",$ P($G(^DIC( 5,$P(I,U,5 ),0)),U,6) =1,$P(I,U, 6)="" S IB AMBR=1
	7011	"RTN","IBC BB11",206, 0)
	7012	Q IBAMBR
	7013	"RTN","IBC BB11",207, 0)
	7014	;
	7015	"RTN","IBC BB11",208, 0)
	7016	COBAMT(IBI FN) ; IB 2.0432 - IF there is a COB a mt. it mus t equal th e Total Cl aim Charge Amount
	7017	"RTN","IBC BB11",209, 0)
	7018	; input - IBIFN = I EN of the Bill/Claim s file (#3 99)
	7019	"RTN","IBC BB11",210, 0)
	7020	; OUTPUT - 0 = no e rror
	7021	"RTN","IBC BB11",211, 0)
	7022	; 1 = Erro r
	7023	"RTN","IBC BB11",212, 0)
	7024	;
	7025	"RTN","IBC BB11",213, 0)
	7026	Q:IBIFN=" " 0
	7027	"RTN","IBC BB11",214, 0)
	7028	Q:$P($G(^ DGCR(399,I BIFN,"U4") ),U)="" 0
	7029	"RTN","IBC BB11",215, 0)
	7030	Q:+$P($G( ^DGCR(399, IBIFN,"U1" )),U)'=+$P ($G(^DGCR( 399,IBIFN, "U4")),U) 1
	7031	"RTN","IBC BB11",216, 0)
	7032	Q 0
	7033	"RTN","IBC BB11",217, 0)
	7034	;
	7035	"RTN","IBC BB11",218, 0)
	7036	COBMRA(IBI FN) ; IB 2.0432 - If there is a 'COB total non- covered am ount' (Fil e#399, Fie ld#260),
	7037	"RTN","IBC BB11",219, 0)
	7038	; Primary Insurance must be M edicare th at never w ent to Med icare, and this must be a 2nda ry or tert iary claim
	7039	"RTN","IBC BB11",220, 0)
	7040	; input - IBIFN = I EN of the Bill/Claim s file (#3 99)
	7041	"RTN","IBC BB11",221, 0)
	7042	; OUTPUT - 0 = no e rror
	7043	"RTN","IBC BB11",222, 0)
	7044	; 1 = Erro r
	7045	"RTN","IBC BB11",223, 0)
	7046	;
	7047	"RTN","IBC BB11",224, 0)
	7048	N IBP
	7049	"RTN","IBC BB11",225, 0)
	7050	Q:IBIFN=" " 0
	7051	"RTN","IBC BB11",226, 0)
	7052	Q:$P($G(^ DGCR(399,I BIFN,"U4") ),U)="" 0
	7053	"RTN","IBC BB11",227, 0)
	7054	S IBP=$P( $G(^DGCR(3 99,IBIFN," M1")),U,5) S:IBP="" IBP=IBIFN
	7055	"RTN","IBC BB11",228, 0)
	7056	I $$WNRBI LL^IBEFUNC (IBIFN,1), $P($G(^DGC R(399,IBP, "S")),U,7) ="",$$COBN ^IBCEF(IBI FN)>1 Q 0
	7057	"RTN","IBC BB11",229, 0)
	7058	Q 1
	7059	"RTN","IBC BB11",230, 0)
	7060	;
	7061	"RTN","IBC BB11",231, 0)
	7062	COBSEC(IBI FN) ; IB 2.0432 - If there is NOT a ' COB total non-covere d amount' (File#399, Field#260 ),
	7063	"RTN","IBC BB11",232, 0)
	7064	; and Pri mary Insur ance is Me dicare tha t never we nt to Medi care, 2nda ry or tert iary claim cannot be set to tr ansmit
	7065	"RTN","IBC BB11",233, 0)
	7066	; input - IBIFN = I EN of the Bill/Claim s file (#3 99)
	7067	"RTN","IBC BB11",234, 0)
	7068	; OUTPUT - 0 = no e rror
	7069	"RTN","IBC BB11",235, 0)
	7070	; 1 = Erro r
	7071	"RTN","IBC BB11",236, 0)
	7072	;
	7073	"RTN","IBC BB11",237, 0)
	7074	N IBP
	7075	"RTN","IBC BB11",238, 0)
	7076	Q:IBIFN=" " 0
	7077	"RTN","IBC BB11",239, 0)
	7078	Q:$P($G(^ DGCR(399,I BIFN,"U4") ),U)'="" 0
	7079	"RTN","IBC BB11",240, 0)
	7080	Q:$$COBN^ IBCEF(IBIF N)<2 0
	7081	"RTN","IBC BB11",241, 0)
	7082	S IBP=$P( $G(^DGCR(3 99,IBIFN," M1")),U,5) S:IBP="" IBP=IBIFN
	7083	"RTN","IBC BB11",242, 0)
	7084	I $$WNRBI LL^IBEFUNC (IBIFN,1), $P($G(^DGC R(399,IBP, "S")),U,7) ="",$P($G( ^DGCR(399, IBIFN,"TX" )),U,8)'=1 Q 1
	7085	"RTN","IBC BB11",243, 0)
	7086	Q 0
	7087	"RTN","IBC BB11",244, 0)
	7088	;
	7089	"RTN","IBC BB11",245, 0)
	7090	TMCK(IBIFN ) ; IB2. 0432 - At tachment C ontrol Num ber - REQU IRED when Transmissi on Method = BM, EL, EM, or FT
	7091	"RTN","IBC BB11",246, 0)
	7092	; input - IBIFN = I EN of the Bill/Claim s file (#3 99)
	7093	"RTN","IBC BB11",247, 0)
	7094	; OUTPUT - 0 = no e rror
	7095	"RTN","IBC BB11",248, 0)
	7096	; 1 = Erro r
	7097	"RTN","IBC BB11",249, 0)
	7098	;
	7099	"RTN","IBC BB11",250, 0)
	7100	N IBAC
	7101	"RTN","IBC BB11",251, 0)
	7102	Q:IBIFN=" " 0
	7103	"RTN","IBC BB11",252, 0)
	7104	F I=1,3 S IBAC(I)=$ P($G(^DGCR (399,IBIFN ,"U8")),U, I)
	7105	"RTN","IBC BB11",253, 0)
	7106	Q:IBAC(3) ="" 0
	7107	"RTN","IBC BB11",254, 0)
	7108	Q:IBAC(1) '="" 0
	7109	"RTN","IBC BB11",255, 0)
	7110	Q:IBAC(3) ="AA" 0
	7111	"RTN","IBC BB11",256, 0)
	7112	Q 1
	7113	"RTN","IBC BB11",257, 0)
	7114	;
	7115	"RTN","IBC BB11",258, 0)
	7116	ACCK(IBIFN ) ; IB2.0 432 If an y of the l oop info i s present, then Repo rt Type & Transmissi on Method req'd
	7117	"RTN","IBC BB11",259, 0)
	7118	; input - IBIFN = I EN of the Bill/Claim s file (#3 99)
	7119	"RTN","IBC BB11",260, 0)
	7120	; OUTPUT - 0 = no e rror
	7121	"RTN","IBC BB11",261, 0)
	7122	; 1 = Erro r
	7123	"RTN","IBC BB11",262, 0)
	7124	;
	7125	"RTN","IBC BB11",263, 0)
	7126	N IBAC
	7127	"RTN","IBC BB11",264, 0)
	7128	Q:IBIFN=" " 0
	7129	"RTN","IBC BB11",265, 0)
	7130	F I=1:1:3 S IBAC(I) =$P($G(^DG CR(399,IBI FN,"U8")), U,I)
	7131	"RTN","IBC BB11",266, 0)
	7132	; All fie lds null, no error
	7133	"RTN","IBC BB11",267, 0)
	7134	I IBAC(1) ="",IBAC(2 )="",IBAC( 3)="" Q 0
	7135	"RTN","IBC BB11",268, 0)
	7136	; Both re quired fie lds comple te, no err or
	7137	"RTN","IBC BB11",269, 0)
	7138	I IBAC(2) '="",IBAC( 3)'="" Q 0
	7139	"RTN","IBC BB11",270, 0)
	7140	; At this point, on e of the 2 required fields has data and one does n ot, so err or
	7141	"RTN","IBC BB11",271, 0)
	7142	Q 1
	7143	"RTN","IBC BB11",272, 0)
	7144	;
	7145	"RTN","IBC BB11",273, 0)
	7146	LNTMCK(IBI FN) ; DEM ;IB2.043 2 - (Line Level) Att achment Co ntrol Numb er - REQUI RED when T ransmissio n Method = BM, EL, E M, or FT
	7147	"RTN","IBC BB11",274, 0)
	7148	; input - IBIFN = I EN of the Bill/Claim s file (#3 99)
	7149	"RTN","IBC BB11",275, 0)
	7150	; OUTPUT - IBLNERR = 0 = no e rror
	7151	"RTN","IBC BB11",276, 0)
	7152	; IBLNERR = 1 = Erro r
	7153	"RTN","IBC BB11",277, 0)
	7154	;
	7155	"RTN","IBC BB11",278, 0)
	7156	N IBAC,IB PROCP,I,IB LNERR
	7157	"RTN","IBC BB11",279, 0)
	7158	S IBLNERR =0 ; DEM; 432 - Init ialize err or flag IB LNERR to ' 0' for no errors.
	7159	"RTN","IBC BB11",280, 0)
	7160	Q:IBIFN=" " IBLNERR
	7161	"RTN","IBC BB11",281, 0)
	7162	S IBPROCP =0 F S IB PROCP=$O(^ DGCR(399,I BIFN,"CP", IBPROCP)) Q:'IBPROCP D Q:IBL NERR
	7163	"RTN","IBC BB11",282, 0)
	7164	. Q:'($D( ^DGCR(399, IBIFN,"CP" ,IBPROCP,0 ))#10) ; DEM;432 - Node '0' i s procedur e node.
	7165	"RTN","IBC BB11",283, 0)
	7166	. Q:'($D( ^DGCR(399, IBIFN,"CP" ,IBPROCP,1 ))#10) ; DEM;432 - Node '1' i s line lev el Attachm ent Contro l fields.
	7167	"RTN","IBC BB11",284, 0)
	7168	. F I=1,3 S IBAC(I) =$P(^DGCR( 399,IBIFN, "CP",IBPRO CP,1),U,I)
	7169	"RTN","IBC BB11",285, 0)
	7170	. I IBAC( 3)="" S IB LNERR=0 Q
	7171	"RTN","IBC BB11",286, 0)
	7172	. I IBAC( 1)'="" S I BLNERR=0 Q
	7173	"RTN","IBC BB11",287, 0)
	7174	. I (IBAC (3)="AA") S IBLNERR= 0 Q
	7175	"RTN","IBC BB11",288, 0)
	7176	. S IBLNE RR=1
	7177	"RTN","IBC BB11",289, 0)
	7178	. Q
	7179	"RTN","IBC BB11",290, 0)
	7180	;
	7181	"RTN","IBC BB11",291, 0)
	7182	Q IBLNERR
	7183	"RTN","IBC BB11",292, 0)
	7184	;
	7185	"RTN","IBC BB11",293, 0)
	7186	LNACCK(IBI FN) ; DEM; IB2.0432 (Line Lev el) If any of the lo op info is present, then Repor t Type & T ransmissio n Method r eq'd
	7187	"RTN","IBC BB11",294, 0)
	7188	; input - IBIFN = I EN of the Bill/Claim s file (#3 99)
	7189	"RTN","IBC BB11",295, 0)
	7190	; OUTPUT - IBLNERR = 0 = no e rror
	7191	"RTN","IBC BB11",296, 0)
	7192	; IBLNERR = 1 = Erro r
	7193	"RTN","IBC BB11",297, 0)
	7194	;
	7195	"RTN","IBC BB11",298, 0)
	7196	N IBAC,IB PROCP,I,IB LNERR
	7197	"RTN","IBC BB11",299, 0)
	7198	S IBLNERR =0 ; DEM; 432 - Init ialize err or flag IB LNERR to ' 0' for no errors.
	7199	"RTN","IBC BB11",300, 0)
	7200	Q:IBIFN=" " IBLNERR
	7201	"RTN","IBC BB11",301, 0)
	7202	S IBPROCP =0 F S IB PROCP=$O(^ DGCR(399,I BIFN,"CP", IBPROCP)) Q:'IBPROCP D Q:IBL NERR
	7203	"RTN","IBC BB11",302, 0)
	7204	. Q:'($D( ^DGCR(399, IBIFN,"CP" ,IBPROCP,0 ))#10) ; DEM;432 - Node '0' i s procedur e node.
	7205	"RTN","IBC BB11",303, 0)
	7206	. Q:'($D( ^DGCR(399, IBIFN,"CP" ,IBPROCP,1 ))#10) ; DEM;432 - Node '1' i s line lev el Attachm ent Contro l fields.
	7207	"RTN","IBC BB11",304, 0)
	7208	. F I=1:1 :3 S IBAC( I)=$P(^DGC R(399,IBIF N,"CP",IBP ROCP,1),U, I)
	7209	"RTN","IBC BB11",305, 0)
	7210	. ; All f ields null , no error
	7211	"RTN","IBC BB11",306, 0)
	7212	. I IBAC( 1)="",IBAC (2)="",IBA C(3)="" S IBLNERR=0 Q
	7213	"RTN","IBC BB11",307, 0)
	7214	. ; Both required f ields comp lete, no e rror
	7215	"RTN","IBC BB11",308, 0)
	7216	. I IBAC( 2)'="",IBA C(3)'="" S IBLNERR=0 Q
	7217	"RTN","IBC BB11",309, 0)
	7218	. ; At th is point, one of the 2 require d fields h as data an d one does not, so e rror
	7219	"RTN","IBC BB11",310, 0)
	7220	. S IBLNE RR=1
	7221	"RTN","IBC BB11",311, 0)
	7222	. Q
	7223	"RTN","IBC BB11",312, 0)
	7224	;
	7225	"RTN","IBC BB11",313, 0)
	7226	Q IBLNERR
	7227	"RTN","IBJ DB21")
	7228	0^1^B12749 6258
	7229	"RTN","IBJ DB21",1,0)
	7230	IBJDB21 ;A LB/RB - RE ASONS NOT BILLABLE R EPORT (COM PILE) ;19- JUN-00
	7231	"RTN","IBJ DB21",2,0)
	7232	;;2.0;INT EGRATED BI LLING;12 3,159,185, 399,437,45 8,568;21 -MAR-94;Bu ild 12
	7233	"RTN","IBJ DB21",3,0)
	7234	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7235	"RTN","IBJ DB21",4,0)
	7236	;;
	7237	"RTN","IBJ DB21",5,0)
	7238	EN ; - Ent ry point f rom IBJDB2 .
	7239	"RTN","IBJ DB21",6,0)
	7240	K ^TMP("I BJDB2",$J) ,IB,IBE,EN CTYP,EPIEN ,IBADMDT,R ELBILL
	7241	"RTN","IBJ DB21",7,0)
	7242	I '$G(IBX TRACT) D
	7243	"RTN","IBJ DB21",8,0)
	7244	. F X=1:1 :4 I IBSEL [X S IBE(X )=IBEPS(X) ; Set epi sodes for report.
	7245	"RTN","IBJ DB21",9,0)
	7246	;
	7247	"RTN","IBJ DB21",10,0 )
	7248	; - Print the heade r line for the Excel spreadshe et
	7249	"RTN","IBJ DB21",11,0 )
	7250	I $G(IBEX CEL) D PHD L
	7251	"RTN","IBJ DB21",12,0 )
	7252	;
	7253	"RTN","IBJ DB21",13,0 )
	7254	; - Compi le reason not billab le (RNB) d ata for ep isode.
	7255	"RTN","IBJ DB21",14,0 )
	7256	S IBRNB=0 F S IBRN B=$S(IBSRN B'="A":$O( IBSRNB(IBR NB)),1:$O( ^IBE(356.8 ,IBRNB))) Q:'IBRNB D
	7257	"RTN","IBJ DB21",15,0 )
	7258	.S IB0=0 F S IB0=$ O(^IBT(356 ,"AR",IBRN B,IB0)) Q: 'IB0 D
	7259	"RTN","IBJ DB21",16,0 )
	7260	..S IBN0= $G(^IBT(35 6,IB0,0)), IBN1=$G(^I BT(356,IB0 ,1)) Q:'IB N0!('IBN1)
	7261	"RTN","IBJ DB21",17,0 )
	7262	..S IBEP= +$P(IBN0,U ,18) I IBS EL'[IBEP Q ; Get ep isode.
	7263	"RTN","IBJ DB21",18,0 )
	7264	..S (IBRN B1,IBSORT1 )=$P($G(^I BE(356.8,I BRNB,0)),U )
	7265	"RTN","IBJ DB21",19,0 )
	7266	..;
	7267	"RTN","IBJ DB21",20,0 )
	7268	..; - Get valid dat e entered/ episode da te and amo unt for re port.
	7269	"RTN","IBJ DB21",21,0 )
	7270	..S IBEPD =+$P(IBN0, U,6)\1,IBD EN=+IBN1\1
	7271	"RTN","IBJ DB21",22,0 )
	7272	..S IBDT= $S($E(IBD) ="D":IBDEN ,1:IBEPD)
	7273	"RTN","IBJ DB21",23,0 )
	7274	..Q:IBDT< IBBDT!(IBD T>IBEDT)
	7275	"RTN","IBJ DB21",24,0 )
	7276	..S IBAMT =$$AMOUNT( IBEP,IB0)
	7277	"RTN","IBJ DB21",25,0 )
	7278	..I IBAMT <0 Q ;Qui t if amoun t is -1 *5 68
	7279	"RTN","IBJ DB21",26,0 )
	7280	..;
	7281	"RTN","IBJ DB21",27,0 )
	7282	..; - Get division, if necess ary.
	7283	"RTN","IBJ DB21",28,0 )
	7284	..I IBSD D Q:'VAUT D&('$D(VAU TD(IBDIV)) )
	7285	"RTN","IBJ DB21",29,0 )
	7286	...S IBDI V=$$DIV^IB JD1(IB0)
	7287	"RTN","IBJ DB21",30,0 )
	7288	..E S IB DIV=$S($G( IBEXCEL):+ $$PRIM^VAS ITE(),1:0)
	7289	"RTN","IBJ DB21",31,0 )
	7290	..;
	7291	"RTN","IBJ DB21",32,0 )
	7292	..; - Pro vider & Sp ecialty
	7293	"RTN","IBJ DB21",33,0 )
	7294	..S (IBPR V,IBSPC)=" ",IBQT=0
	7295	"RTN","IBJ DB21",34,0 )
	7296	..I IBEP= 1!(IBEP=2) D I IBQT Q
	7297	"RTN","IBJ DB21",35,0 )
	7298	...S IBPR SP=$$PRVSP C(IBEP,IB0 )
	7299	"RTN","IBJ DB21",36,0 )
	7300	...I IBSP RV'="A",'$ D(IBSPRV(+ IBPRSP)) S IBQT=1 Q
	7301	"RTN","IBJ DB21",37,0 )
	7302	...I IBEP =1,IBSISP' ="A",'$D(I BSISP(+$P( IBPRSP,U,3 ))) S IBQT =1 Q
	7303	"RTN","IBJ DB21",38,0 )
	7304	...I IBEP =2,IBSOSP' ="A",'$D(I BSOSP(+$P( IBPRSP,U,3 ))) S IBQT =1 Q
	7305	"RTN","IBJ DB21",39,0 )
	7306	...S IBPR V=$S($P(IB PRSP,U,2)' ="":$P(IBP RSP,U,2),1 :" UNKNO WN ")
	7307	"RTN","IBJ DB21",40,0 )
	7308	...S IBSP C=$S($P(IB PRSP,U,4)' ="":$P(IBP RSP,U,4),1 :" UNKNO WN ")
	7309	"RTN","IBJ DB21",41,0 )
	7310	..;
	7311	"RTN","IBJ DB21",42,0 )
	7312	..; - Get remaining data for detailed r eport.
	7313	"RTN","IBJ DB21",43,0 )
	7314	..S DFN=+ $P(IBN0,U, 2)
	7315	"RTN","IBJ DB21",44,0 )
	7316	..D DEM^V ADPT S IBP T=$E(VADM( 1),1,25),I BSSN=$P(VA DM(2),U)
	7317	"RTN","IBJ DB21",45,0 )
	7318	..S DIC=" ^VA(200,", DA=+$P(IBN 1,U,4),DR= ".01",DIQ= "IBCLK" D EN^DIQ1
	7319	"RTN","IBJ DB21",46,0 )
	7320	..S IBCLK =$E($G(IBC LK(200,DA, .01)),1,20 )
	7321	"RTN","IBJ DB21",47,0 )
	7322	..I ($P(I BN0,U,18)= 2)&($$EXTE RNAL^DILFD (356,.19," ",$P(IBN0, U,19))["72 HOUR RULE ") D
	7323	"RTN","IBJ DB21",48,0 )
	7324	...S IBAD MDT=$$ADMD T^IBTUTL5( DFN,$P(IBN 0,U,6))
	7325	"RTN","IBJ DB21",49,0 )
	7326	..E S IB ADMDT=""
	7327	"RTN","IBJ DB21",50,0 )
	7328	..S ENCTY P=$P(^IBE( 356.6,$P(I BN0,U,18), 0),U,3) S EPDT=$E($P (IBN0,U,6) ,1,7)
	7329	"RTN","IBJ DB21",51,0 )
	7330	..S EPIEN =$S(ENCTYP =3:$P(IBN0 ,U,8),ENCT YP=4:$P(IB N0,U,9),1: "")
	7331	"RTN","IBJ DB21",52,0 )
	7332	..S RELBI LL=$$RELBI L^IBTUTL5( EPIEN,EPDT ,DFN,ENCTY P)
	7333	"RTN","IBJ DB21",53,0 )
	7334	..;
	7335	"RTN","IBJ DB21",54,0 )
	7336	..; - Get totals fo r summary.
	7337	"RTN","IBJ DB21",55,0 )
	7338	..I '$D(I B(IBDIV,IB EP,IBRNB)) S IB(IBDI V,IBEP,IBR NB)="0^0"
	7339	"RTN","IBJ DB21",56,0 )
	7340	..S $P(IB (IBDIV,IBE P,IBRNB),U )=$P(IB(IB DIV,IBEP,I BRNB),U)+1
	7341	"RTN","IBJ DB21",57,0 )
	7342	..S $P(IB (IBDIV,IBE P,IBRNB),U ,2)=$P(IB( IBDIV,IBEP ,IBRNB),U, 2)+IBAMT
	7343	"RTN","IBJ DB21",58,0 )
	7344	..I IBRPT ="S" Q
	7345	"RTN","IBJ DB21",59,0 )
	7346	..;
	7347	"RTN","IBJ DB21",60,0 )
	7348	..S IBSOR T1=$S(IBSO RT="P":IBP RV,IBSORT= "S":IBSPC, 1:IBSORT1)
	7349	"RTN","IBJ DB21",61,0 )
	7350	..S:IBSOR T1="" IBSO RT1=" "
	7351	"RTN","IBJ DB21",62,0 )
	7352	..;
	7353	"RTN","IBJ DB21",63,0 )
	7354	..I $G(IB EXCEL) D Q
	7355	"RTN","IBJ DB21",64,0 )
	7356	...W !,$E ($P($G(^DG (40.8,IBDI V,0)),U),1 ,25),U
	7357	"RTN","IBJ DB21",65,0 )
	7358	...W $S(I BEP<4:$E(I BE(IBEP)), 1:"H"),U,I BPT,U,$E(I BSSN,6,10) ,U
	7359	"RTN","IBJ DB21",66,0 )
	7360	...W $E($ $INS^IBJD1 (+$P(IBN0, U,2),IBEPD ),1,25),U
	7361	"RTN","IBJ DB21",67,0 )
	7362	...W $$DT ^IBJD(IBEP D,1),U,$$D T^IBJD(IBD EN,1),U
	7363	"RTN","IBJ DB21",68,0 )
	7364	...W $$DT ^IBJD($P(I BN1,U,3),1 ),U,IBCLK, U,IBADMDT, U,$E(IBRNB 1,1,25),U
	7365	"RTN","IBJ DB21",69,0 )
	7366	...W $E(I BPRV,1,25) ,U,$E(IBSP C,1,25),U, IBAMT,U
	7367	"RTN","IBJ DB21",70,0 )
	7368	...I RELB ILL>0 F X= 2:1:$P(REL BILL,";",1 )+1 W $P(R ELBILL,";" ,X)_" "
	7369	"RTN","IBJ DB21",71,0 )
	7370	...I RELB ILL<0 W ""
	7371	"RTN","IBJ DB21",72,0 )
	7372	...W U,$P (IBN1,U,8)
	7373	"RTN","IBJ DB21",73,0 )
	7374	..;
	7375	"RTN","IBJ DB21",74,0 )
	7376	..S X=IBE PD_U_IBDEN _U_$P(IBN1 ,U,3)_U_IB CLK_U_IBRN B1
	7377	"RTN","IBJ DB21",75,0 )
	7378	..S X=X_U _IBPRV_U_I BSPC_U_IBA MT_U_$E($P (IBN1,U,8) ,1,50)_U_I BADMDT_U_R ELBILL
	7379	"RTN","IBJ DB21",76,0 )
	7380	..S ^TMP( "IBJDB2",$ J,IBDIV,IB EP,IBSORT1 ,IBPT_"@@" _$E(IBSSN, 6,10))=$$I NS^IBJD1(+ $P(IBN0,U, 2),IBEPD)
	7381	"RTN","IBJ DB21",77,0 )
	7382	..S ^TMP( "IBJDB2",$ J,IBDIV,IB EP,IBSORT1 ,IBPT_"@@" _$E(IBSSN, 6,10),+IBN 0)=X
	7383	"RTN","IBJ DB21",78,0 )
	7384	;
	7385	"RTN","IBJ DB21",79,0 )
	7386	I '$G(IBE XCEL) D EN ^IBJDB22 ; Print rep ort(s).
	7387	"RTN","IBJ DB21",80,0 )
	7388	;
	7389	"RTN","IBJ DB21",81,0 )
	7390	ENQ K ^TMP ("IBJDB2")
	7391	"RTN","IBJ DB21",82,0 )
	7392	K DA,DIC, DIQ,DR,IB, IB0,IBAMT, IBCLK,IBDE N,IBDIV,IB DT,IBE,IBE P,IBEPD,IB I
	7393	"RTN","IBJ DB21",83,0 )
	7394	K IBN0,IB N1,IBN2,IB PRSP,IBPRV ,IBPT,IBQT ,IBRNB,IBR NB1,IBSORT 1,IBSPC
	7395	"RTN","IBJ DB21",84,0 )
	7396	K IBSSN,V ADM,X1,X2
	7397	"RTN","IBJ DB21",85,0 )
	7398	Q
	7399	"RTN","IBJ DB21",86,0 )
	7400	;
	7401	"RTN","IBJ DB21",87,0 )
	7402	AMOUNT(EPS ,CLM) ; Re turn the A mount not billed
	7403	"RTN","IBJ DB21",88,0 )
	7404	; Input: EPS - Epis ode(1=Inpa tient,2=Ou tpatient,3 =Prosthet. ,4=Prescr. )
	7405	"RTN","IBJ DB21",89,0 )
	7406	; CLM - Poin ter to Cla im Trackin g File (#3 56)
	7407	"RTN","IBJ DB21",90,0 )
	7408	;Output: AMOUNT not billed
	7409	"RTN","IBJ DB21",91,0 )
	7410	;
	7411	"RTN","IBJ DB21",92,0 )
	7412	N ADM,ADM DT,AMOUNT, BLBS,BLDT, CPT,CPTLST ,DA,DR,DCH D,DFN,DIC, DIQ,DIV,DR G,SPCLTY
	7413	"RTN","IBJ DB21",93,0 )
	7414	N IBRX,EN C,ENCDT,EP DT,PFT,PRS T,PTF,RIMB ,VCPT,TTCS T,X
	7415	"RTN","IBJ DB21",94,0 )
	7416	;
	7417	"RTN","IBJ DB21",95,0 )
	7418	S AMOUNT= 0,X=$G(^IB T(356,CLM, 0))
	7419	"RTN","IBJ DB21",96,0 )
	7420	S ENC=+$P (X,U,4) ; Encoun ter (Po inter to # 409.68)
	7421	"RTN","IBJ DB21",97,0 )
	7422	S ADM=+$P (X,U,5) ; Admiss ion (Po inter to # 405)
	7423	"RTN","IBJ DB21",98,0 )
	7424	S PRST=+$ P(X,U,9) ; Prothe tics (Po inter to # 660)
	7425	"RTN","IBJ DB21",99,0 )
	7426	S EPDT=$P (X,U,6) ; Episod e Date (FM format)
	7427	"RTN","IBJ DB21",100, 0)
	7428	S IBRX=+$ P(X,U,8)
	7429	"RTN","IBJ DB21",101, 0)
	7430	;
	7431	"RTN","IBJ DB21",102, 0)
	7432	; - Assum es REIMBUR SABLE INS. as the RA TE TYPE
	7433	"RTN","IBJ DB21",103, 0)
	7434	S RIMB=$O (^DGCR(399 .3,"B","RE IMBURSABLE INS.",0)) I 'RIMB S RIMB=8
	7435	"RTN","IBJ DB21",104, 0)
	7436	;
	7437	"RTN","IBJ DB21",105, 0)
	7438	G @("AMT" _EPS)
	7439	"RTN","IBJ DB21",106, 0)
	7440	;
	7441	"RTN","IBJ DB21",107, 0)
	7442	AMT1 ; - I npatient C harges
	7443	"RTN","IBJ DB21",108, 0)
	7444	I 'ADM S AMOUNT=-1 G QAMT
	7445	"RTN","IBJ DB21",109, 0)
	7446	S X=$G(^D GPM(ADM,0) ) I X="" S AMOUNT=-1 G QAMT
	7447	"RTN","IBJ DB21",110, 0)
	7448	S PTF=$P( X,U,16) I 'PTF S AMO UNT=-1 G Q AMT
	7449	"RTN","IBJ DB21",111, 0)
	7450	S ADMDT=$ P(X,U)\1,D FN=+$P(X,U ,3)
	7451	"RTN","IBJ DB21",112, 0)
	7452	I $P(X,U, 17) S DCHD =$P($G(^DG PM(+$P(X,U ,17),0)),U )\1
	7453	"RTN","IBJ DB21",113, 0)
	7454	I '$G(DCH D) S DCHD= $$DT^XLFDT ()
	7455	"RTN","IBJ DB21",114, 0)
	7456	;
	7457	"RTN","IBJ DB21",115, 0)
	7458	K ^TMP($J ,"IBCRC-PT F"),^TMP($ J,"IBCRC-D IV"),^TMP( $J,"IBCRC- INDT")
	7459	"RTN","IBJ DB21",116, 0)
	7460	D PTF^IBC RBG(PTF) I '$D(^TMP( $J,"IBCRC- PTF")) S A MOUNT=-1 G QAMT ;*5 68
	7461	"RTN","IBJ DB21",117, 0)
	7462	D PTFDV^I BCRBG(PTF) I '$D(^TM P($J,"IBCR C-DIV")) S AMOUNT=-1 G QAMT ; *568
	7463	"RTN","IBJ DB21",118, 0)
	7464	D BSLOS^I BCRBG(ADMD T,DCHD,1,A DM,0) I '$ D(^TMP($J, "IBCRC-IND T")) S AMO UNT=-1 G Q AMT ;*568
	7465	"RTN","IBJ DB21",119, 0)
	7466	;
	7467	"RTN","IBJ DB21",120, 0)
	7468	S BLDT=""
	7469	"RTN","IBJ DB21",121, 0)
	7470	F S BLDT =$O(^TMP($ J,"IBCRC-I NDT",BLDT) ) Q:BLDT=" " D
	7471	"RTN","IBJ DB21",122, 0)
	7472	.S X=^TMP ($J,"IBCRC -INDT",BLD T)
	7473	"RTN","IBJ DB21",123, 0)
	7474	.S BLBS=$ P(X,U,2),D RG=$P(X,U, 4),DIV=$P( X,U,5),SPC LTY=$P(X,U ,6)
	7475	"RTN","IBJ DB21",124, 0)
	7476	.;
	7477	"RTN","IBJ DB21",125, 0)
	7478	.; - Tort Liable Ch arge (prio r to 09/01 /99)
	7479	"RTN","IBJ DB21",126, 0)
	7480	.I BLDT<2 990901 D Q
	7481	"RTN","IBJ DB21",127, 0)
	7482	..S AMOUN T=AMOUNT+$ $BICOST^IB CRCI(RIMB, 1,BLDT,"IN PATIENT BE DSECTION S TAY",BLBS)
	7483	"RTN","IBJ DB21",128, 0)
	7484	.;
	7485	"RTN","IBJ DB21",129, 0)
	7486	.; - Reas onable Cha rges (on 0 9/01/99 or later)
	7487	"RTN","IBJ DB21",130, 0)
	7488	.I $$NODR G^IBCRBG2( SPCLTY)["O bservation " Q
	7489	"RTN","IBJ DB21",131, 0)
	7490	.I $$NODR G^IBCRBG2( SPCLTY)["N ursing Hom e Care" D Q
	7491	"RTN","IBJ DB21",132, 0)
	7492	..S BLBS= $$MCCRUTL^ IBCRU1("SK ILLED NURS ING CARE", 25)
	7493	"RTN","IBJ DB21",133, 0)
	7494	..S AMOUN T=AMOUNT+$ $BICOST^IB CRCI(RIMB, 1,BLDT,"IN PATIENT BE DSECTION S TAY",BLBS, "",DIV,"", 1)
	7495	"RTN","IBJ DB21",134, 0)
	7496	.;
	7497	"RTN","IBJ DB21",135, 0)
	7498	.S BLBS=$ $BSUPD^IBC RBG2(+SPCL TY,BLDT,1)
	7499	"RTN","IBJ DB21",136, 0)
	7500	.S AMOUNT =AMOUNT+$$ BICOST^IBC RCI(RIMB,1 ,BLDT,"INP ATIENT DRG ",DRG,"",D IV,"",1,BL BS)
	7501	"RTN","IBJ DB21",137, 0)
	7502	;
	7503	"RTN","IBJ DB21",138, 0)
	7504	; - Add t he Profess ional Aver age Amount per Episo de (Reason .Chg only)
	7505	"RTN","IBJ DB21",139, 0)
	7506	I EPDT'<2 990901 S A MOUNT=AMOU NT+$$AVG(E PDT)
	7507	"RTN","IBJ DB21",140, 0)
	7508	;
	7509	"RTN","IBJ DB21",141, 0)
	7510	; - Subtr act the am ount bille d for this Episode
	7511	"RTN","IBJ DB21",142, 0)
	7512	S AMOUNT= AMOUNT-$$C LAMT(DFN,E PDT,1) I A MOUNT=0 S AMOUNT=-1 ;*568
	7513	"RTN","IBJ DB21",143, 0)
	7514	;
	7515	"RTN","IBJ DB21",144, 0)
	7516	K ^TMP($J ,"IBCRC-PT F"),^TMP($ J,"IBCRC-D IV"),^TMP( $J,"IBCRC- INDT")
	7517	"RTN","IBJ DB21",145, 0)
	7518	;
	7519	"RTN","IBJ DB21",146, 0)
	7520	G QAMT
	7521	"RTN","IBJ DB21",147, 0)
	7522	;
	7523	"RTN","IBJ DB21",148, 0)
	7524	AMT2 ; - O utpatient Charges
	7525	"RTN","IBJ DB21",149, 0)
	7526	S X=$$GET OE^SDOE(EN C),ENCDT=+ $P(X,U),DF N=+$P(X,U, 2),DIV=$P( X,U,11)
	7527	"RTN","IBJ DB21",150, 0)
	7528	;
	7529	"RTN","IBJ DB21",151, 0)
	7530	; - Tort Liable Cha rge (prior to 09/01/ 99)
	7531	"RTN","IBJ DB21",152, 0)
	7532	I ENCDT<2 990901 D G QAMT
	7533	"RTN","IBJ DB21",153, 0)
	7534	. S AMOUN T=+$$BICOS T^IBCRCI(R IMB,3,ENCD T,"OUTPATI ENT VISIT DATE")
	7535	"RTN","IBJ DB21",154, 0)
	7536	;
	7537	"RTN","IBJ DB21",155, 0)
	7538	S AMOUNT= $$OPT(ENC, EPDT) ;*5 68
	7539	"RTN","IBJ DB21",156, 0)
	7540	G QAMT ; *568
	7541	"RTN","IBJ DB21",157, 0)
	7542	;
	7543	"RTN","IBJ DB21",158, 0)
	7544	AMT3 ; Pro sthetic Ch arges
	7545	"RTN","IBJ DB21",159, 0)
	7546	N NTBLD
	7547	"RTN","IBJ DB21",160, 0)
	7548	S NTBLD=$ $PRSAMT^IB TUTL5(EPDT ,PRST) I N TBLD=0 S A MOUNT=-1 G QAMT ;*5 68
	7549	"RTN","IBJ DB21",161, 0)
	7550	S DIC="^R MPR(660,", DA=PRST,DR ="14",DIQ= "TTCST" D EN^DIQ1
	7551	"RTN","IBJ DB21",162, 0)
	7552	S AMOUNT= +$G(TTCST( 660,DA,14) )
	7553	"RTN","IBJ DB21",163, 0)
	7554	G QAMT
	7555	"RTN","IBJ DB21",164, 0)
	7556	;
	7557	"RTN","IBJ DB21",165, 0)
	7558	AMT4 ; - P rescriptio n Charges
	7559	"RTN","IBJ DB21",166, 0)
	7560	;
	7561	"RTN","IBJ DB21",167, 0)
	7562	; Protect Rx intern al entry # before RX AMT call s witches to RX number
	7563	"RTN","IBJ DB21",168, 0)
	7564	N IBRXIEN ,NTBLD S I BRXIEN=IBR X
	7565	"RTN","IBJ DB21",169, 0)
	7566	;
	7567	"RTN","IBJ DB21",170, 0)
	7568	; - Tort Liable Cha rge & Reas onable Cha rge (same source)
	7569	"RTN","IBJ DB21",171, 0)
	7570	S NTBLD=$ $RXAMT^IBT UTL5(EPDT, IBRX) I NT BLD=0 S AM OUNT=-1 G QAMT ;*56 8
	7571	"RTN","IBJ DB21",172, 0)
	7572	;
	7573	"RTN","IBJ DB21",173, 0)
	7574	; Patch 4 37 update to call ch arge maste r with eno ugh inform ation
	7575	"RTN","IBJ DB21",174, 0)
	7576	; to look up actual cost of pr escription
	7577	"RTN","IBJ DB21",175, 0)
	7578	;
	7579	"RTN","IBJ DB21",176, 0)
	7580	N IBBI,IB RSNEW
	7581	"RTN","IBJ DB21",177, 0)
	7582	;
	7583	"RTN","IBJ DB21",178, 0)
	7584	; check c harge mast er for the type of b illing--VA Cost or n ot
	7585	"RTN","IBJ DB21",179, 0)
	7586	S IBBI=$$ EVNTITM^IB CRU3(+RIMB ,3,"PRESCR IPTION FIL L",EPDT,.I BRSNEW)
	7587	"RTN","IBJ DB21",180, 0)
	7588	;
	7589	"RTN","IBJ DB21",181, 0)
	7590	S DFN=$$F ILE^IBRXUT L(IBRXIEN, 2)
	7591	"RTN","IBJ DB21",182, 0)
	7592	I $G(DFN) >0&(IBBI[" D A N C S S ") D
	7593	"RTN","IBJ DB21",183, 0)
	7594	. N IBQT Y,IBCOST,I BRFNUM,IBS UBND,IBFEE ,IBRXNODE
	7595	"RTN","IBJ DB21",184, 0)
	7596	.; if th is is a re fill look up the ref ill info f or cost an d quantity
	7597	"RTN","IBJ DB21",185, 0)
	7598	. S IBRF NUM=$$RFLN UM^IBRXUTL (IBRXIEN,E PDT,"")
	7599	"RTN","IBJ DB21",186, 0)
	7600	. I IBRF NUM>0 D
	7601	"RTN","IBJ DB21",187, 0)
	7602	.. S I BSUBND=$$Z EROSUB^IBR XUTL(DFN,I BRXIEN,IBR FNUM)
	7603	"RTN","IBJ DB21",188, 0)
	7604	.. S I BQTY=$P($G (IBSUBND), U,4)
	7605	"RTN","IBJ DB21",189, 0)
	7606	.. S I BCOST=$P($ G(IBSUBND) ,U,11)
	7607	"RTN","IBJ DB21",190, 0)
	7608	.;
	7609	"RTN","IBJ DB21",191, 0)
	7610	.; if th is was an original f ill look u p zero nod e for Rx i nfo
	7611	"RTN","IBJ DB21",192, 0)
	7612	. E D
	7613	"RTN","IBJ DB21",193, 0)
	7614	.. S I BRXNODE=$$ RXZERO^IBR XUTL(DFN,I BRXIEN)
	7615	"RTN","IBJ DB21",194, 0)
	7616	.. S I BQTY=$P($G (IBRXNODE) ,U,7)
	7617	"RTN","IBJ DB21",195, 0)
	7618	.. S I BCOST=$P($ G(IBRXNODE ),U,17)
	7619	"RTN","IBJ DB21",196, 0)
	7620	.;
	7621	"RTN","IBJ DB21",197, 0)
	7622	. S IBRS NEW=+$O(IB RSNEW($P(I BBI,";"),0 ))
	7623	"RTN","IBJ DB21",198, 0)
	7624	. S AMOU NT=$J(+$$R ATECHG^IBC RCC(+IBRSN EW,IBQTY*I BCOST,EPDT ,.IBFEE),0 ,2)
	7625	"RTN","IBJ DB21",199, 0)
	7626	E D
	7627	"RTN","IBJ DB21",200, 0)
	7628	. S AMOU NT=+$$BICO ST^IBCRCI( RIMB,3,EPD T,"PRESCRI PTION FILL ")
	7629	"RTN","IBJ DB21",201, 0)
	7630	;
	7631	"RTN","IBJ DB21",202, 0)
	7632	;
	7633	"RTN","IBJ DB21",203, 0)
	7634	QAMT I AMO UNT=0 S AM OUNT=-1 ;* 568
	7635	"RTN","IBJ DB21",204, 0)
	7636	Q AMOUNT
	7637	"RTN","IBJ DB21",205, 0)
	7638	;
	7639	"RTN","IBJ DB21",206, 0)
	7640	CLAMT(DFN, EPDT,PT) ; Returns t he Total A mount of C laims for Patient/Ep isode
	7641	"RTN","IBJ DB21",207, 0)
	7642	;
	7643	"RTN","IBJ DB21",208, 0)
	7644	; Input: DFN - Poi nter to th e Patient File #2
	7645	"RTN","IBJ DB21",209, 0)
	7646	; EPDT - Epi sode Date
	7647	"RTN","IBJ DB21",210, 0)
	7648	; PT - 0=O utpatient, 1=Inpatie nt
	7649	"RTN","IBJ DB21",211, 0)
	7650	;
	7651	"RTN","IBJ DB21",212, 0)
	7652	N CLAMT,C LM,DAY,IBD ,X
	7653	"RTN","IBJ DB21",213, 0)
	7654	S CLAMT=0 ,DAY=EPDT- 1,CLM=""
	7655	"RTN","IBJ DB21",214, 0)
	7656	F S CLM= $O(^DGCR(3 99,"C",DFN ,CLM)) Q:' CLM D
	7657	"RTN","IBJ DB21",215, 0)
	7658	.S X=$G(^ DGCR(399,C LM,0))
	7659	"RTN","IBJ DB21",216, 0)
	7660	.I $P($P( X,U,3),"." )=$P(EPDT, ".") D
	7661	"RTN","IBJ DB21",217, 0)
	7662	..S IBD=$ $CKBIL^IBT UBOU(CLM,P T) Q:IBD=" "
	7663	"RTN","IBJ DB21",218, 0)
	7664	..I '$P(I BD,U,3) Q ; Not aut horized
	7665	"RTN","IBJ DB21",219, 0)
	7666	..S CLAMT =CLAMT+$G( ^DGCR(399, CLM,"U1"))
	7667	"RTN","IBJ DB21",220, 0)
	7668	;
	7669	"RTN","IBJ DB21",221, 0)
	7670	QCLAMT Q C LAMT
	7671	"RTN","IBJ DB21",222, 0)
	7672	;
	7673	"RTN","IBJ DB21",223, 0)
	7674	OPT(IBOE,I BDT) ; - H as the out patient en counter be en billed?
	7675	"RTN","IBJ DB21",224, 0)
	7676	; Input : IBOE=poi nter to ou tpatient e ncounter i n file #40 9.68
	7677	"RTN","IBJ DB21",225, 0)
	7678	; IBDT=eve nt date CL AIMS TRACK ING(#356)
	7679	"RTN","IBJ DB21",226, 0)
	7680	;
	7681	"RTN","IBJ DB21",227, 0)
	7682	; ; *P re-set var iables: DF N=patient IEN, RIMB= bill rate
	7683	"RTN","IBJ DB21",228, 0)
	7684	;
	7685	"RTN","IBJ DB21",229, 0)
	7686	;
	7687	"RTN","IBJ DB21",230, 0)
	7688	I '$G(DFN )!('$G(IBD T))!('$G(R IMB))!('$G (IBOE)) S IBRTN=0 G OPTQ
	7689	"RTN","IBJ DB21",231, 0)
	7690	N IBCN,IB CPT,IBCT,I BDATA,IBDA Y,IBDIV,IB XX,IBYD,IB YY,IBZ,IBM RA,IBCPTSU M,IBTCHRG, IBRTN,IBAU TH
	7691	"RTN","IBJ DB21",232, 0)
	7692	; - Check to be sur e the enco unter is b illable.
	7693	"RTN","IBJ DB21",233, 0)
	7694	I $$INPT^ IBAMTS1(DF N,IBDT\1_. 2359) S IB RTN=-1 G O PTQ ; Bec ame inpati ent same d ay.
	7695	"RTN","IBJ DB21",234, 0)
	7696	I $$ENCL^ IBAMTS2(IB OE)["1" S IBRTN=-1 G OPTQ ; " ao^ir^sc^s wa^mst^hnc ^cv^shad" encounter.
	7697	"RTN","IBJ DB21",235, 0)
	7698	;
	7699	"RTN","IBJ DB21",236, 0)
	7700	;
	7701	"RTN","IBJ DB21",237, 0)
	7702	; - Gathe r all proc edures ass ociated wi th the enc ounter.
	7703	"RTN","IBJ DB21",238, 0)
	7704	D GETCPT^ SDOE(IBOE, "IBYY") I '$G(IBYY) S IBRTN=-1 G OPTQ ; Check CPT qty.
	7705	"RTN","IBJ DB21",239, 0)
	7706	;
	7707	"RTN","IBJ DB21",240, 0)
	7708	; - Deter mine the e ncounter d ivision.
	7709	"RTN","IBJ DB21",241, 0)
	7710	S IBDIV=+ $P($$GETOE ^SDOE(IBOE ),U,11) S: 'IBDIV IBD IV=+$$PRIM ^VASITE()
	7711	"RTN","IBJ DB21",242, 0)
	7712	;
	7713	"RTN","IBJ DB21",243, 0)
	7714	; - Build array of all billab le encount er procedu res.
	7715	"RTN","IBJ DB21",244, 0)
	7716	S IBXX=0 F S IBXX= $O(IBYY(IB XX)) Q:'IB XX D
	7717	"RTN","IBJ DB21",245, 0)
	7718	. ;
	7719	"RTN","IBJ DB21",246, 0)
	7720	. ; - Get procedure pointer a nd code.
	7721	"RTN","IBJ DB21",247, 0)
	7722	. S IBZ=+ IBYY(IBXX) ,IBCN=$P($ $CPT^ICPTC OD(IBZ),"^ ",2)
	7723	"RTN","IBJ DB21",248, 0)
	7724	. ;
	7725	"RTN","IBJ DB21",249, 0)
	7726	. ; - Ign ore LAB se rvices for vets with Medicare Supplement al coverag e.
	7727	"RTN","IBJ DB21",250, 0)
	7728	. I IBCN> 79999,IBCN <90000 Q
	7729	"RTN","IBJ DB21",251, 0)
	7730	. ;
	7731	"RTN","IBJ DB21",252, 0)
	7732	. ; - Get the insti tutional/p rofessiona l charge c omponents.
	7733	"RTN","IBJ DB21",253, 0)
	7734	. S IBCPT (IBZ,1)=+$ $BICOST^IB CRCI(RIMB, 3,IBDT,"PR OCEDURE",I BZ,"",IBDI V,"",1)
	7735	"RTN","IBJ DB21",254, 0)
	7736	. S IBCPT (IBZ,2)=+$ $BICOST^IB CRCI(RIMB, 3,IBDT,"PR OCEDURE",I BZ,"",IBDI V,"",2)
	7737	"RTN","IBJ DB21",255, 0)
	7738	. ;
	7739	"RTN","IBJ DB21",256, 0)
	7740	. ; - Eli minate com ponents wi thout a ch arge.
	7741	"RTN","IBJ DB21",257, 0)
	7742	. S IBCPT SUM(IBZ)=+ $G(IBCPT(I BZ,1))+$G( IBCPT(IBZ, 2))
	7743	"RTN","IBJ DB21",258, 0)
	7744	. I 'IBCP T(IBZ,1) K IBCPT(IBZ ,1)
	7745	"RTN","IBJ DB21",259, 0)
	7746	. I 'IBCP T(IBZ,2) K IBCPT(IBZ ,2)
	7747	"RTN","IBJ DB21",260, 0)
	7748	;
	7749	"RTN","IBJ DB21",261, 0)
	7750	I '$D(IBC PT) S IBRT N=-1 G OPT Q ; Quit i f no billa ble proced ures remai n.
	7751	"RTN","IBJ DB21",262, 0)
	7752	;
	7753	"RTN","IBJ DB21",263, 0)
	7754	; - Look at all of the vet's bills for the day an d eliminat e
	7755	"RTN","IBJ DB21",264, 0)
	7756	; from the array those proc edures tha t have bee n billed.
	7757	"RTN","IBJ DB21",265, 0)
	7758	S IBXX=0 S IBDAY=$E (IBDT,1,7)
	7759	"RTN","IBJ DB21",266, 0)
	7760	F S IBXX =$O(^DGCR( 399,"AOPV" ,DFN,IBDAY ,IBXX)) Q: 'IBXX D
	7761	"RTN","IBJ DB21",267, 0)
	7762	. ;
	7763	"RTN","IBJ DB21",268, 0)
	7764	. ; - Per form gener al checks on the cla im.
	7765	"RTN","IBJ DB21",269, 0)
	7766	. S IBDAT A=$$CKBIL^ IBTUBOU(IB XX) Q:IBDA TA=""
	7767	"RTN","IBJ DB21",270, 0)
	7768	. S IBAUT H=$P($G(IB DATA),U,2)
	7769	"RTN","IBJ DB21",271, 0)
	7770	. I $G(IB AUTH)<2&($ G(IBAUTH)> 5) Q
	7771	"RTN","IBJ DB21",272, 0)
	7772	. ; - The episode h as been bi lled. Chec k the reve nue code m ultiple fo r
	7773	"RTN","IBJ DB21",273, 0)
	7774	. ; all procedure s billed o n the clai m.
	7775	"RTN","IBJ DB21",274, 0)
	7776	. S IBYY= 0
	7777	"RTN","IBJ DB21",275, 0)
	7778	. F S IB YY=$O(^DGC R(399,IBXX ,"RC",IBYY )) Q:'IBYY S IBYD=^ (IBYY,0) D
	7779	"RTN","IBJ DB21",276, 0)
	7780	. . ;
	7781	"RTN","IBJ DB21",277, 0)
	7782	. . ; - G et the pro cedure cod e,charge t ype and to tal charge s for the revenue co de.
	7783	"RTN","IBJ DB21",278, 0)
	7784	. . S IBZ =$P(IBYD,U ,6)
	7785	"RTN","IBJ DB21",279, 0)
	7786	. . S IBC T=$S($P(IB YD,U,12):$ P(IBYD,U,1 2),1:$P(IB DATA,U,4))
	7787	"RTN","IBJ DB21",280, 0)
	7788	. . S IBT CHRG=$P(IB YD,U,4)
	7789	"RTN","IBJ DB21",281, 0)
	7790	. . I 'IB Z!('IBCT) Q ; Can't determine code/char ge type fo r procedur e.
	7791	"RTN","IBJ DB21",282, 0)
	7792	. . ; Del ete proced ure from u nbilled pr ocedures a rray.
	7793	"RTN","IBJ DB21",283, 0)
	7794	. . I $G( IBTCHRG)'< $G(IBCPTSU M(IBZ)) K IBCPT(IBZ)
	7795	"RTN","IBJ DB21",284, 0)
	7796	. . I $D( IBCPT(IBZ, IBCT)) K I BCPT(IBZ,I BCT)
	7797	"RTN","IBJ DB21",285, 0)
	7798	;
	7799	"RTN","IBJ DB21",286, 0)
	7800	; - Again , quit if no billabl e procedur es remain.
	7801	"RTN","IBJ DB21",287, 0)
	7802	I '$D(IBC PT) S IBRT N=-1 G OPT Q
	7803	"RTN","IBJ DB21",288, 0)
	7804	; - If th ere are bi llable pro cedures re turn TOTAL AMOUNT
	7805	"RTN","IBJ DB21",289, 0)
	7806	I $D(IBCP T) S (IBZ, IBCT,IBRTN )=0
	7807	"RTN","IBJ DB21",290, 0)
	7808	F S IBZ= $O(IBCPT(I BZ)) Q:'IB Z D
	7809	"RTN","IBJ DB21",291, 0)
	7810	.F S IBC T=$O(IBCPT (IBZ,IBCT) ) Q:'IBCT D
	7811	"RTN","IBJ DB21",292, 0)
	7812	..S IBRTN =IBRTN+IBC PT(IBZ,IBC T)
	7813	"RTN","IBJ DB21",293, 0)
	7814	I IBRTN=0 S IBRTN=- 1
	7815	"RTN","IBJ DB21",294, 0)
	7816	;
	7817	"RTN","IBJ DB21",295, 0)
	7818	OPTQ K IBC PT Q IBRTN
	7819	"RTN","IBJ DB21",296, 0)
	7820	;
	7821	"RTN","IBJ DB21",297, 0)
	7822	AVG(EPDT) ; Returns the Averag e Amount o f Inpatien t Professi onal per
	7823	"RTN","IBJ DB21",298, 0)
	7824	; Number of Episodes for the pr evious 12 months
	7825	"RTN","IBJ DB21",299, 0)
	7826	N AVG,M,Z
	7827	"RTN","IBJ DB21",300, 0)
	7828	S AVG=0,M =EPDT\100* 100
	7829	"RTN","IBJ DB21",301, 0)
	7830	I '$D(^IB E(356.19,M ,1)) S M=$ O(^IBE(356 .19,M),-1) I 'M G QA VG
	7831	"RTN","IBJ DB21",302, 0)
	7832	S Z=$G(^I BE(356.19, M,1)) I $P (Z,U,12) S AVG=$P(Z, U,11)/$P(Z ,U,12)
	7833	"RTN","IBJ DB21",303, 0)
	7834	QAVG Q $J( AVG,0,2)
	7835	"RTN","IBJ DB21",304, 0)
	7836	;
	7837	"RTN","IBJ DB21",305, 0)
	7838	PRVSPC(EPS ,CLM) ; Re turn the P rovider an d the Spec ialty
	7839	"RTN","IBJ DB21",306, 0)
	7840	; Input: EPS - Epi sode(1 = I npatient O R 2 = Outp atient)
	7841	"RTN","IBJ DB21",307, 0)
	7842	; CLM - Poi nter to Cl aim Tracki ng File (# 356)
	7843	"RTN","IBJ DB21",308, 0)
	7844	; Output: Provider Code (Poin ter to #20 0) ^ Provi der Name ^
	7845	"RTN","IBJ DB21",309, 0)
	7846	; Specialty Code (Poi nter to #4 0.7 or #45 .7) ^ Spec ialty Name
	7847	"RTN","IBJ DB21",310, 0)
	7848	;
	7849	"RTN","IBJ DB21",311, 0)
	7850	N ADM,DFN ,ENC,PRI,P RS,PRV,PRV LST,SPC,ST P,X,VAIN, D NS T
	7851	"RTN","IBJ DB21",312, 0)
	7852	;
	7853	"RTN","IBJ DB21",313, 0)
	7854	S X=$G(^I BT(356,CLM ,0))
	7855	"RTN","IBJ DB21",314, 0)
	7856	S DFN=$P( X,U,2),ENC =$P(X,U,4) ,ADM=$P(X, U,5),PRS=$ P(X,U,8)
	7857	"RTN","IBJ DB21",315, 0)
	7858	;
	7859	"RTN","IBJ DB21",316, 0)
	7860	S (PRV,SP C)="^"
	7861	"RTN","IBJ DB21",317, 0)
	7862	I EPS=1,A DM D G QP S ; Inpat ient
	7863	"RTN","IBJ DB21",318, 0)
	7864	.S X=$G(^ DGPM(ADM,0 )), D NS T=$P(X,U)\ 1 I ' D NS T Q
	7865	"RTN","IBJ DB21",319, 0)
	7866	.D INP^VA DPT S PRV= $G(VAIN(11 )),SPC=$G( VAIN(3))
	7867	"RTN","IBJ DB21",320, 0)
	7868	.S:PRV="" PRV="^" S :SPC="" SP C="^"
	7869	"RTN","IBJ DB21",321, 0)
	7870	;
	7871	"RTN","IBJ DB21",322, 0)
	7872	I EPS=2,E NC D G QP S ; Outpa tient
	7873	"RTN","IBJ DB21",323, 0)
	7874	.D GETPRV ^SDOE(ENC, "PRVLST")
	7875	"RTN","IBJ DB21",324, 0)
	7876	.S (X,PRI )=""
	7877	"RTN","IBJ DB21",325, 0)
	7878	.F S X=$ O(PRVLST(X ),-1) Q:X= ""!PRI D
	7879	"RTN","IBJ DB21",326, 0)
	7880	..N IBX S PRV=+PRVL ST(X)
	7881	"RTN","IBJ DB21",327, 0)
	7882	..I $P(PR VLST(X),U, 4)="P" S P RI=1 ; Pri mary provi der
	7883	"RTN","IBJ DB21",328, 0)
	7884	..I PRV S PRV=PRV_U _$P($G(^VA (200,+PRV, 0)),U)
	7885	"RTN","IBJ DB21",329, 0)
	7886	..S IBX=$ $GETOE^SDO E(ENC),STP =$P(IBX,U, 3)
	7887	"RTN","IBJ DB21",330, 0)
	7888	..I STP'= "" S SPC=S TP_U_$P($G (^DIC(40.7 ,STP,0)),U )
	7889	"RTN","IBJ DB21",331, 0)
	7890	;
	7891	"RTN","IBJ DB21",332, 0)
	7892	QPS Q (PRV _U_SPC)
	7893	"RTN","IBJ DB21",333, 0)
	7894	;
	7895	"RTN","IBJ DB21",334, 0)
	7896	PHDL ; - P rint the h eader line for the E xcel sprea dsheet
	7897	"RTN","IBJ DB21",335, 0)
	7898	N X
	7899	"RTN","IBJ DB21",336, 0)
	7900	S X="Divi sion^Svc^P atient^SSN ^Insurance ^Episode D t^Dt Enter ed^Dt Lst Edit^"
	7901	"RTN","IBJ DB21",337, 0)
	7902	S X=X_"Ls t Edited B y^Next Adm ission^RNB Cat^Provi der^Specia lty^Entry Amt^Relate d Bills^Co mments"
	7903	"RTN","IBJ DB21",338, 0)
	7904	W !,X
	7905	"RTN","IBJ DB21",339, 0)
	7906	Q
	7907	"RTN","IBJ DF4")
	7908	0^8^B58418 546
	7909	"RTN","IBJ DF4",1,0)
	7910	IBJDF4 ;AL B/RB - FIR ST PARTY F OLLOW-UP R EPORT ;15- APR-00
	7911	"RTN","IBJ DF4",2,0)
	7912	;;2.0;INT EGRATED BI LLING;12 3,204,220, 568;21-M AR-94;Buil d 12
	7913	"RTN","IBJ DF4",3,0)
	7914	;Per VA D irective 6 402, this routine sh ould not b e modified .
	7915	"RTN","IBJ DF4",4,0)
	7916	;
	7917	"RTN","IBJ DF4",5,0)
	7918	EN ; - Opt ion entry point.
	7919	"RTN","IBJ DF4",6,0)
	7920	S IBEXCEL =0
	7921	"RTN","IBJ DF4",7,0)
	7922	;
	7923	"RTN","IBJ DF4",8,0)
	7924	; - Selec t AR categ ories to p rint.
	7925	"RTN","IBJ DF4",9,0)
	7926	S IBPRT=" Choose whi ch type of receivabl es to prin t:"
	7927	"RTN","IBJ DF4",10,0)
	7928	K IBOPT
	7929	"RTN","IBJ DF4",11,0)
	7930	S IBOPT(1 )="EMERGEN CY/HUMANIT ARIAN"
	7931	"RTN","IBJ DF4",12,0)
	7932	S IBOPT(2 )="EMERGEN CY/HUMANIT ARIAN REIM B"
	7933	"RTN","IBJ DF4",13,0)
	7934	S IBOPT(3 )="INELIGI BLE"
	7935	"RTN","IBJ DF4",14,0)
	7936	S IBOPT(4 )="INELIGI BLE HOSP. REIMB."
	7937	"RTN","IBJ DF4",15,0)
	7938	S IBOPT(5 )="C-MEANS TEST & RX COPAY"
	7939	"RTN","IBJ DF4",16,0)
	7940	S IBOPT(6 )="LONG TE RM CARE CO PAY"
	7941	"RTN","IBJ DF4",17,0)
	7942	S IBOPT(7 )="ALL OF THE ABOVE"
	7943	"RTN","IBJ DF4",18,0)
	7944	S IBSEL=$ $MLTP^IBJD (IBPRT,.IB OPT,1) I ' IBSEL G EN Q
	7945	"RTN","IBJ DF4",19,0)
	7946	;
	7947	"RTN","IBJ DF4",20,0)
	7948	STA ; - Ch oose bill status.
	7949	"RTN","IBJ DF4",21,0)
	7950	W !!,"Run report fo r (A)CTIVE ARs, (S)U SPENDED AR s, or (B)O TH: B// "
	7951	"RTN","IBJ DF4",22,0)
	7952	R X:DTIME G:'$T!(X[ "^") ENQ S :X="" X="B " S X=$E(X )
	7953	"RTN","IBJ DF4",23,0)
	7954	I "AaBbSs "'[X S IBO FF=1 D HEL P^IBJDF4H G STA
	7955	"RTN","IBJ DF4",24,0)
	7956	S IBSTA=$ S("Aa"[X:" A","Ss"[X: "S",1:"B")
	7957	"RTN","IBJ DF4",25,0)
	7958	W " ",$S (IBSTA="A" :"ACTIVE", IBSTA="S": "SUSPENDED ",1:"BOTH" )
	7959	"RTN","IBJ DF4",26,0)
	7960	;
	7961	"RTN","IBJ DF4",27,0)
	7962	SUSTYP ;If SUSPENDED is chosen , prompt f or which s uspended b ills to di splay IB2 .0568/DRF
	7963	"RTN","IBJ DF4",28,0)
	7964	I IBSTA=" S" D
	7965	"RTN","IBJ DF4",29,0)
	7966	. N X,XX, I,CH,LAST
	7967	"RTN","IBJ DF4",30,0)
	7968	. K IBSUS
	7969	"RTN","IBJ DF4",31,0)
	7970	. S XX=^D D(433,90,0 ),XX=$P(XX ,"^",3) F I=1:1 S CH =$P(XX,";" ,I) Q:CH=" " S IBSUS ($P(CH,":" ,1))=$P(CH ,":",2)
	7971	"RTN","IBJ DF4",32,0)
	7972	. S LAST= $O(IBSUS(" "),-1),IBS US(LAST+1) ="ALL OF T HE ABOVE"
	7973	"RTN","IBJ DF4",33,0)
	7974	. S IBPRT ="Choose w hich suspe nded types to print: "
	7975	"RTN","IBJ DF4",34,0)
	7976	. S IBSEL ST=$$MLTP0 (IBPRT,.IB SUS,1)
	7977	"RTN","IBJ DF4",35,0)
	7978	I IBSTA=" S",IBSELST ="" G ENQ
	7979	"RTN","IBJ DF4",36,0)
	7980	;
	7981	"RTN","IBJ DF4",37,0)
	7982	; - Selec t a detail ed or summ ary report .
	7983	"RTN","IBJ DF4",38,0)
	7984	D DS^IBJD G ENQ:IBR PT["^"
	7985	"RTN","IBJ DF4",39,0)
	7986	I IBRPT=" S" D G RC
	7987	"RTN","IBJ DF4",40,0)
	7988	. S IBSN= "N",IBSNA= "ALL",IBSN F="",IBSNL ="zzzzz",I BSMN="A"
	7989	"RTN","IBJ DF4",41,0)
	7990	;
	7991	"RTN","IBJ DF4",42,0)
	7992	; - Deter mine sorti ng (By nam e or Last 4 SSN)
	7993	"RTN","IBJ DF4",43,0)
	7994	S IBSN=$$ SNL^IBJD() G ENQ:IBS N="^"
	7995	"RTN","IBJ DF4",44,0)
	7996	;
	7997	"RTN","IBJ DF4",45,0)
	7998	; - Deter mine the r ange
	7999	"RTN","IBJ DF4",46,0)
	8000	S X=$$INT V^IBJD("PA TIENT "_$S (IBSN="N": "NAME",1:" LAST 4")) G ENQ:X="^ "
	8001	"RTN","IBJ DF4",47,0)
	8002	S IBSNF=$ P(X,"^",1) ,IBSNL=$P( X,"^",2),I BSNA=$P(X, "^",3)
	8003	"RTN","IBJ DF4",48,0)
	8004	;
	8005	"RTN","IBJ DF4",49,0)
	8006	AGE ; - De termine if the activ e receivab le must be within an age range .
	8007	"RTN","IBJ DF4",50,0)
	8008	W !!,"Inc lude (A)LL ",$S(IBST A="A":"act ive ",IBST A="S":"sus pended ",1 :""),"ARs or those w ithin an A GE (R)ANGE : ALL// "
	8009	"RTN","IBJ DF4",51,0)
	8010	R X:DTIME G:'$T!(X[ "^") ENQ S :X="" X="A " S X=$E(X )
	8011	"RTN","IBJ DF4",52,0)
	8012	I "ARar"' [X S IBOFF =9 D HELP^ IBJDF4H G AGE
	8013	"RTN","IBJ DF4",53,0)
	8014	S IBSMN=$ S("Rr"[X:" R",1:"A") W " ",$S( IBSMN="R": "RANGE",1: "ALL")
	8015	"RTN","IBJ DF4",54,0)
	8016	I IBSMN=" A" G AMT
	8017	"RTN","IBJ DF4",55,0)
	8018	;
	8019	"RTN","IBJ DF4",56,0)
	8020	; - Deter mine the a ctive rece ivable age range.
	8021	"RTN","IBJ DF4",57,0)
	8022	W !,"EXAM PLE Range: 31-60 day s"
	8023	"RTN","IBJ DF4",58,0)
	8024	S DIR(0)= "NA^1:9999 9"
	8025	"RTN","IBJ DF4",59,0)
	8026	S DIR("A" )="Enter t he minimum age of th e receivab le: "
	8027	"RTN","IBJ DF4",60,0)
	8028	S DIR("T" )=DTIME,DI R("?")="^S IBOFF=16 D HELP^IBJ DF4H"
	8029	"RTN","IBJ DF4",61,0)
	8030	D ^DIR K DIR G:$D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) ENQ
	8031	"RTN","IBJ DF4",62,0)
	8032	S IBSMN=+ Y W " ", IBSMN," DA YS" K DIRO UT,DTOUT,D UOUT,DIRUT
	8033	"RTN","IBJ DF4",63,0)
	8034	;
	8035	"RTN","IBJ DF4",64,0)
	8036	S DIR(0)= "NA^"_IBSM N_":99999"
	8037	"RTN","IBJ DF4",65,0)
	8038	S DIR("A" )="Enter t he maximum age of th e receivab le: "
	8039	"RTN","IBJ DF4",66,0)
	8040	S DIR("B" )=IBSMN,DI R("T")=DTI ME,DIR("?" )="^S IBOF F=21 D HEL P^IBJDF4H"
	8041	"RTN","IBJ DF4",67,0)
	8042	D ^DIR K DIR G:$D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) ENQ
	8043	"RTN","IBJ DF4",68,0)
	8044	S IBSMX=+ Y W " ", IBSMX," DA YS" K DIRO UT,DTOUT,D UOUT,DIRUT
	8045	"RTN","IBJ DF4",69,0)
	8046	;
	8047	"RTN","IBJ DF4",70,0)
	8048	AMT ; - Pr int receiv ables with a minimum balance.
	8049	"RTN","IBJ DF4",71,0)
	8050	S DIR(0)= "Y",DIR("B ")="NO" W !
	8051	"RTN","IBJ DF4",72,0)
	8052	S DIR("A" )="Print r eceivables with a mi nimum bala nce"
	8053	"RTN","IBJ DF4",73,0)
	8054	S DIR("T" )=DTIME,DI R("?")="^S IBOFF=26 D HELP^IBJ DF4H"
	8055	"RTN","IBJ DF4",74,0)
	8056	D ^DIR K DIR G:$D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) ENQ
	8057	"RTN","IBJ DF4",75,0)
	8058	S IBSAM=+ Y K DIROUT ,DTOUT,DUO UT,DIRUT G :'IBSAM EX CEL
	8059	"RTN","IBJ DF4",76,0)
	8060	;
	8061	"RTN","IBJ DF4",77,0)
	8062	AMT1 ; - D etermine t he minimum balance a mount.
	8063	"RTN","IBJ DF4",78,0)
	8064	S DIR(0)= "NA^1:9999 999"
	8065	"RTN","IBJ DF4",79,0)
	8066	S DIR("A" )="Enter t he minimum balance a mount of t he receiva ble: "
	8067	"RTN","IBJ DF4",80,0)
	8068	S DIR("T" )=DTIME,DI R("?")="^S IBOFF=33 D HELP^IBJ DF4H"
	8069	"RTN","IBJ DF4",81,0)
	8070	D ^DIR K DIR G:$D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) ENQ
	8071	"RTN","IBJ DF4",82,0)
	8072	S IBSAM=+ Y K DIROUT ,DTOUT,DUO UT,DIRUT
	8073	"RTN","IBJ DF4",83,0)
	8074	;
	8075	"RTN","IBJ DF4",84,0)
	8076	EXCEL ; - Determine whether to gather da ta for Exc el report.
	8077	"RTN","IBJ DF4",85,0)
	8078	S IBEXCEL =$$EXCEL^I BJD() G EN Q:IBEXCEL= "^"
	8079	"RTN","IBJ DF4",86,0)
	8080	I IBEXCEL S IBSH=1, IBSH1="M" G RC
	8081	"RTN","IBJ DF4",87,0)
	8082	;
	8083	"RTN","IBJ DF4",88,0)
	8084	BCH ; - De termine wh ether to i nclude the bill comm ent histor y.
	8085	"RTN","IBJ DF4",89,0)
	8086	S DIR(0)= "Y",DIR("B ")="NO" W !
	8087	"RTN","IBJ DF4",90,0)
	8088	S DIR("A" )="Include the bill comment hi story with each rece ivable"
	8089	"RTN","IBJ DF4",91,0)
	8090	S DIR("T" )=DTIME,DI R("?")="^S IBOFF=38 D HELP^IBJ DF4H"
	8091	"RTN","IBJ DF4",92,0)
	8092	D ^DIR K DIR G:$D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) ENQ
	8093	"RTN","IBJ DF4",93,0)
	8094	S IBSH=+Y K DIROUT, DTOUT,DUOU T,DIRUT G: 'IBSH RC
	8095	"RTN","IBJ DF4",94,0)
	8096	;
	8097	"RTN","IBJ DF4",95,0)
	8098	S DIR(0)= "SA^A:ALL; M:MOST REC ENT"
	8099	"RTN","IBJ DF4",96,0)
	8100	S DIR("A" )="Print ( A)LL comme nts or the (M)OST RE CENT comme nt: "
	8101	"RTN","IBJ DF4",97,0)
	8102	S DIR("B" )="ALL",DI R("T")=DTI ME,DIR("?" )="^S IBOF F=47 D HEL P^IBJDF4H"
	8103	"RTN","IBJ DF4",98,0)
	8104	D ^DIR K DIR G:$D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) ENQ
	8105	"RTN","IBJ DF4",99,0)
	8106	S IBSH1=Y K DIROUT, DTOUT,DUOU T,DIRUT G: IBSH1="A" RC
	8107	"RTN","IBJ DF4",100,0 )
	8108	;
	8109	"RTN","IBJ DF4",101,0 )
	8110	S DIR(0)= "NAO^1:999 "
	8111	"RTN","IBJ DF4",102,0 )
	8112	S DIR("A" )="Minimum age of mo st recent bill comme nt (option al): "
	8113	"RTN","IBJ DF4",103,0 )
	8114	S DIR("T" )=DTIME,DI R("?")="^S IBOFF=54 D HELP^IBJ DF4H"
	8115	"RTN","IBJ DF4",104,0 )
	8116	D ^DIR K DIR G:$D(D TOUT)!$D(D UOUT)!$D(D IROUT) ENQ
	8117	"RTN","IBJ DF4",105,0 )
	8118	S IBSH2=+ Y W:IBSH2 " days" K DIROUT,DTO UT,DUOUT
	8119	"RTN","IBJ DF4",106,0 )
	8120	;
	8121	"RTN","IBJ DF4",107,0 )
	8122	RC ; - Inc lude recei vables ref erred to R egional Co unsel?
	8123	"RTN","IBJ DF4",108,0 )
	8124	S DIR(0)= "Y",DIR("B ")="NO",DI R("T")=DTI ME W !
	8125	"RTN","IBJ DF4",109,0 )
	8126	S DIR("A" )="Include ARs refer red to Reg ional Coun sel"
	8127	"RTN","IBJ DF4",110,0 )
	8128	S DIR("?" )="^S IBOF F=61 D HEL P^IBJDF4H"
	8129	"RTN","IBJ DF4",111,0 )
	8130	D ^DIR K DIR G:$D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) ENQ
	8131	"RTN","IBJ DF4",112,0 )
	8132	S IBSRC=+ Y K DIROUT ,DTOUT,DUO UT,DIRUT
	8133	"RTN","IBJ DF4",113,0 )
	8134	;
	8135	"RTN","IBJ DF4",114,0 )
	8136	DEV ; - Se lect a dev ice.
	8137	"RTN","IBJ DF4",115,0 )
	8138	I '$G(IBE XCEL) D
	8139	"RTN","IBJ DF4",116,0 )
	8140	. W !!,"N ote: This report wil l search t hrough all "
	8141	"RTN","IBJ DF4",117,0 )
	8142	. W $S(IB STA="A":"a ctive",IBS TA="S":"su spended",1 :"active & suspended ")," recei vables."
	8143	"RTN","IBJ DF4",118,0 )
	8144	. W !?6," It is reco mmended th at you que ue it to r un after n ormal busi ness hours ."
	8145	"RTN","IBJ DF4",119,0 )
	8146	;
	8147	"RTN","IBJ DF4",120,0 )
	8148	I $G(IBEX CEL) D EXM SG^IBJD
	8149	"RTN","IBJ DF4",121,0 )
	8150	;
	8151	"RTN","IBJ DF4",122,0 )
	8152	W ! S %ZI S="QM" D ^ %ZIS G:POP ENQ
	8153	"RTN","IBJ DF4",123,0 )
	8154	I $D(IO(" Q")) D G ENQ
	8155	"RTN","IBJ DF4",124,0 )
	8156	.S ZTRTN= "DQ^IBJDF4 ",ZTDESC=" IB - FIRST PARTY FOL LOW-UP REP ORT"
	8157	"RTN","IBJ DF4",125,0 )
	8158	.S ZTSAVE ("IB*")="" D ^%ZTLOA D
	8159	"RTN","IBJ DF4",126,0 )
	8160	.I $G(ZTS K) W !!,"T his job ha s been que ued. The t ask no. is ",ZTSK,". "
	8161	"RTN","IBJ DF4",127,0 )
	8162	.E W !!, "Unable to queue thi s job."
	8163	"RTN","IBJ DF4",128,0 )
	8164	.K ZTSK,I O("Q") D H OME^%ZIS
	8165	"RTN","IBJ DF4",129,0 )
	8166	;
	8167	"RTN","IBJ DF4",130,0 )
	8168	U IO
	8169	"RTN","IBJ DF4",131,0 )
	8170	;
	8171	"RTN","IBJ DF4",132,0 )
	8172	; If call ed by the Extraction Module, c hange extr act status for the 5
	8173	"RTN","IBJ DF4",133,0 )
	8174	; reports : Emergenc y/Humanita rian, Inel igible rec eivables, C-Means Te st,
	8175	"RTN","IBJ DF4",134,0 )
	8176	; RX Copay /SC VET an d RX Copay /NSC VET
	8177	"RTN","IBJ DF4",135,0 )
	8178	DQ I $G(IB XTRACT) F I=12:1:16 D E^IBJDE( I,1)
	8179	"RTN","IBJ DF4",136,0 )
	8180	;
	8181	"RTN","IBJ DF4",137,0 )
	8182	D ST^IBJD F41 ; Co mpile and print the report.
	8183	"RTN","IBJ DF4",138,0 )
	8184	;
	8185	"RTN","IBJ DF4",139,0 )
	8186	ENQ K IBSE L,IBSN,IBS NF,IBSNL,I BOFF,IBSNA ,IBSH,IBSH 1,IBSH2,IB SAM,IBSRC, IBTEXT
	8187	"RTN","IBJ DF4",140,0 )
	8188	K IBI,IBO PT,IBPRT,I BSTA,IBEXC EL,IBRPT,I BSMN,IBSMX ,POP,DIROU T,DTOUT,DU OUT
	8189	"RTN","IBJ DF4",141,0 )
	8190	K DIRUT,% ZIS,ZTDESC ,ZTRTN,ZTS AVE,I,X,Y
	8191	"RTN","IBJ DF4",142,0 )
	8192	Q
	8193	"RTN","IBJ DF4",143,0 )
	8194	;
	8195	"RTN","IBJ DF4",144,0 )
	8196	SELECT(ARR ,ZERO) ;Se lect items up to num ber ARR
	8197	"RTN","IBJ DF4",145,0 )
	8198	;ARR - Th e upper li mit that c an be chos en
	8199	"RTN","IBJ DF4",146,0 )
	8200	;ZERO - S tart with 0 instead of 1
	8201	"RTN","IBJ DF4",147,0 )
	8202	;This fun ction will eliminate duplicate s and retu rn choices in numeri cal error
	8203	"RTN","IBJ DF4",148,0 )
	8204	;regardle ss of inpu t order.
	8205	"RTN","IBJ DF4",149,0 )
	8206	;
	8207	"RTN","IBJ DF4",150,0 )
	8208	N CNT,DIR ,ERR,FIRST ,I,J,LAST, LIST,OK,PC ,STR,X,Y
	8209	"RTN","IBJ DF4",151,0 )
	8210	I $G(ARR) ="" Q ""
	8211	"RTN","IBJ DF4",152,0 )
	8212	S ZERO=+$ G(ZERO)
	8213	"RTN","IBJ DF4",153,0 )
	8214	S OK=0 F CNT=1:1 I 'OK D Q:O K
	8215	"RTN","IBJ DF4",154,0 )
	8216	. I CNT>1 W " Sel ect SUSPEN DED REASON using the following formats:( A)ll or 1, 2,3 and/or 1-3",!
	8217	"RTN","IBJ DF4",155,0 )
	8218	. S DIR(0 )="FO^^"
	8219	"RTN","IBJ DF4",156,0 )
	8220	. S DIR(" A")="Choos e SUSPENDE D REASON f or report: "
	8221	"RTN","IBJ DF4",157,0 )
	8222	. S DIR(" B")="A"
	8223	"RTN","IBJ DF4",158,0 )
	8224	. S DIR(" ?")="Selec t SUSPENDE D REASON u sing the f ollowing f ormats:(A) ll or 1,2, 3 and/or 1 -3"
	8225	"RTN","IBJ DF4",159,0 )
	8226	. D ^DIR
	8227	"RTN","IBJ DF4",160,0 )
	8228	. K STR S ERR=""
	8229	"RTN","IBJ DF4",161,0 )
	8230	. I X="A" !(X="ALL") D Q:OK
	8231	"RTN","IBJ DF4",162,0 )
	8232	.. F I=$S (ZERO:0,1: 1):1:ARR S STR(I)=""
	8233	"RTN","IBJ DF4",163,0 )
	8234	.. S OK=1
	8235	"RTN","IBJ DF4",164,0 )
	8236	. F I=1:1 :$L(X,",") S PC=$P(X ,",",I) D Q:ERR]""
	8237	"RTN","IBJ DF4",165,0 )
	8238	.. I PC'? 1.N,PC'?1. N1"-"1.N S ERR="Inva lid respon se" Q
	8239	"RTN","IBJ DF4",166,0 )
	8240	.. I PC'> $S(ZERO:-1 ,1:0)!(PC> ARR) S ERR ="Number o ut of rang e" Q
	8241	"RTN","IBJ DF4",167,0 )
	8242	.. I PC?1 .N,PC>$S(Z ERO:-1,1:0 ),PC'>ARR S STR(PC)= "" Q
	8243	"RTN","IBJ DF4",168,0 )
	8244	.. I PC?1 .N1"-"1.N D Q:ERR]" "
	8245	"RTN","IBJ DF4",169,0 )
	8246	... S FIR ST=$P(PC," -",1),LAST =$P(PC,"-" ,2)
	8247	"RTN","IBJ DF4",170,0 )
	8248	... I FIR ST'>$S(ZER O:-1,1:0)! (FIRST>ARR )!(LAST'>0 )!(LAST>AR R) S ERR=" Number out of range" Q
	8249	"RTN","IBJ DF4",171,0 )
	8250	... I FIR ST>$S(ZERO :-1,1:0),F IRST'>ARR, LAST>0,LAS T'>ARR F J =FIRST:1:L AST S STR( J)=""
	8251	"RTN","IBJ DF4",172,0 )
	8252	. I ERR=" " S OK=1 Q
	8253	"RTN","IBJ DF4",173,0 )
	8254	. S OK=0 W " "_ERR ,!
	8255	"RTN","IBJ DF4",174,0 )
	8256	S I=$S(ZE RO:-1,1:0) ,LIST="" F S I=$O(S TR(I)) Q:I ="" S LIS T=LIST_$S( LIST="":"" ,1:",")_I
	8257	"RTN","IBJ DF4",175,0 )
	8258	Q LIST
	8259	"RTN","IBJ DF4",176,0 )
	8260	;
	8261	"RTN","IBJ DF4",177,0 )
	8262	MLTP0(PRPT ,OPT,ALL) ; Function for multi ple value selection
	8263	"RTN","IBJ DF4",178,0 )
	8264	; Input: PRPT - Str ing to be prompted t o the user , before l isting opt ions
	8265	"RTN","IBJ DF4",179,0 )
	8266	; OPT - Arr ay contain ing the po ssible ent ries (inde xed by cod e)
	8267	"RTN","IBJ DF4",180,0 )
	8268	; Obs : Code mus t be seque ntial star ting with 0
	8269	"RTN","IBJ DF4",181,0 )
	8270	; ALL - Fla g indicati ng if the last optio n is ALL O F THE ABOV E
	8271	"RTN","IBJ DF4",182,0 )
	8272	;
	8273	"RTN","IBJ DF4",183,0 )
	8274	; Output: MLTP - Us er selecti on, i.e. " 1,2,3," or "1," or N ULL (nothi ng
	8275	"RTN","IBJ DF4",184,0 )
	8276	; w as selecte d)
	8277	"RTN","IBJ DF4",185,0 )
	8278	;
	8279	"RTN","IBJ DF4",186,0 )
	8280	N A,DIR,D IRUT,DTOUT ,DUOUT,DIR OUT,I,IX,L ST,MLTP
	8281	"RTN","IBJ DF4",187,0 )
	8282	;
	8283	"RTN","IBJ DF4",188,0 )
	8284	PRPT S MLT P="",ALL=+ $G(ALL)
	8285	"RTN","IBJ DF4",189,0 )
	8286	S LST=$O( OPT(""),-1 )
	8287	"RTN","IBJ DF4",190,0 )
	8288	S DIR(0)= "LO^0:"_LS T_"^K:+$P( X,""-"",2) >"_LST_" X "
	8289	"RTN","IBJ DF4",191,0 )
	8290	S DIR("A" ,1)=$G(PRP T),DIR("A" ,2)=""
	8291	"RTN","IBJ DF4",192,0 )
	8292	S A="",IX =3
	8293	"RTN","IBJ DF4",193,0 )
	8294	F S A=$O (OPT(A)) Q:A="" D
	8295	"RTN","IBJ DF4",194,0 )
	8296	. S DIR(" A",IX)=" "_A_" - " _$G(OPT(A) ),IX=IX+1
	8297	"RTN","IBJ DF4",195,0 )
	8298	S DIR("A" ,IX)="",DI R("A")="Se lect",DIR( "B")=LST,D IR("T")=DT IME W !
	8299	"RTN","IBJ DF4",196,0 )
	8300	D ^DIR K DIR I $D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) G Q T
	8301	"RTN","IBJ DF4",197,0 )
	8302	S MLTP=Y K DIROUT,D TOUT,DUOUT ,DIRUT
	8303	"RTN","IBJ DF4",198,0 )
	8304	;
	8305	"RTN","IBJ DF4",199,0 )
	8306	I ALL,MLT P[LST S ML TP=LST_","
	8307	"RTN","IBJ DF4",200,0 )
	8308	;
	8309	"RTN","IBJ DF4",201,0 )
	8310	S DIR(0)= "Y",DIR("A ",1)="You have selec ted",DIR(" A",2)=""
	8311	"RTN","IBJ DF4",202,0 )
	8312	S A="",IX =3
	8313	"RTN","IBJ DF4",203,0 )
	8314	F I=1:1:( $L(MLTP,", ")-1) D
	8315	"RTN","IBJ DF4",204,0 )
	8316	. S DIR(" A",IX)=" "_$P(MLT P,",",I)_" - "_$G(OP T($P(MLTP, ",",I)))
	8317	"RTN","IBJ DF4",205,0 )
	8318	. S IX=IX +1
	8319	"RTN","IBJ DF4",206,0 )
	8320	S DIR("A" ,IX)=""
	8321	"RTN","IBJ DF4",207,0 )
	8322	S DIR("A" )="Are you sure",DIR ("B")="NO" ,DIR("T")= DTIME W !
	8323	"RTN","IBJ DF4",208,0 )
	8324	D ^DIR K DIR I $D(D IRUT)!$D(D TOUT)!$D(D UOUT)!$D(D IROUT) S M LTP=0 G QT
	8325	"RTN","IBJ DF4",209,0 )
	8326	K DIROUT, DTOUT,DUOU T,DIRUT I 'Y K DIR G PRPT
	8327	"RTN","IBJ DF4",210,0 )
	8328	;
	8329	"RTN","IBJ DF4",211,0 )
	8330	I ALL,MLT P[LST D
	8331	"RTN","IBJ DF4",212,0 )
	8332	. S MLTP= "" F I=(LS T-1):-1:1 S MLTP=I_" ,"_MLTP
	8333	"RTN","IBJ DF4",213,0 )
	8334	;
	8335	"RTN","IBJ DF4",214,0 )
	8336	QT Q MLTP
	8337	"RTN","IBJ DF41")
	8338	0^9^B96102 587
	8339	"RTN","IBJ DF41",1,0)
	8340	IBJDF41 ;A LB/RB - FI RST PARTY FOLLOW-UP REPORT (CO MPILE) ;15 -APR-00
	8341	"RTN","IBJ DF41",2,0)
	8342	;;2.0;INT EGRATED BI LLING;12 3,159,204, 356,451,47 3,568;21 -MAR-94;Bu ild 12
	8343	"RTN","IBJ DF41",3,0)
	8344	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8345	"RTN","IBJ DF41",4,0)
	8346	;
	8347	"RTN","IBJ DF41",5,0)
	8348	ST ; - Tas ked entry point.
	8349	"RTN","IBJ DF41",6,0)
	8350	K IB,IBCA T,^TMP("IB JDF4",$J)
	8351	"RTN","IBJ DF41",7,0)
	8352	S IBQ=0
	8353	"RTN","IBJ DF41",8,0)
	8354	;
	8355	"RTN","IBJ DF41",9,0)
	8356	; - Set s elected ca tegories f or report.
	8357	"RTN","IBJ DF41",10,0 )
	8358	I IBSEL[1 S IBCAT(2 )=1
	8359	"RTN","IBJ DF41",11,0 )
	8360	I IBSEL[2 S IBCAT(4 6)=2
	8361	"RTN","IBJ DF41",12,0 )
	8362	I IBSEL[3 S IBCAT(1 )=3
	8363	"RTN","IBJ DF41",13,0 )
	8364	I IBSEL[4 S IBCAT(4 7)=4
	8365	"RTN","IBJ DF41",14,0 )
	8366	I IBSEL[5 S IBCAT(1 8)=3 F X=2 2,23 S IBC AT(X)=6
	8367	"RTN","IBJ DF41",15,0 )
	8368	I IBSEL[6 F X=33:1: 39 S IBCAT (X)=7
	8369	"RTN","IBJ DF41",16,0 )
	8370	;
	8371	"RTN","IBJ DF41",17,0 )
	8372	; - Print the heade r line for the Excel spreadshe et
	8373	"RTN","IBJ DF41",18,0 )
	8374	I $G(IBEX CEL) D PHD L
	8375	"RTN","IBJ DF41",19,0 )
	8376	;
	8377	"RTN","IBJ DF41",20,0 )
	8378	; - Find data requi red for re port.
	8379	"RTN","IBJ DF41",21,0 )
	8380	F IB=16,1 9,40 D G: IBQ ENQ
	8381	"RTN","IBJ DF41",22,0 )
	8382	. I IBSTA ="A",IB'=1 6 Q ; Active A R's only.
	8383	"RTN","IBJ DF41",23,0 )
	8384	. I IBSTA ="S",IB=16 Q ; Suspende d AR's onl y.
	8385	"RTN","IBJ DF41",24,0 )
	8386	. I IB'=4 0 D
	8387	"RTN","IBJ DF41",25,0 )
	8388	. . S IBC AT=""
	8389	"RTN","IBJ DF41",26,0 )
	8390	. . F S IBCAT=$O(I BCAT(IBCAT )) Q:IBCAT ="" D
	8391	"RTN","IBJ DF41",27,0 )
	8392	. . . D I NIT^IBJDF4 3
	8393	"RTN","IBJ DF41",28,0 )
	8394	. S IBA=0
	8395	"RTN","IBJ DF41",29,0 )
	8396	. F S IB A=$O(^PRCA (430,"AC", IB,IBA)) Q :'IBA D Q:IBQ
	8397	"RTN","IBJ DF41",30,0 )
	8398	. . D PRO C
	8399	"RTN","IBJ DF41",31,0 )
	8400	;
	8401	"RTN","IBJ DF41",32,0 )
	8402	I 'IBQ,'$ G(IBEXCEL) D EN^IBJD F42 ; Prin t the repo rt.
	8403	"RTN","IBJ DF41",33,0 )
	8404	;
	8405	"RTN","IBJ DF41",34,0 )
	8406	ENQ K ^TMP ("IBJDF4", $J)
	8407	"RTN","IBJ DF41",35,0 )
	8408	I $D(ZTQU EUED) S ZT REQ="@" G ENQ1
	8409	"RTN","IBJ DF41",36,0 )
	8410	;
	8411	"RTN","IBJ DF41",37,0 )
	8412	D ^%ZISC
	8413	"RTN","IBJ DF41",38,0 )
	8414	ENQ1 K IB, IB0,IBA,IB A1,IBADM,I BAGE,IBAR, IBAR1,IBBA ,IBBN,IBBU ,IBC,IBCAT ,IBCAT1
	8415	"RTN","IBJ DF41",39,0 )
	8416	K IBELIG, IBEXCEL,IB FLG,IBAI,I BAIQ,IBIDX ,IBIO,IBIN T,IBN,IBPA ,IBPD,IBPA T
	8417	"RTN","IBJ DF41",40,0 )
	8418	K IBPT,IB Q,IBRFD,IB RFT,IBSRC, IBRP,IBVA, COM,COM1,D AT,DFN,X,X 1,X2,Y,Z
	8419	"RTN","IBJ DF41",41,0 )
	8420	Q
	8421	"RTN","IBJ DF41",42,0 )
	8422	;
	8423	"RTN","IBJ DF41",43,0 )
	8424	PROC ; - P rocess dat a for repo rt(s).
	8425	"RTN","IBJ DF41",44,0 )
	8426	I IBA#100 =0 D Q:IB Q
	8427	"RTN","IBJ DF41",45,0 )
	8428	. S IBQ=$ $STOP^IBOU TL("First Party Foll ow-Up Repo rt")
	8429	"RTN","IBJ DF41",46,0 )
	8430	S IBAR=$G (^PRCA(430 ,IBA,0)) I 'IBAR Q
	8431	"RTN","IBJ DF41",47,0 )
	8432	S IBCAT=+ $P(IBAR,U, 2) I '$D(I BCAT(IBCAT )) Q ; Get valid AR category.
	8433	"RTN","IBJ DF41",48,0 )
	8434	I '$$CLMA CT^IBJD(IB A,IBCAT) Q ; Inv alid IB cl aim/action .
	8435	"RTN","IBJ DF41",49,0 )
	8436	I IBSTA=" S" S IBSUS TYP=$$SUST (IBA) I IB SELST'[(IB SUSTYP_"," ) Q ;Filt er by susp ended type IB2568/ DRF
	8437	"RTN","IBJ DF41",50,0 )
	8438	S IBPT=$$ PAT(IBA) I IBPT="" Q ; Get patient i nfo.
	8439	"RTN","IBJ DF41",51,0 )
	8440	S DFN=$P( IBPT,U,2)
	8441	"RTN","IBJ DF41",52,0 )
	8442	S IBAGE=$ $FMDIFF^XL FDT(DT,+$P (IBAR,U,10 ))
	8443	"RTN","IBJ DF41",53,0 )
	8444	I IBSMN,I BAGE<IBSMN !(IBAGE>IB SMX) Q ; AR outside ag e range.
	8445	"RTN","IBJ DF41",54,0 )
	8446	S IBVA=$$ VA^IBJD1(D FN),IBBN=$ P(IBAR,U), IBPD=$P($$ PYMT^IBJD1 (IBA),U)
	8447	"RTN","IBJ DF41",55,0 )
	8448	S IBPAT=$ P(IBPT,U)_ "@@"_DFN
	8449	"RTN","IBJ DF41",56,0 )
	8450	;
	8451	"RTN","IBJ DF41",57,0 )
	8452	; - Check the AR ba lance amou nts, if ne cessary.
	8453	"RTN","IBJ DF41",58,0 )
	8454	S (IBADM, IBBA,IBINT ,IBPA)=0,I BN=$G(^PRC A(430,IBA, 7))
	8455	"RTN","IBJ DF41",59,0 )
	8456	F X=1:1:5 D
	8457	"RTN","IBJ DF41",60,0 )
	8458	. S IBBA= IBBA+$P(IB N,U,X)
	8459	"RTN","IBJ DF41",61,0 )
	8460	. S:X=1 I BPA=+IBN S :X=2 IBINT =$P(IBN,U, 2) S:X=3 I BADM=$P(IB N,U,3)
	8461	"RTN","IBJ DF41",62,0 )
	8462	;
	8463	"RTN","IBJ DF41",63,0 )
	8464	I '$G(IBE XCEL) D EN ^IBJDF43 I IBRPT="S" Q ; Ge t summary stats.
	8465	"RTN","IBJ DF41",64,0 )
	8466	;
	8467	"RTN","IBJ DF41",65,0 )
	8468	I IBSAM,I BBA<IBSAM Q
	8469	"RTN","IBJ DF41",66,0 )
	8470	;
	8471	"RTN","IBJ DF41",67,0 )
	8472	; - Check if AR was referred to R-Regio nal Counse l, D-DMC, or T-TOP
	8473	"RTN","IBJ DF41",68,0 )
	8474	; and e xclude, if necessary .
	8475	"RTN","IBJ DF41",69,0 )
	8476	S IB0=$S( IB=40:19,1 :IB),IBIDX =0,IBRFT=" "
	8477	"RTN","IBJ DF41",70,0 )
	8478	S IBAIQ=0 ,IBAI=$G(^ TMP("IBJDF 4",$J,IBPA T,0,"A"))
	8479	"RTN","IBJ DF41",71,0 )
	8480	S IBRFD=$ P($G(^PRCA (430,IBA,6 )),U,4)
	8481	"RTN","IBJ DF41",72,0 )
	8482	I IBRPT=" D",IBRFD D I IBAIQ Q ; Referred to RC
	8483	"RTN","IBJ DF41",73,0 )
	8484	. S IBRFT ="R" I IBA I'["R" S I BAI=IBAI_" R"
	8485	"RTN","IBJ DF41",74,0 )
	8486	. I 'IBSR C S IBAIQ= 1 Q
	8487	"RTN","IBJ DF41",75,0 )
	8488	. D SREF( "R",IBRFD, IB0,,.IBID X)
	8489	"RTN","IBJ DF41",76,0 )
	8490	S IBRFD=+ $G(^PRCA(4 30,IBA,12) )
	8491	"RTN","IBJ DF41",77,0 )
	8492	I IBRPT=" D",IBRFD D ; Referred to DMC
	8493	"RTN","IBJ DF41",78,0 )
	8494	. S IBRFT =IBRFT_"D" I IBAI'[" D" S IBAI= IBAI_"D"
	8495	"RTN","IBJ DF41",79,0 )
	8496	. D SREF( "D",IBRFD, IB0,,.IBID X)
	8497	"RTN","IBJ DF41",80,0 )
	8498	S IBRFD=+ $G(^PRCA(4 30,IBA,14) )
	8499	"RTN","IBJ DF41",81,0 )
	8500	I IBRPT=" D",IBRFD D ; Referred to TOP
	8501	"RTN","IBJ DF41",82,0 )
	8502	. S IBRFT =IBRFT_"T" I IBAI'[" T" S IBAI= IBAI_"T"
	8503	"RTN","IBJ DF41",83,0 )
	8504	. D SREF( "T",IBRFD, IB0,,.IBID X)
	8505	"RTN","IBJ DF41",84,0 )
	8506	;
	8507	"RTN","IBJ DF41",85,0 )
	8508	; - Check if AR is on P-Repay ment plan or F-Defau lted repay ment plan.
	8509	"RTN","IBJ DF41",86,0 )
	8510	; and e xclude if repayment plan is ac tive.
	8511	"RTN","IBJ DF41",87,0 )
	8512	S IBRP=$$ RP(IBA)
	8513	"RTN","IBJ DF41",88,0 )
	8514	I IBRP D
	8515	"RTN","IBJ DF41",89,0 )
	8516	. I IBRP= 2 S IBRFT= IBRFT_"F" I IBAI'[" F" S IBAI= IBAI_"F"
	8517	"RTN","IBJ DF41",90,0 )
	8518	. I IBRP= 1 S IBRFT= IBRFT_"P" I IBAI'["P "&(IBAI'[" F") S IBAI =IBAI_"P"
	8519	"RTN","IBJ DF41",91,0 )
	8520	. D SREF( "P",$P(IBR P,"^",2),I B0,$S(+IBR P=2:1,1:0) ,.IBIDX)
	8521	"RTN","IBJ DF41",92,0 )
	8522	;
	8523	"RTN","IBJ DF41",93,0 )
	8524	I IBIDX S IBFLG=1
	8525	"RTN","IBJ DF41",94,0 )
	8526	;
	8527	"RTN","IBJ DF41",95,0 )
	8528	; - Check if VA Emp loyee
	8529	"RTN","IBJ DF41",96,0 )
	8530	I $P(IBVA ,"^")["*", IBAI'["V" S IBAI=IBA I_"V"
	8531	"RTN","IBJ DF41",97,0 )
	8532	;
	8533	"RTN","IBJ DF41",98,0 )
	8534	I IBAI'=" " S ^TMP(" IBJDF4",$J ,IBPAT,0," A")=IBAI
	8535	"RTN","IBJ DF41",99,0 )
	8536	;
	8537	"RTN","IBJ DF41",100, 0)
	8538	; IB2.0 451 - Chec k for EEOB on associ ated 3rd p arty bills and attac h EOB indi cator '%' if applica ble
	8539	"RTN","IBJ DF41",101, 0)
	8540	S IBBN=$$ IBEEOBCK(I BBN,DFN)_I BBN ; Pas s AR BILL# , Pat ID
	8541	"RTN","IBJ DF41",102, 0)
	8542	;
	8543	"RTN","IBJ DF41",103, 0)
	8544	; - Set u p indexes for detail report.
	8545	"RTN","IBJ DF41",104, 0)
	8546	I $G(IBEX CEL) D Q
	8547	"RTN","IBJ DF41",105, 0)
	8548	. S IBEXC EL1=$P($G( ^PRCA(430. 2,IBCAT,0) ),U,2)_U_$ P(IBPT,U,3 )_U_$P(IBV A,U)_U_$P( IBPT,U,4)_ U_$$DT^IBJ D($P(IBPT, U,6),1)_U_ $$ELIG^IBJ DF42(+$P(I BPT,U,5))_ U
	8549	"RTN","IBJ DF41",106, 0)
	8550	. S IBEXC EL1=IBEXCE L1_$$GET1^ DIQ(2,DFN, .381)_U_$$ MTRX(DFN)_ U_IBBN_U_$ S(IB=16:"A ",1:"S")_U _IBRFT_U_$ $DT^IBJD($ P(IBAR,U,1 0),1)_U_$$ DT^IBJD(IB PD,1)_U_IB BA_U_IBPA_ U_IBINT_U_ IBADM_U
	8551	"RTN","IBJ DF41",107, 0)
	8552	. I IBSH D COM
	8553	"RTN","IBJ DF41",108, 0)
	8554	. S IBD=0 I DAT!IBP D S IBD=$$ FMDIFF^XLF DT(DT,$S(' DAT:IBPD,1 :$G(DAT)))
	8555	"RTN","IBJ DF41",109, 0)
	8556	. S IBEXC EL1=IBEXCE L1_U_IBD
	8557	"RTN","IBJ DF41",110, 0)
	8558	. I IBSTA ="S" S IBE XCEL1=IBEX CEL1_U_IBS USTYP
	8559	"RTN","IBJ DF41",111, 0)
	8560	. W !,IBE XCEL1 K IB D,IBEXCEL1
	8561	"RTN","IBJ DF41",112, 0)
	8562	;
	8563	"RTN","IBJ DF41",113, 0)
	8564	I '($D(^T MP("IBJDF4 ",$J,IBPAT ))#10) D
	8565	"RTN","IBJ DF41",114, 0)
	8566	. S ^TMP( "IBJDF4",$ J,IBPAT)=$ P(IBPT,U,3 ,5)_U_$$MT RX(DFN)_U_ $P(IBPT,U, 6)_"^"_$P( IBVA,"^",2 )_"^"_$$AC CBAL($P(IB PT,U,7))
	8567	"RTN","IBJ DF41",115, 0)
	8568	S ^TMP("I BJDF4",$J, IBPAT,IB0, IBCAT,IBBN )=IBPD_U_I BBA_U_IBPA _U_IBINT_U _IBADM_U_I BIDX
	8569	"RTN","IBJ DF41",116, 0)
	8570	;
	8571	"RTN","IBJ DF41",117, 0)
	8572	I IBSH D COM
	8573	"RTN","IBJ DF41",118, 0)
	8574	Q
	8575	"RTN","IBJ DF41",119, 0)
	8576	;
	8577	"RTN","IBJ DF41",120, 0)
	8578	ACCBAL(DFN ) ; Calcul ates the A ccount Bal ance for t he Bill
	8579	"RTN","IBJ DF41",121, 0)
	8580	; Input: DFN - Pati ent/Debtor internal number
	8581	"RTN","IBJ DF41",122, 0)
	8582	; Output: BAL - Pat ient/Debto r Account Balance
	8583	"RTN","IBJ DF41",123, 0)
	8584	;
	8585	"RTN","IBJ DF41",124, 0)
	8586	N B0,B7,B AL,BILL,I
	8587	"RTN","IBJ DF41",125, 0)
	8588	S (BAL,BI LL)=0
	8589	"RTN","IBJ DF41",126, 0)
	8590	F S BILL =$O(^PRCA( 430,"C",DF N,BILL)) Q :BILL="" D
	8591	"RTN","IBJ DF41",127, 0)
	8592	. S B0=$G (^PRCA(430 ,BILL,0)) I $P(B0,"^ ",8)'=16 Q
	8593	"RTN","IBJ DF41",128, 0)
	8594	. S B7=$G (^PRCA(430 ,BILL,7))
	8595	"RTN","IBJ DF41",129, 0)
	8596	. F I=1:1 :5 S BAL=B AL+$P(B7," ^",I)
	8597	"RTN","IBJ DF41",130, 0)
	8598	Q BAL
	8599	"RTN","IBJ DF41",131, 0)
	8600	;
	8601	"RTN","IBJ DF41",132, 0)
	8602	PHDL ; - P rint the h eader line for the E xcel sprea dsheet
	8603	"RTN","IBJ DF41",133, 0)
	8604	N X
	8605	"RTN","IBJ DF41",134, 0)
	8606	S X="Cat^ Patient^VA Empl.?^SS N^Dt Death ^Prim.Elig .^Med.Elig .?^"
	8607	"RTN","IBJ DF41",135, 0)
	8608	S X=X_"Me ans Tst St s^Means Ts t Dt^RX Co pay Exemp. Sts^RX Cop ay Exemp.D t^"
	8609	"RTN","IBJ DF41",136, 0)
	8610	S X=X_"Bi ll #^Act/S usp^Refer. to^Dt Bil l prep.^La st Pymt Dt ^"
	8611	"RTN","IBJ DF41",137, 0)
	8612	S X=X_"Cu rr.Bal.^Pr inc.Bal.^I nt.^Admin. ^Last Comm .Dt^Days L st Comm.^"
	8613	"RTN","IBJ DF41",138, 0)
	8614	I IBSTA=" S" S X=X_" Susp.Rsn" ; IB2.05 68/DRF Add suspended reson to Excel outp ut
	8615	"RTN","IBJ DF41",139, 0)
	8616	W !,X
	8617	"RTN","IBJ DF41",140, 0)
	8618	Q
	8619	"RTN","IBJ DF41",141, 0)
	8620	;
	8621	"RTN","IBJ DF41",142, 0)
	8622	PAT(X) ; - Find the AR patient and decid e to inclu de the AR.
	8623	"RTN","IBJ DF41",143, 0)
	8624	; Inpu t: X=AR po inter to f ile #430 a nd pre-set variables IBS*
	8625	"RTN","IBJ DF41",144, 0)
	8626	; Outpu t: Y=Sort key (name or last 4) ^ Patient pointer t o file #2
	8627	"RTN","IBJ DF41",145, 0)
	8628	; ^ Nam e ^ SSN ^ Eligibilit ies ^ Date of death (if any)
	8629	"RTN","IBJ DF41",146, 0)
	8630	; ^ Deb tor pointe r to file #340
	8631	"RTN","IBJ DF41",147, 0)
	8632	N PAT,KEY ,DBTR,DFN, DEATH,NAME ,SSN,VAEL, VADM,X1,X2
	8633	"RTN","IBJ DF41",148, 0)
	8634	S PAT="" G:'$G(X) P ATQ
	8635	"RTN","IBJ DF41",149, 0)
	8636	S DBTR=+$ P($G(^PRCA (430,X,0)) ,U,9)
	8637	"RTN","IBJ DF41",150, 0)
	8638	S X1=$P($ G(^RCD(340 ,DBTR,0)), U) G:X1'[" DPT" PATQ
	8639	"RTN","IBJ DF41",151, 0)
	8640	S DFN=+X1 G:'DFN PA TQ D DEM^V ADPT
	8641	"RTN","IBJ DF41",152, 0)
	8642	S NAME=VA DM(1),SSN= $P(VADM(2) ,"^"),DEAT H=VADM(6)\ 1
	8643	"RTN","IBJ DF41",153, 0)
	8644	S KEY=$S( IBSN="N":N AME,1:$E(S SN,6,9))
	8645	"RTN","IBJ DF41",154, 0)
	8646	I KEY=""! (IBSNF'="@ "&('DFN)) G PATQ
	8647	"RTN","IBJ DF41",155, 0)
	8648	I $D(IBSN A) G:IBSNA ="ALL"&('D FN) PATQ G :IBSNA="NU LL"&(DFN) PATQ
	8649	"RTN","IBJ DF41",156, 0)
	8650	I $G(IBSN A)="ALL" G PATC
	8651	"RTN","IBJ DF41",157, 0)
	8652	I IBSNF=" @",IBSNL=" zzzzz" G P ATC
	8653	"RTN","IBJ DF41",158, 0)
	8654	I IBSNF'= KEY,IBSNF] KEY G PATQ
	8655	"RTN","IBJ DF41",159, 0)
	8656	I IBSNL'= KEY,KEY]IB SNL G PATQ
	8657	"RTN","IBJ DF41",160, 0)
	8658	;
	8659	"RTN","IBJ DF41",161, 0)
	8660	PATC ; - S et patient eligibili ties.
	8661	"RTN","IBJ DF41",162, 0)
	8662	D ELIG^VA DPT S X2=+ $G(VAEL(1) )_";"
	8663	"RTN","IBJ DF41",163, 0)
	8664	I +X2 S X 1=0 F S X 1=$O(VAEL( 1,X1)) Q:' X1 S X2=X 2_X1_";"
	8665	"RTN","IBJ DF41",164, 0)
	8666	;
	8667	"RTN","IBJ DF41",165, 0)
	8668	S PAT=KEY _U_DFN_U_$ E(NAME,1,2 6)_U_SSN_U _X2_U_DEAT H
	8669	"RTN","IBJ DF41",166, 0)
	8670	S PAT=PAT _U_DBTR
	8671	"RTN","IBJ DF41",167, 0)
	8672	PATQ Q PAT
	8673	"RTN","IBJ DF41",168, 0)
	8674	;
	8675	"RTN","IBJ DF41",169, 0)
	8676	RP(X) ; - Check if c laim/recei vable is u nder a rep ayment pla n.
	8677	"RTN","IBJ DF41",170, 0)
	8678	; Inpu t: X=Bill pointer to file #399 /#430
	8679	"RTN","IBJ DF41",171, 0)
	8680	; Outpu t: 0-Not o n repay pl an, 1-On r epay plan, 2-On defa ulted plan
	8681	"RTN","IBJ DF41",172, 0)
	8682	N Z
	8683	"RTN","IBJ DF41",173, 0)
	8684	S Z=$$REP DATA^RCBEC HGA(X,1) I Z="" Q 0
	8685	"RTN","IBJ DF41",174, 0)
	8686	I '$P(Z," ^",7) Q (" 1^"_$P(Z," ^"))
	8687	"RTN","IBJ DF41",175, 0)
	8688	Q ("2^"_$ P(Z,"^"))
	8689	"RTN","IBJ DF41",176, 0)
	8690	;
	8691	"RTN","IBJ DF41",177, 0)
	8692	MTRX(X) ; - Return p atient's m eans test and/or RX copay stat us and mos t recent
	8693	"RTN","IBJ DF41",178, 0)
	8694	; test dates for both.
	8695	"RTN","IBJ DF41",179, 0)
	8696	; Inpu t: X=Patie nt pointer to file # 2 and opt. variable IBEXCEL
	8697	"RTN","IBJ DF41",180, 0)
	8698	; Outpu t: Y=Means test stat us ^ Date ^ RX copay status ^ Date
	8699	"RTN","IBJ DF41",181, 0)
	8700	N MTST,RX ST,Y
	8701	"RTN","IBJ DF41",182, 0)
	8702	S Y="^^^" ,MTST=$$LS T^DGMTU(X) ,RXST=$$RX ST^IBARXEU (X)
	8703	"RTN","IBJ DF41",183, 0)
	8704	I '$G(IBE XCEL) D
	8705	"RTN","IBJ DF41",184, 0)
	8706	. S $P(Y, "^",1,2)=$ P(MTST,"^" ,3)_"^"_$$ DAT1^IBOUT L($P(MTST, "^",2))
	8707	"RTN","IBJ DF41",185, 0)
	8708	. S $P(Y, "^",3)=$S( 'RXST:"NON -EXEMPT",+ RXST=1:"EX EMPT",1:"" )
	8709	"RTN","IBJ DF41",186, 0)
	8710	. I $P(Y, "^",3)'="" S $P(Y,"^ ",4)=$$DAT 1^IBOUTL($ P(RXST,"^" ,5))
	8711	"RTN","IBJ DF41",187, 0)
	8712	I $G(IBEX CEL) D
	8713	"RTN","IBJ DF41",188, 0)
	8714	. S $P(Y, "^",1,2)=$ P(MTST,"^" ,4)_"^"_$$ DT^IBJD($P (MTST,"^", 2),1)
	8715	"RTN","IBJ DF41",189, 0)
	8716	. S $P(Y, "^",3)=$S( 'RXST:"M", +RXST=1:"E ",1:"")
	8717	"RTN","IBJ DF41",190, 0)
	8718	. I $P(Y, "^",3)'="" S $P(Y,"^ ",4)=$$DT^ IBJD($P(RX ST,"^",5), 1)
	8719	"RTN","IBJ DF41",191, 0)
	8720	Q Y
	8721	"RTN","IBJ DF41",192, 0)
	8722	;
	8723	"RTN","IBJ DF41",193, 0)
	8724	SREF(RFT,D AT,STS,DEF ,IDX) ; Se t the "ref erred to" informatio n on the
	8725	"RTN","IBJ DF41",194, 0)
	8726	; tem porary glo bal ^TMP
	8727	"RTN","IBJ DF41",195, 0)
	8728	;Input: R FT: "R": R C, "D": DM C, "T": TO P, "P": RE PAYMENT PL AN
	8729	"RTN","IBJ DF41",196, 0)
	8730	; D AT: Date i t was refe rred/estab lished
	8731	"RTN","IBJ DF41",197, 0)
	8732	; S TS: Receiv able statu s (16-Acti ve,19-Susp ended)
	8733	"RTN","IBJ DF41",198, 0)
	8734	; D EF: Repaym ent Plan i n Default? (1 - YES, 0 - NO)
	8735	"RTN","IBJ DF41",199, 0)
	8736	; I DX: Subscr ipt to be set in the Temporary global ^T MP
	8737	"RTN","IBJ DF41",200, 0)
	8738	;Output: IDX: Subsc ript set i n the Temp orary glob al ^TMP
	8739	"RTN","IBJ DF41",201, 0)
	8740	;
	8741	"RTN","IBJ DF41",202, 0)
	8742	N SREF,ID X1
	8743	"RTN","IBJ DF41",203, 0)
	8744	S DEF=+$G (DEF),IDX= +$G(IDX)
	8745	"RTN","IBJ DF41",204, 0)
	8746	I RFT="R" S SREF="R EFERRED TO RC"
	8747	"RTN","IBJ DF41",205, 0)
	8748	I RFT="D" S SREF="R EFERRED TO DMC"
	8749	"RTN","IBJ DF41",206, 0)
	8750	I RFT="T" S SREF="R EFERRED TO TOP"
	8751	"RTN","IBJ DF41",207, 0)
	8752	I RFT="P" D
	8753	"RTN","IBJ DF41",208, 0)
	8754	. S SREF= "REPAYMENT PLAN ESTA BLISHED"
	8755	"RTN","IBJ DF41",209, 0)
	8756	. I $G(DE F) S SREF= SREF_" (CU RRENTLY IN DEFAULT)"
	8757	"RTN","IBJ DF41",210, 0)
	8758	;
	8759	"RTN","IBJ DF41",211, 0)
	8760	I 'IDX S IDX=$O(^TM P("IBJDF4" ,$J,IBPAT, 0,"C",STS, ""),-1)+1
	8761	"RTN","IBJ DF41",212, 0)
	8762	S IDX1=$O (^TMP("IBJ DF4",$J,IB PAT,0,"C", STS,IDX,"" ),-1)+1
	8763	"RTN","IBJ DF41",213, 0)
	8764	S ^TMP("I BJDF4",$J, IBPAT,0,"C ",STS,IDX, IDX1)=DAT
	8765	"RTN","IBJ DF41",214, 0)
	8766	S ^TMP("I BJDF4",$J, IBPAT,0,"C ",STS,IDX, IDX1,1)=SR EF
	8767	"RTN","IBJ DF41",215, 0)
	8768	Q
	8769	"RTN","IBJ DF41",216, 0)
	8770	;
	8771	"RTN","IBJ DF41",217, 0)
	8772	COM ; - Ge t bill com ments.
	8773	"RTN","IBJ DF41",218, 0)
	8774	I 'IBIDX, '$G(IBEXCE L) D
	8775	"RTN","IBJ DF41",219, 0)
	8776	. S IBFLG =0,IBIDX=$ O(^TMP("IB JDF4",$J,I BPAT,0,"C" ,IB0,""),- 1)+1
	8777	"RTN","IBJ DF41",220, 0)
	8778	;
	8779	"RTN","IBJ DF41",221, 0)
	8780	S DAT=0,I BA1=$S(IBS H1="M":999 999999,1:0 )
	8781	"RTN","IBJ DF41",222, 0)
	8782	F S IBA1 =$S(IBSH1= "M":$O(^PR CA(433,"C" ,IBA,IBA1) ,-1),1:$O( ^PRCA(433, "C",IBA,IB A1))) Q:'I BA1 D I IBSH1="M", DAT Q
	8783	"RTN","IBJ DF41",223, 0)
	8784	. S IBC=$ G(^PRCA(43 3,IBA1,1)) Q:'IBC
	8785	"RTN","IBJ DF41",224, 0)
	8786	. I $G(IB SH2),$$FMD IFF^XLFDT( DT,+IBC)>I BSH2 Q ; Comment ag e not mini mum.
	8787	"RTN","IBJ DF41",225, 0)
	8788	. I $P(IB C,U,2)'=35 ,$P(IBC,U, 2)'=45 Q ; Not de crease/com ment trans act.
	8789	"RTN","IBJ DF41",226, 0)
	8790	. S DAT=$ S(IBC:+IBC \1,1:+$P(I BC,U,9)\1)
	8791	"RTN","IBJ DF41",227, 0)
	8792	. I $G(IB EXCEL),IBS H1="M" S I BEXCEL1=IB EXCEL1_$$D T^IBJD(DAT ,1) Q
	8793	"RTN","IBJ DF41",228, 0)
	8794	. ;
	8795	"RTN","IBJ DF41",229, 0)
	8796	. ; - App end brief and transa ction comm ents.
	8797	"RTN","IBJ DF41",230, 0)
	8798	. K COM,C OM1 S COM( 0)=DAT,X1= 0
	8799	"RTN","IBJ DF41",231, 0)
	8800	. S COM1( 1)=$P($G(^ PRCA(433,I BA1,5)),U, 2)
	8801	"RTN","IBJ DF41",232, 0)
	8802	. S COM1( 2)=$E($P($ G(^PRCA(43 3,IBA1,8)) ,U,6),1,70 )
	8803	"RTN","IBJ DF41",233, 0)
	8804	. S COM(1 )=COM1(1)_ $S(COM1(1) ]""&(COM1( 2)]""):"\|" ,1:"")_COM 1(2)
	8805	"RTN","IBJ DF41",234, 0)
	8806	. I COM(1 )]"" S COM (1)=""_C OM(1)_"" ,X1=1
	8807	"RTN","IBJ DF41",235, 0)
	8808	. ;
	8809	"RTN","IBJ DF41",236, 0)
	8810	. ; - Get main comm ents.
	8811	"RTN","IBJ DF41",237, 0)
	8812	. S X2=0
	8813	"RTN","IBJ DF41",238, 0)
	8814	. F S X2 =$O(^PRCA( 433,IBA1,7 ,X2)) Q:'X 2 D
	8815	"RTN","IBJ DF41",239, 0)
	8816	. . S COM ($S(X1:X2+ 1,1:X2))=^ PRCA(433,I BA1,7,X2,0 )
	8817	"RTN","IBJ DF41",240, 0)
	8818	. ;
	8819	"RTN","IBJ DF41",241, 0)
	8820	. I $G(IB EXCEL) Q
	8821	"RTN","IBJ DF41",242, 0)
	8822	. ;
	8823	"RTN","IBJ DF41",243, 0)
	8824	. S IBFLG =1,^TMP("I BJDF4",$J, IBPAT,0,"C ",IB0,IBID X,IBA1)=$G (COM(0)),X 1=0
	8825	"RTN","IBJ DF41",244, 0)
	8826	. F S X1 =$O(COM(X1 )) Q:X1="" D
	8827	"RTN","IBJ DF41",245, 0)
	8828	. . S ^TM P("IBJDF4" ,$J,IBPAT, 0,"C",IB0, IBIDX,IBA1 ,X1)=COM(X 1)
	8829	"RTN","IBJ DF41",246, 0)
	8830	;
	8831	"RTN","IBJ DF41",247, 0)
	8832	I '$G(IBE XCEL),IBFL G D
	8833	"RTN","IBJ DF41",248, 0)
	8834	. S $P(^T MP("IBJDF4 ",$J,IBPAT ,IB0,IBCAT ,IBBN),"^" ,6)=IBIDX
	8835	"RTN","IBJ DF41",249, 0)
	8836	Q
	8837	"RTN","IBJ DF41",250, 0)
	8838	; IB2.0 451 - Use Event Dat e to find an associa ted 3rd Pa rty bill w ith an ass ociated EE OB
	8839	"RTN","IBJ DF41",251, 0)
	8840	IBEEOBCK(I BBN,DFN) ; Passed AR Bill, Pat ient ID
	8841	"RTN","IBJ DF41",252, 0)
	8842	; Functio n will qui t as soon as a 3rd p arty bill is located that has an associa ted EEOB
	8843	"RTN","IBJ DF41",253, 0)
	8844	;
	8845	"RTN","IBJ DF41",254, 0)
	8846	; Find 3r d Party Bi lls with a n Event Da te
	8847	"RTN","IBJ DF41",255, 0)
	8848	N IBREF,I BEEOB,IBDT
	8849	"RTN","IBJ DF41",256, 0)
	8850	S IBEEOB= ""
	8851	"RTN","IBJ DF41",257, 0)
	8852	; Loop th rough Xref of ARbill (#430) to Action fi le (#350)
	8853	"RTN","IBJ DF41",258, 0)
	8854	I +$G(IBB N) S IBREF =0 F S IB REF=$O(^IB ("ABIL",IB BN,IBREF)) Q:'IBREF D Q:IBEE OB="%"
	8855	"RTN","IBJ DF41",259, 0)
	8856	. S IBDT= $P($G(^IB( IBREF,0)), "^",17) ;G et event D ate
	8857	"RTN","IBJ DF41",260, 0)
	8858	. I IBDT S IBEEOB=$ $TPEVDT(DF N,IBDT)
	8859	"RTN","IBJ DF41",261, 0)
	8860	. I IBDT S IBEEOB=$ $TPOPV(DFN ,IBDT)
	8861	"RTN","IBJ DF41",262, 0)
	8862	;
	8863	"RTN","IBJ DF41",263, 0)
	8864	Q IBEEOB
	8865	"RTN","IBJ DF41",264, 0)
	8866	;
	8867	"RTN","IBJ DF41",265, 0)
	8868	; IB2.0 451 - Trav erse all T HIRD PARTY bills for a patient with a sp ecific Eve nt Date (3 99,.03)
	8869	"RTN","IBJ DF41",266, 0)
	8870	TPEVDT(DFN ,EVDT) ;
	8871	"RTN","IBJ DF41",267, 0)
	8872	; Functio n will qui t as soon as a 3rd p arty bill is located that has an associa ted EEOB
	8873	"RTN","IBJ DF41",268, 0)
	8874	; IB2.0 473 - Use the 399,"A PDT" (by p atient) in dex instea d of the 3 99,"D" ind ex for eff iciency
	8875	"RTN","IBJ DF41",269, 0)
	8876	I '$G(DFN )!'$G(EVDT ) Q ""
	8877	"RTN","IBJ DF41",270, 0)
	8878	N IBIFN,I BEEOB
	8879	"RTN","IBJ DF41",271, 0)
	8880	S IBEEOB= "",IBIFN=" "
	8881	"RTN","IBJ DF41",272, 0)
	8882	F S IBIF N=$O(^DGCR (399,"APDT ",DFN,IBIF N),-1) Q:' IBIFN D Q:IBEEOB=" %"
	8883	"RTN","IBJ DF41",273, 0)
	8884	. I $D(^D GCR(399,"A PDT",DFN,I BIFN,99999 99-EVDT)) S IBEEOB=$ $EEOBCK(IB IFN)
	8885	"RTN","IBJ DF41",274, 0)
	8886	Q IBEEOB
	8887	"RTN","IBJ DF41",275, 0)
	8888	;
	8889	"RTN","IBJ DF41",276, 0)
	8890	; IB2.0 451 - Trav erse all T HIRD PARTY bills for a patient with any Opt Visit Dates same as Event Date (399, 43)
	8891	"RTN","IBJ DF41",277, 0)
	8892	TPOPV(DFN, EVDT) ;
	8893	"RTN","IBJ DF41",278, 0)
	8894	; Functio n will qui t as soon as a 3rd p arty bill is located that has an associa ted EEOB
	8895	"RTN","IBJ DF41",279, 0)
	8896	N IBIFN,I BEEOB
	8897	"RTN","IBJ DF41",280, 0)
	8898	S IBEEOB= ""
	8899	"RTN","IBJ DF41",281, 0)
	8900	I +$G(DFN ),+$G(EVDT ) S IBIFN= 0 F S IBI FN=$O(^DGC R(399,"AOP V",DFN,EVD T,IBIFN)) Q:'IBIFN D Q:IBEEO B="%"
	8901	"RTN","IBJ DF41",282, 0)
	8902	. ; attac h EOB indi cator '%' to bill # when appli cable
	8903	"RTN","IBJ DF41",283, 0)
	8904	. S IBEEO B=$$EEOBCK (IBIFN)
	8905	"RTN","IBJ DF41",284, 0)
	8906	Q IBEEOB
	8907	"RTN","IBJ DF41",285, 0)
	8908	;
	8909	"RTN","IBJ DF41",286, 0)
	8910	; IB2.0 451 - Chec k for EEOB indicator
	8911	"RTN","IBJ DF41",287, 0)
	8912	EEOBCK(IBB ILL) ;
	8913	"RTN","IBJ DF41",288, 0)
	8914	; Check f or 1st and 3rd party payment a ctivity on bill
	8915	"RTN","IBJ DF41",289, 0)
	8916	; IBBILL is the IEN for the b ill # in f iles #399/ #430 and m ust be val id,
	8917	"RTN","IBJ DF41",290, 0)
	8918	; check t he EOB typ e and excl ude it if it is an M RA. Otherw ise,
	8919	"RTN","IBJ DF41",291, 0)
	8920	; returns the EEOB indicator '%' if pay ment activ ity was fo und.
	8921	"RTN","IBJ DF41",292, 0)
	8922	; Access to file #3 61.1 cover ed by IA # 4051.
	8923	"RTN","IBJ DF41",293, 0)
	8924	; Access to file #3 99 covered by IA #38 20.
	8925	"RTN","IBJ DF41",294, 0)
	8926	N IBOUT,I BVAL,Z
	8927	"RTN","IBJ DF41",295, 0)
	8928	I $G(IBBI LL)=0 Q ""
	8929	"RTN","IBJ DF41",296, 0)
	8930	I '$O(^IB M(361.1,"B ",IBBILL,0 )) Q "" ; no entry here
	8931	"RTN","IBJ DF41",297, 0)
	8932	I $P($G(^ DGCR(399,I BBILL,0)), "^",13)=1 Q "" ;avo id 'ENTERE D/NOT REVI EWED' stat us
	8933	"RTN","IBJ DF41",298, 0)
	8934	; handle both singl e and mult iple bill entries in file #361 .1
	8935	"RTN","IBJ DF41",299, 0)
	8936	S Z=0 F S Z=$O(^IB M(361.1,"B ",IBBILL,Z )) Q:'Z D Q:$G(IBO UT)="%"
	8937	"RTN","IBJ DF41",300, 0)
	8938	. S IBVAL =$G(^IBM(3 61.1,Z,0))
	8939	"RTN","IBJ DF41",301, 0)
	8940	. S IBOUT =$S($P(IBV AL,"^",4)= 1:"",$P(IB VAL,"^",4) =0:"%",1:" ")
	8941	"RTN","IBJ DF41",302, 0)
	8942	Q IBOUT ; EOB indi cator for either 1st or 3rd pa rty paymen t on bill
	8943	"RTN","IBJ DF41",303, 0)
	8944	;
	8945	"RTN","IBJ DF41",304, 0)
	8946	;
	8947	"RTN","IBJ DF41",305, 0)
	8948	SUST(IBA) ;Look for suspended type for a suspended bill IB2 568/DRF
	8949	"RTN","IBJ DF41",306, 0)
	8950	N TRANS,S T
	8951	"RTN","IBJ DF41",307, 0)
	8952	S ST=""
	8953	"RTN","IBJ DF41",308, 0)
	8954	S TRANS=$ O(^PRCA(43 3,"C",IBA, ""),-1)
	8955	"RTN","IBJ DF41",309, 0)
	8956	S ST=$P($ G(^PRCA(43 3,TRANS,1) ),U,11)
	8957	"RTN","IBJ DF41",310, 0)
	8958	I ST="" S ST="NONE"
	8959	"RTN","IBJ DF41",311, 0)
	8960	Q ST
	8961	"RTN","IBJ DF42")
	8962	0^10^B5586 9087
	8963	"RTN","IBJ DF42",1,0)
	8964	IBJDF42 ;A LB/RB - FI RST PARTY FOLLOW-UP REPORT (PR INT);15-AP R-00
	8965	"RTN","IBJ DF42",2,0)
	8966	;;2.0;INT EGRATED BI LLING;*12 3,204,568 *;21-MAR-9 4;Build 12
	8967	"RTN","IBJ DF42",3,0)
	8968	;Per VA D irective 6 402, this routine sh ould not b e modified .
	8969	"RTN","IBJ DF42",4,0)
	8970	;
	8971	"RTN","IBJ DF42",5,0)
	8972	EN ; - Pri nt the Fol low-up rep ort.
	8973	"RTN","IBJ DF42",6,0)
	8974	;
	8975	"RTN","IBJ DF42",7,0)
	8976	S IBCT(1) ="INELIGIB LE",IBCT(2 )="EMERG/H UMAN.",IBC T(18)="C M EANS TEST"
	8977	"RTN","IBJ DF42",8,0)
	8978	S IBCT(22 )="RX COPA Y/SC",IBCT (23)="RX C OPAY/NSC"
	8979	"RTN","IBJ DF42",9,0)
	8980	S IBCT(33 )="ADHC LT C"
	8981	"RTN","IBJ DF42",10,0 )
	8982	S IBCT(34 )="DOM LTC "
	8983	"RTN","IBJ DF42",11,0 )
	8984	S IBCT(35 )="RESPITE INPT LTC"
	8985	"RTN","IBJ DF42",12,0 )
	8986	S IBCT(36 )="RESPITE OPT LTC"
	8987	"RTN","IBJ DF42",13,0 )
	8988	S IBCT(37 )="GERIATR IC INPT LT C"
	8989	"RTN","IBJ DF42",14,0 )
	8990	S IBCT(38 )="GERIATR IC OPT LTC "
	8991	"RTN","IBJ DF42",15,0 )
	8992	S IBCT(39 )="NURSING HOME LTC"
	8993	"RTN","IBJ DF42",16,0 )
	8994	S IBCT(46 )="EMERG/H UMAN. RMB"
	8995	"RTN","IBJ DF42",17,0 )
	8996	S IBCT(47 )="INELIGI BLE RMB"
	8997	"RTN","IBJ DF42",18,0 )
	8998	;
	8999	"RTN","IBJ DF42",19,0 )
	9000	S IBQ=0 D NOW^%DTC S IBRUN=$$ DAT2^IBOUT L(%) G:IBR PT="S" SUM
	9001	"RTN","IBJ DF42",20,0 )
	9002	S IBPRTFL G=0 D DET D PAUSE:'I BPRTFLG I IBQ!'IBPRT FLG G ENQ
	9003	"RTN","IBJ DF42",21,0 )
	9004	;
	9005	"RTN","IBJ DF42",22,0 )
	9006	D PAUSE I IBQ G ENQ
	9007	"RTN","IBJ DF42",23,0 )
	9008	;
	9009	"RTN","IBJ DF42",24,0 )
	9010	SUM I 'IBQ D PRT^IBJ DF43 ; Pri nt summary .
	9011	"RTN","IBJ DF42",25,0 )
	9012	ENQ K IB0, IBAI,IBC,I BCAT,IBCD, IBC1,IBC2, IBCT,IBCNT ,IBN,IBP,I BPAG,IBQ,I BRUN,IBS
	9013	"RTN","IBJ DF42",26,0 )
	9014	K IBST,IB TOT,%,DFN, IBPRTFLG
	9015	"RTN","IBJ DF42",27,0 )
	9016	Q
	9017	"RTN","IBJ DF42",28,0 )
	9018	;
	9019	"RTN","IBJ DF42",29,0 )
	9020	DET ; - Pr int report for a spe cific cate gory.
	9021	"RTN","IBJ DF42",30,0 )
	9022	;
	9023	"RTN","IBJ DF42",31,0 )
	9024	D HDR1 G: IBQ DETQ
	9025	"RTN","IBJ DF42",32,0 )
	9026	S (IBPT,I B,IBCAT,IB 0)=""
	9027	"RTN","IBJ DF42",33,0 )
	9028	F S IBPT =$O(^TMP(" IBJDF4",$J ,IBPT)) Q: IBPT="" D Q:IBQ
	9029	"RTN","IBJ DF42",34,0 )
	9030	. I $O(^T MP("IBJDF4 ",$J,IBPT, 0))="" Q
	9031	"RTN","IBJ DF42",35,0 )
	9032	. S IBP=$ G(^TMP("IB JDF4",$J,I BPT))
	9033	"RTN","IBJ DF42",36,0 )
	9034	. I $Y>(I OSL-14) D PAUSE Q:IB Q D HDR1 Q:IBQ
	9035	"RTN","IBJ DF42",37,0 )
	9036	. D WPAT
	9037	"RTN","IBJ DF42",38,0 )
	9038	. F IB=16 ,19 D Q:I BQ
	9039	"RTN","IBJ DF42",39,0 )
	9040	. . I IBS TA="A",IB' =16 Q
	9041	"RTN","IBJ DF42",40,0 )
	9042	. . I IBS TA="S",IB= 16 Q
	9043	"RTN","IBJ DF42",41,0 )
	9044	. . I '$D (^TMP("IBJ DF4",$J,IB PT,IB)) D Q
	9045	"RTN","IBJ DF42",42,0 )
	9046	. . . I $ Y>(IOSL-5) D PAUSE Q :IBQ D HD R1,WPAT,HD R2 Q:IBQ
	9047	"RTN","IBJ DF42",43,0 )
	9048	. . . W ! ,"-> NO "_ $S(IB=16:" ACTIVE",1: "SUSPENDED ")_" BILLS ."
	9049	"RTN","IBJ DF42",44,0 )
	9050	. . I $Y> (IOSL-9) D PAUSE Q:I BQ D HDR1 ,WPAT Q:IB Q
	9051	"RTN","IBJ DF42",45,0 )
	9052	. . D HDR 2
	9053	"RTN","IBJ DF42",46,0 )
	9054	. . K IBF LG S IBTOT ="",IBCNT= 0
	9055	"RTN","IBJ DF42",47,0 )
	9056	. . F S IBCAT=$O(^ TMP("IBJDF 4",$J,IBPT ,IB,IBCAT) ) Q:IBCAT= "" D Q:I BQ
	9057	"RTN","IBJ DF42",48,0 )
	9058	. . . F S IB0=$O(^ TMP("IBJDF 4",$J,IBPT ,IB,IBCAT, IB0)) Q:IB 0="" D Q :IBQ
	9059	"RTN","IBJ DF42",49,0 )
	9060	. . . . S IBN=$G(^T MP("IBJDF4 ",$J,IBPT, IB,IBCAT,I B0))
	9061	"RTN","IBJ DF42",50,0 )
	9062	. . . . I $Y>(IOSL- 5) D PAUSE Q:IBQ D HDR1,WPAT, HDR2 Q:IBQ
	9063	"RTN","IBJ DF42",51,0 )
	9064	. . . . D WBIL Q:IB Q
	9065	"RTN","IBJ DF42",52,0 )
	9066	. . . . S IBCNT=IBC NT+1
	9067	"RTN","IBJ DF42",53,0 )
	9068	. . . I ' IBQ,$O(^TM P("IBJDF4" ,$J,IBPT,I B,IBCAT))= "" D
	9069	"RTN","IBJ DF42",54,0 )
	9070	. . . . D TOT W !
	9071	"RTN","IBJ DF42",55,0 )
	9072	. . ; - D isplay bil l comment history, i f selected .
	9073	"RTN","IBJ DF42",56,0 )
	9074	. . S IBP RTFLG=1
	9075	"RTN","IBJ DF42",57,0 )
	9076	. . D WCO M(IBPT,IB)
	9077	"RTN","IBJ DF42",58,0 )
	9078	;
	9079	"RTN","IBJ DF42",59,0 )
	9080	I 'IBPRTF LG D
	9081	"RTN","IBJ DF42",60,0 )
	9082	. W !!!!! !,"There a re no rece ivables fo r the para meters ent ered."
	9083	"RTN","IBJ DF42",61,0 )
	9084	;
	9085	"RTN","IBJ DF42",62,0 )
	9086	DETQ Q
	9087	"RTN","IBJ DF42",63,0 )
	9088	;
	9089	"RTN","IBJ DF42",64,0 )
	9090	WPAT ; - W rite patie nt data.
	9091	"RTN","IBJ DF42",65,0 )
	9092	N I,X
	9093	"RTN","IBJ DF42",66,0 )
	9094	S DFN=$P( IBPT,"@@", 2),IBAI=$G (^TMP("IBJ DF4",$J,IB PT,0,"A"))
	9095	"RTN","IBJ DF42",67,0 )
	9096	W !!,"Pat ient Name : ",$P (IBP,U) W: IBAI["V" " *"
	9097	"RTN","IBJ DF42",68,0 )
	9098	W ?63,"SS N: ",$$SSN ($P(IBP,U, 2)),!,"Mea ns Test St atus: ",$P (IBP,U,4)
	9099	"RTN","IBJ DF42",69,0 )
	9100	W:$P(IBP, U,5)'="" " ("_$P(IBP ,U,5)_")"
	9101	"RTN","IBJ DF42",70,0 )
	9102	W ?58,"Me dicaid: ", $$GET1^DIQ (2,DFN,.38 1)
	9103	"RTN","IBJ DF42",71,0 )
	9104	W !,"RX C opay Statu s : ",$P( IBP,U,6)
	9105	"RTN","IBJ DF42",72,0 )
	9106	W:$P(IBP, U,7)'="" " ("_$P(IBP ,U,7)_")"
	9107	"RTN","IBJ DF42",73,0 )
	9108	W:$P(IBP, U,8) ?53," Date of De ath: ",$$D AT1^IBOUTL ($P(IBP,U, 8))
	9109	"RTN","IBJ DF42",74,0 )
	9110	W !,"Elig ibilities : " S X =$$ELIG($P (IBP,U,3))
	9111	"RTN","IBJ DF42",75,0 )
	9112	F I=1:1 Q :X="" W ? 19,$E(X,1, 61) S X=$E (X,62,999) I X'="" W !
	9113	"RTN","IBJ DF42",76,0 )
	9114	S X=$$INF O(IBAI)
	9115	"RTN","IBJ DF42",77,0 )
	9116	I X'="" D
	9117	"RTN","IBJ DF42",78,0 )
	9118	. W !,"Ad ditional I nfo : "
	9119	"RTN","IBJ DF42",79,0 )
	9120	. F I=1:1 Q:X="" W ?19,$E(X, 1,61) S X= $E(X,62,99 9) I X'="" W !
	9121	"RTN","IBJ DF42",80,0 )
	9122	;
	9123	"RTN","IBJ DF42",81,0 )
	9124	Q
	9125	"RTN","IBJ DF42",82,0 )
	9126	;
	9127	"RTN","IBJ DF42",83,0 )
	9128	WBIL ; - W rite bill data.
	9129	"RTN","IBJ DF42",84,0 )
	9130	W ! W:'$D (IBFLG(IBC AT)) IBCT( IBCAT) W ? 13,IB0
	9131	"RTN","IBJ DF42",85,0 )
	9132	W:$P(IBN, "^",6) ?25 ,$J("("_$P (IBN,"^",6 )_")",4)
	9133	"RTN","IBJ DF42",86,0 )
	9134	W ?30,$$D AT1^IBOUTL (+IBN)
	9135	"RTN","IBJ DF42",87,0 )
	9136	W ?39,$J( $FN($P(IBN ,U,2),",", 2),10),?50 ,$J($FN($P (IBN,U,3), ",",2),10)
	9137	"RTN","IBJ DF42",88,0 )
	9138	W ?61,$J( $FN($P(IBN ,U,4),",", 2),9),?71, $J($FN($P( IBN,U,5)," ,",2),9)
	9139	"RTN","IBJ DF42",89,0 )
	9140	I $G(IBST A)="S" W ? 82,$S(IBSU STYP="NONE ":IBSUSTYP ,1:IBSUS(I BSUSTYP))
	9141	"RTN","IBJ DF42",90,0 )
	9142	S $P(IBTO T,"^")=$P( IBTOT,"^") +$P(IBN,U, 2)
	9143	"RTN","IBJ DF42",91,0 )
	9144	S $P(IBTO T,"^",2)=$ P(IBTOT,"^ ",2)+$P(IB N,U,3)
	9145	"RTN","IBJ DF42",92,0 )
	9146	S $P(IBTO T,"^",3)=$ P(IBTOT,"^ ",3)+$P(IB N,U,4)
	9147	"RTN","IBJ DF42",93,0 )
	9148	S $P(IBTO T,"^",4)=$ P(IBTOT,"^ ",4)+$P(IB N,U,5)
	9149	"RTN","IBJ DF42",94,0 )
	9150	S IBFLG(I BCAT)=""
	9151	"RTN","IBJ DF42",95,0 )
	9152	Q
	9153	"RTN","IBJ DF42",96,0 )
	9154	;
	9155	"RTN","IBJ DF42",97,0 )
	9156	WCOM(IBPT, IB) ; - Wr ite bill c omments.
	9157	"RTN","IBJ DF42",98,0 )
	9158	N CMDT,CO NT,DIWL,DI WR,IBIDX,I BTR,IBLN,I BX,X
	9159	"RTN","IBJ DF42",99,0 )
	9160	;
	9161	"RTN","IBJ DF42",100, 0)
	9162	S (IBIDX, IBTR,IBLN) ="",DIWL=1 ,DIWR=64 K ^UTILITY( $J,"W")
	9163	"RTN","IBJ DF42",101, 0)
	9164	F S IBID X=$O(^TMP( "IBJDF4",$ J,IBPT,0," C",IB,IBID X)) Q:IBID X="" D Q :IBQ
	9165	"RTN","IBJ DF42",102, 0)
	9166	. I $Y>(I OSL-6) D W CPB Q:IBQ
	9167	"RTN","IBJ DF42",103, 0)
	9168	. D WCD(I BIDX)
	9169	"RTN","IBJ DF42",104, 0)
	9170	. F S IB TR=$O(^TMP ("IBJDF4", $J,IBPT,0, "C",IB,IBI DX,IBTR)) Q:IBTR="" D Q:IBQ
	9171	"RTN","IBJ DF42",105, 0)
	9172	. . S CMD T=$G(^TMP( "IBJDF4",$ J,IBPT,0," C",IB,IBID X,IBTR))
	9173	"RTN","IBJ DF42",106, 0)
	9174	. . I $Y> (IOSL-4) D WCPB Q:IB Q
	9175	"RTN","IBJ DF42",107, 0)
	9176	. . S CON T=0 D WCD( ,1,)
	9177	"RTN","IBJ DF42",108, 0)
	9178	. . F S IBLN=$O(^T MP("IBJDF4 ",$J,IBPT, 0,"C",IB,I BIDX,IBTR, IBLN)) Q:I BLN="" D Q:IBQ
	9179	"RTN","IBJ DF42",109, 0)
	9180	. . . S I BX=$G(^TMP ("IBJDF4", $J,IBPT,0, "C",IB,IBI DX,IBTR,IB LN))
	9181	"RTN","IBJ DF42",110, 0)
	9182	. . . I $ E(IBX)=" " ,$L(IBX)>1 S $E(IBX) =""
	9183	"RTN","IBJ DF42",111, 0)
	9184	. . . S X =IBX D ^DI WP
	9185	"RTN","IBJ DF42",112, 0)
	9186	. . . I ' CONT,$L(IB X)<66 D WC TX
	9187	"RTN","IBJ DF42",113, 0)
	9188	. . . S C ONT=$L(IBX )>65
	9189	"RTN","IBJ DF42",114, 0)
	9190	. . . I ' $O(^TMP("I BJDF4",$J, IBPT,0,"C" ,IB,IBIDX, IBTR,IBLN) ) D
	9191	"RTN","IBJ DF42",115, 0)
	9192	. . . . D :$D(^UTILI TY($J,"W") ) WCTX
	9193	"RTN","IBJ DF42",116, 0)
	9194	K ^UTILIT Y($J,"W")
	9195	"RTN","IBJ DF42",117, 0)
	9196	Q
	9197	"RTN","IBJ DF42",118, 0)
	9198	;
	9199	"RTN","IBJ DF42",119, 0)
	9200	WCD(I,D,C) ; - Write the comme nt date.
	9201	"RTN","IBJ DF42",120, 0)
	9202	; Input: I - Index # "(I)"
	9203	"RTN","IBJ DF42",121, 0)
	9204	; D - Print the Date " - MM/DD/ YY"
	9205	"RTN","IBJ DF42",122, 0)
	9206	; C - Print the Cont. "(Continue d)"
	9207	"RTN","IBJ DF42",123, 0)
	9208	;
	9209	"RTN","IBJ DF42",124, 0)
	9210	W:$G(I) ! ,"(",I,")" W:$G(D) ? 3," - ",$$ DAT1^IBOUT L(CMDT),": "
	9211	"RTN","IBJ DF42",125, 0)
	9212	W:$G(C) " (Continued )",!
	9213	"RTN","IBJ DF42",126, 0)
	9214	Q
	9215	"RTN","IBJ DF42",127, 0)
	9216	;
	9217	"RTN","IBJ DF42",128, 0)
	9218	WCTX ; - W rite the c omment tex t.
	9219	"RTN","IBJ DF42",129, 0)
	9220	N LIN,WLI N,Z
	9221	"RTN","IBJ DF42",130, 0)
	9222	S LIN=""
	9223	"RTN","IBJ DF42",131, 0)
	9224	F S LIN= $O(^UTILIT Y($J,"W",1 ,LIN)) Q:L IN="" D Q:IBQ
	9225	"RTN","IBJ DF42",132, 0)
	9226	. S WLIN= $G(^UTILIT Y($J,"W",1 ,LIN,0)) Q :WLIN=""
	9227	"RTN","IBJ DF42",133, 0)
	9228	. W ?16,W LIN
	9229	"RTN","IBJ DF42",134, 0)
	9230	. I '$O(^ UTILITY($J ,"W",1,LIN )) W ! Q
	9231	"RTN","IBJ DF42",135, 0)
	9232	. I $Y>(I OSL-4) D W CPB,WCD(IB IDX,1,1) Q
	9233	"RTN","IBJ DF42",136, 0)
	9234	. W !
	9235	"RTN","IBJ DF42",137, 0)
	9236	K ^UTILIT Y($J,"W")
	9237	"RTN","IBJ DF42",138, 0)
	9238	Q
	9239	"RTN","IBJ DF42",139, 0)
	9240	;
	9241	"RTN","IBJ DF42",140, 0)
	9242	WCPB ; - P age Break in the mid dle of the Comments
	9243	"RTN","IBJ DF42",141, 0)
	9244	D PAUSE Q :IBQ D HD R1,WPAT W !!
	9245	"RTN","IBJ DF42",142, 0)
	9246	Q
	9247	"RTN","IBJ DF42",143, 0)
	9248	;
	9249	"RTN","IBJ DF42",144, 0)
	9250	HDR1 ; - W rite the r eport head er.
	9251	"RTN","IBJ DF42",145, 0)
	9252	N X,I
	9253	"RTN","IBJ DF42",146, 0)
	9254	W:'$G(IBP AG) ! I $E (IOST,1,2) ="C-"!$G(I BPAG) W @I OF,*13
	9255	"RTN","IBJ DF42",147, 0)
	9256	S IBPAG=$ G(IBPAG)+1 W "First Party Foll ow-Up Repo rt"
	9257	"RTN","IBJ DF42",148, 0)
	9258	W ?34,"Ru n Date: ", IBRUN,?71, "Page: ",$ J(IBPAG,3)
	9259	"RTN","IBJ DF42",149, 0)
	9260	S X="ALL "_$S(IBSTA '="S":"ACT IVE",1:"") _$S(IBSTA= "B":" AND ",1:"")
	9261	"RTN","IBJ DF42",150, 0)
	9262	S X=X_$S( IBSTA'="A" :"SUSPENDE D",1:"")_$ $TYPE(IBSE L)_" RECEI VABLES"
	9263	"RTN","IBJ DF42",151, 0)
	9264	I IBSMN'= "A" S X=X_ " OVER "_I BSMN_" AND UNDER "_I BSMX_" DAY S OLD"
	9265	"RTN","IBJ DF42",152, 0)
	9266	S X=X_" / BY "_$S(I BSN="N":"N AME",1:"LA ST 4 SSN")
	9267	"RTN","IBJ DF42",153, 0)
	9268	S X=X_" ( "_$S($G(IB SNA)="ALL" :"ALL",1:" From "_$S( IBSNF="":" FIRST",1:I BSNF)_" to "_$S(IBSN L="zzzzz": "LAST",1:I BSNL))_")"
	9269	"RTN","IBJ DF42",154, 0)
	9270	S X=X_" / "_$S('IBS AM:"NO ",1 :"")_"MINI MUM BALANC E"
	9271	"RTN","IBJ DF42",155, 0)
	9272	S X=X_$S( IBSAM:": $ "_$FN(IBSA M,",",2),1 :"")
	9273	"RTN","IBJ DF42",156, 0)
	9274	S X=X_" / "_$S('IBS H:"NO ",IB SH1="A":"A LL ",1:"ON LY ")_"COM MENTS"
	9275	"RTN","IBJ DF42",157, 0)
	9276	S X=X_$S( $G(IBSH2): " LESS THA N "_IBSH2_ " DAYS OLD ",1:"")
	9277	"RTN","IBJ DF42",158, 0)
	9278	S X=X_" / RECEIVABL ES REFERRE D TO RC "_ $S('IBSRC: "NOT ",1:" ")_"INCLUD ED"
	9279	"RTN","IBJ DF42",159, 0)
	9280	F I=1:1 W !,$E(X,1, 80) S X=$E (X,81,999) I X="" Q
	9281	"RTN","IBJ DF42",160, 0)
	9282	;
	9283	"RTN","IBJ DF42",161, 0)
	9284	S IBQ=$$S TOP^IBOUTL ("First Pa rty Follow -Up Report ")
	9285	"RTN","IBJ DF42",162, 0)
	9286	Q
	9287	"RTN","IBJ DF42",163, 0)
	9288	;
	9289	"RTN","IBJ DF42",164, 0)
	9290	TYPE(SEL) ; Returns a string w ith the ty pe of rece ivables (d escription )
	9291	"RTN","IBJ DF42",165, 0)
	9292	; selecte d or NULL if ALL rec eivable ty pe have be en selecte d.
	9293	"RTN","IBJ DF42",166, 0)
	9294	; SEL - U ser input for the pa rameter "T ype of Rec eivable"
	9295	"RTN","IBJ DF42",167, 0)
	9296	;
	9297	"RTN","IBJ DF42",168, 0)
	9298	N TYPE,I, X
	9299	"RTN","IBJ DF42",169, 0)
	9300	I SEL="1, 2,3," Q ""
	9301	"RTN","IBJ DF42",170, 0)
	9302	S TYPE="" ,X="EMERGE NCY/HUMANI TARIAN^INE LIGIBLE^C- MEANS TEST & RX COPA Y"
	9303	"RTN","IBJ DF42",171, 0)
	9304	F I=2:1:( $L(SEL,"," )-1) D
	9305	"RTN","IBJ DF42",172, 0)
	9306	. S TYPE= TYPE_$S(I= ($L(SEL,", ")-1)&(TYP E'=""):" A ND ",1:", ")
	9307	"RTN","IBJ DF42",173, 0)
	9308	. S TYPE= TYPE_$P(X, "^",+$P(SE L,",",I))
	9309	"RTN","IBJ DF42",174, 0)
	9310	S $E(TYPE ,1)=""
	9311	"RTN","IBJ DF42",175, 0)
	9312	;
	9313	"RTN","IBJ DF42",176, 0)
	9314	Q TYPE
	9315	"RTN","IBJ DF42",177, 0)
	9316	;
	9317	"RTN","IBJ DF42",178, 0)
	9318	HDR2 ; - W rite bill sub-header .
	9319	"RTN","IBJ DF42",179, 0)
	9320	W ! I IBS TA="B" W ! ,$S(IB=16: "ACTIVE",1 :"SUSPENDE D")
	9321	"RTN","IBJ DF42",180, 0)
	9322	W ! I IBS TA="B" W $ S(IB=16:"= =====",1:" =========" )
	9323	"RTN","IBJ DF42",181, 0)
	9324	W:IBSH ?2 6,"COM" W ?30,"Last" ,?40,"Curr ent",?51," Principal"
	9325	"RTN","IBJ DF42",182, 0)
	9326	W !,"Cate gory",?13, "Bill Numb er",?26,"R EF"
	9327	"RTN","IBJ DF42",183, 0)
	9328	W ?30,"Pa yment",?40 ,"Balance" ,?51,"Bala nce",?62," Interest", ?72,"Admin ."
	9329	"RTN","IBJ DF42",184, 0)
	9330	I IBSTA=" S" W ?82," Suspended Type"
	9331	"RTN","IBJ DF42",185, 0)
	9332	W !,$$DAS H(96,1)
	9333	"RTN","IBJ DF42",186, 0)
	9334	Q
	9335	"RTN","IBJ DF42",187, 0)
	9336	;
	9337	"RTN","IBJ DF42",188, 0)
	9338	TOT ; - Wr ite balanc e total fo r patient.
	9339	"RTN","IBJ DF42",189, 0)
	9340	N I,J
	9341	"RTN","IBJ DF42",190, 0)
	9342	I IBCNT>1 W ! F I=4 0,51,62,72 W ?I,$E(" ---------" ,1,$S(I>60 :8,1:9))
	9343	"RTN","IBJ DF42",191, 0)
	9344	W:IBCNT'> 1 !
	9345	"RTN","IBJ DF42",192, 0)
	9346	W !,"Acco unt Balanc e: $"_$FN( $P(IBP,"^" ,10),",",2 )
	9347	"RTN","IBJ DF42",193, 0)
	9348	I IBCNT'> 1 Q
	9349	"RTN","IBJ DF42",194, 0)
	9350	S J=1 F I =39,50,60, 70 W ?I,$J ($FN($P(IB TOT,"^",J) ,",",2),10 ) S J=J+1
	9351	"RTN","IBJ DF42",195, 0)
	9352	Q
	9353	"RTN","IBJ DF42",196, 0)
	9354	;
	9355	"RTN","IBJ DF42",197, 0)
	9356	DASH(X,Y) ; - Return a dashed line.
	9357	"RTN","IBJ DF42",198, 0)
	9358	Q $TR($J( "",X)," ", $S(Y:"-",1 :"="))
	9359	"RTN","IBJ DF42",199, 0)
	9360	;
	9361	"RTN","IBJ DF42",200, 0)
	9362	ELIG(X) ; - Return e ligibility code name .
	9363	"RTN","IBJ DF42",201, 0)
	9364	; X - Eli gibility c odes separ ated by se mi-collon (;)
	9365	"RTN","IBJ DF42",202, 0)
	9366	;
	9367	"RTN","IBJ DF42",203, 0)
	9368	N ELIG,I
	9369	"RTN","IBJ DF42",204, 0)
	9370	S ELIG="" F I=1:1:$ L(X,";") D
	9371	"RTN","IBJ DF42",205, 0)
	9372	. I '$P(X ,";",I) Q
	9373	"RTN","IBJ DF42",206, 0)
	9374	. S ELIG= ELIG_", "_ $E($P($G(^ DIC(8,+$P( X,";",I),0 )),U),1,20 )
	9375	"RTN","IBJ DF42",207, 0)
	9376	S $E(ELIG ,1,2)=""
	9377	"RTN","IBJ DF42",208, 0)
	9378	;
	9379	"RTN","IBJ DF42",209, 0)
	9380	Q ELIG
	9381	"RTN","IBJ DF42",210, 0)
	9382	;
	9383	"RTN","IBJ DF42",211, 0)
	9384	INFO(X) ; - Return t he patient Additiona l Informat ion about the Patien t Accout
	9385	"RTN","IBJ DF42",212, 0)
	9386	; X - Fla gs represe nting the observatio ns
	9387	"RTN","IBJ DF42",213, 0)
	9388	;
	9389	"RTN","IBJ DF42",214, 0)
	9390	N INFO,I
	9391	"RTN","IBJ DF42",215, 0)
	9392	S INFO="" F I=1:1:$ L(X) D
	9393	"RTN","IBJ DF42",216, 0)
	9394	. I $E(X, I)="V" S I NFO=INFO_" , '*' - VA EMPLOYEE"
	9395	"RTN","IBJ DF42",217, 0)
	9396	. I $E(X, I)="R" S I NFO=INFO_" , REFERRED TO RC"
	9397	"RTN","IBJ DF42",218, 0)
	9398	. I $E(X, I)="D" S I NFO=INFO_" , REFERRED TO DMC"
	9399	"RTN","IBJ DF42",219, 0)
	9400	. I $E(X, I)="T" S I NFO=INFO_" , REFERRED TO TOP"
	9401	"RTN","IBJ DF42",220, 0)
	9402	. I $E(X, I)="P" S I NFO=INFO_" , UNDER RE PAYMENT PL AN"
	9403	"RTN","IBJ DF42",221, 0)
	9404	. I $E(X, I)="F" S I NFO=INFO_" , UNDER DE FAULTED RE PAYMENT PL AN"
	9405	"RTN","IBJ DF42",222, 0)
	9406	S $E(INFO ,1,2)=""
	9407	"RTN","IBJ DF42",223, 0)
	9408	;
	9409	"RTN","IBJ DF42",224, 0)
	9410	Q INFO
	9411	"RTN","IBJ DF42",225, 0)
	9412	;
	9413	"RTN","IBJ DF42",226, 0)
	9414	SSN(X) ; - Format th e SSN.
	9415	"RTN","IBJ DF42",227, 0)
	9416	Q $S(X]"" :$E(X,1,3) _"-"_$E(X, 4,5)_"-"_$ E(X,6,10), 1:"")
	9417	"RTN","IBJ DF42",228, 0)
	9418	;
	9419	"RTN","IBJ DF42",229, 0)
	9420	PAUSE ; - Page break .
	9421	"RTN","IBJ DF42",230, 0)
	9422	I $E(IOST ,1,2)'="C- " Q
	9423	"RTN","IBJ DF42",231, 0)
	9424	N IBX,DIR ,DIRUT,DUO UT,DTOUT,D IROUT,X,Y
	9425	"RTN","IBJ DF42",232, 0)
	9426	F IBX=$Y: 1:(IOSL-3) W !
	9427	"RTN","IBJ DF42",233, 0)
	9428	S DIR(0)= "E" D ^DIR S:$D(DIRU T)!($D(DUO UT)) IBQ=1
	9429	"RTN","IBJ DF42",234, 0)
	9430	Q
	9431	"RTN","IBJ TLA1")
	9432	0^2^B13446 872
	9433	"RTN","IBJ TLA1",1,0)
	9434	IBJTLA1 ;A LB/ARH - T PI ACTIVE BILLS LIST BUILD ;2/ 14/95
	9435	"RTN","IBJ TLA1",2,0)
	9436	;;2.0;INT EGRATED BI LLING;39 ,80,61,51, 153,137,18 3,276,451, 516,530,56 8;21-MAR -94;Build 12
	9437	"RTN","IBJ TLA1",3,0)
	9438	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9439	"RTN","IBJ TLA1",4,0)
	9440	;
	9441	"RTN","IBJ TLA1",5,0)
	9442	BLDA ; bui ld active list for t hird party joint inq uiry activ e list
	9443	"RTN","IBJ TLA1",6,0)
	9444	N IBIFN,I BCNT S VAL MCNT=0,IBC NT=0
	9445	"RTN","IBJ TLA1",7,0)
	9446	S IBIFN=0 F S IBIF N=$O(^DGCR (399,"C",D FN,IBIFN)) Q:'IBIFN I $$ACTIV E^IBJTU4(I BIFN) W ". " D SCRN
	9447	"RTN","IBJ TLA1",8,0)
	9448	;
	9449	"RTN","IBJ TLA1",9,0)
	9450	I VALMCNT =0 D SET(" ",0),SET( "No Active Bills for this Pati ent",0)
	9451	"RTN","IBJ TLA1",10,0 )
	9452	;
	9453	"RTN","IBJ TLA1",11,0 )
	9454	Q
	9455	"RTN","IBJ TLA1",12,0 )
	9456	;
	9457	"RTN","IBJ TLA1",13,0 )
	9458	SCRN ; add bill to s creen list (IBIFN,DF N must be defined)
	9459	"RTN","IBJ TLA1",14,0 )
	9460	N X,IBY,I BD0,IBDU,I BDM,TYPE,R EJFLAG,IND FLG,IBTYP S X=""
	9461	"RTN","IBJ TLA1",15,0 )
	9462	S IBCNT=I BCNT+1,IBD 0=$G(^DGCR (399,+IBIF N,0)),IBDU =$G(^DGCR( 399,+IBIFN ,"U")),IBD M=$G(^DGCR (399,+IBIF N,"M"))
	9463	"RTN","IBJ TLA1",16,0 )
	9464	S IBY=IBC NT,X=$$SET FLD^VALM1( IBY,X,"NUM BER")
	9465	"RTN","IBJ TLA1",17,0 )
	9466	; IB2.0 451 - get EEOB indic ator for b ill # when applicabl e
	9467	"RTN","IBJ TLA1",18,0 )
	9468	S IBPFLAG =$$EEOB(+I BIFN)
	9469	"RTN","IBJ TLA1",19,0 )
	9470	S REJFLAG =+$$BILLRE J^IBJTU6($ P(IBD0,U)) ;IB2.05 30 Add ind icator for rejects
	9471	"RTN","IBJ TLA1",20,0 )
	9472	S INDFLG= $S($G(IBPF LAG)'="":" %",1:"")_$ S(REJFLAG: "c",1:"") S:INDFLG=" " INDFLG=" "
	9473	"RTN","IBJ TLA1",21,0 )
	9474	S IBY=IND FLG_$P(IBD 0,U,1)_$$E CME^IBTRE( IBIFN),X=$ $SETFLD^VA LM1(IBY,X, "BILL") ;a dd EEOB in dicator '% ' to bill number whe n applicab le
	9475	"RTN","IBJ TLA1",22,0 )
	9476	S IBY=$S( $$REF^IBJT U31(+IBIFN ):"r",1:"" ),X=$$SETF LD^VALM1(I BY,X,"REFE R")
	9477	"RTN","IBJ TLA1",23,0 )
	9478	S IBY=$S( $$IB^IBRUT L(+IBIFN,0 ):"*",1:"" ),X=$$SETF LD^VALM1(I BY,X,"HD")
	9479	"RTN","IBJ TLA1",24,0 )
	9480	S IBY=$$D ATE($P(IBD U,U,1)),X= $$SETFLD^V ALM1(IBY,X ,"STFROM")
	9481	"RTN","IBJ TLA1",25,0 )
	9482	S IBY=$$D ATE($P(IBD U,U,2)),X= $$SETFLD^V ALM1(IBY,X ,"STTO")
	9483	"RTN","IBJ TLA1",26,0 )
	9484	;
	9485	"RTN","IBJ TLA1",27,0 )
	9486	S IBY=$P( $$LST^DGMT U(DFN,$P(I BDU,U)),U, 4),IBY=$S( IBY="C":"Y ES",IBY="P ":"PEN",IB Y="R":"REQ ",IBY="G": "GMT",1:"N O"),X=$$SE TFLD^VALM1 (IBY,X,"MT ?")
	9487	"RTN","IBJ TLA1",28,0 )
	9488	;S IBY=$$ TYPE($P(IB D0,U,5))_$ $TF($P(IBD 0,U,6))_$S ($P(IBD0,U ,27)=1:"I" ,$P(IBD0,U ,27)=2:"P" ,1:""),X=$ $SETFLD^VA LM1(IBY,X, "TYPE") ; 516 - baa
	9489	"RTN","IBJ TLA1",29,0 )
	9490	S TYPE=$$ TYPE($P(IB D0,U,5)) I $E(TYPE,2 )="P" S TY PE=$E(TYPE ) ; 516 - baa
	9491	"RTN","IBJ TLA1",30,0 )
	9492	;S IBY=TY PE_"/"_$S( $P(IBD0,U, 27)=1:"I", $P(IBD0,U, 27)=2:"P", 1:""),X=$$ SETFLD^VAL M1(IBY,X," TYPE") ; 516 - baa
	9493	"RTN","IBJ TLA1",31,0 )
	9494	S IBY=TYP E_"/"_$S($ P(IBD0,U,2 7)=1:"I",$ P(IBD0,U,2 7)=2:"P",1 :" "),X=$$ SETFLD^VAL M1(IBY,X," TYPE") ; 5 68 - lmh r et space i f null
	9495	"RTN","IBJ TLA1",32,0 )
	9496	;
	9497	"RTN","IBJ TLA1",33,0 )
	9498	; Return care type for (I)npa t,(O)utpat , (R)x or (P)rosthet ics - add under TJPI screen TY PE column - 568
	9499	"RTN","IBJ TLA1",34,0 )
	9500	S IBTYP=$ $TYP^IBRFN (IBIFN)
	9501	"RTN","IBJ TLA1",35,0 )
	9502	S IBTYP=$ S(IBTYP="" :-1,IBTYP= "PR":"P",I BTYP="PH": "R",1:IBTY P)
	9503	"RTN","IBJ TLA1",36,0 )
	9504	S IBY=IBY _"/"_IBTYP ,X=$$SETFL D^VALM1(IB Y,X,"TYPE" )
	9505	"RTN","IBJ TLA1",37,0 )
	9506	;
	9507	"RTN","IBJ TLA1",38,0 )
	9508	S IBY=" " _$P($$ARST ATA^IBJTU4 (IBIFN),U, 2),X=$$SET FLD^VALM1( IBY,X,"ARS T")
	9509	"RTN","IBJ TLA1",39,0 )
	9510	;
	9511	"RTN","IBJ TLA1",40,0 )
	9512	S IBY=$P( $G(^DGCR(3 99.3,+$P(I BD0,U,7),0 )),U,4),X= $$SETFLD^V ALM1(IBY,X ,"RATE")
	9513	"RTN","IBJ TLA1",41,0 )
	9514	S IBY=$S( $$MINS^IBJ TU31(+IBIF N):"+",1:" "),X=$$SET FLD^VALM1( IBY,X,"CB" )
	9515	"RTN","IBJ TLA1",42,0 )
	9516	S IBY=+$G (^DGCR(399 ,+IBIFN,"M P"))
	9517	"RTN","IBJ TLA1",43,0 )
	9518	I 'IBY,$$ MCRWNR^IBE FUNC($$CUR R^IBCEF2(I BIFN)) S I BY=+$$CURR ^IBCEF2(IB IFN)
	9519	"RTN","IBJ TLA1",44,0 )
	9520	S IBY=$P( $G(^DIC(36 ,+IBY,0)), U,1)
	9521	"RTN","IBJ TLA1",45,0 )
	9522	S X=$$SET FLD^VALM1( IBY,X,"INS UR")
	9523	"RTN","IBJ TLA1",46,0 )
	9524	S IBY=$$B ILL^RCJIBF N2(IBIFN)
	9525	"RTN","IBJ TLA1",47,0 )
	9526	S X=$$SET FLD^VALM1( $J(+$P(IBY ,U,1),8,2) ,X,"OAMT")
	9527	"RTN","IBJ TLA1",48,0 )
	9528	S X=$$SET FLD^VALM1( $J(+$P(IBY ,U,3),8,2) ,X,"CAMT")
	9529	"RTN","IBJ TLA1",49,0 )
	9530	D SET(X,I BCNT)
	9531	"RTN","IBJ TLA1",50,0 )
	9532	Q
	9533	"RTN","IBJ TLA1",51,0 )
	9534	;
	9535	"RTN","IBJ TLA1",52,0 )
	9536	DATE(X) ; date in ex ternal for mat
	9537	"RTN","IBJ TLA1",53,0 )
	9538	N Y S Y=" " I X?7N.E S Y=$E(X, 4,5)_"/"_$ E(X,6,7)_" /"_$E(X,2, 3)
	9539	"RTN","IBJ TLA1",54,0 )
	9540	Q Y
	9541	"RTN","IBJ TLA1",55,0 )
	9542	;
	9543	"RTN","IBJ TLA1",56,0 )
	9544	TYPE(X) ; return abb reviated f orm of Bil l Classifi cation (39 9,.05)
	9545	"RTN","IBJ TLA1",57,0 )
	9546	Q $S(X=1: "IP",X=2:" IH",X=3:"O P",X=4:"OH ",1:"")
	9547	"RTN","IBJ TLA1",58,0 )
	9548	;
	9549	"RTN","IBJ TLA1",59,0 )
	9550	TF(X) ; re turn abbre viated for m of Timef rame of Bi ll (399,.0 6)
	9551	"RTN","IBJ TLA1",60,0 )
	9552	Q $S(X=2: "-F",X=3:" -C",X=4:"- L",X'=1:"- O",1:"")
	9553	"RTN","IBJ TLA1",61,0 )
	9554	;
	9555	"RTN","IBJ TLA1",62,0 )
	9556	SET(X,CNT) ; set up list manag er screen array
	9557	"RTN","IBJ TLA1",63,0 )
	9558	S VALMCNT =VALMCNT+1
	9559	"RTN","IBJ TLA1",64,0 )
	9560	S ^TMP("I BJTLA",$J, VALMCNT,0) =X Q:'CNT
	9561	"RTN","IBJ TLA1",65,0 )
	9562	S ^TMP("I BJTLA",$J, "IDX",VALM CNT,+CNT)= ""
	9563	"RTN","IBJ TLA1",66,0 )
	9564	S ^TMP("I BJTLAX",$J ,CNT)=VALM CNT_U_IBIF N
	9565	"RTN","IBJ TLA1",67,0 )
	9566	Q
	9567	"RTN","IBJ TLA1",68,0 )
	9568	;
	9569	"RTN","IBJ TLA1",69,0 )
	9570	EEOB(IBIFN ) ; get pa yment info rmation
	9571	"RTN","IBJ TLA1",70,0 )
	9572	; IB2.0 451 - find an EOB pa yment for a bill
	9573	"RTN","IBJ TLA1",71,0 )
	9574	; input i s the IEN for the bi ll # in fi le #399 an d must be valid,
	9575	"RTN","IBJ TLA1",72,0 )
	9576	; output is the EEO B indicato r '%' if a payment i s found in file #361 .1,
	9577	"RTN","IBJ TLA1",73,0 )
	9578	; exclude EOB type MRA (Medic are).
	9579	"RTN","IBJ TLA1",74,0 )
	9580	N IBPFLAG ,IBVAL,Z
	9581	"RTN","IBJ TLA1",75,0 )
	9582	I $G(IBIF N)=0 Q ""
	9583	"RTN","IBJ TLA1",76,0 )
	9584	I '$O(^IB M(361.1,"B ",IBIFN,0) ) Q "" ; no entry h ere
	9585	"RTN","IBJ TLA1",77,0 )
	9586	I $P($G(^ DGCR(399,I BIFN,0))," ^",13)=1 Q "" ;avoi d 'ENTERED /NOT REVIE WED' statu s
	9587	"RTN","IBJ TLA1",78,0 )
	9588	; handle both singl e and mult iple bill entries in file #361 .1
	9589	"RTN","IBJ TLA1",79,0 )
	9590	S Z=0 F S Z=$O(^IB M(361.1,"B ",IBIFN,Z) ) Q:'Z D Q:$G(IBPF LAG)="%"
	9591	"RTN","IBJ TLA1",80,0 )
	9592	. S IBVAL =$G(^IBM(3 61.1,Z,0))
	9593	"RTN","IBJ TLA1",81,0 )
	9594	. S IBPFL AG=$S($P(I BVAL,"^",4 )=1:"",$P( IBVAL,"^", 4)=0:"%",1 :"")
	9595	"RTN","IBJ TLA1",82,0 )
	9596	Q IBPFLAG ; EOB in dicator fo r either 1 st or 3rd payment on bill
	9597	"RTN","IBJ TLA1",83,0 )
	9598	;
	9599	"RTN","IBJ TLB1")
	9600	0^7^B13573 050
	9601	"RTN","IBJ TLB1",1,0)
	9602	IBJTLB1 ;A LB/ARH - T PI INACTIV E LIST BUI LD ;2/14/9 5
	9603	"RTN","IBJ TLB1",2,0)
	9604	;;2.0;INT EGRATED BI LLING;39 ,80,61,137 ,276,451,5 16,530,568 ;21-MAR- 94;Build 1 2
	9605	"RTN","IBJ TLB1",3,0)
	9606	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9607	"RTN","IBJ TLB1",4,0)
	9608	;
	9609	"RTN","IBJ TLB1",5,0)
	9610	BLDA ; bui ld active list for t hird party joint inq uiry activ e list, DF N must be defined
	9611	"RTN","IBJ TLB1",6,0)
	9612	; first s earch star ts at dt a nd works b ackwards f or 6 month s of bills or IBMAXC NT bills, whichever is greater
	9613	"RTN","IBJ TLB1",7,0)
	9614	; all bil ls for a s ingle day are includ ed in the same searc h so even IBMAXCNT m ay be exce eded
	9615	"RTN","IBJ TLB1",8,0)
	9616	; if IBEN D is defin ed on entr y it is us ed as the end dt of the search , otherwis e DT is us ed
	9617	"RTN","IBJ TLB1",9,0)
	9618	; IBBEG i s left def ined on ex it, if it has a valu e then it is used by the Chang e Dates ac tion to de fine the n ext
	9619	"RTN","IBJ TLB1",10,0 )
	9620	; end dat e of the s earch, thi s results in each CD action de fault work ing backwa rds throug h the date range unt il
	9621	"RTN","IBJ TLB1",11,0 )
	9622	; no bill s are foun d and IBBE G is null then searc h restarts at DT, IB END is def ined so ca n tell if range chan ged
	9623	"RTN","IBJ TLB1",12,0 )
	9624	N IBIFN,I BCNT,IBBDT ,IBEDT,IBF IRST,IBLAS T,IBDT1,IB DT2,IBMAXC NT K IBHMS G
	9625	"RTN","IBJ TLB1",13,0 )
	9626	S IBEDT=$ S(+$G(IBEN D):IBEND,1 :DT),IBBDT =$$FMADD^X LFDT(IBEDT ,-180),IBM AXCNT=52
	9627	"RTN","IBJ TLB1",14,0 )
	9628	;
	9629	"RTN","IBJ TLB1",15,0 )
	9630	S (VALMCN T,IBCNT)=0 ,IBDT1=$S( IBEDT'="": -(IBEDT+.0 1),1:""),I BDT2=-IBBD T
	9631	"RTN","IBJ TLB1",16,0 )
	9632	S IBFIRST =IBBDT,IBL AST=-$O(^D GCR(399,"A PDS",DFN," "))
	9633	"RTN","IBJ TLB1",17,0 )
	9634	;
	9635	"RTN","IBJ TLB1",18,0 )
	9636	F S IBDT 1=$O(^DGCR (399,"APDS ",DFN,IBDT 1)) Q:'IBD T1!(IBDT1> IBDT2&(IBC NT'<IBMAXC NT)) S IB FIRST=-IBD T1 D
	9637	"RTN","IBJ TLB1",19,0 )
	9638	. S IBIFN =0 F S IB IFN=$O(^DG CR(399,"AP DS",DFN,IB DT1,IBIFN) ) Q:'IBIFN I '$$ACT IVE^IBJTU4 (IBIFN) D SCRN W "."
	9639	"RTN","IBJ TLB1",20,0 )
	9640	;
	9641	"RTN","IBJ TLB1",21,0 )
	9642	S IBBEG=$ S('IBDT1:" ",IBBDT>IB FIRST:IBFI RST,1:IBBD T),IBBDT=$ S(+IBBEG:$ $DATE(IBBE G),1:"BEGI N")
	9643	"RTN","IBJ TLB1",22,0 )
	9644	S IBEND=$ S(IBEDT="" !(IBLAST'> IBEDT):"", 1:IBEDT),I BEDT=$S(+I BEND:$$DAT E(IBEND),1 :"END")
	9645	"RTN","IBJ TLB1",23,0 )
	9646	;
	9647	"RTN","IBJ TLB1",24,0 )
	9648	I 'IBBEG, 'IBEND S I BHMSG="** All Inacti ve Bills * *"
	9649	"RTN","IBJ TLB1",25,0 )
	9650	I $G(IBHM SG)="" S I BHMSG=IBBD T_" - "_IB EDT
	9651	"RTN","IBJ TLB1",26,0 )
	9652	S IBHMSG= IBHMSG_" ("_VALMCN T_")"
	9653	"RTN","IBJ TLB1",27,0 )
	9654	;
	9655	"RTN","IBJ TLB1",28,0 )
	9656	I VALMCNT =0 D SET(" ",0),SET( "No Inacti ve Bills f or this Pa tient",0)
	9657	"RTN","IBJ TLB1",29,0 )
	9658	;
	9659	"RTN","IBJ TLB1",30,0 )
	9660	Q
	9661	"RTN","IBJ TLB1",31,0 )
	9662	;
	9663	"RTN","IBJ TLB1",32,0 )
	9664	SCRN ; add bill to s creen list (IBIFN,DF N must be defined)
	9665	"RTN","IBJ TLB1",33,0 )
	9666	N X,IBY,I BD0,IBDU,I BDM,TYPE,R EJFLAG,IND FLG S X=""
	9667	"RTN","IBJ TLB1",34,0 )
	9668	S IBCNT=I BCNT+1,IBD 0=$G(^DGCR (399,+IBIF N,0)),IBDU =$G(^DGCR( 399,+IBIFN ,"U")),IBD M=$G(^DGCR (399,+IBIF N,"M"))
	9669	"RTN","IBJ TLB1",35,0 )
	9670	S IBY=IBC NT,X=$$SET FLD^VALM1( IBY,X,"NUM BER")
	9671	"RTN","IBJ TLB1",36,0 )
	9672	; IB2.0 451 - get EEOB indic ator for b ill # when applicabl e
	9673	"RTN","IBJ TLB1",37,0 )
	9674	S IBPFLAG =$$EEOB^IB JTLA1(+IBI FN)
	9675	"RTN","IBJ TLB1",38,0 )
	9676	S REJFLAG =+$$BILLRE J^IBJTU6($ P(IBD0,U)) ;IB2.05 30 Add ind icator for rejects
	9677	"RTN","IBJ TLB1",39,0 )
	9678	S INDFLG= $S($G(IBPF LAG)'="":" %",1:"")_$ S(REJFLAG: "c",1:"") S:INDFLG=" " INDFLG=" "
	9679	"RTN","IBJ TLB1",40,0 )
	9680	S IBY=$P( IBD0,U,1)_ $$ECME^IBT RE(IBIFN), X=$$SETFLD ^VALM1(IBY ,X,"BILL")
	9681	"RTN","IBJ TLB1",41,0 )
	9682	S IBY=IND FLG_IBY,X= $$SETFLD^V ALM1(IBY,X ,"BILL")
	9683	"RTN","IBJ TLB1",42,0 )
	9684	S IBY=$S( $$REF^IBJT U31(+IBIFN ):"r",1:"" ),X=$$SETF LD^VALM1(I BY,X,"REFE R")
	9685	"RTN","IBJ TLB1",43,0 )
	9686	S IBY=$S( $$IB^IBRUT L(+IBIFN,0 ):"*",1:"" ),X=$$SETF LD^VALM1(I BY,X,"HD")
	9687	"RTN","IBJ TLB1",44,0 )
	9688	S IBY=$$D ATE($P(IBD U,U,1)),X= $$SETFLD^V ALM1(IBY,X ,"STFROM")
	9689	"RTN","IBJ TLB1",45,0 )
	9690	S IBY=$$D ATE($P(IBD U,U,2)),X= $$SETFLD^V ALM1(IBY,X ,"STTO")
	9691	"RTN","IBJ TLB1",46,0 )
	9692	;
	9693	"RTN","IBJ TLB1",47,0 )
	9694	;S IBY=$$ TYPE($P(IB D0,U,5))_$ $TF($P(IBD 0,U,6)),X= $$SETFLD^V ALM1(IBY,X ,"TYPE")
	9695	"RTN","IBJ TLB1",48,0 )
	9696	S TYPE=$$ TYPE($P(IB D0,U,5)) I $E(TYPE,2 )="P" S TY PE=$E(TYPE ) ; 516 - baa
	9697	"RTN","IBJ TLB1",49,0 )
	9698	;S IBY=TY PE_"/"_$S( $P(IBD0,U, 27)=1:"I", $P(IBD0,U, 27)=2:"P", 1:""),X=$$ SETFLD^VAL M1(IBY,X," TYPE") ; 516 - baa
	9699	"RTN","IBJ TLB1",50,0 )
	9700	S IBY=TYP E_"/"_$S($ P(IBD0,U,2 7)=1:"I",$ P(IBD0,U,2 7)=2:"P",1 :" "),X=$$ SETFLD^VAL M1(IBY,X," TYPE")
	9701	"RTN","IBJ TLB1",51,0 )
	9702	S IBTYP=$ $TYP^IBRFN (IBIFN)
	9703	"RTN","IBJ TLB1",52,0 )
	9704	S IBTYP=$ S(IBTYP="" :-1,IBTYP= "PR":"P",I BTYP="PH": "R",1:IBTY P)
	9705	"RTN","IBJ TLB1",53,0 )
	9706	S IBY=IBY _"/"_IBTYP ,X=$$SETFL D^VALM1(IB Y,X,"TYPE" )
	9707	"RTN","IBJ TLB1",54,0 )
	9708	S IBY=" " _$P($$ARST ATA^IBJTU4 (IBIFN),U, 2),X=$$SET FLD^VALM1( IBY,X,"ARS T")
	9709	"RTN","IBJ TLB1",55,0 )
	9710	;
	9711	"RTN","IBJ TLB1",56,0 )
	9712	S IBY=$P( $G(^DGCR(3 99.3,+$P(I BD0,U,7),0 )),U,4),X= $$SETFLD^V ALM1(IBY,X ,"RATE")
	9713	"RTN","IBJ TLB1",57,0 )
	9714	S IBY=$S( $$MINS^IBJ TU31(IBIFN ):"+",1:"" ),X=$$SETF LD^VALM1(I BY,X,"CB")
	9715	"RTN","IBJ TLB1",58,0 )
	9716	S IBY=+$G (^DGCR(399 ,+IBIFN,"M P"))
	9717	"RTN","IBJ TLB1",59,0 )
	9718	I 'IBY,$$ MCRWNR^IBE FUNC(+$$CU RR^IBCEF2( IBIFN)) S IBY=+$$CUR R^IBCEF2(I BIFN)
	9719	"RTN","IBJ TLB1",60,0 )
	9720	S IBY=$P( $G(^DIC(36 ,+IBY,0)), U,1),X=$$S ETFLD^VALM 1(IBY,X,"I NSUR")
	9721	"RTN","IBJ TLB1",61,0 )
	9722	S IBY=$$B ILL^RCJIBF N2(IBIFN)
	9723	"RTN","IBJ TLB1",62,0 )
	9724	S X=$$SET FLD^VALM1( $J(+$P(IBY ,U,1),8,2) ,X,"OAMT")
	9725	"RTN","IBJ TLB1",63,0 )
	9726	S X=$$SET FLD^VALM1( $J(+$P(IBY ,U,3),8,2) ,X,"CAMT")
	9727	"RTN","IBJ TLB1",64,0 )
	9728	D SET(X,I BCNT)
	9729	"RTN","IBJ TLB1",65,0 )
	9730	Q
	9731	"RTN","IBJ TLB1",66,0 )
	9732	;
	9733	"RTN","IBJ TLB1",67,0 )
	9734	DATE(X) ; date in ex ternal for mat
	9735	"RTN","IBJ TLB1",68,0 )
	9736	Q $E(X,4, 5)_"/"_$E( X,6,7)_"/" _$E(X,2,3)
	9737	"RTN","IBJ TLB1",69,0 )
	9738	;
	9739	"RTN","IBJ TLB1",70,0 )
	9740	TYPE(X) ; return abb reviated f orm of Bil l Classifi cation (39 9,.05)
	9741	"RTN","IBJ TLB1",71,0 )
	9742	; modifie d for 516 - baa
	9743	"RTN","IBJ TLB1",72,0 )
	9744	;Q $S(X=1 :"IP",X=2: "IH",X=3:" OP",X=4:"O H",1:"")
	9745	"RTN","IBJ TLB1",73,0 )
	9746	Q $S(X=1: "I",X=2:"I H",X=3:"O" ,X=4:"OH", 1:"")
	9747	"RTN","IBJ TLB1",74,0 )
	9748	;
	9749	"RTN","IBJ TLB1",75,0 )
	9750	TF(X) ; re turn abbre viated for m of Timef rame of Bi ll (399,.0 6)
	9751	"RTN","IBJ TLB1",76,0 )
	9752	Q $S(X=2: "-F",X=3:" -C",X=4:"- L",X'=1:"- O",1:"")
	9753	"RTN","IBJ TLB1",77,0 )
	9754	;
	9755	"RTN","IBJ TLB1",78,0 )
	9756	SET(X,CNT) ; set up list manag er screen array
	9757	"RTN","IBJ TLB1",79,0 )
	9758	S VALMCNT =VALMCNT+1
	9759	"RTN","IBJ TLB1",80,0 )
	9760	S ^TMP("I BJTLB",$J, VALMCNT,0) =X Q:'CNT
	9761	"RTN","IBJ TLB1",81,0 )
	9762	S ^TMP("I BJTLB",$J, "IDX",VALM CNT,+CNT)= ""
	9763	"RTN","IBJ TLB1",82,0 )
	9764	S ^TMP("I BJTLBX",$J ,CNT)=VALM CNT_U_IBIF N
	9765	"RTN","IBJ TLB1",83,0 )
	9766	Q
	9767	"RTN","IBT RE2")
	9768	0^3^B41201 696
	9769	"RTN","IBT RE2",1,0)
	9770	IBTRE2 ;AL B/AAS - CL AIMS TRACK ING - ACTI ONS ;27-JU N-93
	9771	"RTN","IBT RE2",2,0)
	9772	;;2.0;INT EGRATED BI LLING;23 ,121,249,3 12,315,568 ;21-MAR- 94;Build 1 2
	9773	"RTN","IBT RE2",3,0)
	9774	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9775	"RTN","IBT RE2",4,0)
	9776	;
	9777	"RTN","IBT RE2",5,0)
	9778	% G EN^IBT RE
	9779	"RTN","IBT RE2",6,0)
	9780	;
	9781	"RTN","IBT RE2",7,0)
	9782	AT ; -- Ad d tracking entry
	9783	"RTN","IBT RE2",8,0)
	9784	I '$$PFSS WARN^IBBSH DWN() S VA LMBCK="R" Q ;IB2.031 2
	9785	"RTN","IBT RE2",9,0)
	9786	D FULL^VA LM1
	9787	"RTN","IBT RE2",10,0)
	9788	N X,Y,DIC ,DA,DR,DD, DO,DIR,DIR UT,DTOUT,D UOUT,IBETY P,IBQUIT,I BTDT,VAIN, D NS T,IBTRN,IB TDTE
	9789	"RTN","IBT RE2",11,0)
	9790	;
	9791	"RTN","IBT RE2",12,0)
	9792	TEST S IBQ UIT=0
	9793	"RTN","IBT RE2",13,0)
	9794	S DIC(0)= "AEQMNZ",D IC="^IBE(3 56.6,",DIC ("S")="I $ P(^(0),U,3 )<3!($P(^( 0),U,3)=4) ",DIC("A") ="Select T racking Ty pe: " ;56 8
	9795	"RTN","IBT RE2",14,0)
	9796	D ^DIC K DIC S IBET YP=+Y I +Y <0 G ATQ
	9797	"RTN","IBT RE2",15,0)
	9798	W !
	9799	"RTN","IBT RE2",16,0)
	9800	;
	9801	"RTN","IBT RE2",17,0)
	9802	ADM I IBET YP=$O(^IBE (356.6,"AC ",1,0)) D I IBQUIT G ATQ
	9803	"RTN","IBT RE2",18,0)
	9804	.N DIR
	9805	"RTN","IBT RE2",19,0)
	9806	.S DIR("? ")=" "
	9807	"RTN","IBT RE2",20,0)
	9808	.S DIR("? ",1)=" Enter any Date!"
	9809	"RTN","IBT RE2",21,0)
	9810	.S DIR("? ",2)=" "
	9811	"RTN","IBT RE2",22,0)
	9812	.S DIR("? ",3)=" If the pat ient was a n inpatien t on that date the s ystem will use the"
	9813	"RTN","IBT RE2",23,0)
	9814	.S DIR("? ",4)=" correct ad mission da te. If yo u are trac king an ad missions a t another"
	9815	"RTN","IBT RE2",24,0)
	9816	.S DIR("? ",5)=" facility y ou may ent er that da te. Enter '??' to g et a list of the"
	9817	"RTN","IBT RE2",25,0)
	9818	.S DIR("? ",6)=" last 10 ad missions f or this pa tient."
	9819	"RTN","IBT RE2",26,0)
	9820	.S DIR("? ?")="^D LI STA^IBTRE2 0"
	9821	"RTN","IBT RE2",27,0)
	9822	.S DIR(0) ="DO^::AEX TP",DIR("A ")="Admiss ion Date"
	9823	"RTN","IBT RE2",28,0)
	9824	.D ^DIR K DIR S (IB TDT, D NS T)=+Y I $P ( D NS T,".",2)=" " S D NS T= D NS T+.24
	9825	"RTN","IBT RE2",29,0)
	9826	.I $D(DIR UT)!($P(IB TDT,".")'? 7N) S IBQU IT=1 Q
	9827	"RTN","IBT RE2",30,0)
	9828	.; -- che ck for val id admissi on
	9829	"RTN","IBT RE2",31,0)
	9830	.S VA200= "" D INP^V ADPT I VAI N(1)="" D ;look for one day a dmission
	9831	"RTN","IBT RE2",32,0)
	9832	..S IBX=+ $O(^(+$O(^ DGPM("ATID 1",DFN,999 9999-IBTDT )),0)),IBX =+$G(^DGPM (IBX,0))
	9833	"RTN","IBT RE2",33,0)
	9834	..I $E(IB X,1,7)=IBT DT S D NS T=IBX D IN P^VADPT ;9 999999.999 9999
	9835	"RTN","IBT RE2",34,0)
	9836	..I VAIN( 1) W !!,"W ARNING: Th is appears to be a o ne day sta y."
	9837	"RTN","IBT RE2",35,0)
	9838	.I VAIN(1 )="" D
	9839	"RTN","IBT RE2",36,0)
	9840	..W !!,*7 ,"WARNING: Patient d oes not ap pear to be an inpati ent on thi s date!",!
	9841	"RTN","IBT RE2",37,0)
	9842	..I VAIN( 7)="" S VA IN(7)=IBTD T,Y=IBTDT D D^DIQ S $P(VAIN(7) ,"^",2)=Y
	9843	"RTN","IBT RE2",38,0)
	9844	.;
	9845	"RTN","IBT RE2",39,0)
	9846	.S DIR("? ")="No adm ission was found for this date , enter 'Y es' if you want to a dd this an yway, or ' No' if you do not wi sh to trac k this dat e."
	9847	"RTN","IBT RE2",40,0)
	9848	.S DIR(0) ="Y",DIR(" A")="Okay to Add Cla ims Tracki ng entry f or Admissi on Date "_ $P(VAIN(7) ,"^",2),DI R("B")="NO "
	9849	"RTN","IBT RE2",41,0)
	9850	.D ^DIR K DIR I $D( DIRUT)!('Y ) S IBQUIT =1 Q
	9851	"RTN","IBT RE2",42,0)
	9852	.I VAIN(1 ) D ADM^IB TUTL(VAIN( 1))
	9853	"RTN","IBT RE2",43,0)
	9854	.I 'VAIN( 1) D OTH^I BTUTL(DFN, IBETYP,IBT DT)
	9855	"RTN","IBT RE2",44,0)
	9856	.Q
	9857	"RTN","IBT RE2",45,0)
	9858	;
	9859	"RTN","IBT RE2",46,0)
	9860	OPT I IBET YP=$O(^IBE (356.6,"AC ",2,0)) D I IBQUIT G ATQ
	9861	"RTN","IBT RE2",47,0)
	9862	.;
	9863	"RTN","IBT RE2",48,0)
	9864	.N DIR,IB SD,IBARRAY
	9865	"RTN","IBT RE2",49,0)
	9866	.;get all possible scheduling data for patient
	9867	"RTN","IBT RE2",50,0)
	9868	.K ^TMP($ J,"SDAMA30 1")
	9869	"RTN","IBT RE2",51,0)
	9870	.S IBARRA Y(4)=DFN,I BARRAY("SO RT")="P",I BARRAY("FL DS")="1;2; 3;10;12",I BSD=$$SDAP I^SDAMA301 (.IBARRAY)
	9871	"RTN","IBT RE2",52,0)
	9872	.;
	9873	"RTN","IBT RE2",53,0)
	9874	.S DIR("? ")="Time i s Required ."
	9875	"RTN","IBT RE2",54,0)
	9876	.S DIR("? ",1)=" Enter the Outpatient Visit Dat e."
	9877	"RTN","IBT RE2",55,0)
	9878	.S DIR("? ",2)=" If no sche duled visi t is found you will be given a warning. Enter"
	9879	"RTN","IBT RE2",56,0)
	9880	.S DIR("? ",3)=" '??' to ge t a list o f schedule d visits b etween "_$ $DAT1^IBOU TL(IBTBDT) _" and "_$ $DAT1^IBOU TL(IBTEDT) _"."
	9881	"RTN","IBT RE2",57,0)
	9882	.I '$D(IB TASS) S DI R("?",4)=" Use th e change d ate range action to change lis ting of sc heduled Vi sits."
	9883	"RTN","IBT RE2",58,0)
	9884	.S DIR("? ?")="^D LI STO^IBTRE2 0"
	9885	"RTN","IBT RE2",59,0)
	9886	.S DIR(0) ="DO^::AEX TP",DIR("A ")="Outpat ient Visit Date"
	9887	"RTN","IBT RE2",60,0)
	9888	.D ^DIR K DIR S IBT DT=Y
	9889	"RTN","IBT RE2",61,0)
	9890	.I $D(DIR UT)!($P(IB TDT,".")'? 7N) S IBQU IT=1 Q
	9891	"RTN","IBT RE2",62,0)
	9892	.;
	9893	"RTN","IBT RE2",63,0)
	9894	.; check scheduling and encou nters file for entri es
	9895	"RTN","IBT RE2",64,0)
	9896	.S X=$D(^ TMP($J,"SD AMA301",DF N,IBTDT))
	9897	"RTN","IBT RE2",65,0)
	9898	.;
	9899	"RTN","IBT RE2",66,0)
	9900	.I 'X,IBS D<0 W !!,* 7,"WARNING : Unable t o look up Visit info rmation fo r this Pat ient" X "N IBX S IBX =0 F S IB X=$O(^TMP( $J,""SDAMA 301"",IBX) ) W !?5,IB X,?10,$G(^ (IBX))"
	9901	"RTN","IBT RE2",67,0)
	9902	.;
	9903	"RTN","IBT RE2",68,0)
	9904	.I 'X,IBS D S Y=$O(^ TMP($J,"SD AMA301",DF N,$P(IBTDT ,"."))) I $P(IBTDT," .")=$P(Y," .") S IBTD T=Y,X=1
	9905	"RTN","IBT RE2",69,0)
	9906	.;
	9907	"RTN","IBT RE2",70,0)
	9908	.; if non say so
	9909	"RTN","IBT RE2",71,0)
	9910	.I 'X,IBS D'=-1 W !! ,*7,"WARNI NG: No Vis it informa tion for t his Patien t for this date.",!
	9911	"RTN","IBT RE2",72,0)
	9912	.;
	9913	"RTN","IBT RE2",73,0)
	9914	.; ask if okay to a dd entry.
	9915	"RTN","IBT RE2",74,0)
	9916	.S Y=IBTD T D D^DIQ S IBTDTE=Y
	9917	"RTN","IBT RE2",75,0)
	9918	.S DIR(0) ="Y",DIR(" A")="Okay to Add Cla ims Tracki ng entry f or Visit D ate "_IBTD TE,DIR("B" )="NO"
	9919	"RTN","IBT RE2",76,0)
	9920	.D ^DIR K DIR I $D( DIRUT)!('Y ) S IBQUIT =1 Q
	9921	"RTN","IBT RE2",77,0)
	9922	.D OPT^IB TUTL1(DFN, IBETYP,IBT DT,$P($G(^ TMP($J,"SD AMA301",DF N,IBTDT)), "^",12))
	9923	"RTN","IBT RE2",78,0)
	9924	.K ^TMP($ J,"SDAMA30 1")
	9925	"RTN","IBT RE2",79,0)
	9926	.Q
	9927	"RTN","IBT RE2",80,0)
	9928	;
	9929	"RTN","IBT RE2",81,0)
	9930	SCH I IBET YP=$O(^IBE (356.6,"AC ",5,0)) D I IBQUIT G ATQ
	9931	"RTN","IBT RE2",82,0)
	9932	.N DIR
	9933	"RTN","IBT RE2",83,0)
	9934	.S DIR("? ")=" "
	9935	"RTN","IBT RE2",84,0)
	9936	.S DIR("? ",1)=" Enter date of the sc heduled ad mission."
	9937	"RTN","IBT RE2",85,0)
	9938	.S DIR("? ",2)=" If you use the sched uled admis sion packa ge to sche dule admis sions"
	9939	"RTN","IBT RE2",86,0)
	9940	.S DIR("? ",3)=" you may en ter '??' t o get a li st of sche duled admi ssions bet ween"
	9941	"RTN","IBT RE2",87,0)
	9942	.S DIR("? ",4)=" "_$$DAT1^I BOUTL(IBTB DT)_" and "_$$DAT1^I BOUTL(IBTE DT)_". Us e the chan ge date ra nge action "
	9943	"RTN","IBT RE2",88,0)
	9944	.S DIR("? ",5)=" to change listing of scheduled admission s."
	9945	"RTN","IBT RE2",89,0)
	9946	.S DIR("? ",5)=" This shoul d be a fut ure schedu led admiss ion."
	9947	"RTN","IBT RE2",90,0)
	9948	.S DIR(0) ="DO^::AEX T",DIR("A" )="Schedul ed Admissi on Date"
	9949	"RTN","IBT RE2",91,0)
	9950	.S DIR("? ?")="^D LI STS^IBTRE2 0"
	9951	"RTN","IBT RE2",92,0)
	9952	.D ^DIR K DIR S IBT DT=+Y
	9953	"RTN","IBT RE2",93,0)
	9954	.I $D(DIR UT)!($P(IB TDT,".")'? 7N) S IBQU IT=1 Q
	9955	"RTN","IBT RE2",94,0)
	9956	.; ask if okay to a dd entry.
	9957	"RTN","IBT RE2",95,0)
	9958	.D FINDS^ IBTRE20
	9959	"RTN","IBT RE2",96,0)
	9960	.S Y=IBTD T D D^DIQ S IBTDTE=Y
	9961	"RTN","IBT RE2",97,0)
	9962	.S DIR(0) ="Y",DIR(" A")="Okay to Add Cla ims Tracki ng entry f or Schedul ed Adm. Da te "_IBTDT E,DIR("B") ="NO"
	9963	"RTN","IBT RE2",98,0)
	9964	.D ^DIR K DIR I $D( DIRUT)!('Y ) S IBQUIT =1 Q
	9965	"RTN","IBT RE2",99,0)
	9966	.I IBTDT\ 1'>DT S D NS T=IBTDT\1+ .24 D INP^ VADPT I $G (VAIN(1)) D Q
	9967	"RTN","IBT RE2",100,0 )
	9968	..W !!,"P atient an inpatient on this da te, using inpatient admission. "
	9969	"RTN","IBT RE2",101,0 )
	9970	..D ADM^I BTUTL(VAIN (1))
	9971	"RTN","IBT RE2",102,0 )
	9972	.D SCH^IB TUTL2(DFN, IBTDT)
	9973	"RTN","IBT RE2",103,0 )
	9974	.Q
	9975	"RTN","IBT RE2",104,0 )
	9976	;
	9977	"RTN","IBT RE2",105,0 )
	9978	PRO I IBET YP=$O(^IBE (356.6,"AC ",3,0)) D I IBQUIT G ATQ
	9979	"RTN","IBT RE2",106,0 )
	9980	.;
	9981	"RTN","IBT RE2",107,0 )
	9982	.N DIR,IB SD,IBARRAY ,C
	9983	"RTN","IBT RE2",108,0 )
	9984	.;get all possible scheduling data for patient
	9985	"RTN","IBT RE2",109,0 )
	9986	.S IBARRA Y(0)=DFN
	9987	"RTN","IBT RE2",110,0 )
	9988	.;
	9989	"RTN","IBT RE2",111,0 )
	9990	.D LISTP^ IBTRE20
	9991	"RTN","IBT RE2",112,0 )
	9992	.W !
	9993	"RTN","IBT RE2",113,0 )
	9994	.I C=0 S IBQUIT=1 Q
	9995	"RTN","IBT RE2",114,0 )
	9996	.S DIR("? ")="Prosth etics"
	9997	"RTN","IBT RE2",115,0 )
	9998	.S DIR(0) ="N",DIR(" A")="Prost hetics Ent ry"
	9999	"RTN","IBT RE2",116,0 )
	10000	.D ^DIR K DIR
	10001	"RTN","IBT RE2",117,0 )
	10002	.I $D(DIR UT) S IBQU IT=1 Q
	10003	"RTN","IBT RE2",118,0 )
	10004	.I Y>0 S RC=IBARRAY (Y),IBDEL= $P(RC,U,3) ,IBPRO=$P( RC,U,4),PI EN=$P(RC,U ,1),IBPR=$ P(RC,U,2), IBDELO=$P( RC,U,5)
	10005	"RTN","IBT RE2",119,0 )
	10006	.;
	10007	"RTN","IBT RE2",120,0 )
	10008	.; ask if okay to a dd entry.
	10009	"RTN","IBT RE2",121,0 )
	10010	.S Y=IBDE L D D^DIQ S IBTDTE=Y
	10011	"RTN","IBT RE2",122,0 )
	10012	.S DIR(0) ="Y",DIR(" A")="Okay to Add Cla ims Tracki ng entry f or Prosthe tics "_IBP RO_" for " _IBDELO,DI R("B")="NO "
	10013	"RTN","IBT RE2",123,0 )
	10014	.D ^DIR K DIR I $D( DIRUT)!('Y ) S IBQUIT =1 Q
	10015	"RTN","IBT RE2",124,0 )
	10016	.S PCOV=$ $PTCOV^IBC NSU3(DFN,I BDEL,"PROS THETICS")
	10017	"RTN","IBT RE2",125,0 )
	10018	.S IBMARK ="" I 'PCO V S IBMARK ="NO PROST HETIC COVE RAGE"
	10019	"RTN","IBT RE2",126,0 )
	10020	.D PRO^IB TUTL1(DFN, IBDEL,PIEN ,IBMARK)
	10021	"RTN","IBT RE2",127,0 )
	10022	.Q
	10023	"RTN","IBT RE2",128,0 )
	10024	;
	10025	"RTN","IBT RE2",129,0 )
	10026	I $G(IBQU IT) G ATQ
	10027	"RTN","IBT RE2",130,0 )
	10028	I $D(IBTA SS) Q ; l eave prema turely if from assig n reason
	10029	"RTN","IBT RE2",131,0 )
	10030	;
	10031	"RTN","IBT RE2",132,0 )
	10032	I $G(IBTR N) N IBTAT RK S IBTAT RK=1 D QE1 ^IBTRE1
	10033	"RTN","IBT RE2",133,0 )
	10034	;
	10035	"RTN","IBT RE2",134,0 )
	10036	D BLD^IBT RE
	10037	"RTN","IBT RE2",135,0 )
	10038	;
	10039	"RTN","IBT RE2",136,0 )
	10040	ATQ Q:$D(I BTASS)
	10041	"RTN","IBT RE2",137,0 )
	10042	I $G(IBQU IT) W !,"N othing Add ed",! D PA USE^VALM1
	10043	"RTN","IBT RE2",138,0 )
	10044	S VALMBCK ="R"
	10045	"RTN","IBT RE2",139,0 )
	10046	Q
	10047	"RTN","IBT RE20")
	10048	0^4^B20248 565
	10049	"RTN","IBT RE20",1,0)
	10050	IBTRE20 ;A LB/AAS - C LAIMS TRAC KING EXECU TABLE HELP ;13-OCT-9 3
	10051	"RTN","IBT RE20",2,0)
	10052	;;2.0;INT EGRATED BI LLING;40 ,91,249; 21-MAR-94; Build 12
	10053	"RTN","IBT RE20",3,0)
	10054	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	10055	"RTN","IBT RE20",4,0)
	10056	;
	10057	"RTN","IBT RE20",5,0)
	10058	;
	10059	"RTN","IBT RE20",6,0)
	10060	LISTA ; -- list inpa tient admi ssions for patient
	10061	"RTN","IBT RE20",7,0)
	10062	N C,I,J,N ,X,Y,IBX
	10063	"RTN","IBT RE20",8,0)
	10064	K ^TMP("I BM",$J)
	10065	"RTN","IBT RE20",9,0)
	10066	Q:'$D(DFN )
	10067	"RTN","IBT RE20",10,0 )
	10068	S C=0 F I =0:0 S I=$ O(^DGPM("A TID1",DFN, I)) Q:'I S N=$O(^(I ,0)) I $D( ^DGPM(+N,0 )) S D=^(0 ),C=C+1,^T MP("IBM",$ J,C)=N_"^" _D
	10069	"RTN","IBT RE20",11,0 )
	10070	;
	10071	"RTN","IBT RE20",12,0 )
	10072	I C=0 W ! !,"No Admi ssions to Choose Fro m." Q
	10073	"RTN","IBT RE20",13,0 )
	10074	;
	10075	"RTN","IBT RE20",14,0 )
	10076	W !!,"CHO OSE FROM:" F IBI=1:1 :10 Q:'$D( ^TMP("IBM" ,$J,IBI)) D WRA
	10077	"RTN","IBT RE20",15,0 )
	10078	K ^TMP("I BM",$J)
	10079	"RTN","IBT RE20",16,0 )
	10080	Q
	10081	"RTN","IBT RE20",17,0 )
	10082	;
	10083	"RTN","IBT RE20",18,0 )
	10084	WRA S IBX= $P(^TMP("I BM",$J,IBI ),"^",2,20 ),Y=+IBX X ^DD("DD")
	10085	"RTN","IBT RE20",19,0 )
	10086	W !," ",Y
	10087	"RTN","IBT RE20",20,0 )
	10088	W ?27,$S( '$D(^DG(40 5.1,+$P(IB X,"^",4),0 )):"",$P(^ (0),"^",7) ]"":$P(^(0 ),"^",7),1 :$E($P(^(0 ),"^",1),1 ,20))
	10089	"RTN","IBT RE20",21,0 )
	10090	;
	10091	"RTN","IBT RE20",22,0 )
	10092	W ?50,"TO : ",$E($P ($G(^DIC(4 2,+$P(IBX, "^",6),0)) ,"^"),1,17 )
	10093	"RTN","IBT RE20",23,0 )
	10094	I $D(^DG( 405.4,+$P( IBX,"^",7) ,0)) W " [ ",$E($P(^( 0),"^",1), 1,10),"]"
	10095	"RTN","IBT RE20",24,0 )
	10096	I $P(IBX, "^",18)=9 W !?23,"FR OM: ",$P( $G(^DIC(4, +$P(IBX,"^ ",5),0))," ^")
	10097	"RTN","IBT RE20",25,0 )
	10098	Q
	10099	"RTN","IBT RE20",26,0 )
	10100	;
	10101	"RTN","IBT RE20",27,0 )
	10102	LISTO ; -- list outp atient app ointments
	10103	"RTN","IBT RE20",28,0 )
	10104	N C,I,J,N ,X,Y,IBX,I BI,IBDT
	10105	"RTN","IBT RE20",29,0 )
	10106	; assumes ^TMP($J," SDAMA301", DFN,IBTDT) defined a nd IBSD(re sult from SD)
	10107	"RTN","IBT RE20",30,0 )
	10108	Q:'$D(DFN )
	10109	"RTN","IBT RE20",31,0 )
	10110	;
	10111	"RTN","IBT RE20",32,0 )
	10112	I IBSD<0 W !!,"Unab le to look -up Outpat ient Visit s to Choos e From." D Q
	10113	"RTN","IBT RE20",33,0 )
	10114	. N IBX F S IBX=$O (^TMP($J," SDAMA301", IBX)) Q:'I BX W !?5, IBX,?10,$G (^(IBX))
	10115	"RTN","IBT RE20",34,0 )
	10116	;
	10117	"RTN","IBT RE20",35,0 )
	10118	I IBSD=0 W !!,"No O utpatient Visits to Choose Fro m." Q
	10119	"RTN","IBT RE20",36,0 )
	10120	;
	10121	"RTN","IBT RE20",37,0 )
	10122	W !!,"CHO OSE FROM:" S IBI=0,I BDT=$G(IBT BDT) F S IBDT=$O(^T MP($J,"SDA MA301",DFN ,IBDT)),IB I=IBI+1 Q: 'IBDT!(IBI >12) D WR O
	10123	"RTN","IBT RE20",38,0 )
	10124	Q
	10125	"RTN","IBT RE20",39,0 )
	10126	;
	10127	"RTN","IBT RE20",40,0 )
	10128	WRO N IBSD D,Y
	10129	"RTN","IBT RE20",41,0 )
	10130	S Y=IBDT X ^DD("DD" ) W !," ",Y
	10131	"RTN","IBT RE20",42,0 )
	10132	S IBSDD=$ G(^TMP($J, "SDAMA301" ,DFN,IBDT) )
	10133	"RTN","IBT RE20",43,0 )
	10134	W ?27,"Cl inic: ",$P ($P(IBSDD, "^",2),";" ,2),?60," Type: ",$E ($P($P(IBS DD,"^",10) ,";",2),1, 12)
	10135	"RTN","IBT RE20",44,0 )
	10136	;
	10137	"RTN","IBT RE20",45,0 )
	10138	S IBSDD=$ P(IBSDD,"^ ",3) I $L( IBSDD),$P( IBSDD,";") '="R" W !, ?10," [Sta tus: ",$P( IBSDD,";", 2),"]"
	10139	"RTN","IBT RE20",46,0 )
	10140	Q
	10141	"RTN","IBT RE20",47,0 )
	10142	;
	10143	"RTN","IBT RE20",48,0 )
	10144	LISTS ; -- list sche duled admi ssions
	10145	"RTN","IBT RE20",49,0 )
	10146	N C,I,J,N ,X,Y,IBX,I BI
	10147	"RTN","IBT RE20",50,0 )
	10148	K ^TMP("I BM",$J)
	10149	"RTN","IBT RE20",51,0 )
	10150	Q:'$D(DFN )
	10151	"RTN","IBT RE20",52,0 )
	10152	S C=0 F I =0:0 S I=$ O(^DGS(41. 1,"B",DFN, I)) Q:'I I $D(^DGS( 41.1,+I,0) ) S D=$G(^ DGS(41.1,+ I,0)) I $P (D,"^",2)' <IBTBDT,$P (D,"^",2)' >IBTEDT S C=C+1,^TMP ("IBM",$J, C)=I_"^"_D
	10153	"RTN","IBT RE20",53,0 )
	10154	;
	10155	"RTN","IBT RE20",54,0 )
	10156	I C=0 W ! !,"No Sche duled Admi ssions to Choose Fro m." Q
	10157	"RTN","IBT RE20",55,0 )
	10158	;
	10159	"RTN","IBT RE20",56,0 )
	10160	W !!,"CHO OSE FROM:" F IBI=1:1 :12 Q:'$D( ^TMP("IBM" ,$J,IBI)) D WRS
	10161	"RTN","IBT RE20",57,0 )
	10162	K ^TMP("I BM",$J)
	10163	"RTN","IBT RE20",58,0 )
	10164	Q
	10165	"RTN","IBT RE20",59,0 )
	10166	;
	10167	"RTN","IBT RE20",60,0 )
	10168	WRS S IBX= $P($G(^TMP ("IBM",$J, IBI)),"^", 2,20),Y=$P (IBX,"^",2 ) X ^DD("D D")
	10169	"RTN","IBT RE20",61,0 )
	10170	W !," ",Y
	10171	"RTN","IBT RE20",62,0 )
	10172	W ?27," S pec: ",$E( $P($G(^DIC (45.7,+$P( IBX,"^",9) ,0)),"^"), 1,25)
	10173	"RTN","IBT RE20",63,0 )
	10174	;
	10175	"RTN","IBT RE20",64,0 )
	10176	W ?58," T o: ",$E($P ($G(^DIC(4 2,+$P(IBX, "^",8),0)) ,"^"),1,16 )
	10177	"RTN","IBT RE20",65,0 )
	10178	Q
	10179	"RTN","IBT RE20",66,0 )
	10180	;
	10181	"RTN","IBT RE20",67,0 )
	10182	FINDS ; -- match a s cheduled a dmission
	10183	"RTN","IBT RE20",68,0 )
	10184	Q:'$D(DFN )
	10185	"RTN","IBT RE20",69,0 )
	10186	Q:'$D(IBT DT)
	10187	"RTN","IBT RE20",70,0 )
	10188	N I,J
	10189	"RTN","IBT RE20",71,0 )
	10190	S I=0 F S I=$O(^DG S(41.1,"B" ,DFN,I)) Q :'I S J=$ P($G(^DGS( 41.1,I,0)) ,"^",2) Q: IBTDT=J I $P(IBTDT, ".")=$P(J, ".") S IBT DT=J Q
	10191	"RTN","IBT RE20",72,0 )
	10192	Q
	10193	"RTN","IBT RE20",73,0 )
	10194	;
	10195	"RTN","IBT RE20",74,0 )
	10196	ID ; -- wr ite out id entifier f or entry, called by ^dd(356,0, "id","writ e")
	10197	"RTN","IBT RE20",75,0 )
	10198	N IBOE,IB OE0
	10199	"RTN","IBT RE20",76,0 )
	10200	S IBOE=$P (^(0),"^", 4),IBOE0=$ $SCE^IBSDU (+IBOE) I IBOE,$P(IB OE0,U,4) W ?58,"["_$ E($P($G(^S C(+$P(IBOE 0,U,4),0)) ,U),1,20), "]"
	10201	"RTN","IBT RE20",77,0 )
	10202	Q
	10203	"RTN","IBT RE20",78,0 )
	10204	;
	10205	"RTN","IBT RE20",79,0 )
	10206	PRINT ; pa tch 40, cu stom look up. Input : IBX -- 0th node in file # 356.
	10207	"RTN","IBT RE20",80,0 )
	10208	Q:$D(IBX) [0
	10209	"RTN","IBT RE20",81,0 )
	10210	N NAM,EPI S,EVENT,DI SPL,CLIN
	10211	"RTN","IBT RE20",82,0 )
	10212	S NAM=$E( $P($G(^DPT (+$P(IBX,U ,2),0)),U) ,1,22)
	10213	"RTN","IBT RE20",83,0 )
	10214	S EPIS=$P ($P(IBX,U, 6),".")
	10215	"RTN","IBT RE20",84,0 )
	10216	I EPIS S EPIS=$E(EP IS,4,5)_"- "_$E(EPIS, 6,7)_"-"_$ E(EPIS,2,3 )
	10217	"RTN","IBT RE20",85,0 )
	10218	S EVENT=$ E($P($G(^I BE(356.6,+ $P(IBX,U,1 8),0)),U), 1,5)
	10219	"RTN","IBT RE20",86,0 )
	10220	S DISPL=$ $EXPAND^IB TRE(356,.0 7,$P(IBX,U ,7))
	10221	"RTN","IBT RE20",87,0 )
	10222	S CLIN=+$ $SCE^IBSDU (+$P(IBX," ^",4),4)
	10223	"RTN","IBT RE20",88,0 )
	10224	I CLIN S DISPL="["_ $E($P($G(^ SC(CLIN,0) ),U),1,22) _"]"
	10225	"RTN","IBT RE20",89,0 )
	10226	W ?13,NAM ,?37,EPIS, ?47,EVENT, ?54,DISPL
	10227	"RTN","IBT RE20",90,0 )
	10228	Q
	10229	"RTN","IBT RE20",91,0 )
	10230	;
	10231	"RTN","IBT RE20",92,0 )
	10232	LISTP ; -- list inpa tient admi ssions for patient
	10233	"RTN","IBT RE20",93,0 )
	10234	N I,X,Y,P ,P1,P2,DDT ,DDTO,IBX
	10235	"RTN","IBT RE20",94,0 )
	10236	K ^TMP("I BPRO",$J)
	10237	"RTN","IBT RE20",95,0 )
	10238	Q:'$D(DFN )
	10239	"RTN","IBT RE20",96,0 )
	10240	S (I,C)=0
	10241	"RTN","IBT RE20",97,0 )
	10242	F S I=$O (^RMPR(660 ,"C",DFN,I )) Q:'I I $D(^RMPR( 660,I,0)) S D=^(0) D
	10243	"RTN","IBT RE20",98,0 )
	10244	.S SDT=$P (D,U,12) I SDT<IBTBD T!(SDT>IBT EDT) Q
	10245	"RTN","IBT RE20",99,0 )
	10246	.I $O(^IB T(356,"APR O",I,0)) Q
	10247	"RTN","IBT RE20",100, 0)
	10248	.S C=C+1, ^TMP("IBPR O",$J,C)=I _"^"_D
	10249	"RTN","IBT RE20",101, 0)
	10250	;
	10251	"RTN","IBT RE20",102, 0)
	10252	I C=0 W ! !,"No Pros thetics to Choose Fr om." Q
	10253	"RTN","IBT RE20",103, 0)
	10254	;
	10255	"RTN","IBT RE20",104, 0)
	10256	W !!,"CHO OSE FROM:" F IBI=1:1 :10 Q:'$D( ^TMP("IBPR O",$J,IBI) ) D WRP
	10257	"RTN","IBT RE20",105, 0)
	10258	K ^TMP("I BPRO",$J)
	10259	"RTN","IBT RE20",106, 0)
	10260	Q
	10261	"RTN","IBT RE20",107, 0)
	10262	;
	10263	"RTN","IBT RE20",108, 0)
	10264	WRP S IBX= $P(^TMP("I BPRO",$J,I BI),"^",1, 20),N=$P(I BX,U,1),P= $P(IBX,U,7 ),P1=$P(^R MPR(661,P, 0),U,1),P2 =$P(^PRC(4 41,P1,0),U ,2)
	10265	"RTN","IBT RE20",109, 0)
	10266	S DDT=$P( IBX,U,13), DDTO=$$FMT E^XLFDT(DD T,"2DZ"),I BARRAY(IBI )=N_U_P_U_ DDT_U_P2_U _DDTO
	10267	"RTN","IBT RE20",110, 0)
	10268	S TP=$P(I BX,U,4),TY PE=$S(TP=" I":"INITIA L ISSUE",T P="R":"REP LACE",TP=" S":"SPARE" ,TP="X":"R EPAIR",1:" RENTAL")
	10269	"RTN","IBT RE20",111, 0)
	10270	W !," ", IBI,?10,$E (P2,1,25), ?40,TYPE,? 58,"DELIVE RED:",DDTO
	10271	"RTN","IBT RE20",112, 0)
	10272	;
	10273	"RTN","IBT RE20",113, 0)
	10274	Q
	10275	"RTN","IBT RKR5")
	10276	0^5^B39052 603
	10277	"RTN","IBT RKR5",1,0)
	10278	IBTRKR5 ;A LB/AAS - C LAIMS TRAC KING - ADD /TRACK PRO STHETICS ; 13-JAN-94
	10279	"RTN","IBT RKR5",2,0)
	10280	;;2.0;INT EGRATED BI LLING;13 ,260,312,3 39,389,474 ,498,568 ;21-MAR-94 ;Build 12
	10281	"RTN","IBT RKR5",3,0)
	10282	;;Per VA Directive 6402, this routine s hould not be modifie d.
	10283	"RTN","IBT RKR5",4,0)
	10284	;
	10285	"RTN","IBT RKR5",5,0)
	10286	% ; -- ent ry point f or nightly backgroun d job
	10287	"RTN","IBT RKR5",6,0)
	10288	N IBTSBDT ,IBTSEDT
	10289	"RTN","IBT RKR5",7,0)
	10290	S IBTSBDT =$$FMADD^X LFDT(DT,$S ($E(DT,6,7 )=10:-730, 1:-20))-.1 ;IB2.0 568
	10291	"RTN","IBT RKR5",8,0)
	10292	S IBTSEDT =$$FMADD^X LFDT(DT,-3 )+.9
	10293	"RTN","IBT RKR5",9,0)
	10294	D EN1
	10295	"RTN","IBT RKR5",10,0 )
	10296	Q
	10297	"RTN","IBT RKR5",11,0 )
	10298	;
	10299	"RTN","IBT RKR5",12,0 )
	10300	EN ; -- en try point to ask dat e range
	10301	"RTN","IBT RKR5",13,0 )
	10302	N IBSWINF O S IBSWIN FO=$$SWSTA T^IBBAPI() ; IB2.0312
	10303	"RTN","IBT RKR5",14,0 )
	10304	N IBBDT,I BEDT,IBTSB DT,IBTSEDT ,IBTALK
	10305	"RTN","IBT RKR5",15,0 )
	10306	S IBTALK= 1
	10307	"RTN","IBT RKR5",16,0 )
	10308	I '$P($G( ^IBE(350.9 ,1,6)),"^" ,4) W !!," I'm sorry, Tracking of Prosthe tics is cu rrently tu rned off." G ENQ
	10309	"RTN","IBT RKR5",17,0 )
	10310	W !!!,"Se lect the D ate Range of Prosthe tics to Ad d to Claim s Tracking .",!
	10311	"RTN","IBT RKR5",18,0 )
	10312	D DATE^IB OUTL
	10313	"RTN","IBT RKR5",19,0 )
	10314	I IBBDT<1 !(IBEDT<1) G ENQ
	10315	"RTN","IBT RKR5",20,0 )
	10316	S IBTSBDT =IBBDT,IBT SEDT=IBEDT
	10317	"RTN","IBT RKR5",21,0 )
	10318	;
	10319	"RTN","IBT RKR5",22,0 )
	10320	; -- chec k selected dates ; IB2.0312
	10321	"RTN","IBT RKR5",23,0 )
	10322	; Do NOT PROCESS on VistA if Start or E nd>=Switch Eff Dt ; CCR-930
	10323	"RTN","IBT RKR5",24,0 )
	10324	I +IBSWIN FO,((IBTSB DT+1)>$P(I BSWINFO,"^ ",2))!((IB TSEDT+1)>$ P(IBSWINFO ,"^",2)) D G EN
	10325	"RTN","IBT RKR5",25,0 )
	10326	.W !!,"T he Begin O R End Date CANNOT be on or aft er the PFS S Effectiv e date"
	10327	"RTN","IBT RKR5",26,0 )
	10328	.W ": ", $$FMTE^XLF DT($P(IBSW INFO,"^",2 ))
	10329	"RTN","IBT RKR5",27,0 )
	10330	;
	10331	"RTN","IBT RKR5",28,0 )
	10332	S IBTRKR= $G(^IBE(35 0.9,1,6))
	10333	"RTN","IBT RKR5",29,0 )
	10334	; start d ate can't be before parameters
	10335	"RTN","IBT RKR5",30,0 )
	10336	I +IBTRKR ,IBTSBDT<+ IBTRKR S I BTSBDT=IBT RKR W !!," Begin date is before Claims Tr acking Sta rt Date, c hanged to ",$$DAT1^I BOUTL(IBTS BDT)
	10337	"RTN","IBT RKR5",31,0 )
	10338	; -- end date into future
	10339	"RTN","IBT RKR5",32,0 )
	10340	I IBTSEDT >$$FMADD^X LFDT(DT,-3 ) W !!,"I' ll automat ically cha nge the en d date to 3 days pri or to the date queue d to run."
	10341	"RTN","IBT RKR5",33,0 )
	10342	;
	10343	"RTN","IBT RKR5",34,0 )
	10344	W !!,"Thi s should b e queued t o run afte r hours"
	10345	"RTN","IBT RKR5",35,0 )
	10346	W !!!,"I' m going to automatic ally queue this off and send y ou a"
	10347	"RTN","IBT RKR5",36,0 )
	10348	W !,"mail message w hen comple te.",!
	10349	"RTN","IBT RKR5",37,0 )
	10350	S ZTIO="" ,ZTRTN="EN 1^IBTRKR5" ,ZTSAVE("I B*")="",ZT DESC="IB - Add Prost hetics to Claims Tra cking"
	10351	"RTN","IBT RKR5",38,0 )
	10352	D ^%ZTLOA D I $G(ZTS K) K ZTSK W !,"Reque st Queued"
	10353	"RTN","IBT RKR5",39,0 )
	10354	ENQ K ZTSK ,ZTIO,ZTSA VE,ZTDESC, ZTRTN
	10355	"RTN","IBT RKR5",40,0 )
	10356	D HOME^%Z IS
	10357	"RTN","IBT RKR5",41,0 )
	10358	Q
	10359	"RTN","IBT RKR5",42,0 )
	10360	;
	10361	"RTN","IBT RKR5",43,0 )
	10362	EN1 ; -- a dd prostet hics to cl aims track ing file
	10363	"RTN","IBT RKR5",44,0 )
	10364	N I,J,X,Y ,IBTRKR,IB DT,DFN,IBD ATA,IBCNT, IBCNT1,IBC NT2,IBDTS, PROCOV
	10365	"RTN","IBT RKR5",45,0 )
	10366	N IBSWINF O S IBSWIN FO=$$SWSTA T^IBBAPI() ; IB2.0312
	10367	"RTN","IBT RKR5",46,0 )
	10368	;
	10369	"RTN","IBT RKR5",47,0 )
	10370	; -- chec k paramete rs
	10371	"RTN","IBT RKR5",48,0 )
	10372	S IBTRKR= $G(^IBE(35 0.9,1,6))
	10373	"RTN","IBT RKR5",49,0 )
	10374	G:'$P(IBT RKR,"^",5) EN1Q ; qu it if prot hetics tra cking off
	10375	"RTN","IBT RKR5",50,0 )
	10376	I +IBTRKR ,IBTSBDT<+ IBTRKR S I BTSBDT=IBT RKR ; star t date can 't be befo re paramet ers
	10377	"RTN","IBT RKR5",51,0 )
	10378	;
	10379	"RTN","IBT RKR5",52,0 )
	10380	; -- user s can queu e into fut ure, make sure dates not after date run
	10381	"RTN","IBT RKR5",53,0 )
	10382	I IBTSEDT >$$FMADD^X LFDT(DT,-3 ) S IBMESS ="(Selecte d end date of "_$$DA T1^IBOUTL( IBTSEDT)_" automatic ally chang ed to "_$$ DAT1^IBOUT L($$FMADD^ XLFDT(DT,- 3))_".)",I BTSEDT=$$F MADD^XLFDT (DT,-3)
	10383	"RTN","IBT RKR5",54,0 )
	10384	;
	10385	"RTN","IBT RKR5",55,0 )
	10386	;S IBPRTY P=$O(^IBE( 356.6,"AC" ,3,0)) ; t his is the event typ e pointer for prosth etics
	10387	"RTN","IBT RKR5",56,0 )
	10388	;
	10389	"RTN","IBT RKR5",57,0 )
	10390	; -- cnt= total cou nt, cnt1=c ount added nsc, cnt2 =count of pending
	10391	"RTN","IBT RKR5",58,0 )
	10392	S (IBCNT, IBCNT1,IBC NT2)=0
	10393	"RTN","IBT RKR5",59,0 )
	10394	S (IBDTS, IBDT)=IBTS BDT-.0001
	10395	"RTN","IBT RKR5",60,0 )
	10396	;
	10397	"RTN","IBT RKR5",61,0 )
	10398	; loop tw ice, once for shipmn et date (n ew search) , and once for
	10399	"RTN","IBT RKR5",62,0 )
	10400	; deliver y date (ol d search) for backwa rd compati bility.
	10401	"RTN","IBT RKR5",63,0 )
	10402	F S IBDT =$O(^RMPR( 660,"AF",I BDT)) Q:'I BDT!(IBDT> IBTSEDT) D
	10403	"RTN","IBT RKR5",64,0 )
	10404	.; Do NOT PROCES S on VistA if IBDT>= Switch Eff Date ; CCR-930
	10405	"RTN","IBT RKR5",65,0 )
	10406	.I +IB SWINFO,(IB DT+1)>$P(I BSWINFO,"^ ",2) Q ; IB2.0312
	10407	"RTN","IBT RKR5",66,0 )
	10408	.S IBD A=0 F S I BDA=$O(^RM PR(660,"AF ",IBDT,IBD A)) Q:'IBD A D PRCHK
	10409	"RTN","IBT RKR5",67,0 )
	10410	;
	10411	"RTN","IBT RKR5",68,0 )
	10412	; reset d ate and do old check
	10413	"RTN","IBT RKR5",69,0 )
	10414	S IBDT=IB DTS
	10415	"RTN","IBT RKR5",70,0 )
	10416	F S IBDT =$O(^RMPR( 660,"CT",I BDT)) Q:'I BDT!(IBDT> IBTSEDT) D
	10417	"RTN","IBT RKR5",71,0 )
	10418	.; Do NOT PROCES S on VistA if IBDT>= Switch Eff Date ; CCR-930
	10419	"RTN","IBT RKR5",72,0 )
	10420	.I +IB SWINFO,(IB DT+1)>$P(I BSWINFO,"^ ",2) Q ; IB2.0312
	10421	"RTN","IBT RKR5",73,0 )
	10422	.S IBD A="" F S IBDA=$O(^R MPR(660,"C T",IBDT,IB DA)) Q:'IB DA D PRCH K
	10423	"RTN","IBT RKR5",74,0 )
	10424	;
	10425	"RTN","IBT RKR5",75,0 )
	10426	I $G(IBTA LK) D BULL ;^IBTRKR5 1
	10427	"RTN","IBT RKR5",76,0 )
	10428	EN1Q I $D( ZTQUEUED) S ZTREQ="@ "
	10429	"RTN","IBT RKR5",77,0 )
	10430	Q
	10431	"RTN","IBT RKR5",78,0 )
	10432	;
	10433	"RTN","IBT RKR5",79,0 )
	10434	PRCHK ; -- check and add item
	10435	"RTN","IBT RKR5",80,0 )
	10436	N IBE,IBP ,IBDX,IBRM ARK,IBARR, IBT,IBINS
	10437	"RTN","IBT RKR5",81,0 )
	10438	S IBCNT=I BCNT+1,IBR MARK=""
	10439	"RTN","IBT RKR5",82,0 )
	10440	I '$D(ZTQ UEUED),($G (IBTALK)) W "."
	10441	"RTN","IBT RKR5",83,0 )
	10442	;
	10443	"RTN","IBT RKR5",84,0 )
	10444	S IBDATA= $G(^RMPR(6 60,+IBDA,0 )) Q:IBDAT A=""
	10445	"RTN","IBT RKR5",85,0 )
	10446	S DFN=$P( IBDATA,"^" ,2) Q:'DFN
	10447	"RTN","IBT RKR5",86,0 )
	10448	; quit if non billa ble PSAS H CPCS code is found
	10449	"RTN","IBT RKR5",87,0 )
	10450	S SCDATA= $G(^RMPR(6 60,+IBDA," BA1"))
	10451	"RTN","IBT RKR5",88,0 )
	10452	I $$IBPHP (IBDA) Q
	10453	"RTN","IBT RKR5",89,0 )
	10454	D CL^SDCO 21(DFN,IBD T,"",.IBAR R)
	10455	"RTN","IBT RKR5",90,0 )
	10456	;
	10457	"RTN","IBT RKR5",91,0 )
	10458	; -- chec ks copied from rmprb il v2.0 /f eb 2, 1994
	10459	"RTN","IBT RKR5",92,0 )
	10460	Q:'$D(^RM PR(660,+IB DA,"AM"))
	10461	"RTN","IBT RKR5",93,0 )
	10462	Q:$P(^RMP R(660,+IBD A,0),U,9)= ""!($P(^(0 ),U,12)="" )!($P(^(0) ,U,14)="V" )!($P(^(0) ,U,2)="")! ($P(^(0),U ,15)="*")
	10463	"RTN","IBT RKR5",94,0 )
	10464	;Q:($P(^R MPR(660,+I BDA,"AM"), U,3)=2)!($ P(^("AM"), U,3)=3)
	10465	"RTN","IBT RKR5",95,0 )
	10466	;
	10467	"RTN","IBT RKR5",96,0 )
	10468	;
	10469	"RTN","IBT RKR5",97,0 )
	10470	I $O(^IBT (356,"APRO ",IBDA,0)) G PRCHKQ ; already in claims tracking
	10471	"RTN","IBT RKR5",98,0 )
	10472	;
	10473	"RTN","IBT RKR5",99,0 )
	10474	; -- see if trackin g only ins ured and p t is insur ed
	10475	"RTN","IBT RKR5",100, 0)
	10476	I $P(IBTR KR,"^",5)= 1,'$$INSUR ED^IBCNS1( DFN,IBDT) G PRCHKQ ; patient n ot insured
	10477	"RTN","IBT RKR5",101, 0)
	10478	;
	10479	"RTN","IBT RKR5",102, 0)
	10480	; -- if c lasificati ons requir ed, check exemptions
	10481	"RTN","IBT RKR5",103, 0)
	10482	S SCR=0
	10483	"RTN","IBT RKR5",104, 0)
	10484	I '$D(IBA RR) G CLQ
	10485	"RTN","IBT RKR5",105, 0)
	10486	;IB2.05 68
	10487	"RTN","IBT RKR5",106, 0)
	10488	N IBSC
	10489	"RTN","IBT RKR5",107, 0)
	10490	F IBP=1:1 :4 S IBDX( IBP)=$G(^R MPR(660,+I BDA,"BA"_I BP)) D
	10491	"RTN","IBT RKR5",108, 0)
	10492	.S SCR=0 F SCP=2:1: 8 Q:SCR=1 I $P(IBDX (IBP),U,SC P)[1 S IBS C(IBP)=SCP ,SCR=1
	10493	"RTN","IBT RKR5",109, 0)
	10494	I 'SCR S IBRMARK="N EEDS SC DE TERMINATIO N" G CLQ ; no ICD no de in RMPR , use old method of determinin g status
	10495	"RTN","IBT RKR5",110, 0)
	10496	S IBRMARK =""
	10497	"RTN","IBT RKR5",111, 0)
	10498	S IBE=0 F S IBE=$O (IBARR(IBE )) Q:'IBE D Q:($L( $G(IBRMARK )))
	10499	"RTN","IBT RKR5",112, 0)
	10500	.F IBP=1: 1:4 Q:$L($ G(IBRMARK) ) D
	10501	"RTN","IBT RKR5",113, 0)
	10502	..S (SUB, REC)="" I IBSC(IBP) S SUB="CL" _IBSC(IBP) ,REC=$T(@S UB)
	10503	"RTN","IBT RKR5",114, 0)
	10504	..S IBRMA RK=$S(REC' ="":$P(REC ,";",3),1: "NEEDS SC DETERMINAT ION")
	10505	"RTN","IBT RKR5",115, 0)
	10506	;
	10507	"RTN","IBT RKR5",116, 0)
	10508	;
	10509	"RTN","IBT RKR5",117, 0)
	10510	CLQ ; -- o k to add t o tracking module
	10511	"RTN","IBT RKR5",118, 0)
	10512	S PROCOV= 0,SCR=+$G( SCR)
	10513	"RTN","IBT RKR5",119, 0)
	10514	S PROCOV= +$$PTCOV^I BCNSU3(DFN ,IBDT,"PRO STHETICS")
	10515	"RTN","IBT RKR5",120, 0)
	10516	I 'PROCOV ,IBRMARK=" NEEDS SC D ETERMINATI ON" S IBRM ARK="NO PR OSTHETIC C OVERAGE"
	10517	"RTN","IBT RKR5",121, 0)
	10518	I 'PROCOV ,IBRMARK=" " S IBRMAR K="NO PROS THETIC COV ERAGE"
	10519	"RTN","IBT RKR5",122, 0)
	10520	D PRO^IBT UTL1(DFN,I BDT,IBDA,$ G(IBRMARK) ) I '$D(ZT QUEUED),$G (IBTALK) W "+"
	10521	"RTN","IBT RKR5",123, 0)
	10522	I SCR=1 S IBCNT2=IB CNT2+1
	10523	"RTN","IBT RKR5",124, 0)
	10524	I SCR=0 S IBCNT1=IB CNT1+1
	10525	"RTN","IBT RKR5",125, 0)
	10526	K VAEL,VA ,IBDATA,DF N,X,Y
	10527	"RTN","IBT RKR5",126, 0)
	10528	PRCHKQ Q
	10529	"RTN","IBT RKR5",127, 0)
	10530	;
	10531	"RTN","IBT RKR5",128, 0)
	10532	IBPHP(IBDA ) ; non bi llable PSA S HCPCS co des
	10533	"RTN","IBT RKR5",129, 0)
	10534	; input-p atient ite m in #660
	10535	"RTN","IBT RKR5",130, 0)
	10536	; output- value if t he code wi th the fir st 2 chars in the st ring is fo und
	10537	"RTN","IBT RKR5",131, 0)
	10538	N IBPSAS, IBPIN S IB PIN=""
	10539	"RTN","IBT RKR5",132, 0)
	10540	S IBPSAS= ",BA,DI,DL ,EC,EV,FE, HI,HN,HS,N R,RE,SB,SI ,TH,TM,TR, VA,"
	10541	"RTN","IBT RKR5",133, 0)
	10542	; return the pointe r^descript ion^the co de (#661.1 ,.01)
	10543	"RTN","IBT RKR5",134, 0)
	10544	S IBPIN=$ $PIN^IBATU TL(+IBDA)
	10545	"RTN","IBT RKR5",135, 0)
	10546	S IBPIN=$ P(IBPIN,U, 3)
	10547	"RTN","IBT RKR5",136, 0)
	10548	S IBPIN=$ F(IBPSAS," ,"_$E(IBPI N,1,2)_"," )
	10549	"RTN","IBT RKR5",137, 0)
	10550	Q IBPIN
	10551	"RTN","IBT RKR5",138, 0)
	10552	;
	10553	"RTN","IBT RKR5",139, 0)
	10554	BULL ; -- send bulle tin
	10555	"RTN","IBT RKR5",140, 0)
	10556	;
	10557	"RTN","IBT RKR5",141, 0)
	10558	S XMSUB=" Prosthetic Items add ed to Clai ms Trackin g Complete "
	10559	"RTN","IBT RKR5",142, 0)
	10560	S IBT(1)= "The proce ss to auto matically add Prosth etic Items has succe ssfully co mpleted."
	10561	"RTN","IBT RKR5",143, 0)
	10562	S IBT(1.1 )=""
	10563	"RTN","IBT RKR5",144, 0)
	10564	S IBT(2)= " Start D ate: "_$$D AT1^IBOUTL (IBTSBDT)
	10565	"RTN","IBT RKR5",145, 0)
	10566	S IBT(3)= " End D ate: "_$$D AT1^IBOUTL (IBTSEDT)
	10567	"RTN","IBT RKR5",146, 0)
	10568	I $D(IBME SS) S IBT( 3.1)=IBMES S
	10569	"RTN","IBT RKR5",147, 0)
	10570	S IBT(4)= ""
	10571	"RTN","IBT RKR5",148, 0)
	10572	S IBT(5)= " Total Pr osthetics Items chec ked: "_$G( IBCNT)
	10573	"RTN","IBT RKR5",149, 0)
	10574	S IBT(6)= "Total NSC Prostheti c Items Ad ded: "_$G( IBCNT1)
	10575	"RTN","IBT RKR5",150, 0)
	10576	S IBT(7)= " Total SC Prostheti c Items Ad ded: "_$G( IBCNT2)
	10577	"RTN","IBT RKR5",151, 0)
	10578	S IBT(8)= ""
	10579	"RTN","IBT RKR5",152, 0)
	10580	S IBT(9)= "*The item s added as SC requir e determin ation and editing to be billed "
	10581	"RTN","IBT RKR5",153, 0)
	10582	D SEND^IB TRKR31
	10583	"RTN","IBT RKR5",154, 0)
	10584	BULLQ Q
	10585	"RTN","IBT RKR5",155, 0)
	10586	;
	10587	"RTN","IBT RKR5",156, 0)
	10588	CLTXT ; cl assificati on text fo r reason n ot billabl e
	10589	"RTN","IBT RKR5",157, 0)
	10590	;;
	10591	"RTN","IBT RKR5",158, 0)
	10592	CL2 ;;AGEN T ORANGE
	10593	"RTN","IBT RKR5",159, 0)
	10594	CL3 ;;IONI ZING RADIA TION
	10595	"RTN","IBT RKR5",160, 0)
	10596	CL4 ;;SC T REATMENT
	10597	"RTN","IBT RKR5",161, 0)
	10598	CL5 ;;SOUT HWEST ASIA
	10599	"RTN","IBT RKR5",162, 0)
	10600	CL6 ;;MILI TARY SEXUA L TRAUMA
	10601	"RTN","IBT RKR5",163, 0)
	10602	CL7 ;;HEAD /NECK CANC ER
	10603	"RTN","IBT RKR5",164, 0)
	10604	CL8 ;;COMB AT VETERAN
	10605	"VER")
	10606	8.0^22.0
	10607	INSTALL NAME
	10608	PSO7.046 3
	10609	"BLD",1018 9,0)
	10610	PSO7.046 3^OUTPATIE NT PHARMAC Y^0^316121 5^y
	10611	"BLD",1018 9,1,0)
	10612	^^253^253^ 3161212^
	10613	"BLD",1018 9,1,1,0)
	10614
	10615	"BLD",1018 9,1,2,0)
	10616	IMPORTANT INSTALLATI ON NOTE:
	10617	"BLD",1018 9,1,3,0)
	10618	---------- ---------- --------
	10619	"BLD",1018 9,1,4,0)
	10620	This patch is part o f a multi- package bu ild. There are three patches
	10621	"BLD",1018 9,1,5,0)
	10622	associated with the FY16 HAPE Revenue En hancement project - IB2.0568 ,
	10623	"BLD",1018 9,1,6,0)
	10624	PRCA4.53 15 and PSO 7.0463. All three patches ar e to be in stalled
	10625	"BLD",1018 9,1,7,0)
	10626	together a s a bundle , IB_2_568 _PRCA_PSO_ BUNDLE_T1. KID
	10627	"BLD",1018 9,1,8,0)
	10628
	10629	"BLD",1018 9,1,9,0)
	10630
	10631	"BLD",1018 9,1,10,0)
	10632	Descriptio n
	10633	"BLD",1018 9,1,11,0)
	10634	---------- -
	10635	"BLD",1018 9,1,12,0)
	10636	The Chief Business O ffice (CBO ) is reque sting syst em enhance ments to
	10637	"BLD",1018 9,1,13,0)
	10638	The Vetera ns Health Informatio n Systems and Techno logy Archi tecture
	10639	"BLD",1018 9,1,14,0)
	10640	(VistA) In tegrated B illing (IB ), Account s Receivab le (AR), a nd
	10641	"BLD",1018 9,1,15,0)
	10642	Outpatient Pharmacy (PSO) soft ware modul es.
	10643	"BLD",1018 9,1,16,0)
	10644
	10645	"BLD",1018 9,1,17,0)
	10646	The missio n of the D epartment of Veteran s Affairs (VA), Offi ce of
	10647	"BLD",1018 9,1,18,0)
	10648	Informatio n & Techno logy (OI&T ), is to p rovide ben efits and services t o
	10649	"BLD",1018 9,1,19,0)
	10650	veterans o f the Unit ed States Armed Forc es. In mee ting these goals,
	10651	"BLD",1018 9,1,20,0)
	10652	OIT strive s to provi de high qu ality, eff ective, an d efficien t
	10653	"BLD",1018 9,1,21,0)
	10654	Informatio n Technolo gy (IT) se rvices to those resp onsible fo r providin g
	10655	"BLD",1018 9,1,22,0)
	10656	care to th e veterans at the po int-of-car e, as well as throug hout all
	10657	"BLD",1018 9,1,23,0)
	10658	the points of the ve terans' he alth care. The VA de pends on I nformation
	10659	"BLD",1018 9,1,24,0)
	10660	Management /Informati on Technol ogy (IM/IT ) systems to meet mi ssion
	10661	"BLD",1018 9,1,25,0)
	10662	goals.
	10663	"BLD",1018 9,1,26,0)
	10664
	10665	"BLD",1018 9,1,27,0)
	10666	The overal l FY16 HAP E Revenue Enhancemen t project has been f urther
	10667	"BLD",1018 9,1,28,0)
	10668	divided in to three s ub-project s:
	10669	"BLD",1018 9,1,29,0)
	10670
	10671	"BLD",1018 9,1,30,0)
	10672	NSR #20150 506
	10673	"BLD",1018 9,1,31,0)
	10674	The Revenu e Eligibil ity Enhanc ements Pro ject effor t for the Chief
	10675	"BLD",1018 9,1,32,0)
	10676	Business O ffice (CBO ), bundles several N SRs with s imilar bus iness
	10677	"BLD",1018 9,1,33,0)
	10678	needs into a single requiremen ts documen t. Succes sfully add ressing
	10679	"BLD",1018 9,1,34,0)
	10680	the requir ements con tained wit hin this d ocument wi ll enable the
	10681	"BLD",1018 9,1,35,0)
	10682	Department of Vetera ns Affairs (VA) to a ppropriate ly bill ce rtain
	10683	"BLD",1018 9,1,36,0)
	10684	subsets of billable events by correcting , automati ng, or enh ancing
	10685	"BLD",1018 9,1,37,0)
	10686	current Ve terans Hea lth Inform ation Syst ems and Te chnology
	10687	"BLD",1018 9,1,38,0)
	10688	Architectu re (VistA) systems.
	10689	"BLD",1018 9,1,39,0)
	10690
	10691	"BLD",1018 9,1,40,0)
	10692	NSR #20150 507
	10693	"BLD",1018 9,1,41,0)
	10694	The Revenu e Operatio ns Enhance ments Proj ect combin es servera l NSRs, as
	10695	"BLD",1018 9,1,42,0)
	10696	well. This effort en ables the Department of Vetera ns Affairs (VA) to
	10697	"BLD",1018 9,1,43,0)
	10698	improve re venue oper ation func tionality related to repayment plans,
	10699	"BLD",1018 9,1,44,0)
	10700	late charg e capture, bill susp ension rea sons, the billing of
	10701	"BLD",1018 9,1,45,0)
	10702	deactivate d provider s, and the display o f appeal r ights and
	10703	"BLD",1018 9,1,46,0)
	10704	responsibi lities on the Vetera ns Benefic iary trave l Bill of Collection s
	10705	"BLD",1018 9,1,47,0)
	10706	form. Imp lementatio n of the p roposed en hancements will make a
	10707	"BLD",1018 9,1,48,0)
	10708	significan t positive impact on stakehold ers and ta rget users .
	10709	"BLD",1018 9,1,49,0)
	10710
	10711	"BLD",1018 9,1,50,0)
	10712	NSR #20150 505
	10713	"BLD",1018 9,1,51,0)
	10714	The Revenu e Reportin g Enhancem ents Proje ct will en able the V A to
	10715	"BLD",1018 9,1,52,0)
	10716	improve tr acking and reporting of revenu e, and wil l support revenue
	10717	"BLD",1018 9,1,53,0)
	10718	reporting business r ules and g uidelines.
	10719	"BLD",1018 9,1,54,0)
	10720
	10721	"BLD",1018 9,1,55,0)
	10722
	10723	"BLD",1018 9,1,56,0)
	10724	PSO7.046 3 patch en hancements , pertinen t to the a bove NSRs, include:
	10725	"BLD",1018 9,1,57,0)
	10726
	10727	"BLD",1018 9,1,58,0)
	10728	1.) In the event of a Prescrip tion Reset Status/Ca ncel Charg es action,
	10729	"BLD",1018 9,1,59,0)
	10730	all automa tic prepay ment gener ation shal l be
	10731	"BLD",1018 9,1,60,0)
	10732	eliminated .
	10733	"BLD",1018 9,1,61,0)
	10734
	10735	"BLD",1018 9,1,62,0)
	10736	2.) All "c redit bala nces" that are autom atically g enerated i n the even t
	10737	"BLD",1018 9,1,63,0)
	10738	of a Presc ription Re set Status /Cancel Ch arges acti on exempti on to stop .
	10739	"BLD",1018 9,1,64,0)
	10740
	10741	"BLD",1018 9,1,65,0)
	10742	3.) A new on-demand List Manag er report will be ma de availab le for
	10743	"BLD",1018 9,1,66,0)
	10744	identifica tion of Pr escription resets.
	10745	"BLD",1018 9,1,67,0)
	10746
	10747	"BLD",1018 9,1,68,0)
	10748	4.) The ne w on-deman d report f or process ing Prescr iption Res ets will
	10749	"BLD",1018 9,1,69,0)
	10750	provide an option to generate a Summary Report and /or Detail ed Report.
	10751	"BLD",1018 9,1,70,0)
	10752
	10753	"BLD",1018 9,1,71,0)
	10754
	10755	"BLD",1018 9,1,72,0)
	10756
	10757	"BLD",1018 9,1,73,0)
	10758	Concurrent Developme nt / Depen dencies:
	10759	"BLD",1018 9,1,74,0)
	10760	---------- ---------- ---------- --------
	10761	"BLD",1018 9,1,75,0)
	10762	N/A
	10763	"BLD",1018 9,1,76,0)
	10764
	10765	"BLD",1018 9,1,77,0)
	10766
	10767	"BLD",1018 9,1,78,0)
	10768	Patch Comp onents:
	10769	"BLD",1018 9,1,79,0)
	10770	---------- -------
	10771	"BLD",1018 9,1,80,0)
	10772
	10773	"BLD",1018 9,1,81,0)
	10774	Files & Fi elds Assoc iated:
	10775	"BLD",1018 9,1,82,0)
	10776
	10777	"BLD",1018 9,1,83,0)
	10778	File Name (Number) Field Na me (Number ) New/ Modified/D eleted
	10779	"BLD",1018 9,1,84,0)
	10780	---------- -------- -------- ---------- - ---- ---------- ------
	10781	"BLD",1018 9,1,85,0)
	10782	N/A
	10783	"BLD",1018 9,1,86,0)
	10784
	10785	"BLD",1018 9,1,87,0)
	10786	Options As sociated:
	10787	"BLD",1018 9,1,88,0)
	10788
	10789	"BLD",1018 9,1,89,0)
	10790	Option Nam e Type New/ Modified/D eleted
	10791	"BLD",1018 9,1,90,0)
	10792	---------- - ---- ---- ---------- ------
	10793	"BLD",1018 9,1,91,0)
	10794	PSOCP RESE T COPAY ST ATUS LM ROUTINE NEW
	10795	"BLD",1018 9,1,92,0)
	10796
	10797	"BLD",1018 9,1,93,0)
	10798	Protocols Associated :
	10799	"BLD",1018 9,1,94,0)
	10800
	10801	"BLD",1018 9,1,95,0)
	10802	Protocol N ame New /Modified/ Deleted
	10803	"BLD",1018 9,1,96,0)
	10804	---------- --- --- ---------- -------
	10805	"BLD",1018 9,1,97,0)
	10806	PSO PATIEN T MED ACC PRO NEW
	10807	"BLD",1018 9,1,98,0)
	10808	PSO PATIEN T MED BILL PRO NEW
	10809	"BLD",1018 9,1,99,0)
	10810	PSO PATIEN T MED CANC EL NEW
	10811	"BLD",1018 9,1,100,0)
	10812	PSO PATIEN T MED EXPO RT NEW
	10813	"BLD",1018 9,1,101,0)
	10814	PSO PATIEN T MED PAT INQ NEW
	10815	"BLD",1018 9,1,102,0)
	10816	PSO PATIEN T MED RESE T NEW
	10817	"BLD",1018 9,1,103,0)
	10818	PSO PATIEN T MED TPJI NEW
	10819	"BLD",1018 9,1,104,0)
	10820	PSO PATIEN T MEDICATI ON MENU
	10821	"BLD",1018 9,1,105,0)
	10822
	10823	"BLD",1018 9,1,106,0)
	10824	Templates Associated :
	10825	"BLD",1018 9,1,107,0)
	10826
	10827	"BLD",1018 9,1,108,0)
	10828	Template N ame T ype File Name (Num ber) New/Mod/De l
	10829	"BLD",1018 9,1,109,0)
	10830	---------- --- - --- ---- ---------- ---- ---------- -
	10831	"BLD",1018 9,1,110,0)
	10832	PSO PATIEN T MEDICATI ON LIST L IST NEW
	10833	"BLD",1018 9,1,111,0)
	10834
	10835	"BLD",1018 9,1,112,0)
	10836	New Servic e Requests (NSRs):
	10837	"BLD",1018 9,1,113,0)
	10838	---------- ---------- --------
	10839	"BLD",1018 9,1,114,0)
	10840	20150505 - Revenue R eporting E nhancement s
	10841	"BLD",1018 9,1,115,0)
	10842	20150506 - Revenue E ligibility Enhanceme nts
	10843	"BLD",1018 9,1,116,0)
	10844	20150507 - Revenue O perations Enhancemen ts
	10845	"BLD",1018 9,1,117,0)
	10846
	10847	"BLD",1018 9,1,118,0)
	10848
	10849	"BLD",1018 9,1,119,0)
	10850	Patient Sa fety Issue s (PSIs):
	10851	"BLD",1018 9,1,120,0)
	10852	---------- ---------- ----------
	10853	"BLD",1018 9,1,121,0)
	10854	N/A
	10855	"BLD",1018 9,1,122,0)
	10856
	10857	"BLD",1018 9,1,123,0)
	10858
	10859	"BLD",1018 9,1,124,0)
	10860	Remedy Tic ket(s) & O verviews:
	10861	"BLD",1018 9,1,125,0)
	10862	---------- ---------- ---------
	10863	"BLD",1018 9,1,126,0)
	10864	N/A
	10865	"BLD",1018 9,1,127,0)
	10866
	10867	"BLD",1018 9,1,128,0)
	10868	Test Sites :
	10869	"BLD",1018 9,1,129,0)
	10870	----------
	10871	"BLD",1018 9,1,130,0)
	10872	Durham VAM C
	10873	"BLD",1018 9,1,131,0)
	10874
	10875	"BLD",1018 9,1,132,0)
	10876
	10877	"BLD",1018 9,1,133,0)
	10878	Software a nd Documen tation Ret rieval Ins tructions:
	10879	"BLD",1018 9,1,134,0)
	10880	---------- ---------- ---------- ---------- ---------- --
	10881	"BLD",1018 9,1,135,0)
	10882	Patches fo r this ins tallation are combin ed in host file
	10883	"BLD",1018 9,1,136,0)
	10884	IB_2_568_P RCA_PSO_BU NDLE_T1.KI D
	10885	"BLD",1018 9,1,137,0)
	10886
	10887	"BLD",1018 9,1,138,0)
	10888	Installati on of this host file should be coordinat ed among t he package s
	10889	"BLD",1018 9,1,139,0)
	10890	affected s ince only one instal lation is necessary.
	10891	"BLD",1018 9,1,140,0)
	10892
	10893	"BLD",1018 9,1,141,0)
	10894	The patche s are:
	10895	"BLD",1018 9,1,142,0)
	10896
	10897	"BLD",1018 9,1,143,0)
	10898	IB2. 0568
	10899	"BLD",1018 9,1,144,0)
	10900	PRCA* 4.5*315
	10901	"BLD",1018 9,1,145,0)
	10902	PSO7 .0463
	10903	"BLD",1018 9,1,146,0)
	10904
	10905	"BLD",1018 9,1,147,0)
	10906
	10907	"BLD",1018 9,1,148,0)
	10908	Sites may retrieve t he KIDS bu ild in one of the fo llowing wa ys:
	10909	"BLD",1018 9,1,149,0)
	10910
	10911	"BLD",1018 9,1,150,0)
	10912	(1) The pr eferred me thod is to FTP the f iles from
	10913	"BLD",1018 9,1,151,0)
	10914	download. DNS . DNS which will transmit the files from the
	10915	"BLD",1018 9,1,152,0)
	10916	first avai lable FTP server.
	10917	"BLD",1018 9,1,153,0)
	10918
	10919	"BLD",1018 9,1,154,0)
	10920	(2) Sites may also e lect to re trieve the patch dir ectly from a specifi c
	10921	"BLD",1018 9,1,155,0)
	10922	server as follows:
	10923	"BLD",1018 9,1,156,0)
	10924
	10925	"BLD",1018 9,1,157,0)
	10926	OIFO FTP ADDRE SS DIRECTORY
	10927	"BLD",1018 9,1,158,0)
	10928	-------- ------ --------- ---------- ----- ---------- --------
	10929	"BLD",1018 9,1,159,0)
	10930	Albany DNS . URL anonymous. software
	10931	"BLD",1018 9,1,160,0)
	10932	Hines DNS . DNS . URL anonymous. software
	10933	"BLD",1018 9,1,161,0)
	10934	Salt Lake City DNS . URL anonymous. software
	10935	"BLD",1018 9,1,162,0)
	10936
	10937	"BLD",1018 9,1,163,0)
	10938
	10939	"BLD",1018 9,1,164,0)
	10940	Sites may retrieve d ocumentati on directl y using Se cure File Transfer
	10941	"BLD",1018 9,1,165,0)
	10942	Protocol ( SFTP) from the ANONY MOUS.SOFTW ARE direct ory at the following
	10943	"BLD",1018 9,1,166,0)
	10944	OI Field O ffices:
	10945	"BLD",1018 9,1,167,0)
	10946
	10947	"BLD",1018 9,1,168,0)
	10948	Albany: DNS.URL
	10949	"BLD",1018 9,1,169,0)
	10950	Hines: DNS .U RL
	10951	"BLD",1018 9,1,170,0)
	10952	Salt Lake City: DNS . URL
	10953	"BLD",1018 9,1,171,0)
	10954
	10955	"BLD",1018 9,1,172,0)
	10956	Documentat ion can al so be foun d on the V A Software Documenta tion Libra ry
	10957	"BLD",1018 9,1,173,0)
	10958	at:
	10959	"BLD",1018 9,1,174,0)
	10960	http:// URL /
	10961	"BLD",1018 9,1,175,0)
	10962
	10963	"BLD",1018 9,1,176,0)
	10964	Title File Name FTP Mode
	10965	"BLD",1018 9,1,177,0)
	10966	---------- ---------- ---------- ---------- ---------- ---------- ---------
	10967	"BLD",1018 9,1,178,0)
	10968	Outpatient Pharmacy Technical Manual/Sec urity Guid e
	10969	"BLD",1018 9,1,179,0)
	10970	pso_7_tm.d oc Binary
	10971	"BLD",1018 9,1,180,0)
	10972	Outpatient Pharmacy Deployment , Installa tion,
	10973	"BLD",1018 9,1,181,0)
	10974	Back- Out, and R ollback Gu ide
	10975	"BLD",1018 9,1,182,0)
	10976	FY16Re venuePSOVI P_Deployme nt_Install ation_Guid e.doc
	10977	"BLD",1018 9,1,183,0)
	10978	Binary
	10979	"BLD",1018 9,1,184,0)
	10980
	10981	"BLD",1018 9,1,185,0)
	10982
	10983	"BLD",1018 9,1,186,0)
	10984
	10985	"BLD",1018 9,1,187,0)
	10986	Patch Inst allation:
	10987	"BLD",1018 9,1,188,0)
	10988
	10989	"BLD",1018 9,1,189,0)
	10990	Pre/Post I nstallatio n Overview :
	10991	"BLD",1018 9,1,190,0)
	10992	---------- ---------- ---------- -
	10993	"BLD",1018 9,1,191,0)
	10994	N/A
	10995	"BLD",1018 9,1,192,0)
	10996
	10997	"BLD",1018 9,1,193,0)
	10998	Pre-Instal lation Ins tructions:
	10999	"BLD",1018 9,1,194,0)
	11000	---------- ---------- ----------
	11001	"BLD",1018 9,1,195,0)
	11002	N/A
	11003	"BLD",1018 9,1,196,0)
	11004
	11005	"BLD",1018 9,1,197,0)
	11006	Installati on Instruc tions:
	11007	"BLD",1018 9,1,198,0)
	11008	---------- ---------- ------
	11009	"BLD",1018 9,1,199,0)
	11010	This proce ss will in stall new and update d routines and other
	11011	"BLD",1018 9,1,200,0)
	11012	components listed ab ove. There is a post -install r outine tha t will add
	11013	"BLD",1018 9,1,201,0)
	11014	entries to a number of files.
	11015	"BLD",1018 9,1,202,0)
	11016
	11017	"BLD",1018 9,1,203,0)
	11018	The patch will be re leased in conjunctio n with an Integrated Billing
	11019	"BLD",1018 9,1,204,0)
	11020	patch, IB* 4.5568, a nd an Outp atient Pha rmacy patc h, PSO7.0 *463.
	11021	"BLD",1018 9,1,205,0)
	11022
	11023	"BLD",1018 9,1,206,0)
	11024	****** ****** ** NOT E **** ****** ****
	11025	"BLD",1018 9,1,207,0)
	11026	IF A USE R IS ON TH E SYSTEM A ND USING T HESE PROGR AMS
	11027	"BLD",1018 9,1,208,0)
	11028	AN EDITE D ERROR WI LL OCCUR.
	11029	"BLD",1018 9,1,209,0)
	11030	The patc h should b e installe d when NO Outpatient
	11031	"BLD",1018 9,1,210,0)
	11032	Pharmacy users are on the sy stem.
	11033	"BLD",1018 9,1,211,0)
	11034	****** ****** ****** ****** ****** ****
	11035	"BLD",1018 9,1,212,0)
	11036
	11037	"BLD",1018 9,1,213,0)
	11038	Installat ion will t ake less t han 1 minu te.
	11039	"BLD",1018 9,1,214,0)
	11040
	11041	"BLD",1018 9,1,215,0)
	11042	Suggested time to i nstall: no n-peak req uirement h ours.
	11043	"BLD",1018 9,1,216,0)
	11044
	11045	"BLD",1018 9,1,217,0)
	11046
	11047	"BLD",1018 9,1,218,0)
	11048	1. Obtai n the file IB_2_568_ PRCA_PSO_B UNDLE_T1.K ID
	11049	"BLD",1018 9,1,219,0)
	11050
	11051	"BLD",1018 9,1,220,0)
	11052	2. From the Kernel Installat ion & Dist ribution S ystem menu , select
	11053	"BLD",1018 9,1,221,0)
	11054	the I nstallatio n menu.
	11055	"BLD",1018 9,1,222,0)
	11056
	11057	"BLD",1018 9,1,223,0)
	11058	3. Use L oad a Dist ribution u sing IB_2_ 568_PRCA_P SO_BUNDLE_ T1.KID whe n
	11059	"BLD",1018 9,1,224,0)
	11060	promp ted to Ent er a Host File name. You may need to ap pend a
	11061	"BLD",1018 9,1,225,0)
	11062	direc tory name.
	11063	"BLD",1018 9,1,226,0)
	11064
	11065	"BLD",1018 9,1,227,0)
	11066	4. From this menu, you may s elect to u se the fol lowing opt ions
	11067	"BLD",1018 9,1,228,0)
	11068	(when prompted for INSTAL L NAME, en ter IB2.0 568):
	11069	"BLD",1018 9,1,229,0)
	11070	a . Verify Checksums in Transpo rt Global - This opt ion will
	11071	"BLD",1018 9,1,230,0)
	11072	allow y ou to ensu re the int egrity of the routin es that
	11073	"BLD",1018 9,1,231,0)
	11074	are in the transp ort global .
	11075	"BLD",1018 9,1,232,0)
	11076	b . Print T ransport G lobal - Th is option will allow you to
	11077	"BLD",1018 9,1,233,0)
	11078	view th e componen ts of the KIDS build .
	11079	"BLD",1018 9,1,234,0)
	11080	c . Compare Transport Global to Current S ystem - Th is option
	11081	"BLD",1018 9,1,235,0)
	11082	will al low you to view all changes th at will be made when
	11083	"BLD",1018 9,1,236,0)
	11084	this pa tch is ins talled. I t compares all compo nents of
	11085	"BLD",1018 9,1,237,0)
	11086	this pa tch (routi nes, DD's, templates , etc.).
	11087	"BLD",1018 9,1,238,0)
	11088	d . Backup a Transpor t Global - This opti on will cr eate a
	11089	"BLD",1018 9,1,239,0)
	11090	backup message of any routi nes export ed with th is patch.
	11091	"BLD",1018 9,1,240,0)
	11092	It will not backu p any othe r changes such as DD 's or
	11093	"BLD",1018 9,1,241,0)
	11094	templat es.
	11095	"BLD",1018 9,1,242,0)
	11096
	11097	"BLD",1018 9,1,243,0)
	11098	5. When prompted " Want KIDS to INHIBIT LOGONs du ring the i nstall?
	11099	"BLD",1018 9,1,244,0)
	11100	NO//" respond N O.
	11101	"BLD",1018 9,1,245,0)
	11102
	11103	"BLD",1018 9,1,246,0)
	11104	6. When prompted " Want to DI SABLE Sche duled Opti ons, Menu Options,
	11105	"BLD",1018 9,1,247,0)
	11106	and P rotocols? NO//" resp ond NO.
	11107	"BLD",1018 9,1,248,0)
	11108
	11109	"BLD",1018 9,1,249,0)
	11110
	11111	"BLD",1018 9,1,250,0)
	11112
	11113	"BLD",1018 9,1,251,0)
	11114	Post-Insta llation In structions :
	11115	"BLD",1018 9,1,252,0)
	11116	---------- ---------- ---------- -
	11117	"BLD",1018 9,1,253,0)
	11118	There are no special tasks to perform af ter this p atch insta llation.
	11119	"BLD",1018 9,4,0)
	11120	^9.64PA^^
	11121	"BLD",1018 9,6.3)
	11122	11
	11123	"BLD",1018 9,"ABPKG")
	11124	n
	11125	"BLD",1018 9,"INID")
	11126	n^n^n
	11127	"BLD",1018 9,"KRN",0)
	11128	^9.67PA^77 9.2^20
	11129	"BLD",1018 9,"KRN",.4 ,0)
	11130	.4
	11131	"BLD",1018 9,"KRN",.4 01,0)
	11132	.401
	11133	"BLD",1018 9,"KRN",.4 02,0)
	11134	.402
	11135	"BLD",1018 9,"KRN",.4 03,0)
	11136	.403
	11137	"BLD",1018 9,"KRN",.5 ,0)
	11138	.5
	11139	"BLD",1018 9,"KRN",.8 4,0)
	11140	.84
	11141	"BLD",1018 9,"KRN",3. 6,0)
	11142	3.6
	11143	"BLD",1018 9,"KRN",3. 8,0)
	11144	3.8
	11145	"BLD",1018 9,"KRN",9. 2,0)
	11146	9.2
	11147	"BLD",1018 9,"KRN",9. 8,0)
	11148	9.8
	11149	"BLD",1018 9,"KRN",9. 8,"NM",0)
	11150	^9.68A^4^4
	11151	"BLD",1018 9,"KRN",9. 8,"NM",1,0 )
	11152	PSOCPB^^0^ B84712258
	11153	"BLD",1018 9,"KRN",9. 8,"NM",2,0 )
	11154	PSOCPF^^0^ B116045654
	11155	"BLD",1018 9,"KRN",9. 8,"NM",3,0 )
	11156	PSOCPF1^^0 ^B37268746
	11157	"BLD",1018 9,"KRN",9. 8,"NM",4,0 )
	11158	PSOCPF2^^0 ^B12469058
	11159	"BLD",1018 9,"KRN",9. 8,"NM","B" ,"PSOCPB", 1)
	11160
	11161	"BLD",1018 9,"KRN",9. 8,"NM","B" ,"PSOCPF", 2)
	11162
	11163	"BLD",1018 9,"KRN",9. 8,"NM","B" ,"PSOCPF1" ,3)
	11164
	11165	"BLD",1018 9,"KRN",9. 8,"NM","B" ,"PSOCPF2" ,4)
	11166
	11167	"BLD",1018 9,"KRN",19 ,0)
	11168	19
	11169	"BLD",1018 9,"KRN",19 ,"NM",0)
	11170	^9.68A^1^1
	11171	"BLD",1018 9,"KRN",19 ,"NM",1,0)
	11172	PSOCP RESE T COPAY ST ATUS LM^^0
	11173	"BLD",1018 9,"KRN",19 ,"NM","B", "PSOCP RES ET COPAY S TATUS LM", 1)
	11174
	11175	"BLD",1018 9,"KRN",19 .1,0)
	11176	19.1
	11177	"BLD",1018 9,"KRN",10 1,0)
	11178	101
	11179	"BLD",1018 9,"KRN",10 1,"NM",0)
	11180	^9.68A^8^8
	11181	"BLD",1018 9,"KRN",10 1,"NM",1,0 )
	11182	PSO PATIEN T MEDICATI ON MENU^^0
	11183	"BLD",1018 9,"KRN",10 1,"NM",2,0 )
	11184	PSO PATIEN T MED ACC PRO^^0
	11185	"BLD",1018 9,"KRN",10 1,"NM",3,0 )
	11186	PSO PATIEN T MED BILL PRO^^0
	11187	"BLD",1018 9,"KRN",10 1,"NM",4,0 )
	11188	PSO PATIEN T MED PAT INQ^^0
	11189	"BLD",1018 9,"KRN",10 1,"NM",5,0 )
	11190	PSO PATIEN T MED TPJI ^^0
	11191	"BLD",1018 9,"KRN",10 1,"NM",6,0 )
	11192	PSO PATIEN T MED CANC EL^^0
	11193	"BLD",1018 9,"KRN",10 1,"NM",7,0 )
	11194	PSO PATIEN T MED RESE T^^0
	11195	"BLD",1018 9,"KRN",10 1,"NM",8,0 )
	11196	PSO PATIEN T MED EXPO RT^^0
	11197	"BLD",1018 9,"KRN",10 1,"NM","B" ,"PSO PATI ENT MED AC C PRO",2)
	11198
	11199	"BLD",1018 9,"KRN",10 1,"NM","B" ,"PSO PATI ENT MED BI LL PRO",3)
	11200
	11201	"BLD",1018 9,"KRN",10 1,"NM","B" ,"PSO PATI ENT MED CA NCEL",6)
	11202
	11203	"BLD",1018 9,"KRN",10 1,"NM","B" ,"PSO PATI ENT MED EX PORT",8)
	11204
	11205	"BLD",1018 9,"KRN",10 1,"NM","B" ,"PSO PATI ENT MED PA T INQ",4)
	11206
	11207	"BLD",1018 9,"KRN",10 1,"NM","B" ,"PSO PATI ENT MED RE SET",7)
	11208
	11209	"BLD",1018 9,"KRN",10 1,"NM","B" ,"PSO PATI ENT MED TP JI",5)
	11210
	11211	"BLD",1018 9,"KRN",10 1,"NM","B" ,"PSO PATI ENT MEDICA TION MENU" ,1)
	11212
	11213	"BLD",1018 9,"KRN",40 9.61,0)
	11214	409.61
	11215	"BLD",1018 9,"KRN",40 9.61,"NM", 0)
	11216	^9.68A^1^1
	11217	"BLD",1018 9,"KRN",40 9.61,"NM", 1,0)
	11218	PSO PATIEN T MEDICATI ON LIST^^0
	11219	"BLD",1018 9,"KRN",40 9.61,"NM", "B","PSO P ATIENT MED ICATION LI ST",1)
	11220
	11221	"BLD",1018 9,"KRN",77 1,0)
	11222	771
	11223	"BLD",1018 9,"KRN",77 9.2,0)
	11224	779.2
	11225	"BLD",1018 9,"KRN",87 0,0)
	11226	870
	11227	"BLD",1018 9,"KRN",89 89.51,0)
	11228	8989.51
	11229	"BLD",1018 9,"KRN",89 89.52,0)
	11230	8989.52
	11231	"BLD",1018 9,"KRN",89 94,0)
	11232	8994
	11233	"BLD",1018 9,"KRN","B ",.4,.4)
	11234
	11235	"BLD",1018 9,"KRN","B ",.401,.40 1)
	11236
	11237	"BLD",1018 9,"KRN","B ",.402,.40 2)
	11238
	11239	"BLD",1018 9,"KRN","B ",.403,.40 3)
	11240
	11241	"BLD",1018 9,"KRN","B ",.5,.5)
	11242
	11243	"BLD",1018 9,"KRN","B ",.84,.84)
	11244
	11245	"BLD",1018 9,"KRN","B ",3.6,3.6)
	11246
	11247	"BLD",1018 9,"KRN","B ",3.8,3.8)
	11248
	11249	"BLD",1018 9,"KRN","B ",9.2,9.2)
	11250
	11251	"BLD",1018 9,"KRN","B ",9.8,9.8)
	11252
	11253	"BLD",1018 9,"KRN","B ",19,19)
	11254
	11255	"BLD",1018 9,"KRN","B ",19.1,19. 1)
	11256
	11257	"BLD",1018 9,"KRN","B ",101,101)
	11258
	11259	"BLD",1018 9,"KRN","B ",409.61,4 09.61)
	11260
	11261	"BLD",1018 9,"KRN","B ",771,771)
	11262
	11263	"BLD",1018 9,"KRN","B ",779.2,77 9.2)
	11264
	11265	"BLD",1018 9,"KRN","B ",870,870)
	11266
	11267	"BLD",1018 9,"KRN","B ",8989.51, 8989.51)
	11268
	11269	"BLD",1018 9,"KRN","B ",8989.52, 8989.52)
	11270
	11271	"BLD",1018 9,"KRN","B ",8994,899 4)
	11272
	11273	"BLD",1018 9,"QDEF")
	11274	^^^^NO^^^^ NO^^NO
	11275	"BLD",1018 9,"QUES",0 )
	11276	^9.62^^
	11277	"BLD",1018 9,"REQB",0 )
	11278	^9.611^^
	11279	"KRN",19,1 1652,-1)
	11280	0^1
	11281	"KRN",19,1 1652,0)
	11282	PSOCP RESE T COPAY ST ATUS LM^Re set Copay Status Lis t Manager^ ^R^^^^^^^^ OUTPATIENT PHARMACY
	11283	"KRN",19,1 1652,1,0)
	11284	^^2^2^3160 901^
	11285	"KRN",19,1 1652,1,1,0 )
	11286	This list manager wi ll allow t he users t o reset ph armacy cop ay status and
	11287	"KRN",19,1 1652,1,2,0 )
	11288	to cancel copay char ges easier .
	11289	"KRN",19,1 1652,25)
	11290	EN^PSOCPF
	11291	"KRN",19,1 1652,"U")
	11292	RESET COPA Y STATUS L IST MANAGE
	11293	"KRN",101, 4763,-1)
	11294	0^1
	11295	"KRN",101, 4763,0)
	11296	PSO PATIEN T MEDICATI ON MENU^PS OCP MEDICA TION COPAY LM^^M^^^^ ^^^^OUTPAT IENT PHARM ACY
	11297	"KRN",101, 4763,4)
	11298	26^3
	11299	"KRN",101, 4763,10,0)
	11300	^101.01PA^ 8^8
	11301	"KRN",101, 4763,10,1, 0)
	11302	4764^RE^11 ^^^Reset S tatus
	11303	"KRN",101, 4763,10,1, "^")
	11304	PSO PATIEN T MED RESE T
	11305	"KRN",101, 4763,10,2, 0)
	11306	4765^CA^12 ^^^Cancel Payment
	11307	"KRN",101, 4763,10,2, "^")
	11308	PSO PATIEN T MED CANC EL
	11309	"KRN",101, 4763,10,3, 0)
	11310	4766^EC^13 ^^^Excel R eport
	11311	"KRN",101, 4763,10,3, "^")
	11312	PSO PATIEN T MED EXPO RT
	11313	"KRN",101, 4763,10,4, 0)
	11314	4959^AP^21 ^^^Account Profile
	11315	"KRN",101, 4763,10,4, "^")
	11316	PSO PATIEN T MED ACC PRO
	11317	"KRN",101, 4763,10,6, 0)
	11318	4961^TP^32 ^^^Third P arty
	11319	"KRN",101, 4763,10,6, "^")
	11320	PSO PATIEN T MED TPJI
	11321	"KRN",101, 4763,10,7, 0)
	11322	4962^PI^23 ^^^Patient Inquiry
	11323	"KRN",101, 4763,10,7, "^")
	11324	PSO PATIEN T MED PAT INQ
	11325	"KRN",101, 4763,10,8, 0)
	11326	4963^BP^31 ^^^Bill Pr ofile
	11327	"KRN",101, 4763,10,8, "^")
	11328	PSO PATIEN T MED BILL PRO
	11329	"KRN",101, 4763,26)
	11330	D SHOW^VAL M
	11331	"KRN",101, 4763,28)
	11332	Select Act ion:
	11333	"KRN",101, 4763,99)
	11334	64250,4889 2
	11335	"KRN",101, 4764,-1)
	11336	0^7
	11337	"KRN",101, 4764,0)
	11338	PSO PATIEN T MED RESE T^PSO PATI ENT MED RE SET^^A^^^^ ^^^^OUTPAT IENT PHARM ACY
	11339	"KRN",101, 4764,20)
	11340	D RESET^PS OCPF1
	11341	"KRN",101, 4764,99)
	11342	64154,2875 6
	11343	"KRN",101, 4765,-1)
	11344	0^6
	11345	"KRN",101, 4765,0)
	11346	PSO PATIEN T MED CANC EL^PSO PAT IENT MED C ANCEL CHAR GE^^A^^^^^ ^^^
	11347	"KRN",101, 4765,20)
	11348	D CANCEL^P SOCPF1
	11349	"KRN",101, 4765,99)
	11350	64223,4855 3
	11351	"KRN",101, 4766,-1)
	11352	0^8
	11353	"KRN",101, 4766,0)
	11354	PSO PATIEN T MED EXPO RT^PSO PAT IENT MED E XCEL REPOR T^^A^^^^^^ ^^
	11355	"KRN",101, 4766,20)
	11356	D EXPORT^P SOCPF1
	11357	"KRN",101, 4766,99)
	11358	64223,4921 2
	11359	"KRN",101, 4959,-1)
	11360	0^2
	11361	"KRN",101, 4959,0)
	11362	PSO PATIEN T MED ACC PRO^PSO PA TIENT ACCO UNT PROFIL E^^A^^^^^^ ^^OUTPATIE NT PHARMAC Y
	11363	"KRN",101, 4959,2,0)
	11364	^101.02A^^ 0
	11365	"KRN",101, 4959,20)
	11366	D PATACP^P SOCPF2
	11367	"KRN",101, 4959,99)
	11368	64223,4806 1
	11369	"KRN",101, 4961,-1)
	11370	0^5
	11371	"KRN",101, 4961,0)
	11372	PSO PATIEN T MED TPJI ^PSO PATIE NT MED TPJ I^^A^^^^^^ ^^OUTPATIE NT PHARMAC Y
	11373	"KRN",101, 4961,2,0)
	11374	^101.02A^^ 0
	11375	"KRN",101, 4961,20)
	11376	D TPJI^PSO CPF2
	11377	"KRN",101, 4961,99)
	11378	64223,4827 9
	11379	"KRN",101, 4962,-1)
	11380	0^4
	11381	"KRN",101, 4962,0)
	11382	PSO PATIEN T MED PAT INQ^PSO PA TIENT PATI ENT INQ^^A ^^^^^^^^OU TPATIENT P HARMACY
	11383	"KRN",101, 4962,2,0)
	11384	^101.02A^^ 0
	11385	"KRN",101, 4962,20)
	11386	D PATINQ^P SOCPF2
	11387	"KRN",101, 4962,99)
	11388	64223,4924 4
	11389	"KRN",101, 4963,-1)
	11390	0^3
	11391	"KRN",101, 4963,0)
	11392	PSO PATIEN T MED BILL PRO^PSO P ATIENT BIL L PROFILE^ ^A^^^^^^^^ OUTPATIENT PHARMACY
	11393	"KRN",101, 4963,20)
	11394	D BILPRO^P SOCPF2
	11395	"KRN",101, 4963,99)
	11396	64223,4849 2
	11397	"KRN",409. 61,717,-1)
	11398	0^1
	11399	"KRN",409. 61,717,0)
	11400	PSO PATIEN T MEDICATI ON LIST^1^ ^80^3^18^1 ^1^^PSO PA TIENT MEDI CATION MEN U^Patient Medication s^1^^
	11401	"KRN",409. 61,717,1)
	11402	^PSO HIDDE N ACTIONS #4
	11403	"KRN",409. 61,717,"CO L",0)
	11404	^409.621^6 ^6
	11405	"KRN",409. 61,717,"CO L",1,0)
	11406	LINE^1^4^^ ^0
	11407	"KRN",409. 61,717,"CO L",2,0)
	11408	NAME^6^27^ Patient Na me^^0
	11409	"KRN",409. 61,717,"CO L",3,0)
	11410	PID^29^5^I D^^0
	11411	"KRN",409. 61,717,"CO L",4,0)
	11412	MED^36^26^ Medication ^^0
	11413	"KRN",409. 61,717,"CO L",5,0)
	11414	FLDT^54^8^ Fill DT^^0
	11415	"KRN",409. 61,717,"CO L",6,0)
	11416	STAT^63^15 ^Status^^0
	11417	"KRN",409. 61,717,"CO L","AIDENT ",0,1)
	11418
	11419	"KRN",409. 61,717,"CO L","AIDENT ",0,2)
	11420
	11421	"KRN",409. 61,717,"CO L","AIDENT ",0,3)
	11422
	11423	"KRN",409. 61,717,"CO L","AIDENT ",0,4)
	11424
	11425	"KRN",409. 61,717,"CO L","AIDENT ",0,5)
	11426
	11427	"KRN",409. 61,717,"CO L","AIDENT ",0,6)
	11428
	11429	"KRN",409. 61,717,"CO L","B","FL DT",5)
	11430
	11431	"KRN",409. 61,717,"CO L","B","LI NE",1)
	11432
	11433	"KRN",409. 61,717,"CO L","B","ME D",4)
	11434
	11435	"KRN",409. 61,717,"CO L","B","NA ME",2)
	11436
	11437	"KRN",409. 61,717,"CO L","B","PI D",3)
	11438
	11439	"KRN",409. 61,717,"CO L","B","ST AT",6)
	11440
	11441	"KRN",409. 61,717,"FN L")
	11442	D EXIT^PSO CPF
	11443	"KRN",409. 61,717,"HD R")
	11444	D HDR^PSOC PF
	11445	"KRN",409. 61,717,"HL P")
	11446	D HELP^PSO CPF
	11447	"KRN",409. 61,717,"IN IT")
	11448	D INIT^PSO CPF
	11449	"MBREQ")
	11450	1
	11451	"ORD",15,1 01)
	11452	101;15;;;P RO^XPDTA;P ROF1^XPDIA ;PROE1^XPD IA;PROF2^X PDIA;;PROD EL^XPDIA
	11453	"ORD",15,1 01,0)
	11454	PROTOCOL
	11455	"ORD",17,4 09.61)
	11456	409.61;17; 1;;;;LME1^ XPDIA1;;;L MDEL^XPDIA 1
	11457	"ORD",17,4 09.61,0)
	11458	LIST TEMPL ATE
	11459	"ORD",18,1 9)
	11460	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	11461	"ORD",18,1 9,0)
	11462	OPTION
	11463	"PKG",60,- 1)
	11464	1^1
	11465	"PKG",60,0 )
	11466	OUTPATIENT PHARMACY^ PSO^OUTPAT IENT LABEL S, PROFILE , INVENTOR Y, PRESCRI PTIONS
	11467	"PKG",60,2 0,0)
	11468	^9.402P^^
	11469	"PKG",60,2 2,0)
	11470	^9.49I^1^1
	11471	"PKG",60,2 2,1,0)
	11472	7.0^305111 9^2990416^ 1
	11473	"PKG",60,2 2,1,"PAH", 1,0)
	11474	463^316121 5
	11475	"PKG",60,2 2,1,"PAH", 1,1,0)
	11476	^^253^253^ 3161215
	11477	"PKG",60,2 2,1,"PAH", 1,1,1,0)
	11478
	11479	"PKG",60,2 2,1,"PAH", 1,1,2,0)
	11480	IMPORTANT INSTALLATI ON NOTE:
	11481	"PKG",60,2 2,1,"PAH", 1,1,3,0)
	11482	---------- ---------- --------
	11483	"PKG",60,2 2,1,"PAH", 1,1,4,0)
	11484	This patch is part o f a multi- package bu ild. There are three patches
	11485	"PKG",60,2 2,1,"PAH", 1,1,5,0)
	11486	associated with the FY16 HAPE Revenue En hancement project - IB2.0568 ,
	11487	"PKG",60,2 2,1,"PAH", 1,1,6,0)
	11488	PRCA4.53 15 and PSO 7.0463. All three patches ar e to be in stalled
	11489	"PKG",60,2 2,1,"PAH", 1,1,7,0)
	11490	together a s a bundle , IB_2_568 _PRCA_PSO_ BUNDLE_T1. KID
	11491	"PKG",60,2 2,1,"PAH", 1,1,8,0)
	11492
	11493	"PKG",60,2 2,1,"PAH", 1,1,9,0)
	11494
	11495	"PKG",60,2 2,1,"PAH", 1,1,10,0)
	11496	Descriptio n
	11497	"PKG",60,2 2,1,"PAH", 1,1,11,0)
	11498	---------- -
	11499	"PKG",60,2 2,1,"PAH", 1,1,12,0)
	11500	The Chief Business O ffice (CBO ) is reque sting syst em enhance ments to
	11501	"PKG",60,2 2,1,"PAH", 1,1,13,0)
	11502	The Vetera ns Health Informatio n Systems and Techno logy Archi tecture
	11503	"PKG",60,2 2,1,"PAH", 1,1,14,0)
	11504	(VistA) In tegrated B illing (IB ), Account s Receivab le (AR), a nd
	11505	"PKG",60,2 2,1,"PAH", 1,1,15,0)
	11506	Outpatient Pharmacy (PSO) soft ware modul es.
	11507	"PKG",60,2 2,1,"PAH", 1,1,16,0)
	11508
	11509	"PKG",60,2 2,1,"PAH", 1,1,17,0)
	11510	The missio n of the D epartment of Veteran s Affairs (VA), Offi ce of
	11511	"PKG",60,2 2,1,"PAH", 1,1,18,0)
	11512	Informatio n & Techno logy (OI&T ), is to p rovide ben efits and services t o
	11513	"PKG",60,2 2,1,"PAH", 1,1,19,0)
	11514	veterans o f the Unit ed States Armed Forc es. In mee ting these goals,
	11515	"PKG",60,2 2,1,"PAH", 1,1,20,0)
	11516	OIT strive s to provi de high qu ality, eff ective, an d efficien t
	11517	"PKG",60,2 2,1,"PAH", 1,1,21,0)
	11518	Informatio n Technolo gy (IT) se rvices to those resp onsible fo r providin g
	11519	"PKG",60,2 2,1,"PAH", 1,1,22,0)
	11520	care to th e veterans at the po int-of-car e, as well as throug hout all
	11521	"PKG",60,2 2,1,"PAH", 1,1,23,0)
	11522	the points of the ve terans' he alth care. The VA de pends on I nformation
	11523	"PKG",60,2 2,1,"PAH", 1,1,24,0)
	11524	Management /Informati on Technol ogy (IM/IT ) systems to meet mi ssion
	11525	"PKG",60,2 2,1,"PAH", 1,1,25,0)
	11526	goals.
	11527	"PKG",60,2 2,1,"PAH", 1,1,26,0)
	11528
	11529	"PKG",60,2 2,1,"PAH", 1,1,27,0)
	11530	The overal l FY16 HAP E Revenue Enhancemen t project has been f urther
	11531	"PKG",60,2 2,1,"PAH", 1,1,28,0)
	11532	divided in to three s ub-project s:
	11533	"PKG",60,2 2,1,"PAH", 1,1,29,0)
	11534
	11535	"PKG",60,2 2,1,"PAH", 1,1,30,0)
	11536	NSR #20150 506
	11537	"PKG",60,2 2,1,"PAH", 1,1,31,0)
	11538	The Revenu e Eligibil ity Enhanc ements Pro ject effor t for the Chief
	11539	"PKG",60,2 2,1,"PAH", 1,1,32,0)
	11540	Business O ffice (CBO ), bundles several N SRs with s imilar bus iness
	11541	"PKG",60,2 2,1,"PAH", 1,1,33,0)
	11542	needs into a single requiremen ts documen t. Succes sfully add ressing
	11543	"PKG",60,2 2,1,"PAH", 1,1,34,0)
	11544	the requir ements con tained wit hin this d ocument wi ll enable the
	11545	"PKG",60,2 2,1,"PAH", 1,1,35,0)
	11546	Department of Vetera ns Affairs (VA) to a ppropriate ly bill ce rtain
	11547	"PKG",60,2 2,1,"PAH", 1,1,36,0)
	11548	subsets of billable events by correcting , automati ng, or enh ancing
	11549	"PKG",60,2 2,1,"PAH", 1,1,37,0)
	11550	current Ve terans Hea lth Inform ation Syst ems and Te chnology
	11551	"PKG",60,2 2,1,"PAH", 1,1,38,0)
	11552	Architectu re (VistA) systems.
	11553	"PKG",60,2 2,1,"PAH", 1,1,39,0)
	11554
	11555	"PKG",60,2 2,1,"PAH", 1,1,40,0)
	11556	NSR #20150 507
	11557	"PKG",60,2 2,1,"PAH", 1,1,41,0)
	11558	The Revenu e Operatio ns Enhance ments Proj ect combin es servera l NSRs, as
	11559	"PKG",60,2 2,1,"PAH", 1,1,42,0)
	11560	well. This effort en ables the Department of Vetera ns Affairs (VA) to
	11561	"PKG",60,2 2,1,"PAH", 1,1,43,0)
	11562	improve re venue oper ation func tionality related to repayment plans,
	11563	"PKG",60,2 2,1,"PAH", 1,1,44,0)
	11564	late charg e capture, bill susp ension rea sons, the billing of
	11565	"PKG",60,2 2,1,"PAH", 1,1,45,0)
	11566	deactivate d provider s, and the display o f appeal r ights and
	11567	"PKG",60,2 2,1,"PAH", 1,1,46,0)
	11568	responsibi lities on the Vetera ns Benefic iary trave l Bill of Collection s
	11569	"PKG",60,2 2,1,"PAH", 1,1,47,0)
	11570	form. Imp lementatio n of the p roposed en hancements will make a
	11571	"PKG",60,2 2,1,"PAH", 1,1,48,0)
	11572	significan t positive impact on stakehold ers and ta rget users .
	11573	"PKG",60,2 2,1,"PAH", 1,1,49,0)
	11574
	11575	"PKG",60,2 2,1,"PAH", 1,1,50,0)
	11576	NSR #20150 505
	11577	"PKG",60,2 2,1,"PAH", 1,1,51,0)
	11578	The Revenu e Reportin g Enhancem ents Proje ct will en able the V A to
	11579	"PKG",60,2 2,1,"PAH", 1,1,52,0)
	11580	improve tr acking and reporting of revenu e, and wil l support revenue
	11581	"PKG",60,2 2,1,"PAH", 1,1,53,0)
	11582	reporting business r ules and g uidelines.
	11583	"PKG",60,2 2,1,"PAH", 1,1,54,0)
	11584
	11585	"PKG",60,2 2,1,"PAH", 1,1,55,0)
	11586
	11587	"PKG",60,2 2,1,"PAH", 1,1,56,0)
	11588	PSO7.046 3 patch en hancements , pertinen t to the a bove NSRs, include:
	11589	"PKG",60,2 2,1,"PAH", 1,1,57,0)
	11590
	11591	"PKG",60,2 2,1,"PAH", 1,1,58,0)
	11592	1.) In the event of a Prescrip tion Reset Status/Ca ncel Charg es action,
	11593	"PKG",60,2 2,1,"PAH", 1,1,59,0)
	11594	all automa tic prepay ment gener ation shal l be
	11595	"PKG",60,2 2,1,"PAH", 1,1,60,0)
	11596	eliminated .
	11597	"PKG",60,2 2,1,"PAH", 1,1,61,0)
	11598
	11599	"PKG",60,2 2,1,"PAH", 1,1,62,0)
	11600	2.) All "c redit bala nces" that are autom atically g enerated i n the even t
	11601	"PKG",60,2 2,1,"PAH", 1,1,63,0)
	11602	of a Presc ription Re set Status /Cancel Ch arges acti on exempti on to stop .
	11603	"PKG",60,2 2,1,"PAH", 1,1,64,0)
	11604
	11605	"PKG",60,2 2,1,"PAH", 1,1,65,0)
	11606	3.) A new on-demand List Manag er report will be ma de availab le for
	11607	"PKG",60,2 2,1,"PAH", 1,1,66,0)
	11608	identifica tion of Pr escription resets.
	11609	"PKG",60,2 2,1,"PAH", 1,1,67,0)
	11610
	11611	"PKG",60,2 2,1,"PAH", 1,1,68,0)
	11612	4.) The ne w on-deman d report f or process ing Prescr iption Res ets will
	11613	"PKG",60,2 2,1,"PAH", 1,1,69,0)
	11614	provide an option to generate a Summary Report and /or Detail ed Report.
	11615	"PKG",60,2 2,1,"PAH", 1,1,70,0)
	11616
	11617	"PKG",60,2 2,1,"PAH", 1,1,71,0)
	11618
	11619	"PKG",60,2 2,1,"PAH", 1,1,72,0)
	11620
	11621	"PKG",60,2 2,1,"PAH", 1,1,73,0)
	11622	Concurrent Developme nt / Depen dencies:
	11623	"PKG",60,2 2,1,"PAH", 1,1,74,0)
	11624	---------- ---------- ---------- --------
	11625	"PKG",60,2 2,1,"PAH", 1,1,75,0)
	11626	N/A
	11627	"PKG",60,2 2,1,"PAH", 1,1,76,0)
	11628
	11629	"PKG",60,2 2,1,"PAH", 1,1,77,0)
	11630
	11631	"PKG",60,2 2,1,"PAH", 1,1,78,0)
	11632	Patch Comp onents:
	11633	"PKG",60,2 2,1,"PAH", 1,1,79,0)
	11634	---------- -------
	11635	"PKG",60,2 2,1,"PAH", 1,1,80,0)
	11636
	11637	"PKG",60,2 2,1,"PAH", 1,1,81,0)
	11638	Files & Fi elds Assoc iated:
	11639	"PKG",60,2 2,1,"PAH", 1,1,82,0)
	11640
	11641	"PKG",60,2 2,1,"PAH", 1,1,83,0)
	11642	File Name (Number) Field Na me (Number ) New/ Modified/D eleted
	11643	"PKG",60,2 2,1,"PAH", 1,1,84,0)
	11644	---------- -------- -------- ---------- - ---- ---------- ------
	11645	"PKG",60,2 2,1,"PAH", 1,1,85,0)
	11646	N/A
	11647	"PKG",60,2 2,1,"PAH", 1,1,86,0)
	11648
	11649	"PKG",60,2 2,1,"PAH", 1,1,87,0)
	11650	Options As sociated:
	11651	"PKG",60,2 2,1,"PAH", 1,1,88,0)
	11652
	11653	"PKG",60,2 2,1,"PAH", 1,1,89,0)
	11654	Option Nam e Type New/ Modified/D eleted
	11655	"PKG",60,2 2,1,"PAH", 1,1,90,0)
	11656	---------- - ---- ---- ---------- ------
	11657	"PKG",60,2 2,1,"PAH", 1,1,91,0)
	11658	PSOCP RESE T COPAY ST ATUS LM ROUTINE NEW
	11659	"PKG",60,2 2,1,"PAH", 1,1,92,0)
	11660
	11661	"PKG",60,2 2,1,"PAH", 1,1,93,0)
	11662	Protocols Associated :
	11663	"PKG",60,2 2,1,"PAH", 1,1,94,0)
	11664
	11665	"PKG",60,2 2,1,"PAH", 1,1,95,0)
	11666	Protocol N ame New /Modified/ Deleted
	11667	"PKG",60,2 2,1,"PAH", 1,1,96,0)
	11668	---------- --- --- ---------- -------
	11669	"PKG",60,2 2,1,"PAH", 1,1,97,0)
	11670	PSO PATIEN T MED ACC PRO NEW
	11671	"PKG",60,2 2,1,"PAH", 1,1,98,0)
	11672	PSO PATIEN T MED BILL PRO NEW
	11673	"PKG",60,2 2,1,"PAH", 1,1,99,0)
	11674	PSO PATIEN T MED CANC EL NEW
	11675	"PKG",60,2 2,1,"PAH", 1,1,100,0)
	11676	PSO PATIEN T MED EXPO RT NEW
	11677	"PKG",60,2 2,1,"PAH", 1,1,101,0)
	11678	PSO PATIEN T MED PAT INQ NEW
	11679	"PKG",60,2 2,1,"PAH", 1,1,102,0)
	11680	PSO PATIEN T MED RESE T NEW
	11681	"PKG",60,2 2,1,"PAH", 1,1,103,0)
	11682	PSO PATIEN T MED TPJI NEW
	11683	"PKG",60,2 2,1,"PAH", 1,1,104,0)
	11684	PSO PATIEN T MEDICATI ON MENU
	11685	"PKG",60,2 2,1,"PAH", 1,1,105,0)
	11686
	11687	"PKG",60,2 2,1,"PAH", 1,1,106,0)
	11688	Templates Associated :
	11689	"PKG",60,2 2,1,"PAH", 1,1,107,0)
	11690
	11691	"PKG",60,2 2,1,"PAH", 1,1,108,0)
	11692	Template N ame T ype File Name (Num ber) New/Mod/De l
	11693	"PKG",60,2 2,1,"PAH", 1,1,109,0)
	11694	---------- --- - --- ---- ---------- ---- ---------- -
	11695	"PKG",60,2 2,1,"PAH", 1,1,110,0)
	11696	PSO PATIEN T MEDICATI ON LIST L IST NEW
	11697	"PKG",60,2 2,1,"PAH", 1,1,111,0)
	11698
	11699	"PKG",60,2 2,1,"PAH", 1,1,112,0)
	11700	New Servic e Requests (NSRs):
	11701	"PKG",60,2 2,1,"PAH", 1,1,113,0)
	11702	---------- ---------- --------
	11703	"PKG",60,2 2,1,"PAH", 1,1,114,0)
	11704	20150505 - Revenue R eporting E nhancement s
	11705	"PKG",60,2 2,1,"PAH", 1,1,115,0)
	11706	20150506 - Revenue E ligibility Enhanceme nts
	11707	"PKG",60,2 2,1,"PAH", 1,1,116,0)
	11708	20150507 - Revenue O perations Enhancemen ts
	11709	"PKG",60,2 2,1,"PAH", 1,1,117,0)
	11710
	11711	"PKG",60,2 2,1,"PAH", 1,1,118,0)
	11712
	11713	"PKG",60,2 2,1,"PAH", 1,1,119,0)
	11714	Patient Sa fety Issue s (PSIs):
	11715	"PKG",60,2 2,1,"PAH", 1,1,120,0)
	11716	---------- ---------- ----------
	11717	"PKG",60,2 2,1,"PAH", 1,1,121,0)
	11718	N/A
	11719	"PKG",60,2 2,1,"PAH", 1,1,122,0)
	11720
	11721	"PKG",60,2 2,1,"PAH", 1,1,123,0)
	11722
	11723	"PKG",60,2 2,1,"PAH", 1,1,124,0)
	11724	Remedy Tic ket(s) & O verviews:
	11725	"PKG",60,2 2,1,"PAH", 1,1,125,0)
	11726	---------- ---------- ---------
	11727	"PKG",60,2 2,1,"PAH", 1,1,126,0)
	11728	N/A
	11729	"PKG",60,2 2,1,"PAH", 1,1,127,0)
	11730
	11731	"PKG",60,2 2,1,"PAH", 1,1,128,0)
	11732	Test Sites :
	11733	"PKG",60,2 2,1,"PAH", 1,1,129,0)
	11734	----------
	11735	"PKG",60,2 2,1,"PAH", 1,1,130,0)
	11736	Durham VAM C
	11737	"PKG",60,2 2,1,"PAH", 1,1,131,0)
	11738
	11739	"PKG",60,2 2,1,"PAH", 1,1,132,0)
	11740
	11741	"PKG",60,2 2,1,"PAH", 1,1,133,0)
	11742	Software a nd Documen tation Ret rieval Ins tructions:
	11743	"PKG",60,2 2,1,"PAH", 1,1,134,0)
	11744	---------- ---------- ---------- ---------- ---------- --
	11745	"PKG",60,2 2,1,"PAH", 1,1,135,0)
	11746	Patches fo r this ins tallation are combin ed in host file
	11747	"PKG",60,2 2,1,"PAH", 1,1,136,0)
	11748	IB_2_568_P RCA_PSO_BU NDLE_T1.KI D
	11749	"PKG",60,2 2,1,"PAH", 1,1,137,0)
	11750
	11751	"PKG",60,2 2,1,"PAH", 1,1,138,0)
	11752	Installati on of this host file should be coordinat ed among t he package s
	11753	"PKG",60,2 2,1,"PAH", 1,1,139,0)
	11754	affected s ince only one instal lation is necessary.
	11755	"PKG",60,2 2,1,"PAH", 1,1,140,0)
	11756
	11757	"PKG",60,2 2,1,"PAH", 1,1,141,0)
	11758	The patche s are:
	11759	"PKG",60,2 2,1,"PAH", 1,1,142,0)
	11760
	11761	"PKG",60,2 2,1,"PAH", 1,1,143,0)
	11762	IB2. 0568
	11763	"PKG",60,2 2,1,"PAH", 1,1,144,0)
	11764	PRCA* 4.5*315
	11765	"PKG",60,2 2,1,"PAH", 1,1,145,0)
	11766	PSO7 .0463
	11767	"PKG",60,2 2,1,"PAH", 1,1,146,0)
	11768
	11769	"PKG",60,2 2,1,"PAH", 1,1,147,0)
	11770
	11771	"PKG",60,2 2,1,"PAH", 1,1,148,0)
	11772	Sites may retrieve t he KIDS bu ild in one of the fo llowing wa ys:
	11773	"PKG",60,2 2,1,"PAH", 1,1,149,0)
	11774
	11775	"PKG",60,2 2,1,"PAH", 1,1,150,0)
	11776	(1) The pr eferred me thod is to FTP the f iles from
	11777	"PKG",60,2 2,1,"PAH", 1,1,151,0)
	11778	download. DNS . DNS which will transmit the files from the
	11779	"PKG",60,2 2,1,"PAH", 1,1,152,0)
	11780	first avai lable FTP server.
	11781	"PKG",60,2 2,1,"PAH", 1,1,153,0)
	11782
	11783	"PKG",60,2 2,1,"PAH", 1,1,154,0)
	11784	(2) Sites may also e lect to re trieve the patch dir ectly from a specifi c
	11785	"PKG",60,2 2,1,"PAH", 1,1,155,0)
	11786	server as follows:
	11787	"PKG",60,2 2,1,"PAH", 1,1,156,0)
	11788
	11789	"PKG",60,2 2,1,"PAH", 1,1,157,0)
	11790	OIFO FTP ADDRE SS DIRECTORY
	11791	"PKG",60,2 2,1,"PAH", 1,1,158,0)
	11792	-------- ------ --------- ---------- ----- ---------- --------
	11793	"PKG",60,2 2,1,"PAH", 1,1,159,0)
	11794	Albany DNS . URL anonymous. software
	11795	"PKG",60,2 2,1,"PAH", 1,1,160,0)
	11796	Hines DNS . DNS . URL anonymous. software
	11797	"PKG",60,2 2,1,"PAH", 1,1,161,0)
	11798	Salt Lake City DNS . URL anonymous. software
	11799	"PKG",60,2 2,1,"PAH", 1,1,162,0)
	11800
	11801	"PKG",60,2 2,1,"PAH", 1,1,163,0)
	11802
	11803	"PKG",60,2 2,1,"PAH", 1,1,164,0)
	11804	Sites may retrieve d ocumentati on directl y using Se cure File Transfer
	11805	"PKG",60,2 2,1,"PAH", 1,1,165,0)
	11806	Protocol ( SFTP) from the ANONY MOUS.SOFTW ARE direct ory at the following
	11807	"PKG",60,2 2,1,"PAH", 1,1,166,0)
	11808	OI Field O ffices:
	11809	"PKG",60,2 2,1,"PAH", 1,1,167,0)
	11810
	11811	"PKG",60,2 2,1,"PAH", 1,1,168,0)
	11812	Albany: DNS.URL
	11813	"PKG",60,2 2,1,"PAH", 1,1,169,0)
	11814	Hines: DNS .U RL
	11815	"PKG",60,2 2,1,"PAH", 1,1,170,0)
	11816	Salt Lake City: DNS . URL
	11817	"PKG",60,2 2,1,"PAH", 1,1,171,0)
	11818
	11819	"PKG",60,2 2,1,"PAH", 1,1,172,0)
	11820	Documentat ion can al so be foun d on the V A Software Documenta tion Libra ry
	11821	"PKG",60,2 2,1,"PAH", 1,1,173,0)
	11822	at:
	11823	"PKG",60,2 2,1,"PAH", 1,1,174,0)
	11824	http:// URL /
	11825	"PKG",60,2 2,1,"PAH", 1,1,175,0)
	11826
	11827	"PKG",60,2 2,1,"PAH", 1,1,176,0)
	11828	Title File Name FTP Mode
	11829	"PKG",60,2 2,1,"PAH", 1,1,177,0)
	11830	---------- ---------- ---------- ---------- ---------- ---------- ---------
	11831	"PKG",60,2 2,1,"PAH", 1,1,178,0)
	11832	Outpatient Pharmacy Technical Manual/Sec urity Guid e
	11833	"PKG",60,2 2,1,"PAH", 1,1,179,0)
	11834	pso_7_tm.d oc Binary
	11835	"PKG",60,2 2,1,"PAH", 1,1,180,0)
	11836	Outpatient Pharmacy Deployment , Installa tion,
	11837	"PKG",60,2 2,1,"PAH", 1,1,181,0)
	11838	Back- Out, and R ollback Gu ide
	11839	"PKG",60,2 2,1,"PAH", 1,1,182,0)
	11840	FY16Re venuePSOVI P_Deployme nt_Install ation_Guid e.doc
	11841	"PKG",60,2 2,1,"PAH", 1,1,183,0)
	11842	Binary
	11843	"PKG",60,2 2,1,"PAH", 1,1,184,0)
	11844
	11845	"PKG",60,2 2,1,"PAH", 1,1,185,0)
	11846
	11847	"PKG",60,2 2,1,"PAH", 1,1,186,0)
	11848
	11849	"PKG",60,2 2,1,"PAH", 1,1,187,0)
	11850	Patch Inst allation:
	11851	"PKG",60,2 2,1,"PAH", 1,1,188,0)
	11852
	11853	"PKG",60,2 2,1,"PAH", 1,1,189,0)
	11854	Pre/Post I nstallatio n Overview :
	11855	"PKG",60,2 2,1,"PAH", 1,1,190,0)
	11856	---------- ---------- ---------- -
	11857	"PKG",60,2 2,1,"PAH", 1,1,191,0)
	11858	N/A
	11859	"PKG",60,2 2,1,"PAH", 1,1,192,0)
	11860
	11861	"PKG",60,2 2,1,"PAH", 1,1,193,0)
	11862	Pre-Instal lation Ins tructions:
	11863	"PKG",60,2 2,1,"PAH", 1,1,194,0)
	11864	---------- ---------- ----------
	11865	"PKG",60,2 2,1,"PAH", 1,1,195,0)
	11866	N/A
	11867	"PKG",60,2 2,1,"PAH", 1,1,196,0)
	11868
	11869	"PKG",60,2 2,1,"PAH", 1,1,197,0)
	11870	Installati on Instruc tions:
	11871	"PKG",60,2 2,1,"PAH", 1,1,198,0)
	11872	---------- ---------- ------
	11873	"PKG",60,2 2,1,"PAH", 1,1,199,0)
	11874	This proce ss will in stall new and update d routines and other
	11875	"PKG",60,2 2,1,"PAH", 1,1,200,0)
	11876	components listed ab ove. There is a post -install r outine tha t will add
	11877	"PKG",60,2 2,1,"PAH", 1,1,201,0)
	11878	entries to a number of files.
	11879	"PKG",60,2 2,1,"PAH", 1,1,202,0)
	11880
	11881	"PKG",60,2 2,1,"PAH", 1,1,203,0)
	11882	The patch will be re leased in conjunctio n with an Integrated Billing
	11883	"PKG",60,2 2,1,"PAH", 1,1,204,0)
	11884	patch, IB* 4.5568, a nd an Outp atient Pha rmacy patc h, PSO7.0 *463.
	11885	"PKG",60,2 2,1,"PAH", 1,1,205,0)
	11886
	11887	"PKG",60,2 2,1,"PAH", 1,1,206,0)
	11888	****** ****** ** NOT E **** ****** ****
	11889	"PKG",60,2 2,1,"PAH", 1,1,207,0)
	11890	IF A USE R IS ON TH E SYSTEM A ND USING T HESE PROGR AMS
	11891	"PKG",60,2 2,1,"PAH", 1,1,208,0)
	11892	AN EDITE D ERROR WI LL OCCUR.
	11893	"PKG",60,2 2,1,"PAH", 1,1,209,0)
	11894	The patc h should b e installe d when NO Outpatient
	11895	"PKG",60,2 2,1,"PAH", 1,1,210,0)
	11896	Pharmacy users are on the sy stem.
	11897	"PKG",60,2 2,1,"PAH", 1,1,211,0)
	11898	****** ****** ****** ****** ****** ****
	11899	"PKG",60,2 2,1,"PAH", 1,1,212,0)
	11900
	11901	"PKG",60,2 2,1,"PAH", 1,1,213,0)
	11902	Installat ion will t ake less t han 1 minu te.
	11903	"PKG",60,2 2,1,"PAH", 1,1,214,0)
	11904
	11905	"PKG",60,2 2,1,"PAH", 1,1,215,0)
	11906	Suggested time to i nstall: no n-peak req uirement h ours.
	11907	"PKG",60,2 2,1,"PAH", 1,1,216,0)
	11908
	11909	"PKG",60,2 2,1,"PAH", 1,1,217,0)
	11910
	11911	"PKG",60,2 2,1,"PAH", 1,1,218,0)
	11912	1. Obtai n the file IB_2_568_ PRCA_PSO_B UNDLE_T1.K ID
	11913	"PKG",60,2 2,1,"PAH", 1,1,219,0)
	11914
	11915	"PKG",60,2 2,1,"PAH", 1,1,220,0)
	11916	2. From the Kernel Installat ion & Dist ribution S ystem menu , select
	11917	"PKG",60,2 2,1,"PAH", 1,1,221,0)
	11918	the I nstallatio n menu.
	11919	"PKG",60,2 2,1,"PAH", 1,1,222,0)
	11920
	11921	"PKG",60,2 2,1,"PAH", 1,1,223,0)
	11922	3. Use L oad a Dist ribution u sing IB_2_ 568_PRCA_P SO_BUNDLE_ T1.KID whe n
	11923	"PKG",60,2 2,1,"PAH", 1,1,224,0)
	11924	promp ted to Ent er a Host File name. You may need to ap pend a
	11925	"PKG",60,2 2,1,"PAH", 1,1,225,0)
	11926	direc tory name.
	11927	"PKG",60,2 2,1,"PAH", 1,1,226,0)
	11928
	11929	"PKG",60,2 2,1,"PAH", 1,1,227,0)
	11930	4. From this menu, you may s elect to u se the fol lowing opt ions
	11931	"PKG",60,2 2,1,"PAH", 1,1,228,0)
	11932	(when prompted for INSTAL L NAME, en ter IB2.0 568):
	11933	"PKG",60,2 2,1,"PAH", 1,1,229,0)
	11934	a . Verify Checksums in Transpo rt Global - This opt ion will
	11935	"PKG",60,2 2,1,"PAH", 1,1,230,0)
	11936	allow y ou to ensu re the int egrity of the routin es that
	11937	"PKG",60,2 2,1,"PAH", 1,1,231,0)
	11938	are in the transp ort global .
	11939	"PKG",60,2 2,1,"PAH", 1,1,232,0)
	11940	b . Print T ransport G lobal - Th is option will allow you to
	11941	"PKG",60,2 2,1,"PAH", 1,1,233,0)
	11942	view th e componen ts of the KIDS build .
	11943	"PKG",60,2 2,1,"PAH", 1,1,234,0)
	11944	c . Compare Transport Global to Current S ystem - Th is option
	11945	"PKG",60,2 2,1,"PAH", 1,1,235,0)
	11946	will al low you to view all changes th at will be made when
	11947	"PKG",60,2 2,1,"PAH", 1,1,236,0)
	11948	this pa tch is ins talled. I t compares all compo nents of
	11949	"PKG",60,2 2,1,"PAH", 1,1,237,0)
	11950	this pa tch (routi nes, DD's, templates , etc.).
	11951	"PKG",60,2 2,1,"PAH", 1,1,238,0)
	11952	d . Backup a Transpor t Global - This opti on will cr eate a
	11953	"PKG",60,2 2,1,"PAH", 1,1,239,0)
	11954	backup message of any routi nes export ed with th is patch.
	11955	"PKG",60,2 2,1,"PAH", 1,1,240,0)
	11956	It will not backu p any othe r changes such as DD 's or
	11957	"PKG",60,2 2,1,"PAH", 1,1,241,0)
	11958	templat es.
	11959	"PKG",60,2 2,1,"PAH", 1,1,242,0)
	11960
	11961	"PKG",60,2 2,1,"PAH", 1,1,243,0)
	11962	5. When prompted " Want KIDS to INHIBIT LOGONs du ring the i nstall?
	11963	"PKG",60,2 2,1,"PAH", 1,1,244,0)
	11964	NO//" respond N O.
	11965	"PKG",60,2 2,1,"PAH", 1,1,245,0)
	11966
	11967	"PKG",60,2 2,1,"PAH", 1,1,246,0)
	11968	6. When prompted " Want to DI SABLE Sche duled Opti ons, Menu Options,
	11969	"PKG",60,2 2,1,"PAH", 1,1,247,0)
	11970	and P rotocols? NO//" resp ond NO.
	11971	"PKG",60,2 2,1,"PAH", 1,1,248,0)
	11972
	11973	"PKG",60,2 2,1,"PAH", 1,1,249,0)
	11974
	11975	"PKG",60,2 2,1,"PAH", 1,1,250,0)
	11976
	11977	"PKG",60,2 2,1,"PAH", 1,1,251,0)
	11978	Post-Insta llation In structions :
	11979	"PKG",60,2 2,1,"PAH", 1,1,252,0)
	11980	---------- ---------- ---------- -
	11981	"PKG",60,2 2,1,"PAH", 1,1,253,0)
	11982	There are no special tasks to perform af ter this p atch insta llation.
	11983	"QUES","XP F1",0)
	11984	Y
	11985	"QUES","XP F1","??")
	11986	^D REP^XPD H
	11987	"QUES","XP F1","A")
	11988	Shall I wr ite over y our \|FLAG\| File
	11989	"QUES","XP F1","B")
	11990	YES
	11991	"QUES","XP F1","M")
	11992	D XPF1^XPD IQ
	11993	"QUES","XP F2",0)
	11994	Y
	11995	"QUES","XP F2","??")
	11996	^D DTA^XPD H
	11997	"QUES","XP F2","A")
	11998	Want my da ta \|FLAG\| yours
	11999	"QUES","XP F2","B")
	12000	YES
	12001	"QUES","XP F2","M")
	12002	D XPF2^XPD IQ
	12003	"QUES","XP I1",0)
	12004	YO
	12005	"QUES","XP I1","??")
	12006	^D INHIBIT ^XPDH
	12007	"QUES","XP I1","A")
	12008	Want KIDS to INHIBIT LOGONs du ring the i nstall
	12009	"QUES","XP I1","B")
	12010	NO
	12011	"QUES","XP I1","M")
	12012	D XPI1^XPD IQ
	12013	"QUES","XP M1",0)
	12014	PO^VA(200, :EM
	12015	"QUES","XP M1","??")
	12016	^D MG^XPDH
	12017	"QUES","XP M1","A")
	12018	Enter the Coordinato r for Mail Group '\|F LAG\|'
	12019	"QUES","XP M1","B")
	12020
	12021	"QUES","XP M1","M")
	12022	D XPM1^XPD IQ
	12023	"QUES","XP O1",0)
	12024	Y
	12025	"QUES","XP O1","??")
	12026	^D MENU^XP DH
	12027	"QUES","XP O1","A")
	12028	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	12029	"QUES","XP O1","B")
	12030	NO
	12031	"QUES","XP O1","M")
	12032	D XPO1^XPD IQ
	12033	"QUES","XP Z1",0)
	12034	Y
	12035	"QUES","XP Z1","??")
	12036	^D OPT^XPD H
	12037	"QUES","XP Z1","A")
	12038	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	12039	"QUES","XP Z1","B")
	12040	NO
	12041	"QUES","XP Z1","M")
	12042	D XPZ1^XPD IQ
	12043	"QUES","XP Z2",0)
	12044	Y
	12045	"QUES","XP Z2","??")
	12046	^D RTN^XPD H
	12047	"QUES","XP Z2","A")
	12048	Want to MO VE routine s to other CPUs
	12049	"QUES","XP Z2","B")
	12050	NO
	12051	"QUES","XP Z2","M")
	12052	D XPZ2^XPD IQ
	12053	"RTN")
	12054	4
	12055	"RTN","PSO CPB")
	12056	0^1^B84712 258
	12057	"RTN","PSO CPB",1,0)
	12058	PSOCPB ;BI R/BaB - ph armacy co- pay applic ation cont 'd ;1/30/0 7 9:08am
	12059	"RTN","PSO CPB",2,0)
	12060	;;7.0;OUT PATIENT PH ARMACY;7 2,71,85,18 5,143,219, 239,201,26 3,303,431, 463;DEC 1997;Build 11
	12061	"RTN","PSO CPB",3,0)
	12062	;;Per VA Directive 6402, this routine s hould not be modifie d.
	12063	"RTN","PSO CPB",4,0)
	12064	;
	12065	"RTN","PSO CPB",5,0)
	12066	;REF/IA
	12067	"RTN","PSO CPB",6,0)
	12068	;DIS^SDRO UT2/112
	12069	"RTN","PSO CPB",7,0)
	12070	;^IBARX/1 25
	12071	"RTN","PSO CPB",8,0)
	12072	;VADPT/10 061
	12073	"RTN","PSO CPB",9,0)
	12074	;SWSTAT^I BBAPI/4663
	12075	"RTN","PSO CPB",10,0)
	12076	COPAY ;
	12077	"RTN","PSO CPB",11,0)
	12078	;Called b y PSON52,P SORN52...R equires PS OCPAY,PSOB ILL,DEA=PS DEA,PSOFLA G
	12079	"RTN","PSO CPB",12,0)
	12080	;PSOFLAG= 1 NEW, PSO FLAG=0 REN EW
	12081	"RTN","PSO CPB",13,0)
	12082	S PSOSAVE =PSOCPAY ; Save orig inal statu s of PSOCP AY
	12083	"RTN","PSO CPB",14,0)
	12084	I '$G(PSO SCP)!('$G( PSOSCA)) D SCP^PSORN 52D ;CIDC -must ask sc if flag ged for it in enroll ment
	12085	"RTN","PSO CPB",15,0)
	12086	I $G(PSOD RUG("DEA") )["S"!($G( PSODRUG("D EA"))["I") !($G(PSODR UG("DEA")) ["N") S PS OCPAY=0
	12087	"RTN","PSO CPB",16,0)
	12088	G:+PSOBIL L'=2&('$G( PSOSCA)) C OPAY2
	12089	"RTN","PSO CPB",17,0)
	12090	D FULL^VA LM1
	12091	"RTN","PSO CPB",18,0)
	12092	I $G(PSOM ESOI)=1,$G (PSORXED) W !!,"The Pharmacy O rderable I tem has ch anged for this order . Please r eview any" ,!,"existi ng SC or E nvironment al Indicat or default s carefull y for appr opriatenes s.",! S PS OMESOI=2
	12093	"RTN","PSO CPB",19,0)
	12094	I $G(PSOM ESFI)=1 W !!,"The Ph armacy Ord erable Ite m has chan ged for th is order. Please rev iew any",! ,"existing SC or Env ironmental Indicator defaults carefully for approp riateness. ",! S PSOM ESFI=2
	12095	"RTN","PSO CPB",20,0)
	12096	S DFN=+$G (PSODFN) D CHKPAG^PS OMLLD2,DIS ^SDROUT2
	12097	"RTN","PSO CPB",21,0)
	12098	ASK ;
	12099	"RTN","PSO CPB",22,0)
	12100	N PSOUFLA G S PSOUFL AG=0
	12101	"RTN","PSO CPB",23,0)
	12102	K PSOCPZ( "DFLG"),PS ONEW("NEWC OPAY")
	12103	"RTN","PSO CPB",24,0)
	12104	W ! K DIR ,DTOUT,DIR UT,DUOUT
	12105	"RTN","PSO CPB",25,0)
	12106	I $G(PSOR X("SC"))=" SC"!($G(PS ORX("SC")) ="NSC")!($ G(PSOSCOTH )) D
	12107	"RTN","PSO CPB",26,0)
	12108	. W:PSOSC P<50&($G(P SODRUG("DE A"))'["S") &($G(PSODR UG("DEA")) '["I")&($G (PSODRUG(" DEA"))'["N ") !,"This Rx has be en flagged by the pr ovider as: "_$S($G(P SOSCOTH):" NO COPAY", $G(PSORX(" SC"))="SC" :"NO COPAY ",1:"COPAY "),! I $G( PSOSCOTX) S PSOSCOTX =2
	12109	"RTN","PSO CPB",27,0)
	12110	S DIR("A" )="Was tre atment for Service C onnected c ondition", DIR(0)="Y"
	12111	"RTN","PSO CPB",28,0)
	12112	S DIR("?" )="Enter ' Yes' if th is prescri ption is f or a Servi ce Connect ed conditi on"
	12113	"RTN","PSO CPB",29,0)
	12114	I $G(PSOR X("SC"))]" "!($G(PSOR X(+$G(PSOR ENW("OIRXN ")),"SC")) '="") S DI R("B")=$S( $G(PSORX(" SC"))="SC" :"YES",$G( PSORX("SC" ))="NSC":" NO",$G(PSO RX(+$G(PSO RENW("OIRX N")),"SC") )=1:"YES", $G(PSORX(+ $G(PSORENW ("OIRXN")) ,"SC"))=0: "NO",1:"")
	12115	"RTN","PSO CPB",30,0)
	12116	I $G(PSON EWFF),$G(P SOFLAG) I $G(PSOANSQ D("SC"))=0 !($G(PSOAN SQD("SC")) =1) S DIR( "B")=$S($G (PSOANSQD( "SC"))=1:" YES",1:"NO ")
	12117	"RTN","PSO CPB",31,0)
	12118	I $G(DIR( "B"))="YES "!($G(DIR( "B"))="NO" ) S PSOUFL AG=$G(DIR( "B"))
	12119	"RTN","PSO CPB",32,0)
	12120	I $G(DIR( "B"))="" K DIR("B")
	12121	"RTN","PSO CPB",33,0)
	12122	D ^DIR
	12123	"RTN","PSO CPB",34,0)
	12124	I $G(Y)=1 !($G(Y)=0) S PSOANSQ ("SC")=$G( Y) I $G(PS ONEWFF),$G (PSOFLAG) S PSOANSQD ("SC")=$G( Y)
	12125	"RTN","PSO CPB",35,0)
	12126	I PSOFLAG I Y["^"!( $D(DTOUT)) !($D(DUOUT )) S PSOCP Z("DFLG")= 1
	12127	"RTN","PSO CPB",36,0)
	12128	S:Y=0 Y=2
	12129	"RTN","PSO CPB",37,0)
	12130	S PSOANSR =+Y I 'PSO ANSR,'PSOF LAG D S $ P(PSOCPAY, "^")=$S($G (PSOUFLAG) ="NO":1,1: 0) W ! K D IR S DIR(0 )="E",DIR( "A")="Pres s Return t o continue " D ^DIR K DIR G COP AY2
	12131	"RTN","PSO CPB",38,0)
	12132	.W !!,"Th is Renewal has been designated as "_$S($ G(PSOUFLAG )="YES":"S ERVICE CON NECTED",1: "NON-SERVI CE CONNECT ED.")
	12133	"RTN","PSO CPB",39,0)
	12134	.W:PSOSCP <50&($G(PS ODRUG("DEA "))'["S")& ($G(PSODRU G("DEA"))' ["I")&($G( PSODRUG("D EA"))'["N" ) !,"Pleas e use the 'Reset Cop ay Status/ Cancel Cha rges' opti on to make correctio ns."
	12135	"RTN","PSO CPB",40,0)
	12136	.S PSOANS Q("SC")=$S ($G(PSOUFL AG)="YES": 1,1:0)
	12137	"RTN","PSO CPB",41,0)
	12138	I $G(PSOF LAG),$G(PS OCPZ("DFLG ")) G EXIT
	12139	"RTN","PSO CPB",42,0)
	12140	S:PSOANSR =1 PSOCPAY =0 S:PSOAN SR=2 $P(PS OCPAY,"^") =1
	12141	"RTN","PSO CPB",43,0)
	12142	COPAY2 ;
	12143	"RTN","PSO CPB",44,0)
	12144	N PSOPFS S PSOPFS=$ $SWSTAT^IB BAPI()
	12145	"RTN","PSO CPB",45,0)
	12146	I +PSOCPA Y=1,($P(PS OCPAY,"^", 2)=1)!($P( PSOCPAY,"^ ",2)=2) D
	12147	"RTN","PSO CPB",46,0)
	12148	.;set IB node in ^P SRX for co pay if xac tn type is 1 or 2
	12149	"RTN","PSO CPB",47,0)
	12150	.S PSONEW ("NEWCOPAY ")=$P($G(P SOCPAY),"^ ",2)_"^^"_ $S(+$G(PSO PFS):"",1: $P($G(PSOC PAY),"^",2 ))
	12151	"RTN","PSO CPB",48,0)
	12152	EXIT ;
	12153	"RTN","PSO CPB",49,0)
	12154	S PSOCPAY =PSOSAVE ; Restore va l of PSOCP AY
	12155	"RTN","PSO CPB",50,0)
	12156	K PSOSAVE ,PSOANSR,D IR,DUOUT,D IRUT,DTOUT ,Y,X
	12157	"RTN","PSO CPB",51,0)
	12158	Q
	12159	"RTN","PSO CPB",52,0)
	12160	RESET ;RES ET COPAY S TATUS
	12161	"RTN","PSO CPB",53,0)
	12162	K PSOSUMM ,PSOPFS,PS OPFSA,PSOL FIL,PSOPFS G
	12163	"RTN","PSO CPB",54,0)
	12164	I '$D(PSO PAR) D ^PS OLSET G RE SET
	12165	"RTN","PSO CPB",55,0)
	12166	W ! S DIC ="^PSRX(", DIC(0)="AE QZ" D ^DIC K DIC G:Y <0 EXT S P SODA=+Y
	12167	"RTN","PSO CPB",56,0)
	12168	W !,?17," PATIENT: " ,$P($G(^DP T($P(^PSRX (PSODA,0), "^",2),0)) ,"^")
	12169	"RTN","PSO CPB",57,0)
	12170	D ICN^PSO DPT($P(^PS RX(PSODA,0 ),"^",2))
	12171	"RTN","PSO CPB",58,0)
	12172	S PSORXN= $P(^PSRX(P SODA,0),"^ "),PREA="R "
	12173	"RTN","PSO CPB",59,0)
	12174	S PCOPAY= $G(^PSRX(P SODA,"IB") )
	12175	"RTN","PSO CPB",60,0)
	12176	W !!,"Rx # ",PSORXN ," is a ", $S(+PCOPAY :"Copay",1 :"No Copay ")," presc ription"
	12177	"RTN","PSO CPB",61,0)
	12178	S PSOLFIL =$$LF^PSOP FSU1(PSODA ) D PFSA^P SOPFSU1(PS ODA,PSOLFI L,3) ;PSO CPC def PS OPFSA=1 if OP SC/EI' s change.
	12179	"RTN","PSO CPB",62,0)
	12180	D EXEMCHK ^PSOCPC ; CHECK/CHAN GE EXEMPTI ON FLAGS
	12181	"RTN","PSO CPB",63,0)
	12182	S PSOIBQ= $G(^PSRX(P SODA,"IBQ" ))
	12183	"RTN","PSO CPB",64,0)
	12184	I '$G(^PS RX(PSODA," IB")),PSOI BQ'["1" D G ASKCAN
	12185	"RTN","PSO CPB",65,0)
	12186	. K DIR S DIR(0)="Y ",DIR("B") ="N",DIR(" A")="Do yo u want to reset the status to COPAY" D ^ DIR K DIR
	12187	"RTN","PSO CPB",66,0)
	12188	. I Y'=1 Q
	12189	"RTN","PSO CPB",67,0)
	12190	. S DIC=" ^IBE(350.3 ,",DIC("S" )="I $P(^( 0),U,3)'=2 ",DIC(0)=" AEQMZ",DIC ("A")="Sel ect Reason for Reset : " D ^DI C K DIC I Y'<0 S PSO RSN=+Y
	12191	"RTN","PSO CPB",68,0)
	12192	. S PREA= "R",PSOOLD ="No Copay ",PSONW="C opay",PSOC OMM="" D A CTLOG^PSOC PA
	12193	"RTN","PSO CPB",69,0)
	12194	. S PSI=0 ,PSOCOMM=" Copay stat us of this Rx has be en reset t o COPAY." D SETSUMM^ PSOCPC
	12195	"RTN","PSO CPB",70,0)
	12196	. S $P(^P SRX(PSODA, "IB"),"^") =1 ;Reset flag to CO PAY
	12197	"RTN","PSO CPB",71,0)
	12198	;
	12199	"RTN","PSO CPB",72,0)
	12200	I $G(^PSR X(PSODA,"I B")) D G ASKCAN
	12201	"RTN","PSO CPB",73,0)
	12202	. K DIR S DIR(0)="Y ",DIR("B") ="N",DIR(" A")="Do yo u want to reset the status to NO COPAYME NT" D ^DIR K DIR
	12203	"RTN","PSO CPB",74,0)
	12204	. I Y'=1 Q
	12205	"RTN","PSO CPB",75,0)
	12206	. S DIC=" ^IBE(350.3 ,",DIC("S" )="I $P(^( 0),U,3)'=2 ",DIC(0)=" AEQMZ",DIC ("A")="Sel ect Reason for Reset : " D ^DI C K DIC I Y'<0 S PSO RSN=+Y
	12207	"RTN","PSO CPB",76,0)
	12208	. S PREA= "R",PSOOLD ="Copay",P SONW="No C opay",PSOC OMM="" D A CTLOG^PSOC PA
	12209	"RTN","PSO CPB",77,0)
	12210	. S PSI=0 ,PSOCOMM=" Copay stat us of this Rx has be en reset t o NO COPAY ." D SETSU MM^PSOCPC
	12211	"RTN","PSO CPB",78,0)
	12212	. S $P(^P SRX(PSODA, "IB"),"^") ="" ;Reset flag to N O COPAY
	12213	"RTN","PSO CPB",79,0)
	12214	ASKCAN D A SKCAN^PSOC PD
	12215	"RTN","PSO CPB",80,0)
	12216	I '$D(PSO SUMM) S PS I=0,PSOCOM M="No acti on taken" D SETSUMM^ PSOCPC
	12217	"RTN","PSO CPB",81,0)
	12218	D PRTSUMM
	12219	"RTN","PSO CPB",82,0)
	12220	;I $P($G( PSOPFS),"^ ",3)>0&(+$ G(PSOPFSA) ) D CHRG^P SOPFSU1(PS ODA,PSOLFI L,"CG",PSO PFS) ;PSO 7.0463
	12221	"RTN","PSO CPB",83,0)
	12222	RESETE K P SODA,PSORX N,PSORSN,P SOREF,X,Y, PCOPAY,PRE A,PSOCOMM, PSI
	12223	"RTN","PSO CPB",84,0)
	12224	G RESET
	12225	"RTN","PSO CPB",85,0)
	12226	EXT K PSOD A,PSORXN,P SORSN,PSOR EF,X,Y,PCO PAY,PREA,P SOCOPAY
	12227	"RTN","PSO CPB",86,0)
	12228	Q
	12229	"RTN","PSO CPB",87,0)
	12230	BILLED ;Co llect IB n ums,cancel chrgs,res et flag.
	12231	"RTN","PSO CPB",88,0)
	12232	W !!,"* ****Cha rges are o n file for this Rx. *********"
	12233	"RTN","PSO CPB",89,0)
	12234	Q
	12235	"RTN","PSO CPB",90,0)
	12236	BILL2 ;
	12237	"RTN","PSO CPB",91,0)
	12238	N PSOPREV ; VAR FOR PREV CANC ELLED
	12239	"RTN","PSO CPB",92,0)
	12240	S PSOPREV =0
	12241	"RTN","PSO CPB",93,0)
	12242	S DIC="^I BE(350.3," ,DIC("S")= "I $P(^(0) ,U,3)'=2", DIC(0)="AE QMZ",DIC(" A")="Selec t Reason f or Reset o r Charge C ancellatio n : " D ^D IC K DIC G ENDMSG:Y< 0 S PSORSN =+Y
	12243	"RTN","PSO CPB",94,0)
	12244	S X=PSOPA R7_"^"_+$P (^PSRX(PSO DA,0),"^", 2)_"^^"_DU Z
	12245	"RTN","PSO CPB",95,0)
	12246	S SAVX=X
	12247	"RTN","PSO CPB",96,0)
	12248	I $D(PSOC AN) D:'$G( PSOPFS) I +$G(PSOPF S)!($G(PSO PFSG)) D P FS^PSOPFSU 1 G BILL2E ND:'$D(PSO CAN)
	12249	"RTN","PSO CPB",97,0)
	12250	. N III S III="" F S III=$O( PSOCAN(III )) Q:III=" " I PSOCA N(III)["PF S" S PSOPF SG=1 Q ;P FSS switch off, chec k for prev cots bill ing
	12251	"RTN","PSO CPB",98,0)
	12252	D POTBILL 2
	12253	"RTN","PSO CPB",99,0)
	12254	I '$D(PSO CAN) G BIL L2END
	12255	"RTN","PSO CPB",100,0 )
	12256	I $G(CANT YPE) D PRE VCAN I $O( X(""))="" Q
	12257	"RTN","PSO CPB",101,0 )
	12258	I '$G(CAN TYPE) S I= "" F S I= $O(PSOCAN( I)) Q:I="" S X($P(P SOCAN(I)," ^",1))=$P( PSOCAN(I), "^",2)_"^" _PSORSN
	12259	"RTN","PSO CPB",102,0 )
	12260	D CANCEL^ IBARX
	12261	"RTN","PSO CPB",103,0 )
	12262	I $G(CANT YPE) D MSG
	12263	"RTN","PSO CPB",104,0 )
	12264	I '$D(Y) Q
	12265	"RTN","PSO CPB",105,0 )
	12266	I +Y=-1 Q
	12267	"RTN","PSO CPB",106,0 )
	12268	I $D(Y(PS ORXN)),+Y( PSORXN)'=- 1 S $P(^PS RX(PSODA," IB"),"^",2 )=+Y(PSORX N) K Y(PSO RXN) S PRE A="C",PSOR EF=0,PSOOL D="",PSONW ="" D ACTL OG^PSOCPA I '$G(CANT YPE) D MSG
	12269	"RTN","PSO CPB",107,0 )
	12270	F PSOREF= 0:0 S PSOR EF=$O(Y(PS OREF)) Q:P SOREF="" I +Y(PSORE F)'=-1 S ^ PSRX(PSODA ,1,PSOREF, "IB")=+Y(P SOREF) S P REA="C",PS OOLD="",PS ONW="" D A CTLOG^PSOC PA I '$G(C ANTYPE) D MSG
	12271	"RTN","PSO CPB",108,0 )
	12272	BILL2END K X,Y,SAVX, PSOREF,PSO CAN
	12273	"RTN","PSO CPB",109,0 )
	12274	Q
	12275	"RTN","PSO CPB",110,0 )
	12276	;
	12277	"RTN","PSO CPB",111,0 )
	12278	POTBILL2 ; see if any potential charges ( entries fr om file 35 4.71 -- bi lls that e xceeded ca p prev) to be cancel led before cancellin g regular charges
	12279	"RTN","PSO CPB",112,0 )
	12280	N X,I
	12281	"RTN","PSO CPB",113,0 )
	12282	S X=SAVX
	12283	"RTN","PSO CPB",114,0 )
	12284	I $T(CANI BAM^IBARX) ="" Q
	12285	"RTN","PSO CPB",115,0 )
	12286	S I="" F S I=$O(PS OCAN(I)) Q :I="" I P SOCAN(I)[" ^CAP" S X( $P(PSOCAN( I),"^",1)) =$P(PSOCAN (I),"^",2) _"^"_PSORS N K PSOCAN (I)
	12287	"RTN","PSO CPB",116,0 )
	12288	I $O(X("" ))="" Q
	12289	"RTN","PSO CPB",117,0 )
	12290	S PSOPREV =1
	12291	"RTN","PSO CPB",118,0 )
	12292	D CANIBAM ^IBARX
	12293	"RTN","PSO CPB",119,0 )
	12294	I $D(X(PS ORXN)) S $ P(^PSRX(PS ODA,"IB"), "^",4)="" S PREA="C" ,PSOREF=0, PSOCOMM="P otential c harge canc elled",PSO OLD="",PSO NW="" D AC TLOG^PSOCP A D POTMSG K X(PSORX N)
	12295	"RTN","PSO CPB",120,0 )
	12296	F PSOREF= 0:0 S PSOR EF=$O(X(PS OREF)) Q:P SOREF="" Q:PSOREF>1 1 S $P(^P SRX(PSODA, 1,PSOREF," IB"),"^",2 )="" S PRE A="C",PSOC OMM="Poten tial charg e cancelle d",PSOOLD= "",PSONW=" " D ACTLOG ^PSOCPA D POTMSG
	12297	"RTN","PSO CPB",121,0 )
	12298	K PSOREF, PREA,PSOCO MM
	12299	"RTN","PSO CPB",122,0 )
	12300	Q
	12301	"RTN","PSO CPB",123,0 )
	12302	REFILL S P SOREF=0
	12303	"RTN","PSO CPB",124,0 )
	12304	F S PSOR EF=$O(^PSR X(PSODA,1, PSOREF)) Q :PSOREF'?1 N.N D
	12305	"RTN","PSO CPB",125,0 )
	12306	. I $D(^P SRX(PSODA, 1,PSOREF," PFS")) S:$ P($G(^PSRX (PSODA,1,P SOREF,"PFS ")),"^",2) X(PSOREF) ="^"_$G(PS ORSN) Q
	12307	"RTN","PSO CPB",126,0 )
	12308	. I $D(^P SRX(PSODA, 1,PSOREF," IB")),+^(" IB")>0 S X (PSOREF)=+ ^PSRX(PSOD A,1,PSOREF ,"IB")_"^" _$G(PSORSN )
	12309	"RTN","PSO CPB",127,0 )
	12310	S PSOREF= 0 F S PSO REF=$O(^PS RX(PSODA,1 ,PSOREF)) Q:PSOREF'? 1N.N I '$ D(X(PSOREF )),+$P($G( ^PSRX(PSOD A,1,PSOREF ,"IB")),"^ ",2) S XX( PSOREF)=+$ P(^PSRX(PS ODA,1,PSOR EF,"IB")," ^",2)_"^"_ $G(PSORSN) ; IF ONLY ENTRY FRO M 354.71 S AVE IT
	12311	"RTN","PSO CPB",128,0 )
	12312	Q
	12313	"RTN","PSO CPB",129,0 )
	12314	SETCP ;IF NOT COPAY MAKE ELIG CALL/SET F LAG FOR FU TURE
	12315	"RTN","PSO CPB",130,0 )
	12316	W ! S X=P SOPAR7_"^" _+$P(^PSRX (PSODA,0), "^",2)
	12317	"RTN","PSO CPB",131,0 )
	12318	D XTYPE^I BARX
	12319	"RTN","PSO CPB",132,0 )
	12320	I +Y=-1 W !!,"Error in proces sing Copay eligibili ty, no act ion taken. " Q
	12321	"RTN","PSO CPB",133,0 )
	12322	S (ACTYP, BL)="",(PS OBILL,PSOC PAY)=0
	12323	"RTN","PSO CPB",134,0 )
	12324	CP ;
	12325	"RTN","PSO CPB",135,0 )
	12326	S ACTYP=$ O(Y(ACTYP) ) G:'ACTYP CP1
	12327	"RTN","PSO CPB",136,0 )
	12328	F I=0:0 S BL=$O(Y(A CTYP,BL)) Q:BL="" I BL>0 S PS OBILL=BL,P SOCPAY=ACT YP
	12329	"RTN","PSO CPB",137,0 )
	12330	G CP
	12331	"RTN","PSO CPB",138,0 )
	12332	CP1 K ACTY P,BL,I
	12333	"RTN","PSO CPB",139,0 )
	12334	I (PSOBIL L'>0)!(PSO CPAY=0) G INELIG
	12335	"RTN","PSO CPB",140,0 )
	12336	S $P(^PSR X(PSODA,"I B"),"^")=P SOCPAY
	12337	"RTN","PSO CPB",141,0 )
	12338	W !,"COPA Y status o n this Rx has been r eset.",!," *** Future refills w ill be cla ssified as COPAY."
	12339	"RTN","PSO CPB",142,0 )
	12340	S PREA="R ",PSOOLD=" No Copay", PSONW="Cop ay"
	12341	"RTN","PSO CPB",143,0 )
	12342	D ACTLOG^ PSOCPA
	12343	"RTN","PSO CPB",144,0 )
	12344	Q
	12345	"RTN","PSO CPB",145,0 )
	12346	INELIG W ! ,"This Rx does not m eet patien t eligibil ity requir ement for Copay.",!, "**** St atus uncha nged * "
	12347	"RTN","PSO CPB",146,0 )
	12348	S Y=-1
	12349	"RTN","PSO CPB",147,0 )
	12350	Q
	12351	"RTN","PSO CPB",148,0 )
	12352	ENDMSG K X W !,"Unab le to proc ess CHARGE REMOVAL w ithout REA SON for Re set."
	12353	"RTN","PSO CPB",149,0 )
	12354	R !,"ENTE R a REASON now? (Y/ N) ",X:DTI ME Q:'$T
	12355	"RTN","PSO CPB",150,0 )
	12356	I ($E(X)[ "?")!("YyN n^"'[$E(X) ) W !,"Ent er YES to select REA SON and RE SET STATUS ." G ENDMS G
	12357	"RTN","PSO CPB",151,0 )
	12358	I "Yy"[$E (X) G BILL 2
	12359	"RTN","PSO CPB",152,0 )
	12360	Q
	12361	"RTN","PSO CPB",153,0 )
	12362	MSG ;
	12363	"RTN","PSO CPB",154,0 )
	12364	S PSI=0
	12365	"RTN","PSO CPB",155,0 )
	12366	I $G(CANT YPE) S PSO COMM="Rx # "_PSORXN_ " - All co pay charge s cancelle d" D SETSU MM^PSOCPC K PSOCOMM Q
	12367	"RTN","PSO CPB",156,0 )
	12368	S PSOCOMM ="Rx # "_P SORXN_" - "_$S(PSORE F=0:"Origi nal fill", 1:"Refill "_PSOREF)_ " copay ch arge cance lled"
	12369	"RTN","PSO CPB",157,0 )
	12370	D SETSUMM ^PSOCPC
	12371	"RTN","PSO CPB",158,0 )
	12372	K PSOCOMM
	12373	"RTN","PSO CPB",159,0 )
	12374	Q
	12375	"RTN","PSO CPB",160,0 )
	12376	POTMSG ;
	12377	"RTN","PSO CPB",161,0 )
	12378	S PSI=0
	12379	"RTN","PSO CPB",162,0 )
	12380	I $G(CANT YPE) Q ; (MESSAGE W ILL GET SE T LATER)
	12381	"RTN","PSO CPB",163,0 )
	12382	S PSOCOMM ="Rx # "_P SORXN_" - "_$S(PSORE F=0:"Origi nal fill", 1:"Refill "_PSOREF)_ " potentia l copay ch arge cance lled"
	12383	"RTN","PSO CPB",164,0 )
	12384	D SETSUMM ^PSOCPC
	12385	"RTN","PSO CPB",165,0 )
	12386	K PSOCOMM
	12387	"RTN","PSO CPB",166,0 )
	12388	Q
	12389	"RTN","PSO CPB",167,0 )
	12390	MSGNOCAN ;
	12391	"RTN","PSO CPB",168,0 )
	12392	S PSI=0
	12393	"RTN","PSO CPB",169,0 )
	12394	S PSOCOMM ="Rx # "_P SORXN_" - All copay charges ha ve already been canc elled." D SETSUMM^PS OCPC K PSO COMM
	12395	"RTN","PSO CPB",170,0 )
	12396	Q
	12397	"RTN","PSO CPB",171,0 )
	12398	;
	12399	"RTN","PSO CPB",172,0 )
	12400	PRTSUMM ; prt sum of actions i n reset/ca ncel
	12401	"RTN","PSO CPB",173,0 )
	12402	I '$D(PSO SUMM) Q
	12403	"RTN","PSO CPB",174,0 )
	12404	W !
	12405	"RTN","PSO CPB",175,0 )
	12406	S PSI=""
	12407	"RTN","PSO CPB",176,0 )
	12408	F S PSI= $O(PSOSUMM (PSI)) Q:P SI="" W ! ,PSOSUMM(P SI)
	12409	"RTN","PSO CPB",177,0 )
	12410	K PSOSUMM
	12411	"RTN","PSO CPB",178,0 )
	12412	Q
	12413	"RTN","PSO CPB",179,0 )
	12414	PREVCAN ; PREVIEW CA NCELS IF " ALL" IS SE LECTED
	12415	"RTN","PSO CPB",180,0 )
	12416	N I,PSOBI LL
	12417	"RTN","PSO CPB",181,0 )
	12418	S I="" F S I=$O(PS OCAN(I)) Q :I="" D I PSOBILL S X($P(PSO CAN(I),"^" ,1))=$P(PS OCAN(I),"^ ",2)_"^"_P SORSN
	12419	"RTN","PSO CPB",182,0 )
	12420	. S PSOBI LL=1 I $T( STATUS^IBA RX)'="" I PSOCAN(I)' ["CAP" S P SOBILL=$$S TATUS^IBAR X($P(PSOCA N(I),"^",2 )) S:PSOBI LL=2 PSOBI LL=0 ; PRE VIOUSLY CA NCELLED
	12421	"RTN","PSO CPB",183,0 )
	12422	I $O(X("" ))="" D
	12423	"RTN","PSO CPB",184,0 )
	12424	. I PSOPR EV D MSG Q
	12425	"RTN","PSO CPB",185,0 )
	12426	. D MSGNO CAN
	12427	"RTN","PSO CPB",186,0 )
	12428	Q
	12429	"RTN","PSO CPB",187,0 )
	12430	;
	12431	"RTN","PSO CPF")
	12432	0^2^B11604 5654
	12433	"RTN","PSO CPF",1,0)
	12434	PSOCPF ;BI R/BAA - Ph armacy CO- PAY Applic ation Util ities for IB ;02/06/ 92
	12435	"RTN","PSO CPF",2,0)
	12436	;;7.0;OUT PATIENT PH ARMACY;4 63;DEC 1 997;Build 11
	12437	"RTN","PSO CPF",3,0)
	12438	;;Per VA Directive 6402, this routine s hould not be modifie d.
	12439	"RTN","PSO CPF",4,0)
	12440	;
	12441	"RTN","PSO CPF",5,0)
	12442	EN ; -- ma in entry p oint for H ELD CHARGE S LIST
	12443	"RTN","PSO CPF",6,0)
	12444	;
	12445	"RTN","PSO CPF",7,0)
	12446	; add cod e to do fi lters here
	12447	"RTN","PSO CPF",8,0)
	12448	N FILTERS
	12449	"RTN","PSO CPF",9,0)
	12450	I '$$FILT ER(.FILTER S) Q
	12451	"RTN","PSO CPF",10,0)
	12452	;
	12453	"RTN","PSO CPF",11,0)
	12454	; code to do sort
	12455	"RTN","PSO CPF",12,0)
	12456	D SORT
	12457	"RTN","PSO CPF",13,0)
	12458	;
	12459	"RTN","PSO CPF",14,0)
	12460	K XQORS,V ALMEVL D E N^VALM("PS O PATIENT MEDICATION LIST")
	12461	"RTN","PSO CPF",15,0)
	12462	D ^%ZISC
	12463	"RTN","PSO CPF",16,0)
	12464	Q
	12465	"RTN","PSO CPF",17,0)
	12466	;
	12467	"RTN","PSO CPF",18,0)
	12468	HDR ; -- h eader code
	12469	"RTN","PSO CPF",19,0)
	12470	;
	12471	"RTN","PSO CPF",20,0)
	12472	N BDATE,E DATE,MEDSA ,PATS,STAT
	12473	"RTN","PSO CPF",21,0)
	12474	S BDATE=$ P(FILTERS( 0),U,1),ED ATE=$P(FIL TERS(0),U, 2)
	12475	"RTN","PSO CPF",22,0)
	12476	S MEDS=$P (FILTERS(0 ),U,3),PAT S=$P(FILTE RS(0),U,4)
	12477	"RTN","PSO CPF",23,0)
	12478	S STATS=$ P(FILTERS( 0),U,5)
	12479	"RTN","PSO CPF",24,0)
	12480	;
	12481	"RTN","PSO CPF",25,0)
	12482	S VALM("T ITLE")=" P atient Med ications"
	12483	"RTN","PSO CPF",26,0)
	12484	Q
	12485	"RTN","PSO CPF",27,0)
	12486	;
	12487	"RTN","PSO CPF",28,0)
	12488	INIT ; -- init varia bles and l ist array
	12489	"RTN","PSO CPF",29,0)
	12490	; input - ^TMP($J," PSOCPF")
	12491	"RTN","PSO CPF",30,0)
	12492	; output - ^TMP("VA LMAR",$J)
	12493	"RTN","PSO CPF",31,0)
	12494	N BDATE,E DATE,INSTS ,PATS,IINS ,OLDH
	12495	"RTN","PSO CPF",32,0)
	12496	S BDATE=$ P(FILTERS( 0),U,1),ED ATE=$P(FIL TERS(0),U, 2)
	12497	"RTN","PSO CPF",33,0)
	12498	S MEDS=$P (FILTERS(0 ),U,3),PAT S=$P(FILTE RS(0),U,4)
	12499	"RTN","PSO CPF",34,0)
	12500	S STATS=$ P(FILTERS( 0),U,5)
	12501	"RTN","PSO CPF",35,0)
	12502	D BLD
	12503	"RTN","PSO CPF",36,0)
	12504	Q
	12505	"RTN","PSO CPF",37,0)
	12506	;
	12507	"RTN","PSO CPF",38,0)
	12508	SORT ; get the data
	12509	"RTN","PSO CPF",39,0)
	12510	N BDATE,E DATE,MEDS, PATS
	12511	"RTN","PSO CPF",40,0)
	12512	S BDATE=$ P(FILTERS( 0),U,1),ED ATE=$P(FIL TERS(0),U, 2)
	12513	"RTN","PSO CPF",41,0)
	12514	S MEDS=$P (FILTERS(0 ),U,3),PAT S=$P(FILTE RS(0),U,4)
	12515	"RTN","PSO CPF",42,0)
	12516	S ^TMP($J ,"PSOCPFF" )=FILTERS( 0)
	12517	"RTN","PSO CPF",43,0)
	12518	;
	12519	"RTN","PSO CPF",44,0)
	12520	D SORT^PS OCPF1
	12521	"RTN","PSO CPF",45,0)
	12522	Q
	12523	"RTN","PSO CPF",46,0)
	12524	;
	12525	"RTN","PSO CPF",47,0)
	12526	BLD ; buil d data to display
	12527	"RTN","PSO CPF",48,0)
	12528	; build d isplay
	12529	"RTN","PSO CPF",49,0)
	12530	; ^TMP($J ,"PSOCPF", PTNM,RIEN, RFL)=PTNM_ U_PID_U_ME D_U_RIEN_U _RFL_U_ART RN_U_RX_U_ FILDT_U_BL NO_U_ARST1 _U_SC_U_SC P_U_MTSD_U _MTS_U_DFN _U_PBIL_U_ ARST_U_PRI EN
	12531	"RTN","PSO CPF",50,0)
	12532	K ^TMP($J ,"PSOCPFX" )
	12533	"RTN","PSO CPF",51,0)
	12534	K ^TMP("V ALMAR",$J)
	12535	"RTN","PSO CPF",52,0)
	12536	S NODATA= 0
	12537	"RTN","PSO CPF",53,0)
	12538	I '$D(^TM P($J,"PSOC PF")) D Q
	12539	"RTN","PSO CPF",54,0)
	12540	. S VCNT= 1,NODATA=1
	12541	"RTN","PSO CPF",55,0)
	12542	. S LINE= $$SETL("", "","",1,4)
	12543	"RTN","PSO CPF",56,0)
	12544	. S LINE= $$SETL(LIN E,"NO DATA FOUND FOR ENTERED C RITERIA"," ",5,50)
	12545	"RTN","PSO CPF",57,0)
	12546	. S VALMC NT=1
	12547	"RTN","PSO CPF",58,0)
	12548	. D SET^V ALM10(VALM CNT,LINE,V CNT)
	12549	"RTN","PSO CPF",59,0)
	12550	N RFL,VCN T,MED,NAME ,RFL,SC,SC P,FILDT,BL N,IBST1,MT S,RX,REC,V ALMY
	12551	"RTN","PSO CPF",60,0)
	12552	S VALMCNT =0
	12553	"RTN","PSO CPF",61,0)
	12554	S (RIEN,V CNT)=0,(NA ME,RFL)=""
	12555	"RTN","PSO CPF",62,0)
	12556	F S NAME =$O(^TMP($ J,"PSOCPF" ,NAME)) Q: NAME="" D
	12557	"RTN","PSO CPF",63,0)
	12558	. F S RI EN=$O(^TMP ($J,"PSOCP F",NAME,RI EN)) Q:RIE N="" D
	12559	"RTN","PSO CPF",64,0)
	12560	.. F S R FL=$O(^TMP ($J,"PSOCP F",NAME,RI EN,RFL)) Q :RFL="" D
	12561	"RTN","PSO CPF",65,0)
	12562	... S VCN T=VCNT+1
	12563	"RTN","PSO CPF",66,0)
	12564	... S LIN E=$$SETL(" ",VCNT,"", 1,4) ;line #
	12565	"RTN","PSO CPF",67,0)
	12566	... S REC =^TMP($J," PSOCPF",NA ME,RIEN,RF L),PID=$P( REC,U,2),A RST1=$P(RE C,U,10),PB IL=$P(REC, U,16)
	12567	"RTN","PSO CPF",68,0)
	12568	... S MED =$P(REC,U, 3),RX=$P(R EC,U,7),BL N=$P(REC,U ,9),FILDT= $P(REC,U,8 ),DFN=$P(R EC,U,15)
	12569	"RTN","PSO CPF",69,0)
	12570	... S PRI EN=$P(REC, U,18)
	12571	"RTN","PSO CPF",70,0)
	12572	... S ^TM P($J,"PSOC PFX",VCNT) =NAME_U_DF N_U_MED_U_ PBIL_U_BLN _U_PRIEN
	12573	"RTN","PSO CPF",71,0)
	12574	... S LIN E=$$SETL(L INE,NAME," ",5,22)
	12575	"RTN","PSO CPF",72,0)
	12576	... S LIN E=$$SETL(L INE,PID,"" ,28,6)
	12577	"RTN","PSO CPF",73,0)
	12578	... S LIN E=$$SETL(L INE,MED,"" ,35,16)
	12579	"RTN","PSO CPF",74,0)
	12580	... S LIN E=$$SETL(L INE,$$FMTE ^XLFDT(FIL DT,"2DZ"), "",53,8)
	12581	"RTN","PSO CPF",75,0)
	12582	... S LIN E=$$SETL(L INE,ARST1, "",62,17)
	12583	"RTN","PSO CPF",76,0)
	12584	... S VAL MCNT=VALMC NT+1
	12585	"RTN","PSO CPF",77,0)
	12586	... D SET ^VALM10(VA LMCNT,LINE ,VCNT)
	12587	"RTN","PSO CPF",78,0)
	12588	... S RXO ="Rx#:"_RX
	12589	"RTN","PSO CPF",79,0)
	12590	... S BLN O="BIL#:"_ BLN
	12591	"RTN","PSO CPF",80,0)
	12592	... S SC= $P(REC,U,1 1),SCO=$S( SC=1:"YES" ,1:"NO"),S COO="SC:"_ SCO
	12593	"RTN","PSO CPF",81,0)
	12594	... S SCP =$P(REC,U, 12),SCPO=" SC%:"_+SCP
	12595	"RTN","PSO CPF",82,0)
	12596	... S LIN E=$$SETL(" ",SCOO,"", 5,8)
	12597	"RTN","PSO CPF",83,0)
	12598	... S LIN E=$$SETL(L INE,SCPO," ",14,8)
	12599	"RTN","PSO CPF",84,0)
	12600	... S LIN E=$$SETL(L INE,RXO,"" ,35,20)
	12601	"RTN","PSO CPF",85,0)
	12602	... S LIN E=$$SETL(L INE,BLNO," ",62,17)
	12603	"RTN","PSO CPF",86,0)
	12604	... S VAL MCNT=VALMC NT+1
	12605	"RTN","PSO CPF",87,0)
	12606	... D SET ^VALM10(VA LMCNT,LINE ,VCNT)
	12607	"RTN","PSO CPF",88,0)
	12608	... S MTS D=$$FMTE^X LFDT($P(RE C,U,13),"2 DZ"),MTO=" MT DT:"_MT SD
	12609	"RTN","PSO CPF",89,0)
	12610	... S MTS =$P(REC,U, 14),MTSO=" MTS:"_MTS
	12611	"RTN","PSO CPF",90,0)
	12612	... S LIN E=$$SETL(" ",MTSO,"", 5,30)
	12613	"RTN","PSO CPF",91,0)
	12614	... S LIN E=$$SETL(L INE,MTO,"" ,45,14)
	12615	"RTN","PSO CPF",92,0)
	12616	... S VAL MCNT=VALMC NT+1
	12617	"RTN","PSO CPF",93,0)
	12618	... D SET ^VALM10(VA LMCNT,LINE ,VCNT)
	12619	"RTN","PSO CPF",94,0)
	12620	... S LIN E=""
	12621	"RTN","PSO CPF",95,0)
	12622	... S VAL MCNT=VALMC NT+1
	12623	"RTN","PSO CPF",96,0)
	12624	... D SET ^VALM10(VA LMCNT,LINE ,VCNT)
	12625	"RTN","PSO CPF",97,0)
	12626	Q
	12627	"RTN","PSO CPF",98,0)
	12628	;
	12629	"RTN","PSO CPF",99,0)
	12630	SETL(LINE, DATA,LABEL ,COL,LNG) ; Creates a line of data to be set into the body
	12631	"RTN","PSO CPF",100,0 )
	12632	; of the worklist
	12633	"RTN","PSO CPF",101,0 )
	12634	; Input: LINE - Cur rent line being crea ted
	12635	"RTN","PSO CPF",102,0 )
	12636	; DATA - Informatio n to be ad ded to the end of th e current line
	12637	"RTN","PSO CPF",103,0 )
	12638	; LABEL - Label to describe t he informa tion being added
	12639	"RTN","PSO CPF",104,0 )
	12640	; COL - C olumn posi tion in li ne to add informatio n add
	12641	"RTN","PSO CPF",105,0 )
	12642	; LNG - M aximum len gth of dat a informat ion to inc lude on th e line
	12643	"RTN","PSO CPF",106,0 )
	12644	; Returns : Line upd ated with added info rmation
	12645	"RTN","PSO CPF",107,0 )
	12646	S LINE=LI NE_$J("",( COL-$L(LAB EL)-$L(LIN E)))_LABEL _$E(DATA,1 ,LNG)
	12647	"RTN","PSO CPF",108,0 )
	12648	Q LINE
	12649	"RTN","PSO CPF",109,0 )
	12650	;
	12651	"RTN","PSO CPF",110,0 )
	12652	HELP ; -- help code
	12653	"RTN","PSO CPF",111,0 )
	12654	S X="?" D DISP^XQOR M1 W !!
	12655	"RTN","PSO CPF",112,0 )
	12656	Q
	12657	"RTN","PSO CPF",113,0 )
	12658	;
	12659	"RTN","PSO CPF",114,0 )
	12660	EXIT ; -- exit code
	12661	"RTN","PSO CPF",115,0 )
	12662	K ^TMP($J ,"PSOCPF")
	12663	"RTN","PSO CPF",116,0 )
	12664	K ^TMP($J ,"PSOCPFX" )
	12665	"RTN","PSO CPF",117,0 )
	12666	;
	12667	"RTN","PSO CPF",118,0 )
	12668	D CLEAR^V ALM1,CLEAN ^VALM10
	12669	"RTN","PSO CPF",119,0 )
	12670	D ^%ZISC
	12671	"RTN","PSO CPF",120,0 )
	12672	Q
	12673	"RTN","PSO CPF",121,0 )
	12674	;
	12675	"RTN","PSO CPF",122,0 )
	12676	FILTER(FIL TERS) ; fi lter displ ay
	12677	"RTN","PSO CPF",123,0 )
	12678	; Sets an array of filters to determine which ent ris to inc lude in di splay
	12679	"RTN","PSO CPF",124,0 )
	12680	; Input: None
	12681	"RTN","PSO CPF",125,0 )
	12682	; Output:
	12683	"RTN","PSO CPF",126,0 )
	12684	; Returns : 0 if the user ente red '^' or timed out , 1 otherw ise
	12685	"RTN","PSO CPF",127,0 )
	12686	; FILTERS (0) = from date ^ to date ^ 0 (all) 1 (s elected) m edications ^ 0 (all) 1 (select ed) patien ts^
	12687	"RTN","PSO CPF",128,0 )
	12688	; 0 (all) 1 (s elected) s tatus
	12689	"RTN","PSO CPF",129,0 )
	12690	; FILTERS (1,pat ien ) = ""
	12691	"RTN","PSO CPF",130,0 )
	12692	; FILTERS (2,med ien ) = ""
	12693	"RTN","PSO CPF",131,0 )
	12694	; FILTERS (3,status ien) = ""
	12695	"RTN","PSO CPF",132,0 )
	12696	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,XX,Y,I BDATES
	12697	"RTN","PSO CPF",133,0 )
	12698	K FILTERS
	12699	"RTN","PSO CPF",134,0 )
	12700	; get dat e range
	12701	"RTN","PSO CPF",135,0 )
	12702	S IBDATES ="Fill Dat es",IBDATE S=$$FMDATE S(IBDATES) I IBDATES =0 Q 0
	12703	"RTN","PSO CPF",136,0 )
	12704	S FILTERS (0)=IBDATE S
	12705	"RTN","PSO CPF",137,0 )
	12706	;
	12707	"RTN","PSO CPF",138,0 )
	12708	; Medicat ions filte r
	12709	"RTN","PSO CPF",139,0 )
	12710	S DIR(0)= "S",DIR("A ")="Select (A)ll or ( S)elected Medication (s):",DIR( "B")="All"
	12711	"RTN","PSO CPF",140,0 )
	12712	S DIR("?" ,1)="Enter 'A' to no t filter b y Medicati on."
	12713	"RTN","PSO CPF",141,0 )
	12714	S DIR("?" )="Enter ' S' to view entries f or selecte d Medicati ons(s)."
	12715	"RTN","PSO CPF",142,0 )
	12716	S $P(DIR( 0),U,2)="A :All Medic ations;S:S elected Me dications"
	12717	"RTN","PSO CPF",143,0 )
	12718	W ! D ^DI R K DIR
	12719	"RTN","PSO CPF",144,0 )
	12720	I $G(DIRU T) Q 0
	12721	"RTN","PSO CPF",145,0 )
	12722	S X=$$UP^ XLFSTR(X)
	12723	"RTN","PSO CPF",146,0 )
	12724	S $P(FILT ERS(0),U,3 )=$S(Y="A" :0,1:1)
	12725	"RTN","PSO CPF",147,0 )
	12726	;
	12727	"RTN","PSO CPF",148,0 )
	12728	; Set Med ication fi lter
	12729	"RTN","PSO CPF",149,0 )
	12730	I $P(FILT ERS(0),U,3 )=1 D ASKM ED(.FILTER S)
	12731	"RTN","PSO CPF",150,0 )
	12732	;
	12733	"RTN","PSO CPF",151,0 )
	12734	; Patient filter
	12735	"RTN","PSO CPF",152,0 )
	12736	S DIR(0)= "S",DIR("A ")="Select (A)ll or ( S)elected Patient(s) :",DIR("B" )="All"
	12737	"RTN","PSO CPF",153,0 )
	12738	S DIR("?" ,1)="Enter 'A' to no t filter b y Patient. "
	12739	"RTN","PSO CPF",154,0 )
	12740	S DIR("?" )="Enter ' S' to view entries f or selecte d Patients ."
	12741	"RTN","PSO CPF",155,0 )
	12742	S $P(DIR( 0),U,2)="A :All Patie nts;S:Sele cted Patie nts"
	12743	"RTN","PSO CPF",156,0 )
	12744	W ! D ^DI R K DIR
	12745	"RTN","PSO CPF",157,0 )
	12746	I $G(DIRU T) Q 0
	12747	"RTN","PSO CPF",158,0 )
	12748	S X=$$UP^ XLFSTR(X)
	12749	"RTN","PSO CPF",159,0 )
	12750	S $P(FILT ERS(0),U,4 )=$S(Y="A" :0,1:1)
	12751	"RTN","PSO CPF",160,0 )
	12752	; Set Pat ient / Vet eran filte r
	12753	"RTN","PSO CPF",161,0 )
	12754	I $P(FILT ERS(0),U,4 )=1 D ASKP AT(.FILTER S)
	12755	"RTN","PSO CPF",162,0 )
	12756	;
	12757	"RTN","PSO CPF",163,0 )
	12758	; Status filter
	12759	"RTN","PSO CPF",164,0 )
	12760	S DIR(0)= "S",DIR("A ")="Select (A)ll or ( S)elected AR Statuse s:",DIR("B ")="Select ed"
	12761	"RTN","PSO CPF",165,0 )
	12762	S DIR("?" ,1)="Enter 'A' to no t filter b y AR Statu s."
	12763	"RTN","PSO CPF",166,0 )
	12764	S DIR("?" )="Enter ' S' to view entries f or selecte d Statuses ."
	12765	"RTN","PSO CPF",167,0 )
	12766	S $P(DIR( 0),U,2)="A :All Statu ses;S:Sele cted Statu ses"
	12767	"RTN","PSO CPF",168,0 )
	12768	W ! D ^DI R K DIR
	12769	"RTN","PSO CPF",169,0 )
	12770	I $G(DIRU T) Q 0
	12771	"RTN","PSO CPF",170,0 )
	12772	S X=$$UP^ XLFSTR(X)
	12773	"RTN","PSO CPF",171,0 )
	12774	S $P(FILT ERS(0),U,5 )=$S(Y="A" :0,1:1)
	12775	"RTN","PSO CPF",172,0 )
	12776	; Set Sta tus filter
	12777	"RTN","PSO CPF",173,0 )
	12778	I $P(FILT ERS(0),U,5 )=1 D ASKS TAT(.FILTE RS)
	12779	"RTN","PSO CPF",174,0 )
	12780	;
	12781	"RTN","PSO CPF",175,0 )
	12782	D SHOWFIL T(.FILTERS )
	12783	"RTN","PSO CPF",176,0 )
	12784	I X="^" Q 0
	12785	"RTN","PSO CPF",177,0 )
	12786	Q 1
	12787	"RTN","PSO CPF",178,0 )
	12788	;
	12789	"RTN","PSO CPF",179,0 )
	12790	FMDATES(PR OMPT) ; as k for date range
	12791	"RTN","PSO CPF",180,0 )
	12792	N %DT,X,Y ,DT1,DT2,I B0,IB1,IB2
	12793	"RTN","PSO CPF",181,0 )
	12794	S DIR(0)= "S",DIR("A ")="Select (A)ll or ( S)elected Date(s):", DIR("B")=" S"
	12795	"RTN","PSO CPF",182,0 )
	12796	S DIR("?" ,1)="Enter 'A' to vi ew all Dat es."
	12797	"RTN","PSO CPF",183,0 )
	12798	S DIR("?" )="Enter ' S' to view entries f or selecte d Dates."
	12799	"RTN","PSO CPF",184,0 )
	12800	S $P(DIR( 0),U,2)="A :All Dates ;S:Selecte d Dates"
	12801	"RTN","PSO CPF",185,0 )
	12802	W ! D ^DI R K DIR
	12803	"RTN","PSO CPF",186,0 )
	12804	I X="^" Q 0
	12805	"RTN","PSO CPF",187,0 )
	12806	I $G(DIRU T) Q 0
	12807	"RTN","PSO CPF",188,0 )
	12808	I $E(Y)=" A" S DT1=0 _U_DT G FM DQ
	12809	"RTN","PSO CPF",189,0 )
	12810	S DT1="", IB1="Start with date entered: ",IB2="Go to date en tered: "
	12811	"RTN","PSO CPF",190,0 )
	12812	I $G(PROM PT)'="" S IB1="Start with "_PR OMPT_": ", IB2="Go to "_PROMPT_ ": "
	12813	"RTN","PSO CPF",191,0 )
	12814	S %DT="AE X",%DT("A" )=IB1 D ^% DT K %DT I Y<0!($P(Y ,".",1)'?7 N) G FMDQ
	12815	"RTN","PSO CPF",192,0 )
	12816	S (%DT(0) ,DT2)=$P(Y ,".",1) I DT2'>DT S %DT("B")=" Today"
	12817	"RTN","PSO CPF",193,0 )
	12818	S %DT="AE X",%DT("A" )=IB2 D ^% DT K %DT I Y<0!($P(Y ,".",1)'?7 N) G FMDQ
	12819	"RTN","PSO CPF",194,0 )
	12820	S DT1=DT2 _U_$P(Y,". ",1)
	12821	"RTN","PSO CPF",195,0 )
	12822	FMDQ Q DT1
	12823	"RTN","PSO CPF",196,0 )
	12824	;
	12825	"RTN","PSO CPF",197,0 )
	12826	ASKMED(FIL TERS) ; Sets a lis t of Medic ations to be display ed
	12827	"RTN","PSO CPF",198,0 )
	12828	; Input: FILTERS - Current Array of f ilter sett ings
	12829	"RTN","PSO CPF",199,0 )
	12830	; Output: FILTERS - Updated Array of f ilter sett ings
	12831	"RTN","PSO CPF",200,0 )
	12832	N DIC,DIR ,DIRUT,DIV S,DUOUT,FI RST,PSOIEN S,PSOIENS2 ,IEN,N,X,X X,Y
	12833	"RTN","PSO CPF",201,0 )
	12834	S DIC=50, DIC(0)="AE QMN",FIRST =1
	12835	"RTN","PSO CPF",202,0 )
	12836	F D Q:+ IEN<1
	12837	"RTN","PSO CPF",203,0 )
	12838	. D ONEME D(.DIC,.IE N,.FIRST) ; One Medica tion promp t
	12839	"RTN","PSO CPF",204,0 )
	12840	. Q:+IEN< 1
	12841	"RTN","PSO CPF",205,0 )
	12842	. S PSOIE NS($P(IEN, U,2))=$P(I EN,U,1)
	12843	"RTN","PSO CPF",206,0 )
	12844	. S PSOIE NS2($P(IEN ,U,1))=$P( IEN,U,2)
	12845	"RTN","PSO CPF",207,0 )
	12846	I '$D(PSO IENS) S $P (FILTERS(0 ),U,3)=0 Q
	12847	"RTN","PSO CPF",208,0 )
	12848	;
	12849	"RTN","PSO CPF",209,0 )
	12850	; Set the filter no de respons es in alph abetical o rder
	12851	"RTN","PSO CPF",210,0 )
	12852	S XX=""
	12853	"RTN","PSO CPF",211,0 )
	12854	F D Q:X X=""
	12855	"RTN","PSO CPF",212,0 )
	12856	. S XX=$O (PSOIENS(X X))
	12857	"RTN","PSO CPF",213,0 )
	12858	. Q:XX=""
	12859	"RTN","PSO CPF",214,0 )
	12860	. S N=PSO IENS(XX)
	12861	"RTN","PSO CPF",215,0 )
	12862	. S FILTE RS(1,N)=XX
	12863	"RTN","PSO CPF",216,0 )
	12864	Q
	12865	"RTN","PSO CPF",217,0 )
	12866	;
	12867	"RTN","PSO CPF",218,0 )
	12868	ONEMED(DIC ,IEN,FIRST ) ; Promp ts the use r for a Me dication
	12869	"RTN","PSO CPF",219,0 )
	12870	; Input: DIC - Variable /Array of settings n eeded for ^DIC call
	12871	"RTN","PSO CPF",220,0 )
	12872	; FIRST - Set to 1 initially and then 0 for subs equent cal ls
	12873	"RTN","PSO CPF",221,0 )
	12874	; Output: FIRST - Set to 0
	12875	"RTN","PSO CPF",222,0 )
	12876	; IEN - IEN of t he selecte d Division
	12877	"RTN","PSO CPF",223,0 )
	12878	; null of no selecti on was mad e
	12879	"RTN","PSO CPF",224,0 )
	12880	S DIC("A" )=$S(FIRST :"Select a Medicatio n: ",1:"Se lect Anoth er Medicat ion: ")
	12881	"RTN","PSO CPF",225,0 )
	12882	D ^DIC
	12883	"RTN","PSO CPF",226,0 )
	12884	S FIRST=0 ,IEN=Y
	12885	"RTN","PSO CPF",227,0 )
	12886	Q
	12887	"RTN","PSO CPF",228,0 )
	12888	;
	12889	"RTN","PSO CPF",229,0 )
	12890	ASKPAT(FIL TERS) ; Sets a lis t of patie nts
	12891	"RTN","PSO CPF",230,0 )
	12892	; the HCS R Worklist
	12893	"RTN","PSO CPF",231,0 )
	12894	; Input: FILTERS - Current Array of f ilter sett ings
	12895	"RTN","PSO CPF",232,0 )
	12896	; Output: FILTERS - Updated Array of f ilter sett ings
	12897	"RTN","PSO CPF",233,0 )
	12898	N CLINS,D IC,DIR,DIR UT,DIVS,DU OUT,FIRST, IBIENS,IBI ENS2,IEN,N ,NM,NODE,W ARDS,X,XX, Y
	12899	"RTN","PSO CPF",234,0 )
	12900	S DIC(0)= "AEQMN",DI C="^DPT(", FIRST=1
	12901	"RTN","PSO CPF",235,0 )
	12902	F D Q:+ IEN<1
	12903	"RTN","PSO CPF",236,0 )
	12904	. D ONEPA T(.DIC,.IE N,.FIRST) ; One patient
	12905	"RTN","PSO CPF",237,0 )
	12906	. Q:+IEN< 1
	12907	"RTN","PSO CPF",238,0 )
	12908	. S IBIEN S($P(IEN,U ,2))=$P(IE N,U,1)
	12909	"RTN","PSO CPF",239,0 )
	12910	. S IBIEN S2($P(IEN, U,1))=$P(I EN,U,2)
	12911	"RTN","PSO CPF",240,0 )
	12912	I '$D(IBI ENS) S $P( FILTERS(0) ,U,4)=0 Q
	12913	"RTN","PSO CPF",241,0 )
	12914	;
	12915	"RTN","PSO CPF",242,0 )
	12916	; Set the filter no de respons es in alph abetical o rder
	12917	"RTN","PSO CPF",243,0 )
	12918	S XX=""
	12919	"RTN","PSO CPF",244,0 )
	12920	F D Q:X X=""
	12921	"RTN","PSO CPF",245,0 )
	12922	. S XX=$O (IBIENS(XX ))
	12923	"RTN","PSO CPF",246,0 )
	12924	. Q:XX=""
	12925	"RTN","PSO CPF",247,0 )
	12926	. S N=IBI ENS(XX)
	12927	"RTN","PSO CPF",248,0 )
	12928	. S FILTE RS(2,N)=XX
	12929	"RTN","PSO CPF",249,0 )
	12930	Q
	12931	"RTN","PSO CPF",250,0 )
	12932	;
	12933	"RTN","PSO CPF",251,0 )
	12934	ONEPAT(DIC ,IEN,FIRST ) ; Promp ts the use r for a cl inic or wa rd
	12935	"RTN","PSO CPF",252,0 )
	12936	; Input: DIC - Variable /Array of settings n eeded for ^DIC call
	12937	"RTN","PSO CPF",253,0 )
	12938	; FIRST - Set to 1 initially and then 0 for subs equent cal ls
	12939	"RTN","PSO CPF",254,0 )
	12940	; Output: FIRST - Set to 0
	12941	"RTN","PSO CPF",255,0 )
	12942	; IEN - IEN of t he selecte d Patient
	12943	"RTN","PSO CPF",256,0 )
	12944	; null of no selecti on was mad e
	12945	"RTN","PSO CPF",257,0 )
	12946	N DPTNOFZ Y S DPTNOF ZY=1 ;Sup press PATI ENT file f uzzy looku ps
	12947	"RTN","PSO CPF",258,0 )
	12948	S DIC("A" )=$S(FIRST :"Select P atient: ", 1:"Select Another Pa tient: ")
	12949	"RTN","PSO CPF",259,0 )
	12950	D ^DIC
	12951	"RTN","PSO CPF",260,0 )
	12952	S FIRST=0 ,IEN=Y
	12953	"RTN","PSO CPF",261,0 )
	12954	S DFN=+Y
	12955	"RTN","PSO CPF",262,0 )
	12956	Q
	12957	"RTN","PSO CPF",263,0 )
	12958	;
	12959	"RTN","PSO CPF",264,0 )
	12960	;
	12961	"RTN","PSO CPF",265,0 )
	12962	ASKSTAT(FI LTERS) ; Sets a li st of stat us
	12963	"RTN","PSO CPF",266,0 )
	12964	; the HCS R Worklist
	12965	"RTN","PSO CPF",267,0 )
	12966	; Input: FILTERS - Current Array of f ilter sett ings
	12967	"RTN","PSO CPF",268,0 )
	12968	; Output: FILTERS - Updated Array of f ilter sett ings
	12969	"RTN","PSO CPF",269,0 )
	12970	N CLINS,D IC,DIR,DIR UT,DIVS,DU OUT,FIRST, IBSTAT,IBS TAT2,IEN,N ,NM,NODE,W ARDS,X,XX, Y
	12971	"RTN","PSO CPF",270,0 )
	12972	S DIC(0)= "AEQMN",DI C="430.3", FIRST=1,DI C("B")="AC TIVE"
	12973	"RTN","PSO CPF",271,0 )
	12974	F D Q:+ IEN<1
	12975	"RTN","PSO CPF",272,0 )
	12976	. D ONEST A(.DIC,.IE N,.FIRST) ; One status
	12977	"RTN","PSO CPF",273,0 )
	12978	. Q:+IEN< 1
	12979	"RTN","PSO CPF",274,0 )
	12980	. S IBSTA T($P(IEN,U ,2))=$P(IE N,U,1)
	12981	"RTN","PSO CPF",275,0 )
	12982	. S IBSTA T2($P(IEN, U,1))=$P(I EN,U,2)
	12983	"RTN","PSO CPF",276,0 )
	12984	I '$D(IBS TAT) S $P( FILTERS(0) ,U,5)=0 Q
	12985	"RTN","PSO CPF",277,0 )
	12986	;
	12987	"RTN","PSO CPF",278,0 )
	12988	; Set the filter no de respons es in alph abetical o rder
	12989	"RTN","PSO CPF",279,0 )
	12990	S XX=""
	12991	"RTN","PSO CPF",280,0 )
	12992	F D Q:X X=""
	12993	"RTN","PSO CPF",281,0 )
	12994	. S XX=$O (IBSTAT(XX ))
	12995	"RTN","PSO CPF",282,0 )
	12996	. Q:XX=""
	12997	"RTN","PSO CPF",283,0 )
	12998	. S N=IBS TAT(XX)
	12999	"RTN","PSO CPF",284,0 )
	13000	. S FILTE RS(3,N)=XX
	13001	"RTN","PSO CPF",285,0 )
	13002	Q
	13003	"RTN","PSO CPF",286,0 )
	13004	;
	13005	"RTN","PSO CPF",287,0 )
	13006	ONESTA(DIC ,IEN,FIRST ) ; Promp ts the use r for a st atus
	13007	"RTN","PSO CPF",288,0 )
	13008	; Input: DIC - Variable /Array of settings n eeded for ^DIC call
	13009	"RTN","PSO CPF",289,0 )
	13010	; FIRST - Set to 1 initially and then 0 for subs equent cal ls
	13011	"RTN","PSO CPF",290,0 )
	13012	; Output: FIRST - Set to 0
	13013	"RTN","PSO CPF",291,0 )
	13014	; IEN - IEN of t he selecte d status
	13015	"RTN","PSO CPF",292,0 )
	13016	; null of no selecti on was mad e
	13017	"RTN","PSO CPF",293,0 )
	13018	N DPTNOFZ Y S DPTNOF ZY=1 ;Sup press file fuzzy loo kups
	13019	"RTN","PSO CPF",294,0 )
	13020	S DIC("A" )=$S(FIRST :"Select S tatus: ",1 :"Select A nother Sta tus: ")
	13021	"RTN","PSO CPF",295,0 )
	13022	D ^DIC
	13023	"RTN","PSO CPF",296,0 )
	13024	S FIRST=0 ,IEN=Y_U_X ,DIC("B")= ""
	13025	"RTN","PSO CPF",297,0 )
	13026	Q
	13027	"RTN","PSO CPF",298,0 )
	13028	;
	13029	"RTN","PSO CPF",299,0 )
	13030	SHOWFILT(F ILTERS) ;EP
	13031	"RTN","PSO CPF",300,0 )
	13032	; Display s the curr ently sele cted filte r selectio ns for the
	13033	"RTN","PSO CPF",301,0 )
	13034	; Held Ch arges List Manager di splay
	13035	"RTN","PSO CPF",302,0 )
	13036	; Input: FILTERS( ) - Arra y of filte r settings . See FILT ERS for a detailed
	13037	"RTN","PSO CPF",303,0 )
	13038	; expl anation of the FILTE RS array
	13039	"RTN","PSO CPF",304,0 )
	13040	; Output: Current Filter set tings are displayed
	13041	"RTN","PSO CPF",305,0 )
	13042	;
	13043	"RTN","PSO CPF",306,0 )
	13044	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,IEN,IX,L EN,XX,PFLG ,STDT
	13045	"RTN","PSO CPF",307,0 )
	13046	S STDT=$P (FILTERS(0 ),U)
	13047	"RTN","PSO CPF",308,0 )
	13048	W !!!,"Sh ow From Da te: ",$S(S TDT=0:"Fir st",1:$$FM TE^XLFDT(S TDT,"2DZ") )
	13049	"RTN","PSO CPF",309,0 )
	13050	W !," Thru Date : ",$$FMTE ^XLFDT($P( FILTERS(0) ,U,2),"2DZ ")
	13051	"RTN","PSO CPF",310,0 )
	13052	W !,"Show All Medic ations or Selected M edications : "
	13053	"RTN","PSO CPF",311,0 )
	13054	W $S($P(F ILTERS(0), U,3)=0:"Al l",1:"Sele cted")
	13055	"RTN","PSO CPF",312,0 )
	13056	;
	13057	"RTN","PSO CPF",313,0 )
	13058	; Medicat ion list ( if any)
	13059	"RTN","PSO CPF",314,0 )
	13060	I ($P(FIL TERS(0),U, 3)=1) D
	13061	"RTN","PSO CPF",315,0 )
	13062	. S LINE= "Medicatio ns to Disp lay: "
	13063	"RTN","PSO CPF",316,0 )
	13064	. S IEN=0 ,PFLG=0
	13065	"RTN","PSO CPF",317,0 )
	13066	. F S IE N=$O(FILTE RS(1,IEN)) Q:IEN="" D
	13067	"RTN","PSO CPF",318,0 )
	13068	. . S XX= FILTERS(1, IEN)
	13069	"RTN","PSO CPF",319,0 )
	13070	. . S LIN E=LINE_$S( LINE="Medi cations to Display: ":"",1:", ")_XX
	13071	"RTN","PSO CPF",320,0 )
	13072	. W !,$$W RAP(.LINE, .PFLG,80)
	13073	"RTN","PSO CPF",321,0 )
	13074	. F I=0:0 Q:'PFLG W !,?22,$$ WRAP(.LINE ,.PFLG,58)
	13075	"RTN","PSO CPF",322,0 )
	13076	;
	13077	"RTN","PSO CPF",323,0 )
	13078	W !,"Show All Patie nts or Sel ected Pati ents: "
	13079	"RTN","PSO CPF",324,0 )
	13080	W $S($P(F ILTERS(0), U,4)=0:"Al l",1:"Sele cted")
	13081	"RTN","PSO CPF",325,0 )
	13082	; Patient Inclusion list (if any)
	13083	"RTN","PSO CPF",326,0 )
	13084	I ($P(FIL TERS(0),U, 4)=1) D
	13085	"RTN","PSO CPF",327,0 )
	13086	. S LINE= "Patients to Display : "
	13087	"RTN","PSO CPF",328,0 )
	13088	. S IEN=0 ,PFLG=0
	13089	"RTN","PSO CPF",329,0 )
	13090	. F S IE N=$O(FILTE RS(2,IEN)) Q:IEN="" D
	13091	"RTN","PSO CPF",330,0 )
	13092	. . S XX= FILTERS(2, IEN)
	13093	"RTN","PSO CPF",331,0 )
	13094	. . S LIN E=LINE_$S( LINE="Pati ents to Di splay: ":" ",1:", ")_ XX
	13095	"RTN","PSO CPF",332,0 )
	13096	. W !,$$W RAP(.LINE, .PFLG,80)
	13097	"RTN","PSO CPF",333,0 )
	13098	. F I=0:0 Q:'PFLG W !,?21,$$ WRAP(.LINE ,.PFLG,60)
	13099	"RTN","PSO CPF",334,0 )
	13100	;
	13101	"RTN","PSO CPF",335,0 )
	13102	W !,"Show All Statu ses or Sel ected Stat uses: "
	13103	"RTN","PSO CPF",336,0 )
	13104	W $S($P(F ILTERS(0), U,5)=0:"Al l",1:"Sele cted")
	13105	"RTN","PSO CPF",337,0 )
	13106	; AR Stat us Inclusi on list (i f any)
	13107	"RTN","PSO CPF",338,0 )
	13108	I ($P(FIL TERS(0),U, 5)=1) D
	13109	"RTN","PSO CPF",339,0 )
	13110	. S LINE= "AR Status to Displa y: "
	13111	"RTN","PSO CPF",340,0 )
	13112	. S IEN=0 ,PFLG=0
	13113	"RTN","PSO CPF",341,0 )
	13114	. F S IE N=$O(FILTE RS(3,IEN)) Q:IEN="" D
	13115	"RTN","PSO CPF",342,0 )
	13116	. . S XX= $$GET1^DIQ (430.3,IEN _",",.01)
	13117	"RTN","PSO CPF",343,0 )
	13118	. . S LIN E=LINE_$S( LINE="AR S tatus to D isplay: ": "",1:", ") _XX
	13119	"RTN","PSO CPF",344,0 )
	13120	. W !,$$W RAP(.LINE, .PFLG,80)
	13121	"RTN","PSO CPF",345,0 )
	13122	. F I=0:0 Q:'PFLG W !,?21,$$ WRAP(.LINE ,.PFLG,60)
	13123	"RTN","PSO CPF",346,0 )
	13124	;
	13125	"RTN","PSO CPF",347,0 )
	13126	K DIR
	13127	"RTN","PSO CPF",348,0 )
	13128	D PAUSE^V ALM1
	13129	"RTN","PSO CPF",349,0 )
	13130	Q
	13131	"RTN","PSO CPF",350,0 )
	13132	;
	13133	"RTN","PSO CPF",351,0 )
	13134	WRAP(STR,F LG,CL) ;
	13135	"RTN","PSO CPF",352,0 )
	13136	; STR - S TRING TO B E WRAPPED PASSED IN BE REFEREN CE SO IT C ONTAINS TH E REMAING PORTION OF STRING
	13137	"RTN","PSO CPF",353,0 )
	13138	; FLG - F LAG TO IND ICATE WRAP PING NEEDS TO OCCUR
	13139	"RTN","PSO CPF",354,0 )
	13140	; CL - CO LUMN LENGT H
	13141	"RTN","PSO CPF",355,0 )
	13142	;
	13143	"RTN","PSO CPF",356,0 )
	13144	; NO WRAP PING REQUI RED
	13145	"RTN","PSO CPF",357,0 )
	13146	I $L(STR) '>CL S FLG =0 Q STR
	13147	"RTN","PSO CPF",358,0 )
	13148	S FLG=1
	13149	"RTN","PSO CPF",359,0 )
	13150	N A,B,C
	13151	"RTN","PSO CPF",360,0 )
	13152	; POSITIO N AFTER CO LUMN WIDTH BREAK IS A SPACE
	13153	"RTN","PSO CPF",361,0 )
	13154	I $E(STR, CL+1)=" " S B=$E(STR ,1,CL),STR =$E(STR,CL +2,999) Q B
	13155	"RTN","PSO CPF",362,0 )
	13156	S A=$E(ST R,1,CL)
	13157	"RTN","PSO CPF",363,0 )
	13158	; NO SPAC ES WITHIN COLUMN WIT H, JUST BR EAK AT COL UMN WIDTH
	13159	"RTN","PSO CPF",364,0 )
	13160	I $L(A," ")=1 S STR =$E(STR,CL +1,999) Q A
	13161	"RTN","PSO CPF",365,0 )
	13162	; BREAK O N LAST SEM ICOLON PIE CE WITHIN COLUMN WID TH
	13163	"RTN","PSO CPF",366,0 )
	13164	S C=$L(A, " ")
	13165	"RTN","PSO CPF",367,0 )
	13166	S B=$P(A, " ",1,C-1)
	13167	"RTN","PSO CPF",368,0 )
	13168	S STR=$P( A," ",C)_$ E(STR,CL+1 ,999)
	13169	"RTN","PSO CPF",369,0 )
	13170	Q B
	13171	"RTN","PSO CPF1")
	13172	0^3^B37268 746
	13173	"RTN","PSO CPF1",1,0)
	13174	PSOCPF1 ;B IR/BAA - P harmacy CO -PAY Appli cation Uti lities for IB ;02/06 /92
	13175	"RTN","PSO CPF1",2,0)
	13176	;;7.0;OUT PATIENT PH ARMACY;4 63;DEC 1 997;Build 11
	13177	"RTN","PSO CPF1",3,0)
	13178	;;Per VA Directive 6402, this routine s hould not be modifie d.
	13179	"RTN","PSO CPF1",4,0)
	13180	;
	13181	"RTN","PSO CPF1",5,0)
	13182	SORT ; get the data
	13183	"RTN","PSO CPF1",6,0)
	13184	;S ^TMP($ J,"PSOCPF" ,PTNM,MED, RFL)=PTNM_ U_PID_U_ME D_U_RX_U_F ILDT_U_BLN _U_IBST1_U _SC_U_SCP_ U_MTSD_U_M TS_U_RNB_U _DFN
	13185	"RTN","PSO CPF1",7,0)
	13186	N CNT,PTN M,PID,MED, RX,FILDT,F LN,IBST1,S C,SCP,MTSD ,MTS,RNB,D FN,MIEN
	13187	"RTN","PSO CPF1",8,0)
	13188	K ^TMP($J ,"PSOCPF")
	13189	"RTN","PSO CPF1",9,0)
	13190	; compile data to d isplay her e
	13191	"RTN","PSO CPF1",10,0 )
	13192	S BDATE=$ P(FILTERS( 0),U,1),ED ATE=$P(FIL TERS(0),U, 2)
	13193	"RTN","PSO CPF1",11,0 )
	13194	S MEDS=$P (FILTERS(0 ),U,3),PAT S=$P(FILTE RS(0),U,4)
	13195	"RTN","PSO CPF1",12,0 )
	13196	S STATS=$ P(FILTERS( 0),U,5)
	13197	"RTN","PSO CPF1",13,0 )
	13198	S FILDT=B DATE-.01,E ND=EDATE+. 9
	13199	"RTN","PSO CPF1",14,0 )
	13200	F S FILD T=$O(^PSRX ("AD",FILD T)) Q:FILD T>END Q:F ILDT="" D
	13201	"RTN","PSO CPF1",15,0 )
	13202	. S RIEN= 0 F S RIE N=$O(^PSRX ("AD",FILD T,RIEN)) Q :RIEN="" D
	13203	"RTN","PSO CPF1",16,0 )
	13204	.. S RFL= $O(^PSRX(" AD",FILDT, RIEN,""))
	13205	"RTN","PSO CPF1",17,0 )
	13206	.. I '$D( ^PSRX(RIEN ,0)) Q
	13207	"RTN","PSO CPF1",18,0 )
	13208	.. S RX=$ $GET1^DIQ( 52,RIEN_", ",.01,"E")
	13209	"RTN","PSO CPF1",19,0 )
	13210	.. S DRG= $$GET1^DIQ (52,RIEN_" ,",6,"I"), MED=$$GET1 ^DIQ(52,RI EN_",",6," O")
	13211	"RTN","PSO CPF1",20,0 )
	13212	.. I DRG= "" Q
	13213	"RTN","PSO CPF1",21,0 )
	13214	.. I MEDS ,'$D(FILTE RS(1,DRG)) Q
	13215	"RTN","PSO CPF1",22,0 )
	13216	.. S DFN= $$GET1^DIQ (52,RIEN_" ,",2,"I") I DFN="" Q I '$D(^D PT(DFN,0)) Q
	13217	"RTN","PSO CPF1",23,0 )
	13218	.. I PATS ,'$D(FILTE RS(2,DFN)) Q
	13219	"RTN","PSO CPF1",24,0 )
	13220	.. D DEM^ VADPT S PT NM=VADM(1) ,PID=$P(VA DM(2),U,1) ,PID=$E(PT NM,1)_$E(P ID,6,9)
	13221	"RTN","PSO CPF1",25,0 )
	13222	.. D ELIG ^VADPT S S C=$P(VAEL( 3),U,1),SC P=$P(VAEL( 3),U,2),MT S=$P(VAEL( 9),U,2)
	13223	"RTN","PSO CPF1",26,0 )
	13224	.. S MIEN ="" S MIEN =$O(^DGMT( 408.31,"C" ,DFN,MIEN) ,-1)
	13225	"RTN","PSO CPF1",27,0 )
	13226	.. S MREC =$S(MIEN'= "":^DGMT(4 08.31,MIEN ,0),1:""), MTSD=$P(MR EC,U,1)
	13227	"RTN","PSO CPF1",28,0 )
	13228	.. I MTS= "NO LONGER REQUIRED" S MTSD=$P (MREC,U,17 )
	13229	"RTN","PSO CPF1",29,0 )
	13230	.. I RFL S IBN=$$GE T1^DIQ(52. 1,RFL_","_ RIEN,9,"I" )
	13231	"RTN","PSO CPF1",30,0 )
	13232	.. I 'RFL S IBN=$$G ET1^DIQ(52 ,RIEN_",", 106,"I")
	13233	"RTN","PSO CPF1",31,0 )
	13234	.. I IBN= "" S (PBIL ,BLNO,ARTR N,PRIEN,AR ST1,ARST)= "" Q
	13235	"RTN","PSO CPF1",32,0 )
	13236	.. S (PBI L,ARST1,AR ST,BLNO,AR TRN,PBIL,P RIEN)=""
	13237	"RTN","PSO CPF1",33,0 )
	13238	.. S BLNO =$$GET1^DI Q(350,IBN_ ",",.11,"I ")
	13239	"RTN","PSO CPF1",34,0 )
	13240	.. S ARTR N=$$GET1^D IQ(350,IBN _",",.12," I")
	13241	"RTN","PSO CPF1",35,0 )
	13242	.. I ARTR N'="" S (P BIL,PRIEN) =$$GET1^DI Q(433,ARTR N_",",.03, "I")
	13243	"RTN","PSO CPF1",36,0 )
	13244	.. I BLNO ="",PBIL'= "" S BLNO= $$GET1^DIQ (430,PBIL_ ",",.01)
	13245	"RTN","PSO CPF1",37,0 )
	13246	.. I PRIE N'="" S AR ST1=$$GET1 ^DIQ(430,P RIEN_",",8 ,"O"),ARST =$$GET1^DI Q(430,PRIE N_",",8,"I ")
	13247	"RTN","PSO CPF1",38,0 )
	13248	.. I STAT S,'$D(FILT ERS(3,+ARS T)) Q
	13249	"RTN","PSO CPF1",39,0 )
	13250	.. S ^TMP ($J,"PSOCP F",PTNM,RI EN,RFL)=PT NM_U_PID_U _MED_U_RIE N_U_RFL_U_ ARTRN_U_RX _U_FILDT_U _BLNO_U_AR ST1_U_SC_U _SCP_U_MTS D_U_MTS_U_ DFN_U_PBIL _U_ARST_U_ PRIEN_U_IB N
	13251	"RTN","PSO CPF1",40,0 )
	13252	Q
	13253	"RTN","PSO CPF1",41,0 )
	13254	;
	13255	"RTN","PSO CPF1",42,0 )
	13256	RESET ; RE SET COPAY STATUS
	13257	"RTN","PSO CPF1",43,0 )
	13258	;NAME_U_P ID_U_MED_U _RIEN_U_RF L_U_RX_U_D FN
	13259	"RTN","PSO CPF1",44,0 )
	13260	D FULL^VA LM1
	13261	"RTN","PSO CPF1",45,0 )
	13262	N I,J,IBX X,VALMY,EC NT,NAME,GO TPAT,RC,IB FR,IBTO
	13263	"RTN","PSO CPF1",46,0 )
	13264	D EN^VALM 2($G(XQORN OD(0)))
	13265	"RTN","PSO CPF1",47,0 )
	13266	I $D(VALM Y),'NODATA D
	13267	"RTN","PSO CPF1",48,0 )
	13268	. S IBXX= 0 F S IBX X=$O(VALMY (IBXX)) Q: 'IBXX D
	13269	"RTN","PSO CPF1",49,0 )
	13270	.. S RC=$ G(^TMP($J, "PSOCPFX", IBXX))
	13271	"RTN","PSO CPF1",50,0 )
	13272	.. S NAME =$P(RC,U,1 ),PSODA=$P (RC,U,4),M ED=$P(RC,U ,3),RFL=$P (RC,U,5),R X=$P(RC,U, 6),DFN=$P( RC,U,7)
	13273	"RTN","PSO CPF1",51,0 )
	13274	.. D STAT US(PSODA,R FL)
	13275	"RTN","PSO CPF1",52,0 )
	13276	D BLD^PSO CPF
	13277	"RTN","PSO CPF1",53,0 )
	13278	S VALMBCK ="R"
	13279	"RTN","PSO CPF1",54,0 )
	13280	Q
	13281	"RTN","PSO CPF1",55,0 )
	13282	;
	13283	"RTN","PSO CPF1",56,0 )
	13284	STATUS(PSO DA,RFL) ; PROCESS ST ATUS CHANG E
	13285	"RTN","PSO CPF1",57,0 )
	13286	I '$D(PSO PAR) D ^PS OLSET
	13287	"RTN","PSO CPF1",58,0 )
	13288	W !,?17," PATIENT: " ,NAME
	13289	"RTN","PSO CPF1",59,0 )
	13290	S PSORXN= $P(^PSRX(P SODA,0),"^ "),PREA="R "
	13291	"RTN","PSO CPF1",60,0 )
	13292	S PCOPAY= $G(^PSRX(P SODA,"IB") )
	13293	"RTN","PSO CPF1",61,0 )
	13294	W !!,"Rx # ",PSORXN ," is a ", $S(+PCOPAY :"Copay",1 :"No Copay ")," presc ription"
	13295	"RTN","PSO CPF1",62,0 )
	13296	D PFSA^PS OPFSU1(PSO DA,RFL,3) ;PSOCPC d ef PSOPFSA =1 if OP S C/EI's cha nge.
	13297	"RTN","PSO CPF1",63,0 )
	13298	D EXEMCHK ^PSOCPC ; CHECK/CHAN GE EXEMPTI ON FLAGS
	13299	"RTN","PSO CPF1",64,0 )
	13300	S PSOIBQ= $G(^PSRX(P SODA,"IBQ" ))
	13301	"RTN","PSO CPF1",65,0 )
	13302	;
	13303	"RTN","PSO CPF1",66,0 )
	13304	I '$G(^PS RX(PSODA," IB")),PSOI BQ'["1" D
	13305	"RTN","PSO CPF1",67,0 )
	13306	. K DIR S DIR(0)="Y ",DIR("B") ="N",DIR(" A")="Do yo u want to reset the status to COPAY" D ^ DIR K DIR
	13307	"RTN","PSO CPF1",68,0 )
	13308	. I Y'=1 Q
	13309	"RTN","PSO CPF1",69,0 )
	13310	. S DIC=" ^IBE(350.3 ,",DIC("S" )="I $P(^( 0),U,3)'=2 ",DIC(0)=" AEQMZ",DIC ("A")="Sel ect Reason for Reset : " D ^DI C K DIC I Y'<0 S PSO RSN=+Y
	13311	"RTN","PSO CPF1",70,0 )
	13312	. S PREA= "R",PSOOLD ="No Copay ",PSONW="C opay",PSOC OMM="" D A CTLOG^PSOC PA
	13313	"RTN","PSO CPF1",71,0 )
	13314	. S PSI=0 ,PSOCOMM=" Copay stat us of this Rx has be en reset t o COPAY." D SETSUMM^ PSOCPC
	13315	"RTN","PSO CPF1",72,0 )
	13316	. S $P(^P SRX(PSODA, "IB"),"^") =1 ;Reset flag to CO PAY
	13317	"RTN","PSO CPF1",73,0 )
	13318	;
	13319	"RTN","PSO CPF1",74,0 )
	13320	I $G(^PSR X(PSODA,"I B")) D
	13321	"RTN","PSO CPF1",75,0 )
	13322	. K DIR S DIR(0)="Y ",DIR("B") ="N",DIR(" A")="Do yo u want to reset the status to NO COPAYME NT" D ^DIR K DIR
	13323	"RTN","PSO CPF1",76,0 )
	13324	. I Y'=1 Q
	13325	"RTN","PSO CPF1",77,0 )
	13326	. S DIC=" ^IBE(350.3 ,",DIC("S" )="I $P(^( 0),U,3)'=2 ",DIC(0)=" AEQMZ",DIC ("A")="Sel ect Reason for Reset : " D ^DI C K DIC I Y'<0 S PSO RSN=+Y
	13327	"RTN","PSO CPF1",78,0 )
	13328	. S PREA= "R",PSOOLD ="Copay",P SONW="No C opay",PSOC OMM="" D A CTLOG^PSOC PA
	13329	"RTN","PSO CPF1",79,0 )
	13330	. S PSI=0 ,PSOCOMM=" Copay stat us of this Rx has be en reset t o NO COPAY ." D SETSU MM^PSOCPC
	13331	"RTN","PSO CPF1",80,0 )
	13332	. S $P(^P SRX(PSODA, "IB"),"^") ="" ;Reset flag to N O COPAY
	13333	"RTN","PSO CPF1",81,0 )
	13334	Q
	13335	"RTN","PSO CPF1",82,0 )
	13336	;
	13337	"RTN","PSO CPF1",83,0 )
	13338	CANCEL ; C ANCEL COPA Y
	13339	"RTN","PSO CPF1",84,0 )
	13340	;NAME_U_P ID_U_MED_U _RIEN_U_RF L_U_RX_U_D FN
	13341	"RTN","PSO CPF1",85,0 )
	13342	D FULL^VA LM1
	13343	"RTN","PSO CPF1",86,0 )
	13344	N I,J,IBX X,VALMY,EC NT,NAME,GO TPAT,RC,IB FR,IBTO
	13345	"RTN","PSO CPF1",87,0 )
	13346	D EN^VALM 2($G(XQORN OD(0)))
	13347	"RTN","PSO CPF1",88,0 )
	13348	I $D(VALM Y),'NODATA D
	13349	"RTN","PSO CPF1",89,0 )
	13350	. S IBXX= 0 F S IBX X=$O(VALMY (IBXX)) Q: 'IBXX D
	13351	"RTN","PSO CPF1",90,0 )
	13352	.. S RC=$ G(^TMP($J, "PSOCPFX", IBXX))
	13353	"RTN","PSO CPF1",91,0 )
	13354	.. S NAME =$P(RC,U,1 ),PSODA=$P (RC,U,4),M ED=$P(RC,U ,3),RFL=$P (RC,U,5),R X=$P(RC,U, 6),DFN=$P( RC,U,7)
	13355	"RTN","PSO CPF1",92,0 )
	13356	.. W !,?1 7,"PATIENT : ",$P($G( ^DPT($P(^P SRX(PSODA, 0),"^",2), 0)),"^")
	13357	"RTN","PSO CPF1",93,0 )
	13358	.. D ICN^ PSODPT($P( ^PSRX(PSOD A,0),"^",2 ))
	13359	"RTN","PSO CPF1",94,0 )
	13360	.. S PSOR XN=$P(^PSR X(PSODA,0) ,"^"),PREA ="R"
	13361	"RTN","PSO CPF1",95,0 )
	13362	.. D ASKC AN^PSOCPD
	13363	"RTN","PSO CPF1",96,0 )
	13364	D BLD^PSO CPF
	13365	"RTN","PSO CPF1",97,0 )
	13366	S VALMBCK ="R"
	13367	"RTN","PSO CPF1",98,0 )
	13368	Q
	13369	"RTN","PSO CPF1",99,0 )
	13370	;
	13371	"RTN","PSO CPF1",100, 0)
	13372	EXPORT ; - - print ex cel spread sheet.
	13373	"RTN","PSO CPF1",101, 0)
	13374	I NODATA D BLD^PSOC PF S VALMB CK="R" Q
	13375	"RTN","PSO CPF1",102, 0)
	13376	S LCNT=0, PGC=0,IBQU IT=0
	13377	"RTN","PSO CPF1",103, 0)
	13378	D ^%ZISC
	13379	"RTN","PSO CPF1",104, 0)
	13380	D DEVICE( "EF")
	13381	"RTN","PSO CPF1",105, 0)
	13382	;
	13383	"RTN","PSO CPF1",106, 0)
	13384	D BLD^PSO CPF
	13385	"RTN","PSO CPF1",107, 0)
	13386	D PAUSE
	13387	"RTN","PSO CPF1",108, 0)
	13388	S VALMBCK ="R"
	13389	"RTN","PSO CPF1",109, 0)
	13390	Q
	13391	"RTN","PSO CPF1",110, 0)
	13392	;
	13393	"RTN","PSO CPF1",111, 0)
	13394	EXCEL(FILT ERS) ; pri nt the dat a in excel format
	13395	"RTN","PSO CPF1",112, 0)
	13396	;^TMP($J, "PSOCPF",P TNM,RIEN,R FL)=PTNM_U _PID_U_MED _U_RIEN_U_ RFL_U_RX_U _FILDT_U_B LNO_U_IBST 1_U_SC_U_S CP_U_MTSD_ U_MTS_U_DF N_U_PBIL
	13397	"RTN","PSO CPF1",113, 0)
	13398	D CLEAR^V ALM1,FULL^ VALM1
	13399	"RTN","PSO CPF1",114, 0)
	13400	U IO
	13401	"RTN","PSO CPF1",115, 0)
	13402	N LINE,LC NT,PCE,REC ,OUT,NAME, XX,BCNT,CN T,NXT,ZZ,Z Z1,ZZ2,OUT
	13403	"RTN","PSO CPF1",116, 0)
	13404	S BDATE=$ $FMTE^XLFD T($P(FILTE RS,U,1),"2 DZ")
	13405	"RTN","PSO CPF1",117, 0)
	13406	S EDATE=$ $FMTE^XLFD T($P(FILTE RS,U,2),"2 DZ")
	13407	"RTN","PSO CPF1",118, 0)
	13408	D EXHDR
	13409	"RTN","PSO CPF1",119, 0)
	13410	S LCNT=0, NAME=""
	13411	"RTN","PSO CPF1",120, 0)
	13412	F S NAME =$O(^TMP($ J,"PSOCPF" ,NAME)) Q: NAME="" D
	13413	"RTN","PSO CPF1",121, 0)
	13414	. F S RI EN=$O(^TMP ($J,"PSOCP F",NAME,RI EN)) Q:RIE N="" D
	13415	"RTN","PSO CPF1",122, 0)
	13416	.. F S R FL=$O(^TMP ($J,"PSOCP F",NAME,RI EN,RFL)) Q :RFL="" D
	13417	"RTN","PSO CPF1",123, 0)
	13418	... S REC =^TMP($J," PSOCPF",NA ME,RIEN,RF L),LINE=$P (REC,U,1,3 )_U_$P(REC ,U,7,14)
	13419	"RTN","PSO CPF1",124, 0)
	13420	... W !,L INE
	13421	"RTN","PSO CPF1",125, 0)
	13422	W !,"END OF REPORT"
	13423	"RTN","PSO CPF1",126, 0)
	13424	Q
	13425	"RTN","PSO CPF1",127, 0)
	13426	;
	13427	"RTN","PSO CPF1",128, 0)
	13428	DEVICE(TYP E) ; Ask u ser to sel ect device
	13429	"RTN","PSO CPF1",129, 0)
	13430	;
	13431	"RTN","PSO CPF1",130, 0)
	13432	N %ZIS,CR T,MAXCNT,P OP
	13433	"RTN","PSO CPF1",131, 0)
	13434	S %ZIS="Q M" D ^%ZIS G:POP ENQ
	13435	"RTN","PSO CPF1",132, 0)
	13436	I $D(IO(" Q")) D G ENQ
	13437	"RTN","PSO CPF1",133, 0)
	13438	.S ZTDESC ="Medicati on List Ma nager Repo rt"
	13439	"RTN","PSO CPF1",134, 0)
	13440	.I TYPE=" EF" S ZTRT N="EXCEL^P SOCPF1"
	13441	"RTN","PSO CPF1",135, 0)
	13442	.F I="^TM P($J,""PSO CPF"",","F ILTERS" S ZTSAVE(I)= ""
	13443	"RTN","PSO CPF1",136, 0)
	13444	.D ^%ZTLO AD K IO("Q ") D HOME^ %ZIS
	13445	"RTN","PSO CPF1",137, 0)
	13446	.W !!,$S( $D(ZTSK):" This job h as been qu eued as ta sk #"_ZTSK _".",1:"Un able to qu eue this j ob.")
	13447	"RTN","PSO CPF1",138, 0)
	13448	.K ZTSK,I O("Q")
	13449	"RTN","PSO CPF1",139, 0)
	13450	;
	13451	"RTN","PSO CPF1",140, 0)
	13452	I TYPE="E F" U IO D EXCEL(FILT ERS(0))
	13453	"RTN","PSO CPF1",141, 0)
	13454	;
	13455	"RTN","PSO CPF1",142, 0)
	13456	D ^%ZISC
	13457	"RTN","PSO CPF1",143, 0)
	13458	;
	13459	"RTN","PSO CPF1",144, 0)
	13460	I $D(ZTQU EUED) S ZT REQ="@"
	13461	"RTN","PSO CPF1",145, 0)
	13462	K ^TMP("I BOUT",$J)
	13463	"RTN","PSO CPF1",146, 0)
	13464	;
	13465	"RTN","PSO CPF1",147, 0)
	13466	ENQ Q
	13467	"RTN","PSO CPF1",148, 0)
	13468	;
	13469	"RTN","PSO CPF1",149, 0)
	13470	EXHDR ; -- excel hea der
	13471	"RTN","PSO CPF1",150, 0)
	13472	;^TMP($J, "PSOCPF",P TNM,RIEN,R FL)=PTNM_U _PID_U_MED _U_RIEN_U_ RFL_U_RX_U _FILDT_U_B LNO_U_IBST 1_U_SC_U_S CP_U_MTSD_ U_MTS_U_DF N_U_IBST
	13473	"RTN","PSO CPF1",151, 0)
	13474	W !,"Medi cation Co- pay Exempt ion Report "
	13475	"RTN","PSO CPF1",152, 0)
	13476	W !,"From ",BDATE," TO ",EDAT E
	13477	"RTN","PSO CPF1",153, 0)
	13478	S HDR="Pa tient Name "_U_"ID"_U _"MEDICATI ON"_U_"RX" _U_"FILL D ATE"_U_"BI LL NO."_U_ "STATUS"_U _"SC"_U_"P ERCENT"_U_ "MEANS TES T"_U_"MEAN S DATE"
	13479	"RTN","PSO CPF1",154, 0)
	13480	W !,HDR
	13481	"RTN","PSO CPF1",155, 0)
	13482	Q
	13483	"RTN","PSO CPF1",156, 0)
	13484	;
	13485	"RTN","PSO CPF1",157, 0)
	13486	PAUSE ;pau se at end of screen if being d isplayed o n a termin al
	13487	"RTN","PSO CPF1",158, 0)
	13488	Q:$E(IOST ,1,2)'["C- " N DIR,D UOUT,DTOUT ,DIRUT W !
	13489	"RTN","PSO CPF1",159, 0)
	13490	S DIR(0)= "E" D ^DIR K DIR
	13491	"RTN","PSO CPF1",160, 0)
	13492	I $D(DUOU T)!($D(DIR UT)) S IBQ UIT=1
	13493	"RTN","PSO CPF1",161, 0)
	13494	Q
	13495	"RTN","PSO CPF2")
	13496	0^4^B12469 058
	13497	"RTN","PSO CPF2",1,0)
	13498	PSOCPF2 ;B IR/BAA - P harmacy CO -PAY Appli cation Uti lities for IB ;02/06 /92
	13499	"RTN","PSO CPF2",2,0)
	13500	;;7.0;OUT PATIENT PH ARMACY;4 63;DEC 1 997;Build 11
	13501	"RTN","PSO CPF2",3,0)
	13502	;;Per VA Directive 6402, this routine s hould not be modifie d.
	13503	"RTN","PSO CPF2",4,0)
	13504	;
	13505	"RTN","PSO CPF2",5,0)
	13506	Q
	13507	"RTN","PSO CPF2",6,0)
	13508	;S ^TMP($ J,"PSOCPFX ",VCNT)=NA ME_DFN_U_M ED_U_PBIL_ U_BLN_U_PR IEN
	13509	"RTN","PSO CPF2",7,0)
	13510	;
	13511	"RTN","PSO CPF2",8,0)
	13512	PATINS ; v iew patien t insuranc e
	13513	"RTN","PSO CPF2",9,0)
	13514	D FULL^VA LM1
	13515	"RTN","PSO CPF2",10,0 )
	13516	N I,J,IBX X,VALMY,EC NT,DFN,GOP AT
	13517	"RTN","PSO CPF2",11,0 )
	13518	D EN^VALM 2($G(XQORN OD(0)))
	13519	"RTN","PSO CPF2",12,0 )
	13520	I $D(VALM Y),'NODATA D
	13521	"RTN","PSO CPF2",13,0 )
	13522	.. S IBXX =0 F S IB XX=$O(VALM Y(IBXX)) Q :'IBXX D
	13523	"RTN","PSO CPF2",14,0 )
	13524	.. S REC= $G(^TMP($J ,"PSOCPFX" ,IBXX))
	13525	"RTN","PSO CPF2",15,0 )
	13526	.. S ^TMP ($J,"PATIN S")=$P(REC ,U,2)
	13527	"RTN","PSO CPF2",16,0 )
	13528	.. D EN^V ALM("IBCNS VIEW PAT INS")
	13529	"RTN","PSO CPF2",17,0 )
	13530	D BLD^PSO CPF
	13531	"RTN","PSO CPF2",18,0 )
	13532	S VALMBCK ="R"
	13533	"RTN","PSO CPF2",19,0 )
	13534	Q
	13535	"RTN","PSO CPF2",20,0 )
	13536	;
	13537	"RTN","PSO CPF2",21,0 )
	13538	PATACP ; l ook at ACC OUNT PROFI LE
	13539	"RTN","PSO CPF2",22,0 )
	13540	D FULL^VA LM1
	13541	"RTN","PSO CPF2",23,0 )
	13542	N IBXX,VA LMY,ECNT,N AME,RC,DFN ,CPY,PRCAT Y
	13543	"RTN","PSO CPF2",24,0 )
	13544	D EN^VALM 2($G(XQORN OD(0)))
	13545	"RTN","PSO CPF2",25,0 )
	13546	D CLEAR^V ALM1
	13547	"RTN","PSO CPF2",26,0 )
	13548	I $D(VALM Y),'NODATA D
	13549	"RTN","PSO CPF2",27,0 )
	13550	. S IBXX= 0 F S IBX X=$O(VALMY (IBXX)) Q: 'IBXX D
	13551	"RTN","PSO CPF2",28,0 )
	13552	.. S RC=$ G(^TMP($J, "PSOCPFX", IBXX))
	13553	"RTN","PSO CPF2",29,0 )
	13554	.. S DFN= $P(RC,U,2) ,NAME=$P(R C,U,1)
	13555	"RTN","PSO CPF2",30,0 )
	13556	.. N DIC, X,Y,DEBT,P RCADB,DA,P RCA,COUNT, OUT,SEL,BI LL,BAT,TRA N,DR,DXS,D TOUT,DIROU T,DIRUT,DU OUT
	13557	"RTN","PSO CPF2",31,0 )
	13558	.. N DPTN OFZY,DPTNO FZK S (DPT NOFZY,DPTN OFZK)=1
	13559	"RTN","PSO CPF2",32,0 )
	13560	.. S COUN T=0,CPY=1
	13561	"RTN","PSO CPF2",33,0 )
	13562	.. S PRCA TY="ALL",X =NAME
	13563	"RTN","PSO CPF2",34,0 )
	13564	.. S X=$$ UPPER^VALM 1(X)
	13565	"RTN","PSO CPF2",35,0 )
	13566	.. S Y=$S ($O(^PRCA( 430,"B",X, 0)):$O(^(0 )),$O(^PRC A(430,"D", X,0)):$O(^ (0)),1:-1)
	13567	"RTN","PSO CPF2",36,0 )
	13568	.. I Y>0 S DEBT=$P( $G(^PRCA(4 30,Y,0))," ^",9) I DE BT S PRCAD B=$P($G(^R CD(340,DEB T,0)),"^") ,^DISV(DUZ ,"^PRCA(43 0,")=Y,$P( DEBT,"^",2 )=$$NAM^RC FN01(DEBT) D COMP^PR CAAPR,EN1^ PRCAATR(Y) Q
	13569	"RTN","PSO CPF2",37,0 )
	13570	.. S DIC= "^RCD(340, ",DIC(0)=" E" D ^DIC
	13571	"RTN","PSO CPF2",38,0 )
	13572	.. I Y<0 W !,"No en tries foun d for "_NA ME Q
	13573	"RTN","PSO CPF2",39,0 )
	13574	.. S ^DIS V(DUZ,"^RC D(340,")=+ Y
	13575	"RTN","PSO CPF2",40,0 )
	13576	.. S PRCA DB=$P(Y,"^ ",2),DEBT= +Y_"^"_$P( @("^"_$P(P RCADB,";", 2)_+PRCADB _",0)"),"^ ")
	13577	"RTN","PSO CPF2",41,0 )
	13578	.. D COMP ^PRCAAPR,H DR^PRCAAPR 1,HDR2^PRC AAPR1,DIS^ PRCAAPR1
	13579	"RTN","PSO CPF2",42,0 )
	13580	.. D PAUS E^VALM1
	13581	"RTN","PSO CPF2",43,0 )
	13582	K ^TMP("P RCAAPR",$J )
	13583	"RTN","PSO CPF2",44,0 )
	13584	D BLD^PSO CPF
	13585	"RTN","PSO CPF2",45,0 )
	13586	S VALMBCK ="R"
	13587	"RTN","PSO CPF2",46,0 )
	13588	Q
	13589	"RTN","PSO CPF2",47,0 )
	13590	;
	13591	"RTN","PSO CPF2",48,0 )
	13592	BILPRO ; v iew BILL P ROFILE
	13593	"RTN","PSO CPF2",49,0 )
	13594	D FULL^VA LM1
	13595	"RTN","PSO CPF2",50,0 )
	13596	N I,J,IBX X,VALMY,EC NT,REC,RCB ILLDA
	13597	"RTN","PSO CPF2",51,0 )
	13598	D EN^VALM 2($G(XQORN OD(0)))
	13599	"RTN","PSO CPF2",52,0 )
	13600	I $D(VALM Y),'NODATA D
	13601	"RTN","PSO CPF2",53,0 )
	13602	. S IBXX= 0 F S IBX X=$O(VALMY (IBXX)) Q: 'IBXX D
	13603	"RTN","PSO CPF2",54,0 )
	13604	.. S REC= $G(^TMP($J ,"PSOCPFX" ,IBXX))
	13605	"RTN","PSO CPF2",55,0 )
	13606	.. S RCBI LLDA=$P(RE C,U,6)
	13607	"RTN","PSO CPF2",56,0 )
	13608	.. I RCBI LLDA="" Q
	13609	"RTN","PSO CPF2",57,0 )
	13610	.. D EN^V ALM("RCDP BILL PROFI LE")
	13611	"RTN","PSO CPF2",58,0 )
	13612	D BLD^PSO CPF
	13613	"RTN","PSO CPF2",59,0 )
	13614	S VALMBCK ="R"
	13615	"RTN","PSO CPF2",60,0 )
	13616	Q
	13617	"RTN","PSO CPF2",61,0 )
	13618	;
	13619	"RTN","PSO CPF2",62,0 )
	13620	TPJI ; vie w THIRD PA RTY JOIN I NQUIRY
	13621	"RTN","PSO CPF2",63,0 )
	13622	D FULL^VA LM1
	13623	"RTN","PSO CPF2",64,0 )
	13624	N I,J,IBX X,VALMY,EC NT,DFN,GOP AT
	13625	"RTN","PSO CPF2",65,0 )
	13626	D EN^VALM 2($G(XQORN OD(0)))
	13627	"RTN","PSO CPF2",66,0 )
	13628	I $D(VALM Y),'NODATA D
	13629	"RTN","PSO CPF2",67,0 )
	13630	. S IBXX= 0 F S IBX X=$O(VALMY (IBXX)) Q: 'IBXX D
	13631	"RTN","PSO CPF2",68,0 )
	13632	.. S REC= $G(^TMP($J ,"PSOCPFX" ,IBXX))
	13633	"RTN","PSO CPF2",69,0 )
	13634	.. S DFN= $P(REC,U,2 )
	13635	"RTN","PSO CPF2",70,0 )
	13636	.. D EN^I BJTLA
	13637	"RTN","PSO CPF2",71,0 )
	13638	D BLD^PSO CPF
	13639	"RTN","PSO CPF2",72,0 )
	13640	S VALMBCK ="R"
	13641	"RTN","PSO CPF2",73,0 )
	13642	Q
	13643	"RTN","PSO CPF2",74,0 )
	13644	;
	13645	"RTN","PSO CPF2",75,0 )
	13646	BILINQ ; v iew PATIEN T BILLING INQUIRY
	13647	"RTN","PSO CPF2",76,0 )
	13648	D FULL^VA LM1
	13649	"RTN","PSO CPF2",77,0 )
	13650	N I,J,IBX X,VALMY,EC NT,DFN,GOP AT
	13651	"RTN","PSO CPF2",78,0 )
	13652	D EN^VALM 2($G(XQORN OD(0)))
	13653	"RTN","PSO CPF2",79,0 )
	13654	I $D(VALM Y),'NODATA D
	13655	"RTN","PSO CPF2",80,0 )
	13656	. S IBXX= 0 F S IBX X=$O(VALMY (IBXX)) Q: 'IBXX D
	13657	"RTN","PSO CPF2",81,0 )
	13658	.. S REC= $G(^TMP($J ,"PSOCPFX" ,IBXX))
	13659	"RTN","PSO CPF2",82,0 )
	13660	.. S IBIL =$P(REC,U, 5),IBFULL= 0
	13661	"RTN","PSO CPF2",83,0 )
	13662	.. I IBIL ="" Q
	13663	"RTN","PSO CPF2",84,0 )
	13664	.. S IBIF N=$O(^DGCR (399,"B",$ P(IBIL,"-" ,2,3),0))
	13665	"RTN","PSO CPF2",85,0 )
	13666	.. D EN^I BOLK
	13667	"RTN","PSO CPF2",86,0 )
	13668	D BLD^PSO CPF
	13669	"RTN","PSO CPF2",87,0 )
	13670	S VALMBCK ="R"
	13671	"RTN","PSO CPF2",88,0 )
	13672	Q
	13673	"RTN","PSO CPF2",89,0 )
	13674	;
	13675	"RTN","PSO CPF2",90,0 )
	13676	PATINQ ; v iew PATIEN T INQUIRY
	13677	"RTN","PSO CPF2",91,0 )
	13678	D FULL^VA LM1
	13679	"RTN","PSO CPF2",92,0 )
	13680	N I,J,IBX X,VALMY,EC NT,DFN,GOP AT
	13681	"RTN","PSO CPF2",93,0 )
	13682	D EN^VALM 2($G(XQORN OD(0)))
	13683	"RTN","PSO CPF2",94,0 )
	13684	I $D(VALM Y),'NODATA D
	13685	"RTN","PSO CPF2",95,0 )
	13686	. S IBXX= 0 F S IBX X=$O(VALMY (IBXX)) Q: 'IBXX D
	13687	"RTN","PSO CPF2",96,0 )
	13688	.. S REC= $G(^TMP($J ,"PSOCPFX" ,IBXX))
	13689	"RTN","PSO CPF2",97,0 )
	13690	.. S DFN= $P(REC,U,2 )
	13691	"RTN","PSO CPF2",98,0 )
	13692	.. D EN^D GRPD
	13693	"RTN","PSO CPF2",99,0 )
	13694	D BLD^PSO CPF
	13695	"RTN","PSO CPF2",100, 0)
	13696	S VALMBCK ="R"
	13697	"RTN","PSO CPF2",101, 0)
	13698	Q
	13699	"RTN","PSO CPF2",102, 0)
	13700	;
	13701	"RTN","PSO CPF2",103, 0)
	13702	PAUSE ;pau se at end of screen if being d isplayed o n a termin al
	13703	"RTN","PSO CPF2",104, 0)
	13704	Q:$E(IOST ,1,2)'["C- " N DIR,D UOUT,DTOUT ,DIRUT W !
	13705	"RTN","PSO CPF2",105, 0)
	13706	S DIR(0)= "E" D ^DIR K DIR
	13707	"RTN","PSO CPF2",106, 0)
	13708	I $D(DUOU T)!($D(DIR UT)) S IBQ UIT=1
	13709	"RTN","PSO CPF2",107, 0)
	13710	Q
	13711	"VER")
	13712	8.0^22.0
	13713	END
	13714	END