2. EPMO Open Source Coordination Office Redaction File Detail Report

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

2.1 Files compared

#	Location	File	Last Modified
1	PSE Patch PRCA_45_313 v4j CIF submission.zip	PRCA_45_313_v4j_Patch.txt	Wed May 17 16:08:38 2017 UTC
2	PSE Patch PRCA_45_313 v4j CIF submission.zip	PRCA_45_313_v4j_Patch.txt	Wed May 17 18:16:13 2017 UTC

2.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	8	18270
Changed	7	18
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	========== ========== ========== ========== ========== ========== ========== =======
	2	Run Date: MAY 04, 20 17 Designa tion: PRCA 4.5313
	3	Package : PRCA - ACC OUNTS RECE IVABLE Prio rity: Mand atory
	4	Version : 4.5 St atus: Unde r Developm ent
	5	========== ========== ========== ========== ========== ========== ========== =======
	6
	7	Associated patches: (v)XMDB1 0 i nstall wit h patch `PRCA* 4.5*313'
	8	(u)PRCA4. 5307<<= m ust be ins talled BEF ORE `PRCA* 4.5*313'
	9
	10	Subject: P ATIENT STA TEMENT ENH ANCEMENT - Phase Two
	11
	12	Category:
	13	- Other
	14	- Routin e
	15	- Data D ictionary
	16	- Enhanc ement (Man datory)
	17
	18	Descriptio n:
	19	========== ==
	20
	21	****** ****** ****** ****** ****** ****** ****** ***
	22	This patch supp orts chang es to the Veterans H ealth Info rmation
	23	Syste m and Tech nology Arc hitecture (VistA) fo r the Pati ent Statem ent
	24	Enhan cements Pr oject (PSE ).
	25
	26	It is imperativ e that the se patches be instal led no lat er than th e
	27	compl iance date . Your und erstanding and suppo rt is appr eciated.
	28	****** ****** ****** ****** ****** ****** ****** ***
	29
	30	The Chief Business Office (CB O) request ed modific ations to the VistA
	31	Accounts Receivable (AR) pack age to rem edy defici encies ide ntified wi th
	32	patient s tatements. The main goals of t his projec t include the
	33	remediati on and enh ancement o f the AR a pplication software to correct
	34	these dis crepancies . Addition ally this project wi ll perform the initi al
	35	developme nt of the VistA AR e nhancement s to creat e a single , consolid ated
	36	patient s tatement, self-servi ce options for payme nt, and ot her
	37	modificat ions.
	38
	39	This patc h modifies the Accou nt Receiva ble (AR) v 4.5 applic ation as
	40	described below:
	41
	42	1. Change the sched ule of pri nting Pati ent Statem ents to se nd patient s
	43	with the first lett ers of the last name on the sa me day eve ry month. The
	44	day of th e month fo r each let ter combin ation is c ontained i n the
	45	Post-Inst allation s ection.
	46
	47	2. Update the Patie nt Stateme nt Build a nd Transmi t code to create and send
	48	the appro priate sta tements wi th an upda ted format . The Buil d and Tran smit
	49	will occu r two days prior to the listed date to a llow for p rocessing by
	50	the Conso lidated Co -payment P rocessing Center (CC PC) and th e Consolid ated
	51	Billing S tatement S ystem (CBS S) for pri nting on t he assigne d date.
	52
	53	3. Receiv e and proc ess the Pr int Acknow ledgements from CCPC using cur rent
	54	procedure s.
	55
	56	4. Create and trans mit a Nigh tly Patien t Update t o provide CBSS with the
	57	oldest bi ll balance and amoun t for each Veteran o n a nightl y basis.
	58
	59	5. Provid e CBSS Nig htly Accou nt Update Program, a s a menu o ption to r un
	60	the Night ly Patient Update fr om the PRC A ACCOUNTS MANAGEMEN T Menu.
	61
	62	6. Update the follo wing menu options to work with the multi ple statem ent
	63	date:
	64
	65	a. CCPC Statement Errors [RCCPC ER ROR]
	66	b. CCPC Totals [RCCPC TO TALS REPOR T]
	67	c. Repr int Patien t Statemen ts [PRCAE PR STATEMENT ]
	68	d. Buil d CCPC fil e for tran smission [RCCPC BU ILD]
	69	e. Tran smit CCPC messages [RCCPC TR ANSMIT]
	70
	71	7. The Au to-Correct Patient D iscrepancy Report ha s been upd ated to
	72	include a new Auto- Correct Re ason sort order. The report no w defaults to
	73	the Auto- Correct Re ason sort order and the four e xisting so rt orders have
	74	been rear ranged and ordered b elow this new sort o rder.
	75
	76	Additiona lly, the r eport sort descripti on that ap pears on t he page
	77	headers h as been up dated to b e more des criptive.
	78
	79	8. Build and Transm it a yearl y Annual P atient Pay ment Summa ry (APPS)
	80	Statement file for every Pati ent paymen t made in the previo us year.
	81	Payment i n Full (34 ) and Paym ent in Par t (2) will be the on ly Account s
	82	Receivabl e Transact ion Types sent in th e file. Th e Build wi ll begin
	83	automatic ally on Ja nuary 2nd of each ye ar for the previous year.
	84	Transmiss ion will b e based up on the Vis tA Site Co de and wil l occur at
	85	02:00 hou rs from Ja nuary 3rd to January 12th. Tra nsmission will be to a
	86	new queue at CCPC.
	87
	88	9. Three new option s have bee n added to the Follo w-up Lette r Menu
	89	[PRCAE FO LLOW-UP].
	90
	91	Build an d Transmit Annual Pa yment File [RCCPC AP PS BUILD A ND TRANS] will
	92	allow ma nual creat ion and tr ansmission of the AP PS Stateme nt file.
	93
	94	Retransm it Current Annual Pa yment File [RCCPC AP PS RETRANS ] will all ow
	95	manual r e-transmis sion of th e APPS Sta tement Fil e.
	96
	97	Annual P ayment Fil e Consiste ncy Check (RCCPC APP S DATA CHE CK) will a llow
	98	Validati on of the APPS State ment File data for t he current calendar year
	99	to the p resent dat e.
	100
	101	10. For t he Increas e Adjustme nt [PRCAC TR INCREAS E] and Dec rease
	102	Adjustmen t [PRCAC T R DECREASE ] options, the defau lt answer for the "D o
	103	you want to FIX the balance d iscrepancy ? YES//" prompt has been chan ged
	104	from YES to NO.
	105
	106	Example:
	107	Do you wa nt to FIX the balanc e discrepa ncy ? NO//
	108
	109	Patch Com ponents
	110	========= =======
	111
	112	Files & F ields Asso ciated:
	113	File Name (#) Field Name (#) New/ Mod/Del
	114	--------- ---------- ---------- - ----- ---------- ---------- ---- ---- -------
	115	AR DEBTOR (#340) DEBTO R (#.01) Mod
	116	STATE MENT DAY ( #.03) Mod
	117	CURRE NT CBS DEB T AMOUNT ( #7.06) New
	118
	119	AR EVENT (#341) CCPC STATEMENT DATE (#6.0 1) Mod
	120
	121	AR TRANSM ISSION REC ORDS (#349 ) STATE MENT DATE (#.09) Mod
	122
	123	AR TRANSM ISSION TYP E (#349.1) LAST MESSAGE AC K (#41) Del
	124	FINAL MESSAGE A CK (#42) Del
	125	LAST MESSAGE NU MBER (#43) Del
	126	MESSA GE ACKNOWL EDGEMENT ( #40) New
	127	LAST MESSAGE AC K (#349.14 1,.01) New
	128	FINAL MESSAGE A CK (#349.1 41,.02) New
	129	LAST MESSAGE NU MBER (#349 .141,.03) New
	130	PATIE NT STATEME NT DATE New
	131	(#349 .141,.04)
	132	ACK M ESSAGES (# 50) Mod
	133	PATIE NT STATEME NT DATE New
	134	(#349 .151,.04)
	135
	136	AR CBSS S TATEMENTS (#349.2) PATIE NT (#.01) Mod
	137	SSN ( #.02) Mod
	138	PATIE NT NAME (# .03) Mod
	139	INVAL ID STATEME NT ERROR ( #.12) Mod
	140	CBSS FILE BUILD (#.18) Mod
	141	PATIE NT STATEME NT DATE (# .19) New
	142	ERROR CODE(S) ( #51) Mod
	143	CBSS PRINTED (# 61) Mod
	144	INTEG RATION CON TROL NUMBE R (#81) New
	145	ICN C HECKSUM (# 82) New
	146	AR FL AG (#83) New
	147	DATE OF LATEST BILL (#84) New
	148
	149	AR ANNUAL PAYMENT S TATEMENT F ILE PS SE GMENT NUMB ER (#.01) New
	150	(#349.5) YEAR (#.02) New
	151	DATE/ TIME BUILD STARTED ( #.03) New
	152	DATE/ TIME BUILD ENDED (#. 04) New
	153	DATE/ TIME TRANS MIT STARTE D (#.05) New
	154	DATE/ TIME TRANS MIT ENDED (#.06) New
	155	STATE MENT FILE LINES (#1) New
	156	STATE MENT FILE LINES (#34 9.51,.01) New
	157
	158	Forms Ass ociated:
	159
	160	Form Name Fil e # New/M odified/De leted
	161	--------- --- --- ----- ---------- -----
	162	N/A
	163
	164	Mail Grou ps Associa ted:
	165
	166	Mail Grou p Name New /Modified/ Deleted
	167	--------- ------ --- ---------- -------
	168	N/A
	169
	170	Options A ssociated:
	171
	172	Option Na me Type New/Mo dified/Del eted
	173	--------- -- - ---------- ------ ---------- ----
	174	PRCA CBS NIGHTLY UP DATE R un Routine New
	175	RCCPC APP S BUILD AN D TRANS A ction New
	176	RCCPC APP S RETRANS A ction New
	177	RCCPC APP S DATA CHE CK A ction New
	178
	179	Protocols Associate d:
	180
	181	Protocol Name New /Modified/ Deleted
	182	--------- ---- --- ---------- -------
	183	N/A
	184
	185	Security Keys Assoc iated:
	186
	187	Security Key Name N ew/Modifie d/Deleted
	188	--------- -------- - ---------- ---------
	189	RCCPC APP S BUILD AN D TRANS New
	190
	191	Templates Associate d:
	192
	193	Template Name Typ e File Name (Numb er) New/M odified/De leted
	194	--------- ---- --- - ----- ---------- --- ----- ---------- -----
	195	N/A
	196
	197	Additiona l Informat ion:
	198	N/A
	199
	200	New Servi ce Request s (NSRs):
	201	--------- ---------- ---------
	202	N/A
	203
	204	Patient S afety Issu es (PSIs):
	205	--------- ---------- ----------
	206	N/A
	207
	208	Defect Tr acking Sys tem Ticket (s) & Over view:
	209	--------- ---------- ---------- ---------- -----
	210	N/A
	211
	212	Problem:
	213	-------
	214	N/A
	215
	216	Resolutio n:
	217	--------- -
	218	N/A
	219
	220	Test Site s:
	221	--------- -
	222	Bay Pines VA HCS
	223	James A. Haley VAMC
	224
	225	Software and Docume ntation Re trieval In structions :
	226	--------- ---------- ---------- ---------- ---------- ---
	227	Software being rele ased as a host file and/or doc umentation describin g
	228	the new f unctionali ty introdu ced by thi s patch ar e availabl e.
	229
	230	The prefe rred metho d is to re trieve fil es from do wnload. DNS . DNS .
	231	This tran smits the files from the first available server. S ites may
	232	also elec t to retri eve files directly f rom a spec ific serve r.
	233
	234	Sites may retrieve the softwa re and/or documentat ion direct ly using
	235	Secure Fi le Transfe r Protocol (SFTP) fr om the ANO NYMOUS.SOF TWARE
	236	directory at the fo llowing OI Field Off ices:
	237
	238	Albany: D NS.URL
	239	Hines: D NS .UR L
	240	Salt Lake City: DNS . URL
	241
	242	Documenta tion can a lso be fou nd on the VA Softwar e Document ation Libr ary
	243	at: http: // URL /
	244
	245	Title F ile Name FTP M ode
	246	--------- ---------- ---------- ---------- ---------- ---------- ---------- --
	247	<Document ation titl e>
	248
	249	Patch Ins tallation:
	250
	251	Pre/Post Installati on Overvie w:
	252	--------- ---------- ---------- --
	253	The Pre-I nstallatio n removes elements f rom the AR Transacti on and AR
	254	Transacti on Type fi les. The P ost-Instal lation rem oves curre nt monthly
	255	Patient S tatement D ata, reset s each Deb tor's Pati ent Statem ent date t o
	256	the date matching t he last na me of the patient, a nd insures the Patie nt
	257	Statement and Night ly Update queues are set to th e proper d omains.
	258
	259	Pre-Insta llation In structions :
	260	--------- ---------- ---------- -
	261	The Pre-I nstallatio n removes elements f rom the AR Transmiss ion Record s
	262	and AR Tr ansmission Type file s.
	263
	264	The AR TR ANSMISSION RECORDS f ile (#349) will have the STATE MENT DATE field
	265	(#.09) re moved prio r to enter ing a New Style Cros s-Referenc e.
	266
	267	The AR TR ANSMISSION TYPE file (#349.1) will have the LAST M ESSAGE ACK
	268	field (#4 1), FINAL MESSAGE AC K field (# 42), and t he LAST ME SSAGE NUMB ER
	269	field (#4 3) removed . These el ements wil l be repla ced with a multiple
	270	record ME SSAGE ACKN OWLEDGEMEN T field (# 349.141) d uring the data dicti onary
	271	load.
	272
	273	This patc h may be i nstalled w ith users on the sys tem althou gh it is
	274	recommend ed that it be instal led during non-peak hours to m inimize
	275	potential disruptio n to users . This pat ch should take less than 30
	276	minutes t o install.
	277
	278	No Menu O ptions nee d to be di sabled dur ing this i nstallatio n.
	279
	280	Installat ion Instru ctions:
	281	--------- ---------- -------
	282	This patc h modifies the Accou nt Receiva ble (AR) v 4.5 applic ation for a
	283	single, c onsolidate d patient statement.
	284
	285	1. Cho ose the Pa ckMan mess age contai ning this patch.
	286
	287	2. Cho ose the IN STALL/CHEC K MESSAGE PackMan op tion.
	288
	289	3. Fro m the Kern el Install ation and Distributi on System Menu, sele ct
	290	the Installat ion Menu. From this menu, you may elect to use the
	291	fol lowing opt ions. When prompted for the IN STALL NAME enter the
	292	pat ch PRCA4. 5313.
	293
	294	a. Backup a T ransport G lobal - Th is option will creat e a backup
	295	message of any routi nes export ed with th is patch. It will no t
	296	backup any other cha nges such as DDs or templates.
	297
	298	b. Compare Tr ansport Gl obal to Cu rrent Syst em - This option wil l
	299	allow you to view al l changes that will be made wh en this
	300	patch is i nstalled. It compare s all comp onents of this patch
	301	routines, DDs, templ ates, etc.
	302
	303	c. Verify Che cksums in Transport Global - T his option will allo w
	304	you to ens ure the in tegrity of the routi nes that a re in the
	305	transport global.
	306
	307	4. Fro m the Inst allation M enu, selec t the Inst all Packag e(s)
	308	opt ion and ch oose the p atch to in stall.
	309
	310	5. Whe n prompted 'Want KID S to Rebui ld Menu Tr ees Upon C ompletion
	311	of Install? Y ES//' repl y 'YES' un less your system reb uilds menu
	312	tre es nightly using Tas kMan. Answ ering Yes during nor mal busine ss
	313	hou rs could a ffect user s on the s ystem and installati on times w ill
	314	inc rease.
	315
	316	7. Whe n Prompted "Want KID S to INHIB IT LOGONs during the install?
	317	NO //", respo nd NO.
	318
	319	8. Whe n Prompted "Want to DISABLE Sc heduled Op tions, Men u Options, and
	320	Pr otocols? N O//", resp ond NO.
	321
	322	9. Whe n prompted "Delay In stall (Min utes): (0 -60): 0//" enter an
	323	app ropriate n umber of m inutes to delay the installati on in
	324	ord er to give users eno ugh time t o exit the disabled options
	325	bef ore the in stallation starts.
	326
	327	10. Whe n prompted "Device: Home//" r espond wit h the corr ect device .
	328
	329	Post-Inst allation I nstruction s:
	330	--------- ---------- ---------- --
	331	The Post- Installati on removes current m onthly Pat ient State ment Data,
	332	resets ea ch Debtor' s Patient Statement date to th e date mat ching the last
	333	name of t he Patient , and insu res the Pa tient Stat ement and Nightly Up date
	334	transmiss ion queues are set t o the prop er domains .
	335
	336	The previ ous month' s Patient Statement data is re moved at e ach site p rior
	337	to the cr eation of the curren t month's data. To i mplement 1 6 days dur ing
	338	the month for alpha betically based Pati ent Statem ents, all data must be
	339	removed. This is pe rformed du ring the P ost-Instal l. Should a site fee l
	340	it requir es these o lder Patie nt Stateme nts, a Rep rint Patie nt Stateme nts
	341	[PRCAE PR STATEMENT ] may be p erformed. It is STRO NGLY RECOM MENDED, du e to
	342	the size of this fi le, each s ite run a single rep rint to a single Mai lMan
	343	account a nd share t hat data u ntil the p atient's n ew stateme nt prints
	344	within th e next 31 days.
	345
	346	The Post- Installati on will re set each A R Debtor's account t hat proces ses
	347	Patient S tatements with the P atient Sta tement Dat e correspo nding to t he
	348	table pro vided. The letters u se the Pat ient's Las t Name. Th e SITE
	349	STATEMENT DATE fiel d (#.11) i n the AR S ITE PARAME NTER file (#342) is set
	350	to Null t o prevent a possible transmiss ion using the previo us format.
	351
	352	Day of th e Month Lette rs of last name
	353	--------- ------- ----- ---------- -----
	354	1 A,BA, BU
	355	2 B EXC LUDE (BA,B U)
	356	4 CI,CR ,CU,D
	357	6 C EXC LUDE (CI,C R,CU)
	358	7 E,F,I ,Q
	359	8 G,HE
	360	10 H EXC LUDE HE
	361	12 J,K
	362	14 L,O
	363	15 M EXC LUDE (MC,M I)
	364	17 MC,MI ,N,TI-TZ
	365	19 R,TA- TE
	366	21 S EXC LUDE (SC,S H,SI,SM)
	367	22 SC,SH ,SI,SM,TF- TH,V
	368	24 P,U,X ,Y,Z
	369	26 W
	370
	371	VistA Mai lMan is us ed to send the Patie nt Stateme nt and Nig htly Updat e
	372	files. Th e addresse s for thes e transmis sions are taken from the AR
	373	TRANSMISS ION TYPE f ile (#349. 1). The Po st-Install ation vali dates and
	374	updates t he CCPC Do main and A ddressee f or both tr ansmission types. As the
	375	Nightly U pdate and Annual Pat ient Payme nt Summery transmiss ions are s ent
	376	to a new Domain, Pa tch XMDB1 .00 a req uired Patc h must hav e been
	377	previousl y loaded.
	378
	379	Routine In formation:
	380	========== ==========
	381	The second line of e ach of the se routine s now look s like:
	382	;;4.5;Acc ounts Rece ivable;[ Patch List ];Mar 20 , 1995;Bui ld 118
	383
	384	The checks ums below are new ch ecksums, a nd
	385	can be ch ecked with CHECK1^XT SUMBLD.
	386
	387	Routine Na me: PRCA31 3P
	388	Before : n/ a After: B20491359 313
	389	Routine Na me: PRCAAC R
	390	Before : n/ a After: B124955572 307,31 3
	391	Routine Na me: PRCAAC R1
	392	Before : n/ a After: B151271441 307,31 3
	393	Routine Na me: PRCACP S1
	394	Before : n/ a After: B19128158 313
	395	Routine Na me: PRCAG
	396	Before : B2201651 2 After: B48028538 *149,16 5,198,313 *
	397	Routine Na me: RCBEAD J
	398	Before : B7712514 7 After: B77106309 **169,17 2,204,173, 208,233,29 8,
	399	301,313 **
	400	Routine Na me: RCCPCA P
	401	Before : n/ a After: B41793332 313
	402	Routine Na me: RCCPCA R
	403	Before : n/ a After: B47488689 313
	404	Routine Na me: RCCPCA T
	405	Before : n/ a After: B34521600 313
	406	Routine Na me: RCCPCB J
	407	Before : B628849 1 After: B9440906 **34,76, 130,153,16 6,195,217,
	408	237,307 ,313**
	409	Routine Na me: RCCPCF N1
	410	Before : n/ a After: B7181774 313
	411	Routine Na me: RCCPCM L
	412	Before : B4788102 4 After: B67061934 **34,80, 93,118,133 ,140,160,1 65,
	413	187,195 ,206,223,2 60,313**
	414	Routine Na me: RCCPCM L1
	415	Before : B668233 5 After: B8980051 160,31 3
	416	Routine Na me: RCCPCP S
	417	Before : B8089891 5 After: B129514785 **34,70, 80,48,104, 116,149,17 0,
	418	181,190 ,223,237,2 19,265,301 ,
	419	313**
	420	Routine Na me: RCCPCP S1
	421	Before : B3737011 3 After: B65443378 34,48, 104,170,17 6,192,265, 313
	422	Routine Na me: RCCPCS E
	423	Before : B581043 9 After: B16507603 34,313
	424	Routine Na me: RCCPCS V
	425	Before : B519949 0 After: B11825361 34,70, 87,313
	426	Routine Na me: RCCPCS V1
	427	Before : B3201709 6 After: B43313841 34,70, 76,130,153 ,313
	428	Routine Na me: RCCPCT
	429	Before : B248969 7 After: B29330001 34,313
	430
	431	Routine li st of prec eding patc hes: 87, 1 98, 260, 3 01, 307
	432
	433	========== ========== ========== ========== ========== ========== ========== =======
	434	User Infor mation:
	435	Entered By : ENFING ER,MARK Date E ntered : MAY 04, 20 16
	436	Completed By: Date C ompleted:
	437	Released B y : Date R eleased :
	438	========== ========== ========== ========== ========== ========== ========== =======
	439
	440	Packman Ma il Message :
	441	========== ========== =
	442
	443	$END TXT
	444	$KID PRCA* 4.5*313
	445	INSTALL NAME
	446	PRCA4.53 13
	447	"BLD",1011 1,0)
	448	PRCA4.53 13^ACCOUNT S RECEIVAB LE^0^31705 04^y
	449	"BLD",1011 1,1,0)
	450	^^1^1^3160 811^^^^
	451	"BLD",1011 1,1,1,0)
	452	Consolidat ed Patient Statement
	453	"BLD",1011 1,4,0)
	454	^9.64PA^34 9.5^6
	455	"BLD",1011 1,4,340,0)
	456	340
	457	"BLD",1011 1,4,340,2, 0)
	458	^9.641^340 ^1
	459	"BLD",1011 1,4,340,2, 340,0)
	460	AR DEBTOR (File-top level)
	461	"BLD",1011 1,4,340,2, 340,1,0)
	462	^9.6411^.0 3^3
	463	"BLD",1011 1,4,340,2, 340,1,.01, 0)
	464	DEBTOR
	465	"BLD",1011 1,4,340,2, 340,1,.03, 0)
	466	STATEMENT DAY
	467	"BLD",1011 1,4,340,2, 340,1,7.06 ,0)
	468	CURRENT CB S DEBT AMO UNT
	469	"BLD",1011 1,4,340,22 2)
	470	y^n^p^^^^n ^^n
	471	"BLD",1011 1,4,340,22 4)
	472
	473	"BLD",1011 1,4,341,0)
	474	341
	475	"BLD",1011 1,4,341,2, 0)
	476	^9.641^341 ^1
	477	"BLD",1011 1,4,341,2, 341,0)
	478	AR EVENT (File-top level)
	479	"BLD",1011 1,4,341,2, 341,1,0)
	480	^9.6411^6. 01^1
	481	"BLD",1011 1,4,341,2, 341,1,6.01 ,0)
	482	CCPC STATE MENT DATE
	483	"BLD",1011 1,4,341,22 2)
	484	y^n^p^^^^n ^^n
	485	"BLD",1011 1,4,341,22 4)
	486
	487	"BLD",1011 1,4,349,0)
	488	349
	489	"BLD",1011 1,4,349,2, 0)
	490	^9.641^349 ^1
	491	"BLD",1011 1,4,349,2, 349,0)
	492	AR TRANSMI SSION RECO RDS (File -top level )
	493	"BLD",1011 1,4,349,2, 349,1,0)
	494	^9.6411^.0 9^1
	495	"BLD",1011 1,4,349,2, 349,1,.09, 0)
	496	STATEMENT DATE
	497	"BLD",1011 1,4,349,22 2)
	498	y^n^p^^^^n ^^n
	499	"BLD",1011 1,4,349,22 4)
	500
	501	"BLD",1011 1,4,349.1, 0)
	502	349.1
	503	"BLD",1011 1,4,349.1, 222)
	504	y^n^f^^^^n ^^n
	505	"BLD",1011 1,4,349.1, 224)
	506
	507	"BLD",1011 1,4,349.2, 0)
	508	349.2
	509	"BLD",1011 1,4,349.2, 2,0)
	510	^9.641^349 .2^1
	511	"BLD",1011 1,4,349.2, 2,349.2,0)
	512	AR CBSS ST ATEMENTS (File-top level)
	513	"BLD",1011 1,4,349.2, 2,349.2,1, 0)
	514	^9.6411^61 ^12
	515	"BLD",1011 1,4,349.2, 2,349.2,1, .01,0)
	516	PATIENT
	517	"BLD",1011 1,4,349.2, 2,349.2,1, .02,0)
	518	SSN
	519	"BLD",1011 1,4,349.2, 2,349.2,1, .03,0)
	520	PATIENT NA ME
	521	"BLD",1011 1,4,349.2, 2,349.2,1, .12,0)
	522	INVALID ST ATEMENT ER ROR
	523	"BLD",1011 1,4,349.2, 2,349.2,1, .18,0)
	524	CBSS FILE BUILT
	525	"BLD",1011 1,4,349.2, 2,349.2,1, .19,0)
	526	PATIENT ST ATEMENT DA TE
	527	"BLD",1011 1,4,349.2, 2,349.2,1, 51,0)
	528	ERROR CODE (S)
	529	"BLD",1011 1,4,349.2, 2,349.2,1, 61,0)
	530	CBSS PRINT ED
	531	"BLD",1011 1,4,349.2, 2,349.2,1, 81,0)
	532	INTEGRATIO N CONTROL NUMBER
	533	"BLD",1011 1,4,349.2, 2,349.2,1, 82,0)
	534	ICN CHECKS UM
	535	"BLD",1011 1,4,349.2, 2,349.2,1, 83,0)
	536	AR FLAG
	537	"BLD",1011 1,4,349.2, 2,349.2,1, 84,0)
	538	DATE OF LA TEST BILL
	539	"BLD",1011 1,4,349.2, 222)
	540	y^n^p^^^^n ^^n
	541	"BLD",1011 1,4,349.2, 224)
	542
	543	"BLD",1011 1,4,349.5, 0)
	544	349.5
	545	"BLD",1011 1,4,349.5, 222)
	546	y^n^f^^^^n ^^n
	547	"BLD",1011 1,4,349.5, 224)
	548
	549	"BLD",1011 1,4,"APDD" ,340,340)
	550
	551	"BLD",1011 1,4,"APDD" ,340,340,. 01)
	552
	553	"BLD",1011 1,4,"APDD" ,340,340,. 03)
	554
	555	"BLD",1011 1,4,"APDD" ,340,340,7 .06)
	556
	557	"BLD",1011 1,4,"APDD" ,341,341)
	558
	559	"BLD",1011 1,4,"APDD" ,341,341,6 .01)
	560
	561	"BLD",1011 1,4,"APDD" ,349,349)
	562
	563	"BLD",1011 1,4,"APDD" ,349,349,. 09)
	564
	565	"BLD",1011 1,4,"APDD" ,349.2,349 .2)
	566
	567	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.01)
	568
	569	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.02)
	570
	571	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.03)
	572
	573	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.12)
	574
	575	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.18)
	576
	577	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.19)
	578
	579	"BLD",1011 1,4,"APDD" ,349.2,349 .2,51)
	580
	581	"BLD",1011 1,4,"APDD" ,349.2,349 .2,61)
	582
	583	"BLD",1011 1,4,"APDD" ,349.2,349 .2,81)
	584
	585	"BLD",1011 1,4,"APDD" ,349.2,349 .2,82)
	586
	587	"BLD",1011 1,4,"APDD" ,349.2,349 .2,83)
	588
	589	"BLD",1011 1,4,"APDD" ,349.2,349 .2,84)
	590
	591	"BLD",1011 1,4,"B",34 0,340)
	592
	593	"BLD",1011 1,4,"B",34 1,341)
	594
	595	"BLD",1011 1,4,"B",34 9,349)
	596
	597	"BLD",1011 1,4,"B",34 9.1,349.1)
	598
	599	"BLD",1011 1,4,"B",34 9.2,349.2)
	600
	601	"BLD",1011 1,4,"B",34 9.5,349.5)
	602
	603	"BLD",1011 1,6)
	604	2^
	605	"BLD",1011 1,6.3)
	606	118
	607	"BLD",1011 1,"ABPKG")
	608	n
	609	"BLD",1011 1,"INI")
	610	PRE^PRCA31 3P
	611	"BLD",1011 1,"INID")
	612	^y^y
	613	"BLD",1011 1,"INIT")
	614	EN^PRCA313 P
	615	"BLD",1011 1,"KRN",0)
	616	^9.67PA^77 9.2^20
	617	"BLD",1011 1,"KRN",.4 ,0)
	618	.4
	619	"BLD",1011 1,"KRN",.4 ,"NM",0)
	620	^9.68A^^0
	621	"BLD",1011 1,"KRN",.4 01,0)
	622	.401
	623	"BLD",1011 1,"KRN",.4 02,0)
	624	.402
	625	"BLD",1011 1,"KRN",.4 02,"NM",0)
	626	^9.68A^^0
	627	"BLD",1011 1,"KRN",.4 03,0)
	628	.403
	629	"BLD",1011 1,"KRN",.5 ,0)
	630	.5
	631	"BLD",1011 1,"KRN",.8 4,0)
	632	.84
	633	"BLD",1011 1,"KRN",3. 6,0)
	634	3.6
	635	"BLD",1011 1,"KRN",3. 8,0)
	636	3.8
	637	"BLD",1011 1,"KRN",3. 8,"NM",0)
	638	^9.68A^^0
	639	"BLD",1011 1,"KRN",9. 2,0)
	640	9.2
	641	"BLD",1011 1,"KRN",9. 8,0)
	642	9.8
	643	"BLD",1011 1,"KRN",9. 8,"NM",0)
	644	^9.68A^24^ 19
	645	"BLD",1011 1,"KRN",9. 8,"NM",5,0 )
	646	RCCPCBJ^^0 ^B9440906
	647	"BLD",1011 1,"KRN",9. 8,"NM",6,0 )
	648	PRCACPS1^^ 0^B1912815 8
	649	"BLD",1011 1,"KRN",9. 8,"NM",7,0 )
	650	RCCPCFN1^^ 0^B7181774
	651	"BLD",1011 1,"KRN",9. 8,"NM",8,0 )
	652	RCCPCML^^0 ^B67061934
	653	"BLD",1011 1,"KRN",9. 8,"NM",9,0 )
	654	RCCPCSV^^0 ^B11825361
	655	"BLD",1011 1,"KRN",9. 8,"NM",10, 0)
	656	RCCPCPS^^0 ^B12951478 5
	657	"BLD",1011 1,"KRN",9. 8,"NM",11, 0)
	658	RCCPCPS1^^ 0^B6544337 8
	659	"BLD",1011 1,"KRN",9. 8,"NM",12, 0)
	660	RCCPCSV1^^ 0^B4331384 1
	661	"BLD",1011 1,"KRN",9. 8,"NM",13, 0)
	662	RCCPCML1^^ 0^B8980051
	663	"BLD",1011 1,"KRN",9. 8,"NM",14, 0)
	664	RCCPCSE^^0 ^B16507603
	665	"BLD",1011 1,"KRN",9. 8,"NM",15, 0)
	666	RCCPCT^^0^ B29330001
	667	"BLD",1011 1,"KRN",9. 8,"NM",17, 0)
	668	PRCAG^^0^B 48028538
	669	"BLD",1011 1,"KRN",9. 8,"NM",18, 0)
	670	PRCA313P^^ 0^B2049135 9
	671	"BLD",1011 1,"KRN",9. 8,"NM",19, 0)
	672	PRCAACR^^0 ^B12495557 2
	673	"BLD",1011 1,"KRN",9. 8,"NM",20, 0)
	674	PRCAACR1^^ 0^B1512714 41
	675	"BLD",1011 1,"KRN",9. 8,"NM",21, 0)
	676	RCCPCAP^^0 ^B41793332
	677	"BLD",1011 1,"KRN",9. 8,"NM",22, 0)
	678	RCCPCAT^^0 ^B34521600
	679	"BLD",1011 1,"KRN",9. 8,"NM",23, 0)
	680	RCCPCAR^^0 ^B47488689
	681	"BLD",1011 1,"KRN",9. 8,"NM",24, 0)
	682	RCBEADJ^^0 ^B77106309
	683	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCA313P ",18)
	684
	685	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR" ,19)
	686
	687	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR1 ",20)
	688
	689	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPS1 ",6)
	690
	691	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAG",1 7)
	692
	693	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCBEADJ" ,24)
	694
	695	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAP" ,21)
	696
	697	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAR" ,23)
	698
	699	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAT" ,22)
	700
	701	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCBJ" ,5)
	702
	703	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCFN1 ",7)
	704
	705	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML" ,8)
	706
	707	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML1 ",13)
	708
	709	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS" ,10)
	710
	711	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS1 ",11)
	712
	713	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSE" ,14)
	714
	715	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV" ,9)
	716
	717	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV1 ",12)
	718
	719	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCT", 15)
	720
	721	"BLD",1011 1,"KRN",19 ,0)
	722	19
	723	"BLD",1011 1,"KRN",19 ,"NM",0)
	724	^9.68A^8^5
	725	"BLD",1011 1,"KRN",19 ,"NM",4,0)
	726	PRCA CBS N IGHTLY UPD ATE^^0
	727	"BLD",1011 1,"KRN",19 ,"NM",5,0)
	728	PRCAE FOLL OW-UP^^2
	729	"BLD",1011 1,"KRN",19 ,"NM",6,0)
	730	RCCPC APPS BUILD AND TRANS^^0
	731	"BLD",1011 1,"KRN",19 ,"NM",7,0)
	732	RCCPC APPS RETRANS^^ 0
	733	"BLD",1011 1,"KRN",19 ,"NM",8,0)
	734	RCCPC APPS DATA CHEC K^^0
	735	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA CBS NIGHTLY UP DATE",4)
	736
	737	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCAE FOL LOW-UP",5)
	738
	739	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S BUILD AN D TRANS",6 )
	740
	741	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S DATA CHE CK",8)
	742
	743	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S RETRANS" ,7)
	744
	745	"BLD",1011 1,"KRN",19 .1,0)
	746	19.1
	747	"BLD",1011 1,"KRN",19 .1,"NM",0)
	748	^9.68A^1^1
	749	"BLD",1011 1,"KRN",19 .1,"NM",1, 0)
	750	RCCPC APPS BUILD AND TRANS^^0
	751	"BLD",1011 1,"KRN",19 .1,"NM","B ","RCCPC A PPS BUILD AND TRANS" ,1)
	752
	753	"BLD",1011 1,"KRN",10 1,0)
	754	101
	755	"BLD",1011 1,"KRN",40 9.61,0)
	756	409.61
	757	"BLD",1011 1,"KRN",77 1,0)
	758	771
	759	"BLD",1011 1,"KRN",77 9.2,0)
	760	779.2
	761	"BLD",1011 1,"KRN",87 0,0)
	762	870
	763	"BLD",1011 1,"KRN",89 89.51,0)
	764	8989.51
	765	"BLD",1011 1,"KRN",89 89.52,0)
	766	8989.52
	767	"BLD",1011 1,"KRN",89 94,0)
	768	8994
	769	"BLD",1011 1,"KRN","B ",.4,.4)
	770
	771	"BLD",1011 1,"KRN","B ",.401,.40 1)
	772
	773	"BLD",1011 1,"KRN","B ",.402,.40 2)
	774
	775	"BLD",1011 1,"KRN","B ",.403,.40 3)
	776
	777	"BLD",1011 1,"KRN","B ",.5,.5)
	778
	779	"BLD",1011 1,"KRN","B ",.84,.84)
	780
	781	"BLD",1011 1,"KRN","B ",3.6,3.6)
	782
	783	"BLD",1011 1,"KRN","B ",3.8,3.8)
	784
	785	"BLD",1011 1,"KRN","B ",9.2,9.2)
	786
	787	"BLD",1011 1,"KRN","B ",9.8,9.8)
	788
	789	"BLD",1011 1,"KRN","B ",19,19)
	790
	791	"BLD",1011 1,"KRN","B ",19.1,19. 1)
	792
	793	"BLD",1011 1,"KRN","B ",101,101)
	794
	795	"BLD",1011 1,"KRN","B ",409.61,4 09.61)
	796
	797	"BLD",1011 1,"KRN","B ",771,771)
	798
	799	"BLD",1011 1,"KRN","B ",779.2,77 9.2)
	800
	801	"BLD",1011 1,"KRN","B ",870,870)
	802
	803	"BLD",1011 1,"KRN","B ",8989.51, 8989.51)
	804
	805	"BLD",1011 1,"KRN","B ",8989.52, 8989.52)
	806
	807	"BLD",1011 1,"KRN","B ",8994,899 4)
	808
	809	"BLD",1011 1,"QDEF")
	810	^^^^^^^^YE S
	811	"BLD",1011 1,"QUES",0 )
	812	^9.62^^
	813	"BLD",1011 1,"REQB",0 )
	814	^9.611^2^2
	815	"BLD",1011 1,"REQB",1 ,0)
	816	PRCA4.53 07^2
	817	"BLD",1011 1,"REQB",2 ,0)
	818	XMDB1.00 ^2
	819	"BLD",1011 1,"REQB"," B","PRCA4 .5307",1)
	820
	821	"BLD",1011 1,"REQB"," B","XMDB1 .00",2)
	822
	823	"FIA",340)
	824	AR DEBTOR
	825	"FIA",340, 0)
	826	^RCD(340,
	827	"FIA",340, 0,0)
	828	340V
	829	"FIA",340, 0,1)
	830	y^n^p^^^^n ^^n
	831	"FIA",340, 0,10)
	832
	833	"FIA",340, 0,11)
	834
	835	"FIA",340, 0,"RLRO")
	836
	837	"FIA",340, 0,"VR")
	838	4.5^PRCA
	839	"FIA",340, 340)
	840	1
	841	"FIA",340, 340,.01)
	842
	843	"FIA",340, 340,.03)
	844
	845	"FIA",340, 340,7.06)
	846
	847	"FIA",341)
	848	AR EVENT
	849	"FIA",341, 0)
	850	^RC(341,
	851	"FIA",341, 0,0)
	852	341I
	853	"FIA",341, 0,1)
	854	y^n^p^^^^n ^^n
	855	"FIA",341, 0,10)
	856
	857	"FIA",341, 0,11)
	858
	859	"FIA",341, 0,"RLRO")
	860
	861	"FIA",341, 0,"VR")
	862	4.5^PRCA
	863	"FIA",341, 341)
	864	1
	865	"FIA",341, 341,6.01)
	866
	867	"FIA",349)
	868	AR TRANSMI SSION RECO RDS
	869	"FIA",349, 0)
	870	^RCT(349,
	871	"FIA",349, 0,0)
	872	349I
	873	"FIA",349, 0,1)
	874	y^n^p^^^^n ^^n
	875	"FIA",349, 0,10)
	876
	877	"FIA",349, 0,11)
	878
	879	"FIA",349, 0,"RLRO")
	880
	881	"FIA",349, 0,"VR")
	882	4.5^PRCA
	883	"FIA",349, 349)
	884	1
	885	"FIA",349, 349,.09)
	886
	887	"FIA",349. 1)
	888	AR TRANSMI SSION TYPE
	889	"FIA",349. 1,0)
	890	^RCT(349.1 ,
	891	"FIA",349. 1,0,0)
	892	349.1I
	893	"FIA",349. 1,0,1)
	894	y^n^f^^^^n ^^n
	895	"FIA",349. 1,0,10)
	896
	897	"FIA",349. 1,0,11)
	898
	899	"FIA",349. 1,0,"RLRO" )
	900
	901	"FIA",349. 1,0,"VR")
	902	4.5^PRCA
	903	"FIA",349. 1,349.1)
	904	0
	905	"FIA",349. 1,349.11)
	906	0
	907	"FIA",349. 1,349.12)
	908	0
	909	"FIA",349. 1,349.141)
	910	0
	911	"FIA",349. 1,349.151)
	912	0
	913	"FIA",349. 1,349.161)
	914	0
	915	"FIA",349. 2)
	916	AR CBSS ST ATEMENTS
	917	"FIA",349. 2,0)
	918	^RCPS(349. 2,
	919	"FIA",349. 2,0,0)
	920	349.2I
	921	"FIA",349. 2,0,1)
	922	y^n^p^^^^n ^^n
	923	"FIA",349. 2,0,10)
	924
	925	"FIA",349. 2,0,11)
	926
	927	"FIA",349. 2,0,"RLRO" )
	928
	929	"FIA",349. 2,0,"VR")
	930	4.5^PRCA
	931	"FIA",349. 2,349.2)
	932	1
	933	"FIA",349. 2,349.2,.0 1)
	934
	935	"FIA",349. 2,349.2,.0 2)
	936
	937	"FIA",349. 2,349.2,.0 3)
	938
	939	"FIA",349. 2,349.2,.1 2)
	940
	941	"FIA",349. 2,349.2,.1 8)
	942
	943	"FIA",349. 2,349.2,.1 9)
	944
	945	"FIA",349. 2,349.2,51 )
	946
	947	"FIA",349. 2,349.2,61 )
	948
	949	"FIA",349. 2,349.2,81 )
	950
	951	"FIA",349. 2,349.2,82 )
	952
	953	"FIA",349. 2,349.2,83 )
	954
	955	"FIA",349. 2,349.2,84 )
	956
	957	"FIA",349. 5)
	958	AR ANNUAL PAYMENT ST ATEMENT
	959	"FIA",349. 5,0)
	960	^RCAP(349. 5,
	961	"FIA",349. 5,0,0)
	962	349.5
	963	"FIA",349. 5,0,1)
	964	y^n^f^^^^n ^^n
	965	"FIA",349. 5,0,10)
	966
	967	"FIA",349. 5,0,11)
	968
	969	"FIA",349. 5,0,"RLRO" )
	970
	971	"FIA",349. 5,0,"VR")
	972	4.5^PRCA
	973	"FIA",349. 5,349.5)
	974	0
	975	"FIA",349. 5,349.51)
	976	0
	977	"INI")
	978	PRE^PRCA31 3P
	979	"INIT")
	980	EN^PRCA313 P
	981	"IX",349,3 49,"SDT",0 )
	982	349^SDT^Pa tient Stat ement Day of the Mon th^R^^F^IR ^I^349^^^^ ^LS
	983	"IX",349,3 49,"SDT",. 1,0)
	984	^^1^1^3161 007^
	985	"IX",349,3 49,"SDT",. 1,1,0)
	986	This cross -reference is the Pa tient Stat ement Day of the Mon th.
	987	"IX",349,3 49,"SDT",1 )
	988	S ^RCT(349 ,"SDT",$E( X,1,2),DA) =""
	989	"IX",349,3 49,"SDT",2 )
	990	K ^RCT(349 ,"SDT",$E( X,1,2),DA)
	991	"IX",349,3 49,"SDT",2 .5)
	992	K ^RCT(349 ,"SDT")
	993	"IX",349,3 49,"SDT",1 1.1,0)
	994	^.114IA^1^ 1
	995	"IX",349,3 49,"SDT",1 1.1,1,0)
	996	1^F^349^.0 9^2^1^F
	997	"IX",349,3 49,"SDT",1 1.1,1,2)
	998	S X=+$E(X, 6,7)
	999	"IX",349.1 ,349.141," STDT4",0)
	1000	349.141^ST DT4^Patien t Statemen t Date and Last Mess age ACK^R^ ^R^IR^I^34 9.141^^^^
	1001	^LS
	1002	"IX",349.1 ,349.141," STDT4",.1, 0)
	1003	^^2^2^3161 007^
	1004	"IX",349.1 ,349.141," STDT4",.1, 1,0)
	1005	This cross -reference is used t o sort by the Patien t Statemen t Date and the
	1006	"IX",349.1 ,349.141," STDT4",.1, 2,0)
	1007	Last Messa ge ACK.
	1008	"IX",349.1 ,349.141," STDT4",1)
	1009	S ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)=" "
	1010	"IX",349.1 ,349.141," STDT4",2)
	1011	K ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)
	1012	"IX",349.1 ,349.141," STDT4",2.5 )
	1013	K ^RCT(349 .1,DA(1),4 ,"STDT4")
	1014	"IX",349.1 ,349.141," STDT4",11. 1,0)
	1015	^.114IA^2^ 2
	1016	"IX",349.1 ,349.141," STDT4",11. 1,1,0)
	1017	1^F^349.14 1^.04^7^1^ F
	1018	"IX",349.1 ,349.141," STDT4",11. 1,1,3)
	1019
	1020	"IX",349.1 ,349.141," STDT4",11. 1,2,0)
	1021	2^F^349.14 1^.01^3^2^ F
	1022	"IX",349.1 ,349.141," STDT4",11. 1,2,3)
	1023
	1024	"IX",349.1 ,349.151," STDT5",0)
	1025	349.151^ST DT5^Patien t Statemen t Date Ind ex^R^^F^IR ^I^349.151 ^^^^^LS
	1026	"IX",349.1 ,349.151," STDT5",.1, 0)
	1027	^^1^1^3161 006^
	1028	"IX",349.1 ,349.151," STDT5",.1, 1,0)
	1029	This cross -reference is used t o sort by the Patien t Statemen t Date.
	1030	"IX",349.1 ,349.151," STDT5",1)
	1031	S ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)=""
	1032	"IX",349.1 ,349.151," STDT5",2)
	1033	K ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)
	1034	"IX",349.1 ,349.151," STDT5",2.5 )
	1035	K ^RCT(349 .1,DA(1),5 ,"STDT5")
	1036	"IX",349.1 ,349.151," STDT5",11. 1,0)
	1037	^.114IA^1^ 1
	1038	"IX",349.1 ,349.151," STDT5",11. 1,1,0)
	1039	1^F^349.15 1^.04^7^1^ F
	1040	"IX",349.2 ,349.2,"AD ",0)
	1041	349.2^AD^P atient Sta tement Err ors^R^^F^I R^I^349.2^ ^^^^S
	1042	"IX",349.2 ,349.2,"AD ",.1,0)
	1043	^^2^2^3161 007^
	1044	"IX",349.2 ,349.2,"AD ",.1,1,0)
	1045	This is th e cross-re ference to find pati ent statem ent errors that are
	1046	"IX",349.2 ,349.2,"AD ",.1,2,0)
	1047	returned f rom CBSS.
	1048	"IX",349.2 ,349.2,"AD ",1)
	1049	S ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)=""
	1050	"IX",349.2 ,349.2,"AD ",2)
	1051	K ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)
	1052	"IX",349.2 ,349.2,"AD ",2.5)
	1053	K ^RCPS(34 9.2,"AD")
	1054	"IX",349.2 ,349.2,"AD ",11.1,0)
	1055	^.114IA^1^ 1
	1056	"IX",349.2 ,349.2,"AD ",11.1,1,0 )
	1057	1^F^349.2^ 51^1^1^F
	1058	"IX",349.2 ,349.2,"AD ",11.1,1,1 )
	1059
	1060	"IX",349.2 ,349.2,"AD ",11.1,1,2 )
	1061	S X="E"
	1062	"IX",349.2 ,349.2,"ST DT",0)
	1063	349.2^STDT ^Patient S tatement D ate^R^^F^I R^I^349.2^ ^^^^LS
	1064	"IX",349.2 ,349.2,"ST DT",.1,0)
	1065	^^2^2^3161 007^
	1066	"IX",349.2 ,349.2,"ST DT",.1,1,0 )
	1067	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	1068	"IX",349.2 ,349.2,"ST DT",.1,2,0 )
	1069	standardly two days after the statement is transmi tted.
	1070	"IX",349.2 ,349.2,"ST DT",1)
	1071	S ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)=""
	1072	"IX",349.2 ,349.2,"ST DT",2)
	1073	K ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)
	1074	"IX",349.2 ,349.2,"ST DT",2.5)
	1075	K ^RCPS(34 9.2,"STDT" )
	1076	"IX",349.2 ,349.2,"ST DT",11.1,0 )
	1077	^.114IA^1^ 1
	1078	"IX",349.2 ,349.2,"ST DT",11.1,1 ,0)
	1079	1^F^349.2^ .19^7^1^F
	1080	"KRN",19,3 026,-1)
	1081	2^5
	1082	"KRN",19,3 026,0)
	1083	PRCAE FOLL OW-UP^Foll ow-up Lett er Menu^^M ^1^^^^^^^5 3
	1084	"KRN",19,3 026,10,0)
	1085	^19.01IP^1 9^15
	1086	"KRN",19,3 026,10,17, 0)
	1087	11666^^14
	1088	"KRN",19,3 026,10,17, "^")
	1089	RCCPC APPS BUILD AND TRANS
	1090	"KRN",19,3 026,10,18, 0)
	1091	11667^^15
	1092	"KRN",19,3 026,10,18, "^")
	1093	RCCPC APPS RETRANS
	1094	"KRN",19,3 026,10,19, 0)
	1095	11668^^16
	1096	"KRN",19,3 026,10,19, "^")
	1097	RCCPC APPS DATA CHEC K
	1098	"KRN",19,3 026,"U")
	1099	FOLLOW-UP LETTER MEN U
	1100	"KRN",19,1 1657,-1)
	1101	0^4
	1102	"KRN",19,1 1657,0)
	1103	PRCA CBS N IGHTLY UPD ATE^CBS Ni ghtly Acco unt Update Program^^ R^^^^^^^^
	1104	"KRN",19,1 1657,1,0)
	1105	^^2^2^3160 622^
	1106	"KRN",19,1 1657,1,1,0 )
	1107	This optio n runs the Consolida ted Billin g System
	1108	"KRN",19,1 1657,1,2,0 )
	1109	Nightly Ac count Upda te program .
	1110	"KRN",19,1 1657,25)
	1111	ENTER^PRCA CPS1
	1112	"KRN",19,1 1657,"U")
	1113	CBS NIGHTL Y ACCOUNT UPDATE PRO
	1114	"KRN",19,1 1666,-1)
	1115	0^6
	1116	"KRN",19,1 1666,0)
	1117	RCCPC APPS BUILD AND TRANS^Bui ld and Tra nsmit Annu al Payment File^^A^^ RCCPC APP
	1118	S BUILD AN D TRANS^^^ ^^^^^1
	1119	"KRN",19,1 1666,1,0)
	1120	^19.06^3^3 ^3170502^^ ^
	1121	"KRN",19,1 1666,1,1,0 )
	1122	This optio n will bui ld the Ann ual Paymen t Statemen t file for the previ ous
	1123	"KRN",19,1 1666,1,2,0 )
	1124	year for e very patie nt who has one or mo re payment s in the p revious ye ar
	1125	"KRN",19,1 1666,1,3,0 )
	1126	and transm it the fil e to AITC.
	1127	"KRN",19,1 1666,20)
	1128	D MANBLD^R CCPCAT
	1129	"KRN",19,1 1666,"U")
	1130	BUILD AND TRANSMIT A NNUAL PAYM
	1131	"KRN",19,1 1667,-1)
	1132	0^7
	1133	"KRN",19,1 1667,0)
	1134	RCCPC APPS RETRANS^R etransmit Current An nual Payme nt File^^A ^^RCCPC AP PS BUILD
	1135	AND TRANS^ ^^^^^^^1
	1136	"KRN",19,1 1667,1,0)
	1137	^19.06^3^3 ^3170502^^ ^^
	1138	"KRN",19,1 1667,1,1,0 )
	1139	This optio n should o nly to be used when AITC has r equested t he current
	1140	"KRN",19,1 1667,1,2,0 )
	1141	Annual Pay ment State ment file be retrans mitted. Th is file wi ll include
	1142	"KRN",19,1 1667,1,3,0 )
	1143	every pati ent who ha s one or m ore paymen ts in the previous y ear.
	1144	"KRN",19,1 1667,20)
	1145	D RETRANS^ RCCPCAT
	1146	"KRN",19,1 1667,"U")
	1147	RETRANSMIT CURRENT A NNUAL PAYM
	1148	"KRN",19,1 1668,-1)
	1149	0^8
	1150	"KRN",19,1 1668,0)
	1151	RCCPC APPS DATA CHEC K^Annual P ayment Fil e Consiste ncy Check^ ^A^^^^^^^^ ^^1
	1152	"KRN",19,1 1668,1,0)
	1153	^^5^5^3170 321^
	1154	"KRN",19,1 1668,1,1,0 )
	1155	AR data is extracted from the VistA site s and is s ent to CBS S who then
	1156	"KRN",19,1 1668,1,2,0 )
	1157	consolidat es the dat a into the annual pa yment stat ement. The VistA dat a
	1158	"KRN",19,1 1668,1,3,0 )
	1159	needs to b e validate d prior to its trans mission. T his menu o ption will
	1160	"KRN",19,1 1668,1,4,0 )
	1161	produce a report det ailing whi ch APPS da ta needs t o be revie wed and
	1162	"KRN",19,1 1668,1,5,0 )
	1163	updated pr ior to its transmiss ion to CBS S.
	1164	"KRN",19,1 1668,20)
	1165	D MANBLD^R CCPCAR
	1166	"KRN",19,1 1668,"U")
	1167	ANNUAL PAY MENT FILE CONSISTENC
	1168	"KRN",19.1 ,600,-1)
	1169	0^1
	1170	"KRN",19.1 ,600,0)
	1171	RCCPC APPS BUILD AND TRANS
	1172	"KRN",19.1 ,600,1,0)
	1173	^^8^8^3170 502^
	1174	"KRN",19.1 ,600,1,1,0 )
	1175	This is a key for th e AR menu options 'R CCPC APPS BUILD AND TRANS' and
	1176	"KRN",19.1 ,600,1,2,0 )
	1177	'RCCPC APP S RETRANS' .
	1178	"KRN",19.1 ,600,1,3,0 )
	1179
	1180	"KRN",19.1 ,600,1,4,0 )
	1181	The 'RCCPC APPS BUIL D AND TRAN S' option runs the A nnual Paym ent Statem ent
	1182	"KRN",19.1 ,600,1,5,0 )
	1183	File Build and Trans mit for th e previous year and sends the data to AI TC.
	1184	"KRN",19.1 ,600,1,6,0 )
	1185
	1186	"KRN",19.1 ,600,1,7,0 )
	1187	The 'RCCPC APPS RETR ANS' optio n Re-Trans mits the c urrent Ann ual Paymen t
	1188	"KRN",19.1 ,600,1,8,0 )
	1189	Statement File data to AITC.
	1190	"MBREQ")
	1191	0
	1192	"ORD",3,19 .1)
	1193	19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1
	1194	"ORD",3,19 .1,0)
	1195	SECURITY K EY
	1196	"ORD",18,1 9)
	1197	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	1198	"ORD",18,1 9,0)
	1199	OPTION
	1200	"PKG",53,- 1)
	1201	1^1
	1202	"PKG",53,0 )
	1203	ACCOUNTS R ECEIVABLE^ PRCA^FMS
	1204	"PKG",53,2 0,0)
	1205	^9.402P^1^ 1
	1206	"PKG",53,2 0,1,0)
	1207	2^^PRCAMRG
	1208	"PKG",53,2 0,1,1)
	1209
	1210	"PKG",53,2 0,"B",2,1)
	1211
	1212	"PKG",53,2 2,0)
	1213	^9.49I^1^1
	1214	"PKG",53,2 2,1,0)
	1215	4.5^305111 9^2960627
	1216	"PKG",53,2 2,1,"PAH", 1,0)
	1217	313^317050 4^85
	1218	"PKG",53,2 2,1,"PAH", 1,1,0)
	1219	^^1^1^3170 504
	1220	"PKG",53,2 2,1,"PAH", 1,1,1,0)
	1221	Consolidat ed Patient Statement
	1222	"QUES","XP F1",0)
	1223	Y
	1224	"QUES","XP F1","??")
	1225	^D REP^XPD H
	1226	"QUES","XP F1","A")
	1227	Shall I wr ite over y our \|FLAG\| File
	1228	"QUES","XP F1","B")
	1229	YES
	1230	"QUES","XP F1","M")
	1231	D XPF1^XPD IQ
	1232	"QUES","XP F2",0)
	1233	Y
	1234	"QUES","XP F2","??")
	1235	^D DTA^XPD H
	1236	"QUES","XP F2","A")
	1237	Want my da ta \|FLAG\| yours
	1238	"QUES","XP F2","B")
	1239	YES
	1240	"QUES","XP F2","M")
	1241	D XPF2^XPD IQ
	1242	"QUES","XP I1",0)
	1243	YO
	1244	"QUES","XP I1","??")
	1245	^D INHIBIT ^XPDH
	1246	"QUES","XP I1","A")
	1247	Want KIDS to INHIBIT LOGONs du ring the i nstall
	1248	"QUES","XP I1","B")
	1249	NO
	1250	"QUES","XP I1","M")
	1251	D XPI1^XPD IQ
	1252	"QUES","XP M1",0)
	1253	PO^VA(200, :EM
	1254	"QUES","XP M1","??")
	1255	^D MG^XPDH
	1256	"QUES","XP M1","A")
	1257	Enter the Coordinato r for Mail Group '\|F LAG\|'
	1258	"QUES","XP M1","B")
	1259
	1260	"QUES","XP M1","M")
	1261	D XPM1^XPD IQ
	1262	"QUES","XP O1",0)
	1263	Y
	1264	"QUES","XP O1","??")
	1265	^D MENU^XP DH
	1266	"QUES","XP O1","A")
	1267	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	1268	"QUES","XP O1","B")
	1269	YES
	1270	"QUES","XP O1","M")
	1271	D XPO1^XPD IQ
	1272	"QUES","XP Z1",0)
	1273	Y
	1274	"QUES","XP Z1","??")
	1275	^D OPT^XPD H
	1276	"QUES","XP Z1","A")
	1277	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	1278	"QUES","XP Z1","B")
	1279	NO
	1280	"QUES","XP Z1","M")
	1281	D XPZ1^XPD IQ
	1282	"QUES","XP Z2",0)
	1283	Y
	1284	"QUES","XP Z2","??")
	1285	^D RTN^XPD H
	1286	"QUES","XP Z2","A")
	1287	Want to MO VE routine s to other CPUs
	1288	"QUES","XP Z2","B")
	1289	NO
	1290	"QUES","XP Z2","M")
	1291	D XPZ2^XPD IQ
	1292	"RTN")
	1293	19
	1294	"RTN","PRC A313P")
	1295	0^18^B2049 1359^n/a
	1296	"RTN","PRC A313P",1,0 )
	1297	PRCA313P ; ALB/BDB - PATCH PRCA 4.5313 P OST-INSTAL L ROUTINE ; 11/2/15 4:15pm
	1298	"RTN","PRC A313P",2,0 )
	1299	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 118
	1300	"RTN","PRC A313P",3,0 )
	1301	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1302	"RTN","PRC A313P",4,0 )
	1303	; This ro utine queu es the Pat ient State ment Auto- Correction Program
	1304	"RTN","PRC A313P",5,0 )
	1305	;
	1306	"RTN","PRC A313P",6,0 )
	1307	Q
	1308	"RTN","PRC A313P",7,0 )
	1309	EN ;Entry point for PRCA4.53 13 post-in stall
	1310	"RTN","PRC A313P",8,0 )
	1311	;
	1312	"RTN","PRC A313P",9,0 )
	1313	; Delete DD previou s monthly data
	1314	"RTN","PRC A313P",10, 0)
	1315	D CLEANUP
	1316	"RTN","PRC A313P",11, 0)
	1317	; Set Pat ient State ment days
	1318	"RTN","PRC A313P",12, 0)
	1319	D STDT
	1320	"RTN","PRC A313P",13, 0)
	1321	; Set AR Transactio n Types
	1322	"RTN","PRC A313P",14, 0)
	1323	D SET3491
	1324	"RTN","PRC A313P",15, 0)
	1325	;
	1326	"RTN","PRC A313P",16, 0)
	1327	Q
	1328	"RTN","PRC A313P",17, 0)
	1329	;
	1330	"RTN","PRC A313P",18, 0)
	1331	STDT ; En try point for PRCA4 .5313 set of Patien t Statemen t date dep endent up
	1332	on the Pat ient Last Name
	1333	"RTN","PRC A313P",19, 0)
	1334	D BMES^XP DUTL("Star ting Patie nt Stateme nt Date Re set.")
	1335	"RTN","PRC A313P",20, 0)
	1336	N DEBT,DI E
	1337	"RTN","PRC A313P",21, 0)
	1338	S DIE="^R CD(340,"
	1339	"RTN","PRC A313P",22, 0)
	1340	S DEBT=""
	1341	"RTN","PRC A313P",23, 0)
	1342	F S DEBT =$O(^RCD(3 40,"AB","D PT(",DEBT) ) Q:DEBT=" " D
	1343	"RTN","PRC A313P",24, 0)
	1344	. N PAT,D PT,NAME,DA ,DR
	1345	"RTN","PRC A313P",25, 0)
	1346	. S PAT=$ P($G(^RCD( 340,DEBT,0 )),U)
	1347	"RTN","PRC A313P",26, 0)
	1348	. S DPT=$ P(PAT,";", 1)
	1349	"RTN","PRC A313P",27, 0)
	1350	. S NAME= $P($G(^DPT (DPT,0)),U )
	1351	"RTN","PRC A313P",28, 0)
	1352	. S DA=DE BT
	1353	"RTN","PRC A313P",29, 0)
	1354	. S DR=". 03////"_+$ $ACSET^RCC PCFN1(NAME )
	1355	"RTN","PRC A313P",30, 0)
	1356	. D ^DIE
	1357	"RTN","PRC A313P",31, 0)
	1358	;
	1359	"RTN","PRC A313P",32, 0)
	1360	; Set cro ss-referen ce in AR E vent (341) if Patien t Statemen t date exi sts
	1361	"RTN","PRC A313P",33, 0)
	1362	N DA,DIK
	1363	"RTN","PRC A313P",34, 0)
	1364	S DIK="^R C(341,"
	1365	"RTN","PRC A313P",35, 0)
	1366	S DA="" F S DA=$O( ^RC(341,DA )) Q:DA="" I $G(^RC (341,DA,6) )'="" D IX 1^DIK
	1367	"RTN","PRC A313P",36, 0)
	1368	;
	1369	"RTN","PRC A313P",37, 0)
	1370	D BMES^XP DUTL("Pati ent Statem ent Date R eset Compl ete.")
	1371	"RTN","PRC A313P",38, 0)
	1372	Q
	1373	"RTN","PRC A313P",39, 0)
	1374	;
	1375	"RTN","PRC A313P",40, 0)
	1376	CLEANUP ; PRCA4.5 313
	1377	"RTN","PRC A313P",41, 0)
	1378	; Remove site state ment date
	1379	"RTN","PRC A313P",42, 0)
	1380	D BMES^XP DUTL("Star ting Patie nt Stateme nt Cleanup .")
	1381	"RTN","PRC A313P",43, 0)
	1382	N DA,DR,D IE,X,RCT
	1383	"RTN","PRC A313P",44, 0)
	1384	S DA=1
	1385	"RTN","PRC A313P",45, 0)
	1386	S DR=".11 ///@"
	1387	"RTN","PRC A313P",46, 0)
	1388	S DIE="^R C(342,"
	1389	"RTN","PRC A313P",47, 0)
	1390	D ^DIE
	1391	"RTN","PRC A313P",48, 0)
	1392	;
	1393	"RTN","PRC A313P",49, 0)
	1394	; Remove all monthl y data
	1395	"RTN","PRC A313P",50, 0)
	1396	S DIK="^R CT(349,"
	1397	"RTN","PRC A313P",51, 0)
	1398	S DA=0 F S DA=$O(^ RCT(349,DA )) Q:DA="" D ^DIK
	1399	"RTN","PRC A313P",52, 0)
	1400	S ^RCT(34 9,0)="AR T RANSMISSIO N RECORDS^ 349I^^"
	1401	"RTN","PRC A313P",53, 0)
	1402	S DIK="^R CPS(349.2, "
	1403	"RTN","PRC A313P",54, 0)
	1404	S DA=0 F S DA=$O(^ RCPS(349.2 ,DA)) Q:DA ="" D ^DI K
	1405	"RTN","PRC A313P",55, 0)
	1406	S ^RCPS(3 49.2,0)="A R CBSS STA TEMENTS^34 9.2I^^"
	1407	"RTN","PRC A313P",56, 0)
	1408	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T K ^RCT( 349.1,+RCT ,4),^RCT(
	1409	349.1,+RCT ,5)
	1410	"RTN","PRC A313P",57, 0)
	1411	;
	1412	"RTN","PRC A313P",58, 0)
	1413	D BMES^XP DUTL("Pati ent Statem ent Cleanu p complete .")
	1414	"RTN","PRC A313P",59, 0)
	1415	Q
	1416	"RTN","PRC A313P",60, 0)
	1417	;
	1418	"RTN","PRC A313P",61, 0)
	1419	SET3491 ; PRCA4.5 313
	1420	"RTN","PRC A313P",62, 0)
	1421	; Set val ues for Pr oduction o r Test AR Transmissi on Type
	1422	"RTN","PRC A313P",63, 0)
	1423	N PROD,CC ,CP,CA,IEN ,TT,TTVAL
	1424	"RTN","PRC A313P",64, 0)
	1425	;
	1426	"RTN","PRC A313P",65, 0)
	1427	D BMES^XP DUTL("Star ting AR Tr ansaction Type Updat e.")
	1428	"RTN","PRC A313P",66, 0)
	1429	;
	1430	"RTN","PRC A313P",67, 0)
	1431	; Set whe ther envir onment is Production or Test a nd define expected/n ew values
	1432	"RTN","PRC A313P",68, 0)
	1433	S PROD=$$ PROD^XUPRO D
	1434	"RTN","PRC A313P",69, 0)
	1435	S (CC(1), CP(1),CA(1 ))="XXX"
	1436	"RTN","PRC A313P",70, 0)
	1437	S CC(3)=" Q-"_$S(PRO D:"CBS",1: "CCT")_" URL "
	1438	"RTN","PRC A313P",71, 0)
	1439	S CP(3)=" Q-"_$S(PRO D:"CPP",1: "CPT")_" URL "
	1440	"RTN","PRC A313P",72, 0)
	1441	S CA(3)=" Q-"_$S(PRO D:"CAP",1: "CAT")_" URL "
	1442	"RTN","PRC A313P",73, 0)
	1443	;
	1444	"RTN","PRC A313P",74, 0)
	1445	; Validat e Domains are availa ble. Writ e error if not
	1446	"RTN","PRC A313P",75, 0)
	1447	I '$D(^DI C(4.2,"B", CC(3)))!(' $D(^DIC(4. 2,"B",CP(3 ))))!('$D( ^DIC(4.2," B",CA(3))
	1448	)) D Q
	1449	"RTN","PRC A313P",76, 0)
	1450	. N LINE S $P(LINE, "*",79)=""
	1451	"RTN","PRC A313P",77, 0)
	1452	. D BMES^ XPDUTL(LIN E)
	1453	"RTN","PRC A313P",78, 0)
	1454	. D MES^X PDUTL("Dom ains for P RCA4.531 3 have not been full y set up." )
	1455	"RTN","PRC A313P",79, 0)
	1456	. D MES^X PDUTL("Ple ase establ ish Domain s for: ")
	1457	"RTN","PRC A313P",80, 0)
	1458	. D MES^X PDUTL("CCP C PATIENT STATEMENTS , PATIENT STATEMENT UPDATE, an d ANNUAL
	1459	PAYMENT ST ATEMENTS." )
	1460	"RTN","PRC A313P",81, 0)
	1461	. D BMES^ XPDUTL(LIN E)
	1462	"RTN","PRC A313P",82, 0)
	1463	;
	1464	"RTN","PRC A313P",83, 0)
	1465	; Validat e 'PS', 'P U', and 'P Y' are set for Patie nt Stateme nt, Nightl y Update,
	1466	and Annua l Payment Statement
	1467	"RTN","PRC A313P",84, 0)
	1468	F TT="PS" ,"PU","PY" S IEN=$O( ^RCT(349.1 ,"B",TT,0) ) D
	1469	"RTN","PRC A313P",85, 0)
	1470	. N DOMAI N,I
	1471	"RTN","PRC A313P",86, 0)
	1472	. I TT="P S" M DOMAI N=CC
	1473	"RTN","PRC A313P",87, 0)
	1474	. I TT="P U" M DOMAI N=CP
	1475	"RTN","PRC A313P",88, 0)
	1476	. I TT="P Y" M DOMAI N=CA
	1477	"RTN","PRC A313P",89, 0)
	1478	. ; If no IEN creat e new leve l one and three with cross-ref erences
	1479	"RTN","PRC A313P",90, 0)
	1480	. I IEN=" " D SET1(T T,.DOMAIN) Q
	1481	"RTN","PRC A313P",91, 0)
	1482	. ; If no 3 level o r it is no t set to e xpected va lue reset 3 level
	1483	"RTN","PRC A313P",92, 0)
	1484	. I IEN'= "" D
	1485	"RTN","PRC A313P",93, 0)
	1486	. F I=1,3 S TTVAL(I )=$P($G(^R CT(349.1,I EN,3)),U,I )
	1487	"RTN","PRC A313P",94, 0)
	1488	. I DOMAI N(1)_DOMAI N(3)'=TTVA L(1)_TTVAL (3) D SET3 (IEN,.DOMA IN)
	1489	"RTN","PRC A313P",95, 0)
	1490	;
	1491	"RTN","PRC A313P",96, 0)
	1492	D BMES^XP DUTL("AR T ransaction Type Upda te complet e.")
	1493	"RTN","PRC A313P",97, 0)
	1494	;
	1495	"RTN","PRC A313P",98, 0)
	1496	Q
	1497	"RTN","PRC A313P",99, 0)
	1498	;
	1499	"RTN","PRC A313P",100 ,0)
	1500	SET1(TT,DO MAIN) ; P RCA4.531 3
	1501	"RTN","PRC A313P",101 ,0)
	1502	; Set bot h the 1 an d 3 level for 349.1
	1503	"RTN","PRC A313P",102 ,0)
	1504	; New and Set Field values fo r DIC(4.2
	1505	"RTN","PRC A313P",103 ,0)
	1506	N TTNAME, ZZ,DIC,Y
	1507	"RTN","PRC A313P",104 ,0)
	1508	I TT="PS" S TTNAME= "CCPC PATI ENT STATEM ENT"
	1509	"RTN","PRC A313P",105 ,0)
	1510	I TT="PU" S TTNAME= "PATIENT S TATEMENT U PDATE"
	1511	"RTN","PRC A313P",106 ,0)
	1512	I TT="PY" S TTNAME= "ANNUAL PA YMENT STAT EMENTS"
	1513	"RTN","PRC A313P",107 ,0)
	1514	;
	1515	"RTN","PRC A313P",108 ,0)
	1516	; Set 1 l evel value s
	1517	"RTN","PRC A313P",109 ,0)
	1518	S DIC="^R CT(349.1," ,DIC(0)="L "
	1519	"RTN","PRC A313P",110 ,0)
	1520	S X=TT
	1521	"RTN","PRC A313P",111 ,0)
	1522	S DIC("DR ")=".02/// "_TTNAME_" ;.03///"_1 _";"
	1523	"RTN","PRC A313P",112 ,0)
	1524	D FILE^DI CN
	1525	"RTN","PRC A313P",113 ,0)
	1526	S IEN=+Y
	1527	"RTN","PRC A313P",114 ,0)
	1528	;
	1529	"RTN","PRC A313P",115 ,0)
	1530	; Set 3 l evel
	1531	"RTN","PRC A313P",116 ,0)
	1532	D SET3(IE N,.DOMAIN)
	1533	"RTN","PRC A313P",117 ,0)
	1534	;
	1535	"RTN","PRC A313P",118 ,0)
	1536	Q
	1537	"RTN","PRC A313P",119 ,0)
	1538	SET3(IEN,D OMAIN) ; PRCA4.53 13
	1539	"RTN","PRC A313P",120 ,0)
	1540	; Set 3 l evel for 3 49.1
	1541	"RTN","PRC A313P",121 ,0)
	1542	S DOMAIN( "IEN")=$O( ^DIC(4.2," B",DOMAIN( 3),0))
	1543	"RTN","PRC A313P",122 ,0)
	1544	S ^RCT(34 9.1,IEN,3) =DOMAIN(1) _U_DOMAIN( "IEN")_U_D OMAIN(3)
	1545	"RTN","PRC A313P",123 ,0)
	1546	; PRCA4. 5313 - Se t Cross-Re ferences f or this IE N
	1547	"RTN","PRC A313P",124 ,0)
	1548	S DA=IEN, DIK="^RCT( 349.1," D IX1^DIK
	1549	"RTN","PRC A313P",125 ,0)
	1550	;
	1551	"RTN","PRC A313P",126 ,0)
	1552	Q
	1553	"RTN","PRC A313P",127 ,0)
	1554	;
	1555	"RTN","PRC A313P",128 ,0)
	1556	PRE ; Pre -install a ctions for the Data Dictionary
	1557	"RTN","PRC A313P",129 ,0)
	1558	;
	1559	"RTN","PRC A313P",130 ,0)
	1560	D BMES^XP DUTL("Star ting Pre-I nstall Cha nges.")
	1561	"RTN","PRC A313P",131 ,0)
	1562	;
	1563	"RTN","PRC A313P",132 ,0)
	1564	N DIK,DA
	1565	"RTN","PRC A313P",133 ,0)
	1566	; Remove DD for 349 .1, elemen ts 41, 42, and 43 - new elemen ts are ent ered duri
	1567	ng regular install
	1568	"RTN","PRC A313P",134 ,0)
	1569	S DIK="^D D(349.1,", DA(1)=349. 1
	1570	"RTN","PRC A313P",135 ,0)
	1571	F DA=41,4 2,43 D ^DI K
	1572	"RTN","PRC A313P",136 ,0)
	1573	;
	1574	"RTN","PRC A313P",137 ,0)
	1575	; Remove DD for 349 , element .09 to cha nge from o ld to new Style Cros s Referen
	1576	ce.
	1577	"RTN","PRC A313P",138 ,0)
	1578	S DIK="^D D(349,",DA (1)=349
	1579	"RTN","PRC A313P",139 ,0)
	1580	S DA=.09 D ^DIK
	1581	"RTN","PRC A313P",140 ,0)
	1582	;
	1583	"RTN","PRC A313P",141 ,0)
	1584	D BMES^XP DUTL("Pre- Install Ch anges comp lete.")
	1585	"RTN","PRC A313P",142 ,0)
	1586	Q
	1587	"RTN","PRC AACR")
	1588	0^19^B1249 55572^n/a
	1589	"RTN","PRC AACR",1,0)
	1590	PRCAACR ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION REPOR T ;09/21/1 5 3:34 PM
	1591	"RTN","PRC AACR",2,0)
	1592	;;4.5;Acc ounts Rece ivable;3 07,313;M ar 20, 199 5;Build 11 8
	1593	"RTN","PRC AACR",3,0)
	1594	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1595	"RTN","PRC AACR",4,0)
	1596	;
	1597	"RTN","PRC AACR",5,0)
	1598	Q
	1599	"RTN","PRC AACR",6,0)
	1600	;
	1601	"RTN","PRC AACR",7,0)
	1602	PSACRT ; r eport, pri nts sorted individua l transact ions that have been auto-corr
	1603	ected
	1604	"RTN","PRC AACR",8,0)
	1605	N DIC,PAG E,BY,DHD,F ILENUM,FLD S,FR,L,TO, PRCABDT,PR CAEDT,PRCA SORT
	1606	"RTN","PRC AACR",9,0)
	1607	W !
	1608	"RTN","PRC AACR",10,0 )
	1609	PSDATE ;
	1610	"RTN","PRC AACR",11,0 )
	1611	; Determi ne if Auto Correct p rocess is currently running
	1612	"RTN","PRC AACR",12,0 )
	1613	N PRCASTR T,QUIT,X,X 1,X2,Y
	1614	"RTN","PRC AACR",13,0 )
	1615	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= ""
	1616	"RTN","PRC AACR",14,0 )
	1617	; QUIT if Auto Corr ect proces s is curre ntly runni ng
	1618	"RTN","PRC AACR",15,0 )
	1619	I PRCASTR T'="" D Q :QUIT
	1620	"RTN","PRC AACR",16,0 )
	1621	.S Y=$P(P RCASTRT,U, 2)
	1622	"RTN","PRC AACR",17,0 )
	1623	.D DD^%DT
	1624	"RTN","PRC AACR",18,0 )
	1625	.S PRCAST RT=Y
	1626	"RTN","PRC AACR",19,0 )
	1627	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram is cur rently run ning."
	1628	"RTN","PRC AACR",20,0 )
	1629	.W !,"It was starte d at ",PRC ASTRT," an d can take up to 1 h our to com plete."
	1630	"RTN","PRC AACR",21,0 )
	1631	.W !!,"If you choos e to conti nue with t his report , it may n ot reflect all of t
	1632	he"
	1633	"RTN","PRC AACR",22,0 )
	1634	.W !,"cha nges from this lates t run of t he Patient Statement Auto-Corr ection Pr
	1635	ogram."
	1636	"RTN","PRC AACR",23,0 )
	1637	.W !
	1638	"RTN","PRC AACR",24,0 )
	1639	.S DIR(0) ="Y",DIR(" A")="Do yo u want to continue", DIR("B")=" NO"
	1640	"RTN","PRC AACR",25,0 )
	1641	.D ^DIR
	1642	"RTN","PRC AACR",26,0 )
	1643	.W !
	1644	"RTN","PRC AACR",27,0 )
	1645	.; Quit i f ^, ^^, T imeout or No
	1646	"RTN","PRC AACR",28,0 )
	1647	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	1648	"RTN","PRC AACR",29,0 )
	1649	.; Send M ailMan mes sage to PR CACPS mail group if Yes
	1650	"RTN","PRC AACR",30,0 )
	1651	.I Y=1 D PRCAMAIL^P RCACPS(PRC ASTRT)
	1652	"RTN","PRC AACR",31,0 )
	1653	.K DTOUT, DUOUT,DIRO UT
	1654	"RTN","PRC AACR",32,0 )
	1655	;
	1656	"RTN","PRC AACR",33,0 )
	1657	N DIROUT, DIS,DTOUT, DUOUT
	1658	"RTN","PRC AACR",34,0 )
	1659	S DIR("A" )="Date Ra nge: FROM: ",DIR("B" )="T-7"
	1660	"RTN","PRC AACR",35,0 )
	1661	S DIR("?" )="The def ault date is T-7. F uture date s may not be entered ."
	1662	"RTN","PRC AACR",36,0 )
	1663	S DIR(0)= "DO" D ^DI R
	1664	"RTN","PRC AACR",37,0 )
	1665	S:Y'="" P RCABDT=Y
	1666	"RTN","PRC AACR",38,0 )
	1667	I $D(DIRU T)&'Y K DI RUT Q
	1668	"RTN","PRC AACR",39,0 )
	1669	I PRCABDT >DT G PSDA TE
	1670	"RTN","PRC AACR",40,0 )
	1671	W "(",Y(0 ),")"
	1672	"RTN","PRC AACR",41,0 )
	1673	K DIR,X,Y
	1674	"RTN","PRC AACR",42,0 )
	1675	S DIR(0)= "DO"
	1676	"RTN","PRC AACR",43,0 )
	1677	S DIR("A" )="Date Ra nge: TO: ",DIR("B" )="T"
	1678	"RTN","PRC AACR",44,0 )
	1679	S DIR("?" )="The def ault date is T, but any date m ay be ente red."
	1680	"RTN","PRC AACR",45,0 )
	1681	D ^DIR S: Y="" Y=DT
	1682	"RTN","PRC AACR",46,0 )
	1683	I $D(DIRU T)&'Y K DI RUT Q
	1684	"RTN","PRC AACR",47,0 )
	1685	W "(",Y(0 ),")"
	1686	"RTN","PRC AACR",48,0 )
	1687	S PRCAEDT =Y
	1688	"RTN","PRC AACR",49,0 )
	1689	I PRCABDT >PRCAEDT G PSDATE
	1690	"RTN","PRC AACR",50,0 )
	1691	K DIR
	1692	"RTN","PRC AACR",51,0 )
	1693	S DIR(0)= "S^1:Auto- Correct Re ason;2:Deb tor Name;3 :Bill Numb er;4:Trans action Nu
	1694	mber;5:Aut o-Correct Date",DIR( "A")="Sort by"
	1695	"RTN","PRC AACR",52,0 )
	1696	S DIR("B" )=1
	1697	"RTN","PRC AACR",53,0 )
	1698	D ^DIR K DIR
	1699	"RTN","PRC AACR",54,0 )
	1700	S PRCASOR T=Y
	1701	"RTN","PRC AACR",55,0 )
	1702	Q:$D(DTOU T)!($D(DUO UT))!($D(D IROUT))
	1703	"RTN","PRC AACR",56,0 )
	1704	;
	1705	"RTN","PRC AACR",57,0 )
	1706	; Prompt for device
	1707	"RTN","PRC AACR",58,0 )
	1708	W !
	1709	"RTN","PRC AACR",59,0 )
	1710	N ZTRTN,Z TDESC,ZTSA VE
	1711	"RTN","PRC AACR",60,0 )
	1712	K IOP,%ZI S,POP,IO(" Q")
	1713	"RTN","PRC AACR",61,0 )
	1714	S %ZIS="Q "
	1715	"RTN","PRC AACR",62,0 )
	1716	D ^%ZIS Q :POP
	1717	"RTN","PRC AACR",63,0 )
	1718	; If Queu ed
	1719	"RTN","PRC AACR",64,0 )
	1720	I $D(IO(" Q")) D Q
	1721	"RTN","PRC AACR",65,0 )
	1722	.K IO("Q" )
	1723	"RTN","PRC AACR",66,0 )
	1724	.I $G(IOS T)["P-MES" S ZTRTN=" PRT^PRCAAC R1"
	1725	"RTN","PRC AACR",67,0 )
	1726	.I $G(IOS T)'["P-MES " S ZTRTN= "PRT^PRCAA CR"
	1727	"RTN","PRC AACR",68,0 )
	1728	.S ZTSAVE ("PRCABDT" )="",ZTSAV E("PRCAEDT ")="",ZTSA VE("PRCASO RT")=""
	1729	"RTN","PRC AACR",69,0 )
	1730	.D ^%ZTLO AD
	1731	"RTN","PRC AACR",70,0 )
	1732	.D HOME^% ZIS
	1733	"RTN","PRC AACR",71,0 )
	1734	.I $D(ZTS K)[0 W !!? 5,"Report cancelled! "
	1735	"RTN","PRC AACR",72,0 )
	1736	.E W !!? 5,"Report queued!"
	1737	"RTN","PRC AACR",73,0 )
	1738	.K POP
	1739	"RTN","PRC AACR",74,0 )
	1740	;
	1741	"RTN","PRC AACR",75,0 )
	1742	;Print Re port if no t QUEUED
	1743	"RTN","PRC AACR",76,0 )
	1744	PRT ;
	1745	"RTN","PRC AACR",77,0 )
	1746	; If not queued and output se nt to P-ME S
	1747	"RTN","PRC AACR",78,0 )
	1748	I $G(IOST )["P-MES" D PRT^PRCA ACR1 Q
	1749	"RTN","PRC AACR",79,0 )
	1750	;If not q ueued and output not sent to P -MES
	1751	"RTN","PRC AACR",80,0 )
	1752	U IO
	1753	"RTN","PRC AACR",81,0 )
	1754	K ^TMP("P RCAACR",$J )
	1755	"RTN","PRC AACR",82,0 )
	1756	S PAGE=0
	1757	"RTN","PRC AACR",83,0 )
	1758	S DASH="" ,$P(DASH," -",79)=""
	1759	"RTN","PRC AACR",84,0 )
	1760	S DIS(0)= "I $D(^PRC A(433,""TA CD"",PRCAT SRT,D0))", L=0
	1761	"RTN","PRC AACR",85,0 )
	1762	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AACTF,PRC
	1763	ATNTF
	1764	"RTN","PRC AACR",86,0 )
	1765	S PRCATSR T=PRCABDT- .00001
	1766	"RTN","PRC AACR",87,0 )
	1767	; Loop th rough the specified date range
	1768	"RTN","PRC AACR",88,0 )
	1769	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	1770	D
	1771	"RTN","PRC AACR",89,0 )
	1772	.S PRCATN =""
	1773	"RTN","PRC AACR",90,0 )
	1774	.; Loop t hrough the transacti ons for th e current date
	1775	"RTN","PRC AACR",91,0 )
	1776	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	1777	"RTN","PRC AACR",92,0 )
	1778	..; Load associated data fiel ds for rep ort
	1779	"RTN","PRC AACR",93,0 )
	1780	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	1781	"RTN","PRC AACR",94,0 )
	1782	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	1783	"RTN","PRC AACR",95,0 )
	1784	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	1785	"RTN","PRC AACR",96,0 )
	1786	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	1787	"RTN","PRC AACR",97,0 )
	1788	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	1789	"RTN","PRC AACR",98,0 )
	1790	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	1791	"RTN","PRC AACR",99,0 )
	1792	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	1793	"RTN","PRC AACR",100, 0)
	1794	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	1795	"RTN","PRC AACR",101, 0)
	1796	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	1797	"RTN","PRC AACR",102, 0)
	1798	..S PRCAA CR=$E(PRCA ACR,1,14)
	1799	"RTN","PRC AACR",103, 0)
	1800	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	1801	"RTN","PRC AACR",104, 0)
	1802	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	1803	"RTN","PRC AACR",105, 0)
	1804	..I PRCAA CTF="YES" S PRCATNTF =""
	1805	"RTN","PRC AACR",106, 0)
	1806	..;
	1807	"RTN","PRC AACR",107, 0)
	1808	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number
	1809	"RTN","PRC AACR",108, 0)
	1810	..I PRCAS ORT=1 D Q
	1811	"RTN","PRC AACR",109, 0)
	1812	...S ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_PR CABN_U_PR
	1813	CATNTF_U_P RCAACD_U_P RCASSN
	1814	"RTN","PRC AACR",110, 0)
	1815	..;
	1816	"RTN","PRC AACR",111, 0)
	1817	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	1818	"RTN","PRC AACR",112, 0)
	1819	..I PRCAS ORT=2 D Q
	1820	"RTN","PRC AACR",113, 0)
	1821	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	1822	ATNTF_U_PR CAACD_U_PR CAACR
	1823	"RTN","PRC AACR",114, 0)
	1824	..;
	1825	"RTN","PRC AACR",115, 0)
	1826	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1827	"RTN","PRC AACR",116, 0)
	1828	..I PRCAS ORT=3 D Q
	1829	"RTN","PRC AACR",117, 0)
	1830	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	1831	ATNTF_U_PR CAACD_U_PR CAACR
	1832	"RTN","PRC AACR",118, 0)
	1833	..;
	1834	"RTN","PRC AACR",119, 0)
	1835	..; Store in ^TMP s orted by T ransaction , Debtor a nd Bill Nu mber
	1836	"RTN","PRC AACR",120, 0)
	1837	..I PRCAS ORT=4 D Q
	1838	"RTN","PRC AACR",121, 0)
	1839	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	1840	CASSN_U_PR CAACD_U_PR CAACR
	1841	"RTN","PRC AACR",122, 0)
	1842	..;
	1843	"RTN","PRC AACR",123, 0)
	1844	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number and Tran
	1845	saction Nu mber
	1846	"RTN","PRC AACR",124, 0)
	1847	..I PRCAS ORT=5 D Q
	1848	"RTN","PRC AACR",125, 0)
	1849	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	1850	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	1851	"RTN","PRC AACR",126, 0)
	1852	;
	1853	"RTN","PRC AACR",127, 0)
	1854	;
	1855	"RTN","PRC AACR",128, 0)
	1856	N QUIT ; QUIT befor e end of r eport
	1857	"RTN","PRC AACR",129, 0)
	1858	S QUIT=""
	1859	"RTN","PRC AACR",130, 0)
	1860	; Display Auto-Corr ect data s orted by A uto Correc tion Reaso n
	1861	"RTN","PRC AACR",131, 0)
	1862	I PRCASOR T=1 D
	1863	"RTN","PRC AACR",132, 0)
	1864	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_P
	1865	RCABN_U_PR CATNTF_U_P RCAACD_U_P RCASSN
	1866	"RTN","PRC AACR",133, 0)
	1867	.; Displa y Auto Cor rection Re ason heade r
	1868	"RTN","PRC AACR",134, 0)
	1869	.N Y
	1870	"RTN","PRC AACR",135, 0)
	1871	.D PSACRT P1
	1872	"RTN","PRC AACR",136, 0)
	1873	.S PRCAAC R=""
	1874	"RTN","PRC AACR",137, 0)
	1875	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D Q:QUIT
	1876	"RTN","PRC AACR",138, 0)
	1877	..S PRCAD TR=""
	1878	"RTN","PRC AACR",139, 0)
	1879	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	1880	"RTN","PRC AACR",140, 0)
	1881	...S PRCA BN=""
	1882	"RTN","PRC AACR",141, 0)
	1883	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:Q
	1884	UIT
	1885	"RTN","PRC AACR",142, 0)
	1886	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	1887	"RTN","PRC AACR",143, 0)
	1888	....S Y=$ P(PRCADATA ,U,5)
	1889	"RTN","PRC AACR",144, 0)
	1890	....D DD^ %DT
	1891	"RTN","PRC AACR",145, 0)
	1892	....S $P( PRCADATA,U ,5)=Y
	1893	"RTN","PRC AACR",146, 0)
	1894	....W !,$ P(PRCADATA ,U,1),?16, $E($P(PRCA DATA,U,2), 1,18),?36, $E($P(PRCA DATA,U,6)
	1895	,6,9),?42, $E($P(PRCA DATA,U,3), 1,11),?55, $J($P(PRCA DATA,U,4), 9),?66,$P( PRCADATA,
	1896	U,5)
	1897	"RTN","PRC AACR",147, 0)
	1898	....I $Y> (IOSL-3) D
	1899	"RTN","PRC AACR",148, 0)
	1900	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1901	"RTN","PRC AACR",149, 0)
	1902	......D P RTC
	1903	"RTN","PRC AACR",150, 0)
	1904	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1905	"RTN","PRC AACR",151, 0)
	1906	.....D PS ACRTP1
	1907	"RTN","PRC AACR",152, 0)
	1908	;
	1909	"RTN","PRC AACR",153, 0)
	1910	; Display Auto-Corr ect data s orted by D ebtor
	1911	"RTN","PRC AACR",154, 0)
	1912	I PRCASOR T=2 D
	1913	"RTN","PRC AACR",155, 0)
	1914	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	1915	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1916	"RTN","PRC AACR",156, 0)
	1917	.; Displa y Debtor h eader
	1918	"RTN","PRC AACR",157, 0)
	1919	.D PSACRT P2
	1920	"RTN","PRC AACR",158, 0)
	1921	.S PRCADT R=""
	1922	"RTN","PRC AACR",159, 0)
	1923	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D Q:QUIT
	1924	"RTN","PRC AACR",160, 0)
	1925	..S PRCAB N=""
	1926	"RTN","PRC AACR",161, 0)
	1927	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D Q:Q UIT
	1928	"RTN","PRC AACR",162, 0)
	1929	...S PRCA TN=""
	1930	"RTN","PRC AACR",163, 0)
	1931	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D Q:QU
	1932	IT
	1933	"RTN","PRC AACR",164, 0)
	1934	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	1935	"RTN","PRC AACR",165, 0)
	1936	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1937	"RTN","PRC AACR",166, 0)
	1938	....W !,$ E($P(PRCAD ATA,U,1),1 ,18),?20,$ P(PRCADATA ,U,2),?33, $E($P(PRCA DATA,U,3)
	1939	,6,9),?39, $J($P(PRCA DATA,U,4), 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	1940	"RTN","PRC AACR",167, 0)
	1941	....I $Y> (IOSL-3) D
	1942	"RTN","PRC AACR",168, 0)
	1943	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1944	"RTN","PRC AACR",169, 0)
	1945	......D P RTC
	1946	"RTN","PRC AACR",170, 0)
	1947	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1948	"RTN","PRC AACR",171, 0)
	1949	.....D PS ACRTP2
	1950	"RTN","PRC AACR",172, 0)
	1951	;
	1952	"RTN","PRC AACR",173, 0)
	1953	; Display Auto-Corr ect data s orted by A UTO-C DATE
	1954	"RTN","PRC AACR",174, 0)
	1955	I PRCASOR T=3 D
	1956	"RTN","PRC AACR",175, 0)
	1957	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	1958	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1959	"RTN","PRC AACR",176, 0)
	1960	.; Displa y Bill Num ber header
	1961	"RTN","PRC AACR",177, 0)
	1962	.D PSACRT P3
	1963	"RTN","PRC AACR",178, 0)
	1964	.S PRCABN =""
	1965	"RTN","PRC AACR",179, 0)
	1966	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D Q: QUIT
	1967	"RTN","PRC AACR",180, 0)
	1968	..S PRCAD TR=""
	1969	"RTN","PRC AACR",181, 0)
	1970	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1971	"RTN","PRC AACR",182, 0)
	1972	...S PRCA TN=""
	1973	"RTN","PRC AACR",183, 0)
	1974	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D Q:QU
	1975	IT
	1976	"RTN","PRC AACR",184, 0)
	1977	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	1978	"RTN","PRC AACR",185, 0)
	1979	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1980	"RTN","PRC AACR",186, 0)
	1981	....W !,$ P(PRCADATA ,U,1),?13, $E($P(PRCA DATA,U,2), 1,18),?33, $E($P(PRCA DATA,U,3)
	1982	,6,9),?39, $J($P(PRCA DATA,U,4), 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	1983	"RTN","PRC AACR",187, 0)
	1984	....I $Y> (IOSL-3) D
	1985	"RTN","PRC AACR",188, 0)
	1986	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1987	"RTN","PRC AACR",189, 0)
	1988	......D P RTC
	1989	"RTN","PRC AACR",190, 0)
	1990	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1991	"RTN","PRC AACR",191, 0)
	1992	.....D PS ACRTP3
	1993	"RTN","PRC AACR",192, 0)
	1994	;
	1995	"RTN","PRC AACR",193, 0)
	1996	; Display Auto-Corr ect data s orted by T ransaction Number
	1997	"RTN","PRC AACR",194, 0)
	1998	I PRCASOR T=4 D
	1999	"RTN","PRC AACR",195, 0)
	2000	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	2001	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	2002	"RTN","PRC AACR",196, 0)
	2003	.; Displa y AUTO-C D ATE header
	2004	"RTN","PRC AACR",197, 0)
	2005	.D PSACRT P4
	2006	"RTN","PRC AACR",198, 0)
	2007	.S PRCATN =""
	2008	"RTN","PRC AACR",199, 0)
	2009	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D Q: QUIT
	2010	"RTN","PRC AACR",200, 0)
	2011	..S PRCAD TR=""
	2012	"RTN","PRC AACR",201, 0)
	2013	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	2014	"RTN","PRC AACR",202, 0)
	2015	...S PRCA BN=""
	2016	"RTN","PRC AACR",203, 0)
	2017	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D Q:QU
	2018	IT
	2019	"RTN","PRC AACR",204, 0)
	2020	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	2021	"RTN","PRC AACR",205, 0)
	2022	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2023	"RTN","PRC AACR",206, 0)
	2024	....W !,$ J($P(PRCAD ATA,U,1),9 ),?11,$E($ P(PRCADATA ,U,2),1,18 ),?31,$P(P RCADATA,U
	2025	,3),?44,$E ($P(PRCADA TA,U,4),6, 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	2026	"RTN","PRC AACR",207, 0)
	2027	....I $Y> (IOSL-3) D
	2028	"RTN","PRC AACR",208, 0)
	2029	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	2030	"RTN","PRC AACR",209, 0)
	2031	......D P RTC
	2032	"RTN","PRC AACR",210, 0)
	2033	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	2034	"RTN","PRC AACR",211, 0)
	2035	.....D PS ACRTP4
	2036	"RTN","PRC AACR",212, 0)
	2037	;
	2038	"RTN","PRC AACR",213, 0)
	2039	; Display Auto-Corr ect data s orted by A uto-Correc t date
	2040	"RTN","PRC AACR",214, 0)
	2041	I PRCASOR T=5 D
	2042	"RTN","PRC AACR",215, 0)
	2043	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	2044	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2045	"RTN","PRC AACR",216, 0)
	2046	.; Displa y AUTO-C D ATE header
	2047	"RTN","PRC AACR",217, 0)
	2048	.D PSACRT P5
	2049	"RTN","PRC AACR",218, 0)
	2050	.S PRCAAC D=""
	2051	"RTN","PRC AACR",219, 0)
	2052	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D Q:QUIT
	2053	"RTN","PRC AACR",220, 0)
	2054	..S PRCAD TR=""
	2055	"RTN","PRC AACR",221, 0)
	2056	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	2057	"RTN","PRC AACR",222, 0)
	2058	...S PRCA BN=""
	2059	"RTN","PRC AACR",223, 0)
	2060	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:Q
	2061	UIT
	2062	"RTN","PRC AACR",224, 0)
	2063	....S PRC ATN=""
	2064	"RTN","PRC AACR",225, 0)
	2065	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	2066	D Q:QUI T
	2067	"RTN","PRC AACR",226, 0)
	2068	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	2069	"RTN","PRC AACR",227, 0)
	2070	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	2071	"RTN","PRC AACR",228, 0)
	2072	.....W !, $P(PRCADAT A,U,1),?14 ,$E($P(PRC ADATA,U,2) ,1,18),?34 ,$P(PRCADA TA,U,3),?
	2073	47,$E($P(P RCADATA,U, 4),6,9),?5 3,$J($P(PR CADATA,U,5 ),9),?64,$ P(PRCADATA ,U,6)
	2074	"RTN","PRC AACR",229, 0)
	2075	.....I $Y >(IOSL-3) D
	2076	"RTN","PRC AACR",230, 0)
	2077	......I $ E(IOST,1,2 )="C-" D Q:QUIT
	2078	"RTN","PRC AACR",231, 0)
	2079	.......D PRTC
	2080	"RTN","PRC AACR",232, 0)
	2081	.......I $D(DIRUT)! ($D(DTOUT) ) S QUIT=1
	2082	"RTN","PRC AACR",233, 0)
	2083	......D P SACRTP5
	2084	"RTN","PRC AACR",234, 0)
	2085	D ^%ZISC
	2086	"RTN","PRC AACR",235, 0)
	2087	I $E(IOST ,1,2)="C-" ,'$D(DUOUT ),('$D(DTO UT)) W ! S DIR(0)="E " D ^DIR
	2088	"RTN","PRC AACR",236, 0)
	2089	K X,Y,DAS H,D0
	2090	"RTN","PRC AACR",237, 0)
	2091	Q
	2092	"RTN","PRC AACR",238, 0)
	2093	;
	2094	"RTN","PRC AACR",239, 0)
	2095	PRTC ; Pre ss Return To Continu e
	2096	"RTN","PRC AACR",240, 0)
	2097	S DIR(0)= "E" D ^DIR
	2098	"RTN","PRC AACR",241, 0)
	2099	Q
	2100	"RTN","PRC AACR",242, 0)
	2101	;
	2102	"RTN","PRC AACR",243, 0)
	2103	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	2104	"RTN","PRC AACR",244, 0)
	2105	W @IOF
	2106	"RTN","PRC AACR",245, 0)
	2107	S PAGE=PA GE+1
	2108	"RTN","PRC AACR",246, 0)
	2109	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION RE ASON)",?6
	2110	6,$$UPPER^ VALM1($$FM TE^XLFDT(D T))
	2111	"RTN","PRC AACR",247, 0)
	2112	W !,DASH, !
	2113	"RTN","PRC AACR",248, 0)
	2114	W !,"AUTO -C REASON" ,?16,"DEBT OR",?36,"S SN",?42,"B ILL NO.",? 55,"TRANS NUM",?66,
	2115	"AUTO-C DA TE"
	2116	"RTN","PRC AACR",249, 0)
	2117	W !,"---- ---------- ",?16,"--- ---------- -----",?36 ,"----",?4 2,"------- ----",?55
	2118	,"-------- -",?66,"-- ---------- "
	2119	"RTN","PRC AACR",250, 0)
	2120	Q
	2121	"RTN","PRC AACR",251, 0)
	2122	;
	2123	"RTN","PRC AACR",252, 0)
	2124	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2125	"RTN","PRC AACR",253, 0)
	2126	W @IOF
	2127	"RTN","PRC AACR",254, 0)
	2128	S PAGE=PA GE+1
	2129	"RTN","PRC AACR",255, 0)
	2130	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y DEBTOR)" ,?66,$$UPP ER^VALM1(
	2131	$$FMTE^XLF DT(DT))
	2132	"RTN","PRC AACR",256, 0)
	2133	W !,DASH, !
	2134	"RTN","PRC AACR",257, 0)
	2135	W !,"DEBT OR",?20,"B ILL NO.",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	2136	UTO-C REAS ON"
	2137	"RTN","PRC AACR",258, 0)
	2138	W !,"---- ---------- ----",?20, "--------- --",?33,"- ---",?39," ---------" ,?50,"---
	2139	---------" ,?64,"---- ---------- "
	2140	"RTN","PRC AACR",259, 0)
	2141	Q
	2142	"RTN","PRC AACR",260, 0)
	2143	;
	2144	"RTN","PRC AACR",261, 0)
	2145	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2146	"RTN","PRC AACR",262, 0)
	2147	W @IOF
	2148	"RTN","PRC AACR",263, 0)
	2149	S PAGE=PA GE+1
	2150	"RTN","PRC AACR",264, 0)
	2151	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y BILL #)" ,?66,$$UPP ER^VALM1(
	2152	$$FMTE^XLF DT(DT))
	2153	"RTN","PRC AACR",265, 0)
	2154	W !,DASH, !
	2155	"RTN","PRC AACR",266, 0)
	2156	W !,"BILL NO.",?13, "DEBTOR",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	2157	UTO-C REAS ON"
	2158	"RTN","PRC AACR",267, 0)
	2159	W !,"---- -------",? 13,"------ ---------- --",?33,"- ---",?39," ---------" ,?50,"---
	2160	---------" ,?64,"---- ---------- "
	2161	"RTN","PRC AACR",268, 0)
	2162	Q
	2163	"RTN","PRC AACR",269, 0)
	2164	;
	2165	"RTN","PRC AACR",270, 0)
	2166	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2167	"RTN","PRC AACR",271, 0)
	2168	W @IOF
	2169	"RTN","PRC AACR",272, 0)
	2170	S PAGE=PA GE+1
	2171	"RTN","PRC AACR",273, 0)
	2172	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y TRANSACT ION NUMBER )",?66,$$
	2173	UPPER^VALM 1($$FMTE^X LFDT(DT))
	2174	"RTN","PRC AACR",274, 0)
	2175	W !,DASH, !
	2176	"RTN","PRC AACR",275, 0)
	2177	W !,"TRAN S NUM",?11 ,"DEBTOR", ?31,"BILL NO.",?44," SSN",?50," AUTO-C DAT E",?64,"A
	2178	UTO-C REAS ON"
	2179	"RTN","PRC AACR",276, 0)
	2180	W !,"---- -----",?11 ,"-------- ---------- ",?31,"--- --------", ?44,"----" ,?50,"---
	2181	---------" ,?64,"---- ---------- "
	2182	"RTN","PRC AACR",277, 0)
	2183	Q
	2184	"RTN","PRC AACR",278, 0)
	2185	;
	2186	"RTN","PRC AACR",279, 0)
	2187	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	2188	"RTN","PRC AACR",280, 0)
	2189	W @IOF
	2190	"RTN","PRC AACR",281, 0)
	2191	S PAGE=PA GE+1
	2192	"RTN","PRC AACR",282, 0)
	2193	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION DA TE)",?66,
	2194	$$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2195	"RTN","PRC AACR",283, 0)
	2196	W !,DASH, !
	2197	"RTN","PRC AACR",284, 0)
	2198	W !,"AUTO -C DATE",? 14,"DEBTOR ",?34,"BIL L NO.",?47 ,"SSN",?53 ,"TRANS NU M",?64,"A
	2199	UTO-C REAS ON"
	2200	"RTN","PRC AACR",285, 0)
	2201	W !,"---- --------", ?14,"----- ---------- ---",?34," ---------- -",?47,"-- --",?53,"
	2202	---------" ,?64,"---- ---------- "
	2203	"RTN","PRC AACR",286, 0)
	2204	Q
	2205	"RTN","PRC AACR",287, 0)
	2206	;
	2207	"RTN","PRC AACR",288, 0)
	2208	EXIT ;
	2209	"RTN","PRC AACR",289, 0)
	2210	Q
	2211	"RTN","PRC AACR1")
	2212	0^20^B1512 71441^n/a
	2213	"RTN","PRC AACR1",1,0 )
	2214	PRCAACR1 ; ALBANY/BDB -PATIENT S TATEMENTS AUTO-CORRE CTION REPO RT ;09/21/ 15 3:34 P
	2215	M
	2216	"RTN","PRC AACR1",2,0 )
	2217	;;4.5;Acc ounts Rece ivable;3 07,313;M ar 20, 199 5;Build 11 8
	2218	"RTN","PRC AACR1",3,0 )
	2219	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2220	"RTN","PRC AACR1",4,0 )
	2221	;
	2222	"RTN","PRC AACR1",5,0 )
	2223	Q
	2224	"RTN","PRC AACR1",6,0 )
	2225	;Print Re port when Queued to P-MES
	2226	"RTN","PRC AACR1",7,0 )
	2227	PRT ;
	2228	"RTN","PRC AACR1",8,0 )
	2229	U IO
	2230	"RTN","PRC AACR1",9,0 )
	2231	; build a rray of tr ansaction auto-corre cted
	2232	"RTN","PRC AACR1",10, 0)
	2233	K ^TMP("P RCAACR1",$ J)
	2234	"RTN","PRC AACR1",11, 0)
	2235	N DASH,PA GE
	2236	"RTN","PRC AACR1",12, 0)
	2237	S PAGE=0
	2238	"RTN","PRC AACR1",13, 0)
	2239	S DASH="" ,$P(DASH," -",79)=""
	2240	"RTN","PRC AACR1",14, 0)
	2241	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AIEN,PRCA
	2242	ACTF,PRCAT NTF,PRCATE MP
	2243	"RTN","PRC AACR1",15, 0)
	2244	S PRCATSR T=PRCABDT- .00001,PRC AIEN=0
	2245	"RTN","PRC AACR1",16, 0)
	2246	; Loop th rough the specified date range
	2247	"RTN","PRC AACR1",17, 0)
	2248	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	2249	D
	2250	"RTN","PRC AACR1",18, 0)
	2251	.S PRCATN =""
	2252	"RTN","PRC AACR1",19, 0)
	2253	.; Loop t hrough the transacti ons for th e current date
	2254	"RTN","PRC AACR1",20, 0)
	2255	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	2256	"RTN","PRC AACR1",21, 0)
	2257	..; Load associated data fiel ds for rep ort
	2258	"RTN","PRC AACR1",22, 0)
	2259	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	2260	"RTN","PRC AACR1",23, 0)
	2261	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	2262	"RTN","PRC AACR1",24, 0)
	2263	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	2264	"RTN","PRC AACR1",25, 0)
	2265	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	2266	"RTN","PRC AACR1",26, 0)
	2267	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	2268	"RTN","PRC AACR1",27, 0)
	2269	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	2270	"RTN","PRC AACR1",28, 0)
	2271	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	2272	"RTN","PRC AACR1",29, 0)
	2273	..S PRCAS SN=$E(PRCA SSN,6,9)
	2274	"RTN","PRC AACR1",30, 0)
	2275	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	2276	"RTN","PRC AACR1",31, 0)
	2277	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	2278	"RTN","PRC AACR1",32, 0)
	2279	..S PRCAA CR=$E(PRCA ACR,1,14)
	2280	"RTN","PRC AACR1",33, 0)
	2281	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	2282	"RTN","PRC AACR1",34, 0)
	2283	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	2284	"RTN","PRC AACR1",35, 0)
	2285	..I PRCAA CTF="YES" S PRCATNTF =""
	2286	"RTN","PRC AACR1",36, 0)
	2287	..;
	2288	"RTN","PRC AACR1",37, 0)
	2289	..; Stor e in ^TMP sorted by Auto-Corre ct Reason, Debtor an d Bill Num ber #
	2290	"RTN","PRC AACR1",38, 0)
	2291	..I PRCAS ORT=1 D Q
	2292	"RTN","PRC AACR1",39, 0)
	2293	...S ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_PR CABN_U_PR
	2294	CATNTF_U_P RCAACD_U_P RCASSN
	2295	"RTN","PRC AACR1",40, 0)
	2296	..;
	2297	"RTN","PRC AACR1",41, 0)
	2298	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	2299	"RTN","PRC AACR1",42, 0)
	2300	..I PRCAS ORT=2 D Q
	2301	"RTN","PRC AACR1",43, 0)
	2302	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	2303	ATNTF_U_PR CAACD_U_PR CAACR
	2304	"RTN","PRC AACR1",44, 0)
	2305	..;
	2306	"RTN","PRC AACR1",45, 0)
	2307	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	2308	"RTN","PRC AACR1",46, 0)
	2309	..I PRCAS ORT=3 D Q
	2310	"RTN","PRC AACR1",47, 0)
	2311	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	2312	ATNTF_U_PR CAACD_U_PR CAACR
	2313	"RTN","PRC AACR1",48, 0)
	2314	..;
	2315	"RTN","PRC AACR1",49, 0)
	2316	..; Store in ^TMP s orted by T ransaction , Debtor a nd #Bill N umber
	2317	"RTN","PRC AACR1",50, 0)
	2318	..I PRCAS ORT=4 D Q
	2319	"RTN","PRC AACR1",51, 0)
	2320	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	2321	CASSN_U_PR CAACD_U_PR CAACR
	2322	"RTN","PRC AACR1",52, 0)
	2323	..;
	2324	"RTN","PRC AACR1",53, 0)
	2325	..; Store in ^TMP s orted by A uto-Correc t Date, De btor, #Bil l Number a nd Transa
	2326	ction Numb er
	2327	"RTN","PRC AACR1",54, 0)
	2328	..I PRCAS ORT=5 D Q
	2329	"RTN","PRC AACR1",55, 0)
	2330	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	2331	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2332	"RTN","PRC AACR1",56, 0)
	2333	..Q
	2334	"RTN","PRC AACR1",57, 0)
	2335	;
	2336	"RTN","PRC AACR1",58, 0)
	2337	; Display Auto-Corr ect data s orted by B ill Number
	2338	"RTN","PRC AACR1",59, 0)
	2339	I PRCASOR T=1 D
	2340	"RTN","PRC AACR1",60, 0)
	2341	.; Print Header
	2342	"RTN","PRC AACR1",61, 0)
	2343	.D PSACRT P1
	2344	"RTN","PRC AACR1",62, 0)
	2345	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_P
	2346	RCABN_U_PR CATNTF_U_P RCAACD_U_P RCASSN
	2347	"RTN","PRC AACR1",63, 0)
	2348	.S PRCAAC R=""
	2349	"RTN","PRC AACR1",64, 0)
	2350	.N Y
	2351	"RTN","PRC AACR1",65, 0)
	2352	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D
	2353	"RTN","PRC AACR1",66, 0)
	2354	..S PRCAD TR=""
	2355	"RTN","PRC AACR1",67, 0)
	2356	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D
	2357	"RTN","PRC AACR1",68, 0)
	2358	...S PRCA BN=""
	2359	"RTN","PRC AACR1",69, 0)
	2360	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2361	"RTN","PRC AACR1",70, 0)
	2362	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	2363	"RTN","PRC AACR1",71, 0)
	2364	....S Y=$ P(PRCADATA ,U,5)
	2365	"RTN","PRC AACR1",72, 0)
	2366	....D DD^ %DT
	2367	"RTN","PRC AACR1",73, 0)
	2368	....S $P( PRCADATA,U ,5)=Y
	2369	"RTN","PRC AACR1",74, 0)
	2370	....S PRC AIEN=PRCAI EN+1
	2371	"RTN","PRC AACR1",75, 0)
	2372	....; Add Auto-Corr ect Reason
	2373	"RTN","PRC AACR1",76, 0)
	2374	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,14 ),$E(PRCAT EMP,16)=" "
	2375	"RTN","PRC AACR1",77, 0)
	2376	....; Add 18 chars of Debtor' s name
	2377	"RTN","PRC AACR1",78, 0)
	2378	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,36)=" "
	2379	"RTN","PRC AACR1",79, 0)
	2380	....; Add SSN
	2381	"RTN","PRC AACR1",80, 0)
	2382	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 ),$E(PRCAT EMP,42)=" "
	2383	"RTN","PRC AACR1",81, 0)
	2384	....; Add Bill Numb er
	2385	"RTN","PRC AACR1",82, 0)
	2386	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,55)=" "
	2387	"RTN","PRC AACR1",83, 0)
	2388	....; Add Transacti on Number
	2389	"RTN","PRC AACR1",84, 0)
	2390	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 66)=" "
	2391	"RTN","PRC AACR1",85, 0)
	2392	....; Add Auto-Corr ect Date
	2393	"RTN","PRC AACR1",86, 0)
	2394	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,74)=" "
	2395	"RTN","PRC AACR1",87, 0)
	2396	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2397	"RTN","PRC AACR1",88, 0)
	2398	....Q
	2399	"RTN","PRC AACR1",89, 0)
	2400	;
	2401	"RTN","PRC AACR1",90, 0)
	2402	; Store i n ^TMP sor ted by Deb tor, Bill Number and Transacti on #
	2403	"RTN","PRC AACR1",91, 0)
	2404	I PRCASOR T=2 D
	2405	"RTN","PRC AACR1",92, 0)
	2406	.; Print Header
	2407	"RTN","PRC AACR1",93, 0)
	2408	.D PSACRT P2
	2409	"RTN","PRC AACR1",94, 0)
	2410	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	2411	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2412	"RTN","PRC AACR1",95, 0)
	2413	.S PRCADT R=""
	2414	"RTN","PRC AACR1",96, 0)
	2415	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D
	2416	"RTN","PRC AACR1",97, 0)
	2417	..S PRCAB N=""
	2418	"RTN","PRC AACR1",98, 0)
	2419	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D
	2420	"RTN","PRC AACR1",99, 0)
	2421	...S PRCA TN=""
	2422	"RTN","PRC AACR1",100 ,0)
	2423	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D
	2424	"RTN","PRC AACR1",101 ,0)
	2425	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	2426	"RTN","PRC AACR1",102 ,0)
	2427	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2428	"RTN","PRC AACR1",103 ,0)
	2429	....S PRC AIEN=PRCAI EN+1
	2430	"RTN","PRC AACR1",104 ,0)
	2431	....; Add 18 chars of Debtor' s name
	2432	"RTN","PRC AACR1",105 ,0)
	2433	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,18 ),$E(PRCAT EMP,20)=" "
	2434	"RTN","PRC AACR1",106 ,0)
	2435	....; Add Bill Numb er
	2436	"RTN","PRC AACR1",107 ,0)
	2437	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,2 ),$E(PRCAT EMP,33)=" "
	2438	"RTN","PRC AACR1",108 ,0)
	2439	....; Add SSN
	2440	"RTN","PRC AACR1",109 ,0)
	2441	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2442	"RTN","PRC AACR1",110 ,0)
	2443	....; Add Transacti on Number
	2444	"RTN","PRC AACR1",111 ,0)
	2445	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2446	"RTN","PRC AACR1",112 ,0)
	2447	....; Add Auto-Corr ect Date
	2448	"RTN","PRC AACR1",113 ,0)
	2449	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2450	"RTN","PRC AACR1",114 ,0)
	2451	....; Add Auto-Corr ect Reason
	2452	"RTN","PRC AACR1",115 ,0)
	2453	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2454	"RTN","PRC AACR1",116 ,0)
	2455	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2456	"RTN","PRC AACR1",117 ,0)
	2457	....Q
	2458	"RTN","PRC AACR1",118 ,0)
	2459	;
	2460	"RTN","PRC AACR1",119 ,0)
	2461	; Store i n ^TMP sor ted by Aut o-Correct Date, Debt or, Bill N umber and Transacti
	2462	on #
	2463	"RTN","PRC AACR1",120 ,0)
	2464	I PRCASOR T=3 D
	2465	"RTN","PRC AACR1",121 ,0)
	2466	.; Print Header
	2467	"RTN","PRC AACR1",122 ,0)
	2468	.D PSACRT P3
	2469	"RTN","PRC AACR1",123 ,0)
	2470	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	2471	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2472	"RTN","PRC AACR1",124 ,0)
	2473	.S PRCABN =""
	2474	"RTN","PRC AACR1",125 ,0)
	2475	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D
	2476	"RTN","PRC AACR1",126 ,0)
	2477	..S PRCAD TR=""
	2478	"RTN","PRC AACR1",127 ,0)
	2479	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D
	2480	"RTN","PRC AACR1",128 ,0)
	2481	...S PRCA TN=""
	2482	"RTN","PRC AACR1",129 ,0)
	2483	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D
	2484	"RTN","PRC AACR1",130 ,0)
	2485	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	2486	"RTN","PRC AACR1",131 ,0)
	2487	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2488	"RTN","PRC AACR1",132 ,0)
	2489	....S PRC AIEN=PRCAI EN+1
	2490	"RTN","PRC AACR1",133 ,0)
	2491	....; Add Bill Numb er
	2492	"RTN","PRC AACR1",134 ,0)
	2493	....S PRC ATEMP=$P(P RCADATA,U, 1),$E(PRCA TEMP,13)=" "
	2494	"RTN","PRC AACR1",135 ,0)
	2495	....; Add 18 chars of Debtor' s name
	2496	"RTN","PRC AACR1",136 ,0)
	2497	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,33)=" "
	2498	"RTN","PRC AACR1",137 ,0)
	2499	....; Add SSN
	2500	"RTN","PRC AACR1",138 ,0)
	2501	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2502	"RTN","PRC AACR1",139 ,0)
	2503	....; Add Transacti on Number
	2504	"RTN","PRC AACR1",140 ,0)
	2505	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2506	"RTN","PRC AACR1",141 ,0)
	2507	....; Add Auto-Corr ect Date
	2508	"RTN","PRC AACR1",142 ,0)
	2509	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2510	"RTN","PRC AACR1",143 ,0)
	2511	....; Add Auto-Corr ect Reason
	2512	"RTN","PRC AACR1",144 ,0)
	2513	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2514	"RTN","PRC AACR1",145 ,0)
	2515	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2516	"RTN","PRC AACR1",146 ,0)
	2517	....Q
	2518	"RTN","PRC AACR1",147 ,0)
	2519	;
	2520	"RTN","PRC AACR1",148 ,0)
	2521	; Store i n ^TMP sor ted by Tra nsaction, Debtor and #Bill Num ber
	2522	"RTN","PRC AACR1",149 ,0)
	2523	I PRCASOR T=4 D
	2524	"RTN","PRC AACR1",150 ,0)
	2525	.; Print Header
	2526	"RTN","PRC AACR1",151 ,0)
	2527	.D PSACRT P4
	2528	"RTN","PRC AACR1",152 ,0)
	2529	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	2530	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	2531	"RTN","PRC AACR1",153 ,0)
	2532	.S PRCATN =""
	2533	"RTN","PRC AACR1",154 ,0)
	2534	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D
	2535	"RTN","PRC AACR1",155 ,0)
	2536	..S PRCAD TR=""
	2537	"RTN","PRC AACR1",156 ,0)
	2538	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D
	2539	"RTN","PRC AACR1",157 ,0)
	2540	...S PRCA BN=""
	2541	"RTN","PRC AACR1",158 ,0)
	2542	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D
	2543	"RTN","PRC AACR1",159 ,0)
	2544	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	2545	"RTN","PRC AACR1",160 ,0)
	2546	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2547	"RTN","PRC AACR1",161 ,0)
	2548	....S PRC AIEN=PRCAI EN+1
	2549	"RTN","PRC AACR1",162 ,0)
	2550	....; Add Transacti on Number
	2551	"RTN","PRC AACR1",163 ,0)
	2552	....S PRC ATEMP=$J($ P(PRCADATA ,U,1),9),$ E(PRCATEMP ,11)=" "
	2553	"RTN","PRC AACR1",164 ,0)
	2554	....; Add 18 chars of Debtor' s name
	2555	"RTN","PRC AACR1",165 ,0)
	2556	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,31)=" "
	2557	"RTN","PRC AACR1",166 ,0)
	2558	....; Add Bill Numb er
	2559	"RTN","PRC AACR1",167 ,0)
	2560	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,44)=" "
	2561	"RTN","PRC AACR1",168 ,0)
	2562	....; Add SSN
	2563	"RTN","PRC AACR1",169 ,0)
	2564	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,4 ),$E(PRCAT EMP,50)=" "
	2565	"RTN","PRC AACR1",170 ,0)
	2566	....; Add Auto-Corr ect Date
	2567	"RTN","PRC AACR1",171 ,0)
	2568	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2569	"RTN","PRC AACR1",172 ,0)
	2570	....; Add Auto-Corr ect Reason
	2571	"RTN","PRC AACR1",173 ,0)
	2572	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2573	"RTN","PRC AACR1",174 ,0)
	2574	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2575	"RTN","PRC AACR1",175 ,0)
	2576	....Q
	2577	"RTN","PRC AACR1",176 ,0)
	2578	;
	2579	"RTN","PRC AACR1",177 ,0)
	2580	; Display Auto-Corr ect data s orted by A uto-Correc t Reason
	2581	"RTN","PRC AACR1",178 ,0)
	2582	I PRCASOR T=5 D
	2583	"RTN","PRC AACR1",179 ,0)
	2584	.; Print Header
	2585	"RTN","PRC AACR1",180 ,0)
	2586	.D PSACRT P5
	2587	"RTN","PRC AACR1",181 ,0)
	2588	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	2589	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2590	"RTN","PRC AACR1",182 ,0)
	2591	.S PRCAAC D=""
	2592	"RTN","PRC AACR1",183 ,0)
	2593	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D
	2594	"RTN","PRC AACR1",184 ,0)
	2595	..S PRCAD TR=""
	2596	"RTN","PRC AACR1",185 ,0)
	2597	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D
	2598	"RTN","PRC AACR1",186 ,0)
	2599	...S PRCA BN=""
	2600	"RTN","PRC AACR1",187 ,0)
	2601	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2602	"RTN","PRC AACR1",188 ,0)
	2603	....S PRC ATN=""
	2604	"RTN","PRC AACR1",189 ,0)
	2605	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	2606	D
	2607	"RTN","PRC AACR1",190 ,0)
	2608	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	2609	"RTN","PRC AACR1",191 ,0)
	2610	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	2611	"RTN","PRC AACR1",192 ,0)
	2612	.....S PR CAIEN=PRCA IEN+1
	2613	"RTN","PRC AACR1",193 ,0)
	2614	.....; Ad d Auto-Cor rect Date
	2615	"RTN","PRC AACR1",194 ,0)
	2616	.....S PR CATEMP=$P( PRCADATA,U ,1),$E(PRC ATEMP,14)= " "
	2617	"RTN","PRC AACR1",195 ,0)
	2618	.....; Ad d 18 chars of Debtor 's name
	2619	"RTN","PRC AACR1",196 ,0)
	2620	.....S PR CATEMP=PRC ATEMP_$E($ P(PRCADATA ,U,2),1,18 ),$E(PRCAT EMP,34)=" "
	2621	"RTN","PRC AACR1",197 ,0)
	2622	.....; Ad d Bill Num ber
	2623	"RTN","PRC AACR1",198 ,0)
	2624	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 3),$E(PRCA TEMP,47)=" "
	2625	"RTN","PRC AACR1",199 ,0)
	2626	.....; Ad d SSN
	2627	"RTN","PRC AACR1",200 ,0)
	2628	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 4),$E(PRCA TEMP,53)=" "
	2629	"RTN","PRC AACR1",201 ,0)
	2630	.....; Ad d Transact ion Number
	2631	"RTN","PRC AACR1",202 ,0)
	2632	.....S PR CATEMP=PRC ATEMP_$J($ P(PRCADATA ,U,5),9),$ E(PRCATEMP ,64)=" "
	2633	"RTN","PRC AACR1",203 ,0)
	2634	.....; Ad d Auto-Cor rect Reaso n
	2635	"RTN","PRC AACR1",204 ,0)
	2636	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 6)
	2637	"RTN","PRC AACR1",205 ,0)
	2638	.....S ^T MP("PRCAAC R1",$J,PRC AIEN)=PRCA TEMP
	2639	"RTN","PRC AACR1",206 ,0)
	2640	.....Q
	2641	"RTN","PRC AACR1",207 ,0)
	2642	;
	2643	"RTN","PRC AACR1",208 ,0)
	2644	; Send Ma ilMan mess age with N o Forward
	2645	"RTN","PRC AACR1",209 ,0)
	2646	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ
	2647	"RTN","PRC AACR1",210 ,0)
	2648	I PRCASOR T=1 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N REASON)
	2649	"
	2650	"RTN","PRC AACR1",211 ,0)
	2651	I PRCASOR T=2 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY DEBT OR)"
	2652	"RTN","PRC AACR1",212 ,0)
	2653	I PRCASOR T=3 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY BILL #)"
	2654	"RTN","PRC AACR1",213 ,0)
	2655	I PRCASOR T=4 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY TRAN SACTION NU MBER)"
	2656	"RTN","PRC AACR1",214 ,0)
	2657	I PRCASOR T=5 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N DATE)"
	2658	"RTN","PRC AACR1",215 ,0)
	2659	S XMTO(DU Z)=""
	2660	"RTN","PRC AACR1",216 ,0)
	2661	S XMBODY= "^TMP(""PR CAACR1"",$ J)"
	2662	"RTN","PRC AACR1",217 ,0)
	2663	S XMINSTR ("FLAGS")= "X"
	2664	"RTN","PRC AACR1",218 ,0)
	2665	S XMDUZ=D UZ
	2666	"RTN","PRC AACR1",219 ,0)
	2667	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	2668	"RTN","PRC AACR1",220 ,0)
	2669	D HOME^%Z IS
	2670	"RTN","PRC AACR1",221 ,0)
	2671	K IO("Q") ,POP
	2672	"RTN","PRC AACR1",222 ,0)
	2673	K ^TMP("P RCAACR",$J )
	2674	"RTN","PRC AACR1",223 ,0)
	2675	K ^TMP("P RCAACR1",$ J)
	2676	"RTN","PRC AACR1",224 ,0)
	2677	K PRCABDT ,PRCAEDT,P RCASORT
	2678	"RTN","PRC AACR1",225 ,0)
	2679	Q
	2680	"RTN","PRC AACR1",226 ,0)
	2681	;
	2682	"RTN","PRC AACR1",227 ,0)
	2683	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	2684	"RTN","PRC AACR1",228 ,0)
	2685	S PAGE=PA GE+1
	2686	"RTN","PRC AACR1",229 ,0)
	2687	S PRCAIEN =PRCAIEN+1
	2688	"RTN","PRC AACR1",230 ,0)
	2689	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2690	"RTN","PRC AACR1",231 ,0)
	2691	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2692	"RTN","PRC AACR1",232 ,0)
	2693	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION REASON)"
	2694	"RTN","PRC AACR1",233 ,0)
	2695	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2696	"RTN","PRC AACR1",234 ,0)
	2697	S PRCAIEN =PRCAIEN+1
	2698	"RTN","PRC AACR1",235 ,0)
	2699	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2700	"RTN","PRC AACR1",236 ,0)
	2701	S PRCAIEN =PRCAIEN+1
	2702	"RTN","PRC AACR1",237 ,0)
	2703	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2704	"RTN","PRC AACR1",238 ,0)
	2705	S PRCAIEN =PRCAIEN+1
	2706	"RTN","PRC AACR1",239 ,0)
	2707	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2708	"RTN","PRC AACR1",240 ,0)
	2709	S PRCADAT A="AUTO-C REASON D EBTOR S SN BILL NO. TR ANS NUM
	2710	AUTO-C DAT E"
	2711	"RTN","PRC AACR1",241 ,0)
	2712	S PRCAIEN =PRCAIEN+1
	2713	"RTN","PRC AACR1",242 ,0)
	2714	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2715	"RTN","PRC AACR1",243 ,0)
	2716	S PRCADAT A="------- ------- - ---------- ------- - --- ----- ------ -- -------
	2717	---------- --"
	2718	"RTN","PRC AACR1",244 ,0)
	2719	S PRCAIEN =PRCAIEN+1
	2720	"RTN","PRC AACR1",245 ,0)
	2721	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2722	"RTN","PRC AACR1",246 ,0)
	2723	Q
	2724	"RTN","PRC AACR1",247 ,0)
	2725	;
	2726	"RTN","PRC AACR1",248 ,0)
	2727	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2728	"RTN","PRC AACR1",249 ,0)
	2729	S PAGE=PA GE+1
	2730	"RTN","PRC AACR1",250 ,0)
	2731	S PRCAIEN =PRCAIEN+1
	2732	"RTN","PRC AACR1",251 ,0)
	2733	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2734	"RTN","PRC AACR1",252 ,0)
	2735	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2736	"RTN","PRC AACR1",253 ,0)
	2737	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY DEBTOR )"
	2738	"RTN","PRC AACR1",254 ,0)
	2739	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2740	"RTN","PRC AACR1",255 ,0)
	2741	S PRCAIEN =PRCAIEN+1
	2742	"RTN","PRC AACR1",256 ,0)
	2743	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2744	"RTN","PRC AACR1",257 ,0)
	2745	S PRCAIEN =PRCAIEN+1
	2746	"RTN","PRC AACR1",258 ,0)
	2747	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2748	"RTN","PRC AACR1",259 ,0)
	2749	S PRCAIEN =PRCAIEN+1
	2750	"RTN","PRC AACR1",260 ,0)
	2751	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2752	"RTN","PRC AACR1",261 ,0)
	2753	S PRCADAT A="DEBTOR BILL NO . SSN TRANS NU M AUTO-C DATE AU
	2754	TO-C REASO N"
	2755	"RTN","PRC AACR1",262 ,0)
	2756	S PRCAIEN =PRCAIEN+1
	2757	"RTN","PRC AACR1",263 ,0)
	2758	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2759	"RTN","PRC AACR1",264 ,0)
	2760	S PRCADAT A="------- ---------- - ------- ---- ---- -------- - ------- ----- --
	2761	---------- --"
	2762	"RTN","PRC AACR1",265 ,0)
	2763	S PRCAIEN =PRCAIEN+1
	2764	"RTN","PRC AACR1",266 ,0)
	2765	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2766	"RTN","PRC AACR1",267 ,0)
	2767	Q
	2768	"RTN","PRC AACR1",268 ,0)
	2769	;
	2770	"RTN","PRC AACR1",269 ,0)
	2771	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2772	"RTN","PRC AACR1",270 ,0)
	2773	S PAGE=PA GE+1
	2774	"RTN","PRC AACR1",271 ,0)
	2775	S PRCAIEN =PRCAIEN+1
	2776	"RTN","PRC AACR1",272 ,0)
	2777	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2778	"RTN","PRC AACR1",273 ,0)
	2779	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2780	"RTN","PRC AACR1",274 ,0)
	2781	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY BILL # )"
	2782	"RTN","PRC AACR1",275 ,0)
	2783	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2784	"RTN","PRC AACR1",276 ,0)
	2785	S PRCAIEN =PRCAIEN+1
	2786	"RTN","PRC AACR1",277 ,0)
	2787	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2788	"RTN","PRC AACR1",278 ,0)
	2789	S PRCAIEN =PRCAIEN+1
	2790	"RTN","PRC AACR1",279 ,0)
	2791	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2792	"RTN","PRC AACR1",280 ,0)
	2793	S PRCAIEN =PRCAIEN+1
	2794	"RTN","PRC AACR1",281 ,0)
	2795	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2796	"RTN","PRC AACR1",282 ,0)
	2797	S PRCADAT A="BILL NO . DEBT OR SSN TRANS NU M AUTO-C DATE AU
	2798	TO-C REASO N"
	2799	"RTN","PRC AACR1",283 ,0)
	2800	S PRCAIEN =PRCAIEN+1
	2801	"RTN","PRC AACR1",284 ,0)
	2802	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2803	"RTN","PRC AACR1",285 ,0)
	2804	S PRCADAT A="------- ---- ---- ---------- ---- ---- -------- - ------- ----- --
	2805	---------- --"
	2806	"RTN","PRC AACR1",286 ,0)
	2807	S PRCAIEN =PRCAIEN+1
	2808	"RTN","PRC AACR1",287 ,0)
	2809	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2810	"RTN","PRC AACR1",288 ,0)
	2811	Q
	2812	"RTN","PRC AACR1",289 ,0)
	2813	;
	2814	"RTN","PRC AACR1",290 ,0)
	2815	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2816	"RTN","PRC AACR1",291 ,0)
	2817	S PAGE=PA GE+1
	2818	"RTN","PRC AACR1",292 ,0)
	2819	S PRCAIEN =PRCAIEN+1
	2820	"RTN","PRC AACR1",293 ,0)
	2821	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2822	"RTN","PRC AACR1",294 ,0)
	2823	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2824	"RTN","PRC AACR1",295 ,0)
	2825	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY TRANSA CTION NUMB ER)"
	2826	"RTN","PRC AACR1",296 ,0)
	2827	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2828	"RTN","PRC AACR1",297 ,0)
	2829	S PRCAIEN =PRCAIEN+1
	2830	"RTN","PRC AACR1",298 ,0)
	2831	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2832	"RTN","PRC AACR1",299 ,0)
	2833	S PRCAIEN =PRCAIEN+1
	2834	"RTN","PRC AACR1",300 ,0)
	2835	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2836	"RTN","PRC AACR1",301 ,0)
	2837	S PRCAIEN =PRCAIEN+1
	2838	"RTN","PRC AACR1",302 ,0)
	2839	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2840	"RTN","PRC AACR1",303 ,0)
	2841	S PRCADAT A="TRANS N UM DEBTOR BILL N O. SSN AUTO-C DATE AU
	2842	TO-C REASO N"
	2843	"RTN","PRC AACR1",304 ,0)
	2844	S PRCAIEN =PRCAIEN+1
	2845	"RTN","PRC AACR1",305 ,0)
	2846	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2847	"RTN","PRC AACR1",306 ,0)
	2848	S PRCADAT A="------- -- ------ ---------- -- ------ ----- --- - ------- ----- --
	2849	---------- --"
	2850	"RTN","PRC AACR1",307 ,0)
	2851	S PRCAIEN =PRCAIEN+1
	2852	"RTN","PRC AACR1",308 ,0)
	2853	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2854	"RTN","PRC AACR1",309 ,0)
	2855	Q
	2856	"RTN","PRC AACR1",310 ,0)
	2857	;
	2858	"RTN","PRC AACR1",311 ,0)
	2859	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	2860	"RTN","PRC AACR1",312 ,0)
	2861	S PAGE=PA GE+1
	2862	"RTN","PRC AACR1",313 ,0)
	2863	S PRCAIEN =PRCAIEN+1
	2864	"RTN","PRC AACR1",314 ,0)
	2865	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2866	"RTN","PRC AACR1",315 ,0)
	2867	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2868	"RTN","PRC AACR1",316 ,0)
	2869	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION DATE)"
	2870	"RTN","PRC AACR1",317 ,0)
	2871	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2872	"RTN","PRC AACR1",318 ,0)
	2873	S PRCAIEN =PRCAIEN+1
	2874	"RTN","PRC AACR1",319 ,0)
	2875	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2876	"RTN","PRC AACR1",320 ,0)
	2877	S PRCAIEN =PRCAIEN+1
	2878	"RTN","PRC AACR1",321 ,0)
	2879	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2880	"RTN","PRC AACR1",322 ,0)
	2881	S PRCAIEN =PRCAIEN+1
	2882	"RTN","PRC AACR1",323 ,0)
	2883	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2884	"RTN","PRC AACR1",324 ,0)
	2885	S PRCADAT A="AUTO-C DATE DEB TOR BIL L NO. SSN TRAN S NUM AU
	2886	TO-C REASO N"
	2887	"RTN","PRC AACR1",325 ,0)
	2888	S PRCAIEN =PRCAIEN+1
	2889	"RTN","PRC AACR1",326 ,0)
	2890	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2891	"RTN","PRC AACR1",327 ,0)
	2892	S PRCADAT A="------- ----- --- ---------- ----- --- -------- ---- ---- ----- --
	2893	---------- --"
	2894	"RTN","PRC AACR1",328 ,0)
	2895	S PRCAIEN =PRCAIEN+1
	2896	"RTN","PRC AACR1",329 ,0)
	2897	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2898	"RTN","PRC AACR1",330 ,0)
	2899	Q
	2900	"RTN","PRC AACR1",331 ,0)
	2901	;
	2902	"RTN","PRC AACR1",332 ,0)
	2903	EXIT ;
	2904	"RTN","PRC AACR1",333 ,0)
	2905	Q
	2906	"RTN","PRC ACPS1")
	2907	0^6^B19128 158^n/a
	2908	"RTN","PRC ACPS1",1,0 )
	2909	PRCACPS1 ; ALBANY/BDB -PATIENT S TATEMENTS UPDATE ;03 /25/16 3:3 4 PM
	2910	"RTN","PRC ACPS1",2,0 )
	2911	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 118
	2912	"RTN","PRC ACPS1",3,0 )
	2913	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2914	"RTN","PRC ACPS1",4,0 )
	2915	;
	2916	"RTN","PRC ACPS1",5,0 )
	2917	Q
	2918	"RTN","PRC ACPS1",6,0 )
	2919	;
	2920	"RTN","PRC ACPS1",7,0 )
	2921	ENTER ;cal led by the cbs night ly account update pr ogram opti on
	2922	"RTN","PRC ACPS1",8,0 )
	2923	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K,ZTSAVE,R CFULL
	2924	"RTN","PRC ACPS1",9,0 )
	2925	S RCFULL= 1 ;run the full debt or list
	2926	"RTN","PRC ACPS1",10, 0)
	2927	W !,"Queu e the pati ent statem ent update program t o run:"
	2928	"RTN","PRC ACPS1",11, 0)
	2929	S ZTDESC= "Consolida ted Billin g Statemen t Update"
	2930	"RTN","PRC ACPS1",12, 0)
	2931	S ZTRTN=" DEBTOR^PRC ACPS1",ZTI O="",ZTSAV E("RCFULL" )=""
	2932	"RTN","PRC ACPS1",13, 0)
	2933	D ^%ZTLOA D
	2934	"RTN","PRC ACPS1",14, 0)
	2935	Q
	2936	"RTN","PRC ACPS1",15, 0)
	2937	;
	2938	"RTN","PRC ACPS1",16, 0)
	2939	DEBTOR ;ca lled by rc cpcbj
	2940	"RTN","PRC ACPS1",17, 0)
	2941	N DEBTOR, X,DEBTOR0, DEBTOR1,DE BTOR7,CBSS TOT,BALDT
	2942	"RTN","PRC ACPS1",18, 0)
	2943	K ^XTMP(" RCCBSS",$J )
	2944	"RTN","PRC ACPS1",19, 0)
	2945	S ^XTMP(" RCCBSS",$J ,0)=$$FMAD D^XLFDT(DT ,3)_"^"_DT
	2946	"RTN","PRC ACPS1",20, 0)
	2947	S DEBTOR= 0
	2948	"RTN","PRC ACPS1",21, 0)
	2949	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	2950	"RTN","PRC ACPS1",22, 0)
	2951	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) ),DEBTOR7= $G(^(7)),B ALDT=""
	2952	"RTN","PRC ACPS1",23, 0)
	2953	.Q:$P(DEB TOR0,"^")' ["DPT("
	2954	"RTN","PRC ACPS1",24, 0)
	2955	.I +$$GET ICN^MPIF00 1(+DEBTOR0 )<0 Q ;qu it if no i cn
	2956	"RTN","PRC ACPS1",25, 0)
	2957	.S BALDT= $$BILLS(DE BTOR) Q:$P (BALDT,U,2 )=9999999
	2958	"RTN","PRC ACPS1",26, 0)
	2959	.D RECPD
	2960	"RTN","PRC ACPS1",27, 0)
	2961	D COMPILE
	2962	"RTN","PRC ACPS1",28, 0)
	2963	K ^XTMP(" RCCBSS",$J )
	2964	"RTN","PRC ACPS1",29, 0)
	2965	Q
	2966	"RTN","PRC ACPS1",30, 0)
	2967	;
	2968	"RTN","PRC ACPS1",31, 0)
	2969	RECPD(BILL ) ;add a n ew account update
	2970	"RTN","PRC ACPS1",32, 0)
	2971	N REC,RCD FN
	2972	"RTN","PRC ACPS1",33, 0)
	2973	S RCDFN=+ DEBTOR0
	2974	"RTN","PRC ACPS1",34, 0)
	2975	S REC="PD ^"_$$GETIC N^MPIF001( RCDFN)_"^"
	2976	"RTN","PRC ACPS1",35, 0)
	2977	S REC=REC _$$SITE^RC MSITE_$$UP ^XLFSTR($S (($$SSN^RC FN01(DEBTO R)]"")&($$ NAM^RCFN0
	2978	1(DEBTOR)] ""):$TR($E ($$SSN^RCF N01(DEBTOR ),1,9)_$E( $P($$NAM^R CFN01(DEBT OR),","),
	2979	1,5)," "," "),1:""))_ "^"
	2980	"RTN","PRC ACPS1",36, 0)
	2981	S REC=REC _RCDFN_"^"
	2982	"RTN","PRC ACPS1",37, 0)
	2983	S BALDT=$ $BILLS(DEB TOR)
	2984	"RTN","PRC ACPS1",38, 0)
	2985	S CBSSTOT =+$P(DEBTO R7,U,6)
	2986	"RTN","PRC ACPS1",39, 0)
	2987	I '$G(RCF ULL) Q:CBS STOT=+BALD T
	2988	"RTN","PRC ACPS1",40, 0)
	2989	S $P(^RCD (340,DEBTO R,7),U,6)= +BALDT
	2990	"RTN","PRC ACPS1",41, 0)
	2991	S REC=REC _$$HEX(+BA LDT)_"^"_$ P(BALDT,U, 2)_"^\|"
	2992	"RTN","PRC ACPS1",42, 0)
	2993	S ^XTMP(" RCCBSS",$J ,DEBTOR)=R EC
	2994	"RTN","PRC ACPS1",43, 0)
	2995	Q
	2996	"RTN","PRC ACPS1",44, 0)
	2997	;
	2998	"RTN","PRC ACPS1",45, 0)
	2999	BILLS(DEBT OR) ;get o ldest bill date
	3000	"RTN","PRC ACPS1",46, 0)
	3001	N BALTOT, BILL,BN0,P RPDT,OLDDT
	3002	"RTN","PRC ACPS1",47, 0)
	3003	S BILL=""
	3004	"RTN","PRC ACPS1",48, 0)
	3005	S BALTOT= 0,OLDDT=99 99999
	3006	"RTN","PRC ACPS1",49, 0)
	3007	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	3008	"RTN","PRC ACPS1",50, 0)
	3009	.Q:$D(^PR CA(430,"TC SP",BILL)) ;cs chec k
	3010	"RTN","PRC ACPS1",51, 0)
	3011	.S BN0=$G (^PRCA(430 ,BILL,0))
	3012	"RTN","PRC ACPS1",52, 0)
	3013	.I $P(BN0 ,U,8)'=16 Q ;not ac tive
	3014	"RTN","PRC ACPS1",53, 0)
	3015	.S BALTOT =BALTOT+$$ GET1^DIQ(4 30,BILL,11 )
	3016	"RTN","PRC ACPS1",54, 0)
	3017	.S PRPDT= $P(^PRCA(4 30,BILL,0) ,U,10) I + PRPDT,OLDD T>PRPDT S OLDDT=PRPD T
	3018	"RTN","PRC ACPS1",55, 0)
	3019	Q BALTOT_ U_$S(OLDDT '=9999999: $$DTMDY(OL DDT),1:"")
	3020	"RTN","PRC ACPS1",56, 0)
	3021	;
	3022	"RTN","PRC ACPS1",57, 0)
	3023	COMPILE ;
	3024	"RTN","PRC ACPS1",58, 0)
	3025	N RCMSG,D CNTR,REC,R ECC,AMOUNT ,RCNTR,ACT ION,SEQ,SE QTOT
	3026	"RTN","PRC ACPS1",59, 0)
	3027	S DCNTR=0 ,REC=1,REC C=0,AMOUNT =0,SEQ=1,S EQTOT=0
	3028	"RTN","PRC ACPS1",60, 0)
	3029	F S DCNT R=$O(^XTMP ("RCCBSS", $J,DCNTR)) S:+DCNTR' >0 SEQTOT= SEQ Q:+DCN TR'>0 D
	3030	"RTN","PRC ACPS1",61, 0)
	3031	.I REC>45 0 D
	3032	"RTN","PRC ACPS1",62, 0)
	3033	..S ^XTMP ("RCCBSS", $J,"BUILD" ,SEQ,REC)= ^XTMP("RCC BSS",$J,"B UILD",SEQ, REC)_"~"
	3034	"RTN","PRC ACPS1",63, 0)
	3035	..D HEADE R
	3036	"RTN","PRC ACPS1",64, 0)
	3037	..D AITCM SG
	3038	"RTN","PRC ACPS1",65, 0)
	3039	..S REC=0 ,SEQ=SEQ+1
	3040	"RTN","PRC ACPS1",66, 0)
	3041	..Q
	3042	"RTN","PRC ACPS1",67, 0)
	3043	.S REC=RE C+1
	3044	"RTN","PRC ACPS1",68, 0)
	3045	.S ^XTMP( "RCCBSS",$ J,"BUILD", SEQ,REC)=^ XTMP("RCCB SS",$J,DCN TR)
	3046	"RTN","PRC ACPS1",69, 0)
	3047	.Q
	3048	"RTN","PRC ACPS1",70, 0)
	3049	Q:'$D(^XT MP("RCCBSS ",$J,"BUIL D",SEQ))
	3050	"RTN","PRC ACPS1",71, 0)
	3051	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,REC)=^X TMP("RCCBS S",$J,"BUI LD",SEQ,RE C)_"~"
	3052	"RTN","PRC ACPS1",72, 0)
	3053	D HEADER
	3054	"RTN","PRC ACPS1",73, 0)
	3055	D AITCMSG
	3056	"RTN","PRC ACPS1",74, 0)
	3057	Q
	3058	"RTN","PRC ACPS1",75, 0)
	3059	;
	3060	"RTN","PRC ACPS1",76, 0)
	3061	AITCMSG ;
	3062	"RTN","PRC ACPS1",77, 0)
	3063	N XMY,XMD UZ,XMSUB,X MTEXT
	3064	"RTN","PRC ACPS1",78, 0)
	3065	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3066	"RTN","PRC ACPS1",79, 0)
	3067	S XMDUZ=" AR PACKAGE "
	3068	"RTN","PRC ACPS1",80, 0)
	3069	;S XMY("X XX@Q-CPT URL ")=""
	3070	"RTN","PRC ACPS1",81, 0)
	3071	S X=$O(^R CT(349.1," B","PU",0) )
	3072	"RTN","PRC ACPS1",82, 0)
	3073	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^")_" @"_$P($G(
	3074	^RCT(349.1 ,+X,3)),"^ ",3) S:$P( X,"@",2)]" " XMY(X)=" "
	3075	"RTN","PRC ACPS1",83, 0)
	3076	S XMY("G. PRCACPS")= ""
	3077	"RTN","PRC ACPS1",84, 0)
	3078	S XMSUB=S ITE_"/CBSS TRANSMISS ION/BATCH# : "_SEQ
	3079	"RTN","PRC ACPS1",85, 0)
	3080	S XMTEXT= "^XTMP(""R CCBSS"","_ $J_",""BUI LD"","_SEQ _","
	3081	"RTN","PRC ACPS1",86, 0)
	3082	D ^XMD
	3083	"RTN","PRC ACPS1",87, 0)
	3084	K ^XTMP(" RCCBSS",$J ,"BUILD",S EQ)
	3085	"RTN","PRC ACPS1",88, 0)
	3086	Q
	3087	"RTN","PRC ACPS1",89, 0)
	3088	;
	3089	"RTN","PRC ACPS1",90, 0)
	3090	HEADER ;
	3091	"RTN","PRC ACPS1",91, 0)
	3092	;incremen t batch se quence num ber, build new heade r
	3093	"RTN","PRC ACPS1",92, 0)
	3094	N RCMSG,S ITE
	3095	"RTN","PRC ACPS1",93, 0)
	3096	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3097	"RTN","PRC ACPS1",94, 0)
	3098	S RCMSG=" PU"_"^"_SE Q_"^"_SEQT OT_"^"_(RE C-1)_"^"_S ITE_"^"_$$ DTMDY(DT)_ "^\|"
	3099	"RTN","PRC ACPS1",95, 0)
	3100	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,1)=RCMS G
	3101	"RTN","PRC ACPS1",96, 0)
	3102	Q
	3103	"RTN","PRC ACPS1",97, 0)
	3104	;
	3105	"RTN","PRC ACPS1",98, 0)
	3106	HEX(AMT) ; sets up am ount forma tted as 99 9999999V99 S w/no lea ding blank s and tra
	3107	iling sign
	3108	"RTN","PRC ACPS1",99, 0)
	3109	I $G(AMT) '?.1"-".N. 1".".N S A MT="" G Q
	3110	"RTN","PRC ACPS1",100 ,0)
	3111	S AMT=$TR ($J(AMT,9, 2)," ","")
	3112	"RTN","PRC ACPS1",101 ,0)
	3113	I $E(AMT) ="-" S AMT =$E(AMT,2, 99)_$E(AMT ,1)
	3114	"RTN","PRC ACPS1",102 ,0)
	3115	E S AMT= AMT_"+"
	3116	"RTN","PRC ACPS1",103 ,0)
	3117	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	3118	"RTN","PRC ACPS1",104 ,0)
	3119	Q Q AMT
	3120	"RTN","PRC ACPS1",105 ,0)
	3121	;
	3122	"RTN","PRC ACPS1",106 ,0)
	3123	DTMDY(DAT) ;Changes date from fm to mmdd yyyy forma t
	3124	"RTN","PRC ACPS1",107 ,0)
	3125	N YR
	3126	"RTN","PRC ACPS1",108 ,0)
	3127	I '$G(DAT ) G QDAT
	3128	"RTN","PRC ACPS1",109 ,0)
	3129	S YR=$E(( $E(DAT,1,3 )+1700),1, 2)
	3130	"RTN","PRC ACPS1",110 ,0)
	3131	Q $E(DAT, 4,5)_$E(DA T,6,7)_$G( YR)_$E(DAT ,2,3)
	3132	"RTN","PRC ACPS1",111 ,0)
	3133	QDAT Q ""
	3134	"RTN","PRC ACPS1",112 ,0)
	3135	;
	3136	"RTN","PRC ACPS1",113 ,0)
	3137	BLANK(X) ; returns 'x ' blank sp aces
	3138	"RTN","PRC ACPS1",114 ,0)
	3139	N BLANK
	3140	"RTN","PRC ACPS1",115 ,0)
	3141	S BLANK=" ",$P(BLANK ," ",X+1)= ""
	3142	"RTN","PRC ACPS1",116 ,0)
	3143	Q BLANK
	3144	"RTN","PRC ACPS1",117 ,0)
	3145	;
	3146	"RTN","PRC ACPS1",118 ,0)
	3147	RJZF(X,Y) ;right jus tify zero fill width Y
	3148	"RTN","PRC ACPS1",119 ,0)
	3149	S X=$E("0 0000000000 0",1,Y-$L( X))_X
	3150	"RTN","PRC ACPS1",120 ,0)
	3151	Q X
	3152	"RTN","PRC ACPS1",121 ,0)
	3153	;
	3154	"RTN","PRC ACPS1",122 ,0)
	3155	LJSF(X,Y) ;left just ified spac e filled
	3156	"RTN","PRC ACPS1",123 ,0)
	3157	S X=$E(X, 1,Y)
	3158	"RTN","PRC ACPS1",124 ,0)
	3159	S X=X_$$B LANK(Y-$L( X))
	3160	"RTN","PRC ACPS1",125 ,0)
	3161	Q X
	3162	"RTN","PRC ACPS1",126 ,0)
	3163	;
	3164	"RTN","PRC ACPS1",127 ,0)
	3165	JD() ; ret urns today 's Julian date YDOY
	3166	"RTN","PRC ACPS1",128 ,0)
	3167	N XMDDD,X MNOW,XMDT
	3168	"RTN","PRC ACPS1",129 ,0)
	3169	S XMNOW=$ $NOW^XLFDT
	3170	"RTN","PRC ACPS1",130 ,0)
	3171	S XMDT=$E (XMNOW,1,7 )
	3172	"RTN","PRC ACPS1",131 ,0)
	3173	S XMDDD=$ $RJ^XLFSTR ($$FMDIFF^ XLFDT(XMDT ,$E(XMDT,1 ,3)_"0101" ,1)+1,3,"0 ")
	3174	"RTN","PRC ACPS1",132 ,0)
	3175	Q $E(DT,3 )_XMDDD
	3176	"RTN","PRC ACPS1",133 ,0)
	3177	;
	3178	"RTN","PRC ACPS1",134 ,0)
	3179	AMOUNT(X) ;changes a mount to z ero filled , right ju stified
	3180	"RTN","PRC ACPS1",135 ,0)
	3181	S:X<0 X=- X
	3182	"RTN","PRC ACPS1",136 ,0)
	3183	S X=$TR($ J(X,0,2)," .")
	3184	"RTN","PRC ACPS1",137 ,0)
	3185	S X=$E("0 0000000000 0",1,14-$L (X))_X
	3186	"RTN","PRC ACPS1",138 ,0)
	3187	Q X
	3188	"RTN","PRC ACPS1",139 ,0)
	3189	;
	3190	"RTN","PRC AG")
	3191	0^17^B4802 8538^B2201 6512
	3192	"RTN","PRC AG",1,0)
	3193	PRCAG ;WAS H-ISC@ALTO ONA,PA/CMS -Reprint S tatement/L etter Opti on Entries ;8/23/93
	3194	2:42 PM
	3195	"RTN","PRC AG",2,0)
	3196	V ;;4.5;Ac counts Rec eivable; 149,165,19 8,313;Ma r 20, 1995 ;Build 118
	3197	"RTN","PRC AG",3,0)
	3198	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	3199	"RTN","PRC AG",4,0)
	3200	REP ;ENTRY FROM REPR INT PAT ST ATEMENT
	3201	"RTN","PRC AG",5,0)
	3202	NEW BEG,E ND,DAT,DAT E,DEB,DIC, HDAT,IOP,S ITE,TYP,X, Y,ZTDESC,Z TRTN,ZTSAV E,SDT,%ZI
	3203	S,POP,ZTIO
	3204	"RTN","PRC AG",6,0)
	3205	W !!
	3206	"RTN","PRC AG",7,0)
	3207	ADT ; PRC A4.5313 - Build an d print a list of av ailable da tes for Pa tient Sta
	3208	tements wi thin the l ast month
	3209	"RTN","PRC AG",8,0)
	3210	W !,"Thes e dates in the previ ous month contain Pa tient Stat ements: "
	3211	"RTN","PRC AG",9,0)
	3212	S DAT="" F S DAT=$ O(^RCPS(34 9.2,"STDT" ,DAT)) Q:D AT="" I $ D(^RC(341, "STDT",DA
	3213	T)) W !,$$ DATE^RCCPC PS1(DAT)
	3214	"RTN","PRC AG",10,0)
	3215	W !!
	3216	"RTN","PRC AG",11,0)
	3217	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	3218	"RTN","PRC AG",12,0)
	3219	S DIR(0)= "DAO^^K:'$ D(^RC(341, ""STDT"",Y )) X"
	3220	"RTN","PRC AG",13,0)
	3221	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	3222	"RTN","PRC AG",14,0)
	3223	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	3224	"RTN","PRC AG",15,0)
	3225	D ^DIR
	3226	"RTN","PRC AG",16,0)
	3227	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	3228	"RTN","PRC AG",17,0)
	3229	S SDT=Y
	3230	"RTN","PRC AG",18,0)
	3231	W !!,"NOT E: The ran ge is in p rint order not alpha betic!",!
	3232	"RTN","PRC AG",19,0)
	3233	S X=""
	3234	"RTN","PRC AG",20,0)
	3235	S BEG=$O( ^RC(341,"S TDT",SDT," "))
	3236	"RTN","PRC AG",21,0)
	3237	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	3238	"RTN","PRC AG",22,0)
	3239	S DIR(0)= "YAO"
	3240	"RTN","PRC AG",23,0)
	3241	S DIR("B" )="N"
	3242	"RTN","PRC AG",24,0)
	3243	S DIR("A" )="Do you want to St art with a Specific Patient? "
	3244	"RTN","PRC AG",25,0)
	3245	D ^DIR
	3246	"RTN","PRC AG",26,0)
	3247	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	3248	"RTN","PRC AG",27,0)
	3249	I Y=0 S X =""
	3250	"RTN","PRC AG",28,0)
	3251	I Y=1 S X =$$SELNAME (SDT)
	3252	"RTN","PRC AG",29,0)
	3253	I X=-1 Q
	3254	"RTN","PRC AG",30,0)
	3255	I X'="" S BEG=X
	3256	"RTN","PRC AG",31,0)
	3257	; PRCA4. 5313 - Us e statemen t date cro ss-referen ce to prov ide a pati ent list
	3258	"RTN","PRC AG",32,0)
	3259	S X=""
	3260	"RTN","PRC AG",33,0)
	3261	S END=$O( ^RC(341,"S TDT",SDT," "),-1)
	3262	"RTN","PRC AG",34,0)
	3263	W !,"Endi ng Patient Bill must be printe d after th e Starting Patient B ill.",!
	3264	"RTN","PRC AG",35,0)
	3265	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	3266	"RTN","PRC AG",36,0)
	3267	S DIR(0)= "YAO"
	3268	"RTN","PRC AG",37,0)
	3269	S DIR("B" )="N"
	3270	"RTN","PRC AG",38,0)
	3271	S DIR("A" )="Do you want to En d with a S pecific Pa tient? "
	3272	"RTN","PRC AG",39,0)
	3273	D ^DIR
	3274	"RTN","PRC AG",40,0)
	3275	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	3276	"RTN","PRC AG",41,0)
	3277	I Y=0 S X =""
	3278	"RTN","PRC AG",42,0)
	3279	I Y=1 S X =$$SELNAME (SDT)
	3280	"RTN","PRC AG",43,0)
	3281	I X=-1 Q
	3282	"RTN","PRC AG",44,0)
	3283	I X'="" S END=X
	3284	"RTN","PRC AG",45,0)
	3285	I END>0,E ND<BEG W * 7,!,"Endin g bill is before sta rting bill !" G ADT
	3286	"RTN","PRC AG",46,0)
	3287	S HDAT=99 99999-SDT
	3288	"RTN","PRC AG",47,0)
	3289	REPD W !! S %ZIS="QN ",IOP="Q", %ZIS("B")= $P($G(^RC( 342,1,0)), U,8) D ^%Z IS G:POP
	3290	REPQ
	3291	"RTN","PRC AG",48,0)
	3292	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REP D
	3293	"RTN","PRC AG",49,0)
	3294	S ZTRTN=" REP^PRCAGS ",ZTDESC=" Reprint AR Patient S tatements" ,ZTSAVE("B EG")="",Z
	3295	TSAVE("END ")="",ZTSA VE("HDAT") ="" D ^%ZT LOAD
	3296	"RTN","PRC AG",50,0)
	3297	REPQ ; PRC A4.5313 - Kill TMP ($J Lists prior to q uit
	3298	"RTN","PRC AG",51,0)
	3299	D ^%ZISC
	3300	"RTN","PRC AG",52,0)
	3301	K ^TMP($J ,"LISTNAME "),^TMP($J ,"LISTCNT" )
	3302	"RTN","PRC AG",53,0)
	3303	Q
	3304	"RTN","PRC AG",54,0)
	3305	UB ;ENTRY FROM REPRI NT UB BILL S
	3306	"RTN","PRC AG",55,0)
	3307	S ETY="UB " ;set eve nt type to UB and us e REB sub- routine
	3308	"RTN","PRC AG",56,0)
	3309	REB ;ENTRY FROM REPR INT FOLLOW -UP LETTER S
	3310	"RTN","PRC AG",57,0)
	3311	NEW BEG,E ND,DAT,DAT E,DEB,DIC, IOP,SITE,T YP,X,Y,ZTD ESC,ZTRTN, ZTSAVE,%DT ,DA,DIR,D
	3312	TOUT
	3313	"RTN","PRC AG",58,0)
	3314	D SITE^PR CAGU
	3315	"RTN","PRC AG",59,0)
	3316	S:'$D(ETY ) ETY="FL"
	3317	"RTN","PRC AG",60,0)
	3318	REBDT S %D T="AEXP",% DT(0)="-NO W",%DT("A" )="Enter a Date to R eprint: " D ^%DT G:
	3319	Y<1 REBQ
	3320	"RTN","PRC AG",61,0)
	3321	S Y=$P(Y, ".")
	3322	"RTN","PRC AG",62,0)
	3323	I $P($O(^ RC(341,"C" ,Y)),".")' =Y W !!,*7 ,"No notif ications s ent on tha t date",!
	3324	G REBDT
	3325	"RTN","PRC AG",63,0)
	3326	S DAT=999 9999-Y
	3327	"RTN","PRC AG",64,0)
	3328	W !!,"Pre ss return at the 'Bi ll:' promp ts to repr int all ", ETY," Lett ers",!,"f
	3329	or the dat e selected or select a start a nd/or end point."
	3330	"RTN","PRC AG",65,0)
	3331	W !,"Do n ot select bills that print on the Patien t Statemen t."
	3332	"RTN","PRC AG",66,0)
	3333	W !,"NOTE : The rang e is in pr int order not alphab etic!",!
	3334	"RTN","PRC AG",67,0)
	3335	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	3336	"RTN","PRC AG",68,0)
	3337	S DIC="^P RCA(430,", DIC(0)="AE MNQ",DIC(" A")="Start from Bill : ",DIC("S ")="I "",
	3338	18,25,5,24 ,1,2,3,4,2 3,22,""'[( "",""_$P(^ (0),U,2)_" ","")" D ^ DIC I ($D( DTOUT))!(
	3339	X["^") G R EBQ
	3340	"RTN","PRC AG",69,0)
	3341	S BEG=0,Y =+Y
	3342	"RTN","PRC AG",70,0)
	3343	I Y>0 S B EG=-1,DEB= +$P($G(^PR CA(430,Y,0 )),U,9),TY P=+$O(^RC( 341.1,"AC" ,$S(ETY="
	3344	UB":9,1:10 ),0)) F DA TE=DAT-.00 01:0 S DAT E=$O(^RC(3 41,"AD",DE B,TYP,DATE )) Q:$P(D
	3345	ATE,".")'= DAT D
	3346	"RTN","PRC AG",71,0)
	3347	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y
	3348	S BEG=DA, DEB=0 Q
	3349	"RTN","PRC AG",72,0)
	3350	.Q
	3351	"RTN","PRC AG",73,0)
	3352	I BEG=0 S BEG=$O(^R C(341,"C", +$O(^RC(34 1,"C",9999 999-DAT)), 0)) S:'BEG BEG=-1
	3353	"RTN","PRC AG",74,0)
	3354	I BEG<0 W *7,!," So rry, not f ound!" G R EBDT
	3355	"RTN","PRC AG",75,0)
	3356	S DIC("A" )="End aft er Bill: " D ^DIC I ($D(DTOUT) )!(X["^") G REBQ
	3357	"RTN","PRC AG",76,0)
	3358	S END="*" ,Y=+Y
	3359	"RTN","PRC AG",77,0)
	3360	I Y>0 S E ND=-1,DEB= +$P($G(^PR CA(430,Y,0 )),U,9),TY P=+$O(^RC( 341.1,"AC" ,$S(ETY="
	3361	UB":9,1:10 ),0)) F DA TE=DAT-.00 01:0 S DAT E=$O(^RC(3 41,"AD",DE B,TYP,DATE )) Q:$P(D
	3362	ATE,".")'= DAT D
	3363	"RTN","PRC AG",78,0)
	3364	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y
	3365	S END=DA, DEB=0 Q
	3366	"RTN","PRC AG",79,0)
	3367	.Q
	3368	"RTN","PRC AG",80,0)
	3369	I END<0 W *7,!," So rry, not f ound!" G R EBDT
	3370	"RTN","PRC AG",81,0)
	3371	I END'="* ",END<BEG W *7,!,"En ding bill is before starting b ill!" G RE BDT
	3372	"RTN","PRC AG",82,0)
	3373	W !!
	3374	"RTN","PRC AG",83,0)
	3375	REBD I ETY ="UB" S ZT IO="" G RE BD1
	3376	"RTN","PRC AG",84,0)
	3377	S %ZIS("B ")=$P($G(^ RC(342,1,0 )),U,8),%Z IS="QN",IO P="Q" D ^% ZIS G:POP REBQ
	3378	"RTN","PRC AG",85,0)
	3379	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REB D
	3380	"RTN","PRC AG",86,0)
	3381	REBD1 S ZT RTN="BILL^ PRCAGS",ZT SAVE("BEG" )="",ZTSAV E("END")=" ",ZTSAVE(" DAT")="",
	3382	ZTSAVE("SI TE")="",ZT SAVE("ETY" )=""
	3383	"RTN","PRC AG",87,0)
	3384	S ZTDESC= $S(ETY="UB ":"AR Repr int UB Let ters",1:"R eprint AR Follow-up Letters")
	3385	D ^%ZTLOA D
	3386	"RTN","PRC AG",88,0)
	3387	REBQ K ETY D ^%ZISC Q
	3388	"RTN","PRC AG",89,0)
	3389	PRDT ;ENTR Y FROM PRI NT STATEME NT/LETTER BY DATE OP TION
	3390	"RTN","PRC AG",90,0)
	3391	D PRDT^PR CAGP
	3392	"RTN","PRC AG",91,0)
	3393	Q
	3394	"RTN","PRC AG",92,0)
	3395	SELNAME(SD T) ; PRCA ^4.5^313 - Create a list and t hen select a patient name
	3396	"RTN","PRC AG",93,0)
	3397	; There a re three v alues to R eturn from this tag
	3398	"RTN","PRC AG",94,0)
	3399	; IEN -- Number from list of Selecte d Patient
	3400	"RTN","PRC AG",95,0)
	3401	; Null -- No Pati ent Select ed from li st - used to begin o r end Sele ction lis
	3402	t
	3403	"RTN","PRC AG",96,0)
	3404	; -1 -- Quit pr ocessing f rom called tag
	3405	"RTN","PRC AG",97,0)
	3406	N IEN,CNT ,NAME
	3407	"RTN","PRC AG",98,0)
	3408	W !,"Plea se wait wh ile we bui ld the pat ient list. ",!
	3409	"RTN","PRC AG",99,0)
	3410	K ^TMP($J ,"LISTNAME ")
	3411	"RTN","PRC AG",100,0)
	3412	S (IEN,CN T)=0
	3413	"RTN","PRC AG",101,0)
	3414	F S IEN= $O(^RC(341 ,"STDT",SD T,IEN)) Q: IEN="" D
	3415	"RTN","PRC AG",102,0)
	3416	. N PAT,N AME
	3417	"RTN","PRC AG",103,0)
	3418	. S PAT=$ P(^RCD(340 ,$P(^RC(34 1,IEN,0)," ^",5),0)," ;")
	3419	"RTN","PRC AG",104,0)
	3420	. S NAME= $P(^DPT(PA T,0),U)
	3421	"RTN","PRC AG",105,0)
	3422	. S ^TMP( $J,"LISTNA ME",NAME)= IEN
	3423	"RTN","PRC AG",106,0)
	3424	; Quit th e listing if no name s to displ ay
	3425	"RTN","PRC AG",107,0)
	3426	I '$D(^TM P($J,"LIST NAME")) D Q -1
	3427	"RTN","PRC AG",108,0)
	3428	. W !,"Th ere are no names to display fo r this dat e."
	3429	"RTN","PRC AG",109,0)
	3430	. S DIR(0 )="E" D ^D IR
	3431	"RTN","PRC AG",110,0)
	3432	W !,"Plea se enter a ll or part of Patien t Name: " R NAME:DTI ME
	3433	"RTN","PRC AG",111,0)
	3434	I NAME="^ " Q -1
	3435	"RTN","PRC AG",112,0)
	3436	I NAME="" Q NAME
	3437	"RTN","PRC AG",113,0)
	3438	I $G(NAME )'="",$D(^ TMP($J,"LI STNAME",NA ME)) S IEN =^(NAME) Q IEN
	3439	"RTN","PRC AG",114,0)
	3440	W !!,"Pat ient Name is not an exact matc h."
	3441	"RTN","PRC AG",115,0)
	3442	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	3443	"RTN","PRC AG",116,0)
	3444	S DIR(0)= "YAO"
	3445	"RTN","PRC AG",117,0)
	3446	S DIR("B" )="N"
	3447	"RTN","PRC AG",118,0)
	3448	S DIR("A" )="Would y ou like a list of Pa tient Name s for "_$$ DATE^RCCPC PS1(SDT)_
	3449	"? "
	3450	"RTN","PRC AG",119,0)
	3451	D ^DIR
	3452	"RTN","PRC AG",120,0)
	3453	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	3454	"RTN","PRC AG",121,0)
	3455	I Y=0 N Q UIT D I Q UIT'=0 Q Q UIT
	3456	"RTN","PRC AG",122,0)
	3457	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	3458	"RTN","PRC AG",123,0)
	3459	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	3460	"RTN","PRC AG",124,0)
	3461	. S DIR(0 )="YAO"
	3462	"RTN","PRC AG",125,0)
	3463	. S DIR(" B")="Y"
	3464	"RTN","PRC AG",126,0)
	3465	. S DIR(" A")="Is th is correct ? "
	3466	"RTN","PRC AG",127,0)
	3467	. D ^DIR
	3468	"RTN","PRC AG",128,0)
	3469	. S QUIT= Y
	3470	"RTN","PRC AG",129,0)
	3471	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	3472	"RTN","PRC AG",130,0)
	3473	. I QUIT= 1 S QUIT=" "
	3474	"RTN","PRC AG",131,0)
	3475	; Select Name - If Zero (0) i s returned keep tryi ng
	3476	"RTN","PRC AG",132,0)
	3477	F S IEN= $$SELNM1 I IEN'=0 Q
	3478	"RTN","PRC AG",133,0)
	3479	Q IEN
	3480	"RTN","PRC AG",134,0)
	3481	SELNM1() ; Select n ame
	3482	"RTN","PRC AG",135,0)
	3483	N DIRUT,X CNT,DIR,CN T
	3484	"RTN","PRC AG",136,0)
	3485	K ^TMP($J ,"LISTCNT" )
	3486	"RTN","PRC AG",137,0)
	3487	S CNT=0,N AME=""
	3488	"RTN","PRC AG",138,0)
	3489	W @IOF,"N umber",?20 ,"Patient Name"
	3490	"RTN","PRC AG",139,0)
	3491	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I $D(D IRUT) Q
	3492	"RTN","PRC AG",140,0)
	3493	. S CNT=C NT+1
	3494	"RTN","PRC AG",141,0)
	3495	. S ^TMP( $J,"LISTCN T",CNT,NAM E)=^TMP($J ,"LISTNAME ",NAME)
	3496	"RTN","PRC AG",142,0)
	3497	. W !,CNT ,?20,NAME
	3498	"RTN","PRC AG",143,0)
	3499	. I ($Y+3 )>IOSL D Q:$D(DIRUT )
	3500	"RTN","PRC AG",144,0)
	3501	. . S DIR (0)="E" D ^DIR
	3502	"RTN","PRC AG",145,0)
	3503	. . I X=" ^" Q
	3504	"RTN","PRC AG",146,0)
	3505	. . W @IO F
	3506	"RTN","PRC AG",147,0)
	3507	. . W "Nu mber",?20, "Patient N ame"
	3508	"RTN","PRC AG",148,0)
	3509	W !,"Plea se enter n umber of s elected Pa tient Name : " R XCNT :DTIME
	3510	"RTN","PRC AG",149,0)
	3511	I XCNT="^ " Q -1
	3512	"RTN","PRC AG",150,0)
	3513	I XCNT="" N QUIT D Q QUIT
	3514	"RTN","PRC AG",151,0)
	3515	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	3516	"RTN","PRC AG",152,0)
	3517	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	3518	"RTN","PRC AG",153,0)
	3519	. S DIR(0 )="YAO"
	3520	"RTN","PRC AG",154,0)
	3521	. S DIR(" B")="Y"
	3522	"RTN","PRC AG",155,0)
	3523	. S DIR(" A")="No Pa tient Sele cted. "
	3524	"RTN","PRC AG",156,0)
	3525	. S DIR(" A",1)="Is this corre ct? "
	3526	"RTN","PRC AG",157,0)
	3527	. D ^DIR
	3528	"RTN","PRC AG",158,0)
	3529	. S QUIT= Y
	3530	"RTN","PRC AG",159,0)
	3531	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	3532	"RTN","PRC AG",160,0)
	3533	. I QUIT= 1 S QUIT=" "
	3534	"RTN","PRC AG",161,0)
	3535	S CNT=XCN T
	3536	"RTN","PRC AG",162,0)
	3537	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	3538	"RTN","PRC AG",163,0)
	3539	S DIR(0)= "YAO"
	3540	"RTN","PRC AG",164,0)
	3541	S DIR("B" )="Y"
	3542	"RTN","PRC AG",165,0)
	3543	S DIR("A" )="...OK? "
	3544	"RTN","PRC AG",166,0)
	3545	S DIR("A" ,1)=""
	3546	"RTN","PRC AG",167,0)
	3547	S DIR("A" ,2)=$O(^TM P($J,"LIST CNT",CNT,0 ))
	3548	"RTN","PRC AG",168,0)
	3549	D ^DIR
	3550	"RTN","PRC AG",169,0)
	3551	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	3552	"RTN","PRC AG",170,0)
	3553	; If user answered No, then t ry again
	3554	"RTN","PRC AG",171,0)
	3555	I Y=0 Q Y
	3556	"RTN","PRC AG",172,0)
	3557	S NAME=$O (^TMP($J," LISTCNT",C NT,0))
	3558	"RTN","PRC AG",173,0)
	3559	Q ^TMP($J ,"LISTCNT" ,CNT,NAME)
	3560	"RTN","RCB EADJ")
	3561	0^24^B7710 6309^B7712 5147
	3562	"RTN","RCB EADJ",1,0)
	3563	RCBEADJ ;W ISC/RFJ-ad justment ; Jun 06, 20 14@19:11:1 9
	3564	"RTN","RCB EADJ",2,0)
	3565	;;4.5;Acc ounts Rece ivable;1 69,172,204 ,173,208,2 33,298,301 ,313;Mar 20, 1995
	3566	;Build 118
	3567	"RTN","RCB EADJ",3,0)
	3568	;Per VA D irective 6 402, this routine sh ould not b e modified .
	3569	"RTN","RCB EADJ",4,0)
	3570	Q
	3571	"RTN","RCB EADJ",5,0)
	3572	;
	3573	"RTN","RCB EADJ",6,0)
	3574	;
	3575	"RTN","RCB EADJ",7,0)
	3576	DECREASE ; menu opt ion: creat e a decrea se adjustm ent
	3577	"RTN","RCB EADJ",8,0)
	3578	D ADJUST( "DECREASE" )
	3579	"RTN","RCB EADJ",9,0)
	3580	Q
	3581	"RTN","RCB EADJ",10,0 )
	3582	;
	3583	"RTN","RCB EADJ",11,0 )
	3584	;
	3585	"RTN","RCB EADJ",12,0 )
	3586	INCREASE ; menu opt ion: creat e an incre ase adjust ment
	3587	"RTN","RCB EADJ",13,0 )
	3588	D ADJUST( "INCREASE" )
	3589	"RTN","RCB EADJ",14,0 )
	3590	Q
	3591	"RTN","RCB EADJ",15,0 )
	3592	;
	3593	"RTN","RCB EADJ",16,0 )
	3594	ADJUST(RCB ETYPE,RCED I) ; crea te an adju stment
	3595	"RTN","RCB EADJ",17,0 )
	3596	; rcbety pe = INCRE ASE for in crease or DECREASE f or decreas e
	3597	"RTN","RCB EADJ",18,0 )
	3598	; rcedi = the ien of the bil l selected via the E DI Worklis t;ien of
	3599	"RTN","RCB EADJ",19,0 )
	3600	; XX the ER A entry or null/unde fined if b ill should be select ed
	3601	"RTN","RCB EADJ",20,0 )
	3602	N RCBILLD A
	3603	"RTN","RCB EADJ",21,0 )
	3604	F D Q:R CBILLDA<0! $G(RCEDI)
	3605	"RTN","RCB EADJ",22,0 )
	3606	. K RCT RANDA,RCLI ST
	3607	"RTN","RCB EADJ",23,0 )
	3608	. ;
	3609	"RTN","RCB EADJ",24,0 )
	3610	. ; se lect a bil l
	3611	"RTN","RCB EADJ",25,0 )
	3612	. S RCB ILLDA=$S(' $G(RCEDI): $$GETABILL ^RCBEUBIL, 1:+RCEDI)
	3613	"RTN","RCB EADJ",26,0 )
	3614	. I RCB ILLDA<1 Q
	3615	"RTN","RCB EADJ",27,0 )
	3616	. I $D( ^PRCA(430, "TCSP",RCB ILLDA)),(R CBETYPE="I NCREASE") W !,"BILL HAS BEEN
	3617	REFERRED T O CROSS-SE RVICING.", !,"NO MANU AL INCREAS E ADJUSTME NTS ARE AL LOWED." Q
	3618	;prca4. 5301
	3619	"RTN","RCB EADJ",28,0 )
	3620	. I $D( ^PRCA(430, "TCSP",RCB ILLDA)),(R CBETYPE="D ECREASE") S %=2 W !! ,"IS THIS
	3621	ACTION BE ING PERFOR MED DUE TO THE CLAIM S MATCHING PROCESS? " D YN^DIC N Q:(%<0)
	3622	!(%=2) ;p rca4.530 1
	3623	"RTN","RCB EADJ",29,0 )
	3624	. ;
	3625	"RTN","RCB EADJ",30,0 )
	3626	. ; ad just the b ill
	3627	"RTN","RCB EADJ",31,0 )
	3628	. D ADJ BILL(RCBET YPE,RCBILL DA,$P($G(R CEDI),";", 2))
	3629	"RTN","RCB EADJ",32,0 )
	3630	Q
	3631	"RTN","RCB EADJ",33,0 )
	3632	;
	3633	"RTN","RCB EADJ",34,0 )
	3634	ADJBILL(RC BETYPE,RCB ILLDA,RCED IWL) ; ad just a bil l
	3635	"RTN","RCB EADJ",35,0 )
	3636	; RCEDIWL = ien of ERA entry if called from workl ist
	3637	"RTN","RCB EADJ",36,0 )
	3638	N RCAMOUN T,RCBALANC ,RCDATA7,R CLIST,RCON TADJ,RCTRA NDA,TOTALC AL,TOTALST O,I,X,Y
	3639	"RTN","RCB EADJ",37,0 )
	3640	; lock t he bill
	3641	"RTN","RCB EADJ",38,0 )
	3642	L +^PRCA( 430,RCBILL DA):5 E W !,"ANOTHE R USER IS CURRENTLY WORKING WI TH THIS B
	3643	ILL." Q
	3644	"RTN","RCB EADJ",39,0 )
	3645	;
	3646	"RTN","RCB EADJ",40,0 )
	3647	; show d ata for th e bill
	3648	"RTN","RCB EADJ",41,0 )
	3649	D SHOWBIL L^RCWROFF1 (RCBILLDA)
	3650	"RTN","RCB EADJ",42,0 )
	3651	;
	3652	"RTN","RCB EADJ",43,0 )
	3653	; check the balanc e of the b ill
	3654	"RTN","RCB EADJ",44,0 )
	3655	W !!,"Che cking the bill's bal ance ..."
	3656	"RTN","RCB EADJ",45,0 )
	3657	S RCBALAN C=$$OUTOFB AL^RCBDBBA L(RCBILLDA )
	3658	"RTN","RCB EADJ",46,0 )
	3659	I RCBALAN C="" W " I N Balance! "
	3660	"RTN","RCB EADJ",47,0 )
	3661	;
	3662	"RTN","RCB EADJ",48,0 )
	3663	; out of balance, ask to fix it
	3664	"RTN","RCB EADJ",49,0 )
	3665	I RCBALAN C'="" D I RCBILLDA< 1 D UNLOCK Q
	3666	"RTN","RCB EADJ",50,0 )
	3667	. S TOT ALCAL=$P(R CBALANC,"^ ")+$P(RCBA LANC,"^",2 )+$P(RCBAL ANC,"^",3) +$P(RCBAL
	3668	ANC,"^",4) +$P(RCBALA NC,"^",5)
	3669	"RTN","RCB EADJ",51,0 )
	3670	. S RCD ATA7=$G(^P RCA(430,RC BILLDA,7))
	3671	"RTN","RCB EADJ",52,0 )
	3672	. S TOT ALSTO=$P(R CDATA7,"^" )+$P(RCDAT A7,"^",2)+ $P(RCDATA7 ,"^",3)+$P (RCDATA7,
	3673	"^",4)+$P( RCDATA7,"^ ",5)
	3674	"RTN","RCB EADJ",53,0 )
	3675	. W " O UT of Bala nce!"
	3676	"RTN","RCB EADJ",54,0 )
	3677	. W !!, " B ALANCE:",$ J("Calcula ted",12),$ J("Stored" ,12)
	3678	"RTN","RCB EADJ",55,0 )
	3679	. W !," -- ----- ",$J ("-------- ----",12), $J("------ ------",1
	3680	2)
	3681	"RTN","RCB EADJ",56,0 )
	3682	. W !," Pr incipal Ba lance:",$J ($P(RCBALA NC,"^",1), 12,2),$J($ P(RCDATA7
	3683	,"^",1),12 ,2)
	3684	"RTN","RCB EADJ",57,0 )
	3685	. I +$P (RCBALANC, "^",1)'=+$ P(RCDATA7, "^",1) W " <<-- OUT OF BALANC E"
	3686	"RTN","RCB EADJ",58,0 )
	3687	. W !," I nterest Ba lance:",$J ($P(RCBALA NC,"^",2), 12,2),$J($ P(RCDATA7
	3688	,"^",2),12 ,2)
	3689	"RTN","RCB EADJ",59,0 )
	3690	. I +$P (RCBALANC, "^",2)'=+$ P(RCDATA7, "^",2) W " <<-- OUT OF BALANC E"
	3691	"RTN","RCB EADJ",60,0 )
	3692	. W !," Admin Ba lance:",$J ($P(RCBALA NC,"^",3), 12,2),$J($ P(RCDATA7
	3693	,"^",3),12 ,2)
	3694	"RTN","RCB EADJ",61,0 )
	3695	. I +$P (RCBALANC, "^",3)'=+$ P(RCDATA7, "^",3) W " <<-- OUT OF BALANC E"
	3696	"RTN","RCB EADJ",62,0 )
	3697	. W !," MF Ba lance:",$J ($P(RCBALA NC,"^",4), 12,2),$J($ P(RCDATA7
	3698	,"^",4),12 ,2)
	3699	"RTN","RCB EADJ",63,0 )
	3700	. I +$P (RCBALANC, "^",4)'=+$ P(RCDATA7, "^",4) W " <<-- OUT OF BALANC E"
	3701	"RTN","RCB EADJ",64,0 )
	3702	. W !," CC Ba lance:",$J ($P(RCBALA NC,"^",5), 12,2),$J($ P(RCDATA7
	3703	,"^",5),12 ,2)
	3704	"RTN","RCB EADJ",65,0 )
	3705	. I +$P (RCBALANC, "^",5)'=+$ P(RCDATA7, "^",5) W " <<-- OUT OF BALANC E"
	3706	"RTN","RCB EADJ",66,0 )
	3707	. W !," -- ----- ",$J ("-------- -----",12) ,$J("----- --------"
	3708	,12)
	3709	"RTN","RCB EADJ",67,0 )
	3710	. W !," TOTAL:",$J (TOTALCAL, 12,2),$J(T OTALSTO,12 ,2)
	3711	"RTN","RCB EADJ",68,0 )
	3712	. I +TO TALCAL'=+T OTALSTO W " <<-- OU T OF BALAN CE"
	3713	"RTN","RCB EADJ",69,0 )
	3714	. ;
	3715	"RTN","RCB EADJ",70,0 )
	3716	. ; as k to fix t he balance s
	3717	"RTN","RCB EADJ",71,0 )
	3718	. S Y=$ $ASKFIX I Y'=1 W !," NOTE: Yo u must fix the Balan ce Discrep ancy befo
	3719	re process ing an adj ustment!" S RCBILLDA =0 Q
	3720	"RTN","RCB EADJ",72,0 )
	3721	. ;
	3722	"RTN","RCB EADJ",73,0 )
	3723	. ; fi x it
	3724	"RTN","RCB EADJ",74,0 )
	3725	. S $P( RCDATA7,"^ ",1)=+$P(R CBALANC,"^ ",1) ; pri ncipal
	3726	"RTN","RCB EADJ",75,0 )
	3727	. S $P( RCDATA7,"^ ",2)=+$P(R CBALANC,"^ ",2) ; int erest
	3728	"RTN","RCB EADJ",76,0 )
	3729	. S $P( RCDATA7,"^ ",3)=+$P(R CBALANC,"^ ",3) ; adm in
	3730	"RTN","RCB EADJ",77,0 )
	3731	. S $P( RCDATA7,"^ ",4)=+$P(R CBALANC,"^ ",4) ; mar shal fee
	3732	"RTN","RCB EADJ",78,0 )
	3733	. S $P( RCDATA7,"^ ",5)=+$P(R CBALANC,"^ ",5) ; cou rt cost
	3734	"RTN","RCB EADJ",79,0 )
	3735	. S $P( ^PRCA(430, RCBILLDA,7 ),"^",1,5) =$P(RCDATA 7,"^",1,5)
	3736	"RTN","RCB EADJ",80,0 )
	3737	. ;
	3738	"RTN","RCB EADJ",81,0 )
	3739	. W !," Balance Discrepanc y FIXED!"
	3740	"RTN","RCB EADJ",82,0 )
	3741	;
	3742	"RTN","RCB EADJ",83,0 )
	3743	; if the principal balance i s zero, do not allow it to be adjusted
	3744	"RTN","RCB EADJ",84,0 )
	3745	; ask to close/can cel it
	3746	"RTN","RCB EADJ",85,0 )
	3747	I RCBETYP E="DECREAS E",'$G(^PR CA(430,RCB ILLDA,7)) W !!,"Note : This bil l has NO
	3748	PRINCIPAL BALANCE to decrease !" D INTAD MIN(RCBILL DA),UNLOCK Q
	3749	"RTN","RCB EADJ",86,0 )
	3750	;
	3751	"RTN","RCB EADJ",87,0 )
	3752	; If entr y is from EDI Lockbo x worklist , display total adju stments in ERA
	3753	"RTN","RCB EADJ",88,0 )
	3754	N AP D
	3755	"RTN","RCB EADJ",89,0 )
	3756	.N BILL,E OB,ERA,SEQ S ERA="", AP=0
	3757	"RTN","RCB EADJ",90,0 )
	3758	.F S ERA =$O(^RCY(3 44.4,"AP", 1,ERA)) Q: 'ERA D Q :AP
	3759	"RTN","RCB EADJ",91,0 )
	3760	..S SEQ=0
	3761	"RTN","RCB EADJ",92,0 )
	3762	..F S SE Q=$O(^RCY( 344.4,"AP" ,1,ERA,SEQ )) Q:'SEQ D Q:AP
	3763	"RTN","RCB EADJ",93,0 )
	3764	...S EOB= $P($G(^RCY (344.4,ERA ,1,SEQ,0)) ,U,2) Q:'E OB
	3765	"RTN","RCB EADJ",94,0 )
	3766	...S:$P($ G(^IBM(361 .1,EOB,0)) ,U)=RCBILL DA AP=1 ;I A #4051
	3767	"RTN","RCB EADJ",95,0 )
	3768	;
	3769	"RTN","RCB EADJ",96,0 )
	3770	; Ask to enter tra nsaction e ven though it is mar ked for au topost PRC A4.5298
	3771	"RTN","RCB EADJ",97,0 )
	3772	I RCBETYP E="DECREAS E",AP S Y= $$ASKAUPO( ) I Y'=1 W !,"Exitin g bill adj ustment."
	3773	D UNLOCK Q
	3774	"RTN","RCB EADJ",98,0 )
	3775	;
	3776	"RTN","RCB EADJ",99,0 )
	3777	; ask to enter adj ustment am ount
	3778	"RTN","RCB EADJ",100, 0)
	3779	S RCAMOUN T=$$AMOUNT (RCBILLDA, RCBETYPE)
	3780	"RTN","RCB EADJ",101, 0)
	3781	I RCAMOUN T<0 D UNLO CK Q
	3782	"RTN","RCB EADJ",102, 0)
	3783	;
	3784	"RTN","RCB EADJ",103, 0)
	3785	; if dec rease, mak e negative
	3786	"RTN","RCB EADJ",104, 0)
	3787	I RCBETYP E="DECREAS E" S RCAMO UNT=-RCAMO UNT
	3788	"RTN","RCB EADJ",105, 0)
	3789	;
	3790	"RTN","RCB EADJ",106, 0)
	3791	; ask if it is a c ontract ad justment
	3792	"RTN","RCB EADJ",107, 0)
	3793	I RCBETYP E="DECREAS E","^9^28^ 29^30^32^" [("^"_$P($ G(^PRCA(43 0,RCBILLDA ,0)),"^",
	3794	2)_"^") S RCONTADJ=$ $ASKCONT I RCONTADJ< 0 D UNLOCK Q
	3795	"RTN","RCB EADJ",108, 0)
	3796	;
	3797	"RTN","RCB EADJ",109, 0)
	3798	; show w hat the ne w transact ion will l ook like
	3799	"RTN","RCB EADJ",110, 0)
	3800	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
	3801	"RTN","RCB EADJ",111, 0)
	3802	W !!,"If you proces s the tran saction, t he bill wi ll look li ke:"
	3803	"RTN","RCB EADJ",112, 0)
	3804	W !,"Curr ent Princi pal Balanc e: ",$J($P (RCDATA7," ^"),11,2)
	3805	"RTN","RCB EADJ",113, 0)
	3806	W !," NE W ",RCBETY PE," Adjus tment: ",$ J(RCAMOUNT ,11,2)
	3807	"RTN","RCB EADJ",114, 0)
	3808	W !," ------- ----"
	3809	"RTN","RCB EADJ",115, 0)
	3810	W !," NEW Princi pal Balanc e: ",$J($P (RCDATA7," ^")+RCAMOU NT,11,2)
	3811	"RTN","RCB EADJ",116, 0)
	3812	;
	3813	"RTN","RCB EADJ",117, 0)
	3814	; ask to enter tra nsaction
	3815	"RTN","RCB EADJ",118, 0)
	3816	S Y=$$ASK OK(RCBETYP E) I Y'=1 D UNLOCK Q
	3817	"RTN","RCB EADJ",119, 0)
	3818	;
	3819	"RTN","RCB EADJ",120, 0)
	3820	ADDADJ ; add adjust ment
	3821	"RTN","RCB EADJ",121, 0)
	3822	S RCTRAND A=$$INCDEC ^RCBEUTR1( RCBILLDA,R CAMOUNT,"" ,"","",$G( RCONTADJ))
	3823	"RTN","RCB EADJ",122, 0)
	3824	I 'RCTRAN DA W !," * W A R N I N G: A djustment NOT Proces sed! *" D UNLOCK
	3825	Q
	3826	"RTN","RCB EADJ",123, 0)
	3827	I RCTRAND A W !," A djustment Transactio n: ",RCTRA NDA," has been added ."
	3828	"RTN","RCB EADJ",124, 0)
	3829	I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D
	3830	DECADJ^RC TCSPU(RCBI LLDA,RCTRA NDA) ;prca 4.5301 a dd cs decr ease adjus tment
	3831	"RTN","RCB EADJ",125, 0)
	3832	I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD
	3833	^%DT W !!, " * * * * Transmis sion will be held un til "_Y_" * * * *"
	3834	"RTN","RCB EADJ",126, 0)
	3835	;
	3836	"RTN","RCB EADJ",127, 0)
	3837	; ask to enter a c omment
	3838	"RTN","RCB EADJ",128, 0)
	3839	W !!,"Ent er a comme nt for the ",RCBETYP E," Adjust ment:"
	3840	"RTN","RCB EADJ",129, 0)
	3841	S Y=$$EDI T433^RCBEU TRA(RCTRAN DA,"41;")
	3842	"RTN","RCB EADJ",130, 0)
	3843	;
	3844	"RTN","RCB EADJ",131, 0)
	3845	; ask to exempt in terest and admin cha rges
	3846	"RTN","RCB EADJ",132, 0)
	3847	I RCBETYP E="DECREAS E" D INTAD MIN(RCBILL DA)
	3848	"RTN","RCB EADJ",133, 0)
	3849	;
	3850	"RTN","RCB EADJ",134, 0)
	3851	; notifi cation of subsequent payer bul letin
	3852	"RTN","RCB EADJ",135, 0)
	3853	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7)),X=0
	3854	"RTN","RCB EADJ",136, 0)
	3855	F I=1:1:5 S X=X+$P( RCDATA7,"^ ",I)
	3856	"RTN","RCB EADJ",137, 0)
	3857	I RCDATA7 '="",'X D
	3858	"RTN","RCB EADJ",138, 0)
	3859	. N PRC ABN,PRCAEN ,PRCAMT
	3860	"RTN","RCB EADJ",139, 0)
	3861	. S PRC ABN=RCBILL DA,PRCAEN= RCTRANDA,P RCAMT=+$P( $G(^PRCA(4 33,RCTRAND A,1)),"^"
	3862	,5)
	3863	"RTN","RCB EADJ",140, 0)
	3864	. D EOB ^PRCADJ
	3865	"RTN","RCB EADJ",141, 0)
	3866	;
	3867	"RTN","RCB EADJ",142, 0)
	3868	; unlock and ask t he next bi ll to adju st
	3869	"RTN","RCB EADJ",143, 0)
	3870	D UNLOCK
	3871	"RTN","RCB EADJ",144, 0)
	3872	Q
	3873	"RTN","RCB EADJ",145, 0)
	3874	;
	3875	"RTN","RCB EADJ",146, 0)
	3876	;
	3877	"RTN","RCB EADJ",147, 0)
	3878	UNLOCK ; unlock bil l and tran saction
	3879	"RTN","RCB EADJ",148, 0)
	3880	L -^PRCA( 430,RCBILL DA)
	3881	"RTN","RCB EADJ",149, 0)
	3882	I $G(RCTR ANDA) L -^ PRCA(433,R CTRANDA)
	3883	"RTN","RCB EADJ",150, 0)
	3884	Q
	3885	"RTN","RCB EADJ",151, 0)
	3886	;
	3887	"RTN","RCB EADJ",152, 0)
	3888	;
	3889	"RTN","RCB EADJ",153, 0)
	3890	INTADMIN(R CBILLDA) ; ask and adjust the interest and admin
	3891	"RTN","RCB EADJ",154, 0)
	3892	N RCAMOUN T,RCTRANDA ,Y
	3893	"RTN","RCB EADJ",155, 0)
	3894	;
	3895	"RTN","RCB EADJ",156, 0)
	3896	; check to see if there is i nterest an d admin ch arges
	3897	"RTN","RCB EADJ",157, 0)
	3898	S RCAMOUN T=$G(^PRCA (430,RCBIL LDA,7))
	3899	"RTN","RCB EADJ",158, 0)
	3900	I '$P(RCA MOUNT,"^", 2),'$P(RCA MOUNT,"^", 3),'$P(RCA MOUNT,"^", 4),'$P(RCA MOUNT,"^"
	3901	,5) Q
	3902	"RTN","RCB EADJ",159, 0)
	3903	;
	3904	"RTN","RCB EADJ",160, 0)
	3905	; only a sk if ther e is no pr incipal
	3906	"RTN","RCB EADJ",161, 0)
	3907	I RCAMOUN T Q
	3908	"RTN","RCB EADJ",162, 0)
	3909	;
	3910	"RTN","RCB EADJ",163, 0)
	3911	W !!,"You have the option to automatica lly EXEMPT the inter est"
	3912	"RTN","RCB EADJ",164, 0)
	3913	W !,"and administra tive charg es. This will close the bill. "
	3914	"RTN","RCB EADJ",165, 0)
	3915	S Y=$$ASK EXEMP I Y' =1 Q
	3916	"RTN","RCB EADJ",166, 0)
	3917	;
	3918	"RTN","RCB EADJ",167, 0)
	3919	W !!,"Cre ating an E XEMPT tran saction .. ."
	3920	"RTN","RCB EADJ",168, 0)
	3921	S RCTRAND A=$$EXEMPT ^RCBEUTR2( RCBILLDA,$ P(RCAMOUNT ,"^",2)_"^ "_$P(RCAMO UNT,"^",3
	3922	)_"^^"_$P( RCAMOUNT," ^",4)_"^"_ $P(RCAMOUN T,"^",5))
	3923	"RTN","RCB EADJ",169, 0)
	3924	I 'RCTRAN DA W !," * W A R N I N G: E XEMPTION N OT Process ed! *" Q
	3925	"RTN","RCB EADJ",170, 0)
	3926	I RCTRAND A W !," Exempt Tra nsaction: ",RCTRANDA ," has bee n added."
	3927	"RTN","RCB EADJ",171, 0)
	3928	INTC35B ;C heck if CS 5B entry n eeded for exempt tra nsaction
	3929	"RTN","RCB EADJ",172, 0)
	3930	I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D
	3931	DECADJ^RC TCSPU(RCBI LLDA,RCTRA NDA) ;prca 4.5301 a dd cs exem pt
	3932	"RTN","RCB EADJ",173, 0)
	3933	I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD
	3934	^%DT W !!, " * * * * Transmis sion will be held un til "_Y_" * * * *"
	3935	"RTN","RCB EADJ",174, 0)
	3936	;
	3937	"RTN","RCB EADJ",175, 0)
	3938	W !," Cu rrent Bill Status: " ,$P($G(^PR CA(430.3,+ $P($G(^PRC A(430,RCBI LLDA,0)),
	3939	"^",8),0)) ,"^")
	3940	"RTN","RCB EADJ",176, 0)
	3941	Q
	3942	"RTN","RCB EADJ",177, 0)
	3943	;
	3944	"RTN","RCB EADJ",178, 0)
	3945	ASKOK(RCBE TYPE) ; a sk record decrease o r increase transacti on
	3946	"RTN","RCB EADJ",179, 0)
	3947	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	3948	"RTN","RCB EADJ",180, 0)
	3949	S DIR(0)= "YO",DIR(" B")="YES"
	3950	"RTN","RCB EADJ",181, 0)
	3951	S DIR("A" )="Are you sure you want to en ter this " _RCBETYPE_ " adjustme nt "
	3952	"RTN","RCB EADJ",182, 0)
	3953	W ! D ^DI R
	3954	"RTN","RCB EADJ",183, 0)
	3955	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	3956	"RTN","RCB EADJ",184, 0)
	3957	Q Y
	3958	"RTN","RCB EADJ",185, 0)
	3959	;
	3960	"RTN","RCB EADJ",186, 0)
	3961	ASKAUPO() ; ask rec ord even t hough mark ed for aut o post PRC A4.5298
	3962	"RTN","RCB EADJ",187, 0)
	3963	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	3964	"RTN","RCB EADJ",188, 0)
	3965	S DIR(0)= "YOA",DIR( "B")="NO"
	3966	"RTN","RCB EADJ",189, 0)
	3967	S DIR("A" )="Marked for Auto-P ost. Are y ou sure? ( Y/N) "
	3968	"RTN","RCB EADJ",190, 0)
	3969	W ! D ^DI R
	3970	"RTN","RCB EADJ",191, 0)
	3971	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	3972	"RTN","RCB EADJ",192, 0)
	3973	Q Y
	3974	"RTN","RCB EADJ",193, 0)
	3975	;
	3976	"RTN","RCB EADJ",194, 0)
	3977	ASKFIX() ; ask to f ix bill's balance
	3978	"RTN","RCB EADJ",195, 0)
	3979	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	3980	"RTN","RCB EADJ",196, 0)
	3981	S DIR(0)= "YO",DIR(" B")="NO"
	3982	"RTN","RCB EADJ",197, 0)
	3983	S DIR("A" )=" Do yo u want to FIX the ba lance disc repancy "
	3984	"RTN","RCB EADJ",198, 0)
	3985	W ! D ^DI R
	3986	"RTN","RCB EADJ",199, 0)
	3987	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	3988	"RTN","RCB EADJ",200, 0)
	3989	Q Y
	3990	"RTN","RCB EADJ",201, 0)
	3991	;
	3992	"RTN","RCB EADJ",202, 0)
	3993	;
	3994	"RTN","RCB EADJ",203, 0)
	3995	ASKEXEMP() ; ask to record an exempt tr ansaction
	3996	"RTN","RCB EADJ",204, 0)
	3997	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	3998	"RTN","RCB EADJ",205, 0)
	3999	S DIR(0)= "YO",DIR(" B")="NO"
	4000	"RTN","RCB EADJ",206, 0)
	4001	S DIR("A" )=" Would you like to EXEMPT the intere st and adm in charges "
	4002	"RTN","RCB EADJ",207, 0)
	4003	D ^DIR
	4004	"RTN","RCB EADJ",208, 0)
	4005	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	4006	"RTN","RCB EADJ",209, 0)
	4007	Q Y
	4008	"RTN","RCB EADJ",210, 0)
	4009	;
	4010	"RTN","RCB EADJ",211, 0)
	4011	;
	4012	"RTN","RCB EADJ",212, 0)
	4013	ASKCONT() ; ask if contract a djustment
	4014	"RTN","RCB EADJ",213, 0)
	4015	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	4016	"RTN","RCB EADJ",214, 0)
	4017	S DIR(0)= "YO",DIR(" B")="YES"
	4018	"RTN","RCB EADJ",215, 0)
	4019	S DIR("A" )=" Is th is a CONTR ACT adjust ment "
	4020	"RTN","RCB EADJ",216, 0)
	4021	W ! D ^DI R
	4022	"RTN","RCB EADJ",217, 0)
	4023	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	4024	"RTN","RCB EADJ",218, 0)
	4025	Q Y
	4026	"RTN","RCB EADJ",219, 0)
	4027	;
	4028	"RTN","RCB EADJ",220, 0)
	4029	ADJNUM(RCB ILLDA) ; get next a djustment number for a bill
	4030	"RTN","RCB EADJ",221, 0)
	4031	N %,ADJUS T,DATA1,RC TRANDA
	4032	"RTN","RCB EADJ",222, 0)
	4033	S RCTRAND A=0
	4034	"RTN","RCB EADJ",223, 0)
	4035	F S RCTR ANDA=$O(^P RCA(433,"C ",RCBILLDA ,RCTRANDA) ) Q:'RCTRA NDA S DAT A1=$G(^PR
	4036	CA(433,RCT RANDA,1)) I $P(DATA1 ,"^",4),$P (DATA1,"^" ,2)=1!($P( DATA1,"^", 2)=35) S
	4037	ADJUST=$P( DATA1,"^", 4)+1
	4038	"RTN","RCB EADJ",224, 0)
	4039	Q ADJUST
	4040	"RTN","RCB EADJ",225, 0)
	4041	;
	4042	"RTN","RCB EADJ",226, 0)
	4043	;
	4044	"RTN","RCB EADJ",227, 0)
	4045	AMOUNT(RCB ILLDA,RCBE TYPE) ; e nter the a djustment amount for a bill
	4046	"RTN","RCB EADJ",228, 0)
	4047	N DIR,DIR UT,DTOUT,D UOUT,PRINB AL,X,Y
	4048	"RTN","RCB EADJ",229, 0)
	4049	S PRINBAL =+$P($G(^P RCA(430,RC BILLDA,7)) ,"^")
	4050	"RTN","RCB EADJ",230, 0)
	4051	I RCBETYP E="INCREAS E" S PRINB AL=9999999 .99
	4052	"RTN","RCB EADJ",231, 0)
	4053	W !!,"Ent er the ",R CBETYPE," Adjustment AMOUNT, f rom .01 to ",$J(PRIN BAL,0,2),
	4054	"."
	4055	"RTN","RCB EADJ",232, 0)
	4056	S DIR(0)= "NAO^.01:" _PRINBAL_" :2"
	4057	"RTN","RCB EADJ",233, 0)
	4058	S DIR("A" )=" "_RCB ETYPE_" PR INCIPAL BA LANCE BY: "
	4059	"RTN","RCB EADJ",234, 0)
	4060	D ^DIR
	4061	"RTN","RCB EADJ",235, 0)
	4062	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	4063	"RTN","RCB EADJ",236, 0)
	4064	Q $S(Y'=" ":Y,1:-1)
	4065	"RTN","RCB EADJ",237, 0)
	4066	;
	4067	"RTN","RCC PCAP")
	4068	0^21^B4179 3332^n/a
	4069	"RTN","RCC PCAP",1,0)
	4070	RCCPCAP ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT B UILD ; 2/3 /2016 11:3 0 am
	4071	"RTN","RCC PCAP",2,0)
	4072	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 118
	4073	"RTN","RCC PCAP",3,0)
	4074	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4075	"RTN","RCC PCAP",4,0)
	4076	EN(YEAR,SO URCE,DTTIM E) ; Bui ld the pay ment state ments for Year enter ed
	4077	"RTN","RCC PCAP",5,0)
	4078	; Year is the first three num bers of th e Internal Date form at and mus t be earl
	4079	ier than c urrent Yea r
	4080	"RTN","RCC PCAP",6,0)
	4081	; Source will be us ed to dete rmine whet her to sch edule or i mmediately start Tr
	4082	ansmit aft er Build
	4083	"RTN","RCC PCAP",7,0)
	4084	; DTTIME is the Tra nsmit date and time in Interna l time fro m Build an d Transmi
	4085	t menu opt ion
	4086	"RTN","RCC PCAP",8,0)
	4087	;
	4088	"RTN","RCC PCAP",9,0)
	4089	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	4090	"RTN","RCC PCAP",10,0 )
	4091	L +^RCAP( 349.5):DIL OCKTM I '$ T W 7,7, !,"Annual Payment is already b eing run
	4092	or transmi tted. Try again lat er." Q
	4093	"RTN","RCC PCAP",11,0 )
	4094	;
	4095	"RTN","RCC PCAP",12,0 )
	4096	N %,%I,%H ,STARTDT,E NDDT,LINE, PSSEG,PSCN TR,EXIT,DE BTOR,END,N EXT,SIZE
	4097	"RTN","RCC PCAP",13,0 )
	4098	;
	4099	"RTN","RCC PCAP",14,0 )
	4100	; Initial ize Incomi ng Variabl es - YEAR will be to Year befo re Current
	4101	"RTN","RCC PCAP",15,0 )
	4102	; Source will be to "B"ackgro und, and D TTIME to i ts current value, in cluding N
	4103	ULL
	4104	"RTN","RCC PCAP",16,0 )
	4105	I $G(YEAR )="" S YEA R=$E(DT,1, 3)-1
	4106	"RTN","RCC PCAP",17,0 )
	4107	I $G(SOUR CE)="" S S OURCE="B"
	4108	"RTN","RCC PCAP",18,0 )
	4109	S DTTIME= $G(DTTIME)
	4110	"RTN","RCC PCAP",19,0 )
	4111	;
	4112	"RTN","RCC PCAP",20,0 )
	4113	; Remove previous e ntries fro m file pri or to buil ding new f ile
	4114	"RTN","RCC PCAP",21,0 )
	4115	K ^RCAP(3 49.5)
	4116	"RTN","RCC PCAP",22,0 )
	4117	S ^RCAP(3 49.5,0)="A R ANNUAL P AYMENT STA TEMENT^349 .5^^"
	4118	"RTN","RCC PCAP",23,0 )
	4119	;
	4120	"RTN","RCC PCAP",24,0 )
	4121	; Set Sta rt and End Dates
	4122	"RTN","RCC PCAP",25,0 )
	4123	S STARTDT =YEAR_"010 0"
	4124	"RTN","RCC PCAP",26,0 )
	4125	S ENDDT=Y EAR_1232
	4126	"RTN","RCC PCAP",27,0 )
	4127	S (DEBTOR ,END)=""
	4128	"RTN","RCC PCAP",28,0 )
	4129	F PSCNTR= 1:1 Q:END D
	4130	"RTN","RCC PCAP",29,0 )
	4131	. S (NEXT ,SIZE,LINE )=0
	4132	"RTN","RCC PCAP",30,0 )
	4133	. D SETPS (PSCNTR,YE AR)
	4134	"RTN","RCC PCAP",31,0 )
	4135	. N LASTP D
	4136	"RTN","RCC PCAP",32,0 )
	4137	. F S DE BTOR=$O(^P RCA(433,"A TD",DEBTOR )) Q:DEBTO R="" D I NEXT Q
	4138	"RTN","RCC PCAP",33,0 )
	4139	.. N SSN
	4140	"RTN","RCC PCAP",34,0 )
	4141	.. ; Quit if the de btor is no t a patien t
	4142	"RTN","RCC PCAP",35,0 )
	4143	.. I '$D( ^RCD(340," AB","DPT(" ,DEBTOR)) Q
	4144	"RTN","RCC PCAP",36,0 )
	4145	.. ; Quit if a test patient S SN contain s a "P" or is Null
	4146	"RTN","RCC PCAP",37,0 )
	4147	.. S SSN= $$SSN^RCFN 01(DEBTOR)
	4148	"RTN","RCC PCAP",38,0 )
	4149	.. I SSN[ "P"!(SSN=- 1) Q
	4150	"RTN","RCC PCAP",39,0 )
	4151	.. N PHSE T,PHCNTR,P HSEG,DATE, LTBDT
	4152	"RTN","RCC PCAP",40,0 )
	4153	.. S (PHS ET,PHCNTR, LTBDT)=0
	4154	"RTN","RCC PCAP",41,0 )
	4155	.. S DATE =STARTDT
	4156	"RTN","RCC PCAP",42,0 )
	4157	.. F S D ATE=$O(^PR CA(433,"AT D",DEBTOR, DATE)) Q:D ATE="" Q: DATE>ENDDT D
	4158	"RTN","RCC PCAP",43,0 )
	4159	... ; Rec heck and Q uit if the date is n ot within the Year
	4160	"RTN","RCC PCAP",44,0 )
	4161	... I DAT E<STARTDT! (DATE>ENDD T) Q
	4162	"RTN","RCC PCAP",45,0 )
	4163	... ; Set Final Dat e for this Debtor to determine final tra nsaction
	4164	"RTN","RCC PCAP",46,0 )
	4165	... N TRA NS
	4166	"RTN","RCC PCAP",47,0 )
	4167	... S TRA NS=""
	4168	"RTN","RCC PCAP",48,0 )
	4169	... F S TRANS=$O(^ PRCA(433," ATD",DEBTO R,DATE,TRA NS)) Q:TRA NS="" D
	4170	"RTN","RCC PCAP",49,0 )
	4171	.... ; Qu it if the Transactio n Type is not Paymen t in Part( 2) or Paym ent in Fu
	4172	ll(34)
	4173	"RTN","RCC PCAP",50,0 )
	4174	.... I $P (^PRCA(433 ,TRANS,1), U,2)'=2&($ P(^PRCA(43 3,TRANS,1) ,U,2)'=34) Q
	4175	"RTN","RCC PCAP",51,0 )
	4176	.... ; Se t PH Recor d if first time for this Debto r
	4177	"RTN","RCC PCAP",52,0 )
	4178	.... I 'P HSET D SET PH(DEBTOR, SSN,PSCNTR ) S PHSET= 1
	4179	"RTN","RCC PCAP",53,0 )
	4180	.... ; Se t PD Recor d for each Payment T ransaction
	4181	"RTN","RCC PCAP",54,0 )
	4182	.... D SE TPD(DEBTOR ,DATE,TRAN S,PSCNTR)
	4183	"RTN","RCC PCAP",55,0 )
	4184	.. ;
	4185	"RTN","RCC PCAP",56,0 )
	4186	.. ; Afte r completi ng each De btor, if t he Size is over 30K, set Next to create
	4187	a new PS Record,
	4188	"RTN","RCC PCAP",57,0 )
	4189	.. ; set Message De limiter at the end o f the PD r ecord, and set End D ate and T
	4190	ime
	4191	"RTN","RCC PCAP",58,0 )
	4192	.. I SIZE >30000 D
	4193	"RTN","RCC PCAP",59,0 )
	4194	... S ^RC AP(349.5,P SCNTR,1,LA STPD,0)=^R CAP(349.5, PSCNTR,1,L ASTPD,0)_" ~"
	4195	"RTN","RCC PCAP",60,0 )
	4196	... S NEX T=1
	4197	"RTN","RCC PCAP",61,0 )
	4198	... D NOW ^%DTC
	4199	"RTN","RCC PCAP",62,0 )
	4200	... S $P( ^RCAP(349. 5,PSCNTR,0 ),U,4)=%
	4201	"RTN","RCC PCAP",63,0 )
	4202	.. ;
	4203	"RTN","RCC PCAP",64,0 )
	4204	.. ; If t he last De btor in AT D has proc essed set End to sto p processi ng, if Ti
	4205	lde not fi nal
	4206	"RTN","RCC PCAP",65,0 )
	4207	.. ; char acter, set Tilde to Last PD re cord, and set End Da te and tim e
	4208	"RTN","RCC PCAP",66,0 )
	4209	. I DEBTO R="" D
	4210	"RTN","RCC PCAP",67,0 )
	4211	.. S END= 1
	4212	"RTN","RCC PCAP",68,0 )
	4213	.. I $E(^ RCAP(349.5 ,PSCNTR,1, LASTPD,0), $L(^RCAP(3 49.5,PSCNT R,1,LASTPD ,0)))'="~
	4214	" S ^RCAP( 349.5,PSCN TR,1,LASTP D,0)=^RCAP (349.5,PSC NTR,1,LAST PD,0)_"~"
	4215	"RTN","RCC PCAP",69,0 )
	4216	.. D NOW^ %DTC
	4217	"RTN","RCC PCAP",70,0 )
	4218	.. S $P(^ RCAP(349.5 ,PSCNTR,0) ,U,4)=%
	4219	"RTN","RCC PCAP",71,0 )
	4220	;
	4221	"RTN","RCC PCAP",72,0 )
	4222	; PRCA4. 5313 - Un lock prior to transm ission
	4223	"RTN","RCC PCAP",73,0 )
	4224	L -^RCAP( 349.5):DIL OCKTM
	4225	"RTN","RCC PCAP",74,0 )
	4226	;
	4227	"RTN","RCC PCAP",75,0 )
	4228	; If the Source is Background (B) deter mine the d ate and ti me from th e schedul
	4229	e based up on site co de
	4230	"RTN","RCC PCAP",76,0 )
	4231	I SOURCE= "B" S DTTI ME=$$SCHED ^RCCPCAT($ $SITE^RCMS ITE)
	4232	"RTN","RCC PCAP",77,0 )
	4233	D EN^RCCP CAT(DTTIME )
	4234	"RTN","RCC PCAP",78,0 )
	4235	;
	4236	"RTN","RCC PCAP",79,0 )
	4237	Q
	4238	"RTN","RCC PCAP",80,0 )
	4239	;
	4240	"RTN","RCC PCAP",81,0 )
	4241	SETPS(PSCN TR,YEAR) ; Get and Set Data f or PS Reco rd into 34 9.5
	4242	"RTN","RCC PCAP",82,0 )
	4243	; Set Yea r and Buil d Start Da te and Tim e
	4244	"RTN","RCC PCAP",83,0 )
	4245	N PS,DR,D A,DIE,DIC, X,PRCAFDA
	4246	"RTN","RCC PCAP",84,0 )
	4247	S DIC="^R CAP(349.5, ",X=PSCNTR ,DA=.01,DI C(0)="" D FILE^DICN
	4248	"RTN","RCC PCAP",85,0 )
	4249	D NOW^%DT C
	4250	"RTN","RCC PCAP",86,0 )
	4251	S $P(^RCA P(349.5,PS CNTR,0),U, 2,3)=YEAR_ U_%
	4252	"RTN","RCC PCAP",87,0 )
	4253	; Increme nt Line nu mber
	4254	"RTN","RCC PCAP",88,0 )
	4255	S LINE=LI NE+1
	4256	"RTN","RCC PCAP",89,0 )
	4257	; Set PSS EG for thi s Segment to PS Coun ter
	4258	"RTN","RCC PCAP",90,0 )
	4259	S PSSEG(P SCNTR)=PSC NTR
	4260	"RTN","RCC PCAP",91,0 )
	4261	; Pieces 3 and 6 wi ll be upda ted during the creat ion of oth er PS and PH segmen
	4262	ts
	4263	"RTN","RCC PCAP",92,0 )
	4264	S PS="PS" _U_PSCNTR_ U_PSCNTR_U _$$SITE^RC MSITE_U_$$ FP^RCCPCFN _U_0_U_20_ $E(YEAR,2
	4265	,3)_U_$$DA T^RCCPCFN( DT)_U_"}"
	4266	"RTN","RCC PCAP",93,0 )
	4267	; Update File
	4268	"RTN","RCC PCAP",94,0 )
	4269	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P S
	4270	"RTN","RCC PCAP",95,0 )
	4271	D UPDATE^ DIE("","PR CAFDA","LI NE")
	4272	"RTN","RCC PCAP",96,0 )
	4273	; Add len gth to SIZ E
	4274	"RTN","RCC PCAP",97,0 )
	4275	S SIZE=SI ZE+$L(PS)
	4276	"RTN","RCC PCAP",98,0 )
	4277	; Update all previo us PS Segm ents piece 3 with cu rrent coun ter
	4278	"RTN","RCC PCAP",99,0 )
	4279	N I
	4280	"RTN","RCC PCAP",100, 0)
	4281	S I=0
	4282	"RTN","RCC PCAP",101, 0)
	4283	F S I=$O (PSSEG(I)) Q:I=PSCNT R S $P(^R CAP(349.5, I,1,1,0),U ,3)=PSCNTR
	4284	"RTN","RCC PCAP",102, 0)
	4285	;
	4286	"RTN","RCC PCAP",103, 0)
	4287	Q
	4288	"RTN","RCC PCAP",104, 0)
	4289	;
	4290	"RTN","RCC PCAP",105, 0)
	4291	SETPH(DEBT OR,SSN,PSC NTR) ; Ge t and Set Data for P H Record i nto 349.5
	4292	"RTN","RCC PCAP",106, 0)
	4293	N PH,SITE ,PATNAME,A DDRESS,I,A RFLAG,ARAD DR,COUNTRY ,DFN,ICN,D R,DA,DIE,P OSTCODE,P
	4294	RCAFDA
	4295	"RTN","RCC PCAP",107, 0)
	4296	; Increme nt Line nu mber
	4297	"RTN","RCC PCAP",108, 0)
	4298	S LINE=LI NE+1
	4299	"RTN","RCC PCAP",109, 0)
	4300	; Increme nt PH Coun ter
	4301	"RTN","RCC PCAP",110, 0)
	4302	S PHCNTR= PHCNTR+1
	4303	"RTN","RCC PCAP",111, 0)
	4304	; Set PHS EG for thi s Segment to Line
	4305	"RTN","RCC PCAP",112, 0)
	4306	S PHSEG(P HCNTR)=LIN E
	4307	"RTN","RCC PCAP",113, 0)
	4308	; Get DFN and ICN f or Debtor and Patien t - If the ICN retur ns a -1 in the firs
	4309	t piece
	4310	"RTN","RCC PCAP",114, 0)
	4311	; send a Null value as the IC N
	4312	"RTN","RCC PCAP",115, 0)
	4313	S DFN=+$P ($G(^RCD(3 40,DEBTOR, 0)),U)
	4314	"RTN","RCC PCAP",116, 0)
	4315	S ICN=$$G ETICN^MPIF 001(DFN)
	4316	"RTN","RCC PCAP",117, 0)
	4317	S ICN=$S( +ICN'=-1:I CN,1:"")
	4318	"RTN","RCC PCAP",118, 0)
	4319	; Get Acc ount Numbe r -- Sit e code and SSN
	4320	"RTN","RCC PCAP",119, 0)
	4321	S SITE=$$ SITE^RCMSI TE
	4322	"RTN","RCC PCAP",120, 0)
	4323	S PH="PH" _U_SITE_SS N
	4324	"RTN","RCC PCAP",121, 0)
	4325	; Get Pat ient Name
	4326	"RTN","RCC PCAP",122, 0)
	4327	S PATNAME =$$NAM^RCF N01(DEBTOR )
	4328	"RTN","RCC PCAP",123, 0)
	4329	S PH=PH_$ E($P(PATNA ME,","),1, 5)_U_$E($P (PATNAME," ,"),1,20)_ U_$E($P($P (PATNAME,
	4330	",",2)," " ),1,10)_U_ $E($P(PATN AME," ",2) ,1,10)
	4331	"RTN","RCC PCAP",124, 0)
	4332	; If Coun try is not '1' get C ountry Nam e and Post al Code
	4333	"RTN","RCC PCAP",125, 0)
	4334	S COUNTRY =$P($G(^DP T(+$P(^RCD (340,DEBTO R,0),U),.1 1)),U,10)
	4335	"RTN","RCC PCAP",126, 0)
	4336	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	4337	"RTN","RCC PCAP",127, 0)
	4338	; Get Add ress and A RFLAG
	4339	"RTN","RCC PCAP",128, 0)
	4340	S ADDRESS =$P($$DADD ^RCAMADD(D EBTOR,1),U ,1,6)
	4341	"RTN","RCC PCAP",129, 0)
	4342	F I=1:1:4 S $P(ADDR ESS,U,I)=$ E($P(ADDRE SS,U,I),1, 40)
	4343	"RTN","RCC PCAP",130, 0)
	4344	; If the Country is Null the State and Zip Code w ill be use d
	4345	"RTN","RCC PCAP",131, 0)
	4346	; If the Country is Not Null, the State will be F X and the
	4347	"RTN","RCC PCAP",132, 0)
	4348	; Zip Cod e will be Null
	4349	"RTN","RCC PCAP",133, 0)
	4350	S $P(ADDR ESS,U,5)=$ S(COUNTRY= "":$E($P(A DDRESS,U,5 ),1,2),1:" FX")
	4351	"RTN","RCC PCAP",134, 0)
	4352	S $P(ADDR ESS,U,6)=$ S(COUNTRY= "":$E($P(A DDRESS,U,6 ),1,9),1:" ")
	4353	"RTN","RCC PCAP",135, 0)
	4354	S PH=PH_U _ADDRESS
	4355	"RTN","RCC PCAP",136, 0)
	4356	S ARFLAG= "N"
	4357	"RTN","RCC PCAP",137, 0)
	4358	S ARADDR= $P($G(^RCD (340,DEBTO R,1)),U,1, 6)
	4359	"RTN","RCC PCAP",138, 0)
	4360	I ($P(ARA DDR,U)'="" ),($P(ARAD DR,U,4)'=" "),($P(ARA DDR,U,5)'= ""),(($P(A RADDR,U,6
	4361	)'="")) S ARFLAG="Y"
	4362	"RTN","RCC PCAP",139, 0)
	4363	S PH=PH_U _$E(COUNTR Y,1,11)
	4364	"RTN","RCC PCAP",140, 0)
	4365	; Set DFN and ICN f or Debtor and Patien t with Nul l space fo r Total Am ount Rece
	4366	ived
	4367	"RTN","RCC PCAP",141, 0)
	4368	S PH=PH_U _U_SITE_DF N_U_ICN
	4369	"RTN","RCC PCAP",142, 0)
	4370	; Set ARF LAG from a bove
	4371	"RTN","RCC PCAP",143, 0)
	4372	S PH=PH_U _ARFLAG
	4373	"RTN","RCC PCAP",144, 0)
	4374	; Set Nul l spaces f or Last Bi ll Prepare d Date for Debtor an d Number o f PD Segm
	4375	ents
	4376	"RTN","RCC PCAP",145, 0)
	4377	; and the n Record D elimiter
	4378	"RTN","RCC PCAP",146, 0)
	4379	S PH=PH_U _U_U_"}"
	4380	"RTN","RCC PCAP",147, 0)
	4381	; Update file
	4382	"RTN","RCC PCAP",148, 0)
	4383	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P H
	4384	"RTN","RCC PCAP",149, 0)
	4385	D UPDATE^ DIE("","PR CAFDA","LI NE")
	4386	"RTN","RCC PCAP",150, 0)
	4387	; Add len gth to SIZ E
	4388	"RTN","RCC PCAP",151, 0)
	4389	S SIZE=SI ZE+$L(PH)
	4390	"RTN","RCC PCAP",152, 0)
	4391	; Increme nt PS segm ent piece 6 with ano ther PH re cord
	4392	"RTN","RCC PCAP",153, 0)
	4393	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,1,0),U ,6)=$P(^RC AP(349.5,P SSEG(PSCNT R),1,1,0)
	4394	,U,6)+1
	4395	"RTN","RCC PCAP",154, 0)
	4396	Q
	4397	"RTN","RCC PCAP",155, 0)
	4398	;
	4399	"RTN","RCC PCAP",156, 0)
	4400	SETPD(DEBT OR,DATE,TR ANS,PSCNTR ) ; Get a nd Set Dat a for PD R ecord into 349.5
	4401	"RTN","RCC PCAP",157, 0)
	4402	N DR,DA,D IE,PD,AMT, PHTOT,BILL ,CURBDT,PR CAFDA
	4403	"RTN","RCC PCAP",158, 0)
	4404	; Get Tra nsaction A mount - Qu it if Amou nt is zero or null
	4405	"RTN","RCC PCAP",159, 0)
	4406	S AMT=$P( $G(^PRCA(4 33,TRANS,1 )),U,5)
	4407	"RTN","RCC PCAP",160, 0)
	4408	I 'AMT Q
	4409	"RTN","RCC PCAP",161, 0)
	4410	; Format Amount
	4411	"RTN","RCC PCAP",162, 0)
	4412	S AMT=$TR ($J(AMT,9, 2)," ","")
	4413	"RTN","RCC PCAP",163, 0)
	4414	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	4415	"RTN","RCC PCAP",164, 0)
	4416	;
	4417	"RTN","RCC PCAP",165, 0)
	4418	S LINE=LI NE+1
	4419	"RTN","RCC PCAP",166, 0)
	4420	S LASTPD= LINE
	4421	"RTN","RCC PCAP",167, 0)
	4422	; Format and Set Da te Entered , Amount, and Delimi ter
	4423	"RTN","RCC PCAP",168, 0)
	4424	S PD="PD" _U_$$DAT^R CCPCFN(DAT E)_U_AMT_U _"}"
	4425	"RTN","RCC PCAP",169, 0)
	4426	;
	4427	"RTN","RCC PCAP",170, 0)
	4428	; Add len gth to SIZ E
	4429	"RTN","RCC PCAP",171, 0)
	4430	S SIZE=SI ZE+$L(PD)
	4431	"RTN","RCC PCAP",172, 0)
	4432	;
	4433	"RTN","RCC PCAP",173, 0)
	4434	; Update file
	4435	"RTN","RCC PCAP",174, 0)
	4436	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P D
	4437	"RTN","RCC PCAP",175, 0)
	4438	D UPDATE^ DIE("","PR CAFDA","LI NE")
	4439	"RTN","RCC PCAP",176, 0)
	4440	;
	4441	"RTN","RCC PCAP",177, 0)
	4442	; Get cur rent PH To tal, add A mount, the n reset to PH Segmen t
	4443	"RTN","RCC PCAP",178, 0)
	4444	S PHTOT=$ P(^RCAP(34 9.5,PSSEG( PSCNTR),1, PHSEG(PHCN TR),0),U,1 3)
	4445	"RTN","RCC PCAP",179, 0)
	4446	S PHTOT=P HTOT+AMT
	4447	"RTN","RCC PCAP",180, 0)
	4448	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,PHSEG( PHCNTR),0) ,U,13)=PHT OT
	4449	"RTN","RCC PCAP",181, 0)
	4450	;
	4451	"RTN","RCC PCAP",182, 0)
	4452	; Determi ne the Cur rent Bill Date and i f greater than LTBDT , Latest B ill Date,
	4453
	4454	"RTN","RCC PCAP",183, 0)
	4455	; set to PH Segment and LTBDT
	4456	"RTN","RCC PCAP",184, 0)
	4457	S BILL=$P ($G(^PRCA( 433,TRANS, 0)),U,2)
	4458	"RTN","RCC PCAP",185, 0)
	4459	S CURBDT= $P($G(^PRC A(430,BILL ,0)),U,10)
	4460	"RTN","RCC PCAP",186, 0)
	4461	I CURBDT> LTBDT S $P (^RCAP(349 .5,PSSEG(P SCNTR),1,P HSEG(PHCNT R),0),U,17 )=$$DAT^R
	4462	CCPCFN(CUR BDT),LTBDT =CURBDT
	4463	"RTN","RCC PCAP",187, 0)
	4464	;
	4465	"RTN","RCC PCAP",188, 0)
	4466	; Increme nt PH segm ent piece 18 with an other PD r ecord
	4467	"RTN","RCC PCAP",189, 0)
	4468	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,PHSEG( PHCNTR),0) ,U,18)=$P( ^RCAP(349. 5,PSSEG(P
	4469	SCNTR),1,P HSEG(PHCNT R),0),U,18 )+1
	4470	"RTN","RCC PCAP",190, 0)
	4471	Q
	4472	"RTN","RCC PCAP",191, 0)
	4473	;
	4474	"RTN","RCC PCAR")
	4475	0^23^B4748 8689^n/a
	4476	"RTN","RCC PCAR",1,0)
	4477	RCCPCAR ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT R EPORT ; 2/ 3/2016 11: 30 am
	4478	"RTN","RCC PCAR",2,0)
	4479	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 118
	4480	"RTN","RCC PCAR",3,0)
	4481	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4482	"RTN","RCC PCAR",4,0)
	4483	EN(YEAR) ; Report errors for the payme nt stateme nts for Ye ar entered
	4484	"RTN","RCC PCAR",5,0)
	4485	; Year is the first three num bers of th e Internal Date form at
	4486	"RTN","RCC PCAR",6,0)
	4487	;
	4488	"RTN","RCC PCAR",7,0)
	4489	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	4490	"RTN","RCC PCAR",8,0)
	4491	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	4492	"RTN","RCC PCAR",9,0)
	4493	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	4494	"RTN","RCC PCAR",10,0 )
	4495	. W !,"Tr y again la ter."
	4496	"RTN","RCC PCAR",11,0 )
	4497	;
	4498	"RTN","RCC PCAR",12,0 )
	4499	K ^TMP($J ,"MSG")
	4500	"RTN","RCC PCAR",13,0 )
	4501	N STARTDT ,ENDDT,LIN E,DEBTOR,P ATSSN
	4502	"RTN","RCC PCAR",14,0 )
	4503	;
	4504	"RTN","RCC PCAR",15,0 )
	4505	; Initial ize YEAR t o current year if Nu ll
	4506	"RTN","RCC PCAR",16,0 )
	4507	I $G(YEAR )="" S YEA R=$E(DT,1, 3)
	4508	"RTN","RCC PCAR",17,0 )
	4509	;
	4510	"RTN","RCC PCAR",18,0 )
	4511	; Set Sta rt and End Dates
	4512	"RTN","RCC PCAR",19,0 )
	4513	S STARTDT =YEAR_"010 0"
	4514	"RTN","RCC PCAR",20,0 )
	4515	S ENDDT=Y EAR_1232
	4516	"RTN","RCC PCAR",21,0 )
	4517	S LINE=0
	4518	"RTN","RCC PCAR",22,0 )
	4519	S DEBTOR= ""
	4520	"RTN","RCC PCAR",23,0 )
	4521	F S DEBT OR=$O(^PRC A(433,"ATD ",DEBTOR)) Q:DEBTOR= "" D
	4522	"RTN","RCC PCAR",24,0 )
	4523	. ; Quit if the deb tor is not a patient
	4524	"RTN","RCC PCAR",25,0 )
	4525	. I '$D(^ RCD(340,"A B","DPT(", DEBTOR)) Q
	4526	"RTN","RCC PCAR",26,0 )
	4527	. N DATE, PATERROR,P HSET
	4528	"RTN","RCC PCAR",27,0 )
	4529	. S (PHSE T,PATERROR )=0
	4530	"RTN","RCC PCAR",28,0 )
	4531	. S DATE= STARTDT
	4532	"RTN","RCC PCAR",29,0 )
	4533	. F S DA TE=$O(^PRC A(433,"ATD ",DEBTOR,D ATE)) Q:DA TE="" Q:D ATE>ENDDT D
	4534	"RTN","RCC PCAR",30,0 )
	4535	.. ; Rech eck and Qu it if the date is no t within t he Year
	4536	"RTN","RCC PCAR",31,0 )
	4537	.. I DATE <STARTDT!( DATE>ENDDT ) Q
	4538	"RTN","RCC PCAR",32,0 )
	4539	.. ; Set Final Date for this Debtor to determine final tran saction
	4540	"RTN","RCC PCAR",33,0 )
	4541	.. N TRAN S
	4542	"RTN","RCC PCAR",34,0 )
	4543	.. S TRAN S=""
	4544	"RTN","RCC PCAR",35,0 )
	4545	.. F S T RANS=$O(^P RCA(433,"A TD",DEBTOR ,DATE,TRAN S)) Q:TRAN S="" D
	4546	"RTN","RCC PCAR",36,0 )
	4547	... ; Qui t if the T ransaction Type is n ot Payment in Part(2 ) or Payme nt in Ful
	4548	l(34)
	4549	"RTN","RCC PCAR",37,0 )
	4550	... I $P( ^PRCA(433, TRANS,1),U ,2)'=2&($P (^PRCA(433 ,TRANS,1), U,2)'=34) Q
	4551	"RTN","RCC PCAR",38,0 )
	4552	... ; Che ck PH Reco rd if firs t time for this Debt or
	4553	"RTN","RCC PCAR",39,0 )
	4554	... I 'PH SET D CHEC KPH(DEBTOR ) S PHSET= 1
	4555	"RTN","RCC PCAR",40,0 )
	4556	... ; Che ck PD Reco rd for eac h Payment Transactio n
	4557	"RTN","RCC PCAR",41,0 )
	4558	... D CHE CKPD(DEBTO R,DATE,TRA NS)
	4559	"RTN","RCC PCAR",42,0 )
	4560	;
	4561	"RTN","RCC PCAR",43,0 )
	4562	; If ther e are any errors Sen d MailMan Message wi th Errors in ^TMP($J ,"MSG")
	4563	"RTN","RCC PCAR",44,0 )
	4564	I $D(^TMP ($J,"MSG") ) D TRANSM IT
	4565	"RTN","RCC PCAR",45,0 )
	4566	; If ther e are no e rrors Send MailMan M essage wit h No Error s Line
	4567	"RTN","RCC PCAR",46,0 )
	4568	I '$D(^TM P($J,"MSG" )) D
	4569	"RTN","RCC PCAR",47,0 )
	4570	. S ^TMP( $J,"MSG",1 ,0)="No an nual patie nt payment data inco nsistencie s found."
	4571	"RTN","RCC PCAR",48,0 )
	4572	. D TRANS MIT
	4573	"RTN","RCC PCAR",49,0 )
	4574	;
	4575	"RTN","RCC PCAR",50,0 )
	4576	K ^TMP($J ,"MSG")
	4577	"RTN","RCC PCAR",51,0 )
	4578	; PRCA4. 5313 - Un lock follo wing trans mission
	4579	"RTN","RCC PCAR",52,0 )
	4580	L -^TMP($ J,"MSG"):D ILOCKTM
	4581	"RTN","RCC PCAR",53,0 )
	4582	Q
	4583	"RTN","RCC PCAR",54,0 )
	4584	;
	4585	"RTN","RCC PCAR",55,0 )
	4586	CHECKPH(DE BTOR) ; C heck Data for PH Rec ord
	4587	"RTN","RCC PCAR",56,0 )
	4588	N SSN,PAT NAME,I,ARA DDR,ADDRER ,DFN,ICN,B ILLDATE,CO UNTRY,ST
	4589	"RTN","RCC PCAR",57,0 )
	4590	;
	4591	"RTN","RCC PCAR",58,0 )
	4592	; Get and Check DFN for Debto r. If DFN is Null o r does not start wit h a numbe
	4593	r
	4594	"RTN","RCC PCAR",59,0 )
	4595	; write E rror with Debtor Num ber and th en Quit, a s other da ta is depe ndent upo
	4596	n DFN
	4597	"RTN","RCC PCAR",60,0 )
	4598	S DFN=+$P (^RCD(340, DEBTOR,0), U)
	4599	"RTN","RCC PCAR",61,0 )
	4600	I 'DFN D SETERROR(" Debtor Num ber: "_DEB TOR,"Missi ng DFN") Q
	4601	"RTN","RCC PCAR",62,0 )
	4602	;
	4603	"RTN","RCC PCAR",63,0 )
	4604	; Get Pat ient Name and SSN
	4605	"RTN","RCC PCAR",64,0 )
	4606	S PATNAME =$$NAM^RCF N01(DEBTOR )
	4607	"RTN","RCC PCAR",65,0 )
	4608	S SSN=$$S SN^RCFN01( DEBTOR)
	4609	"RTN","RCC PCAR",66,0 )
	4610	S PATSSN= PATNAME_" LAST-4: " _$E(SSN,6, 9)
	4611	"RTN","RCC PCAR",67,0 )
	4612	;
	4613	"RTN","RCC PCAR",68,0 )
	4614	; Get and Check DFN and ICN f or Debtor and Patien t
	4615	"RTN","RCC PCAR",69,0 )
	4616	I $L(DFN) >8 D SETER ROR(PATSSN ,"Invalid DFN")
	4617	"RTN","RCC PCAR",70,0 )
	4618	S ICN=$$G ETICN^MPIF 001(DFN)
	4619	"RTN","RCC PCAR",71,0 )
	4620	I +ICN=-1 !($L(ICN)> 17) D SETE RROR(PATSS N,"Missing or Invali d ICN")
	4621	"RTN","RCC PCAR",72,0 )
	4622	;
	4623	"RTN","RCC PCAR",73,0 )
	4624	; Check P atient Nam e and SSN
	4625	"RTN","RCC PCAR",74,0 )
	4626	I SSN=""! (SSN'?9N) D SETERROR (PATSSN,"M issing or Invalid SS N")
	4627	"RTN","RCC PCAR",75,0 )
	4628	I $P(PATN AME,",")=" " D SETERR OR(PATSSN, "Missing o r Invalid Last Name" )
	4629	"RTN","RCC PCAR",76,0 )
	4630	I $P($P(P ATNAME,"," ,2)," ")=" " D SETERR OR(PATSSN, "Missing o r Invalid First Nam
	4631	e")
	4632	"RTN","RCC PCAR",77,0 )
	4633	;
	4634	"RTN","RCC PCAR",78,0 )
	4635	; Get and Check Add ress
	4636	"RTN","RCC PCAR",79,0 )
	4637	S ARADDR= $P($$DADD^ RCAMADD(DE BTOR,1),U, 1,6)
	4638	"RTN","RCC PCAR",80,0 )
	4639	F I=1,4 I $P(ARADDR ,U,I)=""!( $L($P(ARAD DR,U,I))>4 0!('$L($TR ($P(ARADDR ,U,I)," "
	4640	,"")))) D
	4641	"RTN","RCC PCAR",81,0 )
	4642	. S ADDRE R(I)=$S(I= 1:"Address Line 1",I =4:"City")
	4643	"RTN","RCC PCAR",82,0 )
	4644	. D SETER ROR(PATSSN ,"Missing or Invalid "_ADDRER( I))
	4645	"RTN","RCC PCAR",83,0 )
	4646	N ADDRER
	4647	"RTN","RCC PCAR",84,0 )
	4648	F I=2,3 I $L($P(ARA DDR,U,I))> 40 D
	4649	"RTN","RCC PCAR",85,0 )
	4650	. S ADDRE R(I)=$S(I= 2:"Address Line 2",I =3:"Addres s Line 3")
	4651	"RTN","RCC PCAR",86,0 )
	4652	. D SETER ROR(PATSSN ,"Invalid "_ADDRER(I ))
	4653	"RTN","RCC PCAR",87,0 )
	4654	;
	4655	"RTN","RCC PCAR",88,0 )
	4656	; If the Zip Code i s Null fro m DADD^RCM ADD set Pi ece 6 of A RADDR to P iece 6 of
	4657	.11
	4658	"RTN","RCC PCAR",89,0 )
	4659	I $P(ARAD DR,U,6)="" S $P(ARAD DR,U,6)=$P ($G(^DPT(D FN,.11)),U ,6)
	4660	"RTN","RCC PCAR",90,0 )
	4661	;
	4662	"RTN","RCC PCAR",91,0 )
	4663	; If Coun try is not '1' get C ountry Nam e for use in validat ing the St ate and Z
	4664	ip Code
	4665	"RTN","RCC PCAR",92,0 )
	4666	S COUNTRY =$P($G(^DP T(DFN,.11) ),U,10)
	4667	"RTN","RCC PCAR",93,0 )
	4668	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	4669	"RTN","RCC PCAR",94,0 )
	4670	; State h as three E rror condi tions
	4671	"RTN","RCC PCAR",95,0 )
	4672	; If the State is N ot Null an d is not 2 character s
	4673	"RTN","RCC PCAR",96,0 )
	4674	; If the State is N ot Null an d is not a Valid US State
	4675	"RTN","RCC PCAR",97,0 )
	4676	; If the State is N ot Null an d the Coun try is Not Null
	4677	"RTN","RCC PCAR",98,0 )
	4678	; If the State is N ull and th e Country is Null
	4679	"RTN","RCC PCAR",99,0 )
	4680	I $P(ARAD DR,U,5)'=" ",$L($P(AR ADDR,U,5)) '=2 D SETE RROR(PATSS N,"Missing or Inval
	4681	id State")
	4682	"RTN","RCC PCAR",100, 0)
	4683	S ST=$O(^ DIC(5,"C", $P(ARADDR, U,5),""))
	4684	"RTN","RCC PCAR",101, 0)
	4685	I $P(ARAD DR,U,5)'=" ",ST="" D SETERROR(P ATSSN,"Mis sing or In valid Stat e")
	4686	"RTN","RCC PCAR",102, 0)
	4687	I $P(ARAD DR,U,5)'=" ",ST'="",$ P(^DIC(5,S T,0),U,6)' =1 D SETER ROR(PATSSN ,"Missing
	4688	or Invali d State")
	4689	"RTN","RCC PCAR",103, 0)
	4690	I $P(ARAD DR,U,5)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid State
	4691	")
	4692	"RTN","RCC PCAR",104, 0)
	4693	I $P(ARAD DR,U,5)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d State")
	4694	"RTN","RCC PCAR",105, 0)
	4695	; Zip Cod e has thre e Error co nditions
	4696	"RTN","RCC PCAR",106, 0)
	4697	; If the Zip Code i s Not Null and is no t 5 to 9 N umerics
	4698	"RTN","RCC PCAR",107, 0)
	4699	; If the Zip Code i s Not Null and the C ountry is Not Null
	4700	"RTN","RCC PCAR",108, 0)
	4701	; If the Zip Code i s Null and the Count ry is Null
	4702	"RTN","RCC PCAR",109, 0)
	4703	I $P(ARAD DR,U,6)'=" "&($P(ARAD DR,U,6)'?5 .9N) D SET ERROR(PATS SN,"Missin g or Inva
	4704	lid Zip Co de")
	4705	"RTN","RCC PCAR",110, 0)
	4706	I $P(ARAD DR,U,6)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid Zip C
	4707	ode")
	4708	"RTN","RCC PCAR",111, 0)
	4709	I $P(ARAD DR,U,6)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d Zip Cod
	4710	e")
	4711	"RTN","RCC PCAR",112, 0)
	4712	Q
	4713	"RTN","RCC PCAR",113, 0)
	4714	;
	4715	"RTN","RCC PCAR",114, 0)
	4716	CHECKPD(DE BTOR,DATE, TRANS) ; Get and Se t Data for PD Record into 349. 5
	4717	"RTN","RCC PCAR",115, 0)
	4718	N AMT
	4719	"RTN","RCC PCAR",116, 0)
	4720	; Get and Check Tra nsaction A mount
	4721	"RTN","RCC PCAR",117, 0)
	4722	S AMT=$P( ^PRCA(433, TRANS,1),U ,5)
	4723	"RTN","RCC PCAR",118, 0)
	4724	; Format Amount
	4725	"RTN","RCC PCAR",119, 0)
	4726	S AMT=$TR ($J(AMT,9, 2)," ","")
	4727	"RTN","RCC PCAR",120, 0)
	4728	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	4729	"RTN","RCC PCAR",121, 0)
	4730	I 'AMT!($ L(AMT)>10) D SETERRO R(PATSSN," Amount in Transactio n "_TRANS_ " Invalid
	4731	")
	4732	"RTN","RCC PCAR",122, 0)
	4733	;
	4734	"RTN","RCC PCAR",123, 0)
	4735	; Get and Check Tra nsaction D ate
	4736	"RTN","RCC PCAR",124, 0)
	4737	I $P(DATE ,".")'?7N. N D SETERR OR(PATSSN, "Date for Transactio n "_TRANS_ " Invalid
	4738	")
	4739	"RTN","RCC PCAR",125, 0)
	4740	Q
	4741	"RTN","RCC PCAR",126, 0)
	4742	;
	4743	"RTN","RCC PCAR",127, 0)
	4744	SETERROR(P ATSSN,ERRO R) ; Set the error into TMP($ J,"MSG",LI NE,0) for transmiss
	4745	ion
	4746	"RTN","RCC PCAR",128, 0)
	4747	; If the first time thru for this patie nt set the Name and SSN in mes sage
	4748	"RTN","RCC PCAR",129, 0)
	4749	; with a blank line above the Patient D ata for sp acing
	4750	"RTN","RCC PCAR",130, 0)
	4751	I 'PATERR OR D
	4752	"RTN","RCC PCAR",131, 0)
	4753	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=" "
	4754	"RTN","RCC PCAR",132, 0)
	4755	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=P ATSSN
	4756	"RTN","RCC PCAR",133, 0)
	4757	. S PATER ROR=1
	4758	"RTN","RCC PCAR",134, 0)
	4759	; Write E rror to ne xt line wi th a doubl e space in front
	4760	"RTN","RCC PCAR",135, 0)
	4761	S LINE=LI NE+1 S ^TM P($J,"MSG" ,LINE,0)=" "_ERROR
	4762	"RTN","RCC PCAR",136, 0)
	4763	Q
	4764	"RTN","RCC PCAR",137, 0)
	4765	;
	4766	"RTN","RCC PCAR",138, 0)
	4767	TRANSMIT ; set up and send mail message - copied fr om RCCPCML
	4768	"RTN","RCC PCAR",139, 0)
	4769	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY
	4770	"RTN","RCC PCAR",140, 0)
	4771	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT ERROR R EPORT "_20 _$E(YEAR,2 ,3)_" TO
	4772	CURRENT DA TE"
	4773	"RTN","RCC PCAR",141, 0)
	4774	S XMDUZ=" AR PACKAGE "
	4775	"RTN","RCC PCAR",142, 0)
	4776	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	4777	CCPC STATE MENTS")=""
	4778	"RTN","RCC PCAR",143, 0)
	4779	S XMDUZ=" AR PACKAGE "
	4780	"RTN","RCC PCAR",144, 0)
	4781	D XMZ^XMA 2
	4782	"RTN","RCC PCAR",145, 0)
	4783	I XMZ<1 S RTY=RTY+1 G TRANSMI T:RTY<4 S ERROR=5,NM =0 D ERROR Q
	4784	"RTN","RCC PCAR",146, 0)
	4785	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) I $ D(^TMP($J, "MSG",L(1
	4786	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	4787	"RTN","RCC PCAR",147, 0)
	4788	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	4789	"RTN","RCC PCAR",148, 0)
	4790	D ENT1^XM D
	4791	"RTN","RCC PCAR",149, 0)
	4792	D NOW^%DT C
	4793	"RTN","RCC PCAR",150, 0)
	4794	Q
	4795	"RTN","RCC PCAR",151, 0)
	4796	;
	4797	"RTN","RCC PCAR",152, 0)
	4798	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	4799	"RTN","RCC PCAR",153, 0)
	4800	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	4801	"RTN","RCC PCAR",154, 0)
	4802	Q
	4803	"RTN","RCC PCAR",155, 0)
	4804	;
	4805	"RTN","RCC PCAR",156, 0)
	4806	MANBLD ; Build and Transmit t he Annual Payment St atement Co nsistency Checker
	4807	"RTN","RCC PCAR",157, 0)
	4808	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	4809	"RTN","RCC PCAR",158, 0)
	4810	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	4811	"RTN","RCC PCAR",159, 0)
	4812	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	4813	"RTN","RCC PCAR",160, 0)
	4814	. W !,"Tr y again la ter."
	4815	"RTN","RCC PCAR",161, 0)
	4816	; PRCA4. 5313 - Un lock prior to prepar ing and tr ansmitting
	4817	"RTN","RCC PCAR",162, 0)
	4818	L -^TMP($ J,"MSG"):D ILOCKTM
	4819	"RTN","RCC PCAR",163, 0)
	4820	;
	4821	"RTN","RCC PCAR",164, 0)
	4822	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T,%,%H
	4823	"RTN","RCC PCAR",165, 0)
	4824	S YEAR=20 _$E(DT,2,3 )
	4825	"RTN","RCC PCAR",166, 0)
	4826	S DIR(0)= "YAO"
	4827	"RTN","RCC PCAR",167, 0)
	4828	S DIR("B" )="N"
	4829	"RTN","RCC PCAR",168, 0)
	4830	S DIR("A" )="Do you want to Ru n and Tran smit the C onsistency Checker f or "_YEAR
	4831	_" to the current da te? "
	4832	"RTN","RCC PCAR",169, 0)
	4833	S DIR("?? ")="^D MAN HLP^RCCPCA R"
	4834	"RTN","RCC PCAR",170, 0)
	4835	D ^DIR
	4836	"RTN","RCC PCAR",171, 0)
	4837	I $E(X)'= "Y" Q
	4838	"RTN","RCC PCAR",172, 0)
	4839	S ZTIO="" ,ZTRTN="EN ^RCCPCAR(" _$E(DT,1,3 )_")"
	4840	"RTN","RCC PCAR",173, 0)
	4841	S ZTDESC= "Annual Pa yment Stat ement File Consisten cy Checker "
	4842	"RTN","RCC PCAR",174, 0)
	4843	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	4844	"RTN","RCC PCAR",175, 0)
	4845	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	4846	"RTN","RCC PCAR",176, 0)
	4847	Q
	4848	"RTN","RCC PCAR",177, 0)
	4849	;
	4850	"RTN","RCC PCAR",178, 0)
	4851	MANHLP ; "??" Help for MANBLD
	4852	"RTN","RCC PCAR",179, 0)
	4853	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Run and Transmit t he Consist ency Chec
	4854	ker."
	4855	"RTN","RCC PCAR",180, 0)
	4856	Q
	4857	"RTN","RCC PCAT")
	4858	0^22^B3452 1600^n/a
	4859	"RTN","RCC PCAT",1,0)
	4860	RCCPCAT ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT T RANSMIT ; 2/3/2016 1 1:30 am
	4861	"RTN","RCC PCAT",2,0)
	4862	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 118
	4863	"RTN","RCC PCAT",3,0)
	4864	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4865	"RTN","RCC PCAT",4,0)
	4866	EN(DTTIME) ;Schedul e the Tran smit
	4867	"RTN","RCC PCAT",5,0)
	4868	N ZTDESC, ZTASK,ZTDT H,ZTIO,ZTR TN
	4869	"RTN","RCC PCAT",6,0)
	4870	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	4871	"RTN","RCC PCAT",7,0)
	4872	S ZTDESC= "ANNUAL PA YMENT STAT EMENT TRAN SMISSION"
	4873	"RTN","RCC PCAT",8,0)
	4874	; Initial ize Transm it date an d time
	4875	"RTN","RCC PCAT",9,0)
	4876	I DTTIME= "" S DTTIM E=%H
	4877	"RTN","RCC PCAT",10,0 )
	4878	S ZTDTH=D TTIME
	4879	"RTN","RCC PCAT",11,0 )
	4880	D ^%ZTLOA D Q:$G(ZTS K)=""
	4881	"RTN","RCC PCAT",12,0 )
	4882	Q
	4883	"RTN","RCC PCAT",13,0 )
	4884	;
	4885	"RTN","RCC PCAT",14,0 )
	4886	TRANSMIT ; Send Ann ual Paymen t Statemen t Files to AITC from RCAP(349. 5
	4887	"RTN","RCC PCAT",15,0 )
	4888	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	4889	"RTN","RCC PCAT",16,0 )
	4890	L +^RCAP( 349.5):DIL OCKTM I '$ T W 7,7, !,"Annual Payment is already b eing run
	4891	or transmi tted. Try again lat er." Q
	4892	"RTN","RCC PCAT",17,0 )
	4893	;
	4894	"RTN","RCC PCAT",18,0 )
	4895	K ^TMP($J ,"MSG")
	4896	"RTN","RCC PCAT",19,0 )
	4897	N PSCNTR, %,%I,%H,YE AR
	4898	"RTN","RCC PCAT",20,0 )
	4899	S YEAR=20 _$E($P(^RC AP(349.5,1 ,0),U,2),2 ,3)
	4900	"RTN","RCC PCAT",21,0 )
	4901	S PSCNTR= 0
	4902	"RTN","RCC PCAT",22,0 )
	4903	F S PSCN TR=$O(^RCA P(349.5,PS CNTR)) Q:' PSCNTR D
	4904	"RTN","RCC PCAT",23,0 )
	4905	. ; Set T ransmit St art Date a nd Time
	4906	"RTN","RCC PCAT",24,0 )
	4907	. D NOW^% DTC
	4908	"RTN","RCC PCAT",25,0 )
	4909	. S $P(^R CAP(349.5, PSCNTR,0), U,5)=%
	4910	"RTN","RCC PCAT",26,0 )
	4911	. ; Merge all PS el ements int o TMP MSG file
	4912	"RTN","RCC PCAT",27,0 )
	4913	. M ^TMP( $J,"MSG")= ^RCAP(349. 5,PSCNTR,1 )
	4914	"RTN","RCC PCAT",28,0 )
	4915	. D MAIL
	4916	"RTN","RCC PCAT",29,0 )
	4917	. ; Set T ransmit En d Date and Time
	4918	"RTN","RCC PCAT",30,0 )
	4919	. D NOW^% DTC
	4920	"RTN","RCC PCAT",31,0 )
	4921	. S $P(^R CAP(349.5, PSCNTR,0), U,6)=%
	4922	"RTN","RCC PCAT",32,0 )
	4923	;
	4924	"RTN","RCC PCAT",33,0 )
	4925	; PRCA4. 5313 - Un lock prior to quit
	4926	"RTN","RCC PCAT",34,0 )
	4927	L -^RCAP( 349.5):DIL OCKTM
	4928	"RTN","RCC PCAT",35,0 )
	4929	Q
	4930	"RTN","RCC PCAT",36,0 )
	4931	;
	4932	"RTN","RCC PCAT",37,0 )
	4933	MAIL ;set up and sen d mail mes sage - cop ied from R CCPCML
	4934	"RTN","RCC PCAT",38,0 )
	4935	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	4936	"RTN","RCC PCAT",39,0 )
	4937	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT TRANSMI SSION "_YE AR
	4938	"RTN","RCC PCAT",40,0 )
	4939	S XMDUZ=" AR PACKAGE "
	4940	"RTN","RCC PCAT",41,0 )
	4941	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	4942	CCPC STATE MENTS")=""
	4943	"RTN","RCC PCAT",42,0 )
	4944	S X=$O(^R CT(349.1," B","PY",0) )
	4945	"RTN","RCC PCAT",43,0 )
	4946	I X,$P($G (^RCT(349. 1,+X,0)),U ,3) S X=$P ($G(^RCT(3 49.1,+X,3) ),U)_"@"_$ P($G(^RCT
	4947	(349.1,+X, 3)),U,3) S :$P(X,"@", 2)]"" XMY( X)=""
	4948	"RTN","RCC PCAT",44,0 )
	4949	I $P(X,"@ ",2)']"" D Q
	4950	"RTN","RCC PCAT",45,0 )
	4951	.S ERROR= 6,NM=0 D E RROR
	4952	"RTN","RCC PCAT",46,0 )
	4953	S XMDUZ=" AR PACKAGE "
	4954	"RTN","RCC PCAT",47,0 )
	4955	D XMZ^XMA 2
	4956	"RTN","RCC PCAT",48,0 )
	4957	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	4958	"RTN","RCC PCAT",49,0 )
	4959	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) I $ D(^TMP($J, "MSG",L(1
	4960	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	4961	"RTN","RCC PCAT",50,0 )
	4962	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	4963	"RTN","RCC PCAT",51,0 )
	4964	D ENT1^XM D
	4965	"RTN","RCC PCAT",52,0 )
	4966	D NOW^%DT C
	4967	"RTN","RCC PCAT",53,0 )
	4968	K ^TMP($J ,"MSG")
	4969	"RTN","RCC PCAT",54,0 )
	4970	Q
	4971	"RTN","RCC PCAT",55,0 )
	4972	;
	4973	"RTN","RCC PCAT",56,0 )
	4974	SCHED(SITE ) ; Deter mine the d ate and ti me for Tra nsmit base d upon Sit e Code an
	4975	d table AI TC provide d
	4976	"RTN","RCC PCAT",57,0 )
	4977	; Time wi ll always be 2:00 AM
	4978	"RTN","RCC PCAT",58,0 )
	4979	I SITE>40 1&(SITE<52 0) S DTTIM E=$E(DT,1, 5)_"03.020 000" Q DTT IME
	4980	"RTN","RCC PCAT",59,0 )
	4981	I SITE>51 9&(SITE<54 1) S DTTIM E=$E(DT,1, 5)_"04.020 000" Q DTT IME
	4982	"RTN","RCC PCAT",60,0 )
	4983	I SITE>54 0&(SITE<55 9) S DTTIM E=$E(DT,1, 5)_"05.020 000" Q DTT IME
	4984	"RTN","RCC PCAT",61,0 )
	4985	I SITE>56 0&(SITE<58 1) S DTTIM E=$E(DT,1, 5)_"06.020 000" Q DTT IME
	4986	"RTN","RCC PCAT",62,0 )
	4987	I SITE>58 0&(SITE<59 9) S DTTIM E=$E(DT,1, 5)_"07.020 000" Q DTT IME
	4988	"RTN","RCC PCAT",63,0 )
	4989	I SITE>59 9&(SITE<62 0) S DTTIM E=$E(DT,1, 5)_"08.020 000" Q DTT IME
	4990	"RTN","RCC PCAT",64,0 )
	4991	I SITE>61 9&(SITE<64 1) S DTTIM E=$E(DT,1, 5)_"09.020 000" Q DTT IME
	4992	"RTN","RCC PCAT",65,0 )
	4993	I SITE>64 1&(SITE<65 8) S DTTIM E=$E(DT,1, 5)_"10.020 000" Q DTT IME
	4994	"RTN","RCC PCAT",66,0 )
	4995	I SITE>65 7&(SITE<67 5) S DTTIM E=$E(DT,1, 5)_"11.020 000" Q DTT IME
	4996	"RTN","RCC PCAT",67,0 )
	4997	I SITE>67 4&(SITE<75 8) S DTTIM E=$E(DT,1, 5)_"12.020 000" Q DTT IME
	4998	"RTN","RCC PCAT",68,0 )
	4999	S DTTIME= ""
	5000	"RTN","RCC PCAT",69,0 )
	5001	Q DTTIME
	5002	"RTN","RCC PCAT",70,0 )
	5003	;
	5004	"RTN","RCC PCAT",71,0 )
	5005	MANBLD ; Build and Transmit t he Annual Payment St atement af ter initia l yearly
	5006	transmissi on
	5007	"RTN","RCC PCAT",72,0 )
	5008	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5009	"RTN","RCC PCAT",73,0 )
	5010	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	5011	"RTN","RCC PCAT",74,0 )
	5012	; PRCA4. 5313 - Un lock prior to transm itting
	5013	"RTN","RCC PCAT",75,0 )
	5014	L -^RCAP( 349.5):DIL OCKTM
	5015	"RTN","RCC PCAT",76,0 )
	5016	;
	5017	"RTN","RCC PCAT",77,0 )
	5018	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	5019	"RTN","RCC PCAT",78,0 )
	5020	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	5021	"RTN","RCC PCAT",79,0 )
	5022	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	5023	"RTN","RCC PCAT",80,0 )
	5024	S YEAR("E XT")=20_$E (YEAR,2,3)
	5025	"RTN","RCC PCAT",81,0 )
	5026	S DATE=+$ P($G(^RCAP (349.5,1,0 )),U,6)
	5027	"RTN","RCC PCAT",82,0 )
	5028	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	5029	"RTN","RCC PCAT",83,0 )
	5030	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_".
	5031	"
	5032	"RTN","RCC PCAT",84,0 )
	5033	S DIR(0)= "YAO"
	5034	"RTN","RCC PCAT",85,0 )
	5035	S DIR("B" )="N"
	5036	"RTN","RCC PCAT",86,0 )
	5037	S DIR("A" )="Do you want to Bu ild and Tr ansmit the file for "_YEAR("EX T")_" aga
	5038	in? "
	5039	"RTN","RCC PCAT",87,0 )
	5040	S DIR("?? ")="^D MAN HLP^RCCPCA T"
	5041	"RTN","RCC PCAT",88,0 )
	5042	D ^DIR
	5043	"RTN","RCC PCAT",89,0 )
	5044	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	5045	"RTN","RCC PCAT",90,0 )
	5046	I $E(X)'= "Y" Q
	5047	"RTN","RCC PCAT",91,0 )
	5048	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	5049	"RTN","RCC PCAT",92,0 )
	5050	S ZTIO="" ,ZTRTN="EN ^RCCPCAP(" _YEAR_","_ """F"""_", "_""""""_" )"
	5051	"RTN","RCC PCAT",93,0 )
	5052	S ZTDESC= "Build Ann ual Paymen t Statemen t File"
	5053	"RTN","RCC PCAT",94,0 )
	5054	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	5055	"RTN","RCC PCAT",95,0 )
	5056	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	5057	"RTN","RCC PCAT",96,0 )
	5058	Q
	5059	"RTN","RCC PCAT",97,0 )
	5060	;
	5061	"RTN","RCC PCAT",98,0 )
	5062	RETRANS ; Retransmi t the exis ting file and allow user to se lect date and time
	5063	"RTN","RCC PCAT",99,0 )
	5064	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5065	"RTN","RCC PCAT",100, 0)
	5066	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	5067	"RTN","RCC PCAT",101, 0)
	5068	; PRCA4. 5313 - Un lock prior to retran smitting
	5069	"RTN","RCC PCAT",102, 0)
	5070	L -^RCAP( 349.5):DIL OCKTM
	5071	"RTN","RCC PCAT",103, 0)
	5072	;
	5073	"RTN","RCC PCAT",104, 0)
	5074	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	5075	"RTN","RCC PCAT",105, 0)
	5076	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	5077	"RTN","RCC PCAT",106, 0)
	5078	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	5079	"RTN","RCC PCAT",107, 0)
	5080	S YEAR("E XT")=20_$E (YEAR,2,3)
	5081	"RTN","RCC PCAT",108, 0)
	5082	S DATE=$P ($G(^RCAP( 349.5,$P(^ RCAP(349.5 ,0),U,4),0 )),U,6)
	5083	"RTN","RCC PCAT",109, 0)
	5084	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	5085	"RTN","RCC PCAT",110, 0)
	5086	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_".
	5087	"
	5088	"RTN","RCC PCAT",111, 0)
	5089	S DIR(0)= "YAO"
	5090	"RTN","RCC PCAT",112, 0)
	5091	S DIR("B" )="N"
	5092	"RTN","RCC PCAT",113, 0)
	5093	S DIR("A" )="Do you want to Re transmit t he existin g file for "_YEAR("E XT")_" ag
	5094	ain? "
	5095	"RTN","RCC PCAT",114, 0)
	5096	S DIR("?? ")="^D RET HLP^RCCPCA T"
	5097	"RTN","RCC PCAT",115, 0)
	5098	D ^DIR
	5099	"RTN","RCC PCAT",116, 0)
	5100	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	5101	"RTN","RCC PCAT",117, 0)
	5102	I $E(X)'= "Y" Q
	5103	"RTN","RCC PCAT",118, 0)
	5104	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	5105	"RTN","RCC PCAT",119, 0)
	5106	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	5107	"RTN","RCC PCAT",120, 0)
	5108	S ZTDESC= "Retransmi t Annual P ayment Sta tement Fil e"
	5109	"RTN","RCC PCAT",121, 0)
	5110	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	5111	"RTN","RCC PCAT",122, 0)
	5112	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	5113	"RTN","RCC PCAT",123, 0)
	5114	Q
	5115	"RTN","RCC PCAT",124, 0)
	5116	;
	5117	"RTN","RCC PCAT",125, 0)
	5118	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	5119	"RTN","RCC PCAT",126, 0)
	5120	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	5121	"RTN","RCC PCAT",127, 0)
	5122	Q
	5123	"RTN","RCC PCAT",128, 0)
	5124	;
	5125	"RTN","RCC PCAT",129, 0)
	5126	MENUERR ; Print err or to scre en if Annu al Payment File has not comple ted for t
	5127	his year
	5128	"RTN","RCC PCAT",130, 0)
	5129	N YEAR
	5130	"RTN","RCC PCAT",131, 0)
	5131	S YEAR=20 _$E(DT,2,3 )-1
	5132	"RTN","RCC PCAT",132, 0)
	5133	W !!,"The Build and Transmit of the Ann ual Paymen t File for "_YEAR_" has not c
	5134	ompleted."
	5135	"RTN","RCC PCAT",133, 0)
	5136	W !,"You may not us e this opt ion until it complet es.",!
	5137	"RTN","RCC PCAT",134, 0)
	5138	D PAUSE^V ALM1
	5139	"RTN","RCC PCAT",135, 0)
	5140	Q
	5141	"RTN","RCC PCAT",136, 0)
	5142	;
	5143	"RTN","RCC PCAT",137, 0)
	5144	MANHLP ; "??" Help for MANBLD and RETRA NS
	5145	"RTN","RCC PCAT",138, 0)
	5146	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Build an d Retransm it file."
	5147	"RTN","RCC PCAT",139, 0)
	5148	Q
	5149	"RTN","RCC PCAT",140, 0)
	5150	;
	5151	"RTN","RCC PCAT",141, 0)
	5152	RETHLP ; "??" Help for MANBLD and RETRA NS
	5153	"RTN","RCC PCAT",142, 0)
	5154	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Retransm it file."
	5155	"RTN","RCC PCAT",143, 0)
	5156	Q
	5157	"RTN","RCC PCBJ")
	5158	0^5^B94409 06^B628849 1
	5159	"RTN","RCC PCBJ",1,0)
	5160	RCCPCBJ ;W ASH-ISC@AL TOONA,PA/N YB-Backgro und Driver for CCPC ;1/7/97 9 :42 AM
	5161	"RTN","RCC PCBJ",2,0)
	5162	;;4.5;Acc ounts Rece ivable;3 4,76,130,1 53,166,195 ,217,237,3 07,313;M ar 20, 19
	5163	95;Build 1 18
	5164	"RTN","RCC PCBJ",3,0)
	5165	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	5166	"RTN","RCC PCBJ",4,0)
	5167	EN ;Starts the backg round job for CCPC 5 days befo re stateme nt day
	5168	"RTN","RCC PCBJ",5,0)
	5169	N X,X1,X2 ,X3,ZTRTN, ZTIO,ZTDTH ,ZTSK,ZTDE SC,SDT,RCF ULL
	5170	"RTN","RCC PCBJ",6,0)
	5171	;D ACK P RCA4.531 3 - Moved into OPEN
	5172	"RTN","RCC PCBJ",7,0)
	5173	D ;run t he cbs nig htly accou nt update program ev eryday
	5174	"RTN","RCC PCBJ",8,0)
	5175	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	5176	"RTN","RCC PCBJ",9,0)
	5177	.S RCFULL =0 ;do not send the full debto r list
	5178	"RTN","RCC PCBJ",10,0 )
	5179	.S ZTIO=" ",ZTRTN="D EBTOR^PRCA CPS1"
	5180	"RTN","RCC PCBJ",11,0 )
	5181	.S ZTDESC ="CBS NIGH TLY ACCOUN T UPDATE P ROGRAM",ZT DTH=$H
	5182	"RTN","RCC PCBJ",12,0 )
	5183	.D ^%ZTLO AD
	5184	"RTN","RCC PCBJ",13,0 )
	5185	;
	5186	"RTN","RCC PCBJ",14,0 )
	5187	I $$DOW^X LFDT(DT,1) =3 D ;run the cbs a uto-correc tion progr am on Wedn esdays
	5188	"RTN","RCC PCBJ",15,0 )
	5189	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	5190	"RTN","RCC PCBJ",16,0 )
	5191	.S ZTIO=" ",ZTRTN="S TART^PRCAC PS",ZTSAVE ("RCFULL") =""
	5192	"RTN","RCC PCBJ",17,0 )
	5193	.S ZTDESC ="PATIENT STATEMENTS AUTO-CORR ECTION PRO GRAM",ZTDT H=$H
	5194	"RTN","RCC PCBJ",18,0 )
	5195	.D ^%ZTLO AD
	5196	"RTN","RCC PCBJ",19,0 )
	5197	;
	5198	"RTN","RCC PCBJ",20,0 )
	5199	; PRCA4. 5313 - Ru n the Annu al Payment Statement Build and Transmit
	5200	"RTN","RCC PCBJ",21,0 )
	5201	; on Janu ary 2nd of each year for the p revious ye ar
	5202	"RTN","RCC PCBJ",22,0 )
	5203	I $E(DT,4 ,7)="0102" D
	5204	"RTN","RCC PCBJ",23,0 )
	5205	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	5206	"RTN","RCC PCBJ",24,0 )
	5207	. S ZTIO= "",ZTRTN=" EN^RCCPCAP ",ZTDTH=$H
	5208	"RTN","RCC PCBJ",25,0 )
	5209	. S ZTDES C="ANNUAL PAYMENT ST ATEMENT BU ILD AND TR ANSMIT"
	5210	"RTN","RCC PCBJ",26,0 )
	5211	. D ^%ZTL OAD
	5212	"RTN","RCC PCBJ",27,0 )
	5213	;
	5214	"RTN","RCC PCBJ",28,0 )
	5215	; PRCA4. 5313 - Ru n the Annu al Payment Error Rep ort on Mar ch, June, September
	5216	and
	5217	"RTN","RCC PCBJ",29,0 )
	5218	; Decembe r 15th
	5219	"RTN","RCC PCBJ",30,0 )
	5220	I $E(DT,4 ,5)="03"!( $E(DT,4,5) ="06")!($E (DT,4,5)=" 09")!($E(D T,4,5)=12) D
	5221	"RTN","RCC PCBJ",31,0 )
	5222	. I $E(DT ,6,7)'=15 Q
	5223	"RTN","RCC PCBJ",32,0 )
	5224	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	5225	"RTN","RCC PCBJ",33,0 )
	5226	. S ZTIO= "",ZTRTN=" EN^RCCPCAR ",ZTDTH=$H
	5227	"RTN","RCC PCBJ",34,0 )
	5228	. S ZTDES C="ANNUAL PAYMENT ER ROR REPORT "
	5229	"RTN","RCC PCBJ",35,0 )
	5230	. D ^%ZTL OAD
	5231	"RTN","RCC PCBJ",36,0 )
	5232	;
	5233	"RTN","RCC PCBJ",37,0 )
	5234	I DT'<$P( $G(^RC(342 ,1,30)),"^ ",1)&(DT'> $P($G(^RC( 342,1,30)) ,"^",2)) D ^RCEXINA
	5235	D
	5236	"RTN","RCC PCBJ",38,0 )
	5237	;
	5238	"RTN","RCC PCBJ",39,0 )
	5239	; PRCA4. 5313 - Se t Statemen t Date to two days i n future a nd save fo r Job
	5240	"RTN","RCC PCBJ",40,0 )
	5241	S X1=DT,X 2=2 D C^%D TC S SDT=X
	5242	"RTN","RCC PCBJ",41,0 )
	5243	S ZTSAVE( "SDT")=SDT
	5244	"RTN","RCC PCBJ",42,0 )
	5245	S ZTIO="" ,ZTRTN="OP EN^RCCPCBJ ",ZTDESC=" CBSS PATIE NT STATEME NT"
	5246	"RTN","RCC PCBJ",43,0 )
	5247	S ZTDTH=$ H D ^%ZTLO AD
	5248	"RTN","RCC PCBJ",44,0 )
	5249	Q
	5250	"RTN","RCC PCBJ",45,0 )
	5251	OPEN ;Upda te Open st atus bills to Active or Cancel lation sta tus
	5252	"RTN","RCC PCBJ",46,0 )
	5253	N DAY,BN, DEBTOR,DA, DIE,DR,P,A MT,DATE
	5254	"RTN","RCC PCBJ",47,0 )
	5255	N ZTSAVE, ZTRTN,ZTDE SC,ZTASK,% ZIS,ZTDTH
	5256	"RTN","RCC PCBJ",48,0 )
	5257	; PRCA4. 5313 - Ch eck the ac knowledgem ent for pr evious mon th
	5258	"RTN","RCC PCBJ",49,0 )
	5259	D TRANCHK ^RCCPCSV1
	5260	"RTN","RCC PCBJ",50,0 )
	5261	; PRCA4. 5313 - Se t DATE and day of mo nth from S DT and pro cess that date's de
	5262	btors
	5263	"RTN","RCC PCBJ",51,0 )
	5264	S DATE=SD T,DAY=+$E( SDT,6,7),D EBTOR=""
	5265	"RTN","RCC PCBJ",52,0 )
	5266	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	5267	"RTN","RCC PCBJ",53,0 )
	5268	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'B
	5269	N D
	5270	"RTN","RCC PCBJ",54,0 )
	5271	..S AMT=0 F P=1:1:5 S AMT=$P( $G(^PRCA(4 30,+BN,7)) ,"^",P)+AM T
	5272	"RTN","RCC PCBJ",55,0 )
	5273	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )),AMT Q
	5274	"RTN","RCC PCBJ",56,0 )
	5275	..S DIE=" ^PRCA(430, ",DA=+BN,D R="8////^S X="_$S(AM T:$O(^PRCA (430.3,"AC ",102,0))
	5276	,1:$O(^PRC A(430.3,"A C",111,0)) ) D ^DIE K DA,DIE,DR
	5277	"RTN","RCC PCBJ",57,0 )
	5278	..Q
	5279	"RTN","RCC PCBJ",58,0 )
	5280	.Q
	5281	"RTN","RCC PCBJ",59,0 )
	5282	;
	5283	"RTN","RCC PCBJ",60,0 )
	5284	; update patient a ccounts wi th interes t and admi n
	5285	"RTN","RCC PCBJ",61,0 )
	5286	N RCLASDA T
	5287	"RTN","RCC PCBJ",62,0 )
	5288	S RCLASDA T=DATE
	5289	"RTN","RCC PCBJ",63,0 )
	5290	I DT>3010 101 D FIRS TPTY^RCBEC HGS
	5291	"RTN","RCC PCBJ",64,0 )
	5292	; PRCA4. 5313 - Ad ded SDT to process a nd send
	5293	"RTN","RCC PCBJ",65,0 )
	5294	D EN^RCCP CPS(SDT)
	5295	"RTN","RCC PCBJ",66,0 )
	5296	D REFUND
	5297	"RTN","RCC PCBJ",67,0 )
	5298	D EN^RCCP CML(SDT)
	5299	"RTN","RCC PCBJ",68,0 )
	5300	Q
	5301	"RTN","RCC PCBJ",69,0 )
	5302	;
	5303	"RTN","RCC PCBJ",70,0 )
	5304	;
	5305	"RTN","RCC PCBJ",71,0 )
	5306	REFUND ;Up date Open status PRE PAYMENT bi lls to REF UND REVIEW
	5307	"RTN","RCC PCBJ",72,0 )
	5308	; PRCA4. 5313 - Ch anged DAY to stateme nt date
	5309	"RTN","RCC PCBJ",73,0 )
	5310	S DEBTOR= 0,DAY=SDT
	5311	"RTN","RCC PCBJ",74,0 )
	5312	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	5313	"RTN","RCC PCBJ",75,0 )
	5314	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'B
	5315	N D
	5316	"RTN","RCC PCBJ",76,0 )
	5317	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )) S X=$$E N^PRCARFU
	5318	(+BN)
	5319	"RTN","RCC PCBJ",77,0 )
	5320	..Q
	5321	"RTN","RCC PCBJ",78,0 )
	5322	.Q
	5323	"RTN","RCC PCBJ",79,0 )
	5324	Q
	5325	"RTN","RCC PCBJ",80,0 )
	5326	;
	5327	"RTN","RCC PCBJ",81,0 )
	5328	ACK ;CHECK FOR ACKNO WLEDGEMENT S PRCA4. 5313 - No longer us ed
	5329	"RTN","RCC PCBJ",82,0 )
	5330	N DEB,MSG ,NO,RCX,X, X1,X2
	5331	"RTN","RCC PCBJ",83,0 )
	5332	S X1=$$ST D^RCCPCFN, X2=DT D ^% DTC I X>3 D
	5333	"RTN","RCC PCBJ",84,0 )
	5334	. D TRANC HK^RCCPCSV 1
	5335	"RTN","RCC PCBJ",85,0 )
	5336	Q
	5337	"RTN","RCC PCFN1")
	5338	0^7^B71817 74^n/a
	5339	"RTN","RCC PCFN1",1,0 )
	5340	RCCPCFN1 ; ALB/TGH-Ad ditional F unction ca lls for CB SS ;12/31/ 96 9:27 A M
	5341	"RTN","RCC PCFN1",2,0 )
	5342	;;4.5;Acc ounts Rece ivable;3 13;Mar 3 1, 2016;Bu ild 118
	5343	"RTN","RCC PCFN1",3,0 )
	5344	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5345	"RTN","RCC PCFN1",4,0 )
	5346	ACSET(NAME ) ; Deter mine the d ay of the month for each new d ebtor to h ave their
	5347	patient s tatement s ent
	5348	"RTN","RCC PCFN1",5,0 )
	5349	; by the site to CB SS for con solidation .
	5350	"RTN","RCC PCFN1",6,0 )
	5351	; Input: NAME = Pa tient's Na me
	5352	"RTN","RCC PCFN1",7,0 )
	5353	; Output: DAY/GROUP = day of month for patient st atement tr ansmission and grou
	5354	p number
	5355	"RTN","RCC PCFN1",8,0 )
	5356	; 0 = if i nvalid fir st charact er of last name
	5357	"RTN","RCC PCFN1",9,0 )
	5358	;
	5359	"RTN","RCC PCFN1",10, 0)
	5360	N LTR,GRO UP,DAY,I
	5361	"RTN","RCC PCFN1",11, 0)
	5362	;
	5363	"RTN","RCC PCFN1",12, 0)
	5364	; Quit if the patie nt name is not cross -reference d in the P atient Fil e (#2) -
	5365	return 0
	5366	"RTN","RCC PCFN1",13, 0)
	5367	I $G(NAME )="" Q 0
	5368	"RTN","RCC PCFN1",14, 0)
	5369	I '$D(^DP T("B",NAME )) Q 0
	5370	"RTN","RCC PCFN1",15, 0)
	5371	;
	5372	"RTN","RCC PCFN1",16, 0)
	5373	F I=1,2 S LTR(I)=$E (NAME,I)
	5374	"RTN","RCC PCFN1",17, 0)
	5375	I "AB"[LT R(1) S GRO UP=1,DAY=$ $GRP1(.LTR ) Q DAY_" /"_GROUP
	5376	"RTN","RCC PCFN1",18, 0)
	5377	I "CD"[LT R(1) S GRO UP=2,DAY=$ $GRP2(.LTR ) Q DAY_" /"_GROUP
	5378	"RTN","RCC PCFN1",19, 0)
	5379	I "EFIQ"[ LTR(1) S G ROUP=3,DAY =$$GRP3(.L TR) Q DAY _"/"_GROUP
	5380	"RTN","RCC PCFN1",20, 0)
	5381	I "GH"[LT R(1) S GRO UP=4,DAY=$ $GRP4(.LTR ) Q DAY_" /"_GROUP
	5382	"RTN","RCC PCFN1",21, 0)
	5383	I "JK"[LT R(1) S GRO UP=5,DAY=$ $GRP5(.LTR ) Q DAY_" /"_GROUP
	5384	"RTN","RCC PCFN1",22, 0)
	5385	I "LO"[LT R(1) S GRO UP=6,DAY=$ $GRP6(.LTR ) Q DAY_" /"_GROUP
	5386	"RTN","RCC PCFN1",23, 0)
	5387	I "MN"[LT R(1) S GRO UP=7,DAY=$ $GRP7(.LTR ) Q DAY_" /"_GROUP
	5388	"RTN","RCC PCFN1",24, 0)
	5389	I "T"[LTR (1) S GROU P=8,DAY=$$ GRP8(.LTR) Q DAY_"/ "_GROUP
	5390	"RTN","RCC PCFN1",25, 0)
	5391	I "R"[LTR (1) S GROU P=9,DAY=$$ GRP9(.LTR) Q DAY_"/ "_GROUP
	5392	"RTN","RCC PCFN1",26, 0)
	5393	I "SV"[LT R(1) S GRO UP=10,DAY= $$GRP10(.L TR) Q DAY _"/"_GROUP
	5394	"RTN","RCC PCFN1",27, 0)
	5395	I "PUXYZ" [LTR(1) S GROUP=11,D AY=$$GRP11 (.LTR) Q DAY_"/"_GR OUP
	5396	"RTN","RCC PCFN1",28, 0)
	5397	I "W"[LTR (1) S GROU P=12,DAY=$ $GRP12(.LT R) Q DAY_ "/"_GROUP
	5398	"RTN","RCC PCFN1",29, 0)
	5399	;
	5400	"RTN","RCC PCFN1",30, 0)
	5401	Q 0
	5402	"RTN","RCC PCFN1",31, 0)
	5403	;
	5404	"RTN","RCC PCFN1",32, 0)
	5405	GRP1(LTR) ;AB
	5406	"RTN","RCC PCFN1",33, 0)
	5407	;
	5408	"RTN","RCC PCFN1",34, 0)
	5409	I LTR(1)= "A" S DAY= 1
	5410	"RTN","RCC PCFN1",35, 0)
	5411	I LTR(1)= "B" D
	5412	"RTN","RCC PCFN1",36, 0)
	5413	. I "AU"[ LTR(2) S D AY=1
	5414	"RTN","RCC PCFN1",37, 0)
	5415	. I "AU"' [LTR(2) S DAY=2
	5416	"RTN","RCC PCFN1",38, 0)
	5417	;
	5418	"RTN","RCC PCFN1",39, 0)
	5419	Q DAY
	5420	"RTN","RCC PCFN1",40, 0)
	5421	;
	5422	"RTN","RCC PCFN1",41, 0)
	5423	GRP2(LTR) ;CD
	5424	"RTN","RCC PCFN1",42, 0)
	5425	;
	5426	"RTN","RCC PCFN1",43, 0)
	5427	I LTR(1)= "D" S DAY= 4
	5428	"RTN","RCC PCFN1",44, 0)
	5429	I LTR(1)= "C" D
	5430	"RTN","RCC PCFN1",45, 0)
	5431	. I "IRU" [LTR(2) S DAY=4
	5432	"RTN","RCC PCFN1",46, 0)
	5433	. I "IRU" '[LTR(2) S DAY=6
	5434	"RTN","RCC PCFN1",47, 0)
	5435	;
	5436	"RTN","RCC PCFN1",48, 0)
	5437	Q DAY
	5438	"RTN","RCC PCFN1",49, 0)
	5439	;
	5440	"RTN","RCC PCFN1",50, 0)
	5441	GRP3(LTR) ;EFIQ
	5442	"RTN","RCC PCFN1",51, 0)
	5443	;
	5444	"RTN","RCC PCFN1",52, 0)
	5445	S DAY=7
	5446	"RTN","RCC PCFN1",53, 0)
	5447	;
	5448	"RTN","RCC PCFN1",54, 0)
	5449	Q DAY
	5450	"RTN","RCC PCFN1",55, 0)
	5451	;
	5452	"RTN","RCC PCFN1",56, 0)
	5453	GRP4(LTR) ;GH
	5454	"RTN","RCC PCFN1",57, 0)
	5455	;
	5456	"RTN","RCC PCFN1",58, 0)
	5457	I LTR(1)= "G" S DAY= 8
	5458	"RTN","RCC PCFN1",59, 0)
	5459	I LTR(1)= "H" D
	5460	"RTN","RCC PCFN1",60, 0)
	5461	. I "E"[L TR(2) S DA Y=8
	5462	"RTN","RCC PCFN1",61, 0)
	5463	. I "E"'[ LTR(2) S D AY=10
	5464	"RTN","RCC PCFN1",62, 0)
	5465	;
	5466	"RTN","RCC PCFN1",63, 0)
	5467	Q DAY
	5468	"RTN","RCC PCFN1",64, 0)
	5469	;
	5470	"RTN","RCC PCFN1",65, 0)
	5471	GRP5(LTR) ;JK
	5472	"RTN","RCC PCFN1",66, 0)
	5473	;
	5474	"RTN","RCC PCFN1",67, 0)
	5475	S DAY=12
	5476	"RTN","RCC PCFN1",68, 0)
	5477	;
	5478	"RTN","RCC PCFN1",69, 0)
	5479	Q DAY
	5480	"RTN","RCC PCFN1",70, 0)
	5481	;
	5482	"RTN","RCC PCFN1",71, 0)
	5483	GRP6(LTR) ;LO
	5484	"RTN","RCC PCFN1",72, 0)
	5485	;
	5486	"RTN","RCC PCFN1",73, 0)
	5487	S DAY=14
	5488	"RTN","RCC PCFN1",74, 0)
	5489	;
	5490	"RTN","RCC PCFN1",75, 0)
	5491	Q DAY
	5492	"RTN","RCC PCFN1",76, 0)
	5493	;
	5494	"RTN","RCC PCFN1",77, 0)
	5495	GRP7(LTR) ;MN
	5496	"RTN","RCC PCFN1",78, 0)
	5497	;
	5498	"RTN","RCC PCFN1",79, 0)
	5499	I LTR(1)= "N" S DAY= 17
	5500	"RTN","RCC PCFN1",80, 0)
	5501	I LTR(1)= "M" D
	5502	"RTN","RCC PCFN1",81, 0)
	5503	. I "CI"[ LTR(2) S D AY=17
	5504	"RTN","RCC PCFN1",82, 0)
	5505	. I "CI"' [LTR(2) S DAY=15
	5506	"RTN","RCC PCFN1",83, 0)
	5507	;
	5508	"RTN","RCC PCFN1",84, 0)
	5509	Q DAY
	5510	"RTN","RCC PCFN1",85, 0)
	5511	;
	5512	"RTN","RCC PCFN1",86, 0)
	5513	GRP8(LTR) ;T
	5514	"RTN","RCC PCFN1",87, 0)
	5515	;
	5516	"RTN","RCC PCFN1",88, 0)
	5517	I "ABCDE" [LTR(2) S DAY=19
	5518	"RTN","RCC PCFN1",89, 0)
	5519	I "FGH"[L TR(2) S DA Y=22
	5520	"RTN","RCC PCFN1",90, 0)
	5521	I "ABCDEF GH"'[LTR(2 ) S DAY=17
	5522	"RTN","RCC PCFN1",91, 0)
	5523	;
	5524	"RTN","RCC PCFN1",92, 0)
	5525	Q DAY
	5526	"RTN","RCC PCFN1",93, 0)
	5527	;
	5528	"RTN","RCC PCFN1",94, 0)
	5529	GRP9(LTR) ;R
	5530	"RTN","RCC PCFN1",95, 0)
	5531	;
	5532	"RTN","RCC PCFN1",96, 0)
	5533	S DAY=19
	5534	"RTN","RCC PCFN1",97, 0)
	5535	;
	5536	"RTN","RCC PCFN1",98, 0)
	5537	Q DAY
	5538	"RTN","RCC PCFN1",99, 0)
	5539	;
	5540	"RTN","RCC PCFN1",100 ,0)
	5541	GRP10(LTR) ;SV
	5542	"RTN","RCC PCFN1",101 ,0)
	5543	;
	5544	"RTN","RCC PCFN1",102 ,0)
	5545	I LTR(1)= "V" S DAY= 22
	5546	"RTN","RCC PCFN1",103 ,0)
	5547	I LTR(1)= "S" D
	5548	"RTN","RCC PCFN1",104 ,0)
	5549	. I "CHIM "[LTR(2) S DAY=22
	5550	"RTN","RCC PCFN1",105 ,0)
	5551	. I "CHIM "'[LTR(2) S DAY=21
	5552	"RTN","RCC PCFN1",106 ,0)
	5553	;
	5554	"RTN","RCC PCFN1",107 ,0)
	5555	Q DAY
	5556	"RTN","RCC PCFN1",108 ,0)
	5557	;
	5558	"RTN","RCC PCFN1",109 ,0)
	5559	GRP11(LTR) ;PUXYZ
	5560	"RTN","RCC PCFN1",110 ,0)
	5561	;
	5562	"RTN","RCC PCFN1",111 ,0)
	5563	S DAY=24
	5564	"RTN","RCC PCFN1",112 ,0)
	5565	;
	5566	"RTN","RCC PCFN1",113 ,0)
	5567	Q DAY
	5568	"RTN","RCC PCFN1",114 ,0)
	5569	;
	5570	"RTN","RCC PCFN1",115 ,0)
	5571	GRP12(LTR) ;W
	5572	"RTN","RCC PCFN1",116 ,0)
	5573	;
	5574	"RTN","RCC PCFN1",117 ,0)
	5575	S DAY=26
	5576	"RTN","RCC PCFN1",118 ,0)
	5577	;
	5578	"RTN","RCC PCFN1",119 ,0)
	5579	Q DAY
	5580	"RTN","RCC PCML")
	5581	0^8^B67061 934^B47881 024
	5582	"RTN","RCC PCML",1,0)
	5583	RCCPCML ;W ASH-ISC@AL TOONA,PA/L DB-Send CC PC transmi ssion ;12/ 19/96 4:1 6 PM
	5584	"RTN","RCC PCML",2,0)
	5585	V ;;4.5;Ac counts Rec eivable;** 34,80,93,1 18,133,140 ,160,165,1 87,195,206 ,223,260,
	5586	313**;Mar 20, 1995;B uild 118
	5587	"RTN","RCC PCML",3,0)
	5588	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	5589	"RTN","RCC PCML",4,0)
	5590	TRAN ;call from RCCP C TRANSMIT option to interacti vely allow transmiss ion of CC
	5591	PC mesages
	5592	"RTN","RCC PCML",5,0)
	5593	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	5594	"RTN","RCC PCML",6,0)
	5595	N SDT,X,Y ,ZTRTN,ZTS AVE,ZTDESC ,ZTIO,IEN
	5596	"RTN","RCC PCML",7,0)
	5597	I '$D(^XU SEC("RCCPC TRANSMIT" ,DUZ)) W * 7,*7,!,"Yo u do not h ave access to do th
	5598	is." Q
	5599	"RTN","RCC PCML",8,0)
	5600	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5601	"RTN","RCC PCML",9,0)
	5602	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmi
	5603	tted. Try again lat er." Q
	5604	"RTN","RCC PCML",10,0 )
	5605	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	5606	"RTN","RCC PCML",11,0 )
	5607	S DIR(0)= "DAO^^K:'$ D(^RCPS(34 9.2,""STDT "",Y)) X"
	5608	"RTN","RCC PCML",12,0 )
	5609	S DIR("A" )="Enter s tatement d ate as it will appea r on these statement s: "
	5610	"RTN","RCC PCML",13,0 )
	5611	S DIR("?" )="Enter s tatement d ate as it will appea r on these statement s or ^ to
	5612	exit."
	5613	"RTN","RCC PCML",14,0 )
	5614	D ^DIR
	5615	"RTN","RCC PCML",15,0 )
	5616	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	5617	"RTN","RCC PCML",16,0 )
	5618	; PRCA4. 5313 - Ch anged to a llow for s eparate da tes for st atements b ased upon
	5619	last name
	5620	"RTN","RCC PCML",17,0 )
	5621	S SDT=Y
	5622	"RTN","RCC PCML",18,0 )
	5623	; PRCA4. 5313 - Un lock prior to quitti ng
	5624	"RTN","RCC PCML",19,0 )
	5625	;I '$D(^R CPS(349.2, "STDT",SDT )) W !,"Th ere is not a CCPC fi le for thi s date."
	5626	L -^RCPS(3 49.2):DILO CKTM Q
	5627	"RTN","RCC PCML",20,0 )
	5628	; PRCA4. 5313 - Un lock prior to quitti ng
	5629	"RTN","RCC PCML",21,0 )
	5630	S IEN=$O( ^RCPS(349. 2,"STDT",S DT,0)) I ' $P($P($G(^ RCPS(349.2 ,IEN,0))," ^",10),".
	5631	") D Q
	5632	"RTN","RCC PCML",22,0 )
	5633	. W !,"Yo ur CBSS st atement fi le (349.2) is corrup ted. Pleas e rebuild it."
	5634	"RTN","RCC PCML",23,0 )
	5635	. L -^RCP S(349.2):D ILOCKTM
	5636	"RTN","RCC PCML",24,0 )
	5637	; PRCA4. 5313 - Un lock prior to jobbin g off
	5638	"RTN","RCC PCML",25,0 )
	5639	L -^RCPS( 349.2):DIL OCKTM
	5640	"RTN","RCC PCML",26,0 )
	5641	; PRCA4. 5313 - Al lows for m ultiple st atement da tes
	5642	"RTN","RCC PCML",27,0 )
	5643	S ZTSAVE( "SDT")=SDT ,ZTRTN="RE TRAN^RCCPC ML",ZTIO=" ",ZTDESC=" Re-transmi t CBSS pa
	5644	tient stat ements -us er activat ed"
	5645	"RTN","RCC PCML",28,0 )
	5646	D ^%ZTLOA D
	5647	"RTN","RCC PCML",29,0 )
	5648	Q
	5649	"RTN","RCC PCML",30,0 )
	5650	;
	5651	"RTN","RCC PCML",31,0 )
	5652	EN(SDT) ;c alled from backgroun d job - PR CA4.5313 Added SDT for backg round job
	5653	call
	5654	"RTN","RCC PCML",32,0 )
	5655	N DA,DIK, LPRINT
	5656	"RTN","RCC PCML",33,0 )
	5657	D NOW^%DT C
	5658	"RTN","RCC PCML",34,0 )
	5659	RETRAN N D A,DIK,ERRO R,RCT,X,X1 ,DEB
	5660	"RTN","RCC PCML",35,0 )
	5661	; PRCA4. 5313 - Pr ovides err or for inc omplete bu ild of 349 .2
	5662	"RTN","RCC PCML",36,0 )
	5663	S (ERROR, X)=0 F S X=$O(^RCPS (349.2,"ST DT",SDT,X) ) Q:'X I $G(^RCPS(3 49.2,X,6)
	5664	) S ERROR= 1,NM=0 D E RROR Q
	5665	"RTN","RCC PCML",37,0 )
	5666	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with Error .
	5667	"RTN","RCC PCML",38,0 )
	5668	L +^RCPS( 349.2):DIL OCKTM I '$ T S ERROR= 11,NM=0 D ERROR
	5669	"RTN","RCC PCML",39,0 )
	5670	I $G(ERRO R) D EXIT Q
	5671	"RTN","RCC PCML",40,0 )
	5672	K ^TMP($J )
	5673	"RTN","RCC PCML",41,0 )
	5674	; PRCA4. 5313 - Re moves exis ting 349 f or this da te
	5675	"RTN","RCC PCML",42,0 )
	5676	S X1=0 F S X1=$O(^ RCT(349,"S DT",+$E(SD T,6,7),X1) ) Q:X1="" I $P($G(^ RCT(349,X
	5677	1,0)),U,2) ="PS" S DA =X1,DIK="^ RCT(349," D ^DIK
	5678	"RTN","RCC PCML",43,0 )
	5679	F X="PA", "IS","IT" S RCT=$O(^ RCT(349.1, "B",X,0)) I RCT K ^R CT(349.1,+ RCT,4,+$E
	5680	(SDT,6,7))
	5681	"RTN","RCC PCML",44,0 )
	5682	N %,ADD,A MT,ERROR,L ,LN,M,MSG, MCT,MPT1,M TOT,NM,P,P D,PD0,PSN, PT,PT0,PHC T,RCM,RTY
	5683	,TAMT,TMSG ,SZ,TRDESC
	5684	"RTN","RCC PCML",45,0 )
	5685	D DT^DICR W
	5686	"RTN","RCC PCML",46,0 )
	5687	S (ERROR, RTY)=0
	5688	"RTN","RCC PCML",47,0 )
	5689	S X=$O(^R CT(349.1," B","PS",0) )
	5690	"RTN","RCC PCML",48,0 )
	5691	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^",3)
	5692	"RTN","RCC PCML",49,0 )
	5693	I X']"" S ERROR=6,N M=0 D ERRO R,EXIT Q
	5694	"RTN","RCC PCML",50,0 )
	5695	D PHCT I 'PHCT S ER ROR=1,NM=0 D ERROR,E XIT Q
	5696	"RTN","RCC PCML",51,0 )
	5697	S MTOT=$O (^TMP($J," MCT",""),- 1)
	5698	"RTN","RCC PCML",52,0 )
	5699	; PRCA4. 5313 - Re set MTOT a nd MCT(1) for multip le dates o n one day
	5700	"RTN","RCC PCML",53,0 )
	5701	S MCT(1)= $O(^TMP($J ,"MCT","") )
	5702	"RTN","RCC PCML",54,0 )
	5703	S MTOT=MT OT-(MCT(1) -1)
	5704	"RTN","RCC PCML",55,0 )
	5705	S MCT(1)= 0
	5706	"RTN","RCC PCML",56,0 )
	5707	S MCT=0 F S MCT=$O (^TMP($J," MCT",MCT)) Q:'MCT D PS
	5708	"RTN","RCC PCML",57,0 )
	5709	EXIT D ERR ML^RCCPCML 1
	5710	"RTN","RCC PCML",58,0 )
	5711	K SDT,^TM P($J)
	5712	"RTN","RCC PCML",59,0 )
	5713	; PRCA4. 5313 - Un lock prior to exitin g
	5714	"RTN","RCC PCML",60,0 )
	5715	L -^RCPS( 349.2):DIL OCKTM
	5716	"RTN","RCC PCML",61,0 )
	5717	Q
	5718	"RTN","RCC PCML",62,0 )
	5719	;
	5720	"RTN","RCC PCML",63,0 )
	5721	F349 ;Get PS segment entry
	5722	"RTN","RCC PCML",64,0 )
	5723	N DA,D0,D IC,DLAYGO, X
	5724	"RTN","RCC PCML",65,0 )
	5725	S ERROR=0 K DD,DO S DIC="^RCT (349,",DIC (0)="L",DL AYGO=349,X ="PS."_$TR ($$FMTE^X
	5726	LFDT(DT,"2 D"),"/",". ")_"."_RCM D FILE^DI CN
	5727	"RTN","RCC PCML",66,0 )
	5728	I Y<0 S R TY=RTY+1 G F349:RTY< 4 S ERROR= 2,NM=0 D E RROR Q
	5729	"RTN","RCC PCML",67,0 )
	5730	S PSN=+Y
	5731	"RTN","RCC PCML",68,0 )
	5732	Q
	5733	"RTN","RCC PCML",69,0 )
	5734	;
	5735	"RTN","RCC PCML",70,0 )
	5736	PS ;Build PS,PH,PD s egments an d messages
	5737	"RTN","RCC PCML",71,0 )
	5738	S PSN=$O( ^TMP($J,"M CT",MCT,0) )
	5739	"RTN","RCC PCML",72,0 )
	5740	; PRCA4. 5313 - In crement Co unter for internal s torage
	5741	"RTN","RCC PCML",73,0 )
	5742	S MCT(1)= MCT(1)+1
	5743	"RTN","RCC PCML",74,0 )
	5744	; PRCA4. 5313 - Up date to ne w formatti ng
	5745	"RTN","RCC PCML",75,0 )
	5746	S $P(^RCT (349,+PSN, 0),"^",3,1 0)=MCT(1)_ "^"_MTOT_" ^"_$$SITE^ RCMSITE()_ "^"_$$FP^
	5747	RCCPCFN_"^ "_+^TMP($J ,"MCT",MCT )_"^"_$P(^ TMP($J,"MC T",MCT),"^ ",2)_"^"_$ $DAT^RCCP
	5748	CFN(SDT)_" ^"_$$DAT^R CCPCFN(DT)
	5749	"RTN","RCC PCML",76,0 )
	5750	S LN=+PSN ,^TMP($J," MSG",LN)=$ P($G(^RCT( 349,+PSN,0 )),"^",2,1 0)_"^\|"
	5751	"RTN","RCC PCML",77,0 )
	5752	; Reforma t Statemen t Date to Internal F ormat
	5753	"RTN","RCC PCML",78,0 )
	5754	S $P(^RCT (349,+PSN, 0),"^",9)= SDT
	5755	"RTN","RCC PCML",79,0 )
	5756	S MPT1=$P (^TMP($J," MCT",MCT), "^",3)
	5757	"RTN","RCC PCML",80,0 )
	5758	; PRCA4. 5313 - Su btract num ber of rec ords from last recor d to find number be
	5759	fore file starting p oint
	5760	"RTN","RCC PCML",81,0 )
	5761	S PT=MPT1 -$P(^TMP($ J,"MCT",MC T),"^",1)
	5762	"RTN","RCC PCML",82,0 )
	5763	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:PT="" Q :PT=$O(^RC PS(349.2,+ ($P(^TMP(
	5764	$J,"MCT",M CT),"^",3) ))) D
	5765	"RTN","RCC PCML",83,0 )
	5766	.Q:$D(^TM P($J,"ERRP T",+PT))
	5767	"RTN","RCC PCML",84,0 )
	5768	.S PT0=^R CPS(349.2, +PT,0)
	5769	"RTN","RCC PCML",85,0 )
	5770	. ; PRCA* 4.5*313 - Set DEB fr om PTO
	5771	"RTN","RCC PCML",86,0 )
	5772	. S DEB=$ P(PT0,"^")
	5773	"RTN","RCC PCML",87,0 )
	5774	.S LN=LN+ 1 S ^TMP($ J,"MSG",LN )="PH^"_$$ SITE^RCMSI TE_$$KEY^R CCPCFN(+PT )_"^"_$$N
	5775	M^RCCPCFN( +PT)_"^"
	5776	"RTN","RCC PCML",88,0 )
	5777	.S ADD=$G (^RCPS(349 .2,+PT,1))
	5778	"RTN","RCC PCML",89,0 )
	5779	.;
	5780	"RTN","RCC PCML",90,0 )
	5781	.;Remove special ch aracters c ausing pro blems (WIM -0402-2072 8)
	5782	"RTN","RCC PCML",91,0 )
	5783	.I ADD["~ " S ADD=$T R(ADD,"~", "") ;Remov e tilde
	5784	"RTN","RCC PCML",92,0 )
	5785	.I ADD["\| " S ADD=$T R(ADD,"\|", "") ;Remov e the pipe symbol
	5786	"RTN","RCC PCML",93,0 )
	5787	.;
	5788	"RTN","RCC PCML",94,0 )
	5789	.;Debtor needs larg e print (f ont) IF LP RINT=1
	5790	"RTN","RCC PCML",95,0 )
	5791	.S LPRINT =$G(^RCPS( 349.2,+PT, 7)) S:LPRI NT="" LPRI NT=0
	5792	"RTN","RCC PCML",96,0 )
	5793	.;
	5794	"RTN","RCC PCML",97,0 )
	5795	.F P=1:1: 7 S $P(^TM P($J,"MSG" ,LN),"^",P +5)=$S($P( ADD,"^",P) ]"":$P(ADD ,"^",P),1
	5796	:"")
	5797	"RTN","RCC PCML",98,0 )
	5798	.S ^TMP($ J,"MSG",LN )=^TMP($J, "MSG",LN)_ "^"
	5799	"RTN","RCC PCML",99,0 )
	5800	.S LN=LN+ 1
	5801	"RTN","RCC PCML",100, 0)
	5802	.F X=4:1: 8 S $P(AMT ,"^",X-3)= $$HEX^RCCP CFN($P(PT0 ,"^",X))
	5803	"RTN","RCC PCML",101, 0)
	5804	.S ^TMP($ J,"MSG",LN )=AMT_"^"_ $G(^RCPS(3 49.2,+PT,3 ))_"^"_$G( ^RCPS(349. 2,+PT,4))
	5805	_"^"_$O(^R CPS(349.2, +PT,2,""), -1)
	5806	"RTN","RCC PCML",102, 0)
	5807	.S LN=LN+ 1 I $P($G( ^RCD(340,+ DEB,0)),"; ") S ^TMP( $J,"MSG",L N)="^"_$$S ITE^RCMSI
	5808	TE_$$RJ^XL FSTR($TR($ P(^RCD(340 ,+DEB,0)," ;"),".","" ),13,0)
	5809	"RTN","RCC PCML",103, 0)
	5810	.; PRCA5 .4313 - S et ICN wit h Checksum , AR Flag, and Date of Latest Bill ino
	5811	PH data
	5812	"RTN","RCC PCML",104, 0)
	5813	.N PT8 S PT8=$G(^RC PS(349.2,+ PT,8))
	5814	"RTN","RCC PCML",105, 0)
	5815	.S ^TMP($ J,"MSG",LN )=$G(^TMP( $J,"MSG",L N))_"^"_LP RINT_"^"_$ P(PT8,"^") _"V"_$P(P
	5816	T8,"^",2,3 )_"^"_$$DA T^RCCPCFN( $P(PT8,"^" ,4))_"^\|"
	5817	"RTN","RCC PCML",106, 0)
	5818	.S $P(^RC PS(349.2,+ PT,0),"^", 11)=+PSN
	5819	"RTN","RCC PCML",107, 0)
	5820	.S PD=0 F S PD=$O( ^RCPS(349. 2,+PT,2,PD )) Q:'PD I $D(^(PD, 0)) S PD0= ^(0) D
	5821	"RTN","RCC PCML",108, 0)
	5822	..S AMT(0 )=$$HEX^RC CPCFN($P(P D0,"^",3))
	5823	"RTN","RCC PCML",109, 0)
	5824	..;Replac e special characters causing p roblem (PR CA*260)
	5825	"RTN","RCC PCML",110, 0)
	5826	..S TRDES C=$P(PD0," ^",2)
	5827	"RTN","RCC PCML",111, 0)
	5828	..I TRDES C["~" S TR DESC=$TR(T RDESC,"~", " ") ;Rep lace tilde
	5829	"RTN","RCC PCML",112, 0)
	5830	..I TRDES C["\|" S TR DESC=$TR(T RDESC,"\|", " ") ;Rep lace the p ipe symbol
	5831	"RTN","RCC PCML",113, 0)
	5832	..S LN=LN +1,^TMP($J ,"MSG",LN) ="PD^"_$$D AT^RCCPCFN (+PD0)_"^" _TRDESC_"^ "_AMT(0)_
	5833	"^"_$P(PD0 ,"^",4)_"^ \|"
	5834	"RTN","RCC PCML",114, 0)
	5835	S LN=LN+1 ,^TMP($J," MSG",LN)=" ~"
	5836	"RTN","RCC PCML",115, 0)
	5837	; PRCA4. 5313 - Se t all cros s-referenc es for Fil e
	5838	"RTN","RCC PCML",116, 0)
	5839	S DA=+PSN ,DIK="^RCT (349," D I X1^DIK
	5840	"RTN","RCC PCML",117, 0)
	5841	;
	5842	"RTN","RCC PCML",118, 0)
	5843	MAIL ;set up mail me ssage
	5844	"RTN","RCC PCML",119, 0)
	5845	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z
	5846	"RTN","RCC PCML",120, 0)
	5847	S XMSUB=$ $SITE^RCMS ITE()_" CB SS TRANSMI SSION "_SD T
	5848	"RTN","RCC PCML",121, 0)
	5849	S XMDUZ=" AR PACKAGE "
	5850	"RTN","RCC PCML",122, 0)
	5851	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),"^",12) S XMY("G
	5852	.RCCPC STA TEMENTS")= ""
	5853	"RTN","RCC PCML",123, 0)
	5854	S X=$O(^R CT(349.1," B","PS",0) )
	5855	"RTN","RCC PCML",124, 0)
	5856	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^")_" @"_$P($G(
	5857	^RCT(349.1 ,+X,3)),"^ ",3) S:$P( X,"@",2)]" " XMY(X)=" "
	5858	"RTN","RCC PCML",125, 0)
	5859	I $P(X,"@ ",2)']"" D Q
	5860	"RTN","RCC PCML",126, 0)
	5861	.S ERROR= 6,NM=0 D E RROR
	5862	"RTN","RCC PCML",127, 0)
	5863	S XMDUZ=" AR PACKAGE "
	5864	"RTN","RCC PCML",128, 0)
	5865	D XMZ^XMA 2
	5866	"RTN","RCC PCML",129, 0)
	5867	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	5868	"RTN","RCC PCML",130, 0)
	5869	S $P(^RCT (349,+PSN, 0),"^",11, 12)=DT_"^" _XMZ
	5870	"RTN","RCC PCML",131, 0)
	5871	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) S L =L+1,^XMB( 3.9,+XMZ,
	5872	2,L,0)=^TM P($J,"MSG" ,L(1))
	5873	"RTN","RCC PCML",132, 0)
	5874	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_"^"_L_" ^"_DT
	5875	"RTN","RCC PCML",133, 0)
	5876	D ENT1^XM D
	5877	"RTN","RCC PCML",134, 0)
	5878	D NOW^%DT C
	5879	"RTN","RCC PCML",135, 0)
	5880	S $P(^RCT (349,+PSN, 0),"^",11, 12)=%_"^"_ XMZ
	5881	"RTN","RCC PCML",136, 0)
	5882	K ^TMP($J ,"MSG")
	5883	"RTN","RCC PCML",137, 0)
	5884	Q
	5885	"RTN","RCC PCML",138, 0)
	5886	;
	5887	"RTN","RCC PCML",139, 0)
	5888	PHCT ;PH c ount
	5889	"RTN","RCC PCML",140, 0)
	5890	S (ERROR, PT,PHCT,TA MT,SZ)=0,R CM=1
	5891	"RTN","RCC PCML",141, 0)
	5892	; PRCA4. 5313 - If last reco rd is for this date reset RCM to next va lue
	5893	"RTN","RCC PCML",142, 0)
	5894	N FINAL
	5895	"RTN","RCC PCML",143, 0)
	5896	S FINAL=$ O(^RCT(349 ,"@"),-1)
	5897	"RTN","RCC PCML",144, 0)
	5898	I FINAL,$ P($P(^RCT( 349,FINAL, 0),"^"),". ",2,4)=$TR ($$FMTE^XL FDT(DT,"2D "),"/",".
	5899	") S RCM=$ P($P(^RCT( 349,FINAL, 0),"^"),". ",5)+1
	5900	"RTN","RCC PCML",145, 0)
	5901	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:'PT S E RROR=0 D I ERROR,(E RROR<3) Q
	5902	"RTN","RCC PCML",146, 0)
	5903	.; PRCA4 .5313 - S et DEB to Debtor num ber
	5904	"RTN","RCC PCML",147, 0)
	5905	.S DEB=$P ($G(^RCPS( 349.2,PT,0 )),"^")
	5906	"RTN","RCC PCML",148, 0)
	5907	.S SZ(1)= 0 D ERRCHK Q:ERROR
	5908	"RTN","RCC PCML",149, 0)
	5909	.S PT0=^R CPS(349.2, +PT,0)
	5910	"RTN","RCC PCML",150, 0)
	5911	.S PHCT=P HCT+1
	5912	"RTN","RCC PCML",151, 0)
	5913	.S SZ=550 +SZ,SZ(1)= 550
	5914	"RTN","RCC PCML",152, 0)
	5915	.S:$G(^RC PS(349.2,+ PT,1))]"" SZ=SZ+$L(^ (1)),SZ(1) =SZ(1)+$L( ^(1))
	5916	"RTN","RCC PCML",153, 0)
	5917	.S:$G(^RC PS(349.2,+ PT,3))]"" SZ=SZ+$L(^ (3))+1,SZ( 1)=SZ(1)+$ L(^(3))+1
	5918	"RTN","RCC PCML",154, 0)
	5919	.S:$G(^RC PS(349.2,+ PT,4))]"" SZ=SZ+$L(^ (4))+1,SZ( 1)=SZ(1)+$ L(^(4))+1
	5920	"RTN","RCC PCML",155, 0)
	5921	.S X=0 F S X=$O(^R CPS(349.2, +PT,2,X)) Q:'X I $D (^(X,0)) S SZ=$L(^(0 ))+SZ,SZ(
	5922	1)=SZ(1)+$ L(^(0))
	5923	"RTN","RCC PCML",156, 0)
	5924	.S TAMT=T AMT+$P(^RC PS(349.2,+ PT,0),"^", 8)
	5925	"RTN","RCC PCML",157, 0)
	5926	.I SZ>270 00 D
	5927	"RTN","RCC PCML",158, 0)
	5928	..S RTY=0 D F349 Q: ERROR
	5929	"RTN","RCC PCML",159, 0)
	5930	..S TAMT= TAMT-$P(PT 0,"^",8)
	5931	"RTN","RCC PCML",160, 0)
	5932	..S TAMT= $$HEX^RCCP CFN(TAMT)
	5933	"RTN","RCC PCML",161, 0)
	5934	..S ^TMP( $J,"MCT",R CM)=(PHCT- 1)_"^"_TAM T_"^"_$O(^ RCPS(349.2 ,"STDT",SD T,PT),-1)
	5935	_"^"_(SZ-S Z(1))
	5936	"RTN","RCC PCML",162, 0)
	5937	..S ^TMP( $J,"MCT",R CM,+PSN)=" "
	5938	"RTN","RCC PCML",163, 0)
	5939	..S RCM=R CM+1,PHCT= 1
	5940	"RTN","RCC PCML",164, 0)
	5941	..S SZ=SZ (1)
	5942	"RTN","RCC PCML",165, 0)
	5943	..S TAMT= $P(PT0,"^" ,8)
	5944	"RTN","RCC PCML",166, 0)
	5945	I 'PT,$O( ^RCPS(349. 2,"STDT",S DT,0)) D
	5946	"RTN","RCC PCML",167, 0)
	5947	.S RTY=0 D F349 Q:E RROR S ^T MP($J,"MCT ",RCM)=PHC T_"^"_$$HE X^RCCPCFN( TAMT)_"^"
	5948	_$O(^RCPS( 349.2,"STD T",SDT,PT) ,-1)
	5949	"RTN","RCC PCML",168, 0)
	5950	.S ^TMP($ J,"MCT",RC M,+PSN)=""
	5951	"RTN","RCC PCML",169, 0)
	5952	Q
	5953	"RTN","RCC PCML",170, 0)
	5954	;
	5955	"RTN","RCC PCML",171, 0)
	5956	ERROR ;ERR OR FILE
	5957	"RTN","RCC PCML",172, 0)
	5958	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	5959	"RTN","RCC PCML",173, 0)
	5960	N SSN
	5961	"RTN","RCC PCML",174, 0)
	5962	S SSN=$$S SN^RCFN01( +DEB)
	5963	"RTN","RCC PCML",175, 0)
	5964	I SSN'=-1 S ^TMP($J ,"ERROR",E RROR,NM,SS N)=""
	5965	"RTN","RCC PCML",176, 0)
	5966	Q
	5967	"RTN","RCC PCML",177, 0)
	5968	;
	5969	"RTN","RCC PCML",178, 0)
	5970	ERRCHK ;Er ror check
	5971	"RTN","RCC PCML",179, 0)
	5972	I '$D(^RC PS(349.2,+ PT,0)) S E RROR=1,NM= 0 D ERROR Q
	5973	"RTN","RCC PCML",180, 0)
	5974	S PT(1)=P T,PT=$O(^R CPS(349.2, "STDT",SDT ,0)) I '$P (^RCPS(349 .2,PT,0)," ^",18) S
	5975	ERROR=1,NM =0 D ERROR S PT=PT(1 ) Q
	5976	"RTN","RCC PCML",181, 0)
	5977	S PT=PT(1 )
	5978	"RTN","RCC PCML",182, 0)
	5979	I $$KEY^R CCPCFN(+PT )']"" S ER ROR=4,NM=$ $NAM^RCFN0 1(+DEB) D ERROR S ^T MP($J,"ER
	5980	RPT",+PT)= "" Q
	5981	"RTN","RCC PCML",183, 0)
	5982	I '$D(^RC PS(349.2," AKEY",$$KE Y^RCCPCFN( +PT))) S E RROR=4,NM= $$NAM^RCFN 01(+DEB)
	5983	D ERROR S ^TMP($J,"E RRPT",+PT) ="" Q
	5984	"RTN","RCC PCML",184, 0)
	5985	S ADD=$G( ^RCPS(349. 2,+PT,1))
	5986	"RTN","RCC PCML",185, 0)
	5987	F P=1:1:7 S ADD(P)= $S($P(ADD, "^",P)]"": $P(ADD,"^" ,P),1:"")
	5988	"RTN","RCC PCML",186, 0)
	5989	I ADD(1)= "",ADD(2)= "",ADD(3)= "",ADD(4)= "",ADD(5)= "",ADD(6)= "" S ERROR =8,NM=$$N
	5990	AM^RCFN01( +DEB) D ER ROR S ^TMP ($J,"ERRPT ",+PT)="" Q
	5991	"RTN","RCC PCML",187, 0)
	5992	I ADD(1)= "",(ADD(2) =""),(ADD( 3)=""),(AD D(6)="") S ERROR=8,N M=$$NAM^RC FN01(+DEB
	5993	) D ERROR S ^TMP($J, "ERRPT",+P T)="" Q
	5994	"RTN","RCC PCML",188, 0)
	5995	I ADD(4)= ""!(ADD(5) ="")!(ADD( 6)="") S E RROR=8,NM= $$NAM^RCFN 01(+DEB) D ERROR S
	5996	^TMP($J,"E RRPT",+PT) =""
	5997	"RTN","RCC PCML",189, 0)
	5998	F ADD=1:1 :6 I ADD(A DD)'?.ANP S ERROR=10 ,NM=$$NAM^ RCFN01(+DE B),^TMP($J ,"ERRPT",
	5999	+PT)="" D ERROR Q
	6000	"RTN","RCC PCML",190, 0)
	6001	I $P($G(^ RCD(340,+D EB,1)),"^" ,9) S ^TMP ($J,"ERRPT ",+PT)="", ERROR=9,NM =$$NAM^RC
	6002	FN01(+DEB) D ERROR
	6003	"RTN","RCC PCML",191, 0)
	6004	Q
	6005	"RTN","RCC PCML1")
	6006	0^13^B8980 051^B66823 35
	6007	"RTN","RCC PCML1",1,0 )
	6008	RCCPCML1 ; ALB@ALTOON A,PA/LDB - Send CCPC transmiss ion (cont. );8/25/00 4:16 PM
	6009	"RTN","RCC PCML1",2,0 )
	6010	V ;;4.5;Ac counts Rec eivable; 160,313; Mar 20, 19 95;Build 1 18
	6011	"RTN","RCC PCML1",3,0 )
	6012	;;Per VA Directive 6402, this routine s hould not be modifie d.
	6013	"RTN","RCC PCML1",4,0 )
	6014	ERRML ;ERR OR MESSAGE S
	6015	"RTN","RCC PCML1",5,0 )
	6016	N CT,ERRO R,LN,PT,SP ,XMDUZ,XMT EXT,XMSUB, XMY
	6017	"RTN","RCC PCML1",6,0 )
	6018	K ^TMP($J ,"ERRMSG")
	6019	"RTN","RCC PCML1",7,0 )
	6020	S (ERROR, LN)=0 F S ERROR=$O( ^TMP($J,"E RROR",ERRO R)) Q:'ERR OR D
	6021	"RTN","RCC PCML1",8,0 )
	6022	. ; PRCA* 4.5*313 - Add header identifyi ng the Sta tement Dat e
	6023	"RTN","RCC PCML1",9,0 )
	6024	. I LN=0 S LN=LN+1 D
	6025	"RTN","RCC PCML1",10, 0)
	6026	. . N Y
	6027	"RTN","RCC PCML1",11, 0)
	6028	. . S Y=S DT X ^DD(" DD")
	6029	"RTN","RCC PCML1",12, 0)
	6030	. . S ^TM P($J,"ERRM SG",LN)="E RRORS FOR PATIENT ST ATEMENT DA TE: "_Y
	6031	"RTN","RCC PCML1",13, 0)
	6032	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	6033	"RTN","RCC PCML1",14, 0)
	6034	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=$P($T (ERRMSG+ER ROR),";;", 2)
	6035	"RTN","RCC PCML1",15, 0)
	6036	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	6037	"RTN","RCC PCML1",16, 0)
	6038	.S CT=0,P T="" F S PT=$O(^TMP ($J,"ERROR ",ERROR,PT )) Q:PT="" D
	6039	"RTN","RCC PCML1",17, 0)
	6040	..S CT=CT +1,LN=LN+1
	6041	"RTN","RCC PCML1",18, 0)
	6042	..I PT=0 S ^TMP($J, "ERRMSG",L N)=" " Q
	6043	"RTN","RCC PCML1",19, 0)
	6044	..N Y I P T'=0 D
	6045	"RTN","RCC PCML1",20, 0)
	6046	...S PT(1 )="" F S PT(1)=$O(^ TMP($J,"ER ROR",ERROR ,PT,PT(1)) ) Q:PT(1)= "" D
	6047	"RTN","RCC PCML1",21, 0)
	6048	....S ^TM P($J,"ERRM SG",LN)=$S ($L(CT)<2: " "_CT,1:C T)_". "
	6049	"RTN","RCC PCML1",22, 0)
	6050	....S SP= " ",Y=PT,Y= PT_$E(SP,$ L(PT),30)
	6051	"RTN","RCC PCML1",23, 0)
	6052	....S ^TM P($J,"ERRM SG",LN)=^T MP($J,"ERR MSG",LN)_Y _PT(1)
	6053	"RTN","RCC PCML1",24, 0)
	6054	S XMDUZ=" AR PACKAGE "
	6055	"RTN","RCC PCML1",25, 0)
	6056	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= ""
	6057	"RTN","RCC PCML1",26, 0)
	6058	E S XMY( $G(DUZ))=" "
	6059	"RTN","RCC PCML1",27, 0)
	6060	; PRCA4. 5313 - Ch ange CCPC to CBSS an d add Stat ement Date
	6061	"RTN","RCC PCML1",28, 0)
	6062	N Y S Y=S DT D DD^%D T S SDT=Y
	6063	"RTN","RCC PCML1",29, 0)
	6064	S XMSUB=" CBSS ERROR S FOUND DU RING TRANS MISSION"
	6065	"RTN","RCC PCML1",30, 0)
	6066	S XMTEXT= "^TMP($J," "ERRMSG"", "
	6067	"RTN","RCC PCML1",31, 0)
	6068	D ^XMD
	6069	"RTN","RCC PCML1",32, 0)
	6070	K ^TMP($J ,"ERRMSG")
	6071	"RTN","RCC PCML1",33, 0)
	6072	Q
	6073	"RTN","RCC PCML1",34, 0)
	6074	;
	6075	"RTN","RCC PCML1",35, 0)
	6076	ERRMSG ;E rror messa ges PRCA 4.5313 - Change CC PC to CBSS
	6077	"RTN","RCC PCML1",36, 0)
	6078	1 ;;CBSS t ransmissio n process found no r ecords or an incompl ete file. Contact I
	6079	RM.
	6080	"RTN","RCC PCML1",37, 0)
	6081	2 ;;No CBS S transmis sion recor ds transmi tted. Chec k file 349 . Contact IRM.
	6082	"RTN","RCC PCML1",38, 0)
	6083	3 ;;Corrup ted PH seg ment has b een encoun tered for the follow ing patien t(s):
	6084	"RTN","RCC PCML1",39, 0)
	6085	4 ;;No key field in CBSS file for the fo llowing pa tient(s):
	6086	"RTN","RCC PCML1",40, 0)
	6087	5 ;;Mailma n message creation a borted. Pl ease conta ct IRM.
	6088	"RTN","RCC PCML1",41, 0)
	6089	6 ;;No tra nsmission sent. Defi ne REMOTE DOMAIN in AR TRANSMI SSION TYPE file (34
	6090	9.1).
	6091	"RTN","RCC PCML1",42, 0)
	6092	7 ;;Print Acknowledg ements exi st. Transm ission can not be res ent.
	6093	"RTN","RCC PCML1",43, 0)
	6094	8 ;;Addres s informat ion is mis sing for t he followi ng patient (s):
	6095	"RTN","RCC PCML1",44, 0)
	6096	9 ;;Addres s is marke d as ADDRE SS UNKNOWN for the f ollowing p atient(s):
	6097	"RTN","RCC PCML1",45, 0)
	6098	10 ;;Corru pted Addre ss. Re-ent er address informati on for the following patient(
	6099	s):
	6100	"RTN","RCC PCML1",46, 0)
	6101	11 ;;File did not bu ild or tra nsmit due to another build or transmissi on runnin
	6102	g.
	6103	"RTN","RCC PCPS")
	6104	0^10^B1295 14785^B808 98915
	6105	"RTN","RCC PCPS",1,0)
	6106	RCCPCPS ;W ASH-ISC@AL TOONA,PA/N YB-Build P atient Sta tement Fil e ;12/19/9 6 4:14 P
	6107	M
	6108	"RTN","RCC PCPS",2,0)
	6109	;;4.5;Acc ounts Rece ivable;**3 4,70,80,48 ,104,116,1 49,170,181 ,190,223,2 37,219,26
	6110	5,301,313* *;Mar 20,1 995;Build 118
	6111	"RTN","RCC PCPS",3,0)
	6112	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	6113	"RTN","RCC PCPS",4,0)
	6114	EN(SDT) ; PRCA4.5 313 - For use when c alled by B ackground Job
	6115	"RTN","RCC PCPS",5,0)
	6116	;
	6117	"RTN","RCC PCPS",6,0)
	6118	EN1 ;FOR U SE WHEN BU ILDING PS FILE (SDT MUST BE AV AILABLE AS A LOCAL V ARIABLE)
	6119	"RTN","RCC PCPS",7,0)
	6120	N CCPC,CN T,DAT,DEB, DIK,END,IN ADFL,LDT1, LDT3,PCC,P RN,RCDATE, RCT,SVADM, SVAMT,SVI
	6121	NT,SVOTH,S ITE,TXT,VA R,X,%,REP, ERROR,NM
	6122	"RTN","RCC PCPS",8,0)
	6123	N RCINFUL L,RCINPART S COMM=0
	6124	"RTN","RCC PCPS",9,0)
	6125	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6126	"RTN","RCC PCPS",10,0 )
	6127	L +^RCPS( 349.2):DIL OCKTM I '$ T D Q
	6128	"RTN","RCC PCPS",11,0 )
	6129	. D NOW^% DTC S Y=% D DD^%DT
	6130	"RTN","RCC PCPS",12,0 )
	6131	. W Y W ! !,"Another date is b eing run o r transmit ted. Try again late r."
	6132	"RTN","RCC PCPS",13,0 )
	6133	. S ERROR =11,NM=0 D ERROR^RCC PCML,ERRML ^RCCPCML1
	6134	"RTN","RCC PCPS",14,0 )
	6135	; PRCA4. 5313 - Cl ear data f or date be ing create d
	6136	"RTN","RCC PCPS",15,0 )
	6137	D KILL^RC CPCPS1(SDT )
	6138	"RTN","RCC PCPS",16,0 )
	6139	; PRCA4. 5313 - Se t date to a month ag o and kill data for that date
	6140	"RTN","RCC PCPS",17,0 )
	6141	N OLDDT
	6142	"RTN","RCC PCPS",18,0 )
	6143	S OLDDT=$ $MONTHAGO^ RCCPCPS1(S DT)
	6144	"RTN","RCC PCPS",19,0 )
	6145	; PRCA4. 5313 - Mo ved to KIL L^RCCPCPS1
	6146	"RTN","RCC PCPS",20,0 )
	6147	D KILL^RC CPCPS1(OLD DT)
	6148	"RTN","RCC PCPS",21,0 )
	6149	;
	6150	"RTN","RCC PCPS",22,0 )
	6151	D DT^DICR W,SITE^PRC AGU
	6152	"RTN","RCC PCPS",23,0 )
	6153	I '$D(SIT E) W !!,"A R SITE PAR AMETER ENT RIES NOT D EFINED!",? 50 D Q
	6154	"RTN","RCC PCPS",24,0 )
	6155	. D NOW^% DTC S Y=% D DD^%DT W Y
	6156	"RTN","RCC PCPS",25,0 )
	6157	. W !!,"C OULD NOT P ROCESS AR PATIENT ST ATEMENTS"
	6158	"RTN","RCC PCPS",26,0 )
	6159	. ; PRCA* 4.5*313 - Unlock pri or to exit ing
	6160	"RTN","RCC PCPS",27,0 )
	6161	. L -^RCP S(349.2):D ILOCKTM
	6162	"RTN","RCC PCPS",28,0 )
	6163	;
	6164	"RTN","RCC PCPS",29,0 )
	6165	; PRCA4. 5313 - Cl ear ICN Er ror tempor ary storag e
	6166	"RTN","RCC PCPS",30,0 )
	6167	K ^TMP("I CNERROR",$ J)
	6168	"RTN","RCC PCPS",31,0 )
	6169	D NOW^%DT C S END=%
	6170	"RTN","RCC PCPS",32,0 )
	6171	S LDT1=$$ FPS^RCAMFN 01(DT,-1), RCDATE=DT
	6172	"RTN","RCC PCPS",33,0 )
	6173	S (CNT,DE B)=0,PRN=1
	6174	"RTN","RCC PCPS",34,0 )
	6175	F S DEB= $O(^RCD(34 0,"AC",+$E (SDT,6,7), DEB)) Q:DE B="" I $D (^RCD(340, "AB","DPT
	6176	(",DEB)) D
	6177	"RTN","RCC PCPS",35,0 )
	6178	. N AMT ,BBAL,BEG, BN,CAT,DES C,ETY,FC,N D,PAT,PBAL ,PC,PSIEN
	6179	"RTN","RCC PCPS",36,0 )
	6180	. N PDA T,PEND,ST, SVINT,SVAD M,SVOTH,AD DR,ARFLAG, DIC,FLBPD1 ,ICN
	6181	"RTN","RCC PCPS",37,0 )
	6182	. I $L( +$$SSN^RCF N01(DEB))< 5 Q
	6183	"RTN","RCC PCPS",38,0 )
	6184	. ;Chec k for Emer gency Resp onse Indic ator (ERI) Flag.
	6185	"RTN","RCC PCPS",39,0 )
	6186	. N RCD FN S RCDFN =+($P($G(^ RCD(340,DE B,0)),"^", 1)) I $$EM ERES^PRCAU TL(RCDFN)
	6187	]"" Q
	6188	"RTN","RCC PCPS",40,0 )
	6189	. ; ini tialize va riables fo r CS - PRC A4.5301
	6190	"RTN","RCC PCPS",41,0 )
	6191	. N CSB B,CSTCH,CS TPC,CSPREV S (CSBB,C STCH,CSTPC )=0
	6192	"RTN","RCC PCPS",42,0 )
	6193	. ; PRC A^4.5*313 - If ICN i s null set to send e rror email
	6194	"RTN","RCC PCPS",43,0 )
	6195	. S ICN =$$GETICN^ MPIF001(RC DFN)
	6196	"RTN","RCC PCPS",44,0 )
	6197	. I $P( ICN,U)=-1 S ^TMP("IC NERROR",$J ,RCDFN)="" Q
	6198	"RTN","RCC PCPS",45,0 )
	6199	. S FLB PD1=$$FLBP D1
	6200	"RTN","RCC PCPS",46,0 )
	6201	. I FLB PD1="" Q
	6202	"RTN","RCC PCPS",47,0 )
	6203	. I $P( ^PRCA(430, FLBPD1,0), U,10)="" Q
	6204	"RTN","RCC PCPS",48,0 )
	6205	. S INA DFL=0
	6206	"RTN","RCC PCPS",49,0 )
	6207	. S (SV ADM,SVAMT, SVINT,SVOT H)=0
	6208	"RTN","RCC PCPS",50,0 )
	6209	. N REF ,SBAL,TBAL ,TN,TTY,X, Y
	6210	"RTN","RCC PCPS",51,0 )
	6211	. K ^TM P("PRCAGT" ,$J)
	6212	"RTN","RCC PCPS",52,0 )
	6213	. S BEG =+$$LST^RC FN01(DEB,2 )
	6214	"RTN","RCC PCPS",53,0 )
	6215	. S LDT 3=$S(BEG>0 :$$FPS^RCA MFN01($P(B EG,"."),-3 ),1:0)
	6216	"RTN","RCC PCPS",54,0 )
	6217	. I $P( BEG,".")'< $P(RCDATE, ".") Q
	6218	"RTN","RCC PCPS",55,0 )
	6219	. D NOW ^%DTC S EN D=%
	6220	"RTN","RCC PCPS",56,0 )
	6221	. I BEG <1 S PDAT= "",BEG=0,P BAL=0
	6222	"RTN","RCC PCPS",57,0 )
	6223	. I BEG S PDAT=BE G,BEG=9999 999.999999 -BEG,PBAL= 0 D PBAL^P RCAGU(DEB, .BEG,.PBA
	6224	L) ;get pr ev bal
	6225	"RTN","RCC PCPS",58,0 )
	6226	. D EN^ PRCAGT(DEB ,BEG,.END)
	6227	"RTN","RCC PCPS",59,0 )
	6228	. S TBA L=0 D TBAL ^PRCAGT(DE B,.TBAL) ; get trans bal
	6229	"RTN","RCC PCPS",60,0 )
	6230	. S BBA L=0 D BBAL ^PRCAGU(DE B,.BBAL) ; get bill b al
	6231	"RTN","RCC PCPS",61,0 )
	6232	. ; ent ire accoun t has been referred to CS - PR CA4.5301
	6233	"RTN","RCC PCPS",62,0 )
	6234	. I CSB B,CSBB'<BB AL Q
	6235	"RTN","RCC PCPS",63,0 )
	6236	. S X=$ $PRE^PRCAG U(DEB) S P END=$P(X,U ,2),X=+X I X,BBAL D REF^PRCAGD (DEB,X,$G
	6237	(REP)) Q
	6238	"RTN","RCC PCPS",64,0 )
	6239	. I BBA L=0,PEND,- PEND=PBAL+ TBAL Q
	6240	"RTN","RCC PCPS",65,0 )
	6241	. I BBA L'=(PBAL+T BAL) D EN^ PRCAGD(DEB ,BBAL,TBAL ,PBAL,BEG, $G(REP)) Q
	6242	"RTN","RCC PCPS",66,0 )
	6243	. I BBA L'>0,'$D(^ TMP("PRCAG T",$J,DEB) ) Q
	6244	"RTN","RCC PCPS",67,0 )
	6245	. I BBA L=0,$G(SIT E("ZERO")) Q
	6246	"RTN","RCC PCPS",68,0 )
	6247	. I BBA L<0,BBAL>- .99 Q
	6248	"RTN","RCC PCPS",69,0 )
	6249	. I BBA L'<0,'$D(^ XTMP("PRCA GU",$J,DEB )),'COMM Q ;third l etter prin ted,not c
	6250	omment
	6251	"RTN","RCC PCPS",70,0 )
	6252	. S TBA L=TBAL+PBA L
	6253	"RTN","RCC PCPS",71,0 )
	6254	. ;adju st amounts to be fil ed in 349. 2 for CS b ills - PRC A4.5301
	6255	"RTN","RCC PCPS",72,0 )
	6256	. S TBA L=TBAL-CSB B ; reduce the total bill bala nce by CS balance
	6257	"RTN","RCC PCPS",73,0 )
	6258	. S CSP REV=CSBB-( CSTCH+CSTP C) ; compu te the CS previous b alance as the diffe
	6259	rence betw een the bi ll balance and the t ransaction balance
	6260	"RTN","RCC PCPS",74,0 )
	6261	. S PBA L=PBAL-CSP REV ; redu ce the pre vious bala nce by the CS previo us balanc
	6262	e
	6263	"RTN","RCC PCPS",75,0 )
	6264	. S TBA L("CH")=TB AL("CH")-C STCH ; red uce total charges by CS charge s
	6265	"RTN","RCC PCPS",76,0 )
	6266	. S TBA L("PC")=TB AL("PC")-C STPC ; red uce total credits by CS credit s
	6267	"RTN","RCC PCPS",77,0 )
	6268	. ;
	6269	"RTN","RCC PCPS",78,0 )
	6270	. I '$D (^RCPS(349 .2,0)) S ^ (0)="AR CB SS STATEME NTS^349.2I ^^"
	6271	"RTN","RCC PCPS",79,0 )
	6272	. S DIC ="^RCPS(34 9.2,",X=DE B,DA=.01,D IC(0)="" D FILE^DICN
	6273	"RTN","RCC PCPS",80,0 )
	6274	. S PSI EN=+Y
	6275	"RTN","RCC PCPS",81,0 )
	6276	. S ^RC PS(349.2,P SIEN,0)=DE B_"^"_$$SS N^RCFN01(D EB)_"^"
	6277	"RTN","RCC PCPS",82,0 )
	6278	. S ADD R=$$DADD^R CAMADD(DEB ,1) ;get p atient's a ddress, co nfidential if appli
	6279	cable
	6280	"RTN","RCC PCPS",83,0 )
	6281	. S ARF LAG="N" N X
	6282	"RTN","RCC PCPS",84,0 )
	6283	. S X=$ P($G(^RCD( 340,DEB,1) ),U,1,6) I ($P(X,U)' =""),($P(X ,U,4)'="") ,($P(X,U,
	6284	5)'=""),(( $P(X,U,6)' ="")) S AR FLAG="Y"
	6285	"RTN","RCC PCPS",85,0 )
	6286	. S ^RC PS(349.2,P SIEN,1)=$P (ADDR,"^", 1,6)
	6287	"RTN","RCC PCPS",86,0 )
	6288	. S ST= $P(ADDR,"^ ",5)
	6289	"RTN","RCC PCPS",87,0 )
	6290	. S ^RC PS(349.2,P SIEN,7)=$P (^RCD(340, DEB,0),U,7 ) ;large p rint
	6291	"RTN","RCC PCPS",88,0 )
	6292	. ; PRC A4.5313 - Add four new eleme nts for CB SS
	6293	"RTN","RCC PCPS",89,0 )
	6294	. S $P( ^RCPS(349. 2,PSIEN,8) ,U)=$P(ICN ,"V")
	6295	"RTN","RCC PCPS",90,0 )
	6296	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,2)=$P(I CN,"V",2)
	6297	"RTN","RCC PCPS",91,0 )
	6298	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,3)=ARFL AG
	6299	"RTN","RCC PCPS",92,0 )
	6300	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,4)=""
	6301	"RTN","RCC PCPS",93,0 )
	6302	. I FLB PD1 S $P(^ RCPS(349.2 ,PSIEN,8), U,4)=$P(^P RCA(430,FL BPD1,0),U, 10)
	6303	"RTN","RCC PCPS",94,0 )
	6304	. I $G( ST)'="" S ST=$O(^DIC (5,"C",ST, 0))
	6305	"RTN","RCC PCPS",95,0 )
	6306	. I $G( ST)>90,'$P ($G(^DIC(5 ,ST,0)),"^ ",6) S FC= $P($G(^DIC (5,ST,0)), "^")
	6307	"RTN","RCC PCPS",96,0 )
	6308	. S $P( ^RCPS(349. 2,PSIEN,1) ,"^",7)=$G (FC) S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1
	6309	),"^",5)=" FX"
	6310	"RTN","RCC PCPS",97,0 )
	6311	. S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1) ,"^",6)=$P (ADDR,"^", 8)
	6312	"RTN","RCC PCPS",98,0 )
	6313	. D NOW ^%DTC S $P (^RCPS(349 .2,PSIEN,0 ),"^",10)= %
	6314	"RTN","RCC PCPS",99,0 )
	6315	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",3)=$$ NAM^RCFN01 (DEB)
	6316	"RTN","RCC PCPS",100, 0)
	6317	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",4,7)= $S(TBAL'>0 :0,1:TBAL) _"^"_PBAL_ "^"_TBAL(
	6318	"CH")_"^"_ TBAL("PC") ,$P(^(0)," ^",8)=PBAL +TBAL("CH" )+TBAL("PC ")+TBAL("R F")
	6319	"RTN","RCC PCPS",101, 0)
	6320	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",13,17 )=BBAL("PB ")_"^"_BBA L("INT")_" ^"_BBAL("
	6321	ADM")_"^"_ BBAL("MF") _"^"_BBAL( "CT")
	6322	"RTN","RCC PCPS",102, 0)
	6323	. ;
	6324	"RTN","RCC PCPS",103, 0)
	6325	. N RCB ILLDA,RCDA TA1,RCDEBT DA,RCDESC, RCPSDA,RCT OTAL,RCTRA NDA,RCTRDA TE,VALUE,
	6326	RCCOM1,RCC OM2,RCCOM3
	6327	"RTN","RCC PCPS",104, 0)
	6328	. S RCD EBTDA=DEB
	6329	"RTN","RCC PCPS",105, 0)
	6330	. I '$D (^RCPS(349 .2,PSIEN,2 ,0)) S ^(0 )="^^^"
	6331	"RTN","RCC PCPS",106, 0)
	6332	. ;
	6333	"RTN","RCC PCPS",107, 0)
	6334	. S RCC OM1=$E($TR ($G(SITE(" COM1")),"~ \|^",""),1, 80),(RCCOM 2,RCCOM3)= ""
	6335	"RTN","RCC PCPS",108, 0)
	6336	. ; Add second co mment line for the G MT-reduced status
	6337	"RTN","RCC PCPS",109, 0)
	6338	. I $$G MT^PRCAGST (RCDEBTDA) S RCCOM2= "REDUCTION OF INPATI ENT COPAYM ENT DUE T
	6339	O GEOGRAPH IC MEANS T EST STATUS "
	6340	"RTN","RCC PCPS",110, 0)
	6341	. I TBA L'>0 S RCC OM3=" THI S IS NOT A BILL"
	6342	"RTN","RCC PCPS",111, 0)
	6343	. I RCC OM1'="",RC COM2'="" S $E(RCCOM1 ,80)=" " ; Make sure GMT messag e will be
	6344	printed o n separate line.
	6345	"RTN","RCC PCPS",112, 0)
	6346	. S ^RC PS(349.2,P SIEN,3)=RC COM1_RCCOM 2_RCCOM3
	6347	"RTN","RCC PCPS",113, 0)
	6348	. ;
	6349	"RTN","RCC PCPS",114, 0)
	6350	. S RCP SDA=0 ; th is variabl e used to set the de scription on the PS segment
	6351	"RTN","RCC PCPS",115, 0)
	6352	. S RCT RDATE=0 F S RCTRDAT E=$O(^TMP( "PRCAGT",$ J,RCDEBTDA ,RCTRDATE) ) Q:'RCTR
	6353	DATE S RC BILLDA=0 F S RCBILL DA=$O(^TMP ("PRCAGT", $J,RCDEBTD A,RCTRDATE ,RCBILLDA
	6354	)) Q:'RCBI LLDA D
	6355	"RTN","RCC PCPS",116, 0)
	6356	. . ; skip CS b ills/trans actions - PRCA4.53 01
	6357	"RTN","RCC PCPS",117, 0)
	6358	. . Q :$D(^PRCA( 430,"TCSP" ,RCBILLDA) )
	6359	"RTN","RCC PCPS",118, 0)
	6360	. . I $P($G(^RC PS(349.2,P SIEN,0))," ^",8)<0 S PC(75)=75
	6361	"RTN","RCC PCPS",119, 0)
	6362	. . I $P($G(^PR CA(430,RCB ILLDA,6)), "^",2)]"", ($P($G(^PR CA(430,RCB ILLDA,7))
	6363	,"^")>0) S PC(1)="01 "
	6364	"RTN","RCC PCPS",120, 0)
	6365	. . S CAT=$P($G (^PRCA(430 ,RCBILLDA, 0)),"^",2)
	6366	"RTN","RCC PCPS",121, 0)
	6367	. . S PC=$P($G( ^PRCA(430. 2,CAT,0)), "^",14)
	6368	"RTN","RCC PCPS",122, 0)
	6369	. . F X=1:1:100 I $P(PC," ,",X)'="" S PCC=$P(P C,",",X),P C(+PCC)=PC C Q:PCC="
	6370	"
	6371	"RTN","RCC PCPS",123, 0)
	6372	. . S PC="",X=0 F S X=$O (PC(X)) Q: X="" I $G (PC(X))'=" " S PC=PC_ PC(X)
	6373	"RTN","RCC PCPS",124, 0)
	6374	. . S $P(^RCPS( 349.2,PSIE N,4),"^")= PC
	6375	"RTN","RCC PCPS",125, 0)
	6376	. . ;
	6377	"RTN","RCC PCPS",126, 0)
	6378	. . I $D(^TMP(" PRCAGT",$J ,RCDEBTDA, RCTRDATE,R CBILLDA,0) ) S AMT=+^ (0) I AMT
	6379	D
	6380	"RTN","RCC PCPS",127, 0)
	6381	. . . ; get the descri ption for the bill
	6382	"RTN","RCC PCPS",128, 0)
	6383	. . . K RCDES C D BILLDE SC^RCCPCPS 1(RCBILLDA )
	6384	"RTN","RCC PCPS",129, 0)
	6385	. . . ;
	6386	"RTN","RCC PCPS",130, 0)
	6387	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	6388	"RTN","RCC PCPS",131, 0)
	6389	. . . S RCPSD A=RCPSDA+1
	6390	"RTN","RCC PCPS",132, 0)
	6391	. . . S $P(^R CPS(349.2, PSIEN,2,RC PSDA,0),"^ ",1,4)=$P( RCTRDATE," .")_"^"_$
	6392	G(RCDESC(1 ))_"^"_$G( AMT)_"^"_$ P($G(^PRCA (430,RCBIL LDA,0)),"^ ")
	6393	"RTN","RCC PCPS",133, 0)
	6394	. . . F X=2:1 Q:$G(RCDE SC(X))="" S RCPSDA= RCPSDA+1,^ RCPS(349.2 ,PSIEN,2,
	6395	RCPSDA,0)= "^"_RCDESC (X)_"^^"
	6396	"RTN","RCC PCPS",134, 0)
	6397	. . ;
	6398	"RTN","RCC PCPS",135, 0)
	6399	. . S RCTRANDA= 0 F S RCT RANDA=$O(^ TMP("PRCAG T",$J,RCDE BTDA,RCTRD ATE,RCBIL
	6400	LDA,RCTRAN DA)) D:'RC TRANDA NO Q:'RCTRAND A D
	6401	"RTN","RCC PCPS",136, 0)
	6402	. . . ; get the descri ption for the transa ction
	6403	"RTN","RCC PCPS",137, 0)
	6404	. . . K RCDES C D TRANDE SC^RCCPCPS 1(RCTRANDA ),RCDESC
	6405	"RTN","RCC PCPS",138, 0)
	6406	. . . ; if i t is an in terest/adm in charge, summarize it below
	6407	"RTN","RCC PCPS",139, 0)
	6408	. . . I $G(RC DESC(1))[" INTEREST" Q
	6409	"RTN","RCC PCPS",140, 0)
	6410	. . . ; get the value of the tra nsaction f or the sta tement
	6411	"RTN","RCC PCPS",141, 0)
	6412	. . . S VALUE =$$TRANVAL U^RCDPBTLM (RCTRANDA)
	6413	"RTN","RCC PCPS",142, 0)
	6414	. . . S VALUE =$P(VALUE, "^",2)+$P( VALUE,"^", 3)+$P(VALU E,"^",4)+$ P(VALUE,"
	6415	^",5)+$P(V ALUE,"^",6 )
	6416	"RTN","RCC PCPS",143, 0)
	6417	. . . ; if i t is a sus pended (47 ) or unsus pended (46 ) transact ion, show
	6418	value
	6419	"RTN","RCC PCPS",144, 0)
	6420	. . . ; make suspended charges a ppear as n egative
	6421	"RTN","RCC PCPS",145, 0)
	6422	. . . S RCDAT A1=$G(^PRC A(433,RCTR ANDA,1))
	6423	"RTN","RCC PCPS",146, 0)
	6424	. . . I $P(RC DATA1,"^", 2)=47!($P( RCDATA1,"^ ",2)=46) S VALUE=$P( RCDATA1,"
	6425	^",5) I $P (RCDATA1," ^",2)=47 S VALUE=-VA LUE
	6426	"RTN","RCC PCPS",147, 0)
	6427	. . . ; if i t is an am ended bill , show val ue
	6428	"RTN","RCC PCPS",148, 0)
	6429	. . . I $P(RC DATA1,"^", 2)=33 S VA LUE=$P(RCD ATA1,"^",5 )
	6430	"RTN","RCC PCPS",149, 0)
	6431	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	6432	"RTN","RCC PCPS",150, 0)
	6433	. . . S RCPSD A=RCPSDA+1
	6434	"RTN","RCC PCPS",151, 0)
	6435	. . . S $P(^R CPS(349.2, PSIEN,2,RC PSDA,0),"^ ",1,5)=$P( RCTRDATE," .")_"^"_$
	6436	G(RCDESC(1 ))_"^"_VAL UE_"^"_$P( $G(^PRCA(4 30,RCBILLD A,0)),"^")
	6437	"RTN","RCC PCPS",152, 0)
	6438	. . . F X=2:1 Q:$G(RCDE SC(X))="" S RCPSDA= RCPSDA+1,^ RCPS(349.2 ,PSIEN,2,
	6439	RCPSDA,0)= "^"_RCDESC (X)_"^^"
	6440	"RTN","RCC PCPS",153, 0)
	6441	. . . ;
	6442	"RTN","RCC PCPS",154, 0)
	6443	. . . ; for comment tr ansaction ... not su re what th is is for ?
	6444	"RTN","RCC PCPS",155, 0)
	6445	. . . I $P(RC DATA1,"^", 2)=45,$P($ G(^PRCA(43 3,RCTRANDA ,5)),"^",2 )["your w
	6446	aiver righ ts" S ^RCP S(349.2,PS IEN,4)="01 50"
	6447	"RTN","RCC PCPS",156, 0)
	6448	. ;
	6449	"RTN","RCC PCPS",157, 0)
	6450	. ; if interest, admin, or other, ad d them her e
	6451	"RTN","RCC PCPS",158, 0)
	6452	. S X=$ G(RCTOTAL( "INT"))+$G (RCTOTAL(" ADM"))+$G( RCTOTAL("O TH"))
	6453	"RTN","RCC PCPS",159, 0)
	6454	. I X>0 D
	6455	"RTN","RCC PCPS",160, 0)
	6456	. . S RCDESC="I NTEREST/AD M. CHARGE (Int:"_$J( $G(RCTOTAL ("INT")),1 ,2)_" Adm
	6457	:"_$J($G(R CTOTAL("AD M")),1,2)_ " Other:"_ $J($G(RCTO TAL("OTH") ),1,2)_")"
	6458	"RTN","RCC PCPS",161, 0)
	6459	. . S RCPSDA=RC PSDA+1
	6460	"RTN","RCC PCPS",162, 0)
	6461	. . S ^RCPS(349 .2,PSIEN,2 ,RCPSDA,0) ="^"_RCDES C_"^"_$J(X ,1,2)
	6462	"RTN","RCC PCPS",163, 0)
	6463	. . S ^RCPS(349 .2,PSIEN,2 ,0)="^^"_R CPSDA_"^"_ RCPSDA
	6464	"RTN","RCC PCPS",164, 0)
	6465	. ;
	6466	"RTN","RCC PCPS",165, 0)
	6467	. ; PRC A4.5313 - Set stat ement date into cros s-referenc e
	6468	"RTN","RCC PCPS",166, 0)
	6469	. S $P( ^RCPS(349. 2,PSIEN,0) ,U,19)=SDT
	6470	"RTN","RCC PCPS",167, 0)
	6471	. ;
	6472	"RTN","RCC PCPS",168, 0)
	6473	. ; se t 0th node
	6474	"RTN","RCC PCPS",169, 0)
	6475	. I RCP SDA S ^RCP S(349.2,PS IEN,2,0)=" ^^"_RCPSDA _"^"_RCPSD A
	6476	"RTN","RCC PCPS",170, 0)
	6477	. ;
	6478	"RTN","RCC PCPS",171, 0)
	6479	. ; PRC A4.5313 - Set Cros s-Referenc es for thi s Debtor
	6480	"RTN","RCC PCPS",172, 0)
	6481	. S DA= PSIEN,DIK= "^RCPS(349 .2," D IX1 ^DIK
	6482	"RTN","RCC PCPS",173, 0)
	6483	. ;
	6484	"RTN","RCC PCPS",174, 0)
	6485	. ; PRC A4.5313 - Remove d ata for ea ch debtor
	6486	"RTN","RCC PCPS",175, 0)
	6487	. K ^XT MP("PRCAGU ",$J,DEB)
	6488	"RTN","RCC PCPS",176, 0)
	6489	. ;
	6490	"RTN","RCC PCPS",177, 0)
	6491	. I RCP SDA'<287 S ^XTMP("RC CPC",0)=DT ,(^XTMP("R CCPC",RCDE BTDA),^XTM P("RCCPC1
	6492	",PSIEN))= "" Q
	6493	"RTN","RCC PCPS",178, 0)
	6494	. D NO
	6495	"RTN","RCC PCPS",179, 0)
	6496	;
	6497	"RTN","RCC PCPS",180, 0)
	6498	S PSIEN=0 S PSIEN=$ O(^RCPS(34 9.2,"STDT" ,SDT,PSIEN )) Q:PSIEN ="" S $P( ^RCPS(349
	6499	.2,PSIEN,0 ),"^",18)= 1
	6500	"RTN","RCC PCPS",181, 0)
	6501	;
	6502	"RTN","RCC PCPS",182, 0)
	6503	; PRCA4. 5313 - Se nd ICN Err or email i f necessar y
	6504	"RTN","RCC PCPS",183, 0)
	6505	I $D(^TMP ("ICNERROR ",$J)) D I CNERR^RCCP CPS1 K ^TM P("ICNERRO R",$J)
	6506	"RTN","RCC PCPS",184, 0)
	6507	;
	6508	"RTN","RCC PCPS",185, 0)
	6509	K COMM,TR ,TRNIEN
	6510	"RTN","RCC PCPS",186, 0)
	6511	;
	6512	"RTN","RCC PCPS",187, 0)
	6513	OSTM ;Proc ess old st atements
	6514	"RTN","RCC PCPS",188, 0)
	6515	S DIK="^R CPS(349.2, ",DA=0 F S DA=$O(^X TMP("RCCPC 1",DA)) Q: 'DA D ^DI K
	6516	"RTN","RCC PCPS",189, 0)
	6517	K DA,^XTM P("RCCPC1" )
	6518	"RTN","RCC PCPS",190, 0)
	6519	;
	6520	"RTN","RCC PCPS",191, 0)
	6521	STATMNT ;P rint patie nt stateme nts
	6522	"RTN","RCC PCPS",192, 0)
	6523	N IOP,ZTI O,ZTSAVE,Z TRTN,ZTDES C,ZTASK,%Z IS,ZTDTH,P RCADEV,POP
	6524	"RTN","RCC PCPS",193, 0)
	6525	S (IOP,PR CADEV)=$P( $G(^RC(342 ,1,0)),"^" ,8)
	6526	"RTN","RCC PCPS",194, 0)
	6527	I IOP]"" D
	6528	"RTN","RCC PCPS",195, 0)
	6529	.S ZTRTN= "STM^RCCPC STM",ZTDTH =$H,ZTDESC ="Print ol d AR State ments"
	6530	"RTN","RCC PCPS",196, 0)
	6531	.S %ZIS=" N0" D ^%ZI S Q:POP
	6532	"RTN","RCC PCPS",197, 0)
	6533	.S ZTSAVE ("PRCADEV" )="" D ^%Z TLOAD,^%ZI SC
	6534	"RTN","RCC PCPS",198, 0)
	6535	; PRCA4. 5313 - Un lock prior to exitin g
	6536	"RTN","RCC PCPS",199, 0)
	6537	L -^RCPS( 349.2):DIL OCKTM
	6538	"RTN","RCC PCPS",200, 0)
	6539	Q
	6540	"RTN","RCC PCPS",201, 0)
	6541	;
	6542	"RTN","RCC PCPS",202, 0)
	6543	NO ;If the re is no a ctivity
	6544	"RTN","RCC PCPS",203, 0)
	6545	I $G(^RCP S(349.2,PS IEN,4))["0 150" D
	6546	"RTN","RCC PCPS",204, 0)
	6547	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^NOTICE: Y ou now hav e delinque nt charges . Please^
	6548	^"
	6549	"RTN","RCC PCPS",205, 0)
	6550	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^review En forcement of Involun tary Colle ctions^^"
	6551	"RTN","RCC PCPS",206, 0)
	6552	.S ^RCPS( 349.2,PSIE N,2,3,0)=" ^on revers e.^^"
	6553	"RTN","RCC PCPS",207, 0)
	6554	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 3^3"
	6555	"RTN","RCC PCPS",208, 0)
	6556	I $G(^RCP S(349.2,PS IEN,2,1,0) )="" D
	6557	"RTN","RCC PCPS",209, 0)
	6558	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^No Activi ty in the Last 30 Da ys!^^"
	6559	"RTN","RCC PCPS",210, 0)
	6560	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^Please re fer to pre vious stat ement of r ights.^^"
	6561	"RTN","RCC PCPS",211, 0)
	6562	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 2^2"
	6563	"RTN","RCC PCPS",212, 0)
	6564	.I $G(^RC PS(349.2,P SIEN,4))=" " S ^(4)=" 90"
	6565	"RTN","RCC PCPS",213, 0)
	6566	Q
	6567	"RTN","RCC PCPS",214, 0)
	6568	BUILD ;Thi s is the e ntry point from the BUILD CCPC file opti on
	6569	"RTN","RCC PCPS",215, 0)
	6570	N TDT,QDT ,ZTDESC,ZT ASK,ZTSK,Z DTDTH,ZTIO ,ZTRTN,CNC L,%H,%DT,D IR,DTOUT
	6571	"RTN","RCC PCPS",216, 0)
	6572	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6573	"RTN","RCC PCPS",217, 0)
	6574	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmi
	6575	tted. Try again lat er." Q
	6576	"RTN","RCC PCPS",218, 0)
	6577	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	6578	"RTN","RCC PCPS",219, 0)
	6579	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6580	"RTN","RCC PCPS",220, 0)
	6581	S DIR(0)= "DAO^^K:"" ,1,2,4,6,7 ,8,10,12,1 4,15,17,19 ,21,22,24, 26,""'[("" ,""_+$E(Y
	6582	,6,7)_""," ") X"
	6583	"RTN","RCC PCPS",221, 0)
	6584	S DIR("A" )="Enter a Patient S tatement d ate for th is build: "
	6585	"RTN","RCC PCPS",222, 0)
	6586	S DIR("?" )="Enter a Patient S tatement d ate for th is build o r ^ to exi t."
	6587	"RTN","RCC PCPS",223, 0)
	6588	D ^DIR
	6589	"RTN","RCC PCPS",224, 0)
	6590	; PRCA4. 5313 - Un lock prior to quitti ng
	6591	"RTN","RCC PCPS",225, 0)
	6592	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	6593	"RTN","RCC PCPS",226, 0)
	6594	S SDT=Y
	6595	"RTN","RCC PCPS",227, 0)
	6596	S TDT=$O( ^RCPS(349. 2,"STDT",S DT,0)) I T DT D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$
	6597	D(DIROUT) Q
	6598	"RTN","RCC PCPS",228, 0)
	6599	.S TDT=$T R($$SLH^RC FN01(SDT), "/","")
	6600	"RTN","RCC PCPS",229, 0)
	6601	.W *7,!!, "The Patie nt Stateme nts for ", $E(TDT,1,2 )_"/"_$E(T DT,3,4)_"/ "_$E(TDT,
	6602	5,8)
	6603	"RTN","RCC PCPS",230, 0)
	6604	.I $D(^RC T(349,"SDT ",+$E(SDT, 6,7))) D
	6605	"RTN","RCC PCPS",231, 0)
	6606	..S TDT=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",+ $E(SDT,6,7 ),0)),0)," ^",10)
	6607	"RTN","RCC PCPS",232, 0)
	6608	..S TDT=$ TR($$SLH^R CFN01(TDT) ,"/","")
	6609	"RTN","RCC PCPS",233, 0)
	6610	..W " wer e transmit ted on ",$ E(TDT,1,2) _"/"_$E(TD T,3,4)_"/" _$E(TDT,5, 8)_"."
	6611	"RTN","RCC PCPS",234, 0)
	6612	.E W " d o not have a transmi ssion date !"
	6613	"RTN","RCC PCPS",235, 0)
	6614	.W !!,">> PLEASE CO NTACT CUST OMER SUPPO RT BEFORE PROCEEDING <<",!!
	6615	"RTN","RCC PCPS",236, 0)
	6616	.N DIR,DT OUT,DUOUT, DIRUT,DIRO UT
	6617	"RTN","RCC PCPS",237, 0)
	6618	.S DIR(0) ="E",DIR(" A")=" Pres s ENTER to Continue with Build or ^ to E xit" D ^D
	6619	IR
	6620	"RTN","RCC PCPS",238, 0)
	6621	.I $D(DTO UT)!$D(DUO UT)!$D(DIR UT)!$D(DIR OUT) L -^R CPS(349.2) :DILOCKTM Q
	6622	"RTN","RCC PCPS",239, 0)
	6623	; PRCA4. 5313 - Un lock prior to jobbin g off
	6624	"RTN","RCC PCPS",240, 0)
	6625	L -^RCPS( 349.2):DIL OCKTM
	6626	"RTN","RCC PCPS",241, 0)
	6627	I $D(DIRU T) K SDT Q
	6628	"RTN","RCC PCPS",242, 0)
	6629	TIME S ZTI O="",ZTRTN ="EN1^RCCP CPS",ZTDES C="Build C BSS Statem ent File"
	6630	"RTN","RCC PCPS",243, 0)
	6631	S ZTDTH=" ",ZTSAVE(" SDT")=SDT D ^%ZTLOAD Q:$G(ZTSK )=""
	6632	"RTN","RCC PCPS",244, 0)
	6633	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6634	"RTN","RCC PCPS",245, 0)
	6635	; PRCA5. 4313 - Al low run an y time
	6636	"RTN","RCC PCPS",246, 0)
	6637	;I (QDT>D T_"."_0800 )&(QDT<(DT _"."_1801) ) D G TIM E
	6638	"RTN","RCC PCPS",247, 0)
	6639	;.W !!,*7 ,"You Can Not Queue this Job B etween 8:0 0am and 6: 00pm.",!
	6640	"RTN","RCC PCPS",248, 0)
	6641	;.D KILL^ %ZTLOAD
	6642	"RTN","RCC PCPS",249, 0)
	6643	W !,"Queu ed for Bui lding."
	6644	"RTN","RCC PCPS",250, 0)
	6645	; PRCA4. 5313 - Un lock prior to quitti ng
	6646	"RTN","RCC PCPS",251, 0)
	6647	L -^RCPS( 349.2):DIL OCKTM
	6648	"RTN","RCC PCPS",252, 0)
	6649	Q
	6650	"RTN","RCC PCPS",253, 0)
	6651	;
	6652	"RTN","RCC PCPS",254, 0)
	6653	RCDESC ;Re move "IN P ART" & "IN FULL" fro m the the bill descr iption
	6654	"RTN","RCC PCPS",255, 0)
	6655	QUIT:$G(R CDESC(1))= ""
	6656	"RTN","RCC PCPS",256, 0)
	6657	S RCINFUL L=" (IN FU LL)"
	6658	"RTN","RCC PCPS",257, 0)
	6659	S RCINPAR T=" (IN PA RT)"
	6660	"RTN","RCC PCPS",258, 0)
	6661	I RCDESC( 1)[RCINFUL L S RCDESC (1)=$P(RCD ESC(1),RCI NFULL)_$P( RCDESC(1), RCINFULL,
	6662	2)
	6663	"RTN","RCC PCPS",259, 0)
	6664	I RCDESC( 1)[RCINPAR T S RCDESC (1)=$P(RCD ESC(1),RCI NPART)_$P( RCDESC(1), RCINPART,
	6665	2)
	6666	"RTN","RCC PCPS",260, 0)
	6667	Q
	6668	"RTN","RCC PCPS",261, 0)
	6669	FLBPD1() ; PRCA4.5 313 - Retu rn last bi ll prep da te
	6670	"RTN","RCC PCPS",262, 0)
	6671	N X1,X2 S X1="" I ' $D(^PRCA(4 30,"ATD",R CDFN)) Q X 1
	6672	"RTN","RCC PCPS",263, 0)
	6673	S X2=$O(^ PRCA(430," ATD",RCDFN ,X1),-1)
	6674	"RTN","RCC PCPS",264, 0)
	6675	S X1=$O(^ PRCA(430," ATD",RCDFN ,X2,X1),-1 )
	6676	"RTN","RCC PCPS",265, 0)
	6677	Q X1
	6678	"RTN","RCC PCPS1")
	6679	0^11^B6544 3378^B3737 0113
	6680	"RTN","RCC PCPS1",1,0 )
	6681	RCCPCPS1 ; WISC/RFJ-b uild descr iption for patient s tatement ; 08 Aug 200 1
	6682	"RTN","RCC PCPS1",2,0 )
	6683	;;4.5;Acc ounts Rece ivable;3 4,48,104,1 70,176,192 ,265,313 ;Mar 20, 1 995;Build
	6684	118
	6685	"RTN","RCC PCPS1",3,0 )
	6686	;;Per VA Directive 6402, this routine s hould not be modifie d.
	6687	"RTN","RCC PCPS1",4,0 )
	6688	Q
	6689	"RTN","RCC PCPS1",5,0 )
	6690	;
	6691	"RTN","RCC PCPS1",6,0 )
	6692	;
	6693	"RTN","RCC PCPS1",7,0 )
	6694	TRANDESC(R CTRANDA,RC WIDTH) ; build the descriptio n array fo r a transa ction
	6695	"RTN","RCC PCPS1",8,0 )
	6696	;
	6697	"RTN","RCC PCPS1",9,0 )
	6698	; initia lize
	6699	"RTN","RCC PCPS1",10, 0)
	6700	N DESCRIP T,RCBILLDA ,RCCATEG,R CCATTXT,RC DATA0,RCDA TA1,RCDATA 3,RCLINE,T RANTYPE,X
	6701	"RTN","RCC PCPS1",11, 0)
	6702	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	6703	"RTN","RCC PCPS1",12, 0)
	6704	K RCDESC
	6705	"RTN","RCC PCPS1",13, 0)
	6706	S RCLINE= 1,RCDESC(1 )=""
	6707	"RTN","RCC PCPS1",14, 0)
	6708	;
	6709	"RTN","RCC PCPS1",15, 0)
	6710	S RCBILLD A=+$P($G(^ PRCA(433,R CTRANDA,0) ),"^",2) I 'RCBILLDA Q
	6711	"RTN","RCC PCPS1",16, 0)
	6712	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	6713	"RTN","RCC PCPS1",17, 0)
	6714	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	6715	"RTN","RCC PCPS1",18, 0)
	6716	S RCDATA1 =^PRCA(433 ,RCTRANDA, 1)
	6717	"RTN","RCC PCPS1",19, 0)
	6718	S TRANTYP E=$P(RCDAT A1,"^",2)
	6719	"RTN","RCC PCPS1",20, 0)
	6720	;
	6721	"RTN","RCC PCPS1",21, 0)
	6722	; build the first line descr iption
	6723	"RTN","RCC PCPS1",22, 0)
	6724	; if tra nsaction t ype is an increase o r decrease , set desc ription
	6725	"RTN","RCC PCPS1",23, 0)
	6726	I TRANTYP E=1!(TRANT YPE=35) D
	6727	"RTN","RCC PCPS1",24, 0)
	6728	. ; if c means t est, set d escription to catego ry for c m eans test
	6729	"RTN","RCC PCPS1",25, 0)
	6730	. I RCC ATEG=18 S DESCRIPT=$ S($P(RCDAT A0,"^",16) :$P(^PRCA( 430.2,$P(R CDATA0,"^
	6731	",16),0)," ^"),1:RCCA TTXT) Q
	6732	"RTN","RCC PCPS1",26, 0)
	6733	. ; ot herwise, s et to cate gory name
	6734	"RTN","RCC PCPS1",27, 0)
	6735	. S DES CRIPT=RCCA TTXT
	6736	"RTN","RCC PCPS1",28, 0)
	6737	;
	6738	"RTN","RCC PCPS1",29, 0)
	6739	; if the bill cate gory is a rx-copay a nd it is a n increase adjustmen t
	6740	"RTN","RCC PCPS1",30, 0)
	6741	; then s et the des cription t o copay
	6742	"RTN","RCC PCPS1",31, 0)
	6743	I RCCATEG =22!(RCCAT EG=23),TRA NTYPE=1 S DESCRIPT=" COPAY"
	6744	"RTN","RCC PCPS1",32, 0)
	6745	;
	6746	"RTN","RCC PCPS1",33, 0)
	6747	; if the bill cate gory is ad ult day he alth care, remove he alth
	6748	"RTN","RCC PCPS1",34, 0)
	6749	I RCCATEG =33 S DESC RIPT="ADUL T DAY CARE "
	6750	"RTN","RCC PCPS1",35, 0)
	6751	;
	6752	"RTN","RCC PCPS1",36, 0)
	6753	; if the bill cate gory is re spite or g eriatric e val,
	6754	"RTN","RCC PCPS1",37, 0)
	6755	; take t he 2nd pie ce removin g institut ional
	6756	"RTN","RCC PCPS1",38, 0)
	6757	I RCCATEG =35!(RCCAT EG=36)!(RC CATEG=37)! (RCCATEG=3 8) S DESCR IPT=$P(RCC ATTXT,"-"
	6758	)_$S(RCCAT EG=35!(RCC ATEG=37):" IN",1:" O UT")_"PATI ENT"
	6759	"RTN","RCC PCPS1",39, 0)
	6760	;
	6761	"RTN","RCC PCPS1",40, 0)
	6762	; if it is a comme nt transac tion
	6763	"RTN","RCC PCPS1",41, 0)
	6764	I TRANTYP E=45 S DES CRIPT="COM MENT: "_$P ($G(^PRCA( 433,RCTRAN DA,5)),"^" ,2)
	6765	"RTN","RCC PCPS1",42, 0)
	6766	;
	6767	"RTN","RCC PCPS1",43, 0)
	6768	; prepay ment bill (1=increas e, 35=decr ease, othe rwise refu nd)
	6769	"RTN","RCC PCPS1",44, 0)
	6770	I RCCATEG =26 S DESC RIPT=$S(TR ANTYPE=1:" OVERPAYMEN T CREDIT", TRANTYPE=3 5:"OVERPA
	6771	YMENT CRED IT DECREAS E",1:"OVER PAYMENT RE FUND")
	6772	"RTN","RCC PCPS1",45, 0)
	6773	;
	6774	"RTN","RCC PCPS1",46, 0)
	6775	; if the first lin e descript ion not se t (like pa yments), s et it
	6776	"RTN","RCC PCPS1",47, 0)
	6777	; to the type of t ransaction
	6778	"RTN","RCC PCPS1",48, 0)
	6779	I $G(DESC RIPT)="" S DESCRIPT= $P($G(^PRC A(430.3,+$ P(RCDATA1, "^",2),0)) ,"^")
	6780	"RTN","RCC PCPS1",49, 0)
	6781	;
	6782	"RTN","RCC PCPS1",50, 0)
	6783	; if the transacti on date is different from the process da te,
	6784	"RTN","RCC PCPS1",51, 0)
	6785	; show i t with the descripti on
	6786	"RTN","RCC PCPS1",52, 0)
	6787	I $P(RCDA TA1,"^"),$ P($P(RCDAT A1,"^"),". ")'=$P($P( RCDATA1,"^ ",9),".") S DESCRIP
	6788	T=DESCRIPT _" ("_$$D ATE($P($P( RCDATA1,"^ "),"."))_" )"
	6789	"RTN","RCC PCPS1",53, 0)
	6790	;
	6791	"RTN","RCC PCPS1",54, 0)
	6792	; set th e first de scription line
	6793	"RTN","RCC PCPS1",55, 0)
	6794	D SETDESC (DESCRIPT)
	6795	"RTN","RCC PCPS1",56, 0)
	6796	;
	6797	"RTN","RCC PCPS1",57, 0)
	6798	; if it is a payme nt transac tion, show amount pa id interes t, admin, other
	6799	"RTN","RCC PCPS1",58, 0)
	6800	I TRANTYP E=2!(TRANT YPE=34) D
	6801	"RTN","RCC PCPS1",59, 0)
	6802	. S RCD ATA3=$G(^P RCA(433,RC TRANDA,3))
	6803	"RTN","RCC PCPS1",60, 0)
	6804	. ; if not inter est, admin , or other , quit
	6805	"RTN","RCC PCPS1",61, 0)
	6806	. I '$P (RCDATA3," ^",2),'$P( RCDATA3,"^ ",3),'$P(R CDATA3,"^" ,4),'$P(RC DATA3,"^"
	6807	,5) Q
	6808	"RTN","RCC PCPS1",62, 0)
	6809	. ;
	6810	"RTN","RCC PCPS1",63, 0)
	6811	. S DES CRIPT=" ( Int:"_$J(+ $P(RCDATA3 ,"^",2),1, 2)_" Adm: "_$J(+$P(R CDATA3,"^
	6812	",3),1,2)
	6813	"RTN","RCC PCPS1",64, 0)
	6814	. ; ca lculate ot her
	6815	"RTN","RCC PCPS1",65, 0)
	6816	. S X=$ P(RCDATA1, "^",5)-$P( RCDATA3,"^ ")-$P(RCDA TA3,"^",2) -$P(RCDATA 3,"^",3)
	6817	"RTN","RCC PCPS1",66, 0)
	6818	. S DES CRIPT=DESC RIPT_$S(X: " Other:"_ $J(X,1,2)_ ")",1:")")
	6819	"RTN","RCC PCPS1",67, 0)
	6820	. D SET DESC(DESCR IPT)
	6821	"RTN","RCC PCPS1",68, 0)
	6822	;
	6823	"RTN","RCC PCPS1",69, 0)
	6824	; if it is a admin cost or i nterest ch arge, tota l the amou nts
	6825	"RTN","RCC PCPS1",70, 0)
	6826	I TRANTYP E=13!(TRAN TYPE=12) D Q
	6827	"RTN","RCC PCPS1",71, 0)
	6828	. S X=$ G(^PRCA(43 3,RCTRANDA ,2)) I X=" " Q
	6829	"RTN","RCC PCPS1",72, 0)
	6830	. S RCT OTAL("INT" )=$G(RCTOT AL("INT")) +$P(X,"^", 7)
	6831	"RTN","RCC PCPS1",73, 0)
	6832	. S RCT OTAL("ADM" )=$G(RCTOT AL("ADM")) +$P(X,"^", 8)
	6833	"RTN","RCC PCPS1",74, 0)
	6834	. S RCT OTAL("OTH" )=$G(RCTOT AL("OTH")) +($P(RCDAT A1,"^",5)- $P(X,"^",7 )-$P(X,"^
	6835	",8))
	6836	"RTN","RCC PCPS1",75, 0)
	6837	;
	6838	"RTN","RCC PCPS1",76, 0)
	6839	; if not an increa se adjustm ent, quit
	6840	"RTN","RCC PCPS1",77, 0)
	6841	I TRANTYP E'=1 Q
	6842	"RTN","RCC PCPS1",78, 0)
	6843	;
	6844	"RTN","RCC PCPS1",79, 0)
	6845	; increa se to c me ans test, ltc or rx- copay, get data from ib
	6846	"RTN","RCC PCPS1",80, 0)
	6847	I RCCATEG =18!(RCCAT EG=22)!(RC CATEG=23)! ((RCCATEG> 32)&(RCCAT EG<40)) D
	6848	"RTN","RCC PCPS1",81, 0)
	6849	. S X=" IBRFN1" X ^%ZOSF("TE ST") I '$T Q
	6850	"RTN","RCC PCPS1",82, 0)
	6851	. K ^TM P("IBRFN1" ,$J)
	6852	"RTN","RCC PCPS1",83, 0)
	6853	. D STM T^IBRFN1(R CTRANDA)
	6854	"RTN","RCC PCPS1",84, 0)
	6855	. D IBD ATA
	6856	"RTN","RCC PCPS1",85, 0)
	6857	Q
	6858	"RTN","RCC PCPS1",86, 0)
	6859	;
	6860	"RTN","RCC PCPS1",87, 0)
	6861	;
	6862	"RTN","RCC PCPS1",88, 0)
	6863	; Return s RCDESC(1 ..n) array of Bill D escription
	6864	"RTN","RCC PCPS1",89, 0)
	6865	BILLDESC(R CBILLDA,RC WIDTH) ;
	6866	"RTN","RCC PCPS1",90, 0)
	6867	; initia lize
	6868	"RTN","RCC PCPS1",91, 0)
	6869	N DESCRIP T,RCCATEG, RCCATTXT,R CDATA0,RCL INE,X
	6870	"RTN","RCC PCPS1",92, 0)
	6871	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	6872	"RTN","RCC PCPS1",93, 0)
	6873	K RCDESC
	6874	"RTN","RCC PCPS1",94, 0)
	6875	S RCLINE= 1,RCDESC(1 )=""
	6876	"RTN","RCC PCPS1",95, 0)
	6877	;
	6878	"RTN","RCC PCPS1",96, 0)
	6879	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	6880	"RTN","RCC PCPS1",97, 0)
	6881	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	6882	"RTN","RCC PCPS1",98, 0)
	6883	;
	6884	"RTN","RCC PCPS1",99, 0)
	6885	; if cat egory=c me ans test, set the de scription and quit
	6886	"RTN","RCC PCPS1",100 ,0)
	6887	I RCCATEG =18 S DESC RIPT=$S($P (RCDATA0," ^",16):$P( ^PRCA(430. 2,$P(RCDAT A0,"^",16
	6888	),0),"^"), 1:RCCATTXT ) D SETDES C(DESCRIPT ) Q
	6889	"RTN","RCC PCPS1",101 ,0)
	6890	;
	6891	"RTN","RCC PCPS1",102 ,0)
	6892	; set th e category descripti on
	6893	"RTN","RCC PCPS1",103 ,0)
	6894	D SETDESC (RCCATTXT)
	6895	"RTN","RCC PCPS1",104 ,0)
	6896	;
	6897	"RTN","RCC PCPS1",105 ,0)
	6898	; if cat egory not champva su bsitence a nd not tri care patie nt, quit
	6899	"RTN","RCC PCPS1",106 ,0)
	6900	I RCCATEG '=27,RCCAT EG'=31 Q
	6901	"RTN","RCC PCPS1",107 ,0)
	6902	;
	6903	"RTN","RCC PCPS1",108 ,0)
	6904	; build descriptio n for cham pva subsis tence and tricare pa tient bill s
	6905	"RTN","RCC PCPS1",109 ,0)
	6906	; get da ta from ib
	6907	"RTN","RCC PCPS1",110 ,0)
	6908	S X="IBRF N1" X ^%ZO SF("TEST") I '$T Q
	6909	"RTN","RCC PCPS1",111 ,0)
	6910	K ^TMP("I BRFN1",$J)
	6911	"RTN","RCC PCPS1",112 ,0)
	6912	D STMTB^I BRFN1($P(R CDATA0,"^" ))
	6913	"RTN","RCC PCPS1",113 ,0)
	6914	D IBDATA
	6915	"RTN","RCC PCPS1",114 ,0)
	6916	Q
	6917	"RTN","RCC PCPS1",115 ,0)
	6918	;
	6919	"RTN","RCC PCPS1",116 ,0)
	6920	;
	6921	"RTN","RCC PCPS1",117 ,0)
	6922	IBDATA ; get data f rom IB for descripti on
	6923	"RTN","RCC PCPS1",118 ,0)
	6924	N IBDATA, IBJ
	6925	"RTN","RCC PCPS1",119 ,0)
	6926	;
	6927	"RTN","RCC PCPS1",120 ,0)
	6928	; show I B data
	6929	"RTN","RCC PCPS1",121 ,0)
	6930	S IBJ=0 F S IBJ=$O (^TMP("IBR FN1",$J,IB J)) Q:'IBJ S IBDATA =^TMP("IBR FN1",$J,I
	6931	BJ) D
	6932	"RTN","RCC PCPS1",122 ,0)
	6933	. ;
	6934	"RTN","RCC PCPS1",123 ,0)
	6935	. ; if no drug o r bill dat e returned from IB, then it is outpatien t
	6936	"RTN","RCC PCPS1",124 ,0)
	6937	. I $P( IBDATA,"^" ,3)="" D:$ P(IBDATA," ^",2) SETD ESC("VISIT DATE: "_$ $DATE($P(
	6938	IBDATA,"^" ,2))) Q
	6939	"RTN","RCC PCPS1",125 ,0)
	6940	. ;
	6941	"RTN","RCC PCPS1",126 ,0)
	6942	. ; if no drug q uantity re turned fro m ib, then it is inp atient
	6943	"RTN","RCC PCPS1",127 ,0)
	6944	. I '$P (IBDATA,"^ ",6) D Q
	6945	"RTN","RCC PCPS1",128 ,0)
	6946	. . I $P(IBDATA ,"^",2) D SETDESC(" ADMISSION DATE: "_$ $DATE($P(I BDATA,"^"
	6947	,2)))
	6948	"RTN","RCC PCPS1",129 ,0)
	6949	. . I $P(IBDATA ,"^",3) D SETDESC(" BEGINNING DATE OF B ILLING CYC LE: "_$$D
	6950	ATE($P(IBD ATA,"^",3) ))
	6951	"RTN","RCC PCPS1",130 ,0)
	6952	. . I $P(IBDATA ,"^",4) D SETDESC(" ENDING DA TE OF BILL ING CYCLE: "_$$DATE
	6953	($P(IBDATA ,"^",4)))
	6954	"RTN","RCC PCPS1",131 ,0)
	6955	. . I $P(IBDATA ,"^",5) D SETDESC(" DISCHARGE DATE: "_$ $DATE($P(I BDATA,"^"
	6956	,5)))
	6957	"RTN","RCC PCPS1",132 ,0)
	6958	. ;
	6959	"RTN","RCC PCPS1",133 ,0)
	6960	. ; ph armacy
	6961	"RTN","RCC PCPS1",134 ,0)
	6962	. D:$P( IBDATA,"^" ,2) SETDES C("RX:"_$P (IBDATA,"^ ",2))
	6963	"RTN","RCC PCPS1",135 ,0)
	6964	. D:$P( IBDATA,"^" ,7) SETDES C("FD:"_$$ DATE($P(IB DATA,"^",7 )))
	6965	"RTN","RCC PCPS1",136 ,0)
	6966	. ;
	6967	"RTN","RCC PCPS1",137 ,0)
	6968	. ; if not patie nt stateme nt detail, quit
	6969	"RTN","RCC PCPS1",138 ,0)
	6970	. I $$D ET^RCFN01( $P(RCDATA0 ,"^",9))'= 2 Q
	6971	"RTN","RCC PCPS1",139 ,0)
	6972	. ;
	6973	"RTN","RCC PCPS1",140 ,0)
	6974	. ; re turn pharm acy detail
	6975	"RTN","RCC PCPS1",141 ,0)
	6976	. I $P( IBDATA,"^" ,3)'="" D SETDESC(" DRUG:"_$TR ($P(IBDATA ,"^",3),"\| ~"))
	6977	"RTN","RCC PCPS1",142 ,0)
	6978	. I $P( IBDATA,"^" ,4) D SETD ESC(" DAYS :"_$P(IBDA TA,"^",4))
	6979	"RTN","RCC PCPS1",143 ,0)
	6980	. I $P( IBDATA,"^" ,6) D SETD ESC(" QTY: "_$P(IBDAT A,"^",6))
	6981	"RTN","RCC PCPS1",144 ,0)
	6982	. I $P( IBDATA,"^" ,5)'="" D SETDESC(" PHY:"_$P(I BDATA,"^", 5))
	6983	"RTN","RCC PCPS1",145 ,0)
	6984	. I $P( IBDATA,"^" ,8) D SETD ESC(" CHG: $"_$J($P(I BDATA,"^", 8),0,2))
	6985	"RTN","RCC PCPS1",146 ,0)
	6986	;
	6987	"RTN","RCC PCPS1",147 ,0)
	6988	K ^TMP("I BRFN1",$J)
	6989	"RTN","RCC PCPS1",148 ,0)
	6990	Q
	6991	"RTN","RCC PCPS1",149 ,0)
	6992	;
	6993	"RTN","RCC PCPS1",150 ,0)
	6994	;
	6995	"RTN","RCC PCPS1",151 ,0)
	6996	; Add lin e to the d escription , not long er than RC WIDTH
	6997	"RTN","RCC PCPS1",152 ,0)
	6998	; Input: RCLINE,RCW IDTH
	6999	"RTN","RCC PCPS1",153 ,0)
	7000	; Output: RCDESC
	7001	"RTN","RCC PCPS1",154 ,0)
	7002	SETDESC(DE SCRIPT) N LENGTH
	7003	"RTN","RCC PCPS1",155 ,0)
	7004	; calcul ate the le ngth of th e descript ion
	7005	"RTN","RCC PCPS1",156 ,0)
	7006	S LENGTH= $L(RCDESC( RCLINE))+$ L(DESCRIPT )
	7007	"RTN","RCC PCPS1",157 ,0)
	7008	I RCDESC( RCLINE)'=" " S LENGTH =LENGTH+1
	7009	"RTN","RCC PCPS1",158 ,0)
	7010	;
	7011	"RTN","RCC PCPS1",159 ,0)
	7012	; the de scription line canno t go over RCWIDTH ch aracters
	7013	"RTN","RCC PCPS1",160 ,0)
	7014	I LENGTH< RCWIDTH S RCDESC(RCL INE)=RCDES C(RCLINE)_ $S(RCDESC( RCLINE)="" :"",1:" "
	7015	)_DESCRIPT Q
	7016	"RTN","RCC PCPS1",161 ,0)
	7017	;
	7018	"RTN","RCC PCPS1",162 ,0)
	7019	; Descrip tion line to add is over RCWID TH
	7020	"RTN","RCC PCPS1",163 ,0)
	7021	; The giv en string will be sp litted _on ly_ if the limit is more than 44 charac
	7022	ters.
	7023	"RTN","RCC PCPS1",164 ,0)
	7024	I $L(DESC RIPT)>RCWI DTH D Q
	7025	"RTN","RCC PCPS1",165 ,0)
	7026	. I RCD ESC(RCLINE )'="" S RC LINE=RCLIN E+1
	7027	"RTN","RCC PCPS1",166 ,0)
	7028	. S RCD ESC(RCLINE )=$E(DESCR IPT,1,RCWI DTH)
	7029	"RTN","RCC PCPS1",167 ,0)
	7030	. S RCL INE=RCLINE +1
	7031	"RTN","RCC PCPS1",168 ,0)
	7032	. S RCD ESC(RCLINE )=$E(DESCR IPT,RCWIDT H+1,2*RCWI DTH)
	7033	"RTN","RCC PCPS1",169 ,0)
	7034	;
	7035	"RTN","RCC PCPS1",170 ,0)
	7036	; over R CWIDTH cha racters, s tart new l ine
	7037	"RTN","RCC PCPS1",171 ,0)
	7038	I RCDESC( RCLINE)'=" " S RCLINE =RCLINE+1
	7039	"RTN","RCC PCPS1",172 ,0)
	7040	S RCDESC( RCLINE)=DE SCRIPT
	7041	"RTN","RCC PCPS1",173 ,0)
	7042	Q
	7043	"RTN","RCC PCPS1",174 ,0)
	7044	;
	7045	"RTN","RCC PCPS1",175 ,0)
	7046	DATE(FMDT) ; format date mm/d d/yyyy
	7047	"RTN","RCC PCPS1",176 ,0)
	7048	I 'FMDT Q ""
	7049	"RTN","RCC PCPS1",177 ,0)
	7050	N X,Y,%DT S %DT="TX ",X=FMDT D ^%DT Q:Y< 0 ""
	7051	"RTN","RCC PCPS1",178 ,0)
	7052	Q $E(FMDT ,4,5)_"/"_ $E(FMDT,6, 7)_"/"_(17 00+$E(FMDT ,1,3))
	7053	"RTN","RCC PCPS1",179 ,0)
	7054	;
	7055	"RTN","RCC PCPS1",180 ,0)
	7056	KILL(SDT) ; PRCA4 .5313 - k ill data p rior to re creating f or this da y of mont
	7057	h
	7058	"RTN","RCC PCPS1",181 ,0)
	7059	;
	7060	"RTN","RCC PCPS1",182 ,0)
	7061	; Set dat e back one month
	7062	"RTN","RCC PCPS1",183 ,0)
	7063	N IEN,X,R CT,DA,DIK, ACK
	7064	"RTN","RCC PCPS1",184 ,0)
	7065	;
	7066	"RTN","RCC PCPS1",185 ,0)
	7067	S IEN=""
	7068	"RTN","RCC PCPS1",186 ,0)
	7069	F S IEN= $O(^RCPS(3 49.2,"STDT ",SDT,IEN) ) Q:IEN="" S DA=IEN ,DIK="^RCP S(349.2,"
	7070	D ^DIK
	7071	"RTN","RCC PCPS1",187 ,0)
	7072	;
	7073	"RTN","RCC PCPS1",188 ,0)
	7074	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T D
	7075	"RTN","RCC PCPS1",189 ,0)
	7076	. S ACK=" " F S ACK =$O(^RCT(3 49.1,RCT,4 ,"STDT4",S DT,ACK)) Q :ACK="" D
	7077	"RTN","RCC PCPS1",190 ,0)
	7078	. . S IEN =0 F S IE N=$O(^RCT( 349.1,RCT, 4,"STDT4", SDT,ACK,IE N)) Q:IEN= "" S DA=
	7079	IEN,DIK="^ RCT(349.1, "_RCT_",4, " D ^DIK K ^RCT(349. 1,RCT,4,"S TDT4",SDT, ACK,IEN)
	7080	"RTN","RCC PCPS1",191 ,0)
	7081	. S IEN=0 F S IEN= $O(^RCT(34 9.1,RCT,5, "STDT5",SD T,IEN)) Q: IEN="" S DA=IEN,DI
	7082	K="^RCT(34 9.1,"_RCT_ ",5," D ^D IK K ^RCT( 349.1,RCT, 5,"STDT5", SDT,IEN)
	7083	"RTN","RCC PCPS1",192 ,0)
	7084	;
	7085	"RTN","RCC PCPS1",193 ,0)
	7086	K ^XTMP(" RCCPC")
	7087	"RTN","RCC PCPS1",194 ,0)
	7088	;
	7089	"RTN","RCC PCPS1",195 ,0)
	7090	Q
	7091	"RTN","RCC PCPS1",196 ,0)
	7092	;
	7093	"RTN","RCC PCPS1",197 ,0)
	7094	MONTHAGO(S DT) ; PRC A4.5313 - Return d ate one mo nth prior to entered date - S
	7095	DT is stat ement date
	7096	"RTN","RCC PCPS1",198 ,0)
	7097	; and Sta tement dat e cannot e xceed 26th day of th e month.
	7098	"RTN","RCC PCPS1",199 ,0)
	7099	; New OLD DT in call ing routin e
	7100	"RTN","RCC PCPS1",200 ,0)
	7101	S OLDDT=S DT-100
	7102	"RTN","RCC PCPS1",201 ,0)
	7103	I $E(SDT, 4,5)="01" S OLDDT=($ E(SDT,1,3) -1)_12_$E( SDT,6,7)
	7104	"RTN","RCC PCPS1",202 ,0)
	7105	Q OLDDT
	7106	"RTN","RCC PCPS1",203 ,0)
	7107	;
	7108	"RTN","RCC PCPS1",204 ,0)
	7109	ICNERR ; PRCA4.5 313 - Send email to RCCPC STAT EMENTS Mai l Group wi th all mi
	7110	ssing ICNs
	7111	"RTN","RCC PCPS1",205 ,0)
	7112	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ,XMY, DFN,CNT,I
	7113	"RTN","RCC PCPS1",206 ,0)
	7114	;
	7115	"RTN","RCC PCPS1",207 ,0)
	7116	; Create Message at MSG level of tempor ary storag e
	7117	"RTN","RCC PCPS1",208 ,0)
	7118	S CNT=1,^ TMP("ICNER ROR",$J,"M SG",CNT)=" The Patien t Statemen ts for the se patien
	7119	ts were no t sent to CBSS due t o a"
	7120	"RTN","RCC PCPS1",209 ,0)
	7121	S CNT=2,^ TMP("ICNER ROR",$J,"M SG",CNT)=" missing IC N."
	7122	"RTN","RCC PCPS1",210 ,0)
	7123	S CNT=3,^ TMP("ICNER ROR",$J,"M SG",CNT)=" NAME SSN
	7124	"
	7125	"RTN","RCC PCPS1",211 ,0)
	7126	S CNT=4,^ TMP("ICNER ROR",$J,"M SG",CNT)=" ========== ========== ========== =========
	7127	======="
	7128	"RTN","RCC PCPS1",212 ,0)
	7129	S DFN="" F S DFN=$ O(^TMP("IC NERROR",$J ,DFN)) Q:D FN="" Q:D FN="MSG" D
	7130	"RTN","RCC PCPS1",213 ,0)
	7131	. N DPTDA TA,NAME
	7132	"RTN","RCC PCPS1",214 ,0)
	7133	. S DPTDA TA=$G(^DPT (DFN,0))
	7134	"RTN","RCC PCPS1",215 ,0)
	7135	. I DPTDA TA="" Q
	7136	"RTN","RCC PCPS1",216 ,0)
	7137	. S NAME= $P(DPTDATA ,U)
	7138	"RTN","RCC PCPS1",217 ,0)
	7139	. I $L(NA ME)<35 S $ E(NAME,35) =" "
	7140	"RTN","RCC PCPS1",218 ,0)
	7141	. S CNT=C NT+1
	7142	"RTN","RCC PCPS1",219 ,0)
	7143	. S ^TMP( "ICNERROR" ,$J,"MSG", CNT)=NAME_ $P(DPTDATA ,U,9)
	7144	"RTN","RCC PCPS1",220 ,0)
	7145	;
	7146	"RTN","RCC PCPS1",221 ,0)
	7147	S XMDUZ=D UZ
	7148	"RTN","RCC PCPS1",222 ,0)
	7149	S XMTO(DU Z)=""
	7150	"RTN","RCC PCPS1",223 ,0)
	7151	S XMTO("G .RCCPC STA TEMENTS")= ""
	7152	"RTN","RCC PCPS1",224 ,0)
	7153	S XMSUBJ= "PATIENTS WITH MISSI NG ICNS"
	7154	"RTN","RCC PCPS1",225 ,0)
	7155	S XMBODY= "^TMP(""IC NERROR"",$ J,""MSG"") "
	7156	"RTN","RCC PCPS1",226 ,0)
	7157	S XMINSTR ("FLAGS")= "X"
	7158	"RTN","RCC PCPS1",227 ,0)
	7159	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	7160	"RTN","RCC PCPS1",228 ,0)
	7161	Q
	7162	"RTN","RCC PCSE")
	7163	0^14^B1650 7603^B5810 439
	7164	"RTN","RCC PCSE",1,0)
	7165	RCCPCSE ;W ASH-ISC@AL TOONA,PA/L DB - CCPC Statements Errors;5/ 30/96 10: 20 AM ;10
	7166	/16/96 8: 42 AM
	7167	"RTN","RCC PCSE",2,0)
	7168	V ;;4.5;Ac counts Rec eivable; 34,313;M ar 20, 199 5;Build 11 8
	7169	"RTN","RCC PCSE",3,0)
	7170	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7171	"RTN","RCC PCSE",4,0)
	7172	;
	7173	"RTN","RCC PCSE",5,0)
	7174	K ^TMP($J )
	7175	"RTN","RCC PCSE",6,0)
	7176	N ADD,DIR ,DIRUT,ERR ,ERROR,HDR ,LINE,LN,P G,POP,PT,X ,X1,Y,%ZIS ,Z,ZTRTN,Z TDESC,%,%
	7177	Y,ZTSAVE
	7178	"RTN","RCC PCSE",7,0)
	7179	I '$O(^RC PS(349.2," AD","E",0) ) W !,"THE RE ARE NO CBSS PATIE NT STATEME NT ERRORS
	7180	" Q
	7181	"RTN","RCC PCSE",8,0)
	7182	E W !,"C BSS PATIEN T STATEMEN T ERROR RE PORT"
	7183	"RTN","RCC PCSE",9,0)
	7184	N IEN,%D, DTOUT,SDT, SDAT,TMPQ, ALL,DTPT
	7185	"RTN","RCC PCSE",10,0 )
	7186	S (TMPQ,A LL)=0
	7187	"RTN","RCC PCSE",11,0 )
	7188	S IEN="" F S IEN=$ O(^RCPS(34 9.2,"AD"," E",IEN)) Q :IEN="" I $G(^RCPS( 349.2,IEN
	7189	,5))'="" D
	7190	"RTN","RCC PCSE",12,0 )
	7191	. S SDT=$ P(^RCPS(34 9.2,IEN,0) ,U,19)
	7192	"RTN","RCC PCSE",13,0 )
	7193	. S DTPT( SDT,IEN)=" "
	7194	"RTN","RCC PCSE",14,0 )
	7195	. S DTPT( SDT)=$G(DT PT(SDT))+1
	7196	"RTN","RCC PCSE",15,0 )
	7197	; PRCA4. 5313 - As k about al l dates or specific
	7198	"RTN","RCC PCSE",16,0 )
	7199	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7200	"RTN","RCC PCSE",17,0 )
	7201	S DIR(0)= "YAO"
	7202	"RTN","RCC PCSE",18,0 )
	7203	S DIR("B" )="Y"
	7204	"RTN","RCC PCSE",19,0 )
	7205	S DIR("A" )="Do you want to pr int errors for all d ates avail able? "
	7206	"RTN","RCC PCSE",20,0 )
	7207	D ^DIR
	7208	"RTN","RCC PCSE",21,0 )
	7209	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	7210	"RTN","RCC PCSE",22,0 )
	7211	I Y=1 S A LL=1 D PRI NT Q
	7212	"RTN","RCC PCSE",23,0 )
	7213	; PRCA4. 5313 - Ad d date pro mpts
	7214	"RTN","RCC PCSE",24,0 )
	7215	W !,"The following dates have errors to print:"
	7216	"RTN","RCC PCSE",25,0 )
	7217	S SDT="" F S SDT=$ O(DTPT(SDT )) Q:SDT= "" W !,$$ DATE^RCCPC PS1(SDT)
	7218	"RTN","RCC PCSE",26,0 )
	7219	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7220	"RTN","RCC PCSE",27,0 )
	7221	S DIR(0)= "DAO^^K:'$ D(DTPT(Y)) X"
	7222	"RTN","RCC PCSE",28,0 )
	7223	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	7224	"RTN","RCC PCSE",29,0 )
	7225	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	7226	"RTN","RCC PCSE",30,0 )
	7227	D ^DIR
	7228	"RTN","RCC PCSE",31,0 )
	7229	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	7230	"RTN","RCC PCSE",32,0 )
	7231	S SDT=Y
	7232	"RTN","RCC PCSE",33,0 )
	7233	D PRINT
	7234	"RTN","RCC PCSE",34,0 )
	7235	Q
	7236	"RTN","RCC PCSE",35,0 )
	7237	PRINT ; P RCA4.531 3 Determin e print de vice then enter Sort
	7238	"RTN","RCC PCSE",36,0 )
	7239	D HOME^%Z IS S %ZIS= "QN" D ^%Z IS Q:POP
	7240	"RTN","RCC PCSE",37,0 )
	7241	I $D(IO(" Q")) D Q
	7242	"RTN","RCC PCSE",38,0 )
	7243	.S ZTRTN= "SORT^RCCP CSE",ZTDES C="CBSS PA TIENT STAT EMENT ERRO R REPORT"
	7244	"RTN","RCC PCSE",39,0 )
	7245	. S TMPQ= 1,(ZTSAVE( "DTPT("),Z TSAVE("SDT "),ZTSAVE( "ALL"),ZTS AVE("TMPQ" ))=""
	7246	"RTN","RCC PCSE",40,0 )
	7247	.D ^%ZTLO AD
	7248	"RTN","RCC PCSE",41,0 )
	7249	SORT ; PR CA4.5313 - Rewritt en to prin t by date
	7250	"RTN","RCC PCSE",42,0 )
	7251	S HDR="CB SS PATIENT STATEMENT ERROR REP ORT",LINE= "",$P(LINE ,"=",79)=" ",PG=1
	7252	"RTN","RCC PCSE",43,0 )
	7253	I 'ALL D SORT1,PRNT Q
	7254	"RTN","RCC PCSE",44,0 )
	7255	I ALL S S DT=""
	7256	"RTN","RCC PCSE",45,0 )
	7257	F S SDT= $O(DTPT(SD T)) Q:SDT= "" D SORT 1
	7258	"RTN","RCC PCSE",46,0 )
	7259	D PRNT
	7260	"RTN","RCC PCSE",47,0 )
	7261	; PRCA4. 5313 - Re move TMP s torage
	7262	"RTN","RCC PCSE",48,0 )
	7263	K ^TMP($J )
	7264	"RTN","RCC PCSE",49,0 )
	7265	Q
	7266	"RTN","RCC PCSE",50,0 )
	7267	SORT1 ;PR CA4.5313 Print a d ay of erro rs
	7268	"RTN","RCC PCSE",51,0 )
	7269	N IEN
	7270	"RTN","RCC PCSE",52,0 )
	7271	S IEN="" F S IEN=$ O(DTPT(SDT ,IEN)) Q:I EN="" D
	7272	"RTN","RCC PCSE",53,0 )
	7273	.S ERR=$G (^RCPS(349 .2,IEN,5))
	7274	"RTN","RCC PCSE",54,0 )
	7275	.S ^TMP($ J,"ERR",SD T,IEN)=$P( $G(^RCPS(3 49.2,IEN,0 )),"^",3)_ "^"_$P(^(0 ),"^",2)
	7276	"RTN","RCC PCSE",55,0 )
	7277	.S ADD=$G (^RCPS(349 .2,IEN,1))
	7278	"RTN","RCC PCSE",56,0 )
	7279	.F X=1:1: 6 S ADD(X) =$P(ADD,"^ ",X),^TMP( $J,"ERR",S DT,IEN,1+X )=ADD(X)
	7280	"RTN","RCC PCSE",57,0 )
	7281	.F X=1:5 S X1=X+4,E RROR=$E(ER R,X,X1) Q: ERROR="" D
	7282	"RTN","RCC PCSE",58,0 )
	7283	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=ERROR
	7284	"RTN","RCC PCSE",59,0 )
	7285	..S ERROR =$O(^RCPSE (349.7,"B" ,$E(ERROR, 1,5),""))
	7286	"RTN","RCC PCSE",60,0 )
	7287	..S ERROR =$P($G(^RC PSE(349.7, +ERROR,0)) ,"^",4)
	7288	"RTN","RCC PCSE",61,0 )
	7289	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=^TMP($J ,"ERR",SDT ,IEN,X+10) _"^"_ERROR
	7290	"RTN","RCC PCSE",62,0 )
	7291	;
	7292	"RTN","RCC PCSE",63,0 )
	7293	K ADD
	7294	"RTN","RCC PCSE",64,0 )
	7295	Q
	7296	"RTN","RCC PCSE",65,0 )
	7297	PRNT ; PR CA4.5313 - Print b ased upon statement date
	7298	"RTN","RCC PCSE",66,0 )
	7299	K DIRUT
	7300	"RTN","RCC PCSE",67,0 )
	7301	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7302	"RTN","RCC PCSE",68,0 )
	7303	S (SDT,IE N)=""
	7304	"RTN","RCC PCSE",69,0 )
	7305	F S SDT= $O(^TMP($J ,"ERR",SDT )) Q:SDT=" " D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$
	7306	D(DIROUT) Q
	7307	"RTN","RCC PCSE",70,0 )
	7308	. W @IOF, ?25,HDR,?7 5,PG,!,LIN E S PG=PG+ 1
	7309	"RTN","RCC PCSE",71,0 )
	7310	. W !,?20 ,"Patient Statement Date: "_$$ DATE^RCCPC PS1(SDT),! ,LINE
	7311	"RTN","RCC PCSE",72,0 )
	7312	. F S IE N=$O(^TMP( $J,"ERR",S DT,IEN)) Q :IEN="" D PRNT1 I $ D(DTOUT)!$ D(DUOUT)!
	7313	$D(DIRUT)! $D(DIROUT) Q
	7314	"RTN","RCC PCSE",73,0 )
	7315	. I 'TMPQ S DIR(0)= "E" D ^DIR I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	7316	"RTN","RCC PCSE",74,0 )
	7317	Q
	7318	"RTN","RCC PCSE",75,0 )
	7319	PRNT1 ; P RCA4.531 3 - Print based upon statement date
	7320	"RTN","RCC PCSE",76,0 )
	7321	I ($Y+12) >IOSL D
	7322	"RTN","RCC PCSE",77,0 )
	7323	.I 'TMPQ S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	7324	"RTN","RCC PCSE",78,0 )
	7325	.W @IOF,? 25,HDR,?75 ,PG S PG=P G+1
	7326	"RTN","RCC PCSE",79,0 )
	7327	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	7328	"RTN","RCC PCSE",80,0 )
	7329	W !!,$E($ P(^TMP($J, "ERR",SDT, IEN),"^"), 1,25),?37, "ERROR COD ES",!,$P(^ (IEN),"^"
	7330	,2),?30,$E (LINE,1,48 )
	7331	"RTN","RCC PCSE",81,0 )
	7332	F X=2:1:4 S:$G(^TMP ($J,"ERR", SDT,IEN,X) )]"" ADD(X )=^(X)
	7333	"RTN","RCC PCSE",82,0 )
	7334	S ADD(5)= $G(^TMP($J ,"ERR",SDT ,IEN,5))_" , "_$G(^(6 ))_" "_$G( ^(7))
	7335	"RTN","RCC PCSE",83,0 )
	7336	S X=7 F S X=$O(^TM P($J,"ERR" ,SDT,IEN,X )) Q:'X S ERR(X-1)= ^(X)
	7337	"RTN","RCC PCSE",84,0 )
	7338	S (Z,Y)=0 F D Q:Y =""&(Z="")
	7339	"RTN","RCC PCSE",85,0 )
	7340	.W !
	7341	"RTN","RCC PCSE",86,0 )
	7342	.I Z'="" S Z=$O(ADD (Z)) I Z'= "",(ADD(Z) ]"") W ADD (Z)
	7343	"RTN","RCC PCSE",87,0 )
	7344	.I Y'="" S Y=$O(ERR (Y)) I Y'= "" W ?30,$ P(ERR(Y)," ^"),?40,$P (ERR(Y),"^ ",2)
	7345	"RTN","RCC PCSE",88,0 )
	7346	W !,LINE
	7347	"RTN","RCC PCSE",89,0 )
	7348	Q
	7349	"RTN","RCC PCSV")
	7350	0^9^B11825 361^B51994 90
	7351	"RTN","RCC PCSV",1,0)
	7352	RCCPCSV ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 11
	7353	:36 AM
	7354	"RTN","RCC PCSV",2,0)
	7355	V ;;4.5;Ac counts Rec eivable; 34,70,87,3 13;Mar 2 0, 1995;Bu ild 118
	7356	"RTN","RCC PCSV",3,0)
	7357	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7358	"RTN","RCC PCSV",4,0)
	7359	;
	7360	"RTN","RCC PCSV",5,0)
	7361	EN ;INPUT FROM MESSA GE
	7362	"RTN","RCC PCSV",6,0)
	7363	RREC ;READ INCOMING MESSAGE
	7364	"RTN","RCC PCSV",7,0)
	7365	N DAT,DEB ,END,ERR,E RROR,EVN,K EY,LABEL,L N,MSG,P,RC MSG,RCTR,R CX,RCX1,RE ,SBAL,STO
	7366	T,TR,TR0,T R1,TXT
	7367	"RTN","RCC PCSV",8,0)
	7368	N SDT,NOE RR,X,Y,DA
	7369	"RTN","RCC PCSV",9,0)
	7370	K ^TMP($J )
	7371	"RTN","RCC PCSV",10,0 )
	7372	S (LN,MSG ,RCX,RE)=0
	7373	"RTN","RCC PCSV",11,0 )
	7374	S TXT=0 F X XMREC Q:XMER<0!( XMRG="") S TXT=TXT+ 1,^TMP($J, "MSG",TXT) =XMRG
	7375	"RTN","RCC PCSV",12,0 )
	7376	S (DA(1), NOERR)=""
	7377	"RTN","RCC PCSV",13,0 )
	7378	S TXT=1 F S TXT=$O (^TMP($J," MSG",TXT)) Q:'TXT D
	7379	"RTN","RCC PCSV",14,0 )
	7380	. S:^TMP( $J,"MSG",T XT)?1"PA^" .E DA(1)=4 S:^TMP($J ,"MSG",TXT )?1"IS".E DA(1)=3
	7381	"RTN","RCC PCSV",15,0 )
	7382	. ; PRCA* 4.5*313 - Set Statem ent date f rom PA or IS records
	7383	"RTN","RCC PCSV",16,0 )
	7384	. I "PAIS "[$E(^TMP( $J,"MSG",T XT),1,2) S X=$P(^TMP ($J,"MSG", TXT),"^",7 ) D ^%DT
	7385	S SDT=Y
	7386	"RTN","RCC PCSV",17,0 )
	7387	. ; PRCA* 4.5*313 - If the dat e and sequ ence numbe r have alr eady been processed
	7388	quit afte r setting an error
	7389	"RTN","RCC PCSV",18,0 )
	7390	. I "PAIS "[$P(^TMP( $J,"MSG",T XT),U) I ( $D(^RCT(34 9.1,DA(1), 4,"STDT4", SDT,$P(^T
	7391	MP($J,"MSG ",TXT),U,2 )))) D Q
	7392	"RTN","RCC PCSV",19,0 )
	7393	. . S ERR ="Duplicat e file was received for Patien t Statemen t Date: "_ $P(^TMP($
	7394	J,"MSG",TX T),U,7) D ERRMSG
	7395	"RTN","RCC PCSV",20,0 )
	7396	. . S ERR ="Last Mes sage Ackno wledgement Number: " _$P(^TMP($ J,"MSG",TX T),U,2) D
	7397	ERRMSG
	7398	"RTN","RCC PCSV",21,0 )
	7399	. . S SDT =$P(^TMP($ J,"MSG",TX T),U,7)
	7400	"RTN","RCC PCSV",22,0 )
	7401	. ; PRCA* 4.5*313 - If IT is r eceived it always pr ocesses
	7402	"RTN","RCC PCSV",23,0 )
	7403	. I $P(^T MP($J,"MSG ",TXT),U)= "IT" S SDT =$P(^TMP($ J,"MSG",TX T),"^",6), NOERR=1 Q
	7404	"RTN","RCC PCSV",24,0 )
	7405	. I $G(XM Z)=""!('DA (1))!($D(E RR)) Q
	7406	"RTN","RCC PCSV",25,0 )
	7407	. S RCX=R CX+1
	7408	"RTN","RCC PCSV",26,0 )
	7409	. I "PAIS ADID"[$E(^ TMP($J,"MS G",TXT),1, 2) D
	7410	"RTN","RCC PCSV",27,0 )
	7411	. . ; PRC A4.5313 - Add Stat ement Date to 349.1, five leve l for PA, IS, AD, a
	7412	nd ID reco rds
	7413	"RTN","RCC PCSV",28,0 )
	7414	. . N DIN UM,DIC,X
	7415	"RTN","RCC PCSV",29,0 )
	7416	. . S DIN UM=+$G(XMZ )_RCX
	7417	"RTN","RCC PCSV",30,0 )
	7418	. . S DIC ="^RCT(349 .1,DA(1),5 ,"
	7419	"RTN","RCC PCSV",31,0 )
	7420	. . S X=$ P(^TMP($J, "MSG",TXT) ,"^",2)
	7421	"RTN","RCC PCSV",32,0 )
	7422	. . S DIC (0)="L"
	7423	"RTN","RCC PCSV",33,0 )
	7424	. . S DIC ("DR")=".0 2////"_$P( ^TMP($J,"M SG",TXT)," ^",3)_";.0 3////"_$G( XMZ)_";.0
	7425	4////"_SDT
	7426	"RTN","RCC PCSV",34,0 )
	7427	. . D FIL E^DICN
	7428	"RTN","RCC PCSV",35,0 )
	7429	. ; PRCA* 4.5*313 - If process ing has oc curred
	7430	"RTN","RCC PCSV",36,0 )
	7431	. S NOERR =1
	7432	"RTN","RCC PCSV",37,0 )
	7433	;
	7434	"RTN","RCC PCSV",38,0 )
	7435	K DA(1)
	7436	"RTN","RCC PCSV",39,0 )
	7437	I NOERR D SEG,KILL^ XM
	7438	"RTN","RCC PCSV",40,0 )
	7439	I $O(^TMP ($J,"ERR", 0)) D
	7440	"RTN","RCC PCSV",41,0 )
	7441	. ; PRCA* 4.5*313 - Change CCP C to CBSS and add da te
	7442	"RTN","RCC PCSV",42,0 )
	7443	. S XMSUB ="CBSS ERR OR MESSAGE TO STATIO N FOR "_SD T
	7444	"RTN","RCC PCSV",43,0 )
	7445	. S XMDUZ ="AR PACKA GE"
	7446	"RTN","RCC PCSV",44,0 )
	7447	. S XMTEX T="^TMP($J ,"_"""ERR" ","
	7448	"RTN","RCC PCSV",45,0 )
	7449	. I $O(^X MB(3.8,"B" ,"RCCPC ST ATEMENTS", 0)) S XMY( "G.RCCPC S TATEMENTS" )=""
	7450	"RTN","RCC PCSV",46,0 )
	7451	. D ^XMD
	7452	"RTN","RCC PCSV",47,0 )
	7453	. K ^TMP( $J)
	7454	"RTN","RCC PCSV",48,0 )
	7455	. ; PRCA* 4.5*313 - Change to send SDT f or resend
	7456	"RTN","RCC PCSV",49,0 )
	7457	. D:$G(RE )="R"&($G( SDT)'="") EN^RCCPCML (SDT)
	7458	"RTN","RCC PCSV",50,0 )
	7459	E S XMZ= XQMSG,XMSE R="S."_XQS OP D REMSB MSG^XMA1C
	7460	"RTN","RCC PCSV",51,0 )
	7461	Q
	7462	"RTN","RCC PCSV",52,0 )
	7463	;
	7464	"RTN","RCC PCSV",53,0 )
	7465	SEG S RCMS G=1 S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) D
	7466	"RTN","RCC PCSV",54,0 )
	7467	.S RCTR=^ TMP($J,"MS G",RCMSG)
	7468	"RTN","RCC PCSV",55,0 )
	7469	.S LABEL= $S(($P(RCT R,"^")]"") &($T(@($P( RCTR,"^")) )]""):$P(R CTR,"^"),1 :"ERROR")
	7470	"RTN","RCC PCSV",56,0 )
	7471	.D @(LABE L)
	7472	"RTN","RCC PCSV",57,0 )
	7473	Q
	7474	"RTN","RCC PCSV",58,0 )
	7475	;
	7476	"RTN","RCC PCSV",59,0 )
	7477	ERROR ;SEN D ERROR ME SSAGE TO M AIL GROUP
	7478	"RTN","RCC PCSV",60,0 )
	7479	;
	7480	"RTN","RCC PCSV",61,0 )
	7481	; PRCA4. 5313 - Ch ange CCPC to CBSS
	7482	"RTN","RCC PCSV",62,0 )
	7483	S ERR="CB SS ERROR - CANNOT RE AD MESSAGE FROM CBSS " D ERRMSG
	7484	"RTN","RCC PCSV",63,0 )
	7485	S ERR="An error has occurred in reading a message from the CBSS."
	7486	"RTN","RCC PCSV",64,0 )
	7487	D ERRMSG
	7488	"RTN","RCC PCSV",65,0 )
	7489	S ERR="Pl ease conta ct your IR M for assi stance."
	7490	"RTN","RCC PCSV",66,0 )
	7491	D ERRMSG
	7492	"RTN","RCC PCSV",67,0 )
	7493	S ERR="Th e MESSAGE WAS AS FOL LOWS:"
	7494	"RTN","RCC PCSV",68,0 )
	7495	D ERRMSG
	7496	"RTN","RCC PCSV",69,0 )
	7497	S ERR=^TM P($J,"MSG" ,RCMSG)
	7498	"RTN","RCC PCSV",70,0 )
	7499	D ERRMSG
	7500	"RTN","RCC PCSV",71,0 )
	7501	Q
	7502	"RTN","RCC PCSV",72,0 )
	7503	;
	7504	"RTN","RCC PCSV",73,0 )
	7505	IS ;INVALI D STATEMEN T
	7506	"RTN","RCC PCSV",74,0 )
	7507	D IS^RCCP CSV1
	7508	"RTN","RCC PCSV",75,0 )
	7509	Q
	7510	"RTN","RCC PCSV",76,0 )
	7511	;
	7512	"RTN","RCC PCSV",77,0 )
	7513	PA ;STATEM ENT ACKNOW LEDGEMENT
	7514	"RTN","RCC PCSV",78,0 )
	7515	D PA^RCCP CSV1
	7516	"RTN","RCC PCSV",79,0 )
	7517	Q
	7518	"RTN","RCC PCSV",80,0 )
	7519	;
	7520	"RTN","RCC PCSV",81,0 )
	7521	IT ;INVALI D TRANSMIS SION
	7522	"RTN","RCC PCSV",82,0 )
	7523	D IT^RCCP CSV1
	7524	"RTN","RCC PCSV",83,0 )
	7525	Q
	7526	"RTN","RCC PCSV",84,0 )
	7527	;
	7528	"RTN","RCC PCSV",85,0 )
	7529	ERRMSG ;ER ROR MESSAG E
	7530	"RTN","RCC PCSV",86,0 )
	7531	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	7532	"RTN","RCC PCSV",87,0 )
	7533	Q
	7534	"RTN","RCC PCSV1")
	7535	0^12^B4331 3841^B3201 7096
	7536	"RTN","RCC PCSV1",1,0 )
	7537	RCCPCSV1 ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 2:
	7538	54 PM
	7539	"RTN","RCC PCSV1",2,0 )
	7540	;;4.5;Acc ounts Rece ivable;*3 4,70,76,13 0,153,313 *;Mar 20, 1995;Build 118
	7541	"RTN","RCC PCSV1",3,0 )
	7542	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7543	"RTN","RCC PCSV1",4,0 )
	7544	;
	7545	"RTN","RCC PCSV1",5,0 )
	7546	IS ;INVALI D STATEMEN T
	7547	"RTN","RCC PCSV1",6,0 )
	7548	; PRCA4. 5313 - Ad d SDT for Patient St atement Da te
	7549	"RTN","RCC PCSV1",7,0 )
	7550	N SDAT,SD T,X,Y,ERR
	7551	"RTN","RCC PCSV1",8,0 )
	7552	S SDAT=$P (RCTR,"^", 7) S (X,SD T)=SDAT D ^%DT S SDA T=Y
	7553	"RTN","RCC PCSV1",9,0 )
	7554	D CHKTRAN (LABEL)
	7555	"RTN","RCC PCSV1",10, 0)
	7556	S ERR="Th e followin g statemen ts did not print due to errors :" D ERRMS G
	7557	"RTN","RCC PCSV1",11, 0)
	7558	S ERR=" " D ERRMSG
	7559	"RTN","RCC PCSV1",12, 0)
	7560	S ERR=" KEY ER ROR" D ERR MSG S ERR= " " D ERRM SG
	7561	"RTN","RCC PCSV1",13, 0)
	7562	D ID
	7563	"RTN","RCC PCSV1",14, 0)
	7564	S ERR="If these err ors are co rrected, t hese state ments will not print until" D
	7565	ERRMSG S ERR="the n ext billin g cycle." D ERRMSG
	7566	"RTN","RCC PCSV1",15, 0)
	7567	Q
	7568	"RTN","RCC PCSV1",16, 0)
	7569	;
	7570	"RTN","RCC PCSV1",17, 0)
	7571	ID ;INVALI D STATEMEN T DETAIL E RROR
	7572	"RTN","RCC PCSV1",18, 0)
	7573	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	7574	"RTN","RCC PCSV1",19, 0)
	7575	.; PRCA4 .5313 - C lean up va riables
	7576	"RTN","RCC PCSV1",20, 0)
	7577	.N KEY,DE B,ERROR,RC X,RCX1,ERR ,LN
	7578	"RTN","RCC PCSV1",21, 0)
	7579	.I $P(^TM P($J,"MSG" ,RCMSG),"^ ")'="ID" S ERR="ERRO R IN READI NG CBSS ER ROR RECOR
	7580	D" D ERRMS G Q
	7581	"RTN","RCC PCSV1",22, 0)
	7582	.S KEY=$P (^TMP($J," MSG",RCMSG ),"^",2),K EY=$TR(KEY ," ",""),K EY=$E(KEY, $F(KEY,$$
	7583	SITE^RCMSI TE),999)
	7584	"RTN","RCC PCSV1",23, 0)
	7585	.I KEY']" " D KEYERR Q
	7586	"RTN","RCC PCSV1",24, 0)
	7587	.S DEB=$O (^RCPS(349 .2,"AKEY", KEY,0)) I 'DEB D KEY ERR Q
	7588	"RTN","RCC PCSV1",25, 0)
	7589	.S ERROR= $P(^TMP($J ,"MSG",RCM SG),"^",3) ,^RCPS(349 .2,+DEB,5) =ERROR
	7590	"RTN","RCC PCSV1",26, 0)
	7591	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERR(0)=$E( ERROR,RCX, RCX1) Q:ER R(0)="" D
	7592	"RTN","RCC PCSV1",27, 0)
	7593	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERR(0)," "))
	7594	"RTN","RCC PCSV1",28, 0)
	7595	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RR(0)
	7596	"RTN","RCC PCSV1",29, 0)
	7597	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 )
	7598	"RTN","RCC PCSV1",30, 0)
	7599	..S ERR=K EY_" "_ERR (0)_" "_ER R
	7600	"RTN","RCC PCSV1",31, 0)
	7601	..D ERRMS G
	7602	"RTN","RCC PCSV1",32, 0)
	7603	..S ERR=" " D ERRMS G
	7604	"RTN","RCC PCSV1",33, 0)
	7605	.S ^RCPS( 349.2,+DEB ,5)=$P(^TM P($J,"MSG" ,RCMSG),"^ ",3)
	7606	"RTN","RCC PCSV1",34, 0)
	7607	.S ^RCPS( 349.2,"AD" ,"E",+DEB) =""
	7608	"RTN","RCC PCSV1",35, 0)
	7609	Q
	7610	"RTN","RCC PCSV1",36, 0)
	7611	;
	7612	"RTN","RCC PCSV1",37, 0)
	7613	;
	7614	"RTN","RCC PCSV1",38, 0)
	7615	KEYERR ;SE ND MESSAGE TO MAIL G ROUP INDIC ATING NO K EY
	7616	"RTN","RCC PCSV1",39, 0)
	7617	S ERR="CB SS ERROR M ESSAGE - N O AR KEY I D FOR CBSS KEY: "_KE Y D ERRMSG
	7618	"RTN","RCC PCSV1",40, 0)
	7619	S ERR="Th is patient record is corrupted . Please c ontact IRM ." D ERRMS G
	7620	"RTN","RCC PCSV1",41, 0)
	7621	S ERR=" " D ERRMSG
	7622	"RTN","RCC PCSV1",42, 0)
	7623	Q
	7624	"RTN","RCC PCSV1",43, 0)
	7625	;
	7626	"RTN","RCC PCSV1",44, 0)
	7627	PA ;STATEM ENT ACKNOW LEDGEMENT
	7628	"RTN","RCC PCSV1",45, 0)
	7629	N STDT,SS TDT,SDAT,S DT,IEN,DEB ,X,Y,STOT, SEQ,KEY,EN D,SBAL,EVN ,DA,DIK
	7630	"RTN","RCC PCSV1",46, 0)
	7631	Q:$P(RCTR ,"^")'="PA "
	7632	"RTN","RCC PCSV1",47, 0)
	7633	; D CHKTR AN(LABEL)
	7634	"RTN","RCC PCSV1",48, 0)
	7635	S (X,SDT) =$P(RCTR," ^",7) D ^% DT S SDAT= Y
	7636	"RTN","RCC PCSV1",49, 0)
	7637	D CHKTRAN (LABEL)
	7638	"RTN","RCC PCSV1",50, 0)
	7639	S STOT=+$ P(RCTR,"^" ,6)
	7640	"RTN","RCC PCSV1",51, 0)
	7641	S SEQ=+$P (RCTR,"^", 3)
	7642	"RTN","RCC PCSV1",52, 0)
	7643	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	7644	"RTN","RCC PCSV1",53, 0)
	7645	.N P
	7646	"RTN","RCC PCSV1",54, 0)
	7647	.S RCTR=^ TMP($J,"MS G",RCMSG)
	7648	"RTN","RCC PCSV1",55, 0)
	7649	.Q:$P(RCT R,"^")'="A D"
	7650	"RTN","RCC PCSV1",56, 0)
	7651	.S KEY=$P (RCTR,"^", 2),KEY=$TR (KEY," "," "),KEY=$E( KEY,$F(KEY ,$$SITE^RC MSITE),99
	7652	9)
	7653	"RTN","RCC PCSV1",57, 0)
	7654	.I KEY']" " D KEYERR Q
	7655	"RTN","RCC PCSV1",58, 0)
	7656	.;PRCA4. 5313 - Fi nd Debtor using IEN from 349.2
	7657	"RTN","RCC PCSV1",59, 0)
	7658	.S IEN=$O (^RCPS(349 .2,"AKEY", KEY,0))
	7659	"RTN","RCC PCSV1",60, 0)
	7660	.I '$G(IE N) D KEYER R Q
	7661	"RTN","RCC PCSV1",61, 0)
	7662	.S DEB=$P ($G(^RCPS( 349.2,IEN, 0)),U)
	7663	"RTN","RCC PCSV1",62, 0)
	7664	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	7665	"RTN","RCC PCSV1",63, 0)
	7666	.I IEN S END=$P(^RC PS(349.2,+ IEN,0),"^" ,10)
	7667	"RTN","RCC PCSV1",64, 0)
	7668	.S:'$G(EN D) END=$O( ^RCPS(349. 2,"STDT",S DAT,0)),EN D=$P($G(^( +END,0))," ^",10)
	7669	"RTN","RCC PCSV1",65, 0)
	7670	.F P=13:1 :17 S SBAL (P)=$P(^RC PS(349.2,+ IEN,0),"^" ,P)
	7671	"RTN","RCC PCSV1",66, 0)
	7672	.;update patient st atement da te in 341 to end pro cess time
	7673	"RTN","RCC PCSV1",67, 0)
	7674	.D OPEN^R CEVDRV1(2, $P(^RCD(34 0,DEB,0),U ),END,DUZ, $$SITE^RCM SITE,.ERR, .EVN,SBAL
	7675	(13)_U_SBA L(14)_U_SB AL(15)_U_S BAL(16)_U_ SBAL(17))
	7676	"RTN","RCC PCSV1",68, 0)
	7677	.I EVN S DR=".07/// /"_END_";. 11////"_1, DA=+EVN,DI E="^RC(341 ," D ^DIE K DIE,DR,
	7678	DA
	7679	"RTN","RCC PCSV1",69, 0)
	7680	.; PRCA4 .5313 - A dd cross-r eference f or File
	7681	"RTN","RCC PCSV1",70, 0)
	7682	.I EVN S $P(^RC(341 ,+EVN,6)," ^")=$G(SDA T) D
	7683	"RTN","RCC PCSV1",71, 0)
	7684	. .S DA=+ EVN,DIK="^ RC(341," D IX1^DIK
	7685	"RTN","RCC PCSV1",72, 0)
	7686	.;update bill file 430 letter fields
	7687	"RTN","RCC PCSV1",73, 0)
	7688	.NEW BN,D A,DIC,DIE, DR,II,LET, NOT,X,Y
	7689	"RTN","RCC PCSV1",74, 0)
	7690	.S DIE="^ PRCA(430," ,NOT=0,BN= 0
	7691	"RTN","RCC PCSV1",75, 0)
	7692	.F S BN= $O(^PRCA(4 30,"AS",DE B,16,BN)) Q:'BN S D A=BN D
	7693	"RTN","RCC PCSV1",76, 0)
	7694	..S LET=$ G(^PRCA(43 0,BN,6))
	7695	"RTN","RCC PCSV1",77, 0)
	7696	..I $P(LE T,"^",21)> END Q
	7697	"RTN","RCC PCSV1",78, 0)
	7698	..S END=$ G(SDAT)
	7699	"RTN","RCC PCSV1",79, 0)
	7700	..F II=1: 1:4 Q:$P(L ET,U,II)=E ND I $P(L ET,U,II)=" " S DR=$S( II=1:61,II =2:62,II=
	7701	3:63,1:68) _"////^S X ="_END_";6 8.1////^S X="_END D ^DIE Q
	7702	"RTN","RCC PCSV1",80, 0)
	7703	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	7704	"RTN","RCC PCSV1",81, 0)
	7705	.S ^RCPS( 349.2,+IEN ,6)=1
	7706	"RTN","RCC PCSV1",82, 0)
	7707	PAMAIL ;
	7708	"RTN","RCC PCSV1",83, 0)
	7709	N XMSUB,X MY,XMDUZ,X MTEXT,MSG
	7710	"RTN","RCC PCSV1",84, 0)
	7711	; PRCA4. 5313 - Ch ange to CB SS
	7712	"RTN","RCC PCSV1",85, 0)
	7713	S XMSUB=" Patient Ac knowledgem ents recei ved from C BSS."
	7714	"RTN","RCC PCSV1",86, 0)
	7715	S XMY("G. RCCPC STAT EMENTS")=" ",XMDUZ="A R PACKAGE" ,XMTEXT="M SG("
	7716	"RTN","RCC PCSV1",87, 0)
	7717	; PRCA4. 5313 - Ad d Patient Statement Date and r enumber ot her lines
	7718	"RTN","RCC PCSV1",88, 0)
	7719	S MSG(1)= "For Patie nt Stateme nt Date of "_SDT_"."
	7720	"RTN","RCC PCSV1",89, 0)
	7721	S MSG(2)= "Patient a cknowledge ment messa ge "_$G(XM Z)_" recei ved."
	7722	"RTN","RCC PCSV1",90, 0)
	7723	S MSG(3)= "This mean s that CBS S has prin ted patien t statemen ts for thi s stateme
	7724	nt period. "
	7725	"RTN","RCC PCSV1",91, 0)
	7726	D ^XMD
	7727	"RTN","RCC PCSV1",92, 0)
	7728	Q
	7729	"RTN","RCC PCSV1",93, 0)
	7730	;
	7731	"RTN","RCC PCSV1",94, 0)
	7732	CHKTRAN(LA BEL) ;Chec k for inco mplete mes sage from CCPC
	7733	"RTN","RCC PCSV1",95, 0)
	7734	; PRCA4. 5313 - Ad d multiple entries b ased upon date to fo ur level
	7735	"RTN","RCC PCSV1",96, 0)
	7736	Q:$G(LABE L)']""
	7737	"RTN","RCC PCSV1",97, 0)
	7738	N PSIEN,D A,DIK,DO,D IC,X
	7739	"RTN","RCC PCSV1",98, 0)
	7740	S LABEL(1 )=+$O(^RCT (349.1,"B" ,LABEL,0))
	7741	"RTN","RCC PCSV1",99, 0)
	7742	; PRCA4. 5313 - Ad d Patient Statement Date to fo ur level
	7743	"RTN","RCC PCSV1",100 ,0)
	7744	I LABEL(1 ),$P(^TMP( $J,"MSG",R CMSG),"^", 2)=$P(^TMP ($J,"MSG", RCMSG),"^" ,3) D
	7745	"RTN","RCC PCSV1",101 ,0)
	7746	. S DIC=" ^RCT(349.1 ,LABEL(1), 4,"
	7747	"RTN","RCC PCSV1",102 ,0)
	7748	. S X=$P( ^TMP($J,"M SG",RCMSG) ,"^",2)
	7749	"RTN","RCC PCSV1",103 ,0)
	7750	. S DA(1) =LABEL(1), DIC(0)="L"
	7751	"RTN","RCC PCSV1",104 ,0)
	7752	. S DIC(" DR")=".02/ ///"_$P(^T MP($J,"MSG ",RCMSG)," ^",3)_";.0 3////"_$G( XMZ)_";.0
	7753	4////"_SDA T
	7754	"RTN","RCC PCSV1",105 ,0)
	7755	. D FILE^ DICN
	7756	"RTN","RCC PCSV1",106 ,0)
	7757	Q
	7758	"RTN","RCC PCSV1",107 ,0)
	7759	;
	7760	"RTN","RCC PCSV1",108 ,0)
	7761	TRANCHK ;C heck for c omplete AC K transmis sion
	7762	"RTN","RCC PCSV1",109 ,0)
	7763	; PRCA4. 5313 - Ch eck for st atement da tes five t o seven da ys in past since bu
	7764	ild and tr ansmit.
	7765	"RTN","RCC PCSV1",110 ,0)
	7766	N X,Y,DAT E,SDT,I,X1 ,X2
	7767	"RTN","RCC PCSV1",111 ,0)
	7768	F I=-3:-1 :-5 S X1=D T,X2=I D C ^%DTC S (Y ,SDT)=X D DD^%DT S D ATE=Y D TR ANCHK1
	7769	"RTN","RCC PCSV1",112 ,0)
	7770	Q
	7771	"RTN","RCC PCSV1",113 ,0)
	7772	;
	7773	"RTN","RCC PCSV1",114 ,0)
	7774	TRANCHK1 ; PRCA4.5 313 - Vali date trans mission co mpleteness for date provided.
	7775	"RTN","RCC PCSV1",115 ,0)
	7776	N MSG,RCT ,SEG,SEQ,C NT,IEN,XMD UZ,XMSUB,X MTEXT,XMY
	7777	"RTN","RCC PCSV1",116 ,0)
	7778	F RCT=3,4 S CNT=$O( ^RCT(349.1 ,RCT,4,"ST DT4",SDT,0 )) I CNT'= "" D
	7779	"RTN","RCC PCSV1",117 ,0)
	7780	.S IEN=$O (^RCT(349. 1,RCT,4,"S TDT4",SDT, CNT,0)) D
	7781	"RTN","RCC PCSV1",118 ,0)
	7782	..I IEN'= "",$P($G(^ RCT(349.1, +RCT,4,IEN ,0)),"^")' =$P($G(^RC T(349.1,+R CT,4,IEN,
	7783	0)),"^",2) D TRANSEN D
	7784	"RTN","RCC PCSV1",119 ,0)
	7785	Q
	7786	"RTN","RCC PCSV1",120 ,0)
	7787	;
	7788	"RTN","RCC PCSV1",121 ,0)
	7789	TRANSEND ; PRCA4.5 313 Send Transmissi on
	7790	"RTN","RCC PCSV1",122 ,0)
	7791	S XMDUZ=" AR PACKAGE "
	7792	"RTN","RCC PCSV1",123 ,0)
	7793	; PRCA4. 5313 - Ch ange CCPC to CBSS
	7794	"RTN","RCC PCSV1",124 ,0)
	7795	S XMSUB=" CBSS ACKNO WLEDGEMENT TRANSMISS ION(S) INC OMPLETE"
	7796	"RTN","RCC PCSV1",125 ,0)
	7797	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= "" E S X
	7798	MY(.5)=""
	7799	"RTN","RCC PCSV1",126 ,0)
	7800	S XMTEXT= "MSG("
	7801	"RTN","RCC PCSV1",127 ,0)
	7802	S SEG=$S( RCT=3:"IS" ,1:"PA")
	7803	"RTN","RCC PCSV1",128 ,0)
	7804	S SEG(1)= $P(^RCT(34 9.1,+RCT,4 ,IEN,0),"^ ",2)
	7805	"RTN","RCC PCSV1",129 ,0)
	7806	; PRCA4. 5313 - Ad d line ide ntifying P atient Sta tement Dat e that err ored
	7807	"RTN","RCC PCSV1",130 ,0)
	7808	S MSG(2)= "For Patie nt Stateme nt Date of "_DATE_". "
	7809	"RTN","RCC PCSV1",131 ,0)
	7810	; PRCA4. 5313 - Ch ange CCPC to CBSS
	7811	"RTN","RCC PCSV1",132 ,0)
	7812	S MSG(3)= "The last "_SEG_" se gment mess age receiv ed from CB SS was num bered "_S
	7813	EG(1)_"."
	7814	"RTN","RCC PCSV1",133 ,0)
	7815	S MSG(4)= "This was not labele d the fina l message in that se gment type transmis
	7816	sion."
	7817	"RTN","RCC PCSV1",134 ,0)
	7818	S MSG(5)= "This may cause pati ent statem ent inform ation to b e missing. "
	7819	"RTN","RCC PCSV1",135 ,0)
	7820	S MSG(6)= "The last message nu mber recei ved was "_ $P($G(^RCT (349.1,RCT ,4,IEN,0)
	7821	),"^",3)_" ."
	7822	"RTN","RCC PCSV1",136 ,0)
	7823	; PRCA4 .5313 - C hange CCPC to CBSS
	7824	"RTN","RCC PCSV1",137 ,0)
	7825	S MSG(7)= "Please co ntact the CBSS in Au stin."
	7826	"RTN","RCC PCSV1",138 ,0)
	7827	D ^XMD
	7828	"RTN","RCC PCSV1",139 ,0)
	7829	Q
	7830	"RTN","RCC PCSV1",140 ,0)
	7831	;
	7832	"RTN","RCC PCSV1",141 ,0)
	7833	;
	7834	"RTN","RCC PCSV1",142 ,0)
	7835	IT ;INVALI D TRANSMIS SION
	7836	"RTN","RCC PCSV1",143 ,0)
	7837	; PRCA4. 5313 - Ch ange messa ge from CC PC to CBSS
	7838	"RTN","RCC PCSV1",144 ,0)
	7839	N SDT,ERR ,MSG,RCX,R CX1,ERROR, RE
	7840	"RTN","RCC PCSV1",145 ,0)
	7841	S ERR="Th e CBSS pat ient state ment messa ges were n ot accepte d by CBSS" D ERRMSG
	7842	"RTN","RCC PCSV1",146 ,0)
	7843	; PRCA4. 5313 - Ad d statemen t date to error mess age
	7844	"RTN","RCC PCSV1",147 ,0)
	7845	S SDT=$P( ^TMP($J,"M SG",RCMSG) ,"^",6)
	7846	"RTN","RCC PCSV1",148 ,0)
	7847	S ERR="fo r "_SDT_" due to the following error(s): " D ERRMSG
	7848	"RTN","RCC PCSV1",149 ,0)
	7849	S ERR=" " D ERRMSG
	7850	"RTN","RCC PCSV1",150 ,0)
	7851	S RCMSG=1 F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	7852	"RTN","RCC PCSV1",151 ,0)
	7853	.S MSG=^T MP($J,"MSG ",RCMSG)
	7854	"RTN","RCC PCSV1",152 ,0)
	7855	.S MSG=$P (MSG,"^",8 )
	7856	"RTN","RCC PCSV1",153 ,0)
	7857	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERROR=$E(M SG,RCX,RCX 1) Q:ERROR ="" D
	7858	"RTN","RCC PCSV1",154 ,0)
	7859	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERROR,"" ))
	7860	"RTN","RCC PCSV1",155 ,0)
	7861	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RROR
	7862	"RTN","RCC PCSV1",156 ,0)
	7863	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 ),ERR=ERRO R_" "_ERR
	7864	"RTN","RCC PCSV1",157 ,0)
	7865	..I ERR(1 ) S:$P(^RC PSE(349.7, +ERR(1),0) ,"^",3)="R " RE=1
	7866	"RTN","RCC PCSV1",158 ,0)
	7867	..D ERRMS G
	7868	"RTN","RCC PCSV1",159 ,0)
	7869	S ERR=" " D ERRMSG
	7870	"RTN","RCC PCSV1",160 ,0)
	7871	S ERR="Pl ease conta ct IRM."
	7872	"RTN","RCC PCSV1",161 ,0)
	7873	D ERRMSG
	7874	"RTN","RCC PCSV1",162 ,0)
	7875	Q
	7876	"RTN","RCC PCSV1",163 ,0)
	7877	;
	7878	"RTN","RCC PCSV1",164 ,0)
	7879	ERRMSG ;ER ROR MESSAG E
	7880	"RTN","RCC PCSV1",165 ,0)
	7881	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	7882	"RTN","RCC PCSV1",166 ,0)
	7883	Q
	7884	"RTN","RCC PCT")
	7885	0^15^B2933 0001^B2489 697
	7886	"RTN","RCC PCT",1,0)
	7887	RCCPCT ;WA SH-ISC@ALT OONA,PA/LD B - CCPC P atient Sta tement mes sage total s ;11/7/9
	7888	6 10:53 A M
	7889	"RTN","RCC PCT",2,0)
	7890	;;4.5;Acc ounts Rece ivable;3 4,313;Ma r 20, 1995 ;Build 118
	7891	"RTN","RCC PCT",3,0)
	7892	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7893	"RTN","RCC PCT",4,0)
	7894	EN ;
	7895	"RTN","RCC PCT",5,0)
	7896	D GO
	7897	"RTN","RCC PCT",6,0)
	7898	K TDT,TDT 1,TDT2,TDT 3,DATE,PTO T,TTOT,L,X ,Y,Y1,Y2,D ,IEN,POP,Q ,%,%DT,%ZI S,%Y,FIRS
	7899	T,LAST
	7900	"RTN","RCC PCT",7,0)
	7901	Q
	7902	"RTN","RCC PCT",8,0)
	7903	GO ;
	7904	"RTN","RCC PCT",9,0)
	7905	W @IOF W !,"This re port will print the total Pati ent Statem ents sent to CBSS a
	7906	nd the"
	7907	"RTN","RCC PCT",10,0)
	7908	W !,"tota l acknowle dged as ha ving been printed wi th three d ifferent r eport"
	7909	"RTN","RCC PCT",11,0)
	7910	W !,"form ats availa ble."
	7911	"RTN","RCC PCT",12,0)
	7912	W !!,"The first for mat is jus t a single summary t otal repor t of all S tatement"
	7913	"RTN","RCC PCT",13,0)
	7914	W !,"Date s."
	7915	"RTN","RCC PCT",14,0)
	7916	W !!,"The second fo rmat is al l Statemen t Dates pr inted indi vidually w ith total
	7917	s"
	7918	"RTN","RCC PCT",15,0)
	7919	W !,"and a summary total at t he end."
	7920	"RTN","RCC PCT",16,0)
	7921	W !!,"The third for mat is pri nting the totals for a single Statement Date sele
	7922	cted.",!
	7923	"RTN","RCC PCT",17,0)
	7924	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7925	"RTN","RCC PCT",18,0)
	7926	S DIR(0)= "E" D ^DIR
	7927	"RTN","RCC PCT",19,0)
	7928	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	7929	"RTN","RCC PCT",20,0)
	7930	S IEN="" F S IEN=$ O(^RCT(349 ,"SDT",IEN )) Q:IEN=" " S TDT(I EN)=""
	7931	"RTN","RCC PCT",21,0)
	7932	W @IOF W !!,"The fo llowing Pa tient Stat ement Date s are avai lable for the Total
	7933	s Report:" ,!
	7934	"RTN","RCC PCT",22,0)
	7935	S (TDT1,F IRST,LAST) ="" F S T DT1=$O(TDT (TDT1)) Q: TDT1="" D
	7936	"RTN","RCC PCT",23,0)
	7937	.S TDT3=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",T DT1,0)),0) ,"^",9) W !,$$DATE^R CCPCPS1(T
	7938	DT3)
	7939	"RTN","RCC PCT",24,0)
	7940	.I TDT3<F IRST S FIR ST=TDT3
	7941	"RTN","RCC PCT",25,0)
	7942	.I TDT3>L AST S LAST =TDT3
	7943	"RTN","RCC PCT",26,0)
	7944	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7945	"RTN","RCC PCT",27,0)
	7946	S DIR(0)= "YAO"
	7947	"RTN","RCC PCT",28,0)
	7948	S DIR("B" )="Y"
	7949	"RTN","RCC PCT",29,0)
	7950	S DIR("A" )="Do you want to pr int a sing le total f or ALL the available dates? "
	7951	"RTN","RCC PCT",30,0)
	7952	D ^DIR
	7953	"RTN","RCC PCT",31,0)
	7954	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	7955	"RTN","RCC PCT",32,0)
	7956	I Y=1 D Q
	7957	"RTN","RCC PCT",33,0)
	7958	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	7959	"RTN","RCC PCT",34,0)
	7960	.I $D(IO( "Q")) D Q
	7961	"RTN","RCC PCT",35,0)
	7962	..S Q=1
	7963	"RTN","RCC PCT",36,0)
	7964	..S ZTRTN ="STARTS^R CCPCT",ZTD ESC="CBSS ALL PATIEN T STATEMEN TS TOTAL R EPORT"
	7965	"RTN","RCC PCT",37,0)
	7966	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	7967	"RTN","RCC PCT",38,0)
	7968	..D ^%ZTL OAD
	7969	"RTN","RCC PCT",39,0)
	7970	..K ZTRTN ,ZTDESC,ZT SAVE
	7971	"RTN","RCC PCT",40,0)
	7972	.E D STA RTS Q
	7973	"RTN","RCC PCT",41,0)
	7974	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7975	"RTN","RCC PCT",42,0)
	7976	S DIR(0)= "YAO"
	7977	"RTN","RCC PCT",43,0)
	7978	S DIR("B" )="Y"
	7979	"RTN","RCC PCT",44,0)
	7980	S DIR("A" )="Do you want to pr int separa te totals for ALL th e availabl e dates?
	7981	"
	7982	"RTN","RCC PCT",45,0)
	7983	D ^DIR
	7984	"RTN","RCC PCT",46,0)
	7985	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	7986	"RTN","RCC PCT",47,0)
	7987	I Y=1 D Q
	7988	"RTN","RCC PCT",48,0)
	7989	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	7990	"RTN","RCC PCT",49,0)
	7991	.I $D(IO( "Q")) D Q
	7992	"RTN","RCC PCT",50,0)
	7993	..S Q=1
	7994	"RTN","RCC PCT",51,0)
	7995	..S ZTRTN ="START^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	7996	"RTN","RCC PCT",52,0)
	7997	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	7998	"RTN","RCC PCT",53,0)
	7999	..D ^%ZTL OAD
	8000	"RTN","RCC PCT",54,0)
	8001	..K ZTRTN ,ZTDESC,ZT SAVE
	8002	"RTN","RCC PCT",55,0)
	8003	.E D STA RT Q
	8004	"RTN","RCC PCT",56,0)
	8005	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8006	"RTN","RCC PCT",57,0)
	8007	S DIR(0)= "DAO^"_FIR ST_":"_LAS T_":EX^K:' $D(TDT(+$E (Y,6,7))) X"
	8008	"RTN","RCC PCT",58,0)
	8009	S DIR("A" )="Enter a single Pa tient Stat ement date from list above: "
	8010	"RTN","RCC PCT",59,0)
	8011	S DIR("?" )="Enter a single Pa tient Stat ement date from list above or ^ to exit
	8012	."
	8013	"RTN","RCC PCT",60,0)
	8014	D ^DIR
	8015	"RTN","RCC PCT",61,0)
	8016	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8017	"RTN","RCC PCT",62,0)
	8018	S Y1=+$E( Y,6,7),Y2= Y
	8019	"RTN","RCC PCT",63,0)
	8020	;I '$D(TD T(Y1)) W ! ,"There ar e no recor ds for tha t date." Q
	8021	"RTN","RCC PCT",64,0)
	8022	D HOME^%Z IS S %ZIS= "AEQ" D ^% ZIS Q:POP
	8023	"RTN","RCC PCT",65,0)
	8024	I $D(IO(" Q")) D Q
	8025	"RTN","RCC PCT",66,0)
	8026	.S Q=1
	8027	"RTN","RCC PCT",67,0)
	8028	.S ZTRTN= "START1^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	8029	"RTN","RCC PCT",68,0)
	8030	.S ZTSAVE ("Q")="",Z TSAVE("Y1" )="",ZTSAV E("Y2")=""
	8031	"RTN","RCC PCT",69,0)
	8032	.D ^%ZTLO AD
	8033	"RTN","RCC PCT",70,0)
	8034	.K ZTRTN, ZTDESC,ZTS AVE
	8035	"RTN","RCC PCT",71,0)
	8036	START1 ;Th is will pr int a summ ary total for a sing le date
	8037	"RTN","RCC PCT",72,0)
	8038	N PTOT,TT OT,X,D
	8039	"RTN","RCC PCT",73,0)
	8040	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8041	"RTN","RCC PCT",74,0)
	8042	U IO S (T TOT,X)=0 F S X=$O(^ RCT(349,"S DT",Y1,X)) Q:'X I $ D(^RCT(349 ,X,0)) S
	8043	TTOT=$P(^R CT(349,X,0 ),"^",7)+T TOT
	8044	"RTN","RCC PCT",75,0)
	8045	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,"STD T",Y2,X)) Q:'X I $G (^RCPS(349 .2,X,6))
	8046	S PTOT=PTO T+1
	8047	"RTN","RCC PCT",76,0)
	8048	I IOST?1" C".E W @IO F
	8049	"RTN","RCC PCT",77,0)
	8050	W !,?10," CBSS Messa ge Totals for ",$$DA TE^RCCPCPS 1(Y2),!!
	8051	"RTN","RCC PCT",78,0)
	8052	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	8053	"RTN","RCC PCT",79,0)
	8054	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	8055	"RTN","RCC PCT",80,0)
	8056	W !,"==== ========== ========== ======="
	8057	"RTN","RCC PCT",81,0)
	8058	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	8059	"RTN","RCC PCT",82,0)
	8060	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	8061	"RTN","RCC PCT",83,0)
	8062	Q
	8063	"RTN","RCC PCT",84,0)
	8064	START ;Thi s will pri nt separat e totals f or all ava ilable sta tement dat es
	8065	"RTN","RCC PCT",85,0)
	8066	N PTOT,TT OT,X,X1,DA TE
	8067	"RTN","RCC PCT",86,0)
	8068	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8069	"RTN","RCC PCT",87,0)
	8070	S (TTOT,P TOT,X,X1)= 0 S DATE=" "
	8071	"RTN","RCC PCT",88,0)
	8072	U IO S (T DT1,TDT2)= ""
	8073	"RTN","RCC PCT",89,0)
	8074	I IOST?1" C".E W @IO F
	8075	"RTN","RCC PCT",90,0)
	8076	F S TDT1 =$O(TDT(TD T1)) Q:TDT 1="" D I $D(DTOUT) !$D(DUOUT) !$D(DIRUT) !$D(DIROU
	8077	T) Q
	8078	"RTN","RCC PCT",91,0)
	8079	.I X="^" Q
	8080	"RTN","RCC PCT",92,0)
	8081	.S TTOT=0
	8082	"RTN","RCC PCT",93,0)
	8083	.F S TDT 2=$O(^RCT( 349,"SDT", TDT1,TDT2) ) Q:TDT2=" " D
	8084	"RTN","RCC PCT",94,0)
	8085	..S Y=$P( ^RCT(349,T DT2,0),"^" ,9)
	8086	"RTN","RCC PCT",95,0)
	8087	..S Y1=+$ E(Y,3,4),D ATE=$$DATE ^RCCPCPS1( Y)
	8088	"RTN","RCC PCT",96,0)
	8089	..S X=Y D ^%DT
	8090	"RTN","RCC PCT",97,0)
	8091	..I $D(^R CT(349,TDT 2,0)) S TT OT=$P(^RCT (349,TDT2, 0),"^",7)+ TTOT
	8092	"RTN","RCC PCT",98,0)
	8093	..S PTOT= 0,X1="" I $D(^RCPS(3 49.2,"STDT ",Y)) F S X1=$O(^RC PS(349.2," STDT",Y,X
	8094	1)) Q:'X1 I $G(^RCP S(349.2,X1 ,6)) S PTO T=PTOT+1
	8095	"RTN","RCC PCT",99,0)
	8096	.W !,?10, "CBSS Mess age Totals for ",DAT E,!!
	8097	"RTN","RCC PCT",100,0 )
	8098	.W "Trans mission St atement To tal : ",$ J(TTOT,9)
	8099	"RTN","RCC PCT",101,0 )
	8100	.W !,"CBS S Statemen ts Printed Total : " ,$J(PTOT,9 )
	8101	"RTN","RCC PCT",102,0 )
	8102	.W !,"=== ========== ========== ========"
	8103	"RTN","RCC PCT",103,0 )
	8104	.W !,"Tot al Not Pri nted : " ,$J(TTOT-P TOT,9),!
	8105	"RTN","RCC PCT",104,0 )
	8106	.I '$D(Q) I $Y+4>IO SL D
	8107	"RTN","RCC PCT",105,0 )
	8108	..S DIR(0 )="E" D ^D IR I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	8109	"RTN","RCC PCT",106,0 )
	8110	..W @IOF
	8111	"RTN","RCC PCT",107,0 )
	8112	I X="^" Q
	8113	"RTN","RCC PCT",108,0 )
	8114	W !!!," ****** ****** ****** ****** ******** *"
	8115	"RTN","RCC PCT",109,0 )
	8116	STARTS ; T his will p rint the s ummary tot al for ALL available statement s
	8117	"RTN","RCC PCT",110,0 )
	8118	N DATE,PT OT,TTOT,X, D
	8119	"RTN","RCC PCT",111,0 )
	8120	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8121	"RTN","RCC PCT",112,0 )
	8122	U IO S (T TOT,D)=0 F S D=$O(T DT(D)) Q:D ="" S X=0 F S X=$O (^RCT(349, "SDT",D,X
	8123	)) Q:X="" I $D(^RCT (349,X,0)) S TTOT=$P (^RCT(349, X,0),"^",7 )+TTOT
	8124	"RTN","RCC PCT",113,0 )
	8125	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,X)) Q:'X I $G (^(X,6)) S PTOT=PTOT +1
	8126	"RTN","RCC PCT",114,0 )
	8127	W !!,?10, "CBSS Mess age Totals for ALL a vailable d ates ",!!
	8128	"RTN","RCC PCT",115,0 )
	8129	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	8130	"RTN","RCC PCT",116,0 )
	8131	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	8132	"RTN","RCC PCT",117,0 )
	8133	W !,"==== ========== ========== ======="
	8134	"RTN","RCC PCT",118,0 )
	8135	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	8136	"RTN","RCC PCT",119,0 )
	8137	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	8138	"VER")
	8139	8.0^22.2
	8140	"^DD",340, 340,.01,0)
	8141	DEBTOR^RV^ ^0;1^
	8142	"^DD",340, 340,.01,1, 0)
	8143	^.1
	8144	"^DD",340, 340,.01,1, 1,0)
	8145	340^B
	8146	"^DD",340, 340,.01,1, 1,1)
	8147	S ^RCD(340 ,"B",$E(X, 1,30),DA)= ""
	8148	"^DD",340, 340,.01,1, 1,2)
	8149	K ^RCD(340 ,"B",$E(X, 1,30),DA)
	8150	"^DD",340, 340,.01,1, 1,3)
	8151	Needed for look-up o f informat ion by Deb tor
	8152	"^DD",340, 340,.01,1, 1,"%D",0)
	8153	^^2^2^2931 014^^^^
	8154	"^DD",340, 340,.01,1, 1,"%D",1,0 )
	8155	This is th e regular FileMan 'B ' cross-re ference an d is used throughout the
	8156	"^DD",340, 340,.01,1, 1,"%D",2,0 )
	8157	AR package for users to look u p informat ion by deb tor.
	8158	"^DD",340, 340,.01,1, 2,0)
	8159	^^TRIGGER^ 340^.03
	8160	"^DD",340, 340,.01,1, 2,1)
	8161	X ^DD(340, .01,1,2,1. 3) I X S X =DIV S Y(1 )=$S($D(^R CD(340,D0, 0)):^(0),1 :"") S X=
	8162	$P(Y(1),U, 3),X=X S D IU=X K Y X ^DD(340,. 01,1,2,1.1 ) X ^DD(34 0,.01,1,2, 1.4)
	8163	"^DD",340, 340,.01,1, 2,1.1)
	8164	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),";"),0), U)) S:X X
	8165	=+X
	8166	"^DD",340, 340,.01,1, 2,1.3)
	8167	K DIV S DI V=X,D0=DA, DIV(0)=D0 S Y(0)=X S Y(1)=$S($ D(^RCD(340 ,D0,0)):^( 0),1:"")
	8168	S X=$P(Y(1 ),U,3)="", Y(2)=X,Y(3 )=X S X=Y( 0),X=X S X =X[";DPT(" ,Y=X,X=Y(2 ),X=X&Y
	8169	"^DD",340, 340,.01,1, 2,1.4)
	8170	S DIH=$S($ D(^RCD(340 ,DIV(0),0) ):^(0),1:" "),DIV=X S $P(^(0),U ,3)=DIV,DI H=340,DIG
	8171	=.03 D ^DI CR:$O(^DD( DIH,DIG,1, 0))>0
	8172	"^DD",340, 340,.01,1, 2,2)
	8173	Q
	8174	"^DD",340, 340,.01,1, 2,3)
	8175	Needed for assigning statement days for patients
	8176	"^DD",340, 340,.01,1, 2,"%D",0)
	8177	^.101^2^2^ 3160502^^^
	8178	"^DD",340, 340,.01,1, 2,"%D",1,0 )
	8179	This cross -reference sets the statement day for ne w patients as determ ined
	8180	"^DD",340, 340,.01,1, 2,"%D",2,0 )
	8181	by the fir st two let ters of th e patient' s last nam e.
	8182	"^DD",340, 340,.01,1, 2,"CREATE CONDITION" )
	8183	STATEMENT DAY=""&(IN TERNAL(DEB TOR)[";DPT (")
	8184	"^DD",340, 340,.01,1, 2,"CREATE VALUE")
	8185	S X=$$ACSE T^RCCPCFN1 ($P(^DPT($ P($P(^RCD( 340,D0,0) ,U),";"),0 ),U) S:X X =+X
	8186	"^DD",340, 340,.01,1, 2,"DELETE VALUE")
	8187	NO EFFECT
	8188	"^DD",340, 340,.01,1, 2,"DT")
	8189	2961010
	8190	"^DD",340, 340,.01,1, 2,"FIELD")
	8191	STATEMENT DAY
	8192	"^DD",340, 340,.01,1, 3,0)
	8193	340^AB^MUM PS
	8194	"^DD",340, 340,.01,1, 3,1)
	8195	S ^RCD(340 ,"AB",$P(X ,";",2),DA )=""
	8196	"^DD",340, 340,.01,1, 3,2)
	8197	K ^RCD(340 ,"AB",$P(X ,";",2),DA )
	8198	"^DD",340, 340,.01,1, 3,3)
	8199	Needed to cross-refe rence debt or file by 'type' of debtor
	8200	"^DD",340, 340,.01,1, 3,"%D",0)
	8201	^^5^5^2931 014^^^^
	8202	"^DD",340, 340,.01,1, 3,"%D",1,0 )
	8203	This cross -reference allows ra pid look-u p of debto rs in the debtor fil e
	8204	"^DD",340, 340,.01,1, 3,"%D",2,0 )
	8205	by the 'ty pe' of deb tor. Ther e are five types of debtors (P atient,
	8206	"^DD",340, 340,.01,1, 3,"%D",3,0 )
	8207	Insurance Company, I nstitution , Vendor, and Person ). This a llows
	8208	"^DD",340, 340,.01,1, 3,"%D",4,0 )
	8209	the AR sof tware to s can the fi le for onl y a specif ic type of debtor
	8210	"^DD",340, 340,.01,1, 3,"%D",5,0 )
	8211	rather tha n having t o look at each entry .
	8212	"^DD",340, 340,.01,1, 3,"DT")
	8213	2930526
	8214	"^DD",340, 340,.01,1. 1)
	8215	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),"";""),0 ),U) S:X
	8216	X=+X
	8217	"^DD",340, 340,.01,3)
	8218	Enter Debt or Informa tion
	8219	"^DD",340, 340,.01,7. 5)
	8220	S:$D(PRCAB T) DIC("V" )="I +Y(0) ="_$P("440 !(+Y(0)=4) ^440!(+Y(0 )=4)^440!( +Y(0)=200
	8221	)",U,PRCAB T) S:$D(PR CAT) DIC(" V")="I +Y( 0)="_$S("C P"[PRCAT:2 ,"FV"[PRCA T:440,"T"
	8222	[PRCAT:36, "N"[PRCAT: 4,"O"[PRCA T:200,1:"2 00!(+Y(0)= 440)")
	8223	"^DD",340, 340,.01,21 ,0)
	8224	^^5^5^2970 219^^^^
	8225	"^DD",340, 340,.01,21 ,1,0)
	8226	This field contains the debtor to which this accou nt belongs to. An
	8227	"^DD",340, 340,.01,21 ,2,0)
	8228	account ca n belong t o an insur ance compa ny, vendor , institut ion, perso n,
	8229	"^DD",340, 340,.01,21 ,3,0)
	8230	or patient . Account s can be s et up for Medical Ca re Cost Re covery cha rges
	8231	"^DD",340, 340,.01,21 ,4,0)
	8232	and also f or non-ben efit debts , such as: Employee bills, Ex- employee b ills,
	8233	"^DD",340, 340,.01,21 ,5,0)
	8234	and Vendor bills.
	8235	"^DD",340, 340,.01,"D T")
	8236	3160428
	8237	"^DD",340, 340,.01,"V ",0)
	8238	^.12P^5^5
	8239	"^DD",340, 340,.01,"V ",1,0)
	8240	2^PATIENT^ 1^P^n^n
	8241	"^DD",340, 340,.01,"V ",1,1)
	8242
	8243	"^DD",340, 340,.01,"V ",1,2)
	8244
	8245	"^DD",340, 340,.01,"V ",2,0)
	8246	200^OTHER (PERSON)^2 ^O^n^y
	8247	"^DD",340, 340,.01,"V ",3,0)
	8248	36^3RD PAR TY^4^I^n^n
	8249	"^DD",340, 340,.01,"V ",4,0)
	8250	4^INSTITUT ION^5^N^n^ n
	8251	"^DD",340, 340,.01,"V ",5,0)
	8252	440^VENDOR ^3^V^n^n
	8253	"^DD",340, 340,.03,0)
	8254	STATEMENT DAY^NJ2,0^ ^0;3^K:+X' =X!(X>28)! (X<1)!(X?. E1"."1N.N) X
	8255	"^DD",340, 340,.03,1, 0)
	8256	^.1
	8257	"^DD",340, 340,.03,1, 1,0)
	8258	340^AC
	8259	"^DD",340, 340,.03,1, 1,1)
	8260	S ^RCD(340 ,"AC",$E(X ,1,30),DA) =""
	8261	"^DD",340, 340,.03,1, 1,2)
	8262	K ^RCD(340 ,"AC",$E(X ,1,30),DA)
	8263	"^DD",340, 340,.03,1, 1,3)
	8264	Needed for printing of patient statement s and foll ow-up lett ers
	8265	"^DD",340, 340,.03,1, 1,"%D",0)
	8266	^^4^4^2931 014^^^^
	8267	"^DD",340, 340,.03,1, 1,"%D",1,0 )
	8268	This cross -reference is used t o print pa tient stat ements and Vendor, P erson,
	8269	"^DD",340, 340,.03,1, 1,"%D",2,0 )
	8270	and Instit ution foll ow-up lett ers. Sinc e these ty pe of debt ors get no tified
	8271	"^DD",340, 340,.03,1, 1,"%D",3,0 )
	8272	based on t heir state ment day, this cross -reference allows ra pid look-u p
	8273	"^DD",340, 340,.03,1, 1,"%D",4,0 )
	8274	of which d ebtor is d ue a notif ication on a particu lar day.
	8275	"^DD",340, 340,.03,1, 1,"DT")
	8276	2930309
	8277	"^DD",340, 340,.03,3)
	8278	Type a Num ber betwee n 1 and 28 , 0 Decima l Digits
	8279	"^DD",340, 340,.03,5, 1,0)
	8280	340^.01^2
	8281	"^DD",340, 340,.03,21 ,0)
	8282	^^19^19^31 60428^
	8283	"^DD",340, 340,.03,21 ,1,0)
	8284	A statemen t day is a ssigned to all types of debtor s, except insurance
	8285	"^DD",340, 340,.03,21 ,2,0)
	8286	companies. A statem ent day is the day t hat a stat ement is g enerated o r a
	8287	"^DD",340, 340,.03,21 ,3,0)
	8288	follow-up letter is generated for non-be nefit debt s. Except for
	8289	"^DD",340, 340,.03,21 ,4,0)
	8290	Patient St atements w hich are g enerated t wo days pr ior to thi s day.
	8291	"^DD",340, 340,.03,21 ,5,0)
	8292	The AR pac kage will hold 'noti fications' from bein g sent unt il the
	8293	"^DD",340, 340,.03,21 ,6,0)
	8294	debtor's ' statement day' arriv es. This allows all activity since the
	8295	"^DD",340, 340,.03,21 ,7,0)
	8296	previous s tatement t o print an d update t he debtor on the acc ount
	8297	"^DD",340, 340,.03,21 ,8,0)
	8298	activity.
	8299	"^DD",340, 340,.03,21 ,9,0)
	8300
	8301	"^DD",340, 340,.03,21 ,10,0)
	8302	Patient st atement da ys never c hange, but Instituti on, Person , and Vend or
	8303	"^DD",340, 340,.03,21 ,11,0)
	8304	statement days are c hanged by the AR sof tware. Wh en these t ype debtor s
	8305	"^DD",340, 340,.03,21 ,12,0)
	8306	have a new active bi ll, the da te the new active bi ll is crea ted become s
	8307	"^DD",340, 340,.03,21 ,13,0)
	8308	their 'sta tement day '. This s tatement d ay remains in effect until no
	8309	"^DD",340, 340,.03,21 ,14,0)
	8310	active bil ls exist f or the deb tor, at wh ich time t he stateme nt day
	8311	"^DD",340, 340,.03,21 ,15,0)
	8312	is 'delete d'.
	8313	"^DD",340, 340,.03,21 ,16,0)
	8314
	8315	"^DD",340, 340,.03,21 ,17,0)
	8316	Insurance companies are notifi ed based o n a bill-s pecific da te.
	8317	"^DD",340, 340,.03,21 ,18,0)
	8318	Since insu rance comp anies have much more activity, they are notified
	8319	"^DD",340, 340,.03,21 ,19,0)
	8320	on a const ant basis depending on each in dividual b ill 'due-d ate'.
	8321	"^DD",340, 340,.03,"D T")
	8322	3160428
	8323	"^DD",340, 340,7.06,0 )
	8324	CURRENT CB S DEBT AMO UNT^NJ9,2^ ^7;6^S:X[" $" X=$P(X, "$",2) K:X '?."-".N.1 ".".2N!(X
	8325	>999999)!( X<-999999) X
	8326	"^DD",340, 340,7.06,3 )
	8327	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	8328	"^DD",340, 340,7.06,2 1,0)
	8329	^^7^7^3160 401^
	8330	"^DD",340, 340,7.06,2 1,1,0)
	8331	This field stores th e debt amo unt curren tly
	8332	"^DD",340, 340,7.06,2 1,2,0)
	8333	updated to the Conso lidated Bi lling Stat ement Syst em
	8334	"^DD",340, 340,7.06,2 1,3,0)
	8335	CBSS. Thi s field is used to c ompare the current
	8336	"^DD",340, 340,7.06,2 1,4,0)
	8337	amount at the CBSS w ith the am ount curre ntly
	8338	"^DD",340, 340,7.06,2 1,5,0)
	8339	available for receiv ing paymen t. For in creases
	8340	"^DD",340, 340,7.06,2 1,6,0)
	8341	or decreas es, the de bt amount is forward ed to
	8342	"^DD",340, 340,7.06,2 1,7,0)
	8343	CBSS.
	8344	"^DD",340, 340,7.06," DT")
	8345	3160401
	8346	"^DD",341, 341,6.01,0 )
	8347	CCPC STATE MENT DATE^ D^^6;1^S % DT="EX" D ^%DT S X=Y K:X<1 X
	8348	"^DD",341, 341,6.01,1 ,0)
	8349	^.1
	8350	"^DD",341, 341,6.01,1 ,1,0)
	8351	341^STDT
	8352	"^DD",341, 341,6.01,1 ,1,1)
	8353	S ^RC(341, "STDT",$E( X,1,30),DA )=""
	8354	"^DD",341, 341,6.01,1 ,1,2)
	8355	K ^RC(341, "STDT",$E( X,1,30),DA )
	8356	"^DD",341, 341,6.01,1 ,1,"%D",0)
	8357	^.101^2^2^ 3160809^^
	8358	"^DD",341, 341,6.01,1 ,1,"%D",1, 0)
	8359	This cross reference is used t o sort and print eve nts by the ir Patient
	8360	"^DD",341, 341,6.01,1 ,1,"%D",2, 0)
	8361	Statement date.
	8362	"^DD",341, 341,6.01,1 ,1,"DT")
	8363	3160803
	8364	"^DD",341, 341,6.01,3 )
	8365	Enter date of Patien t Statemen t.
	8366	"^DD",341, 341,6.01,2 1,0)
	8367	^^1^1^3160 921^
	8368	"^DD",341, 341,6.01,2 1,1,0)
	8369	This is th e date of the Patien t Statemen t from CBS S.
	8370	"^DD",341, 341,6.01," DT")
	8371	3160921
	8372	"^DD",349, 349,.09,0)
	8373	STATEMENT DATE^D^^0; 9^S %DT="E X" D ^%DT S X=Y K:X< 1 X
	8374	"^DD",349, 349,.09,3)
	8375	Enter the statement date.
	8376	"^DD",349, 349,.09,21 ,0)
	8377	^^1^1^3161 019^
	8378	"^DD",349, 349,.09,21 ,1,0)
	8379	This is th e patient statement date.
	8380	"^DD",349, 349,.09,"D T")
	8381	3161103
	8382	"^DD",349. 1,349.1,0)
	8383	FIELD^^40^ 14
	8384	"^DD",349. 1,349.1,0, "DDA")
	8385	N
	8386	"^DD",349. 1,349.1,0, "DT")
	8387	3161103
	8388	"^DD",349. 1,349.1,0, "IX","B",3 49.1,.01)
	8389
	8390	"^DD",349. 1,349.1,0, "NM","AR T RANSMISSIO N TYPE")
	8391
	8392	"^DD",349. 1,349.1,0, "PT",349.9 ,.01)
	8393
	8394	"^DD",349. 1,349.1,0, "VRPK")
	8395	PRCA
	8396	"^DD",349. 1,349.1,.0 1,0)
	8397	CODE^RF^^0 ;1^K:$L(X) >10!($L(X) <2)!'(X'?1 P.E) X
	8398	"^DD",349. 1,349.1,.0 1,1,0)
	8399	^.1
	8400	"^DD",349. 1,349.1,.0 1,1,1,0)
	8401	349.1^B
	8402	"^DD",349. 1,349.1,.0 1,1,1,1)
	8403	S ^RCT(349 .1,"B",$E( X,1,30),DA )=""
	8404	"^DD",349. 1,349.1,.0 1,1,1,2)
	8405	K ^RCT(349 .1,"B",$E( X,1,30),DA )
	8406	"^DD",349. 1,349.1,.0 1,3)
	8407	Answer mus t be 2-10 characters in length .
	8408	"^DD",349. 1,349.1,.0 1,21,0)
	8409	^.001^1^1^ 3040601^^^
	8410	"^DD",349. 1,349.1,.0 1,21,1,0)
	8411	This field will hold the uniqu e codes fo r the tran smission t ypes.
	8412	"^DD",349. 1,349.1,.0 1,23,0)
	8413	^^1^1^3040 601^
	8414	"^DD",349. 1,349.1,.0 1,23,1,0)
	8415
	8416	"^DD",349. 1,349.1,.0 1,"DT")
	8417	2960216
	8418	"^DD",349. 1,349.1,.0 2,0)
	8419	EXPANDED N AME^F^^0;2 ^K:$L(X)>3 0!($L(X)<3 ) X
	8420	"^DD",349. 1,349.1,.0 2,3)
	8421	Answer mus t be 3-30 characters in length .
	8422	"^DD",349. 1,349.1,.0 2,21,0)
	8423	^^1^1^2960 216^^
	8424	"^DD",349. 1,349.1,.0 2,21,1,0)
	8425	This is th e expanded name of t he transmi ssion type .
	8426	"^DD",349. 1,349.1,.0 2,"DT")
	8427	2960216
	8428	"^DD",349. 1,349.1,.0 3,0)
	8429	ACTIVE^S^0 :NO;1:YES; ^0;3^Q
	8430	"^DD",349. 1,349.1,.0 3,21,0)
	8431	^^1^1^2960 216^
	8432	"^DD",349. 1,349.1,.0 3,21,1,0)
	8433	This field will indi cate if th e transmis sion type is being u sed.
	8434	"^DD",349. 1,349.1,.0 3,"DT")
	8435	2960216
	8436	"^DD",349. 1,349.1,.0 4,0)
	8437	PURGE FREQ UENCY^NJ4, 0^^0;4^K:+ X'=X!(X>36 50)!(X<30) !(X?.E1"." 1N.N) X
	8438	"^DD",349. 1,349.1,.0 4,3)
	8439	Type a Num ber betwee n 30 and 3 650, 0 Dec imal Digit s
	8440	"^DD",349. 1,349.1,.0 4,21,0)
	8441	^^2^2^2960 216^^
	8442	"^DD",349. 1,349.1,.0 4,21,1,0)
	8443	This field indicates if and wh en a purge of the en tries will take
	8444	"^DD",349. 1,349.1,.0 4,21,2,0)
	8445	place.
	8446	"^DD",349. 1,349.1,.0 4,23,0)
	8447	^^2^2^2960 216^
	8448	"^DD",349. 1,349.1,.0 4,23,1,0)
	8449	Number of days that transmissi on records are on-li ne before
	8450	"^DD",349. 1,349.1,.0 4,23,2,0)
	8451	purging oc curs.
	8452	"^DD",349. 1,349.1,.0 4,"DT")
	8453	2960216
	8454	"^DD",349. 1,349.1,1, 0)
	8455	LOCAL ADDR ESSEE^349. 11P^^1;0
	8456	"^DD",349. 1,349.1,2, 0)
	8457	LOCAL MAIL GROUP^349. 12P^^2;0
	8458	"^DD",349. 1,349.1,31 ,0)
	8459	REMOTE ADD RESSEE^F^^ 3;1^K:$L(X )>30!($L(X )<1)!'(X?. A) X
	8460	"^DD",349. 1,349.1,31 ,3)
	8461	Answer mus t be 1-30 characters in length .
	8462	"^DD",349. 1,349.1,31 ,21,0)
	8463	^^1^1^2960 430^^^
	8464	"^DD",349. 1,349.1,31 ,21,1,0)
	8465	This is th e addresse e name at the remote domain.
	8466	"^DD",349. 1,349.1,31 ,"DT")
	8467	2960430
	8468	"^DD",349. 1,349.1,32 ,0)
	8469	REMOTE DOM AIN^P4.2'^ DIC(4.2,^3 ;2^Q
	8470	"^DD",349. 1,349.1,32 ,1,0)
	8471	^.1
	8472	"^DD",349. 1,349.1,32 ,1,1,0)
	8473	^^TRIGGER^ 349.1^33
	8474	"^DD",349. 1,349.1,32 ,1,1,1)
	8475	K DIV S DI V=X,D0=DA, DIV(0)=D0 S Y(1)=$S( $D(^RCT(34 9.1,D0,3)) :^(3),1:"" ) S X=$P(
	8476	Y(1),U,3), X=X S DIU= X K Y X ^D D(349.1,32 ,1,1,1.1) X ^DD(349. 1,32,1,1,1 .4)
	8477	"^DD",349. 1,349.1,32 ,1,1,1.1)
	8478	S X=DIV S I(0,0)=$S( $D(D0):D0, 1:""),D0=D IV S:'$D(^ DIC(4.2,+D 0,0)) D0=- 1 S Y(101
	8479	)=$S($D(^D IC(4.2,D0, 0)):^(0),1 :"") S X=$ P(Y(101),U ,1) S D0=I (0,0)
	8480	"^DD",349. 1,349.1,32 ,1,1,1.4)
	8481	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1
	8482	,DIG=33 D ^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	8483	"^DD",349. 1,349.1,32 ,1,1,2)
	8484	K DIV S DI V=X,D0=DA, DIV(0)=D0 S Y(1)=$S( $D(^RCT(34 9.1,D0,3)) :^(3),1:"" ) S X=$P(
	8485	Y(1),U,3), X=X S DIU= X K Y S X= "" X ^DD(3 49.1,32,1, 1,2.4)
	8486	"^DD",349. 1,349.1,32 ,1,1,2.4)
	8487	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1
	8488	,DIG=33 D ^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	8489	"^DD",349. 1,349.1,32 ,1,1,"CREA TE VALUE")
	8490	REMOTE DOM AIN:.01
	8491	"^DD",349. 1,349.1,32 ,1,1,"DELE TE VALUE")
	8492	@
	8493	"^DD",349. 1,349.1,32 ,1,1,"FIEL D")
	8494	DOMAIN NAM E
	8495	"^DD",349. 1,349.1,32 ,21,0)
	8496	^.001^2^2^ 3000524^^^
	8497	"^DD",349. 1,349.1,32 ,21,1,0)
	8498	This is th e remote d omain wher e the tran smission r ecord is b eing
	8499	"^DD",349. 1,349.1,32 ,21,2,0)
	8500	sent.
	8501	"^DD",349. 1,349.1,32 ,"DT")
	8502	2960902
	8503	"^DD",349. 1,349.1,33 ,0)
	8504	DOMAIN NAM E^F^^3;3^K :$L(X)>30! ($L(X)<3) X
	8505	"^DD",349. 1,349.1,33 ,3)
	8506	Answer mus t be 3-30 characters in length .
	8507	"^DD",349. 1,349.1,33 ,5,1,0)
	8508	349.1^32^1
	8509	"^DD",349. 1,349.1,33 ,9)
	8510	^
	8511	"^DD",349. 1,349.1,33 ,21,0)
	8512	^^1^1^2960 902^
	8513	"^DD",349. 1,349.1,33 ,21,1,0)
	8514	This is th e name of the DOMAIN from file 4.2 DOMAI N.
	8515	"^DD",349. 1,349.1,33 ,"DT")
	8516	2960902
	8517	"^DD",349. 1,349.1,34 ,0)
	8518	RC MAIL AD DRESS^RFX^ ^3;4^K:$L( X)>30!($L( X)<3) X
	8519	"^DD",349. 1,349.1,34 ,3)
	8520	Answer mus t be 3-30 characters in length .
	8521	"^DD",349. 1,349.1,34 ,4)
	8522	D MAILADD^ RCRCXMS
	8523	"^DD",349. 1,349.1,34 ,21,0)
	8524	^.001^2^2^ 3040429^^^ ^
	8525	"^DD",349. 1,349.1,34 ,21,1,0)
	8526	This field will cont ain the Re gional Cou nsel mail address fo r the
	8527	"^DD",349. 1,349.1,34 ,21,2,0)
	8528	primary si te. It wi ll be the default ma il address .
	8529	"^DD",349. 1,349.1,34 ,23,0)
	8530	^.001^1^1^ 3040429^^^ ^
	8531	"^DD",349. 1,349.1,34 ,23,1,0)
	8532
	8533	"^DD",349. 1,349.1,34 ,"DT")
	8534	3040407
	8535	"^DD",349. 1,349.1,35 ,0)
	8536	RC DEATH N OTIFICATIO N ADDRESS^ RF^^3;5^K: $L(X)>40!( $L(X)<2) X
	8537	"^DD",349. 1,349.1,35 ,3)
	8538	Answer mus t be 2-40 characters in length .
	8539	"^DD",349. 1,349.1,35 ,4)
	8540	D DEATHADD ^RCRCXMS
	8541	"^DD",349. 1,349.1,35 ,21,0)
	8542	^.001^3^3^ 3040429^^^ ^
	8543	"^DD",349. 1,349.1,35 ,21,1,0)
	8544	This field contains the Region al Counsel mail addr ess for de ath
	8545	"^DD",349. 1,349.1,35 ,21,2,0)
	8546	notificati ons for th e primary site. Thi s will be the defaul t for deat h
	8547	"^DD",349. 1,349.1,35 ,21,3,0)
	8548	notificati ons.
	8549	"^DD",349. 1,349.1,35 ,23,0)
	8550	^.001^1^1^ 3040429^^^ ^
	8551	"^DD",349. 1,349.1,35 ,23,1,0)
	8552
	8553	"^DD",349. 1,349.1,35 ,"DT")
	8554	3040428
	8555	"^DD",349. 1,349.1,40 ,0)
	8556	MESSAGE AC KNOWLEDGEM ENT^349.14 1A^^4;0
	8557	"^DD",349. 1,349.1,40 ,21,0)
	8558	^^5^5^3160 429^
	8559	"^DD",349. 1,349.1,40 ,21,1,0)
	8560	Message Ac knowledgem ents conta in the top level of data for m essages
	8561	"^DD",349. 1,349.1,40 ,21,2,0)
	8562	received f rom Austin .
	8563	"^DD",349. 1,349.1,40 ,21,3,0)
	8564
	8565	"^DD",349. 1,349.1,40 ,21,4,0)
	8566	The IEN fo r the mult iple Messa ge Acknowl edgements is set in the code t o
	8567	"^DD",349. 1,349.1,40 ,21,5,0)
	8568	the day of the month for the P atient Sta tement.
	8569	"^DD",349. 1,349.1,51 ,0)
	8570	ACK MESSAG ES^349.151 A^^5;0
	8571	"^DD",349. 1,349.1,51 ,21,0)
	8572	^^1^1^3161 006^
	8573	"^DD",349. 1,349.1,51 ,21,1,0)
	8574	Acknowledg ement Mess ages recei ved from e xternal so urces.
	8575	"^DD",349. 1,349.1,61 ,0)
	8576	DIVISION O F CARE^349 .161PA^^6; 0
	8577	"^DD",349. 1,349.1,61 ,21,0)
	8578	^.001^4^4^ 3040517^^^ ^
	8579	"^DD",349. 1,349.1,61 ,21,1,0)
	8580	This field is a mult iple that allows div isions to be entered if their
	8581	"^DD",349. 1,349.1,61 ,21,2,0)
	8582	Regional C ounsel mai l addresse s and deat h notifica tion addre sses are
	8583	"^DD",349. 1,349.1,61 ,21,3,0)
	8584	different from the p rimary add resses.
	8585	"^DD",349. 1,349.1,61 ,21,4,0)
	8586
	8587	"^DD",349. 1,349.1,61 ,23,0)
	8588	^.001^1^1^ 3040517^^^ ^
	8589	"^DD",349. 1,349.1,61 ,23,1,0)
	8590
	8591	"^DD",349. 1,349.1,61 ,"DT")
	8592	3040514
	8593	"^DD",349. 1,349.11,0 )
	8594	LOCAL ADDR ESSEE SUB- FIELD^^.01 ^1
	8595	"^DD",349. 1,349.11,0 ,"DT")
	8596	2960216
	8597	"^DD",349. 1,349.11,0 ,"IX","B", 349.11,.01 )
	8598
	8599	"^DD",349. 1,349.11,0 ,"NM","LOC AL ADDRESS EE")
	8600
	8601	"^DD",349. 1,349.11,0 ,"UP")
	8602	349.1
	8603	"^DD",349. 1,349.11,. 01,0)
	8604	LOCAL ADDR ESSEE^MP20 0'^VA(200, ^0;1^Q
	8605	"^DD",349. 1,349.11,. 01,1,0)
	8606	^.1
	8607	"^DD",349. 1,349.11,. 01,1,1,0)
	8608	349.11^B
	8609	"^DD",349. 1,349.11,. 01,1,1,1)
	8610	S ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)= ""
	8611	"^DD",349. 1,349.11,. 01,1,1,2)
	8612	K ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)
	8613	"^DD",349. 1,349.11,. 01,21,0)
	8614	^^2^2^2960 216^
	8615	"^DD",349. 1,349.11,. 01,21,1,0)
	8616	The local users who wish to be recepient s of the t ransmissio n messages
	8617	"^DD",349. 1,349.11,. 01,21,2,0)
	8618	will named in this f ield.
	8619	"^DD",349. 1,349.11,. 01,"DT")
	8620	2960216
	8621	"^DD",349. 1,349.12,0 )
	8622	LOCAL MAIL GROUP SUB- FIELD^^.01 ^1
	8623	"^DD",349. 1,349.12,0 ,"DT")
	8624	2960216
	8625	"^DD",349. 1,349.12,0 ,"IX","B", 349.12,.01 )
	8626
	8627	"^DD",349. 1,349.12,0 ,"NM","LOC AL MAILGRO UP")
	8628
	8629	"^DD",349. 1,349.12,0 ,"UP")
	8630	349.1
	8631	"^DD",349. 1,349.12,. 01,0)
	8632	LOCAL MAIL GROUP^MP3. 8'^XMB(3.8 ,^0;1^Q
	8633	"^DD",349. 1,349.12,. 01,1,0)
	8634	^.1
	8635	"^DD",349. 1,349.12,. 01,1,1,0)
	8636	349.12^B
	8637	"^DD",349. 1,349.12,. 01,1,1,1)
	8638	S ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)= ""
	8639	"^DD",349. 1,349.12,. 01,1,1,2)
	8640	K ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)
	8641	"^DD",349. 1,349.12,. 01,21,0)
	8642	^^2^2^2960 216^
	8643	"^DD",349. 1,349.12,. 01,21,1,0)
	8644	This field is used t o define a ny mailgro ups which should rec eive the
	8645	"^DD",349. 1,349.12,. 01,21,2,0)
	8646	transmissi on message s.
	8647	"^DD",349. 1,349.12,. 01,"DT")
	8648	2960216
	8649	"^DD",349. 1,349.141, 0)
	8650	MESSAGE AC KNOWLEDGEM ENT SUB-FI ELD^^.04^4
	8651	"^DD",349. 1,349.141, 0,"DT")
	8652	3160425
	8653	"^DD",349. 1,349.141, 0,"NM","ME SSAGE ACKN OWLEDGEMEN T")
	8654
	8655	"^DD",349. 1,349.141, 0,"UP")
	8656	349.1
	8657	"^DD",349. 1,349.141, .01,0)
	8658	LAST MESSA GE ACK^NJ3 ,0X^^0;1^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	8659	"^DD",349. 1,349.141, .01,1,0)
	8660	^.1^^0
	8661	"^DD",349. 1,349.141, .01,3)
	8662	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	8663	"^DD",349. 1,349.141, .01,21,0)
	8664	^^1^1^3160 425^
	8665	"^DD",349. 1,349.141, .01,21,1,0 )
	8666	Number of last messa ge type se nt from CB SS.
	8667	"^DD",349. 1,349.141, .01,"DT")
	8668	3161007
	8669	"^DD",349. 1,349.141, .02,0)
	8670	FINAL MESS AGE ACK^NJ 3,0^^0;2^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	8671	"^DD",349. 1,349.141, .02,3)
	8672	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	8673	"^DD",349. 1,349.141, .02,21,0)
	8674	^^1^1^3160 425^
	8675	"^DD",349. 1,349.141, .02,21,1,0 )
	8676	Final mess age number of this t ype from C BSS.
	8677	"^DD",349. 1,349.141, .02,"DT")
	8678	3160425
	8679	"^DD",349. 1,349.141, .03,0)
	8680	LAST MESSA GE NUMBER^ NJ8,0^^0;3 ^K:+X'=X!( X>99999999 )!(X<1)!(X ?.E1"."1.N ) X
	8681	"^DD",349. 1,349.141, .03,3)
	8682	Type a num ber betwee n 1 and 99 999999, 0 decimal di gits.
	8683	"^DD",349. 1,349.141, .03,21,0)
	8684	^^2^2^3160 425^
	8685	"^DD",349. 1,349.141, .03,21,1,0 )
	8686	This is th e last mes sage numbe r of this type for t he last tr ansmission
	8687	"^DD",349. 1,349.141, .03,21,2,0 )
	8688	from CBSS.
	8689	"^DD",349. 1,349.141, .03,"DT")
	8690	3160425
	8691	"^DD",349. 1,349.141, .04,0)
	8692	PATIENT ST ATEMENT DA TE^DX^^0;4 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	8693	"^DD",349. 1,349.141, .04,1,0)
	8694	^.1^^0
	8695	"^DD",349. 1,349.141, .04,3)
	8696	Enter date of Patien t Statemen t.
	8697	"^DD",349. 1,349.141, .04,21,0)
	8698	^^1^1^3161 025^
	8699	"^DD",349. 1,349.141, .04,21,1,0 )
	8700	This is th e Patient Statement Date.
	8701	"^DD",349. 1,349.141, .04,"DT")
	8702	3161025
	8703	"^DD",349. 1,349.151, 0)
	8704	ACK MESSAG ES SUB-FIE LD^^.04^4
	8705	"^DD",349. 1,349.151, 0,"DT")
	8706	3161103
	8707	"^DD",349. 1,349.151, 0,"NM","AC K MESSAGES ")
	8708
	8709	"^DD",349. 1,349.151, 0,"UP")
	8710	349.1
	8711	"^DD",349. 1,349.151, .01,0)
	8712	ACK MESSAG ES^F^^0;1^ K:$L(X)>80 !($L(X)<3) X
	8713	"^DD",349. 1,349.151, .01,1,0)
	8714	^.1^^0
	8715	"^DD",349. 1,349.151, .01,3)
	8716	Answer mus t be 3-80 characters in length .
	8717	"^DD",349. 1,349.151, .01,21,0)
	8718	^^1^1^2970 106^^
	8719	"^DD",349. 1,349.151, .01,21,1,0 )
	8720	This multi ple will s tore the A cknowlegme nt message s from Aus tin.
	8721	"^DD",349. 1,349.151, .01,"DT")
	8722	3161005
	8723	"^DD",349. 1,349.151, .02,0)
	8724	ACCOUNT/SE G ID^F^^0; 2^K:$L(X)> 25!($L(X)< 3) X
	8725	"^DD",349. 1,349.151, .02,3)
	8726	Answer mus t be 3-25 characters in length .
	8727	"^DD",349. 1,349.151, .02,21,0)
	8728	^^1^1^2961 114^
	8729	"^DD",349. 1,349.151, .02,21,1,0 )
	8730	This field stores th e account id for the record.
	8731	"^DD",349. 1,349.151, .02,"DT")
	8732	2961205
	8733	"^DD",349. 1,349.151, .03,0)
	8734	ACCOUNT/SE G INFO^F^^ 0;3^K:$L(X )>40!($L(X )<3) X
	8735	"^DD",349. 1,349.151, .03,3)
	8736	Answer mus t be 3-40 characters in length .
	8737	"^DD",349. 1,349.151, .03,21,0)
	8738	^^1^1^2961 114^
	8739	"^DD",349. 1,349.151, .03,21,1,0 )
	8740	This field will stor e the deta iled infor mation abo ut the rec ord if any .
	8741	"^DD",349. 1,349.151, .03,"DT")
	8742	2961205
	8743	"^DD",349. 1,349.151, .04,0)
	8744	PATIENT ST ATEMENT DA TE^D^^0;4^ S %DT="EX" D ^%DT S X=Y K:X<1 X
	8745	"^DD",349. 1,349.151, .04,3)
	8746	Enter date of Patien t Statemen t.
	8747	"^DD",349. 1,349.151, .04,21,0)
	8748	^^1^1^3161 006^
	8749	"^DD",349. 1,349.151, .04,21,1,0 )
	8750	The Patien t Statemen t date for Acknowled gement Mes sages.
	8751	"^DD",349. 1,349.151, .04,"DT")
	8752	3161103
	8753	"^DD",349. 1,349.161, 0)
	8754	DIVISION O F CARE SUB -FIELD^^.0 4^4
	8755	"^DD",349. 1,349.161, 0,"DT")
	8756	3040429
	8757	"^DD",349. 1,349.161, 0,"IX","B" ,349.161,. 01)
	8758
	8759	"^DD",349. 1,349.161, 0,"NM","DI VISION OF CARE")
	8760
	8761	"^DD",349. 1,349.161, 0,"UP")
	8762	349.1
	8763	"^DD",349. 1,349.161, .01,0)
	8764	DIVISION O F CARE^P40 .8'^DG(40. 8,^0;1^Q
	8765	"^DD",349. 1,349.161, .01,1,0)
	8766	^.1
	8767	"^DD",349. 1,349.161, .01,1,1,0)
	8768	349.161^B
	8769	"^DD",349. 1,349.161, .01,1,1,1)
	8770	S ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)= ""
	8771	"^DD",349. 1,349.161, .01,1,1,2)
	8772	K ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)
	8773	"^DD",349. 1,349.161, .01,21,0)
	8774	^.001^1^1^ 3040517^^^ ^
	8775	"^DD",349. 1,349.161, .01,21,1,0 )
	8776	Enter divi sions of c are where bill charg es origina te for thi s site.
	8777	"^DD",349. 1,349.161, .01,"DT")
	8778	3000524
	8779	"^DD",349. 1,349.161, .02,0)
	8780	REMOTE DOM AIN^P4.2'^ DIC(4.2,^0 ;2^Q
	8781	"^DD",349. 1,349.161, .02,3)
	8782
	8783	"^DD",349. 1,349.161, .02,21,0)
	8784	^.001^1^1^ 3000524^^
	8785	"^DD",349. 1,349.161, .02,21,1,0 )
	8786	This is th e Remote D omain addr ess where transmissi ons will b e sent for this div
	8787	ision.
	8788	"^DD",349. 1,349.161, .02,"DT")
	8789	3000524
	8790	"^DD",349. 1,349.161, .03,0)
	8791	RC MAIL AD DRESS^F^^0 ;3^K:$L(X) >30!($L(X) <3) X
	8792	"^DD",349. 1,349.161, .03,3)
	8793	Answer mus t be 3-30 characters in length .
	8794	"^DD",349. 1,349.161, .03,4)
	8795	D MAILADD^ RCRCXMS
	8796	"^DD",349. 1,349.161, .03,21,0)
	8797	^.001^4^4^ 3040429^^
	8798	"^DD",349. 1,349.161, .03,21,1,0 )
	8799	This field will cont ain the na me of the Regional C ounsel mai l address
	8800	"^DD",349. 1,349.161, .03,21,2,0 )
	8801	that trans actions fr om the ass ociated Di vision of Care will be sent.
	8802	"^DD",349. 1,349.161, .03,21,3,0 )
	8803	This field s address will be di fferent fr om the pri mary divis ion's
	8804	"^DD",349. 1,349.161, .03,21,4,0 )
	8805	RC mail ad dress.
	8806	"^DD",349. 1,349.161, .03,23,0)
	8807	^^1^1^3040 429^
	8808	"^DD",349. 1,349.161, .03,23,1,0 )
	8809
	8810	"^DD",349. 1,349.161, .03,"DT")
	8811	3040325
	8812	"^DD",349. 1,349.161, .04,0)
	8813	RC DEATH N OTIFICATIO N ADDRESS^ F^^0;4^K:$ L(X)>40!($ L(X)<3) X
	8814	"^DD",349. 1,349.161, .04,3)
	8815	Answer mus t be 3-40 characters in length .
	8816	"^DD",349. 1,349.161, .04,4)
	8817	D DEATHADD ^RCRCXMS
	8818	"^DD",349. 1,349.161, .04,21,0)
	8819	^.001^4^4^ 3040429^^^
	8820	"^DD",349. 1,349.161, .04,21,1,0 )
	8821	This field will cont ain the na me of the RC death n otificatio ns address
	8822	"^DD",349. 1,349.161, .04,21,2,0 )
	8823	that death notices f rom the as sociated D ivision of Care will be sent.
	8824	"^DD",349. 1,349.161, .04,21,3,0 )
	8825	This field s address will be di fferent fr om the pri mary divis ion's
	8826	"^DD",349. 1,349.161, .04,21,4,0 )
	8827	RC death n otificatio n address.
	8828	"^DD",349. 1,349.161, .04,23,0)
	8829	^.001^1^1^ 3040429^^
	8830	"^DD",349. 1,349.161, .04,23,1,0 )
	8831
	8832	"^DD",349. 1,349.161, .04,"DT")
	8833	3040429
	8834	"^DD",349. 2,349.2,.0 1,0)
	8835	PATIENT^RP 340'X^RCD( 340,^0;1^Q
	8836	"^DD",349. 2,349.2,.0 1,1,0)
	8837	^.1^^0
	8838	"^DD",349. 2,349.2,.0 1,3)
	8839	Enter the Debtor Num ber for th e Patient Statement.
	8840	"^DD",349. 2,349.2,.0 1,21,0)
	8841	^^2^2^3161 011^^
	8842	"^DD",349. 2,349.2,.0 1,21,1,0)
	8843	This is th e Debtor n umber to r eceive the Patient S tatement a ssociated
	8844	"^DD",349. 2,349.2,.0 1,21,2,0)
	8845	with the s pecific Pa tient.
	8846	"^DD",349. 2,349.2,.0 1,"DT")
	8847	3161011
	8848	"^DD",349. 2,349.2,.0 2,0)
	8849	SSN^RFXO^^ 0;2^K:$L(X )>10!($L(X )<9) X S X =$$SSN^RCF N01(+DA)
	8850	"^DD",349. 2,349.2,.0 2,1,0)
	8851	^.1
	8852	"^DD",349. 2,349.2,.0 2,1,1,0)
	8853	349.2^AKEY 1^MUMPS
	8854	"^DD",349. 2,349.2,.0 2,1,1,1)
	8855	I $P(^RCPS (349.2,+DA ,0),"^",3) ]"" S ^RCP S(349.2,"A KEY",$E(X, 1,9)_$TR($ E($P($P(^
	8856	RCPS(349.2 ,+DA,0),"^ ",3),","), 1,5)," "," "),DA)=""
	8857	"^DD",349. 2,349.2,.0 2,1,1,2)
	8858	K ^RCPS(34 9.2,"AKEY" ,$E(X,1,9) _$TR($E($P ($P(^RCPS( 349.2,+DA, 0),"^",3), ","),1,5)
	8859	," ",""))
	8860	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,0)
	8861	^.101^1^1^ 3160427^^
	8862	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,1,0)
	8863	This cross -reference is used t o key the statements for CBSS.
	8864	"^DD",349. 2,349.2,.0 2,1,1,"DT" )
	8865	2960924
	8866	"^DD",349. 2,349.2,.0 2,2)
	8867	S Y(0)=Y S Y=Y
	8868	"^DD",349. 2,349.2,.0 2,2.1)
	8869	S Y=Y
	8870	"^DD",349. 2,349.2,.0 2,3)
	8871	Answer mus t be 9-10 characters in length .
	8872	"^DD",349. 2,349.2,.0 2,21,0)
	8873	^^1^1^2960 418^^
	8874	"^DD",349. 2,349.2,.0 2,21,1,0)
	8875	This is th e SSN for the patien t.
	8876	"^DD",349. 2,349.2,.0 2,"DT")
	8877	2960924
	8878	"^DD",349. 2,349.2,.0 3,0)
	8879	PATIENT NA ME^RFX^^0; 3^K:$L(X)> 44!($L(X)< 3) X S X=$ $NAM^RCFN0 1(+DA)
	8880	"^DD",349. 2,349.2,.0 3,1,0)
	8881	^.1
	8882	"^DD",349. 2,349.2,.0 3,1,1,0)
	8883	349.2^AKEY 2^MUMPS
	8884	"^DD",349. 2,349.2,.0 3,1,1,1)
	8885	I $$KEY^RC CPCFN(+DA) ]"" S ^RCP S(349.2,"A KEY",$$KEY ^RCCPCFN(+ DA),DA)=""
	8886	"^DD",349. 2,349.2,.0 3,1,1,2)
	8887	I $P(^RCPS (349.2,+DA ,0),"^",2) >1 K ^RCPS (349.2,"AK EY",$E($P( ^RCPS(349. 2,+DA,0),
	8888	"^",2),1,9 )_$TR($E($ P(X,","),1 ,5)," ","" ))
	8889	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,0)
	8890	^^1^1^3160 427^
	8891	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,1,0)
	8892	This cross -reference is used t o key the statements for CBSS.
	8893	"^DD",349. 2,349.2,.0 3,1,1,"DT" )
	8894	2960924
	8895	"^DD",349. 2,349.2,.0 3,3)
	8896	Answer mus t be 3-44 characters in length .
	8897	"^DD",349. 2,349.2,.0 3,21,0)
	8898	^^1^1^2960 418^^^^
	8899	"^DD",349. 2,349.2,.0 3,21,1,0)
	8900	This is th e patient name as it appears o n the stat ement.
	8901	"^DD",349. 2,349.2,.0 3,"DT")
	8902	2960924
	8903	"^DD",349. 2,349.2,.1 2,0)
	8904	INVALID ST ATEMENT ER ROR^P349.7 '^RCPSE(34 9.7,^0;12^ Q
	8905	"^DD",349. 2,349.2,.1 2,3)
	8906	Enter the error code for the r ecord that was not a ccepted by CBSS.
	8907	"^DD",349. 2,349.2,.1 2,21,0)
	8908	^^1^1^3160 427^
	8909	"^DD",349. 2,349.2,.1 2,21,1,0)
	8910	This is th e error co de for the record th at was not accepted by CBSS.
	8911	"^DD",349. 2,349.2,.1 2,"DT")
	8912	3160909
	8913	"^DD",349. 2,349.2,.1 8,0)
	8914	CBSS FILE BUILT^S^0: NOT BUILT; 1:BUILT;^0 ;18^Q
	8915	"^DD",349. 2,349.2,.1 8,3)
	8916	Enter a '1 ' when the CBSS PATI ENT STATEM ENTS file is complet e.
	8917	"^DD",349. 2,349.2,.1 8,21,0)
	8918	^^2^2^3160 909^^
	8919	"^DD",349. 2,349.2,.1 8,21,1,0)
	8920	This field will stor e a marker that the CBSS PATIE NT STATEME NTS file
	8921	"^DD",349. 2,349.2,.1 8,21,2,0)
	8922	(349.2) is a complet e file for that stat ement day.
	8923	"^DD",349. 2,349.2,.1 8,"DT")
	8924	3160921
	8925	"^DD",349. 2,349.2,.1 9,0)
	8926	PATIENT ST ATEMENT DA TE^D^^0;19 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	8927	"^DD",349. 2,349.2,.1 9,3)
	8928	Enter the date of th e Patient Statement.
	8929	"^DD",349. 2,349.2,.1 9,21,0)
	8930	^^2^2^3161 019^
	8931	"^DD",349. 2,349.2,.1 9,21,1,0)
	8932	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	8933	"^DD",349. 2,349.2,.1 9,21,2,0)
	8934	standardly two days after the statement is transmi tted
	8935	"^DD",349. 2,349.2,.1 9,"DT")
	8936	3161103
	8937	"^DD",349. 2,349.2,51 ,0)
	8938	ERROR CODE (S)^F^^5;1 ^K:$L(X)>3 0!($L(X)<5 ) X
	8939	"^DD",349. 2,349.2,51 ,1,0)
	8940	^.1^^0
	8941	"^DD",349. 2,349.2,51 ,3)
	8942	Answer mus t be 5-30 characters in length .
	8943	"^DD",349. 2,349.2,51 ,21,0)
	8944	^^2^2^3161 007^
	8945	"^DD",349. 2,349.2,51 ,21,1,0)
	8946	These are the error codes sent back by C BSS when a statement cannot be
	8947	"^DD",349. 2,349.2,51 ,21,2,0)
	8948	printed.
	8949	"^DD",349. 2,349.2,51 ,"DT")
	8950	3161007
	8951	"^DD",349. 2,349.2,61 ,0)
	8952	CBSS PRINT ED^S^1:Y;0 :N;^6;1^Q
	8953	"^DD",349. 2,349.2,61 ,3)
	8954	Enter whet her the pa tient stat ement for this patie nt printed at the CB SS.
	8955	"^DD",349. 2,349.2,61 ,21,0)
	8956	^^2^2^3160 909^^
	8957	"^DD",349. 2,349.2,61 ,21,1,0)
	8958	This field indicates whether t he patient statement for this patient pr inted
	8959	"^DD",349. 2,349.2,61 ,21,2,0)
	8960	at the CCP C or not.
	8961	"^DD",349. 2,349.2,61 ,"DT")
	8962	3160921
	8963	"^DD",349. 2,349.2,81 ,0)
	8964	INTEGRATIO N CONTROL NUMBER^NJ1 2,0^^8;1^K :+X'=X!(X> 9999999999 99)!(X<0)! (X?.E1"."
	8965	1.N) X
	8966	"^DD",349. 2,349.2,81 ,3)
	8967	Enter the ICN, a num ber betwee n 0 and 99 9999999999 with no d ecimal dig its.
	8968	"^DD",349. 2,349.2,81 ,21,0)
	8969	^^2^2^3160 909^
	8970	"^DD",349. 2,349.2,81 ,21,1,0)
	8971	Machine to machine i dentifier for a pati ent. This field can only be
	8972	"^DD",349. 2,349.2,81 ,21,2,0)
	8973	edited by CIRN.
	8974	"^DD",349. 2,349.2,81 ,"DT")
	8975	3160921
	8976	"^DD",349. 2,349.2,82 ,0)
	8977	ICN CHECKS UM^F^^8;2^ K:$L(X)>6! ($L(X)<6) X
	8978	"^DD",349. 2,349.2,82 ,3)
	8979	Answer mus t be 6 cha racters in length.
	8980	"^DD",349. 2,349.2,82 ,21,0)
	8981	^^2^2^3160 428^
	8982	"^DD",349. 2,349.2,82 ,21,1,0)
	8983	This check sum is the calculate d checksum for the I ntegration Control
	8984	"^DD",349. 2,349.2,82 ,21,2,0)
	8985	Number. I t verifies the integ rity of th e ICN.
	8986	"^DD",349. 2,349.2,82 ,"DT")
	8987	3160428
	8988	"^DD",349. 2,349.2,83 ,0)
	8989	AR FLAG^S^ T:TRUE;F:F ALSE;^8;3^ Q
	8990	"^DD",349. 2,349.2,83 ,3)
	8991	Enter T fo r 'TRUE' o r F for 'F alse', for whether t he patient address w as obtain
	8992	ed from AR storage.
	8993	"^DD",349. 2,349.2,83 ,21,0)
	8994	^^2^2^3160 428^
	8995	"^DD",349. 2,349.2,83 ,21,1,0)
	8996	This is a set of cod e, indicat ing whethe r or not t he address was taken
	8997	"^DD",349. 2,349.2,83 ,21,2,0)
	8998	from the A R DEBTOR ( #340).
	8999	"^DD",349. 2,349.2,83 ,"DT")
	9000	3160921
	9001	"^DD",349. 2,349.2,84 ,0)
	9002	DATE OF LA TEST BILL^ DX^^8;4^S %DT="EX" D ^%DT S X= Y K:X<1 X
	9003	"^DD",349. 2,349.2,84 ,3)
	9004	Enter the date on wh ich the la test bill was establ ished.
	9005	"^DD",349. 2,349.2,84 ,21,0)
	9006	^^1^1^3160 428^^
	9007	"^DD",349. 2,349.2,84 ,21,1,0)
	9008	The date t he latest bill was p repared. Time is no t allowed.
	9009	"^DD",349. 2,349.2,84 ,"DT")
	9010	3160921
	9011	"^DD",349. 5,349.5,0)
	9012	FIELD^^1^7
	9013	"^DD",349. 5,349.5,0, "DT")
	9014	3170224
	9015	"^DD",349. 5,349.5,0, "IX","B",3 49.5,.01)
	9016
	9017	"^DD",349. 5,349.5,0, "NM","AR A NNUAL PAYM ENT STATEM ENT")
	9018
	9019	"^DD",349. 5,349.5,.0 1,0)
	9020	PS SEGMENT NUMBER^RN J4,0^^0;1^ K:+X'=X!(X >9999)!(X< 1)!(X?.E1" ."1.N) X
	9021	"^DD",349. 5,349.5,.0 1,1,0)
	9022	^.1
	9023	"^DD",349. 5,349.5,.0 1,1,1,0)
	9024	349.5^B
	9025	"^DD",349. 5,349.5,.0 1,1,1,1)
	9026	S ^RCAP(34 9.5,"B",$E (X,1,30),D A)=""
	9027	"^DD",349. 5,349.5,.0 1,1,1,2)
	9028	K ^RCAP(34 9.5,"B",$E (X,1,30),D A)
	9029	"^DD",349. 5,349.5,.0 1,3)
	9030	Enter the PS Segment Number (a number be tween 1 an d 9999).
	9031	"^DD",349. 5,349.5,.0 1,21,0)
	9032	^^1^1^3170 223^
	9033	"^DD",349. 5,349.5,.0 1,21,1,0)
	9034	This is th e Segment Number for the "PS" Record Ide ntifier.
	9035	"^DD",349. 5,349.5,.0 1,"DT")
	9036	3170224
	9037	"^DD",349. 5,349.5,.0 2,0)
	9038	YEAR^NJ3,0 ^^0;2^K:+X '=X!(X>400 )!(X<300)! (X?.E1"."1 .N) X
	9039	"^DD",349. 5,349.5,.0 2,3)
	9040	Enter the Year for t his segmen t in Inter nal FileMa n Format ( a number b etween 30
	9041	0 and 400) .
	9042	"^DD",349. 5,349.5,.0 2,21,0)
	9043	^^1^1^3170 223^
	9044	"^DD",349. 5,349.5,.0 2,21,1,0)
	9045	This is th e Annual P ayment Fil e Year to be process ed.
	9046	"^DD",349. 5,349.5,.0 2,"DT")
	9047	3170224
	9048	"^DD",349. 5,349.5,.0 3,0)
	9049	DATE/TIME BUILD STAR TED^D^^0;3 ^S %DT="ES TXR" D ^%D T S X=Y K: 3170101>X X
	9050	"^DD",349. 5,349.5,.0 3,3)
	9051	Enter the Date and T ime Build Started.
	9052	"^DD",349. 5,349.5,.0 3,21,0)
	9053	^^1^1^3170 223^
	9054	"^DD",349. 5,349.5,.0 3,21,1,0)
	9055	This is th e Date and Time that the Build for this file start ed.
	9056	"^DD",349. 5,349.5,.0 3,"DT")
	9057	3170224
	9058	"^DD",349. 5,349.5,.0 4,0)
	9059	DATE/TIME BUILD ENDE D^D^^0;4^S %DT="ESTX R" D ^%DT S X=Y K:31 70101>X X
	9060	"^DD",349. 5,349.5,.0 4,3)
	9061	Enter the Date and T ime Build Ended.
	9062	"^DD",349. 5,349.5,.0 4,21,0)
	9063	^^1^1^3170 223^
	9064	"^DD",349. 5,349.5,.0 4,21,1,0)
	9065	This is th e Date and Time that the Build for this file ended .
	9066	"^DD",349. 5,349.5,.0 4,"DT")
	9067	3170224
	9068	"^DD",349. 5,349.5,.0 5,0)
	9069	DATE/TIME TRANSMIT S TARTED^D^^ 0;5^S %DT= "ESTXR" D ^%DT S X=Y K:3170101 >X X
	9070	"^DD",349. 5,349.5,.0 5,3)
	9071	Enter the Date and T ime Transm it Started .
	9072	"^DD",349. 5,349.5,.0 5,21,0)
	9073	^^1^1^3170 223^
	9074	"^DD",349. 5,349.5,.0 5,21,1,0)
	9075	This is th e Date and Time that the Trans mit for th is file st arted.
	9076	"^DD",349. 5,349.5,.0 5,"DT")
	9077	3170224
	9078	"^DD",349. 5,349.5,.0 6,0)
	9079	DATE/TIME TRANSMIT E NDED^D^^0; 6^S %DT="E STXR" D ^% DT S X=Y K :3170101>X X
	9080	"^DD",349. 5,349.5,.0 6,3)
	9081	Enter Date /Time Tran smit Ended .
	9082	"^DD",349. 5,349.5,.0 6,21,0)
	9083	^^1^1^3170 223^
	9084	"^DD",349. 5,349.5,.0 6,21,1,0)
	9085	This is th e Date and Time that the Trans mit for th is file en ded.
	9086	"^DD",349. 5,349.5,.0 6,"DT")
	9087	3170224
	9088	"^DD",349. 5,349.5,1, 0)
	9089	STATEMENT FILE LINES ^349.51^^1 ;0
	9090	"^DD",349. 5,349.5,1, 21,0)
	9091	^^1^1^3170 224^^
	9092	"^DD",349. 5,349.5,1, 21,1,0)
	9093	This is th e multiple for the A nnual Paym ent Statem ent file l ines.
	9094	"^DD",349. 5,349.51,0 )
	9095	STATEMENT FILE LINES SUB-FIELD ^^.01^1
	9096	"^DD",349. 5,349.51,0 ,"DT")
	9097	3170224
	9098	"^DD",349. 5,349.51,0 ,"NM","STA TEMENT FIL E LINES")
	9099
	9100	"^DD",349. 5,349.51,0 ,"UP")
	9101	349.5
	9102	"^DD",349. 5,349.51,. 01,0)
	9103	STATEMENT FILE LINES ^MFJ342^^0 ;1^K:$L(X) >342!($L(X )<1) X
	9104	"^DD",349. 5,349.51,. 01,1,0)
	9105	^.1^^0
	9106	"^DD",349. 5,349.51,. 01,3)
	9107	Enter File Lines for Annual Pa yment Stat ement (1 t o 342 char acters).
	9108	"^DD",349. 5,349.51,. 01,21,0)
	9109	^^1^1^3170 224^
	9110	"^DD",349. 5,349.51,. 01,21,1,0)
	9111	These are the File L ines for A nnual Paym ent Statem ent.
	9112	"^DD",349. 5,349.51,. 01,"DT")
	9113	3170224
	9114	"^DIC",349 .1,349.1,0 )
	9115	AR TRANSMI SSION TYPE ^349.1
	9116	"^DIC",349 .1,349.1,0 ,"GL")
	9117	^RCT(349.1 ,
	9118	"^DIC",349 .1,349.1," %D",0)
	9119	^1.001^2^2 ^3160422^^ ^^
	9120	"^DIC",349 .1,349.1," %D",1,0)
	9121	This file stores the transmiss ion types used in fi le 349
	9122	"^DIC",349 .1,349.1," %D",2,0)
	9123	AR TRANSMI SSION RECO RDS.
	9124	"^DIC",349 .1,"B","AR TRANSMISS ION TYPE", 349.1)
	9125
	9126	"^DIC",349 .5,349.5,0 )
	9127	AR ANNUAL PAYMENT ST ATEMENT^34 9.5
	9128	"^DIC",349 .5,349.5,0 ,"GL")
	9129	^RCAP(349. 5,
	9130	"^DIC",349 .5,349.5," %",0)
	9131	^1.005^^
	9132	"^DIC",349 .5,349.5," %D",0)
	9133	^^3^3^3170 223^
	9134	"^DIC",349 .5,349.5," %D",1,0)
	9135	This file will hold all of the previous year's pat ient payme nt data fo r
	9136	"^DIC",349 .5,349.5," %D",2,0)
	9137	that calen dar year a nd persist for only one year t o then be deleted an d
	9138	"^DIC",349 .5,349.5," %D",3,0)
	9139	replaced a t the begi nning of t he next ca lendar yea r.
	9140	"^DIC",349 .5,"B","AR ANNUAL PA YMENT STAT EMENT",349 .5)
	9141
	9142	"BLD",1011 1,6)
	9143	4^
	9144	$END KID P RCA4.531 3