1. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 10/2/2017 2:16:57 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.

1.1 Files compared

#	Location	File	Last Modified
1	C:\AraxisMergeCompare\Pri_un\ZIP\PSE Patch PRCA_45_313 v9 CIF submission	PSE Patch PRCA_45_313 v9 CIF submission.docx	Thu Aug 10 14:02:44 2017 UTC
2	C:\AraxisMergeCompare\Pri_re\ZIP\PSE Patch PRCA_45_313 v9 CIF submission	PSE Patch PRCA_45_313 v9 CIF submission.docx	Mon Oct 2 17:27:26 2017 UTC

1.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	9	22992
Changed	9	22
Inserted	0	0
Removed	0	0

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

1.4 Active regular expressions

No regular expressions were active.

1.5 Comparison detail

	1	Printed at DNS 08/10/17@0 9:32
	2	Subj: PRCA 4.5313 T EST v9 [# 85226764] 08/02/17@0 9:45 1098 4 lines
	3	From: NPM [#852267 64] In 'I N' basket. Page 1
	4	---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
	5	$TXT Creat ed by ENFI NGER,MARK at DEVESS. D NS (KIDS) on Wednesd
	6	ay, 08/02/ 17 at 09:4 1
	7	========== ========== ========== ========== ========== ========== ========== =======
	8	Run Date: AUG 02, 20 17 Designa tion: PRCA 4.5313
	9	Package : PRCA - ACC OUNTS RECE IVABLE Prio rity: Mand atory
	10	Version : 4.5 St atus: Unde r Developm ent
	11	========== ========== ========== ========== ========== ========== ========== =======
	12
	13	Associated patches: (v)XMDB1 0 i nstall wit h patch `PRCA* 4.5*313'
	14	(v)PRCA4. 5307<<= m ust be ins talled BEF ORE `PRCA* 4.5*313'
	15
	16	Subject: P ATIENT STA TEMENT ENH ANCEMENT - Phase Two
	17
	18	Category:
	19	- Other
	20	- Routin e
	21	- Data D ictionary
	22	- Enhanc ement (Man datory)
	23
	24	Descriptio n:
	25	========== ==
	26
	27
	28	******* ****** ****** ****** ****** ****** ****** **
	29
	30	This patch sup ports chan ges to the Veterans Health Inf ormation
	31	Syst em and Tec hnology Ar chitecture (VistA) f or the Pat ient State ment
	32	Enha ncements P roject (PS E).
	33
	34	It i s imperati ve that th ese patche s be insta lled no la ter than t he
	35	comp liance dat e. Your un derstandin g and supp ort is app reciated.
	36
	37	******* ****** ****** ****** ****** ****** ****** **
	38
	39	The Chie f Business Office (C BO) reques ted modifi cations to the VistA
	40	Accounts Receivabl e (AR) pac kage to re medy defic iencies id entified w ith
	41	patient statements . The main goals of this proje ct include the
	42	remediat ion and en hancement of the AR applicatio n software to correc t
	43	these di screpancie s. Additio nally this project w ill perfor m the init ial
	44	developm ent of the VistA AR enhancemen ts to crea te a singl e, consoli dated
	45	patient statement, self-serv ice option s for paym ent, and o ther
	46	modifica tions.
	47
	48	This pat ch modifie s the Acco unt Receiv able (AR) v4.5 appli cation as
	49	describe d below:
	50
	51	1. Chang e the sche dule of pr inting Pat ient State ments to s end patien ts
	52	with the first let ters of th e last nam e on the s ame day ev ery month. The
	53	day of t he month f or each le tter combi nation is contained in the
	54	Post-Ins tallation section.
	55
	56	2. Updat e the Pati ent Statem ent Build and Transm it code to create an d
	57	send the appropria te stateme nts with a n updated format. Th e Build an d
	58	Transmit will occu r two days prior to the listed date to a llow for
	59	processi ng by the Consolidat ed Co-paym ent Proces sing Cente r (CCPC) a nd
	60	the Cons olidated B illing Sta tement Sys tem (CBSS) for print ing on the
	61	assigned date.
	62
	63	3. Recei ve and pro cess the P rint Ackno wledgement s from CCP C using cu rrent
	64	procedur es.
	65
	66	4. Creat e and tran smit a Nig htly Patie nt Update to provide CBSS with the
	67	oldest b ill balanc e and amou nt for eac h Veteran on a night ly basis.
	68
	69	5. Provi de CBS Nig htly Accou nt Update Program [P RCA CBS NI GHTLY UPDA TE]
	70	as a men u option t o run the Nightly Pa tient Upda te from th e [PRCA
	71	ACCOUNTS MANAGEMEN T] Menu.
	72
	73	6. Updat e the foll owing menu options t o work wit h the mult iple state ment
	74	date:
	75
	76	a. CCP C Statemen t Errors [RCCPC E RROR]
	77	b. CCP C Totals [RCCPC T OTALS REPO RT]
	78	c. Rep rint Patie nt Stateme nts [PRCAE P R STATEMEN T]
	79	d. Bui ld CCPC fi le for tra nsmission [RCCPC B UILD]
	80	e. Tra nsmit CCPC messages [RCCPC T RANSMIT]
	81
	82	7. Patie nt Stateme nt Auto-Co rrection P rogram
	83	The AR a pplication executes an Auto-Co rrection p rogram tha t detects
	84	and reme diates the following 2 types o f statemen t discrepa ncies:
	85
	86	1. Dupl icate tran sactions i n the AR T RANSACTION file (#43 3).
	87	2. Inco mplete sta tus errors in the AR TRANSACTI ON file (# 433).
	88
	89	The Pat ient State ment Auto- Correction Program i s schedule d as part of
	90	the AR nightly ba ckground j ob.
	91
	92	The Pat ient State ment Auto- Correction Program c an be run on demand
	93	and wil l be an op tion in th e Account Management menu.
	94
	95	The Pat ient State ment Auto- Correction Program r uns as a
	96	post-in itializati on program at the ti me of inst allation.
	97
	98	OI&T sh ould also schedule t he PRCA AU TOCRCT PGM QUEUED op tion to ru n
	99	every W ednesday a t 1:00 AM local time , before t he CCPC jo b.
	100
	101	8. Auto- Correct Pa tient Disc repancy Re port
	102	The Auto -Correct P atient Dis crepancy R eport list s the disc repancy
	103	details that were remediated by the Pa tient Stat ement Auto -Correctio n
	104	Program.
	105
	106	The Aut o-Correct Patient Di screpancy Report dis plays the bill numbe r,
	107	the deb tor, the l ast four d igits of t he SSN, th e transact ion number ,
	108	the cor rection da te, and th e reason f or the aut o-correcti on.
	109
	110	The Aut o-Correct Patient Di screpancy Report pro vides four sort opti ons.
	111
	112	1 Auto- Correct Re ason
	113	2 Debto r Name
	114	3 Bill Number
	115	4 Trans action Num ber
	116	5 Auto- Correct Da te
	117
	118	Each ent ry in the Auto-Corre ct Patient Discrepan cy Report will have one
	119	of the t hree Auto- Correct Re asons.
	120
	121	1 INCOM PLETE FLAG ERROR
	122	2 DUPLI CATE TRANS ACTION
	123	3 NOT F IXABLE
	124
	125	Transact ions liste d as NOT F IXABLE wil l need to be manuall y reviewed
	126	to deter mine the a ppropriate course of action an d then the y should b e
	127	correcte d manually .
	128
	129	Addition ally, the report sor t descript ion that a ppears on the page
	130	headers has been u pdated to be more de scriptive.
	131
	132	9. Build and Trans mit a year ly Annual Patient Pa yment Summ ary (APPS)
	133	Statemen t file for every Pat ient payme nt made in the previ ous year.
	134	Payment in Full (3 4) and Pay ment in Pa rt (2) wil l be the o nly Accoun ts
	135	Receivab le Transac tion Types sent in t he file. T he Build w ill begin
	136	automati cally on J anuary 2nd of each y ear for th e previous year.
	137	Transmis sion will be based u pon the Vi stA Site C ode and wi ll occur a t
	138	02:00 ho urs from J anuary 3rd to Januar y 12th. Tr ansmission will be t o a
	139	new queu e at CCPC.
	140
	141	10. Thre e new opti ons have b een added to the Fol low-up Let ter Menu
	142	[PRCAE F OLLOW-UP].
	143
	144	Build a nd Transmi t Annual P ayment Fil e [RCCPC A PPS BUILD AND TRANS] will
	145	allow m anual crea tion and t ransmissio n of the A PPS Statem ent file.
	146
	147	Retrans mit Curren t Annual P ayment Fil e [RCCPC A PPS RETRAN S] will al low
	148	manual re-transmi ssion of t he APPS St atement Fi le.
	149
	150	Annual Payment Fi le Consist ency Check (RCCPC AP PS DATA CH ECK) will
	151	allow V alidation of the APP S Statemen t File dat a for the current
	152	calenda r year to the presen t date.
	153
	154	Patch Co mponents
	155	======== ========
	156
	157	Files & Fields Ass ociated:
	158
	159	File Nam e (#) Fiel d Name (#) New/Mod /Del
	160	-------- ---------- ---------- -- ---- ---------- ---- ------- ----
	161	AR TRANS ACTION (#4 33) DATE (#94) New
	162	AMOU NT (#95) New
	163	TYPE OF ERROR (#96) New
	164	FLAG (#97) New
	165
	166	AR DEBTO R (#340) DEBT OR (#.01) Mod
	167	STAT EMENT DAY (#.03) Mod
	168	CURR ENT CBS DE BT AMOUNT (#7.06) New
	169
	170	AR EVENT (#341) CCPC STATEMENT DATE (#6. 01) Mod
	171
	172	AR TRANS MISSION RE CORDS (#34 9) STAT EMENT DATE (#.09) Mod
	173
	174	AR TRANS MISSION TY PE (#349.1 ) LAST MESSAGE A CK (#41) Del
	175	FINA L MESSAGE ACK (#42) Del
	176	LAST MESSAGE N UMBER (#43 ) Del
	177	MESS AGE ACKNOW LEDGEMENT (#40) New
	178	LAST MESSAGE A CK (#349.1 41,.01) New
	179	FINA L MESSAGE ACK (#349. 141,.02) New
	180	LAST MESSAGE N UMBER (#34 9.141,.03) New
	181	PATI ENT STATEM ENT DATE New
	182	(#34 9.141,.04)
	183	ACK MESSAGES ( #50) Mod
	184	PATI ENT STATEM ENT DATE New
	185	(#34 9.151,.04)
	186
	187	AR CBSS STATEMENTS (#349.2) PATI ENT (#.01) Mod
	188	SSN (#.02) Mod
	189	PATI ENT NAME ( #.03) Mod
	190	INVA LID STATEM ENT ERROR (#.12) Mod
	191	CBSS FILE BUIL D (#.18) Mod
	192	PATI ENT STATEM ENT DATE ( #.19) New
	193	ERRO R CODE(S) (#51) Mod
	194	CBSS PRINTED ( #61) Mod
	195	INTE GRATION CO NTROL NUMB ER (#81) New
	196	ICN CHECKSUM ( #82) New
	197	AR F LAG (#83) New
	198	DATE OF LATEST BILL (#84 ) New
	199
	200	AR ANNUA L PAYMENT STATEMENT FILE PS S EGMENT NUM BER (#.01) New
	201	(#349.5) YEAR (#.02) New
	202	DATE /TIME BUIL D STARTED (#.03) New
	203	DATE /TIME BUIL D ENDED (# .04) New
	204	DATE /TIME TRAN SMIT START ED (#.05) New
	205	DATE /TIME TRAN SMIT ENDED (#.06) New
	206	STAT EMENT FILE LINES (#1 ) New
	207	STAT EMENT FILE LINES (#3 49.51,.01) New
	208
	209	Forms As sociated:
	210
	211	Form Nam e Fi le # New/M od/Del
	212	-------- - -- ---- ----- ------
	213	N/A
	214
	215	Mail Gro ups Associ ated:
	216
	217	Mail Gro up Name New/M od/Del
	218	-------- ------- ----- ------
	219	PRCACPS N ew
	220
	221	Options Associated :
	222
	223	Option N ame Type New/M od/Del
	224	-------- --- ---------- - ----- ------
	225	PRCA CBS NIGHTLY U PDATE Run Routin e N ew
	226	RCCPC AP PS BUILD A ND TRANS Action N ew
	227	RCCPC AP PS RETRANS Action N ew
	228	RCCPC AP PS DATA CH ECK Action N ew
	229	PRCA ACC OUNT MANAG EMENT Menu M od
	230	PRCA AUT OCRCT PGM Run Routin e N ew
	231	PRCA AUT OCRCT RPT Run Routin e N ew
	232
	233
	234	Protocol s Associat ed:
	235
	236	Protocol Name Ne w/Modified /Deleted
	237	-------- ----- -- ---------- --------
	238	N/A
	239
	240	Security Keys Asso ciated:
	241
	242	Security Key Name N ew/Mod/Del
	243	-------- --------- - ----------
	244	PRCA AUT OCRCT PGM New
	245
	246	Template s Associat ed:
	247
	248	Template Name Ty pe File Name (Num ber) New/ Mod/Del
	249	-------- ----- -- -- ---- ---------- ---- ---- -------
	250	N/A
	251
	252	Addition al Informa tion:
	253	N/A
	254
	255	New Serv ice Reques ts (NSRs):
	256	-------- ---------- ----------
	257	N/A
	258
	259	Patient Safety Iss ues (PSIs) :
	260	-------- ---------- ---------- -
	261	N/A
	262
	263	Defect T racking Sy stem Ticke t(s) & Ove rview:
	264	-------- ---------- ---------- ---------- ------
	265	N/A
	266
	267	Problem:
	268	-------
	269	N/A
	270
	271	Resoluti on:
	272	-------- --
	273	N/A
	274
	275	Test Sit es:
	276	-------- --
	277	- Bay Pi nes VAMC ( 516)
	278	- James A. Haley V AMC (Tampa , FL) (673 )
	279	- Connec ticut HCS - West Hav en Divisio n (689)
	280
	281	Software and Docum entation R etrieval I nstruction s:
	282	-------- ---------- ---------- ---------- ---------- ----
	283	Software being rel eased as a host file and/or do cumentatio n describi ng
	284	the new functional ity introd uced by th is patch a re availab le.
	285
	286	The prefer red method is to ret rieve file s from DNS .
	287	This tra nsmits the files fro m the firs t availabl e server. Sites may
	288	also ele ct to retr ieve files directly from a spe cific serv er.
	289
	290	Sites ma y retrieve the softw are and/or documenta tion direc tly using
	291	Secure F ile Transf er Protoco l (SFTP) f rom the AN ONYMOUS.SO FTWARE
	292	director y at the f ollowing O I Field Of fices:
	293
	294	Albany: URL
	295	Hines: URL
	296	Salt Lake City: URL
	297
	298	Document ation can also be fo und on the VA Softwa re Documen tation Lib rary
	299	at: http:/ / URL
	300
	301
	302	Title File Name SFTP Mode
	303	--------- ---------- ---------- ---------- ---------- ---------- ---------- -----
	304	Patient Statement Enhancemen ts User Ma nual prca _4_5_p313_ um.pdf (bi nary)
	305	Patient Statement Enhancemen ts Release prca _4_5_p313_ rn.pdf (bi nary)
	306	Notes / Installat ion Guide
	307	Accounts Receivabl e Technica l Manual / prca _4_5_p313_ tm.pdf (bi nary)
	308	Securit y Guide
	309
	310	Patch In stallation :
	311
	312	Pre/Post Installat ion Overvi ew:
	313	-------- ---------- ---------- ---
	314	The Pre- Installati on removes elements from the A R Transact ion and AR
	315	Transact ion Type f iles. The Post-Insta llation re moves curr ent monthl y
	316	Patient Statement Data, rese ts each De btor's Pat ient State ment date to
	317	the date matching the last n ame of the patient, and insure s the Pati ent
	318	Statemen t and Nigh tly Update queues ar e set to t he proper domains.
	319
	320	The post -install r outine for patch PRC A4.5313 will queue the
	321	Patient Statement Auto-Corre ction Prog ram to rem ediate sta tement
	322	discrepa ncies.
	323
	324	The post install r outine PRC A313P may be deleted from the system if the
	325	post-ins tall proce ss has com pleted.
	326
	327
	328	Pre-Inst allation I nstruction s:
	329	-------- ---------- ---------- --
	330	The Pre- Installati on removes elements from the A R Transmis sion Recor ds
	331	and AR T ransmissio n Type fil es.
	332
	333	The AR T RANSMISSIO N RECORDS file (#349 ) will hav e the STAT EMENT DATE
	334	field (# .09) remov ed prior t o entering a New Sty le Cross-R eference.
	335
	336	The AR T RANSMISSIO N TYPE fil e (#349.1) will have the LAST MESSAGE AC K
	337	field (# 41), FINAL MESSAGE A CK field ( #42), and the LAST M ESSAGE NUM BER
	338	field (# 43) remove d. These e lements wi ll be repl aced with a multiple
	339	record M ESSAGE ACK NOWLEDGEME NT field ( #349.141) during the data
	340	dictiona ry load.
	341
	342	This pat ch may be installed with users on the sy stem altho ugh it is
	343	recommen ded that i t be insta lled durin g non-peak hours to minimize
	344	potentia l disrupti on to user s. This pa tch should take less than 30
	345	minutes to install .
	346
	347	The foll owing opti ons may be marked as 'out of o rder':
	348
	349	Stateme nt Discrep ancy Listi ng [PRC A DISC LIS T]
	350	Check P atient Acc ount Balan ce [PRC A ACCOUNT CHECK]
	351
	352	Installa tion Instr uctions:
	353	-------- ---------- --------
	354	This pat ch modifie s the Acco unt Receiv able (AR) v4.5 appli cation for a
	355	single, consolidat ed patient statement .
	356
	357	1. Ch oose the P ackMan mes sage conta ining this patch.
	358
	359	2. Ch oose the I NSTALL/CHE CK MESSAGE PackMan o ption.
	360
	361	3. Fr om the Ker nel Instal lation and Distribut ion System Menu, sel ect
	362	th e Installa tion Menu. From this menu, you may elect to use th e
	363	fo llowing op tions. Whe n prompted for the I NSTALL NAM E enter th e
	364	pa tch PRCA4 .5313.
	365
	366	a. Backup a Transport Global - T his option will crea te a backu p
	367	message o f any rout ines expor ted with t his patch. It will n ot
	368	backup an y other ch anges such as DDs or templates .
	369
	370	b. Compare T ransport G lobal to C urrent Sys tem - This option wi ll
	371	allow you to view a ll changes that will be made w hen this
	372	patch is installed. It compar es all com ponents of this patc h
	373	routines, DDs, temp lates, etc .
	374
	375	c. Verify Ch ecksums in Transport Global - This optio n will all ow
	376	you to en sure the i ntegrity o f the rout ines that are in the
	377	transport global.
	378
	379	4. Fr om the Ins tallation Menu, sele ct the Ins tall Packa ge(s)
	380	op tion and c hoose the patch to i nstall.
	381
	382	5. Wh en prompte d 'Want KI DS to Rebu ild Menu T rees Upon Completion
	383	of Install? YES//' rep ly 'YES' u nless your system re builds men u
	384	tr ees nightl y using Ta skMan. Ans wering Yes during no rmal busin ess
	385	ho urs could affect use rs on the system and installat ion times will
	386	in crease.
	387
	388	6. Wh en Prompte d "Enter t he Coordin ator for M ail Group 'PRCACPS': ",
	389	r espond wit h the name : Kendrick , Tammy S.
	390
	391	7. Wh en Prompte d "Want KI DS to INHI BIT LOGONs during th e install?
	392	N O//", resp ond NO.
	393
	394	8. Wh en Prompte d "Want to DISABLE S cheduled O ptions, Me nu Options ,
	395	a nd Protoco ls? NO//", respond Y ES.
	396
	397	a. When Pr ompted "En ter option s you wish to mark a s 'Out Of
	398	Order': ", enter t he followi ng options :
	399
	400	Stat ement Disc repancy Li sting [ PRCA DISC LIST]
	401	Chec k Patient Account Ba lance [ PRCA ACCOU NT CHECK]
	402
	403	b. When Pr ompted "En ter protoc ols you wi sh to mark as 'Out
	404	Of Orde r':", Pres s <ENTER>.
	405
	406	9. Wh en prompte d "Delay I nstall (Mi nutes): ( 0-60): 0// " enter a n
	407	ap propriate number of minutes to delay the installat ion in ord er to
	408	gi ve users e nough time to exit t he disable d options before the
	409	in stallation starts.
	410
	411	10. Wh en prompte d "Device: Home//" respond wi th the cor rect devic e.
	412
	413
	414	Post-Ins tallation Instructio ns:
	415	-------- ---------- ---------- ---
	416	The Auto -Correctio n program may take u p to 20 mi nutes to r un.
	417
	418	The Post -Installat ion remove s current monthly Pa tient Stat ement Data ,
	419	resets e ach Debtor 's Patient Statement date to t he date ma tching the
	420	last nam e of the P atient, an d insures the Patien t Statemen t and Nigh tly
	421	Update t ransmissio n queues a re set to the proper domains.
	422
	423	The prev ious month 's Patient Statement data is r emoved at each site
	424	prior to the creat ion of the current m onth's dat a. To impl ement 16 d ays
	425	during t he month f or alphabe tically ba sed Patien t Statemen ts, all da ta
	426	must be removed. T his is per formed dur ing the Po st-Install . Should a site
	427	feel it requires t hese older Patient S tatements, a Reprint Patient
	428	Statemen ts [PRCAE PR STATEME NT] may be performed . It is ST RONGLY
	429	RECOMMEN DED, due t o the size of this f ile, each site run a single re print
	430	to a sin gle MailMa n account and share that data until the patient's new
	431	statemen t prints w ithin the next 31 da ys.
	432
	433	The Post -Installat ion will r eset each AR Debtor' s account that proce sses
	434	Patient Statements with the Patient St atement Da te corresp onding to the
	435	table pr ovided. Th e letters use the Pa tient's La st Name. T he SITE
	436	STATEMEN T DATE fie ld (#.11) in the AR SITE PARAM ENTER file (#342) is set
	437	to Null to prevent a possibl e transmis sion using the previ ous format .
	438
	439	Day of t he Month Lett ers of las t name
	440	-------- -------- ---- ---------- ------
	441	1 A,BA ,BU
	442	2 B EX CLUDE (BA, BU)
	443	4 CI,C R,CU,D
	444	6 C EX CLUDE (CI, CR,CU)
	445	7 E,F, I,Q
	446	8 G,HE
	447	10 H EX CLUDE HE
	448	12 J,K
	449	14 L,O
	450	15 M EX CLUDE (MC, MI)
	451	17 MC,M I,N,TI-TZ
	452	19 R,TA -TE
	453	21 S EX CLUDE (SC, SH,SI,SM)
	454	22 SC,S H,SI,SM,TF -TH,V
	455	24 P,U, X,Y,Z
	456	26 W
	457
	458	VistA Ma ilMan is u sed to sen d the Pati ent Statem ent and Ni ghtly Upda te
	459	files. T he address es for the se transmi ssions are taken fro m the AR
	460	TRANSMIS SION TYPE file (#349 .1). The P ost-Instal lation val idates and
	461	updates the CCPC D omain and Addressee for both t ransmissio n types. A s the
	462	Nightly Update and Annual Pa tient Paym ent Summer y transmis sions are sent
	463	to a new Domain, P atch XMDB* 1.0*0 a re quired Pat ch must ha ve been
	464	previous ly loaded.
	465
	466	During th e post-ins tall proce ss you may see liste d in the l og one of the
	467	followin g messages :
	468
	469	>>> STAT ION ID XXX MATCH FOU ND!
	470	>>> THE PATIENT ST ATEMENT TR ANSMISSION DATE WILL BE UPDATE D
	471	Note: XX X will equ al your ST ATION NUMB ER
	472
	473	>>> WARN ING! STATI ON ID NOT FOUND!
	474	>>> THE PATIENT ST ATEMENT TR ANSMISSION DATE WILL NOT BE UP DATED
	475
	476	The post- install ro utine for patch PRCA 4.5313 w ill queue the
	477	Patient Statement Auto-Corre ction Prog ram to rem ediate sta tement
	478	discrepa ncies.
	479
	480	The inst allation l og will di splay:
	481	>>>POST- INSTALL CO NSOLIDATED PATIENT S TATEMENT A UTO-CORREC TION
	482	>>>PROGR AM HAS BEE N QUEUED
	483
	484	If there is an err or, the in stallation log will display:
	485	>>>ERROR : POST-INS TALL CONSO LIDATED PA TIENT STAT EMENT AUTO -CORRECTIO N
	486	>>>PROGR AM COULD N OT BE QUEU ED
	487
	488
	489	The post install r outine PRC A313P may be deleted from the system if the
	490	post-ins tall proce ss has com pleted.
	491
	492	Routine In formation:
	493	========== ==========
	494	The second line of e ach of the se routine s now look s like:
	495	;;4.5;Acc ounts Rece ivable;[ Patch List ];Mar 20 , 1995;Bui ld 124
	496
	497	The checks ums below are new ch ecksums, a nd
	498	can be ch ecked with CHECK1^XT SUMBLD.
	499
	500	Routine Na me: PRCA31 3P
	501	Before : n/ a After: B27681734 313
	502	Routine Na me: PRCAAC R
	503	Before : n/ a After: B127336081 313
	504	Routine Na me: PRCAAC R1
	505	Before : n/ a After: B151271441 313
	506	Routine Na me: PRCACP S
	507	Before : n/ a After: B254066716 313
	508	Routine Na me: PRCACP S1
	509	Before : n/ a After: B19128158 313
	510	Routine Na me: PRCACP SA
	511	Before : n/ a After: B33270653 313
	512	Routine Na me: PRCAG
	513	Before : B2201651 2 After: B74256403 *149,16 5,198,313 *
	514	Routine Na me: RCBEAD J
	515	Before : B7712514 7 After: B77106309 **169,17 2,204,173, 208,233,29 8,
	516	301,313 **
	517	Routine Na me: RCCPCA P
	518	Before : n/ a After: B43189035 313
	519	Routine Na me: RCCPCA R
	520	Before : n/ a After: B47894432 313
	521	Routine Na me: RCCPCA T
	522	Before : n/ a After: B52270242 313
	523	Routine Na me: RCCPCB J
	524	Before : B628849 1 After: B9440906 34,76, 130,153,16 6,195,217, 237,313
	525	Routine Na me: RCCPCF N1
	526	Before : n/ a After: B7181774 313
	527	Routine Na me: RCCPCM L
	528	Before : B4788102 4 After: B67061934 **34,80, 93,118,133 ,140,160,1 65,
	529	187,195 ,206,223,2 60,313**
	530	Routine Na me: RCCPCM L1
	531	Before : B668233 5 After: B8980051 160,31 3
	532	Routine Na me: RCCPCP S
	533	Before : B8089891 5 After: B131432714 **34,70, 80,48,104, 116,149,17 0,
	534	181,190 ,223,237,2 19,265,301 ,
	535	313**
	536	Routine Na me: RCCPCP S1
	537	Before : B3737011 3 After: B65443378 34,48, 104,170,17 6,192,265, 313
	538	Routine Na me: RCCPCS E
	539	Before : B581043 9 After: B16507603 34,313
	540	Routine Na me: RCCPCS V
	541	Before : B519949 0 After: B11825361 34,70, 87,313
	542	Routine Na me: RCCPCS V1
	543	Before : B3201709 6 After: B43313841 34,70, 76,130,153 ,313
	544	Routine Na me: RCCPCT
	545	Before : B248969 7 After: B29330001 34,313
	546	Routine Na me: RCDPBT LM
	547	Before : B4947614 0 After: B55885939 **114,14 8,153,168, 169,198,24 7,
	548	271,276 ,313**
	549
	550	Routine li st of prec eding patc hes: 87, 2 60, 276, 3 01
	551
	552	========== ========== ========== ========== ========== ========== ========== =======
	553	User Infor mation:
	554	Entered By : ENFING ER,MARK Date E ntered : MAY 04, 20 16
	555	Completed By: Date C ompleted:
	556	Released B y : Date R eleased :
	557	========== ========== ========== ========== ========== ========== ========== =======
	558
	559
	560	Packman Ma il Message :
	561	========== ========== =
	562
	563	$END TXT
	564	$KID PRCA* 4.5*313
	565	INSTALL NAME
	566	PRCA4.53 13
	567	"BLD",1011 1,0)
	568	PRCA4.53 13^ACCOUNT S RECEIVAB LE^0^31708 02^y
	569	"BLD",1011 1,1,0)
	570	^^1^1^3160 811^^^^
	571	"BLD",1011 1,1,1,0)
	572	Consolidat ed Patient Statement
	573	"BLD",1011 1,4,0)
	574	^9.64PA^43 3^7
	575	"BLD",1011 1,4,340,0)
	576	340
	577	"BLD",1011 1,4,340,2, 0)
	578	^9.641^340 ^1
	579	"BLD",1011 1,4,340,2, 340,0)
	580	AR DEBTOR (File-top level)
	581	"BLD",1011 1,4,340,2, 340,1,0)
	582	^9.6411^.0 3^3
	583	"BLD",1011 1,4,340,2, 340,1,.01, 0)
	584	DEBTOR
	585	"BLD",1011 1,4,340,2, 340,1,.03, 0)
	586	STATEMENT DAY
	587	"BLD",1011 1,4,340,2, 340,1,7.06 ,0)
	588	CURRENT CB S DEBT AMO UNT
	589	"BLD",1011 1,4,340,22 2)
	590	y^n^p^^^^n ^^n
	591	"BLD",1011 1,4,340,22 4)
	592
	593	"BLD",1011 1,4,341,0)
	594	341
	595	"BLD",1011 1,4,341,2, 0)
	596	^9.641^341 ^1
	597	"BLD",1011 1,4,341,2, 341,0)
	598	AR EVENT (File-top level)
	599	"BLD",1011 1,4,341,2, 341,1,0)
	600	^9.6411^6. 01^1
	601	"BLD",1011 1,4,341,2, 341,1,6.01 ,0)
	602	CCPC STATE MENT DATE
	603	"BLD",1011 1,4,341,22 2)
	604	y^n^p^^^^n ^^n
	605	"BLD",1011 1,4,341,22 4)
	606
	607	"BLD",1011 1,4,349,0)
	608	349
	609	"BLD",1011 1,4,349,2, 0)
	610	^9.641^349 ^1
	611	"BLD",1011 1,4,349,2, 349,0)
	612	AR TRANSMI SSION RECO RDS (File -top level )
	613	"BLD",1011 1,4,349,2, 349,1,0)
	614	^9.6411^.0 9^1
	615	"BLD",1011 1,4,349,2, 349,1,.09, 0)
	616	STATEMENT DATE
	617	"BLD",1011 1,4,349,22 2)
	618	y^n^p^^^^n ^^n
	619	"BLD",1011 1,4,349,22 4)
	620
	621	"BLD",1011 1,4,349.1, 0)
	622	349.1
	623	"BLD",1011 1,4,349.1, 222)
	624	y^n^f^^^^n ^^n
	625	"BLD",1011 1,4,349.1, 224)
	626
	627	"BLD",1011 1,4,349.2, 0)
	628	349.2
	629	"BLD",1011 1,4,349.2, 2,0)
	630	^9.641^349 .2^1
	631	"BLD",1011 1,4,349.2, 2,349.2,0)
	632	AR CBSS ST ATEMENTS (File-top level)
	633	"BLD",1011 1,4,349.2, 2,349.2,1, 0)
	634	^9.6411^61 ^12
	635	"BLD",1011 1,4,349.2, 2,349.2,1, .01,0)
	636	PATIENT
	637	"BLD",1011 1,4,349.2, 2,349.2,1, .02,0)
	638	SSN
	639	"BLD",1011 1,4,349.2, 2,349.2,1, .03,0)
	640	PATIENT NA ME
	641	"BLD",1011 1,4,349.2, 2,349.2,1, .12,0)
	642	INVALID ST ATEMENT ER ROR
	643	"BLD",1011 1,4,349.2, 2,349.2,1, .18,0)
	644	CBSS FILE BUILT
	645	"BLD",1011 1,4,349.2, 2,349.2,1, .19,0)
	646	PATIENT ST ATEMENT DA TE
	647	"BLD",1011 1,4,349.2, 2,349.2,1, 51,0)
	648	ERROR CODE (S)
	649	"BLD",1011 1,4,349.2, 2,349.2,1, 61,0)
	650	CBSS PRINT ED
	651	"BLD",1011 1,4,349.2, 2,349.2,1, 81,0)
	652	INTEGRATIO N CONTROL NUMBER
	653	"BLD",1011 1,4,349.2, 2,349.2,1, 82,0)
	654	ICN CHECKS UM
	655	"BLD",1011 1,4,349.2, 2,349.2,1, 83,0)
	656	AR FLAG
	657	"BLD",1011 1,4,349.2, 2,349.2,1, 84,0)
	658	DATE OF LA TEST BILL
	659	"BLD",1011 1,4,349.2, 222)
	660	y^n^p^^^^n ^^n
	661	"BLD",1011 1,4,349.2, 224)
	662
	663	"BLD",1011 1,4,349.5, 0)
	664	349.5
	665	"BLD",1011 1,4,349.5, 222)
	666	y^n^f^^^^n ^^n
	667	"BLD",1011 1,4,349.5, 224)
	668
	669	"BLD",1011 1,4,433,0)
	670	433
	671	"BLD",1011 1,4,433,2, 0)
	672	^9.641^433 ^1
	673	"BLD",1011 1,4,433,2, 433,0)
	674	AR TRANSAC TION (Fil e-top leve l)
	675	"BLD",1011 1,4,433,2, 433,1,0)
	676	^9.6411^97 ^4
	677	"BLD",1011 1,4,433,2, 433,1,94,0 )
	678	AUTO-CORRE CTION DATE
	679	"BLD",1011 1,4,433,2, 433,1,95,0 )
	680	AUTO-CORRE CTION TRAN S. AMOUNT
	681	"BLD",1011 1,4,433,2, 433,1,96,0 )
	682	AUTO-CORRE CTION TYPE OF ERROR
	683	"BLD",1011 1,4,433,2, 433,1,97,0 )
	684	AUTO-CORRE CTION TICK ET FLAG
	685	"BLD",1011 1,4,433,22 2)
	686	y^n^p^^^^n ^^n
	687	"BLD",1011 1,4,433,22 4)
	688
	689	"BLD",1011 1,4,"APDD" ,340,340)
	690
	691	"BLD",1011 1,4,"APDD" ,340,340,. 01)
	692
	693	"BLD",1011 1,4,"APDD" ,340,340,. 03)
	694
	695	"BLD",1011 1,4,"APDD" ,340,340,7 .06)
	696
	697	"BLD",1011 1,4,"APDD" ,341,341)
	698
	699	"BLD",1011 1,4,"APDD" ,341,341,6 .01)
	700
	701	"BLD",1011 1,4,"APDD" ,349,349)
	702
	703	"BLD",1011 1,4,"APDD" ,349,349,. 09)
	704
	705	"BLD",1011 1,4,"APDD" ,349.2,349 .2)
	706
	707	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.01)
	708
	709	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.02)
	710
	711	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.03)
	712
	713	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.12)
	714
	715	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.18)
	716
	717	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.19)
	718
	719	"BLD",1011 1,4,"APDD" ,349.2,349 .2,51)
	720
	721	"BLD",1011 1,4,"APDD" ,349.2,349 .2,61)
	722
	723	"BLD",1011 1,4,"APDD" ,349.2,349 .2,81)
	724
	725	"BLD",1011 1,4,"APDD" ,349.2,349 .2,82)
	726
	727	"BLD",1011 1,4,"APDD" ,349.2,349 .2,83)
	728
	729	"BLD",1011 1,4,"APDD" ,349.2,349 .2,84)
	730
	731	"BLD",1011 1,4,"APDD" ,433,433)
	732
	733	"BLD",1011 1,4,"APDD" ,433,433,9 4)
	734
	735	"BLD",1011 1,4,"APDD" ,433,433,9 5)
	736
	737	"BLD",1011 1,4,"APDD" ,433,433,9 6)
	738
	739	"BLD",1011 1,4,"APDD" ,433,433,9 7)
	740
	741	"BLD",1011 1,4,"B",34 0,340)
	742
	743	"BLD",1011 1,4,"B",34 1,341)
	744
	745	"BLD",1011 1,4,"B",34 9,349)
	746
	747	"BLD",1011 1,4,"B",34 9.1,349.1)
	748
	749	"BLD",1011 1,4,"B",34 9.2,349.2)
	750
	751	"BLD",1011 1,4,"B",34 9.5,349.5)
	752
	753	"BLD",1011 1,4,"B",43 3,433)
	754
	755	"BLD",1011 1,6)
	756	2^
	757	"BLD",1011 1,6.3)
	758	124
	759	"BLD",1011 1,"ABPKG")
	760	n
	761	"BLD",1011 1,"INI")
	762	PRE^PRCA31 3P
	763	"BLD",1011 1,"INID")
	764	^y^y
	765	"BLD",1011 1,"INIT")
	766	EN^PRCA313 P
	767	"BLD",1011 1,"KRN",0)
	768	^9.67PA^77 9.2^20
	769	"BLD",1011 1,"KRN",.4 ,0)
	770	.4
	771	"BLD",1011 1,"KRN",.4 ,"NM",0)
	772	^9.68A^^0
	773	"BLD",1011 1,"KRN",.4 01,0)
	774	.401
	775	"BLD",1011 1,"KRN",.4 02,0)
	776	.402
	777	"BLD",1011 1,"KRN",.4 02,"NM",0)
	778	^9.68A^^0
	779	"BLD",1011 1,"KRN",.4 03,0)
	780	.403
	781	"BLD",1011 1,"KRN",.5 ,0)
	782	.5
	783	"BLD",1011 1,"KRN",.8 4,0)
	784	.84
	785	"BLD",1011 1,"KRN",3. 6,0)
	786	3.6
	787	"BLD",1011 1,"KRN",3. 8,0)
	788	3.8
	789	"BLD",1011 1,"KRN",3. 8,"NM",0)
	790	^9.68A^1^1
	791	"BLD",1011 1,"KRN",3. 8,"NM",1,0 )
	792	PRCACPS^^0
	793	"BLD",1011 1,"KRN",3. 8,"NM","B" ,"PRCACPS" ,1)
	794
	795	"BLD",1011 1,"KRN",9. 2,0)
	796	9.2
	797	"BLD",1011 1,"KRN",9. 8,0)
	798	9.8
	799	"BLD",1011 1,"KRN",9. 8,"NM",0)
	800	^9.68A^29^ 22
	801	"BLD",1011 1,"KRN",9. 8,"NM",5,0 )
	802	RCCPCBJ^^0 ^B9440906
	803	"BLD",1011 1,"KRN",9. 8,"NM",7,0 )
	804	RCCPCFN1^^ 0^B7181774
	805	"BLD",1011 1,"KRN",9. 8,"NM",8,0 )
	806	RCCPCML^^0 ^B67061934
	807	"BLD",1011 1,"KRN",9. 8,"NM",9,0 )
	808	RCCPCSV^^0 ^B11825361
	809	"BLD",1011 1,"KRN",9. 8,"NM",10, 0)
	810	RCCPCPS^^0 ^B13143271 4
	811	"BLD",1011 1,"KRN",9. 8,"NM",11, 0)
	812	RCCPCPS1^^ 0^B6544337 8
	813	"BLD",1011 1,"KRN",9. 8,"NM",12, 0)
	814	RCCPCSV1^^ 0^B4331384 1
	815	"BLD",1011 1,"KRN",9. 8,"NM",13, 0)
	816	RCCPCML1^^ 0^B8980051
	817	"BLD",1011 1,"KRN",9. 8,"NM",14, 0)
	818	RCCPCSE^^0 ^B16507603
	819	"BLD",1011 1,"KRN",9. 8,"NM",15, 0)
	820	RCCPCT^^0^ B29330001
	821	"BLD",1011 1,"KRN",9. 8,"NM",17, 0)
	822	PRCAG^^0^B 74256403
	823	"BLD",1011 1,"KRN",9. 8,"NM",18, 0)
	824	PRCA313P^^ 0^B2768173 4
	825	"BLD",1011 1,"KRN",9. 8,"NM",19, 0)
	826	PRCAACR^^0 ^B12733608 1
	827	"BLD",1011 1,"KRN",9. 8,"NM",20, 0)
	828	PRCAACR1^^ 0^B1512714 41
	829	"BLD",1011 1,"KRN",9. 8,"NM",21, 0)
	830	RCCPCAP^^0 ^B43189035
	831	"BLD",1011 1,"KRN",9. 8,"NM",22, 0)
	832	RCCPCAT^^0 ^B52270242
	833	"BLD",1011 1,"KRN",9. 8,"NM",23, 0)
	834	RCCPCAR^^0 ^B47894432
	835	"BLD",1011 1,"KRN",9. 8,"NM",24, 0)
	836	RCBEADJ^^0 ^B77106309
	837	"BLD",1011 1,"KRN",9. 8,"NM",26, 0)
	838	RCDPBTLM^^ 0^B5588593 9
	839	"BLD",1011 1,"KRN",9. 8,"NM",27, 0)
	840	PRCACPS^^0 ^B25406671 6
	841	"BLD",1011 1,"KRN",9. 8,"NM",28, 0)
	842	PRCACPS1^^ 0^B1912815 8
	843	"BLD",1011 1,"KRN",9. 8,"NM",29, 0)
	844	PRCACPSA^^ 0^B3327065 3
	845	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCA313P ",18)
	846
	847	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR" ,19)
	848
	849	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR1 ",20)
	850
	851	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPS" ,27)
	852
	853	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPS1 ",28)
	854
	855	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPSA ",29)
	856
	857	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAG",1 7)
	858
	859	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCBEADJ" ,24)
	860
	861	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAP" ,21)
	862
	863	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAR" ,23)
	864
	865	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAT" ,22)
	866
	867	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCBJ" ,5)
	868
	869	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCFN1 ",7)
	870
	871	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML" ,8)
	872
	873	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML1 ",13)
	874
	875	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS" ,10)
	876
	877	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS1 ",11)
	878
	879	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSE" ,14)
	880
	881	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV" ,9)
	882
	883	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV1 ",12)
	884
	885	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCT", 15)
	886
	887	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCDPBTLM ",26)
	888
	889	"BLD",1011 1,"KRN",19 ,0)
	890	19
	891	"BLD",1011 1,"KRN",19 ,"NM",0)
	892	^9.68A^11^ 8
	893	"BLD",1011 1,"KRN",19 ,"NM",4,0)
	894	PRCA CBS N IGHTLY UPD ATE^^0
	895	"BLD",1011 1,"KRN",19 ,"NM",5,0)
	896	PRCAE FOLL OW-UP^^2
	897	"BLD",1011 1,"KRN",19 ,"NM",6,0)
	898	RCCPC APPS BUILD AND TRANS^^0
	899	"BLD",1011 1,"KRN",19 ,"NM",7,0)
	900	RCCPC APPS RETRANS^^ 0
	901	"BLD",1011 1,"KRN",19 ,"NM",8,0)
	902	RCCPC APPS DATA CHEC K^^0
	903	"BLD",1011 1,"KRN",19 ,"NM",9,0)
	904	PRCA ACCOU NT MANAGEM ENT^^2
	905	"BLD",1011 1,"KRN",19 ,"NM",10,0 )
	906	PRCA AUTOC RCT PGM^^0
	907	"BLD",1011 1,"KRN",19 ,"NM",11,0 )
	908	PRCA AUTOC RCT RPT^^0
	909	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA ACCO UNT MANAGE MENT",9)
	910
	911	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA AUTO CRCT PGM", 10)
	912
	913	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA AUTO CRCT RPT", 11)
	914
	915	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA CBS NIGHTLY UP DATE",4)
	916
	917	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCAE FOL LOW-UP",5)
	918
	919	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S BUILD AN D TRANS",6 )
	920
	921	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S DATA CHE CK",8)
	922
	923	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S RETRANS" ,7)
	924
	925	"BLD",1011 1,"KRN",19 .1,0)
	926	19.1
	927	"BLD",1011 1,"KRN",19 .1,"NM",0)
	928	^9.68A^2^2
	929	"BLD",1011 1,"KRN",19 .1,"NM",1, 0)
	930	RCCPC APPS BUILD AND TRANS^^0
	931	"BLD",1011 1,"KRN",19 .1,"NM",2, 0)
	932	PRCA AUTOC RCT PGM^^0
	933	"BLD",1011 1,"KRN",19 .1,"NM","B ","PRCA AU TOCRCT PGM ",2)
	934
	935	"BLD",1011 1,"KRN",19 .1,"NM","B ","RCCPC A PPS BUILD AND TRANS" ,1)
	936
	937	"BLD",1011 1,"KRN",10 1,0)
	938	101
	939	"BLD",1011 1,"KRN",40 9.61,0)
	940	409.61
	941	"BLD",1011 1,"KRN",77 1,0)
	942	771
	943	"BLD",1011 1,"KRN",77 9.2,0)
	944	779.2
	945	"BLD",1011 1,"KRN",87 0,0)
	946	870
	947	"BLD",1011 1,"KRN",89 89.51,0)
	948	8989.51
	949	"BLD",1011 1,"KRN",89 89.52,0)
	950	8989.52
	951	"BLD",1011 1,"KRN",89 94,0)
	952	8994
	953	"BLD",1011 1,"KRN","B ",.4,.4)
	954
	955	"BLD",1011 1,"KRN","B ",.401,.40 1)
	956
	957	"BLD",1011 1,"KRN","B ",.402,.40 2)
	958
	959	"BLD",1011 1,"KRN","B ",.403,.40 3)
	960
	961	"BLD",1011 1,"KRN","B ",.5,.5)
	962
	963	"BLD",1011 1,"KRN","B ",.84,.84)
	964
	965	"BLD",1011 1,"KRN","B ",3.6,3.6)
	966
	967	"BLD",1011 1,"KRN","B ",3.8,3.8)
	968
	969	"BLD",1011 1,"KRN","B ",9.2,9.2)
	970
	971	"BLD",1011 1,"KRN","B ",9.8,9.8)
	972
	973	"BLD",1011 1,"KRN","B ",19,19)
	974
	975	"BLD",1011 1,"KRN","B ",19.1,19. 1)
	976
	977	"BLD",1011 1,"KRN","B ",101,101)
	978
	979	"BLD",1011 1,"KRN","B ",409.61,4 09.61)
	980
	981	"BLD",1011 1,"KRN","B ",771,771)
	982
	983	"BLD",1011 1,"KRN","B ",779.2,77 9.2)
	984
	985	"BLD",1011 1,"KRN","B ",870,870)
	986
	987	"BLD",1011 1,"KRN","B ",8989.51, 8989.51)
	988
	989	"BLD",1011 1,"KRN","B ",8989.52, 8989.52)
	990
	991	"BLD",1011 1,"KRN","B ",8994,899 4)
	992
	993	"BLD",1011 1,"QDEF")
	994	^^^^^^^^YE S^^YES
	995	"BLD",1011 1,"QUES",0 )
	996	^9.62^^
	997	"BLD",1011 1,"REQB",0 )
	998	^9.611^7^7
	999	"BLD",1011 1,"REQB",1 ,0)
	1000	PRCA4.53 07^2
	1001	"BLD",1011 1,"REQB",2 ,0)
	1002	XMDB1.00 ^2
	1003	"BLD",1011 1,"REQB",3 ,0)
	1004	PRCA4.52 37^2
	1005	"BLD",1011 1,"REQB",4 ,0)
	1006	PRCA4.52 33^2
	1007	"BLD",1011 1,"REQB",5 ,0)
	1008	PRCA4.53 09^2
	1009	"BLD",1011 1,"REQB",6 ,0)
	1010	PRCA4.52 76^2
	1011	"BLD",1011 1,"REQB",7 ,0)
	1012	PRCA4.53 01^2
	1013	"BLD",1011 1,"REQB"," B","PRCA4 .5233",4)
	1014
	1015	"BLD",1011 1,"REQB"," B","PRCA4 .5237",3)
	1016
	1017	"BLD",1011 1,"REQB"," B","PRCA4 .5276",6)
	1018
	1019	"BLD",1011 1,"REQB"," B","PRCA4 .5301",7)
	1020
	1021	"BLD",1011 1,"REQB"," B","PRCA4 .5307",1)
	1022
	1023	"BLD",1011 1,"REQB"," B","PRCA4 .5309",5)
	1024
	1025	"BLD",1011 1,"REQB"," B","XMDB1 .00",2)
	1026
	1027	"FIA",340)
	1028	AR DEBTOR
	1029	"FIA",340, 0)
	1030	^RCD(340,
	1031	"FIA",340, 0,0)
	1032	340V
	1033	"FIA",340, 0,1)
	1034	y^n^p^^^^n ^^n
	1035	"FIA",340, 0,10)
	1036
	1037	"FIA",340, 0,11)
	1038
	1039	"FIA",340, 0,"RLRO")
	1040
	1041	"FIA",340, 0,"VR")
	1042	4.5^PRCA
	1043	"FIA",340, 340)
	1044	1
	1045	"FIA",340, 340,.01)
	1046
	1047	"FIA",340, 340,.03)
	1048
	1049	"FIA",340, 340,7.06)
	1050
	1051	"FIA",341)
	1052	AR EVENT
	1053	"FIA",341, 0)
	1054	^RC(341,
	1055	"FIA",341, 0,0)
	1056	341I
	1057	"FIA",341, 0,1)
	1058	y^n^p^^^^n ^^n
	1059	"FIA",341, 0,10)
	1060
	1061	"FIA",341, 0,11)
	1062
	1063	"FIA",341, 0,"RLRO")
	1064
	1065	"FIA",341, 0,"VR")
	1066	4.5^PRCA
	1067	"FIA",341, 341)
	1068	1
	1069	"FIA",341, 341,6.01)
	1070
	1071	"FIA",349)
	1072	AR TRANSMI SSION RECO RDS
	1073	"FIA",349, 0)
	1074	^RCT(349,
	1075	"FIA",349, 0,0)
	1076	349I
	1077	"FIA",349, 0,1)
	1078	y^n^p^^^^n ^^n
	1079	"FIA",349, 0,10)
	1080
	1081	"FIA",349, 0,11)
	1082
	1083	"FIA",349, 0,"RLRO")
	1084
	1085	"FIA",349, 0,"VR")
	1086	4.5^PRCA
	1087	"FIA",349, 349)
	1088	1
	1089	"FIA",349, 349,.09)
	1090
	1091	"FIA",349. 1)
	1092	AR TRANSMI SSION TYPE
	1093	"FIA",349. 1,0)
	1094	^RCT(349.1 ,
	1095	"FIA",349. 1,0,0)
	1096	349.1I
	1097	"FIA",349. 1,0,1)
	1098	y^n^f^^^^n ^^n
	1099	"FIA",349. 1,0,10)
	1100
	1101	"FIA",349. 1,0,11)
	1102
	1103	"FIA",349. 1,0,"RLRO" )
	1104
	1105	"FIA",349. 1,0,"VR")
	1106	4.5^PRCA
	1107	"FIA",349. 1,349.1)
	1108	0
	1109	"FIA",349. 1,349.11)
	1110	0
	1111	"FIA",349. 1,349.12)
	1112	0
	1113	"FIA",349. 1,349.141)
	1114	0
	1115	"FIA",349. 1,349.151)
	1116	0
	1117	"FIA",349. 1,349.161)
	1118	0
	1119	"FIA",349. 2)
	1120	AR CBSS ST ATEMENTS
	1121	"FIA",349. 2,0)
	1122	^RCPS(349. 2,
	1123	"FIA",349. 2,0,0)
	1124	349.2I
	1125	"FIA",349. 2,0,1)
	1126	y^n^p^^^^n ^^n
	1127	"FIA",349. 2,0,10)
	1128
	1129	"FIA",349. 2,0,11)
	1130
	1131	"FIA",349. 2,0,"RLRO" )
	1132
	1133	"FIA",349. 2,0,"VR")
	1134	4.5^PRCA
	1135	"FIA",349. 2,349.2)
	1136	1
	1137	"FIA",349. 2,349.2,.0 1)
	1138
	1139	"FIA",349. 2,349.2,.0 2)
	1140
	1141	"FIA",349. 2,349.2,.0 3)
	1142
	1143	"FIA",349. 2,349.2,.1 2)
	1144
	1145	"FIA",349. 2,349.2,.1 8)
	1146
	1147	"FIA",349. 2,349.2,.1 9)
	1148
	1149	"FIA",349. 2,349.2,51 )
	1150
	1151	"FIA",349. 2,349.2,61 )
	1152
	1153	"FIA",349. 2,349.2,81 )
	1154
	1155	"FIA",349. 2,349.2,82 )
	1156
	1157	"FIA",349. 2,349.2,83 )
	1158
	1159	"FIA",349. 2,349.2,84 )
	1160
	1161	"FIA",349. 5)
	1162	AR ANNUAL PAYMENT ST ATEMENT
	1163	"FIA",349. 5,0)
	1164	^RCAP(349. 5,
	1165	"FIA",349. 5,0,0)
	1166	349.5
	1167	"FIA",349. 5,0,1)
	1168	y^n^f^^^^n ^^n
	1169	"FIA",349. 5,0,10)
	1170
	1171	"FIA",349. 5,0,11)
	1172
	1173	"FIA",349. 5,0,"RLRO" )
	1174
	1175	"FIA",349. 5,0,"VR")
	1176	4.5^PRCA
	1177	"FIA",349. 5,349.5)
	1178	0
	1179	"FIA",349. 5,349.51)
	1180	0
	1181	"FIA",433)
	1182	AR TRANSAC TION
	1183	"FIA",433, 0)
	1184	^PRCA(433,
	1185	"FIA",433, 0,0)
	1186	433NI
	1187	"FIA",433, 0,1)
	1188	y^n^p^^^^n ^^n
	1189	"FIA",433, 0,10)
	1190
	1191	"FIA",433, 0,11)
	1192
	1193	"FIA",433, 0,"RLRO")
	1194
	1195	"FIA",433, 0,"VR")
	1196	4.5^PRCA
	1197	"FIA",433, 433)
	1198	1
	1199	"FIA",433, 433,94)
	1200
	1201	"FIA",433, 433,95)
	1202
	1203	"FIA",433, 433,96)
	1204
	1205	"FIA",433, 433,97)
	1206
	1207	"INI")
	1208	PRE^PRCA31 3P
	1209	"INIT")
	1210	EN^PRCA313 P
	1211	"IX",349,3 49,"SDT",0 )
	1212	349^SDT^Pa tient Stat ement Day of the Mon th^R^^F^IR ^I^349^^^^ ^LS
	1213	"IX",349,3 49,"SDT",. 1,0)
	1214	^^1^1^3161 007^
	1215	"IX",349,3 49,"SDT",. 1,1,0)
	1216	This cross -reference is the Pa tient Stat ement Day of the Mon th.
	1217	"IX",349,3 49,"SDT",1 )
	1218	S ^RCT(349 ,"SDT",$E( X,1,2),DA) =""
	1219	"IX",349,3 49,"SDT",2 )
	1220	K ^RCT(349 ,"SDT",$E( X,1,2),DA)
	1221	"IX",349,3 49,"SDT",2 .5)
	1222	K ^RCT(349 ,"SDT")
	1223	"IX",349,3 49,"SDT",1 1.1,0)
	1224	^.114IA^1^ 1
	1225	"IX",349,3 49,"SDT",1 1.1,1,0)
	1226	1^F^349^.0 9^2^1^F
	1227	"IX",349,3 49,"SDT",1 1.1,1,2)
	1228	S X=+$E(X, 6,7)
	1229	"IX",349.1 ,349.141," STDT4",0)
	1230	349.141^ST DT4^Patien t Statemen t Date and Last Mess age ACK^R^ ^R^IR^I^34 9.141^^^^
	1231	^LS
	1232	"IX",349.1 ,349.141," STDT4",.1, 0)
	1233	^^2^2^3161 007^
	1234	"IX",349.1 ,349.141," STDT4",.1, 1,0)
	1235	This cross -reference is used t o sort by the Patien t Statemen t Date and the
	1236	"IX",349.1 ,349.141," STDT4",.1, 2,0)
	1237	Last Messa ge ACK.
	1238	"IX",349.1 ,349.141," STDT4",1)
	1239	S ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)=" "
	1240	"IX",349.1 ,349.141," STDT4",2)
	1241	K ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)
	1242	"IX",349.1 ,349.141," STDT4",2.5 )
	1243	K ^RCT(349 .1,DA(1),4 ,"STDT4")
	1244	"IX",349.1 ,349.141," STDT4",11. 1,0)
	1245	^.114IA^2^ 2
	1246	"IX",349.1 ,349.141," STDT4",11. 1,1,0)
	1247	1^F^349.14 1^.04^7^1^ F
	1248	"IX",349.1 ,349.141," STDT4",11. 1,1,3)
	1249
	1250	"IX",349.1 ,349.141," STDT4",11. 1,2,0)
	1251	2^F^349.14 1^.01^3^2^ F
	1252	"IX",349.1 ,349.141," STDT4",11. 1,2,3)
	1253
	1254	"IX",349.1 ,349.151," STDT5",0)
	1255	349.151^ST DT5^Patien t Statemen t Date Ind ex^R^^F^IR ^I^349.151 ^^^^^LS
	1256	"IX",349.1 ,349.151," STDT5",.1, 0)
	1257	^^1^1^3161 006^
	1258	"IX",349.1 ,349.151," STDT5",.1, 1,0)
	1259	This cross -reference is used t o sort by the Patien t Statemen t Date.
	1260	"IX",349.1 ,349.151," STDT5",1)
	1261	S ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)=""
	1262	"IX",349.1 ,349.151," STDT5",2)
	1263	K ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)
	1264	"IX",349.1 ,349.151," STDT5",2.5 )
	1265	K ^RCT(349 .1,DA(1),5 ,"STDT5")
	1266	"IX",349.1 ,349.151," STDT5",11. 1,0)
	1267	^.114IA^1^ 1
	1268	"IX",349.1 ,349.151," STDT5",11. 1,1,0)
	1269	1^F^349.15 1^.04^7^1^ F
	1270	"IX",349.2 ,349.2,"AD ",0)
	1271	349.2^AD^P atient Sta tement Err ors^R^^F^I R^I^349.2^ ^^^^S
	1272	"IX",349.2 ,349.2,"AD ",.1,0)
	1273	^^2^2^3161 007^
	1274	"IX",349.2 ,349.2,"AD ",.1,1,0)
	1275	This is th e cross-re ference to find pati ent statem ent errors that are
	1276	"IX",349.2 ,349.2,"AD ",.1,2,0)
	1277	returned f rom CBSS.
	1278	"IX",349.2 ,349.2,"AD ",1)
	1279	S ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)=""
	1280	"IX",349.2 ,349.2,"AD ",2)
	1281	K ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)
	1282	"IX",349.2 ,349.2,"AD ",2.5)
	1283	K ^RCPS(34 9.2,"AD")
	1284	"IX",349.2 ,349.2,"AD ",11.1,0)
	1285	^.114IA^1^ 1
	1286	"IX",349.2 ,349.2,"AD ",11.1,1,0 )
	1287	1^F^349.2^ 51^1^1^F
	1288	"IX",349.2 ,349.2,"AD ",11.1,1,1 )
	1289
	1290	"IX",349.2 ,349.2,"AD ",11.1,1,2 )
	1291	S X="E"
	1292	"IX",349.2 ,349.2,"ST DT",0)
	1293	349.2^STDT ^Patient S tatement D ate^R^^F^I R^I^349.2^ ^^^^LS
	1294	"IX",349.2 ,349.2,"ST DT",.1,0)
	1295	^^2^2^3161 007^
	1296	"IX",349.2 ,349.2,"ST DT",.1,1,0 )
	1297	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	1298	"IX",349.2 ,349.2,"ST DT",.1,2,0 )
	1299	standardly two days after the statement is transmi tted.
	1300	"IX",349.2 ,349.2,"ST DT",1)
	1301	S ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)=""
	1302	"IX",349.2 ,349.2,"ST DT",2)
	1303	K ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)
	1304	"IX",349.2 ,349.2,"ST DT",2.5)
	1305	K ^RCPS(34 9.2,"STDT" )
	1306	"IX",349.2 ,349.2,"ST DT",11.1,0 )
	1307	^.114IA^1^ 1
	1308	"IX",349.2 ,349.2,"ST DT",11.1,1 ,0)
	1309	1^F^349.2^ .19^7^1^F
	1310	"IX",433,4 33,"TACD", 0)
	1311	433^TACD^T he date th at this tr ansaction was correc ted by the Auto-Corr ection Pr
	1312	ogram.^R^^ F^IR^I^433 ^^^^^LS
	1313	"IX",433,4 33,"TACD", .1,0)
	1314	^^2^2^3160 920^
	1315	"IX",433,4 33,"TACD", .1,1,0)
	1316	The is the date that the Patie nt Stateme nt Auto-Co rrection P rogram
	1317	"IX",433,4 33,"TACD", .1,2,0)
	1318	corrected the statem ent discre pancy for this trans action.
	1319	"IX",433,4 33,"TACD", 1)
	1320	S ^PRCA(43 3,"TACD",$ E(X,1,7),D A)=""
	1321	"IX",433,4 33,"TACD", 2)
	1322	K ^PRCA(43 3,"TACD",$ E(X,1,7),D A)
	1323	"IX",433,4 33,"TACD", 2.5)
	1324	K ^PRCA(43 3,"TACD")
	1325	"IX",433,4 33,"TACD", 11.1,0)
	1326	^.114IA^1^ 1
	1327	"IX",433,4 33,"TACD", 11.1,1,0)
	1328	1^F^433^94 ^7^1^F
	1329	"IX",433,4 33,"TACD", "NOREINDEX ")
	1330	1
	1331	"KRN",3.8, 322,-1)
	1332	0^1
	1333	"KRN",3.8, 322,0)
	1334	PRCACPS^PU ^^^^^
	1335	"KRN",3.8, 322,2,0)
	1336	^3.801^2^2 ^3160406^^ ^
	1337	"KRN",3.8, 322,2,1,0)
	1338	This mail group will receive a notificat ion when t he Consoli dated
	1339	"KRN",3.8, 322,2,2,0)
	1340	Patient St atement Au to-Correct ion progra m has comp leted.
	1341	"KRN",3.8, 322,3)
	1342
	1343	"KRN",19,3 026,-1)
	1344	2^5
	1345	"KRN",19,3 026,0)
	1346	PRCAE FOLL OW-UP^Foll ow-up Lett er Menu^^M ^1^^^^^^^5 3
	1347	"KRN",19,3 026,10,0)
	1348	^19.01IP^1 9^15
	1349	"KRN",19,3 026,10,17, 0)
	1350	11666^^14
	1351	"KRN",19,3 026,10,17, "^")
	1352	RCCPC APPS BUILD AND TRANS
	1353	"KRN",19,3 026,10,18, 0)
	1354	11667^^15
	1355	"KRN",19,3 026,10,18, "^")
	1356	RCCPC APPS RETRANS
	1357	"KRN",19,3 026,10,19, 0)
	1358	11668^^16
	1359	"KRN",19,3 026,10,19, "^")
	1360	RCCPC APPS DATA CHEC K
	1361	"KRN",19,3 026,"U")
	1362	FOLLOW-UP LETTER MEN U
	1363	"KRN",19,3 126,-1)
	1364	2^9
	1365	"KRN",19,3 126,0)
	1366	PRCA ACCOU NT MANAGEM ENT^Accoun t Manageme nt^^M^1^^^ ^^^^53
	1367	"KRN",19,3 126,10,0)
	1368	^19.01IP^2 1^20
	1369	"KRN",19,3 126,10,18, 0)
	1370	11669^^2
	1371	"KRN",19,3 126,10,18, "^")
	1372	PRCA AUTOC RCT PGM
	1373	"KRN",19,3 126,10,19, 0)
	1374	11670^^1
	1375	"KRN",19,3 126,10,19, "^")
	1376	PRCA AUTOC RCT RPT
	1377	"KRN",19,3 126,10,21, 0)
	1378	11657^^3
	1379	"KRN",19,3 126,10,21, "^")
	1380	PRCA CBS N IGHTLY UPD ATE
	1381	"KRN",19,3 126,"U")
	1382	ACCOUNT MA NAGEMENT
	1383	"KRN",19,1 1657,-1)
	1384	0^4
	1385	"KRN",19,1 1657,0)
	1386	PRCA CBS N IGHTLY UPD ATE^CBS Ni ghtly Acco unt Update Program^^ R^^^^^^^^
	1387	"KRN",19,1 1657,1,0)
	1388	^^2^2^3160 622^
	1389	"KRN",19,1 1657,1,1,0 )
	1390	This optio n runs the Consolida ted Billin g System
	1391	"KRN",19,1 1657,1,2,0 )
	1392	Nightly Ac count Upda te program .
	1393	"KRN",19,1 1657,25)
	1394	ENTER^PRCA CPS1
	1395	"KRN",19,1 1657,"U")
	1396	CBS NIGHTL Y ACCOUNT UPDATE PRO
	1397	"KRN",19,1 1666,-1)
	1398	0^6
	1399	"KRN",19,1 1666,0)
	1400	RCCPC APPS BUILD AND TRANS^Bui ld and Tra nsmit Annu al Payment File^^A^^ RCCPC APP
	1401	S BUILD AN D TRANS^^^ ^^^^^1
	1402	"KRN",19,1 1666,1,0)
	1403	^19.06^3^3 ^3170502^^ ^
	1404	"KRN",19,1 1666,1,1,0 )
	1405	This optio n will bui ld the Ann ual Paymen t Statemen t file for the previ ous
	1406	"KRN",19,1 1666,1,2,0 )
	1407	year for e very patie nt who has one or mo re payment s in the p revious ye ar
	1408	"KRN",19,1 1666,1,3,0 )
	1409	and transm it the fil e to AITC.
	1410	"KRN",19,1 1666,20)
	1411	D MANBLD^R CCPCAT
	1412	"KRN",19,1 1666,"U")
	1413	BUILD AND TRANSMIT A NNUAL PAYM
	1414	"KRN",19,1 1667,-1)
	1415	0^7
	1416	"KRN",19,1 1667,0)
	1417	RCCPC APPS RETRANS^R etransmit Current An nual Payme nt File^^A ^^RCCPC AP PS BUILD
	1418	AND TRANS^ ^^^^^^^1
	1419	"KRN",19,1 1667,1,0)
	1420	^19.06^3^3 ^3170502^^ ^^
	1421	"KRN",19,1 1667,1,1,0 )
	1422	This optio n should o nly to be used when AITC has r equested t he current
	1423	"KRN",19,1 1667,1,2,0 )
	1424	Annual Pay ment State ment file be retrans mitted. Th is file wi ll include
	1425	"KRN",19,1 1667,1,3,0 )
	1426	every pati ent who ha s one or m ore paymen ts in the previous y ear.
	1427	"KRN",19,1 1667,20)
	1428	D RETRANS^ RCCPCAT
	1429	"KRN",19,1 1667,"U")
	1430	RETRANSMIT CURRENT A NNUAL PAYM
	1431	"KRN",19,1 1668,-1)
	1432	0^8
	1433	"KRN",19,1 1668,0)
	1434	RCCPC APPS DATA CHEC K^Annual P ayment Fil e Consiste ncy Check^ ^A^^^^^^^^ ^^1
	1435	"KRN",19,1 1668,1,0)
	1436	^^5^5^3170 321^
	1437	"KRN",19,1 1668,1,1,0 )
	1438	AR data is extracted from the VistA site s and is s ent to CBS S who then
	1439	"KRN",19,1 1668,1,2,0 )
	1440	consolidat es the dat a into the annual pa yment stat ement. The VistA dat a
	1441	"KRN",19,1 1668,1,3,0 )
	1442	needs to b e validate d prior to its trans mission. T his menu o ption will
	1443	"KRN",19,1 1668,1,4,0 )
	1444	produce a report det ailing whi ch APPS da ta needs t o be revie wed and
	1445	"KRN",19,1 1668,1,5,0 )
	1446	updated pr ior to its transmiss ion to CBS S.
	1447	"KRN",19,1 1668,20)
	1448	D MANBLD^R CCPCAR
	1449	"KRN",19,1 1668,"U")
	1450	ANNUAL PAY MENT FILE CONSISTENC
	1451	"KRN",19,1 1669,-1)
	1452	0^10
	1453	"KRN",19,1 1669,0)
	1454	PRCA AUTOC RCT PGM^Pa tient Stat ement Auto -Correctio n Program^ ^R^^PRCA A UTOCRCT P
	1455	GM^^^^^^
	1456	"KRN",19,1 1669,1,0)
	1457	^^2^2^3170 518^
	1458	"KRN",19,1 1669,1,1,0 )
	1459	This optio n runs the Auto-Corr ection pro gram for P atient Sta tement
	1460	"KRN",19,1 1669,1,2,0 )
	1461	discrepanc ies.
	1462	"KRN",19,1 1669,25)
	1463	BEGIN^PRCA CPS
	1464	"KRN",19,1 1669,"U")
	1465	PATIENT ST ATEMENT AU TO-CORRECT
	1466	"KRN",19,1 1670,-1)
	1467	0^11
	1468	"KRN",19,1 1670,0)
	1469	PRCA AUTOC RCT RPT^Au to-Correct Patient D iscrepancy Report^^R ^^^^^^^^
	1470	"KRN",19,1 1670,1,0)
	1471	^^2^2^3170 518^
	1472	"KRN",19,1 1670,1,1,0 )
	1473	This optio n runs the Auto-Corr ection Pat ient Discr epancy Rep ort for
	1474	"KRN",19,1 1670,1,2,0 )
	1475	correction s made by the Patien t Statemen t Auto-Cor rection Pr ogram.
	1476	"KRN",19,1 1670,25)
	1477	PSACRT^PRC AACR
	1478	"KRN",19,1 1670,"U")
	1479	AUTO-CORRE CT PATIENT DISCREPAN
	1480	"KRN",19.1 ,598,-1)
	1481	0^2
	1482	"KRN",19.1 ,598,0)
	1483	PRCA AUTOC RCT PGM
	1484	"KRN",19.1 ,598,1,0)
	1485	^19.11^3^3 ^3170515^^ ^^
	1486	"KRN",19.1 ,598,1,1,0 )
	1487	This is a key for th e AR optio n 'PRCA AU TOCRCT PGM '.
	1488	"KRN",19.1 ,598,1,2,0 )
	1489	The 'PRCA AUTOCRCT P GM' option runs the Consolidat ed
	1490	"KRN",19.1 ,598,1,3,0 )
	1491	Patient St atement Au to-Correct ion progra m.
	1492	"KRN",19.1 ,600,-1)
	1493	0^1
	1494	"KRN",19.1 ,600,0)
	1495	RCCPC APPS BUILD AND TRANS
	1496	"KRN",19.1 ,600,1,0)
	1497	^^8^8^3170 502^
	1498	"KRN",19.1 ,600,1,1,0 )
	1499	This is a key for th e AR menu options 'R CCPC APPS BUILD AND TRANS' and
	1500	"KRN",19.1 ,600,1,2,0 )
	1501	'RCCPC APP S RETRANS' .
	1502	"KRN",19.1 ,600,1,3,0 )
	1503
	1504	"KRN",19.1 ,600,1,4,0 )
	1505	The 'RCCPC APPS BUIL D AND TRAN S' option runs the A nnual Paym ent Statem ent
	1506	"KRN",19.1 ,600,1,5,0 )
	1507	File Build and Trans mit for th e previous year and sends the data to AI TC.
	1508	"KRN",19.1 ,600,1,6,0 )
	1509
	1510	"KRN",19.1 ,600,1,7,0 )
	1511	The 'RCCPC APPS RETR ANS' optio n Re-Trans mits the c urrent Ann ual Paymen t
	1512	"KRN",19.1 ,600,1,8,0 )
	1513	Statement File data to AITC.
	1514	"MBREQ")
	1515	0
	1516	"ORD",3,19 .1)
	1517	19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1
	1518	"ORD",3,19 .1,0)
	1519	SECURITY K EY
	1520	"ORD",11,3 .8)
	1521	3.8;11;;;M AILG^XPDTA 1;MAILGF1^ XPDIA1;MAI LGE1^XPDIA 1;MAILGF2^ XPDIA1;;MA ILGDEL^XP
	1522	DIA1(%)
	1523	"ORD",11,3 .8,0)
	1524	MAIL GROUP
	1525	"ORD",18,1 9)
	1526	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	1527	"ORD",18,1 9,0)
	1528	OPTION
	1529	"PKG",53,- 1)
	1530	1^1
	1531	"PKG",53,0 )
	1532	ACCOUNTS R ECEIVABLE^ PRCA^FMS
	1533	"PKG",53,2 0,0)
	1534	^9.402P^1^ 1
	1535	"PKG",53,2 0,1,0)
	1536	2^^PRCAMRG
	1537	"PKG",53,2 0,1,1)
	1538
	1539	"PKG",53,2 0,"B",2,1)
	1540
	1541	"PKG",53,2 2,0)
	1542	^9.49I^1^1
	1543	"PKG",53,2 2,1,0)
	1544	4.5^305111 9^2960627
	1545	"PKG",53,2 2,1,"PAH", 1,0)
	1546	313^317080 2^85
	1547	"PKG",53,2 2,1,"PAH", 1,1,0)
	1548	^^1^1^3170 802
	1549	"PKG",53,2 2,1,"PAH", 1,1,1,0)
	1550	Consolidat ed Patient Statement
	1551	"QUES","XP F1",0)
	1552	Y
	1553	"QUES","XP F1","??")
	1554	^D REP^XPD H
	1555	"QUES","XP F1","A")
	1556	Shall I wr ite over y our \|FLAG\| File
	1557	"QUES","XP F1","B")
	1558	YES
	1559	"QUES","XP F1","M")
	1560	D XPF1^XPD IQ
	1561	"QUES","XP F2",0)
	1562	Y
	1563	"QUES","XP F2","??")
	1564	^D DTA^XPD H
	1565	"QUES","XP F2","A")
	1566	Want my da ta \|FLAG\| yours
	1567	"QUES","XP F2","B")
	1568	YES
	1569	"QUES","XP F2","M")
	1570	D XPF2^XPD IQ
	1571	"QUES","XP I1",0)
	1572	YO
	1573	"QUES","XP I1","??")
	1574	^D INHIBIT ^XPDH
	1575	"QUES","XP I1","A")
	1576	Want KIDS to INHIBIT LOGONs du ring the i nstall
	1577	"QUES","XP I1","B")
	1578	NO
	1579	"QUES","XP I1","M")
	1580	D XPI1^XPD IQ
	1581	"QUES","XP M1",0)
	1582	PO^VA(200, :EM
	1583	"QUES","XP M1","??")
	1584	^D MG^XPDH
	1585	"QUES","XP M1","A")
	1586	Enter the Coordinato r for Mail Group '\|F LAG\|'
	1587	"QUES","XP M1","B")
	1588
	1589	"QUES","XP M1","M")
	1590	D XPM1^XPD IQ
	1591	"QUES","XP O1",0)
	1592	Y
	1593	"QUES","XP O1","??")
	1594	^D MENU^XP DH
	1595	"QUES","XP O1","A")
	1596	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	1597	"QUES","XP O1","B")
	1598	YES
	1599	"QUES","XP O1","M")
	1600	D XPO1^XPD IQ
	1601	"QUES","XP Z1",0)
	1602	Y
	1603	"QUES","XP Z1","??")
	1604	^D OPT^XPD H
	1605	"QUES","XP Z1","A")
	1606	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	1607	"QUES","XP Z1","B")
	1608	YES
	1609	"QUES","XP Z1","M")
	1610	D XPZ1^XPD IQ
	1611	"QUES","XP Z2",0)
	1612	Y
	1613	"QUES","XP Z2","??")
	1614	^D RTN^XPD H
	1615	"QUES","XP Z2","A")
	1616	Want to MO VE routine s to other CPUs
	1617	"QUES","XP Z2","B")
	1618	NO
	1619	"QUES","XP Z2","M")
	1620	D XPZ2^XPD IQ
	1621	"RTN")
	1622	22
	1623	"RTN","PRC A313P")
	1624	0^18^B2768 1734^n/a
	1625	"RTN","PRC A313P",1,0 )
	1626	PRCA313P ; ALB/BDB - PATCH PRCA 4.5313 P OST-INSTAL L ROUTINE ; 11/2/15 4:15pm
	1627	"RTN","PRC A313P",2,0 )
	1628	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 124
	1629	"RTN","PRC A313P",3,0 )
	1630	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1631	"RTN","PRC A313P",4,0 )
	1632	; This ro utine queu es the Pat ient State ment Auto- Correction Program
	1633	"RTN","PRC A313P",5,0 )
	1634	;
	1635	"RTN","PRC A313P",6,0 )
	1636	Q
	1637	"RTN","PRC A313P",7,0 )
	1638	EN ;Entry point for PRCA4.53 13 post-in stall
	1639	"RTN","PRC A313P",8,0 )
	1640	;
	1641	"RTN","PRC A313P",9,0 )
	1642	; Queue t he Patient Statement Auto-Corr ection Pro gram
	1643	"RTN","PRC A313P",10, 0)
	1644	D PRCACPS
	1645	"RTN","PRC A313P",11, 0)
	1646	; Delete DD previou s monthly data
	1647	"RTN","PRC A313P",12, 0)
	1648	D CLEANUP
	1649	"RTN","PRC A313P",13, 0)
	1650	; Set Pat ient State ment days
	1651	"RTN","PRC A313P",14, 0)
	1652	D STDT
	1653	"RTN","PRC A313P",15, 0)
	1654	; Set AR Transactio n Types
	1655	"RTN","PRC A313P",16, 0)
	1656	D SET3491
	1657	"RTN","PRC A313P",17, 0)
	1658	;
	1659	"RTN","PRC A313P",18, 0)
	1660	Q
	1661	"RTN","PRC A313P",19, 0)
	1662	;
	1663	"RTN","PRC A313P",20, 0)
	1664	STDT ; En try point for PRCA4 .5313 set of Patien t Statemen t date dep endent up
	1665	on the Pat ient Last Name
	1666	"RTN","PRC A313P",21, 0)
	1667	D BMES^XP DUTL("Star ting Patie nt Stateme nt Date Re set.")
	1668	"RTN","PRC A313P",22, 0)
	1669	N DEBT,DI E
	1670	"RTN","PRC A313P",23, 0)
	1671	S DIE="^R CD(340,"
	1672	"RTN","PRC A313P",24, 0)
	1673	S DEBT=""
	1674	"RTN","PRC A313P",25, 0)
	1675	F S DEBT =$O(^RCD(3 40,"AB","D PT(",DEBT) ) Q:DEBT=" " D
	1676	"RTN","PRC A313P",26, 0)
	1677	. N PAT,D PT,NAME,DA ,DR
	1678	"RTN","PRC A313P",27, 0)
	1679	. S PAT=$ P($G(^RCD( 340,DEBT,0 )),U)
	1680	"RTN","PRC A313P",28, 0)
	1681	. S DPT=$ P(PAT,";", 1)
	1682	"RTN","PRC A313P",29, 0)
	1683	. S NAME= $P($G(^DPT (DPT,0)),U )
	1684	"RTN","PRC A313P",30, 0)
	1685	. S DA=DE BT
	1686	"RTN","PRC A313P",31, 0)
	1687	. S DR=". 03////"_+$ $ACSET^RCC PCFN1(NAME )
	1688	"RTN","PRC A313P",32, 0)
	1689	. D ^DIE
	1690	"RTN","PRC A313P",33, 0)
	1691	;
	1692	"RTN","PRC A313P",34, 0)
	1693	; Set cro ss-referen ce in AR E vent (341) if Patien t Statemen t date exi sts
	1694	"RTN","PRC A313P",35, 0)
	1695	N DA,DIK
	1696	"RTN","PRC A313P",36, 0)
	1697	S DIK="^R C(341,"
	1698	"RTN","PRC A313P",37, 0)
	1699	S DA="" F S DA=$O( ^RC(341,DA )) Q:DA="" I $G(^RC (341,DA,6) )'="" D IX 1^DIK
	1700	"RTN","PRC A313P",38, 0)
	1701	;
	1702	"RTN","PRC A313P",39, 0)
	1703	D BMES^XP DUTL("Pati ent Statem ent Date R eset Compl ete.")
	1704	"RTN","PRC A313P",40, 0)
	1705	Q
	1706	"RTN","PRC A313P",41, 0)
	1707	;
	1708	"RTN","PRC A313P",42, 0)
	1709	CLEANUP ; PRCA4.5 313
	1710	"RTN","PRC A313P",43, 0)
	1711	; Remove site state ment date
	1712	"RTN","PRC A313P",44, 0)
	1713	D BMES^XP DUTL("Star ting Patie nt Stateme nt Cleanup .")
	1714	"RTN","PRC A313P",45, 0)
	1715	N DA,DR,D IE,X,RCT
	1716	"RTN","PRC A313P",46, 0)
	1717	S DA=1
	1718	"RTN","PRC A313P",47, 0)
	1719	S DR=".11 ///@"
	1720	"RTN","PRC A313P",48, 0)
	1721	S DIE="^R C(342,"
	1722	"RTN","PRC A313P",49, 0)
	1723	D ^DIE
	1724	"RTN","PRC A313P",50, 0)
	1725	;
	1726	"RTN","PRC A313P",51, 0)
	1727	; Remove all monthl y data
	1728	"RTN","PRC A313P",52, 0)
	1729	S DIK="^R CT(349,"
	1730	"RTN","PRC A313P",53, 0)
	1731	S DA=0 F S DA=$O(^ RCT(349,DA )) Q:DA="" D ^DIK
	1732	"RTN","PRC A313P",54, 0)
	1733	S ^RCT(34 9,0)="AR T RANSMISSIO N RECORDS^ 349I^^"
	1734	"RTN","PRC A313P",55, 0)
	1735	S DIK="^R CPS(349.2, "
	1736	"RTN","PRC A313P",56, 0)
	1737	S DA=0 F S DA=$O(^ RCPS(349.2 ,DA)) Q:DA ="" D ^DI K
	1738	"RTN","PRC A313P",57, 0)
	1739	S ^RCPS(3 49.2,0)="A R CBSS STA TEMENTS^34 9.2I^^"
	1740	"RTN","PRC A313P",58, 0)
	1741	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T K ^RCT( 349.1,+RCT ,4),^RCT(
	1742	349.1,+RCT ,5)
	1743	"RTN","PRC A313P",59, 0)
	1744	;
	1745	"RTN","PRC A313P",60, 0)
	1746	D BMES^XP DUTL("Pati ent Statem ent Cleanu p complete .")
	1747	"RTN","PRC A313P",61, 0)
	1748	Q
	1749	"RTN","PRC A313P",62, 0)
	1750	;
	1751	"RTN","PRC A313P",63, 0)
	1752	SET3491 ; PRCA4.5 313
	1753	"RTN","PRC A313P",64, 0)
	1754	; Set val ues for Pr oduction o r Test AR Transmissi on Type
	1755	"RTN","PRC A313P",65, 0)
	1756	N PROD,CC ,CP,CA,IEN ,TT,TTVAL
	1757	"RTN","PRC A313P",66, 0)
	1758	;
	1759	"RTN","PRC A313P",67, 0)
	1760	D BMES^XP DUTL("Star ting AR Tr ansaction Type Updat e.")
	1761	"RTN","PRC A313P",68, 0)
	1762	;
	1763	"RTN","PRC A313P",69, 0)
	1764	; Set whe ther envir onment is Production or Test a nd define expected/n ew values
	1765	"RTN","PRC A313P",70, 0)
	1766	S PROD=$$ PROD^XUPRO D
	1767	"RTN","PRC A313P",71, 0)
	1768	S (CC(1), CP(1),CA(1 ))="XXX"
	1769	"RTN","PRC A313P",72, 0)
	1770	S CC(3)=" Q-"_$S(PRO D:"CBS",1: "CCT")_". D NS "
	1771	"RTN","PRC A313P",73, 0)
	1772	S CP(3)=" Q-"_$S(PRO D:"CPP",1: "CPT")_". D NS "
	1773	"RTN","PRC A313P",74, 0)
	1774	S CA(3)=" Q-"_$S(PRO D:"CAP",1: "CAT")_". D NS "
	1775	"RTN","PRC A313P",75, 0)
	1776	;
	1777	"RTN","PRC A313P",76, 0)
	1778	; Validat e Domains are availa ble. Writ e error if not
	1779	"RTN","PRC A313P",77, 0)
	1780	I '$D(^DI C(4.2,"B", CC(3)))!(' $D(^DIC(4. 2,"B",CP(3 ))))!('$D( ^DIC(4.2," B",CA(3))
	1781	)) D Q
	1782	"RTN","PRC A313P",78, 0)
	1783	. N LINE S $P(LINE, "*",79)=""
	1784	"RTN","PRC A313P",79, 0)
	1785	. D BMES^ XPDUTL(LIN E)
	1786	"RTN","PRC A313P",80, 0)
	1787	. D MES^X PDUTL("Dom ains for P RCA4.531 3 have not been full y set up." )
	1788	"RTN","PRC A313P",81, 0)
	1789	. D MES^X PDUTL("Ple ase establ ish Domain s for: ")
	1790	"RTN","PRC A313P",82, 0)
	1791	. D MES^X PDUTL("CCP C PATIENT STATEMENTS , PATIENT STATEMENT UPDATE, an d ANNUAL
	1792	PAYMENT ST ATEMENTS." )
	1793	"RTN","PRC A313P",83, 0)
	1794	. D BMES^ XPDUTL(LIN E)
	1795	"RTN","PRC A313P",84, 0)
	1796	;
	1797	"RTN","PRC A313P",85, 0)
	1798	; Validat e 'PS', 'P U', and 'P Y' are set for Patie nt Stateme nt, Nightl y Update,
	1799	and Annua l Payment Statement
	1800	"RTN","PRC A313P",86, 0)
	1801	F TT="PS" ,"PU","PY" S IEN=$O( ^RCT(349.1 ,"B",TT,0) ) D
	1802	"RTN","PRC A313P",87, 0)
	1803	. N DOMAI N,I
	1804	"RTN","PRC A313P",88, 0)
	1805	. I TT="P S" M DOMAI N=CC
	1806	"RTN","PRC A313P",89, 0)
	1807	. I TT="P U" M DOMAI N=CP
	1808	"RTN","PRC A313P",90, 0)
	1809	. I TT="P Y" M DOMAI N=CA
	1810	"RTN","PRC A313P",91, 0)
	1811	. ; If no IEN creat e new leve l one and three with cross-ref erences
	1812	"RTN","PRC A313P",92, 0)
	1813	. I IEN=" " D SET1(T T,.DOMAIN) Q
	1814	"RTN","PRC A313P",93, 0)
	1815	. ; If no 3 level o r it is no t set to e xpected va lue reset 3 level
	1816	"RTN","PRC A313P",94, 0)
	1817	. I IEN'= "" D
	1818	"RTN","PRC A313P",95, 0)
	1819	. F I=1,3 S TTVAL(I )=$P($G(^R CT(349.1,I EN,3)),U,I )
	1820	"RTN","PRC A313P",96, 0)
	1821	. I DOMAI N(1)_DOMAI N(3)'=TTVA L(1)_TTVAL (3) D SET3 (IEN,.DOMA IN)
	1822	"RTN","PRC A313P",97, 0)
	1823	;
	1824	"RTN","PRC A313P",98, 0)
	1825	D BMES^XP DUTL("AR T ransaction Type Upda te complet e.")
	1826	"RTN","PRC A313P",99, 0)
	1827	;
	1828	"RTN","PRC A313P",100 ,0)
	1829	Q
	1830	"RTN","PRC A313P",101 ,0)
	1831	;
	1832	"RTN","PRC A313P",102 ,0)
	1833	SET1(TT,DO MAIN) ; P RCA4.531 3
	1834	"RTN","PRC A313P",103 ,0)
	1835	; Set bot h the 1 an d 3 level for 349.1
	1836	"RTN","PRC A313P",104 ,0)
	1837	; New and Set Field values fo r DIC(4.2
	1838	"RTN","PRC A313P",105 ,0)
	1839	N TTNAME, ZZ,DIC,Y
	1840	"RTN","PRC A313P",106 ,0)
	1841	I TT="PS" S TTNAME= "CCPC PATI ENT STATEM ENT"
	1842	"RTN","PRC A313P",107 ,0)
	1843	I TT="PU" S TTNAME= "PATIENT S TATEMENT U PDATE"
	1844	"RTN","PRC A313P",108 ,0)
	1845	I TT="PY" S TTNAME= "ANNUAL PA YMENT STAT EMENTS"
	1846	"RTN","PRC A313P",109 ,0)
	1847	;
	1848	"RTN","PRC A313P",110 ,0)
	1849	; Set 1 l evel value s
	1850	"RTN","PRC A313P",111 ,0)
	1851	S DIC="^R CT(349.1," ,DIC(0)="L "
	1852	"RTN","PRC A313P",112 ,0)
	1853	S X=TT
	1854	"RTN","PRC A313P",113 ,0)
	1855	S DIC("DR ")=".02/// "_TTNAME_" ;.03///"_1 _";"
	1856	"RTN","PRC A313P",114 ,0)
	1857	D FILE^DI CN
	1858	"RTN","PRC A313P",115 ,0)
	1859	S IEN=+Y
	1860	"RTN","PRC A313P",116 ,0)
	1861	;
	1862	"RTN","PRC A313P",117 ,0)
	1863	; Set 3 l evel
	1864	"RTN","PRC A313P",118 ,0)
	1865	D SET3(IE N,.DOMAIN)
	1866	"RTN","PRC A313P",119 ,0)
	1867	;
	1868	"RTN","PRC A313P",120 ,0)
	1869	Q
	1870	"RTN","PRC A313P",121 ,0)
	1871	SET3(IEN,D OMAIN) ; PRCA4.53 13
	1872	"RTN","PRC A313P",122 ,0)
	1873	; Set 3 l evel for 3 49.1
	1874	"RTN","PRC A313P",123 ,0)
	1875	S DOMAIN( "IEN")=$O( ^DIC(4.2," B",DOMAIN( 3),0))
	1876	"RTN","PRC A313P",124 ,0)
	1877	S ^RCT(34 9.1,IEN,3) =DOMAIN(1) _U_DOMAIN( "IEN")_U_D OMAIN(3)
	1878	"RTN","PRC A313P",125 ,0)
	1879	; PRCA4. 5313 - Se t Cross-Re ferences f or this IE N
	1880	"RTN","PRC A313P",126 ,0)
	1881	S DA=IEN, DIK="^RCT( 349.1," D IX1^DIK
	1882	"RTN","PRC A313P",127 ,0)
	1883	;
	1884	"RTN","PRC A313P",128 ,0)
	1885	Q
	1886	"RTN","PRC A313P",129 ,0)
	1887	;
	1888	"RTN","PRC A313P",130 ,0)
	1889	PRE ; Pre -install a ctions for the Data Dictionary
	1890	"RTN","PRC A313P",131 ,0)
	1891	;
	1892	"RTN","PRC A313P",132 ,0)
	1893	D BMES^XP DUTL("Star ting Pre-I nstall Cha nges.")
	1894	"RTN","PRC A313P",133 ,0)
	1895	;
	1896	"RTN","PRC A313P",134 ,0)
	1897	N DIK,DA
	1898	"RTN","PRC A313P",135 ,0)
	1899	; Remove DD for 349 .1, elemen ts 41, 42, and 43 - new elemen ts are ent ered duri
	1900	ng regular install
	1901	"RTN","PRC A313P",136 ,0)
	1902	S DIK="^D D(349.1,", DA(1)=349. 1
	1903	"RTN","PRC A313P",137 ,0)
	1904	F DA=41,4 2,43 D ^DI K
	1905	"RTN","PRC A313P",138 ,0)
	1906	;
	1907	"RTN","PRC A313P",139 ,0)
	1908	; Remove DD for 349 , element .09 to cha nge from o ld to new Style Cros s Referen
	1909	ce.
	1910	"RTN","PRC A313P",140 ,0)
	1911	S DIK="^D D(349,",DA (1)=349
	1912	"RTN","PRC A313P",141 ,0)
	1913	S DA=.09 D ^DIK
	1914	"RTN","PRC A313P",142 ,0)
	1915	;
	1916	"RTN","PRC A313P",143 ,0)
	1917	D BMES^XP DUTL("Pre- Install Ch anges comp lete.")
	1918	"RTN","PRC A313P",144 ,0)
	1919	Q
	1920	"RTN","PRC A313P",145 ,0)
	1921	;
	1922	"RTN","PRC A313P",146 ,0)
	1923	PRCACPS ; Queue the Patient S tatement A uto-Correc tion Progr am
	1924	"RTN","PRC A313P",147 ,0)
	1925	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	1926	"RTN","PRC A313P",148 ,0)
	1927	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	1928	"RTN","PRC A313P",149 ,0)
	1929	S ZTRTN=" START^PRCA CPS",ZTDTH =$H,ZTIO=" "
	1930	"RTN","PRC A313P",150 ,0)
	1931	D ^%ZTLOA D
	1932	"RTN","PRC A313P",151 ,0)
	1933	I $G(ZTSK ) D Q
	1934	"RTN","PRC A313P",152 ,0)
	1935	.D BMES^X PDUTL(">>> POST-INSTA LL CONSOLI DATED PATI ENT STATEM ENT AUTO-C ORRECTION
	1936	")
	1937	"RTN","PRC A313P",153 ,0)
	1938	.D MES^XP DUTL(">>>P ROGRAM HAS BEEN QUEU ED IN TASK "_ZTSK)
	1939	"RTN","PRC A313P",154 ,0)
	1940	I '$G(ZTS K) D Q
	1941	"RTN","PRC A313P",155 ,0)
	1942	.D BMES^X PDUTL(">>> ERROR: POS T-INSTALL CONSOLIDAT ED PATIENT STATEMENT AUTO-COR
	1943	RECTION")
	1944	"RTN","PRC A313P",156 ,0)
	1945	.D MES^XP DUTL(">>>P ROGRAM COU LD NOT BE QUEUED")
	1946	"RTN","PRC A313P",157 ,0)
	1947	Q
	1948	"RTN","PRC AACR")
	1949	0^19^B1273 36081^n/a
	1950	"RTN","PRC AACR",1,0)
	1951	PRCAACR ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION REPOR T ;09/21/1 5 3:34 PM
	1952	"RTN","PRC AACR",2,0)
	1953	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 124
	1954	"RTN","PRC AACR",3,0)
	1955	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1956	"RTN","PRC AACR",4,0)
	1957	;
	1958	"RTN","PRC AACR",5,0)
	1959	Q
	1960	"RTN","PRC AACR",6,0)
	1961	;
	1962	"RTN","PRC AACR",7,0)
	1963	PSACRT ; r eport, pri nts sorted individua l transact ions that have been auto-corr
	1964	ected
	1965	"RTN","PRC AACR",8,0)
	1966	N DIC,PAG E,BY,DHD,F ILENUM,FLD S,FR,L,TO, PRCABDT,PR CAEDT,PRCA SORT
	1967	"RTN","PRC AACR",9,0)
	1968	W !
	1969	"RTN","PRC AACR",10,0 )
	1970	PSDATE ;
	1971	"RTN","PRC AACR",11,0 )
	1972	; Determi ne if Auto Correct p rocess is currently running
	1973	"RTN","PRC AACR",12,0 )
	1974	N PRCASTR T,QUIT,X,X 1,X2,Y
	1975	"RTN","PRC AACR",13,0 )
	1976	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= ""
	1977	"RTN","PRC AACR",14,0 )
	1978	; QUIT if Auto Corr ect proces s is curre ntly runni ng
	1979	"RTN","PRC AACR",15,0 )
	1980	I PRCASTR T'="" D Q :QUIT
	1981	"RTN","PRC AACR",16,0 )
	1982	.S Y=$P(P RCASTRT,U, 2)
	1983	"RTN","PRC AACR",17,0 )
	1984	.D DD^%DT
	1985	"RTN","PRC AACR",18,0 )
	1986	.S PRCAST RT=Y
	1987	"RTN","PRC AACR",19,0 )
	1988	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram is cur rently run ning."
	1989	"RTN","PRC AACR",20,0 )
	1990	.W !,"It was starte d at ",PRC ASTRT," an d can take up to 1 h our to com plete."
	1991	"RTN","PRC AACR",21,0 )
	1992	.W !!,"If you choos e to conti nue with t his report , it may n ot reflect all of t
	1993	he"
	1994	"RTN","PRC AACR",22,0 )
	1995	.W !,"cha nges from this lates t run of t he Patient Statement Auto-Corr ection Pr
	1996	ogram."
	1997	"RTN","PRC AACR",23,0 )
	1998	.W !
	1999	"RTN","PRC AACR",24,0 )
	2000	.S DIR(0) ="Y",DIR(" A")="Do yo u want to continue", DIR("B")=" NO"
	2001	"RTN","PRC AACR",25,0 )
	2002	.D ^DIR
	2003	"RTN","PRC AACR",26,0 )
	2004	.W !
	2005	"RTN","PRC AACR",27,0 )
	2006	.; Quit i f ^, ^^, T imeout or No
	2007	"RTN","PRC AACR",28,0 )
	2008	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	2009	"RTN","PRC AACR",29,0 )
	2010	.; Send M ailMan mes sage to PR CACPS mail group if Yes
	2011	"RTN","PRC AACR",30,0 )
	2012	.I Y=1 D PRCAMAIL^P RCACPSA(PR CASTRT)
	2013	"RTN","PRC AACR",31,0 )
	2014	.K DTOUT, DUOUT,DIRO UT
	2015	"RTN","PRC AACR",32,0 )
	2016	;
	2017	"RTN","PRC AACR",33,0 )
	2018	N DIROUT, DIS,DTOUT, DUOUT
	2019	"RTN","PRC AACR",34,0 )
	2020	S DIR("A" )="Date Ra nge: FROM: ",DIR("B" )="T-7"
	2021	"RTN","PRC AACR",35,0 )
	2022	S DIR("?" )="The def ault date is T-7. F uture date s may not be entered ."
	2023	"RTN","PRC AACR",36,0 )
	2024	S DIR(0)= "DO" D ^DI R
	2025	"RTN","PRC AACR",37,0 )
	2026	S:Y'="" P RCABDT=Y
	2027	"RTN","PRC AACR",38,0 )
	2028	I $D(DIRU T)&'Y K DI RUT Q
	2029	"RTN","PRC AACR",39,0 )
	2030	I PRCABDT >DT G PSDA TE
	2031	"RTN","PRC AACR",40,0 )
	2032	W "(",Y(0 ),")"
	2033	"RTN","PRC AACR",41,0 )
	2034	K DIR,X,Y
	2035	"RTN","PRC AACR",42,0 )
	2036	S DIR(0)= "DO"
	2037	"RTN","PRC AACR",43,0 )
	2038	S DIR("A" )="Date Ra nge: TO: ",DIR("B" )="T"
	2039	"RTN","PRC AACR",44,0 )
	2040	S DIR("?" )="The def ault date is T, but any date m ay be ente red."
	2041	"RTN","PRC AACR",45,0 )
	2042	D ^DIR S: Y="" Y=DT
	2043	"RTN","PRC AACR",46,0 )
	2044	I $D(DIRU T)&'Y K DI RUT Q
	2045	"RTN","PRC AACR",47,0 )
	2046	W "(",Y(0 ),")"
	2047	"RTN","PRC AACR",48,0 )
	2048	S PRCAEDT =Y
	2049	"RTN","PRC AACR",49,0 )
	2050	I PRCABDT >PRCAEDT G PSDATE
	2051	"RTN","PRC AACR",50,0 )
	2052	K DIR
	2053	"RTN","PRC AACR",51,0 )
	2054	S DIR(0)= "S^1:Auto- Correct Re ason;2:Deb tor Name;3 :Bill Numb er;4:Trans action Nu
	2055	mber;5:Aut o-Correct Date",DIR( "A")="Sort by"
	2056	"RTN","PRC AACR",52,0 )
	2057	S DIR("B" )=1
	2058	"RTN","PRC AACR",53,0 )
	2059	D ^DIR K DIR
	2060	"RTN","PRC AACR",54,0 )
	2061	S PRCASOR T=Y
	2062	"RTN","PRC AACR",55,0 )
	2063	Q:$D(DTOU T)!($D(DUO UT))!($D(D IROUT))
	2064	"RTN","PRC AACR",56,0 )
	2065	;
	2066	"RTN","PRC AACR",57,0 )
	2067	; Prompt for device
	2068	"RTN","PRC AACR",58,0 )
	2069	W !
	2070	"RTN","PRC AACR",59,0 )
	2071	N ZTRTN,Z TDESC,ZTSA VE,ZTSK
	2072	"RTN","PRC AACR",60,0 )
	2073	K IOP,%ZI S,POP,IO(" Q")
	2074	"RTN","PRC AACR",61,0 )
	2075	S %ZIS="Q "
	2076	"RTN","PRC AACR",62,0 )
	2077	D ^%ZIS Q :POP
	2078	"RTN","PRC AACR",63,0 )
	2079	; If Queu ed
	2080	"RTN","PRC AACR",64,0 )
	2081	I $D(IO(" Q")) D Q
	2082	"RTN","PRC AACR",65,0 )
	2083	.K IO("Q" )
	2084	"RTN","PRC AACR",66,0 )
	2085	.I $G(IOS T)["P-MES" S ZTRTN=" PRT^PRCAAC R1"
	2086	"RTN","PRC AACR",67,0 )
	2087	.I $G(IOS T)'["P-MES " S ZTRTN= "PRT^PRCAA CR"
	2088	"RTN","PRC AACR",68,0 )
	2089	.S ZTSAVE ("PRCABDT" )="",ZTSAV E("PRCAEDT ")="",ZTSA VE("PRCASO RT")=""
	2090	"RTN","PRC AACR",69,0 )
	2091	.D ^%ZTLO AD
	2092	"RTN","PRC AACR",70,0 )
	2093	.D HOME^% ZIS
	2094	"RTN","PRC AACR",71,0 )
	2095	.I $D(ZTS K)[0 W !!? 5,"Report cancelled! "
	2096	"RTN","PRC AACR",72,0 )
	2097	.E W !!? 5,"Report queued!"
	2098	"RTN","PRC AACR",73,0 )
	2099	.K POP
	2100	"RTN","PRC AACR",74,0 )
	2101	;
	2102	"RTN","PRC AACR",75,0 )
	2103	;Print Re port if no t QUEUED
	2104	"RTN","PRC AACR",76,0 )
	2105	PRT ;
	2106	"RTN","PRC AACR",77,0 )
	2107	; If not queued and output se nt to P-ME S
	2108	"RTN","PRC AACR",78,0 )
	2109	I $G(IOST )["P-MES" D PRT^PRCA ACR1 Q
	2110	"RTN","PRC AACR",79,0 )
	2111	;If not q ueued and output not sent to P -MES
	2112	"RTN","PRC AACR",80,0 )
	2113	U IO
	2114	"RTN","PRC AACR",81,0 )
	2115	K ^TMP("P RCAACR",$J )
	2116	"RTN","PRC AACR",82,0 )
	2117	S PAGE=0
	2118	"RTN","PRC AACR",83,0 )
	2119	S DASH="" ,$P(DASH," -",79)=""
	2120	"RTN","PRC AACR",84,0 )
	2121	S DIS(0)= "I $D(^PRC A(433,""TA CD"",PRCAT SRT,D0))", L=0
	2122	"RTN","PRC AACR",85,0 )
	2123	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AACTF,PRC
	2124	ATNTF
	2125	"RTN","PRC AACR",86,0 )
	2126	S PRCATSR T=PRCABDT- .00001
	2127	"RTN","PRC AACR",87,0 )
	2128	; Loop th rough the specified date range
	2129	"RTN","PRC AACR",88,0 )
	2130	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	2131	D
	2132	"RTN","PRC AACR",89,0 )
	2133	.S PRCATN =""
	2134	"RTN","PRC AACR",90,0 )
	2135	.; Loop t hrough the transacti ons for th e current date
	2136	"RTN","PRC AACR",91,0 )
	2137	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	2138	"RTN","PRC AACR",92,0 )
	2139	..; Load associated data fiel ds for rep ort
	2140	"RTN","PRC AACR",93,0 )
	2141	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	2142	"RTN","PRC AACR",94,0 )
	2143	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	2144	"RTN","PRC AACR",95,0 )
	2145	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	2146	"RTN","PRC AACR",96,0 )
	2147	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	2148	"RTN","PRC AACR",97,0 )
	2149	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	2150	"RTN","PRC AACR",98,0 )
	2151	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	2152	"RTN","PRC AACR",99,0 )
	2153	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	2154	"RTN","PRC AACR",100, 0)
	2155	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	2156	"RTN","PRC AACR",101, 0)
	2157	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	2158	"RTN","PRC AACR",102, 0)
	2159	..S PRCAA CR=$E(PRCA ACR,1,14)
	2160	"RTN","PRC AACR",103, 0)
	2161	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	2162	"RTN","PRC AACR",104, 0)
	2163	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	2164	"RTN","PRC AACR",105, 0)
	2165	..I PRCAA CTF="YES" S PRCATNTF =""
	2166	"RTN","PRC AACR",106, 0)
	2167	..;
	2168	"RTN","PRC AACR",107, 0)
	2169	..; If an y of the n odes are n ull Quit
	2170	"RTN","PRC AACR",108, 0)
	2171	..I PRCAA CR=""!(PRC ADTR="")!( PRCABN="") !(PRCATN=" ")!(PRCAAC D="") Q
	2172	"RTN","PRC AACR",109, 0)
	2173	..;
	2174	"RTN","PRC AACR",110, 0)
	2175	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number
	2176	"RTN","PRC AACR",111, 0)
	2177	..I PRCAS ORT=1 D Q
	2178	"RTN","PRC AACR",112, 0)
	2179	...S ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_PR CABN_U_PR
	2180	CATNTF_U_P RCAACD_U_P RCASSN
	2181	"RTN","PRC AACR",113, 0)
	2182	..;
	2183	"RTN","PRC AACR",114, 0)
	2184	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	2185	"RTN","PRC AACR",115, 0)
	2186	..I PRCAS ORT=2 D Q
	2187	"RTN","PRC AACR",116, 0)
	2188	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	2189	ATNTF_U_PR CAACD_U_PR CAACR
	2190	"RTN","PRC AACR",117, 0)
	2191	..;
	2192	"RTN","PRC AACR",118, 0)
	2193	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	2194	"RTN","PRC AACR",119, 0)
	2195	..I PRCAS ORT=3 D Q
	2196	"RTN","PRC AACR",120, 0)
	2197	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	2198	ATNTF_U_PR CAACD_U_PR CAACR
	2199	"RTN","PRC AACR",121, 0)
	2200	..;
	2201	"RTN","PRC AACR",122, 0)
	2202	..; Store in ^TMP s orted by T ransaction , Debtor a nd Bill Nu mber
	2203	"RTN","PRC AACR",123, 0)
	2204	..I PRCAS ORT=4 D Q
	2205	"RTN","PRC AACR",124, 0)
	2206	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	2207	CASSN_U_PR CAACD_U_PR CAACR
	2208	"RTN","PRC AACR",125, 0)
	2209	..;
	2210	"RTN","PRC AACR",126, 0)
	2211	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number and Tran
	2212	saction Nu mber
	2213	"RTN","PRC AACR",127, 0)
	2214	..I PRCAS ORT=5 D Q
	2215	"RTN","PRC AACR",128, 0)
	2216	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	2217	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2218	"RTN","PRC AACR",129, 0)
	2219	;
	2220	"RTN","PRC AACR",130, 0)
	2221	;
	2222	"RTN","PRC AACR",131, 0)
	2223	N QUIT ; QUIT befor e end of r eport
	2224	"RTN","PRC AACR",132, 0)
	2225	S QUIT=""
	2226	"RTN","PRC AACR",133, 0)
	2227	; Display Auto-Corr ect data s orted by A uto Correc tion Reaso n
	2228	"RTN","PRC AACR",134, 0)
	2229	I PRCASOR T=1 D
	2230	"RTN","PRC AACR",135, 0)
	2231	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_P
	2232	RCABN_U_PR CATNTF_U_P RCAACD_U_P RCASSN
	2233	"RTN","PRC AACR",136, 0)
	2234	.; Displa y Auto Cor rection Re ason heade r
	2235	"RTN","PRC AACR",137, 0)
	2236	.N Y
	2237	"RTN","PRC AACR",138, 0)
	2238	.D PSACRT P1
	2239	"RTN","PRC AACR",139, 0)
	2240	.S PRCAAC R=""
	2241	"RTN","PRC AACR",140, 0)
	2242	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D Q:QUIT
	2243	"RTN","PRC AACR",141, 0)
	2244	..S PRCAD TR=""
	2245	"RTN","PRC AACR",142, 0)
	2246	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	2247	"RTN","PRC AACR",143, 0)
	2248	...S PRCA BN=""
	2249	"RTN","PRC AACR",144, 0)
	2250	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:Q
	2251	UIT
	2252	"RTN","PRC AACR",145, 0)
	2253	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	2254	"RTN","PRC AACR",146, 0)
	2255	....S Y=$ P(PRCADATA ,U,5)
	2256	"RTN","PRC AACR",147, 0)
	2257	....D DD^ %DT
	2258	"RTN","PRC AACR",148, 0)
	2259	....S $P( PRCADATA,U ,5)=Y
	2260	"RTN","PRC AACR",149, 0)
	2261	....W !,$ P(PRCADATA ,U,1),?16, $E($P(PRCA DATA,U,2), 1,18),?36, $E($P(PRCA DATA,U,6)
	2262	,6,9),?42, $E($P(PRCA DATA,U,3), 1,11),?55, $J($P(PRCA DATA,U,4), 9),?66,$P( PRCADATA,
	2263	U,5)
	2264	"RTN","PRC AACR",150, 0)
	2265	....I $Y> (IOSL-3) D
	2266	"RTN","PRC AACR",151, 0)
	2267	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	2268	"RTN","PRC AACR",152, 0)
	2269	......D P RTC
	2270	"RTN","PRC AACR",153, 0)
	2271	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	2272	"RTN","PRC AACR",154, 0)
	2273	.....D PS ACRTP1
	2274	"RTN","PRC AACR",155, 0)
	2275	;
	2276	"RTN","PRC AACR",156, 0)
	2277	; Display Auto-Corr ect data s orted by D ebtor
	2278	"RTN","PRC AACR",157, 0)
	2279	I PRCASOR T=2 D
	2280	"RTN","PRC AACR",158, 0)
	2281	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	2282	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2283	"RTN","PRC AACR",159, 0)
	2284	.; Displa y Debtor h eader
	2285	"RTN","PRC AACR",160, 0)
	2286	.D PSACRT P2
	2287	"RTN","PRC AACR",161, 0)
	2288	.S PRCADT R=""
	2289	"RTN","PRC AACR",162, 0)
	2290	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D Q:QUIT
	2291	"RTN","PRC AACR",163, 0)
	2292	..S PRCAB N=""
	2293	"RTN","PRC AACR",164, 0)
	2294	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D Q:Q UIT
	2295	"RTN","PRC AACR",165, 0)
	2296	...S PRCA TN=""
	2297	"RTN","PRC AACR",166, 0)
	2298	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D Q:QU
	2299	IT
	2300	"RTN","PRC AACR",167, 0)
	2301	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	2302	"RTN","PRC AACR",168, 0)
	2303	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2304	"RTN","PRC AACR",169, 0)
	2305	....W !,$ E($P(PRCAD ATA,U,1),1 ,18),?20,$ P(PRCADATA ,U,2),?33, $E($P(PRCA DATA,U,3)
	2306	,6,9),?39, $J($P(PRCA DATA,U,4), 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	2307	"RTN","PRC AACR",170, 0)
	2308	....I $Y> (IOSL-3) D
	2309	"RTN","PRC AACR",171, 0)
	2310	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	2311	"RTN","PRC AACR",172, 0)
	2312	......D P RTC
	2313	"RTN","PRC AACR",173, 0)
	2314	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	2315	"RTN","PRC AACR",174, 0)
	2316	.....D PS ACRTP2
	2317	"RTN","PRC AACR",175, 0)
	2318	;
	2319	"RTN","PRC AACR",176, 0)
	2320	; Display Auto-Corr ect data s orted by A UTO-C DATE
	2321	"RTN","PRC AACR",177, 0)
	2322	I PRCASOR T=3 D
	2323	"RTN","PRC AACR",178, 0)
	2324	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	2325	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2326	"RTN","PRC AACR",179, 0)
	2327	.; Displa y Bill Num ber header
	2328	"RTN","PRC AACR",180, 0)
	2329	.D PSACRT P3
	2330	"RTN","PRC AACR",181, 0)
	2331	.S PRCABN =""
	2332	"RTN","PRC AACR",182, 0)
	2333	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D Q: QUIT
	2334	"RTN","PRC AACR",183, 0)
	2335	..S PRCAD TR=""
	2336	"RTN","PRC AACR",184, 0)
	2337	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	2338	"RTN","PRC AACR",185, 0)
	2339	...S PRCA TN=""
	2340	"RTN","PRC AACR",186, 0)
	2341	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D Q:QU
	2342	IT
	2343	"RTN","PRC AACR",187, 0)
	2344	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	2345	"RTN","PRC AACR",188, 0)
	2346	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2347	"RTN","PRC AACR",189, 0)
	2348	....W !,$ P(PRCADATA ,U,1),?13, $E($P(PRCA DATA,U,2), 1,18),?33, $E($P(PRCA DATA,U,3)
	2349	,6,9),?39, $J($P(PRCA DATA,U,4), 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	2350	"RTN","PRC AACR",190, 0)
	2351	....I $Y> (IOSL-3) D
	2352	"RTN","PRC AACR",191, 0)
	2353	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	2354	"RTN","PRC AACR",192, 0)
	2355	......D P RTC
	2356	"RTN","PRC AACR",193, 0)
	2357	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	2358	"RTN","PRC AACR",194, 0)
	2359	.....D PS ACRTP3
	2360	"RTN","PRC AACR",195, 0)
	2361	;
	2362	"RTN","PRC AACR",196, 0)
	2363	; Display Auto-Corr ect data s orted by T ransaction Number
	2364	"RTN","PRC AACR",197, 0)
	2365	I PRCASOR T=4 D
	2366	"RTN","PRC AACR",198, 0)
	2367	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	2368	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	2369	"RTN","PRC AACR",199, 0)
	2370	.; Displa y AUTO-C D ATE header
	2371	"RTN","PRC AACR",200, 0)
	2372	.D PSACRT P4
	2373	"RTN","PRC AACR",201, 0)
	2374	.S PRCATN =""
	2375	"RTN","PRC AACR",202, 0)
	2376	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D Q: QUIT
	2377	"RTN","PRC AACR",203, 0)
	2378	..S PRCAD TR=""
	2379	"RTN","PRC AACR",204, 0)
	2380	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	2381	"RTN","PRC AACR",205, 0)
	2382	...S PRCA BN=""
	2383	"RTN","PRC AACR",206, 0)
	2384	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D Q:QU
	2385	IT
	2386	"RTN","PRC AACR",207, 0)
	2387	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	2388	"RTN","PRC AACR",208, 0)
	2389	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2390	"RTN","PRC AACR",209, 0)
	2391	....W !,$ J($P(PRCAD ATA,U,1),9 ),?11,$E($ P(PRCADATA ,U,2),1,18 ),?31,$P(P RCADATA,U
	2392	,3),?44,$E ($P(PRCADA TA,U,4),6, 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	2393	"RTN","PRC AACR",210, 0)
	2394	....I $Y> (IOSL-3) D
	2395	"RTN","PRC AACR",211, 0)
	2396	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	2397	"RTN","PRC AACR",212, 0)
	2398	......D P RTC
	2399	"RTN","PRC AACR",213, 0)
	2400	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	2401	"RTN","PRC AACR",214, 0)
	2402	.....D PS ACRTP4
	2403	"RTN","PRC AACR",215, 0)
	2404	;
	2405	"RTN","PRC AACR",216, 0)
	2406	; Display Auto-Corr ect data s orted by A uto-Correc t date
	2407	"RTN","PRC AACR",217, 0)
	2408	I PRCASOR T=5 D
	2409	"RTN","PRC AACR",218, 0)
	2410	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	2411	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2412	"RTN","PRC AACR",219, 0)
	2413	.; Displa y AUTO-C D ATE header
	2414	"RTN","PRC AACR",220, 0)
	2415	.D PSACRT P5
	2416	"RTN","PRC AACR",221, 0)
	2417	.S PRCAAC D=""
	2418	"RTN","PRC AACR",222, 0)
	2419	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D Q:QUIT
	2420	"RTN","PRC AACR",223, 0)
	2421	..S PRCAD TR=""
	2422	"RTN","PRC AACR",224, 0)
	2423	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	2424	"RTN","PRC AACR",225, 0)
	2425	...S PRCA BN=""
	2426	"RTN","PRC AACR",226, 0)
	2427	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:Q
	2428	UIT
	2429	"RTN","PRC AACR",227, 0)
	2430	....S PRC ATN=""
	2431	"RTN","PRC AACR",228, 0)
	2432	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	2433	D Q:QUI T
	2434	"RTN","PRC AACR",229, 0)
	2435	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	2436	"RTN","PRC AACR",230, 0)
	2437	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	2438	"RTN","PRC AACR",231, 0)
	2439	.....W !, $P(PRCADAT A,U,1),?14 ,$E($P(PRC ADATA,U,2) ,1,18),?34 ,$P(PRCADA TA,U,3),?
	2440	47,$E($P(P RCADATA,U, 4),6,9),?5 3,$J($P(PR CADATA,U,5 ),9),?64,$ P(PRCADATA ,U,6)
	2441	"RTN","PRC AACR",232, 0)
	2442	.....I $Y >(IOSL-3) D
	2443	"RTN","PRC AACR",233, 0)
	2444	......I $ E(IOST,1,2 )="C-" D Q:QUIT
	2445	"RTN","PRC AACR",234, 0)
	2446	.......D PRTC
	2447	"RTN","PRC AACR",235, 0)
	2448	.......I $D(DIRUT)! ($D(DTOUT) ) S QUIT=1
	2449	"RTN","PRC AACR",236, 0)
	2450	......D P SACRTP5
	2451	"RTN","PRC AACR",237, 0)
	2452	D ^%ZISC
	2453	"RTN","PRC AACR",238, 0)
	2454	I $E(IOST ,1,2)="C-" ,'$D(DUOUT ),('$D(DTO UT)) W ! S DIR(0)="E " D ^DIR
	2455	"RTN","PRC AACR",239, 0)
	2456	K X,Y,DAS H,D0
	2457	"RTN","PRC AACR",240, 0)
	2458	Q
	2459	"RTN","PRC AACR",241, 0)
	2460	;
	2461	"RTN","PRC AACR",242, 0)
	2462	PRTC ; Pre ss Return To Continu e
	2463	"RTN","PRC AACR",243, 0)
	2464	S DIR(0)= "E" D ^DIR
	2465	"RTN","PRC AACR",244, 0)
	2466	Q
	2467	"RTN","PRC AACR",245, 0)
	2468	;
	2469	"RTN","PRC AACR",246, 0)
	2470	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	2471	"RTN","PRC AACR",247, 0)
	2472	W @IOF
	2473	"RTN","PRC AACR",248, 0)
	2474	S PAGE=PA GE+1
	2475	"RTN","PRC AACR",249, 0)
	2476	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION RE ASON)",?6
	2477	6,$$UPPER^ VALM1($$FM TE^XLFDT(D T))
	2478	"RTN","PRC AACR",250, 0)
	2479	W !,DASH, !
	2480	"RTN","PRC AACR",251, 0)
	2481	W !,"AUTO -C REASON" ,?16,"DEBT OR",?36,"S SN",?42,"B ILL NO.",? 55,"TRANS NUM",?66,
	2482	"AUTO-C DA TE"
	2483	"RTN","PRC AACR",252, 0)
	2484	W !,"---- ---------- ",?16,"--- ---------- -----",?36 ,"----",?4 2,"------- ----",?55
	2485	,"-------- -",?66,"-- ---------- "
	2486	"RTN","PRC AACR",253, 0)
	2487	Q
	2488	"RTN","PRC AACR",254, 0)
	2489	;
	2490	"RTN","PRC AACR",255, 0)
	2491	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2492	"RTN","PRC AACR",256, 0)
	2493	W @IOF
	2494	"RTN","PRC AACR",257, 0)
	2495	S PAGE=PA GE+1
	2496	"RTN","PRC AACR",258, 0)
	2497	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y DEBTOR)" ,?66,$$UPP ER^VALM1(
	2498	$$FMTE^XLF DT(DT))
	2499	"RTN","PRC AACR",259, 0)
	2500	W !,DASH, !
	2501	"RTN","PRC AACR",260, 0)
	2502	W !,"DEBT OR",?20,"B ILL NO.",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	2503	UTO-C REAS ON"
	2504	"RTN","PRC AACR",261, 0)
	2505	W !,"---- ---------- ----",?20, "--------- --",?33,"- ---",?39," ---------" ,?50,"---
	2506	---------" ,?64,"---- ---------- "
	2507	"RTN","PRC AACR",262, 0)
	2508	Q
	2509	"RTN","PRC AACR",263, 0)
	2510	;
	2511	"RTN","PRC AACR",264, 0)
	2512	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2513	"RTN","PRC AACR",265, 0)
	2514	W @IOF
	2515	"RTN","PRC AACR",266, 0)
	2516	S PAGE=PA GE+1
	2517	"RTN","PRC AACR",267, 0)
	2518	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y BILL #)" ,?66,$$UPP ER^VALM1(
	2519	$$FMTE^XLF DT(DT))
	2520	"RTN","PRC AACR",268, 0)
	2521	W !,DASH, !
	2522	"RTN","PRC AACR",269, 0)
	2523	W !,"BILL NO.",?13, "DEBTOR",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	2524	UTO-C REAS ON"
	2525	"RTN","PRC AACR",270, 0)
	2526	W !,"---- -------",? 13,"------ ---------- --",?33,"- ---",?39," ---------" ,?50,"---
	2527	---------" ,?64,"---- ---------- "
	2528	"RTN","PRC AACR",271, 0)
	2529	Q
	2530	"RTN","PRC AACR",272, 0)
	2531	;
	2532	"RTN","PRC AACR",273, 0)
	2533	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2534	"RTN","PRC AACR",274, 0)
	2535	W @IOF
	2536	"RTN","PRC AACR",275, 0)
	2537	S PAGE=PA GE+1
	2538	"RTN","PRC AACR",276, 0)
	2539	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y TRANSACT ION NUMBER )",?66,$$
	2540	UPPER^VALM 1($$FMTE^X LFDT(DT))
	2541	"RTN","PRC AACR",277, 0)
	2542	W !,DASH, !
	2543	"RTN","PRC AACR",278, 0)
	2544	W !,"TRAN S NUM",?11 ,"DEBTOR", ?31,"BILL NO.",?44," SSN",?50," AUTO-C DAT E",?64,"A
	2545	UTO-C REAS ON"
	2546	"RTN","PRC AACR",279, 0)
	2547	W !,"---- -----",?11 ,"-------- ---------- ",?31,"--- --------", ?44,"----" ,?50,"---
	2548	---------" ,?64,"---- ---------- "
	2549	"RTN","PRC AACR",280, 0)
	2550	Q
	2551	"RTN","PRC AACR",281, 0)
	2552	;
	2553	"RTN","PRC AACR",282, 0)
	2554	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	2555	"RTN","PRC AACR",283, 0)
	2556	W @IOF
	2557	"RTN","PRC AACR",284, 0)
	2558	S PAGE=PA GE+1
	2559	"RTN","PRC AACR",285, 0)
	2560	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION DA TE)",?66,
	2561	$$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2562	"RTN","PRC AACR",286, 0)
	2563	W !,DASH, !
	2564	"RTN","PRC AACR",287, 0)
	2565	W !,"AUTO -C DATE",? 14,"DEBTOR ",?34,"BIL L NO.",?47 ,"SSN",?53 ,"TRANS NU M",?64,"A
	2566	UTO-C REAS ON"
	2567	"RTN","PRC AACR",288, 0)
	2568	W !,"---- --------", ?14,"----- ---------- ---",?34," ---------- -",?47,"-- --",?53,"
	2569	---------" ,?64,"---- ---------- "
	2570	"RTN","PRC AACR",289, 0)
	2571	Q
	2572	"RTN","PRC AACR",290, 0)
	2573	;
	2574	"RTN","PRC AACR",291, 0)
	2575	EXIT ;
	2576	"RTN","PRC AACR",292, 0)
	2577	Q
	2578	"RTN","PRC AACR1")
	2579	0^20^B1512 71441^n/a
	2580	"RTN","PRC AACR1",1,0 )
	2581	PRCAACR1 ; ALBANY/BDB -PATIENT S TATEMENTS AUTO-CORRE CTION REPO RT ;09/21/ 15 3:34 P
	2582	M
	2583	"RTN","PRC AACR1",2,0 )
	2584	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 124
	2585	"RTN","PRC AACR1",3,0 )
	2586	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2587	"RTN","PRC AACR1",4,0 )
	2588	;
	2589	"RTN","PRC AACR1",5,0 )
	2590	Q
	2591	"RTN","PRC AACR1",6,0 )
	2592	;Print Re port when Queued to P-MES
	2593	"RTN","PRC AACR1",7,0 )
	2594	PRT ;
	2595	"RTN","PRC AACR1",8,0 )
	2596	U IO
	2597	"RTN","PRC AACR1",9,0 )
	2598	; build a rray of tr ansaction auto-corre cted
	2599	"RTN","PRC AACR1",10, 0)
	2600	K ^TMP("P RCAACR1",$ J)
	2601	"RTN","PRC AACR1",11, 0)
	2602	N DASH,PA GE
	2603	"RTN","PRC AACR1",12, 0)
	2604	S PAGE=0
	2605	"RTN","PRC AACR1",13, 0)
	2606	S DASH="" ,$P(DASH," -",79)=""
	2607	"RTN","PRC AACR1",14, 0)
	2608	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AIEN,PRCA
	2609	ACTF,PRCAT NTF,PRCATE MP
	2610	"RTN","PRC AACR1",15, 0)
	2611	S PRCATSR T=PRCABDT- .00001,PRC AIEN=0
	2612	"RTN","PRC AACR1",16, 0)
	2613	; Loop th rough the specified date range
	2614	"RTN","PRC AACR1",17, 0)
	2615	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	2616	D
	2617	"RTN","PRC AACR1",18, 0)
	2618	.S PRCATN =""
	2619	"RTN","PRC AACR1",19, 0)
	2620	.; Loop t hrough the transacti ons for th e current date
	2621	"RTN","PRC AACR1",20, 0)
	2622	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	2623	"RTN","PRC AACR1",21, 0)
	2624	..; Load associated data fiel ds for rep ort
	2625	"RTN","PRC AACR1",22, 0)
	2626	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	2627	"RTN","PRC AACR1",23, 0)
	2628	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	2629	"RTN","PRC AACR1",24, 0)
	2630	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	2631	"RTN","PRC AACR1",25, 0)
	2632	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	2633	"RTN","PRC AACR1",26, 0)
	2634	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	2635	"RTN","PRC AACR1",27, 0)
	2636	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	2637	"RTN","PRC AACR1",28, 0)
	2638	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	2639	"RTN","PRC AACR1",29, 0)
	2640	..S PRCAS SN=$E(PRCA SSN,6,9)
	2641	"RTN","PRC AACR1",30, 0)
	2642	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	2643	"RTN","PRC AACR1",31, 0)
	2644	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	2645	"RTN","PRC AACR1",32, 0)
	2646	..S PRCAA CR=$E(PRCA ACR,1,14)
	2647	"RTN","PRC AACR1",33, 0)
	2648	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	2649	"RTN","PRC AACR1",34, 0)
	2650	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	2651	"RTN","PRC AACR1",35, 0)
	2652	..I PRCAA CTF="YES" S PRCATNTF =""
	2653	"RTN","PRC AACR1",36, 0)
	2654	..;
	2655	"RTN","PRC AACR1",37, 0)
	2656	..; Stor e in ^TMP sorted by Auto-Corre ct Reason, Debtor an d Bill Num ber #
	2657	"RTN","PRC AACR1",38, 0)
	2658	..I PRCAS ORT=1 D Q
	2659	"RTN","PRC AACR1",39, 0)
	2660	...S ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_PR CABN_U_PR
	2661	CATNTF_U_P RCAACD_U_P RCASSN
	2662	"RTN","PRC AACR1",40, 0)
	2663	..;
	2664	"RTN","PRC AACR1",41, 0)
	2665	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	2666	"RTN","PRC AACR1",42, 0)
	2667	..I PRCAS ORT=2 D Q
	2668	"RTN","PRC AACR1",43, 0)
	2669	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	2670	ATNTF_U_PR CAACD_U_PR CAACR
	2671	"RTN","PRC AACR1",44, 0)
	2672	..;
	2673	"RTN","PRC AACR1",45, 0)
	2674	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	2675	"RTN","PRC AACR1",46, 0)
	2676	..I PRCAS ORT=3 D Q
	2677	"RTN","PRC AACR1",47, 0)
	2678	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	2679	ATNTF_U_PR CAACD_U_PR CAACR
	2680	"RTN","PRC AACR1",48, 0)
	2681	..;
	2682	"RTN","PRC AACR1",49, 0)
	2683	..; Store in ^TMP s orted by T ransaction , Debtor a nd #Bill N umber
	2684	"RTN","PRC AACR1",50, 0)
	2685	..I PRCAS ORT=4 D Q
	2686	"RTN","PRC AACR1",51, 0)
	2687	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	2688	CASSN_U_PR CAACD_U_PR CAACR
	2689	"RTN","PRC AACR1",52, 0)
	2690	..;
	2691	"RTN","PRC AACR1",53, 0)
	2692	..; Store in ^TMP s orted by A uto-Correc t Date, De btor, #Bil l Number a nd Transa
	2693	ction Numb er
	2694	"RTN","PRC AACR1",54, 0)
	2695	..I PRCAS ORT=5 D Q
	2696	"RTN","PRC AACR1",55, 0)
	2697	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	2698	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2699	"RTN","PRC AACR1",56, 0)
	2700	..Q
	2701	"RTN","PRC AACR1",57, 0)
	2702	;
	2703	"RTN","PRC AACR1",58, 0)
	2704	; Display Auto-Corr ect data s orted by B ill Number
	2705	"RTN","PRC AACR1",59, 0)
	2706	I PRCASOR T=1 D
	2707	"RTN","PRC AACR1",60, 0)
	2708	.; Print Header
	2709	"RTN","PRC AACR1",61, 0)
	2710	.D PSACRT P1
	2711	"RTN","PRC AACR1",62, 0)
	2712	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_P
	2713	RCABN_U_PR CATNTF_U_P RCAACD_U_P RCASSN
	2714	"RTN","PRC AACR1",63, 0)
	2715	.S PRCAAC R=""
	2716	"RTN","PRC AACR1",64, 0)
	2717	.N Y
	2718	"RTN","PRC AACR1",65, 0)
	2719	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D
	2720	"RTN","PRC AACR1",66, 0)
	2721	..S PRCAD TR=""
	2722	"RTN","PRC AACR1",67, 0)
	2723	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D
	2724	"RTN","PRC AACR1",68, 0)
	2725	...S PRCA BN=""
	2726	"RTN","PRC AACR1",69, 0)
	2727	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2728	"RTN","PRC AACR1",70, 0)
	2729	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	2730	"RTN","PRC AACR1",71, 0)
	2731	....S Y=$ P(PRCADATA ,U,5)
	2732	"RTN","PRC AACR1",72, 0)
	2733	....D DD^ %DT
	2734	"RTN","PRC AACR1",73, 0)
	2735	....S $P( PRCADATA,U ,5)=Y
	2736	"RTN","PRC AACR1",74, 0)
	2737	....S PRC AIEN=PRCAI EN+1
	2738	"RTN","PRC AACR1",75, 0)
	2739	....; Add Auto-Corr ect Reason
	2740	"RTN","PRC AACR1",76, 0)
	2741	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,14 ),$E(PRCAT EMP,16)=" "
	2742	"RTN","PRC AACR1",77, 0)
	2743	....; Add 18 chars of Debtor' s name
	2744	"RTN","PRC AACR1",78, 0)
	2745	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,36)=" "
	2746	"RTN","PRC AACR1",79, 0)
	2747	....; Add SSN
	2748	"RTN","PRC AACR1",80, 0)
	2749	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 ),$E(PRCAT EMP,42)=" "
	2750	"RTN","PRC AACR1",81, 0)
	2751	....; Add Bill Numb er
	2752	"RTN","PRC AACR1",82, 0)
	2753	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,55)=" "
	2754	"RTN","PRC AACR1",83, 0)
	2755	....; Add Transacti on Number
	2756	"RTN","PRC AACR1",84, 0)
	2757	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 66)=" "
	2758	"RTN","PRC AACR1",85, 0)
	2759	....; Add Auto-Corr ect Date
	2760	"RTN","PRC AACR1",86, 0)
	2761	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,74)=" "
	2762	"RTN","PRC AACR1",87, 0)
	2763	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2764	"RTN","PRC AACR1",88, 0)
	2765	....Q
	2766	"RTN","PRC AACR1",89, 0)
	2767	;
	2768	"RTN","PRC AACR1",90, 0)
	2769	; Store i n ^TMP sor ted by Deb tor, Bill Number and Transacti on #
	2770	"RTN","PRC AACR1",91, 0)
	2771	I PRCASOR T=2 D
	2772	"RTN","PRC AACR1",92, 0)
	2773	.; Print Header
	2774	"RTN","PRC AACR1",93, 0)
	2775	.D PSACRT P2
	2776	"RTN","PRC AACR1",94, 0)
	2777	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	2778	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2779	"RTN","PRC AACR1",95, 0)
	2780	.S PRCADT R=""
	2781	"RTN","PRC AACR1",96, 0)
	2782	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D
	2783	"RTN","PRC AACR1",97, 0)
	2784	..S PRCAB N=""
	2785	"RTN","PRC AACR1",98, 0)
	2786	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D
	2787	"RTN","PRC AACR1",99, 0)
	2788	...S PRCA TN=""
	2789	"RTN","PRC AACR1",100 ,0)
	2790	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D
	2791	"RTN","PRC AACR1",101 ,0)
	2792	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	2793	"RTN","PRC AACR1",102 ,0)
	2794	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2795	"RTN","PRC AACR1",103 ,0)
	2796	....S PRC AIEN=PRCAI EN+1
	2797	"RTN","PRC AACR1",104 ,0)
	2798	....; Add 18 chars of Debtor' s name
	2799	"RTN","PRC AACR1",105 ,0)
	2800	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,18 ),$E(PRCAT EMP,20)=" "
	2801	"RTN","PRC AACR1",106 ,0)
	2802	....; Add Bill Numb er
	2803	"RTN","PRC AACR1",107 ,0)
	2804	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,2 ),$E(PRCAT EMP,33)=" "
	2805	"RTN","PRC AACR1",108 ,0)
	2806	....; Add SSN
	2807	"RTN","PRC AACR1",109 ,0)
	2808	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2809	"RTN","PRC AACR1",110 ,0)
	2810	....; Add Transacti on Number
	2811	"RTN","PRC AACR1",111 ,0)
	2812	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2813	"RTN","PRC AACR1",112 ,0)
	2814	....; Add Auto-Corr ect Date
	2815	"RTN","PRC AACR1",113 ,0)
	2816	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2817	"RTN","PRC AACR1",114 ,0)
	2818	....; Add Auto-Corr ect Reason
	2819	"RTN","PRC AACR1",115 ,0)
	2820	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2821	"RTN","PRC AACR1",116 ,0)
	2822	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2823	"RTN","PRC AACR1",117 ,0)
	2824	....Q
	2825	"RTN","PRC AACR1",118 ,0)
	2826	;
	2827	"RTN","PRC AACR1",119 ,0)
	2828	; Store i n ^TMP sor ted by Aut o-Correct Date, Debt or, Bill N umber and Transacti
	2829	on #
	2830	"RTN","PRC AACR1",120 ,0)
	2831	I PRCASOR T=3 D
	2832	"RTN","PRC AACR1",121 ,0)
	2833	.; Print Header
	2834	"RTN","PRC AACR1",122 ,0)
	2835	.D PSACRT P3
	2836	"RTN","PRC AACR1",123 ,0)
	2837	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	2838	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2839	"RTN","PRC AACR1",124 ,0)
	2840	.S PRCABN =""
	2841	"RTN","PRC AACR1",125 ,0)
	2842	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D
	2843	"RTN","PRC AACR1",126 ,0)
	2844	..S PRCAD TR=""
	2845	"RTN","PRC AACR1",127 ,0)
	2846	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D
	2847	"RTN","PRC AACR1",128 ,0)
	2848	...S PRCA TN=""
	2849	"RTN","PRC AACR1",129 ,0)
	2850	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D
	2851	"RTN","PRC AACR1",130 ,0)
	2852	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	2853	"RTN","PRC AACR1",131 ,0)
	2854	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2855	"RTN","PRC AACR1",132 ,0)
	2856	....S PRC AIEN=PRCAI EN+1
	2857	"RTN","PRC AACR1",133 ,0)
	2858	....; Add Bill Numb er
	2859	"RTN","PRC AACR1",134 ,0)
	2860	....S PRC ATEMP=$P(P RCADATA,U, 1),$E(PRCA TEMP,13)=" "
	2861	"RTN","PRC AACR1",135 ,0)
	2862	....; Add 18 chars of Debtor' s name
	2863	"RTN","PRC AACR1",136 ,0)
	2864	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,33)=" "
	2865	"RTN","PRC AACR1",137 ,0)
	2866	....; Add SSN
	2867	"RTN","PRC AACR1",138 ,0)
	2868	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2869	"RTN","PRC AACR1",139 ,0)
	2870	....; Add Transacti on Number
	2871	"RTN","PRC AACR1",140 ,0)
	2872	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2873	"RTN","PRC AACR1",141 ,0)
	2874	....; Add Auto-Corr ect Date
	2875	"RTN","PRC AACR1",142 ,0)
	2876	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2877	"RTN","PRC AACR1",143 ,0)
	2878	....; Add Auto-Corr ect Reason
	2879	"RTN","PRC AACR1",144 ,0)
	2880	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2881	"RTN","PRC AACR1",145 ,0)
	2882	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2883	"RTN","PRC AACR1",146 ,0)
	2884	....Q
	2885	"RTN","PRC AACR1",147 ,0)
	2886	;
	2887	"RTN","PRC AACR1",148 ,0)
	2888	; Store i n ^TMP sor ted by Tra nsaction, Debtor and #Bill Num ber
	2889	"RTN","PRC AACR1",149 ,0)
	2890	I PRCASOR T=4 D
	2891	"RTN","PRC AACR1",150 ,0)
	2892	.; Print Header
	2893	"RTN","PRC AACR1",151 ,0)
	2894	.D PSACRT P4
	2895	"RTN","PRC AACR1",152 ,0)
	2896	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	2897	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	2898	"RTN","PRC AACR1",153 ,0)
	2899	.S PRCATN =""
	2900	"RTN","PRC AACR1",154 ,0)
	2901	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D
	2902	"RTN","PRC AACR1",155 ,0)
	2903	..S PRCAD TR=""
	2904	"RTN","PRC AACR1",156 ,0)
	2905	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D
	2906	"RTN","PRC AACR1",157 ,0)
	2907	...S PRCA BN=""
	2908	"RTN","PRC AACR1",158 ,0)
	2909	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D
	2910	"RTN","PRC AACR1",159 ,0)
	2911	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	2912	"RTN","PRC AACR1",160 ,0)
	2913	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2914	"RTN","PRC AACR1",161 ,0)
	2915	....S PRC AIEN=PRCAI EN+1
	2916	"RTN","PRC AACR1",162 ,0)
	2917	....; Add Transacti on Number
	2918	"RTN","PRC AACR1",163 ,0)
	2919	....S PRC ATEMP=$J($ P(PRCADATA ,U,1),9),$ E(PRCATEMP ,11)=" "
	2920	"RTN","PRC AACR1",164 ,0)
	2921	....; Add 18 chars of Debtor' s name
	2922	"RTN","PRC AACR1",165 ,0)
	2923	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,31)=" "
	2924	"RTN","PRC AACR1",166 ,0)
	2925	....; Add Bill Numb er
	2926	"RTN","PRC AACR1",167 ,0)
	2927	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,44)=" "
	2928	"RTN","PRC AACR1",168 ,0)
	2929	....; Add SSN
	2930	"RTN","PRC AACR1",169 ,0)
	2931	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,4 ),$E(PRCAT EMP,50)=" "
	2932	"RTN","PRC AACR1",170 ,0)
	2933	....; Add Auto-Corr ect Date
	2934	"RTN","PRC AACR1",171 ,0)
	2935	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2936	"RTN","PRC AACR1",172 ,0)
	2937	....; Add Auto-Corr ect Reason
	2938	"RTN","PRC AACR1",173 ,0)
	2939	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2940	"RTN","PRC AACR1",174 ,0)
	2941	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2942	"RTN","PRC AACR1",175 ,0)
	2943	....Q
	2944	"RTN","PRC AACR1",176 ,0)
	2945	;
	2946	"RTN","PRC AACR1",177 ,0)
	2947	; Display Auto-Corr ect data s orted by A uto-Correc t Reason
	2948	"RTN","PRC AACR1",178 ,0)
	2949	I PRCASOR T=5 D
	2950	"RTN","PRC AACR1",179 ,0)
	2951	.; Print Header
	2952	"RTN","PRC AACR1",180 ,0)
	2953	.D PSACRT P5
	2954	"RTN","PRC AACR1",181 ,0)
	2955	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	2956	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2957	"RTN","PRC AACR1",182 ,0)
	2958	.S PRCAAC D=""
	2959	"RTN","PRC AACR1",183 ,0)
	2960	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D
	2961	"RTN","PRC AACR1",184 ,0)
	2962	..S PRCAD TR=""
	2963	"RTN","PRC AACR1",185 ,0)
	2964	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D
	2965	"RTN","PRC AACR1",186 ,0)
	2966	...S PRCA BN=""
	2967	"RTN","PRC AACR1",187 ,0)
	2968	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2969	"RTN","PRC AACR1",188 ,0)
	2970	....S PRC ATN=""
	2971	"RTN","PRC AACR1",189 ,0)
	2972	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	2973	D
	2974	"RTN","PRC AACR1",190 ,0)
	2975	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	2976	"RTN","PRC AACR1",191 ,0)
	2977	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	2978	"RTN","PRC AACR1",192 ,0)
	2979	.....S PR CAIEN=PRCA IEN+1
	2980	"RTN","PRC AACR1",193 ,0)
	2981	.....; Ad d Auto-Cor rect Date
	2982	"RTN","PRC AACR1",194 ,0)
	2983	.....S PR CATEMP=$P( PRCADATA,U ,1),$E(PRC ATEMP,14)= " "
	2984	"RTN","PRC AACR1",195 ,0)
	2985	.....; Ad d 18 chars of Debtor 's name
	2986	"RTN","PRC AACR1",196 ,0)
	2987	.....S PR CATEMP=PRC ATEMP_$E($ P(PRCADATA ,U,2),1,18 ),$E(PRCAT EMP,34)=" "
	2988	"RTN","PRC AACR1",197 ,0)
	2989	.....; Ad d Bill Num ber
	2990	"RTN","PRC AACR1",198 ,0)
	2991	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 3),$E(PRCA TEMP,47)=" "
	2992	"RTN","PRC AACR1",199 ,0)
	2993	.....; Ad d SSN
	2994	"RTN","PRC AACR1",200 ,0)
	2995	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 4),$E(PRCA TEMP,53)=" "
	2996	"RTN","PRC AACR1",201 ,0)
	2997	.....; Ad d Transact ion Number
	2998	"RTN","PRC AACR1",202 ,0)
	2999	.....S PR CATEMP=PRC ATEMP_$J($ P(PRCADATA ,U,5),9),$ E(PRCATEMP ,64)=" "
	3000	"RTN","PRC AACR1",203 ,0)
	3001	.....; Ad d Auto-Cor rect Reaso n
	3002	"RTN","PRC AACR1",204 ,0)
	3003	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 6)
	3004	"RTN","PRC AACR1",205 ,0)
	3005	.....S ^T MP("PRCAAC R1",$J,PRC AIEN)=PRCA TEMP
	3006	"RTN","PRC AACR1",206 ,0)
	3007	.....Q
	3008	"RTN","PRC AACR1",207 ,0)
	3009	;
	3010	"RTN","PRC AACR1",208 ,0)
	3011	; Send Ma ilMan mess age with N o Forward
	3012	"RTN","PRC AACR1",209 ,0)
	3013	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ
	3014	"RTN","PRC AACR1",210 ,0)
	3015	I PRCASOR T=1 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N REASON)
	3016	"
	3017	"RTN","PRC AACR1",211 ,0)
	3018	I PRCASOR T=2 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY DEBT OR)"
	3019	"RTN","PRC AACR1",212 ,0)
	3020	I PRCASOR T=3 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY BILL #)"
	3021	"RTN","PRC AACR1",213 ,0)
	3022	I PRCASOR T=4 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY TRAN SACTION NU MBER)"
	3023	"RTN","PRC AACR1",214 ,0)
	3024	I PRCASOR T=5 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N DATE)"
	3025	"RTN","PRC AACR1",215 ,0)
	3026	S XMTO(DU Z)=""
	3027	"RTN","PRC AACR1",216 ,0)
	3028	S XMBODY= "^TMP(""PR CAACR1"",$ J)"
	3029	"RTN","PRC AACR1",217 ,0)
	3030	S XMINSTR ("FLAGS")= "X"
	3031	"RTN","PRC AACR1",218 ,0)
	3032	S XMDUZ=D UZ
	3033	"RTN","PRC AACR1",219 ,0)
	3034	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	3035	"RTN","PRC AACR1",220 ,0)
	3036	D HOME^%Z IS
	3037	"RTN","PRC AACR1",221 ,0)
	3038	K IO("Q") ,POP
	3039	"RTN","PRC AACR1",222 ,0)
	3040	K ^TMP("P RCAACR",$J )
	3041	"RTN","PRC AACR1",223 ,0)
	3042	K ^TMP("P RCAACR1",$ J)
	3043	"RTN","PRC AACR1",224 ,0)
	3044	K PRCABDT ,PRCAEDT,P RCASORT
	3045	"RTN","PRC AACR1",225 ,0)
	3046	Q
	3047	"RTN","PRC AACR1",226 ,0)
	3048	;
	3049	"RTN","PRC AACR1",227 ,0)
	3050	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	3051	"RTN","PRC AACR1",228 ,0)
	3052	S PAGE=PA GE+1
	3053	"RTN","PRC AACR1",229 ,0)
	3054	S PRCAIEN =PRCAIEN+1
	3055	"RTN","PRC AACR1",230 ,0)
	3056	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3057	"RTN","PRC AACR1",231 ,0)
	3058	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	3059	"RTN","PRC AACR1",232 ,0)
	3060	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION REASON)"
	3061	"RTN","PRC AACR1",233 ,0)
	3062	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	3063	"RTN","PRC AACR1",234 ,0)
	3064	S PRCAIEN =PRCAIEN+1
	3065	"RTN","PRC AACR1",235 ,0)
	3066	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3067	"RTN","PRC AACR1",236 ,0)
	3068	S PRCAIEN =PRCAIEN+1
	3069	"RTN","PRC AACR1",237 ,0)
	3070	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	3071	"RTN","PRC AACR1",238 ,0)
	3072	S PRCAIEN =PRCAIEN+1
	3073	"RTN","PRC AACR1",239 ,0)
	3074	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3075	"RTN","PRC AACR1",240 ,0)
	3076	S PRCADAT A="AUTO-C REASON D EBTOR S SN BILL NO. TR ANS NUM
	3077	AUTO-C DAT E"
	3078	"RTN","PRC AACR1",241 ,0)
	3079	S PRCAIEN =PRCAIEN+1
	3080	"RTN","PRC AACR1",242 ,0)
	3081	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3082	"RTN","PRC AACR1",243 ,0)
	3083	S PRCADAT A="------- ------- - ---------- ------- - --- ----- ------ -- -------
	3084	---------- --"
	3085	"RTN","PRC AACR1",244 ,0)
	3086	S PRCAIEN =PRCAIEN+1
	3087	"RTN","PRC AACR1",245 ,0)
	3088	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3089	"RTN","PRC AACR1",246 ,0)
	3090	Q
	3091	"RTN","PRC AACR1",247 ,0)
	3092	;
	3093	"RTN","PRC AACR1",248 ,0)
	3094	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	3095	"RTN","PRC AACR1",249 ,0)
	3096	S PAGE=PA GE+1
	3097	"RTN","PRC AACR1",250 ,0)
	3098	S PRCAIEN =PRCAIEN+1
	3099	"RTN","PRC AACR1",251 ,0)
	3100	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3101	"RTN","PRC AACR1",252 ,0)
	3102	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	3103	"RTN","PRC AACR1",253 ,0)
	3104	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY DEBTOR )"
	3105	"RTN","PRC AACR1",254 ,0)
	3106	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	3107	"RTN","PRC AACR1",255 ,0)
	3108	S PRCAIEN =PRCAIEN+1
	3109	"RTN","PRC AACR1",256 ,0)
	3110	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3111	"RTN","PRC AACR1",257 ,0)
	3112	S PRCAIEN =PRCAIEN+1
	3113	"RTN","PRC AACR1",258 ,0)
	3114	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	3115	"RTN","PRC AACR1",259 ,0)
	3116	S PRCAIEN =PRCAIEN+1
	3117	"RTN","PRC AACR1",260 ,0)
	3118	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3119	"RTN","PRC AACR1",261 ,0)
	3120	S PRCADAT A="DEBTOR BILL NO . SSN TRANS NU M AUTO-C DATE AU
	3121	TO-C REASO N"
	3122	"RTN","PRC AACR1",262 ,0)
	3123	S PRCAIEN =PRCAIEN+1
	3124	"RTN","PRC AACR1",263 ,0)
	3125	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3126	"RTN","PRC AACR1",264 ,0)
	3127	S PRCADAT A="------- ---------- - ------- ---- ---- -------- - ------- ----- --
	3128	---------- --"
	3129	"RTN","PRC AACR1",265 ,0)
	3130	S PRCAIEN =PRCAIEN+1
	3131	"RTN","PRC AACR1",266 ,0)
	3132	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3133	"RTN","PRC AACR1",267 ,0)
	3134	Q
	3135	"RTN","PRC AACR1",268 ,0)
	3136	;
	3137	"RTN","PRC AACR1",269 ,0)
	3138	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	3139	"RTN","PRC AACR1",270 ,0)
	3140	S PAGE=PA GE+1
	3141	"RTN","PRC AACR1",271 ,0)
	3142	S PRCAIEN =PRCAIEN+1
	3143	"RTN","PRC AACR1",272 ,0)
	3144	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3145	"RTN","PRC AACR1",273 ,0)
	3146	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	3147	"RTN","PRC AACR1",274 ,0)
	3148	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY BILL # )"
	3149	"RTN","PRC AACR1",275 ,0)
	3150	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	3151	"RTN","PRC AACR1",276 ,0)
	3152	S PRCAIEN =PRCAIEN+1
	3153	"RTN","PRC AACR1",277 ,0)
	3154	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3155	"RTN","PRC AACR1",278 ,0)
	3156	S PRCAIEN =PRCAIEN+1
	3157	"RTN","PRC AACR1",279 ,0)
	3158	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	3159	"RTN","PRC AACR1",280 ,0)
	3160	S PRCAIEN =PRCAIEN+1
	3161	"RTN","PRC AACR1",281 ,0)
	3162	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3163	"RTN","PRC AACR1",282 ,0)
	3164	S PRCADAT A="BILL NO . DEBT OR SSN TRANS NU M AUTO-C DATE AU
	3165	TO-C REASO N"
	3166	"RTN","PRC AACR1",283 ,0)
	3167	S PRCAIEN =PRCAIEN+1
	3168	"RTN","PRC AACR1",284 ,0)
	3169	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3170	"RTN","PRC AACR1",285 ,0)
	3171	S PRCADAT A="------- ---- ---- ---------- ---- ---- -------- - ------- ----- --
	3172	---------- --"
	3173	"RTN","PRC AACR1",286 ,0)
	3174	S PRCAIEN =PRCAIEN+1
	3175	"RTN","PRC AACR1",287 ,0)
	3176	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3177	"RTN","PRC AACR1",288 ,0)
	3178	Q
	3179	"RTN","PRC AACR1",289 ,0)
	3180	;
	3181	"RTN","PRC AACR1",290 ,0)
	3182	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	3183	"RTN","PRC AACR1",291 ,0)
	3184	S PAGE=PA GE+1
	3185	"RTN","PRC AACR1",292 ,0)
	3186	S PRCAIEN =PRCAIEN+1
	3187	"RTN","PRC AACR1",293 ,0)
	3188	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3189	"RTN","PRC AACR1",294 ,0)
	3190	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	3191	"RTN","PRC AACR1",295 ,0)
	3192	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY TRANSA CTION NUMB ER)"
	3193	"RTN","PRC AACR1",296 ,0)
	3194	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	3195	"RTN","PRC AACR1",297 ,0)
	3196	S PRCAIEN =PRCAIEN+1
	3197	"RTN","PRC AACR1",298 ,0)
	3198	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3199	"RTN","PRC AACR1",299 ,0)
	3200	S PRCAIEN =PRCAIEN+1
	3201	"RTN","PRC AACR1",300 ,0)
	3202	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	3203	"RTN","PRC AACR1",301 ,0)
	3204	S PRCAIEN =PRCAIEN+1
	3205	"RTN","PRC AACR1",302 ,0)
	3206	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3207	"RTN","PRC AACR1",303 ,0)
	3208	S PRCADAT A="TRANS N UM DEBTOR BILL N O. SSN AUTO-C DATE AU
	3209	TO-C REASO N"
	3210	"RTN","PRC AACR1",304 ,0)
	3211	S PRCAIEN =PRCAIEN+1
	3212	"RTN","PRC AACR1",305 ,0)
	3213	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3214	"RTN","PRC AACR1",306 ,0)
	3215	S PRCADAT A="------- -- ------ ---------- -- ------ ----- --- - ------- ----- --
	3216	---------- --"
	3217	"RTN","PRC AACR1",307 ,0)
	3218	S PRCAIEN =PRCAIEN+1
	3219	"RTN","PRC AACR1",308 ,0)
	3220	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3221	"RTN","PRC AACR1",309 ,0)
	3222	Q
	3223	"RTN","PRC AACR1",310 ,0)
	3224	;
	3225	"RTN","PRC AACR1",311 ,0)
	3226	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	3227	"RTN","PRC AACR1",312 ,0)
	3228	S PAGE=PA GE+1
	3229	"RTN","PRC AACR1",313 ,0)
	3230	S PRCAIEN =PRCAIEN+1
	3231	"RTN","PRC AACR1",314 ,0)
	3232	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3233	"RTN","PRC AACR1",315 ,0)
	3234	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	3235	"RTN","PRC AACR1",316 ,0)
	3236	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION DATE)"
	3237	"RTN","PRC AACR1",317 ,0)
	3238	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	3239	"RTN","PRC AACR1",318 ,0)
	3240	S PRCAIEN =PRCAIEN+1
	3241	"RTN","PRC AACR1",319 ,0)
	3242	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3243	"RTN","PRC AACR1",320 ,0)
	3244	S PRCAIEN =PRCAIEN+1
	3245	"RTN","PRC AACR1",321 ,0)
	3246	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	3247	"RTN","PRC AACR1",322 ,0)
	3248	S PRCAIEN =PRCAIEN+1
	3249	"RTN","PRC AACR1",323 ,0)
	3250	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	3251	"RTN","PRC AACR1",324 ,0)
	3252	S PRCADAT A="AUTO-C DATE DEB TOR BIL L NO. SSN TRAN S NUM AU
	3253	TO-C REASO N"
	3254	"RTN","PRC AACR1",325 ,0)
	3255	S PRCAIEN =PRCAIEN+1
	3256	"RTN","PRC AACR1",326 ,0)
	3257	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3258	"RTN","PRC AACR1",327 ,0)
	3259	S PRCADAT A="------- ----- --- ---------- ----- --- -------- ---- ---- ----- --
	3260	---------- --"
	3261	"RTN","PRC AACR1",328 ,0)
	3262	S PRCAIEN =PRCAIEN+1
	3263	"RTN","PRC AACR1",329 ,0)
	3264	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	3265	"RTN","PRC AACR1",330 ,0)
	3266	Q
	3267	"RTN","PRC AACR1",331 ,0)
	3268	;
	3269	"RTN","PRC AACR1",332 ,0)
	3270	EXIT ;
	3271	"RTN","PRC AACR1",333 ,0)
	3272	Q
	3273	"RTN","PRC ACPS")
	3274	0^27^B2540 66716^n/a
	3275	"RTN","PRC ACPS",1,0)
	3276	PRCACPS ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION ;09/2 1/15 3:34 PM
	3277	"RTN","PRC ACPS",2,0)
	3278	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 124
	3279	"RTN","PRC ACPS",3,0)
	3280	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3281	"RTN","PRC ACPS",4,0)
	3282	;
	3283	"RTN","PRC ACPS",5,0)
	3284	Q
	3285	"RTN","PRC ACPS",6,0)
	3286	;
	3287	"RTN","PRC ACPS",7,0)
	3288	BEGIN ; En try point for manual run
	3289	"RTN","PRC ACPS",8,0)
	3290	; Determi ne if Auto Correct p rocess is currently running
	3291	"RTN","PRC ACPS",9,0)
	3292	N DIR,PRC ASTRT,QUIT ,X,X1,X2,Y
	3293	"RTN","PRC ACPS",10,0 )
	3294	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= 0
	3295	"RTN","PRC ACPS",11,0 )
	3296	; Notify user if Au to Correct process i s currentl y running
	3297	"RTN","PRC ACPS",12,0 )
	3298	I PRCASTR T'="" D Q :QUIT
	3299	"RTN","PRC ACPS",13,0 )
	3300	.S Y=$P(P RCASTRT,U, 2)
	3301	"RTN","PRC ACPS",14,0 )
	3302	.D DD^%DT
	3303	"RTN","PRC ACPS",15,0 )
	3304	.S PRCAST RT=Y
	3305	"RTN","PRC ACPS",16,0 )
	3306	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram was pr eviously s tarted on
	3307	"
	3308	"RTN","PRC ACPS",17,0 )
	3309	.W !,PRCA STRT," and has not y et success fully comp leted."
	3310	"RTN","PRC ACPS",18,0 )
	3311	.W !!,"Th e job can take up to 1 hour to complete when sched uled to ru n outside
	3312	"
	3313	"RTN","PRC ACPS",19,0 )
	3314	.W !,"of normal bus iness hour s and long er if run during nor mal busine ss hours"
	3315	"RTN","PRC ACPS",20,0 )
	3316	.W !,"whe n the load on the sy stem is gr eater."
	3317	"RTN","PRC ACPS",21,0 )
	3318	.W !!
	3319	"RTN","PRC ACPS",22,0 )
	3320	.W !,"If it has bee n more tha n an hour since the Patient St atement Au to-Correc
	3321	tion"
	3322	"RTN","PRC ACPS",23,0 )
	3323	.W !,"Pro gram was s tarted and the confi rmation e- mail with subject: C PS"
	3324	"RTN","PRC ACPS",24,0 )
	3325	.W !,"AUT O-CORRECTI ON COMPLET E has not been sent to the PRC ACPS mail group, yo
	3326	u can"
	3327	"RTN","PRC ACPS",25,0 )
	3328	.W !,"run the Patie nt Stateme nt Auto-Co rrection P rogram aga in."
	3329	"RTN","PRC ACPS",26,0 )
	3330	.W !
	3331	"RTN","PRC ACPS",27,0 )
	3332	.S DIR("A ")="Do you want to r un the Pat ient State ment Auto- Correction Program
	3333	again"
	3334	"RTN","PRC ACPS",28,0 )
	3335	.S DIR(0) ="Y",DIR(" B")="NO"
	3336	"RTN","PRC ACPS",29,0 )
	3337	.D ^DIR
	3338	"RTN","PRC ACPS",30,0 )
	3339	.W !
	3340	"RTN","PRC ACPS",31,0 )
	3341	.; Quit i f ^, ^^, T imeout or No
	3342	"RTN","PRC ACPS",32,0 )
	3343	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	3344	"RTN","PRC ACPS",33,0 )
	3345	.K DTOUT, DUOUT,DIRO UT
	3346	"RTN","PRC ACPS",34,0 )
	3347	.Q
	3348	"RTN","PRC ACPS",35,0 )
	3349	;
	3350	"RTN","PRC ACPS",36,0 )
	3351	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	3352	"RTN","PRC ACPS",37,0 )
	3353	W !,"Queu e the pati ent statem ent discre pancies au to-correct ion progra m to run:
	3354	"
	3355	"RTN","PRC ACPS",38,0 )
	3356	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	3357	"RTN","PRC ACPS",39,0 )
	3358	S ZTRTN=" START^PRCA CPS",ZTIO= ""
	3359	"RTN","PRC ACPS",40,0 )
	3360	D ^%ZTLOA D
	3361	"RTN","PRC ACPS",41,0 )
	3362	Q
	3363	"RTN","PRC ACPS",42,0 )
	3364	;
	3365	"RTN","PRC ACPS",43,0 )
	3366	START ; En try point for Schedu led backgr ound job
	3367	"RTN","PRC ACPS",44,0 )
	3368	N DEBTOR, DEBTOR0,DE BTOR1,PRCA STRT,REFRE V,X,Y
	3369	"RTN","PRC ACPS",45,0 )
	3370	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0))
	3371	"RTN","PRC ACPS",46,0 )
	3372	; If a pr evious job still run ning send e-mail war ning to PR CACPS mail group
	3373	"RTN","PRC ACPS",47,0 )
	3374	I PRCASTR T'="" D
	3375	"RTN","PRC ACPS",48,0 )
	3376	.S Y=$P(P RCASTRT,U, 2)
	3377	"RTN","PRC ACPS",49,0 )
	3378	.; Conver t date to external f ormat
	3379	"RTN","PRC ACPS",50,0 )
	3380	.D DD^%DT
	3381	"RTN","PRC ACPS",51,0 )
	3382	.S PRCAST RT=Y
	3383	"RTN","PRC ACPS",52,0 )
	3384	.; Send m ail to PRC ACPS mail group noti ng previou s run didn 't complet e
	3385	"RTN","PRC ACPS",53,0 )
	3386	.D PRCAMA IL^PRCACPS A(PRCASTRT )
	3387	"RTN","PRC ACPS",54,0 )
	3388	.Q
	3389	"RTN","PRC ACPS",55,0 )
	3390	; Get cur rent date/ time
	3391	"RTN","PRC ACPS",56,0 )
	3392	D NOW^%DT C
	3393	"RTN","PRC ACPS",57,0 )
	3394	S (PRCAST RT,X1)=%,X 2=8
	3395	"RTN","PRC ACPS",58,0 )
	3396	D C^%DTC
	3397	"RTN","PRC ACPS",59,0 )
	3398	S ^XTMP(" PRCACPS",0 )=X_U_PRCA STRT_U_"Pa tient Stat ement Auto -Correctio n Program
	3399	"
	3400	"RTN","PRC ACPS",60,0 )
	3401	; Loop th rough C x- ref in 430 . This fie ld points to the Deb tor File, which in
	3402	turn is a
	3403	"RTN","PRC ACPS",61,0 )
	3404	; variabl e pointer to other f iles.
	3405	"RTN","PRC ACPS",62,0 )
	3406	S DEBTOR= 0
	3407	"RTN","PRC ACPS",63,0 )
	3408	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	3409	"RTN","PRC ACPS",64,0 )
	3410	.; Perfor m the same in/out of balance c heck as th e CHECK PA TIENT ACCO UNT BALAN
	3411	CE option
	3412	"RTN","PRC ACPS",65,0 )
	3413	.; Quit t o next deb tor if acc ount is in balance
	3414	"RTN","PRC ACPS",66,0 )
	3415	.I '$$EN^ PRCAMRKC(D EBTOR) Q
	3416	"RTN","PRC ACPS",67,0 )
	3417	.S BALDIF F=0
	3418	"RTN","PRC ACPS",68,0 )
	3419	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) )
	3420	"RTN","PRC ACPS",69,0 )
	3421	.; QUIT i f it doesn 't point t o the PATI ENT (^DPT) file
	3422	"RTN","PRC ACPS",70,0 )
	3423	.Q:$P(DEB TOR0,"^")' ["DPT("
	3424	"RTN","PRC ACPS",71,0 )
	3425	.Q:$P(DEB TOR1,"^",9 )=1 ; qui t if debto r address marked unk nown
	3426	"RTN","PRC ACPS",72,0 )
	3427	.; Skip t his Debtor is they a t least 1 Bill in #4 30 with a status of REFUND RE
	3428	VIEW (#44)
	3429	"RTN","PRC ACPS",73,0 )
	3430	.Q:$$REFR EV(DEBTOR)
	3431	"RTN","PRC ACPS",74,0 )
	3432	.; Get pr evious bal ance and d ate of las t transact ion from t he AR EVEN T file (#
	3433	341)
	3434	"RTN","PRC ACPS",75,0 )
	3435	.D ENTER( DEBTOR)
	3436	"RTN","PRC ACPS",76,0 )
	3437	.; Perfor m checks/u pdates bas ed on File #430
	3438	"RTN","PRC ACPS",77,0 )
	3439	.D START1
	3440	"RTN","PRC ACPS",78,0 )
	3441	.; QUIT i f in balan ce
	3442	"RTN","PRC ACPS",79,0 )
	3443	.; *** Re moved so a ll out of balance ac counts to enter STAR T2
	3444	"RTN","PRC ACPS",80,0 )
	3445	.;I BALDI FF=0 K BAL DIFF,^TMP( "PRCAGTPS" ,$J),^TMP( "PRCABILL" ,$J) Q
	3446	"RTN","PRC ACPS",81,0 )
	3447	.; Review Data in ^ TMP and up date #433 as needed
	3448	"RTN","PRC ACPS",82,0 )
	3449	.D START2
	3450	"RTN","PRC ACPS",83,0 )
	3451	.; If the account i s still ou t of balan ce after f ixing ever ything it can
	3452	"RTN","PRC ACPS",84,0 )
	3453	.; call U PDTLTR to mark the l ast transa ction for the accoun t as NOT F IXABLE
	3454	"RTN","PRC ACPS",85,0 )
	3455	.I $$EN^P RCAMRKC(DE BTOR) D UP DTLTR^PRCA CPSA(0)
	3456	"RTN","PRC ACPS",86,0 )
	3457	.; clean up temp in fo and pro cess next debtor
	3458	"RTN","PRC ACPS",87,0 )
	3459	.K BALDIF F,^TMP("PR CAGTPS",$J ),^TMP("PR CABILL",$J )
	3460	"RTN","PRC ACPS",88,0 )
	3461	; Send ma ilman mess age to the PRCACPS m ail group at end of processing
	3462	"RTN","PRC ACPS",89,0 )
	3463	D USRMSG
	3464	"RTN","PRC ACPS",90,0 )
	3465	Q
	3466	"RTN","PRC ACPS",91,0 )
	3467	;
	3468	"RTN","PRC ACPS",92,0 )
	3469	REFREV(DEB TOR) ;
	3470	"RTN","PRC ACPS",93,0 )
	3471	; Check i f any Bill for this Debtor has a status of REFUND REVIEW (#4 4)
	3472	"RTN","PRC ACPS",94,0 )
	3473	N BN,QUIT
	3474	"RTN","PRC ACPS",95,0 )
	3475	S BN="",Q UIT=0
	3476	"RTN","PRC ACPS",96,0 )
	3477	F S BN=$ O(^PRCA(43 0,"C",DEBT OR,BN)) Q: 'BN D Q: QUIT
	3478	"RTN","PRC ACPS",97,0 )
	3479	.; Check CURRENT ST ATUS (#8) for status of REFUND REVIEW (# 44)
	3480	"RTN","PRC ACPS",98,0 )
	3481	.I $P($G( ^PRCA(430, BN,0)),U,8 )=44 S QUI T=1
	3482	"RTN","PRC ACPS",99,0 )
	3483	Q QUIT
	3484	"RTN","PRC ACPS",100, 0)
	3485	;
	3486	"RTN","PRC ACPS",101, 0)
	3487	ENTER(DEBT OR) ;
	3488	"RTN","PRC ACPS",102, 0)
	3489	S (PBAL,B BAL,TBAL)= 0 K ^TMP(" PRCAGTPS", $J)
	3490	"RTN","PRC ACPS",103, 0)
	3491	; Get las t type of event for debtor by calling $$ LST^RCFN01 . Referenc es files
	3492	#340 and # 341.1
	3493	"RTN","PRC ACPS",104, 0)
	3494	S DAT=$$L ST^RCFN01( DEBTOR,2) I DAT<1 S DAT=0
	3495	"RTN","PRC ACPS",105, 0)
	3496	; PBAL^PR CAGU gets previous b alance and date of l ast transa ction from the AR E
	3497	VENT file (#341)
	3498	"RTN","PRC ACPS",106, 0)
	3499	I DAT S D AT=9999999 .999999-DA T D PBAL^P RCAGU(DEBT OR,.DAT,.P BAL)
	3500	"RTN","PRC ACPS",107, 0)
	3501	D EN(DEBT OR,DAT)
	3502	"RTN","PRC ACPS",108, 0)
	3503	K BBAL,TB AL,DAT
	3504	"RTN","PRC ACPS",109, 0)
	3505	Q
	3506	"RTN","PRC ACPS",110, 0)
	3507	;
	3508	"RTN","PRC ACPS",111, 0)
	3509	EN(DEBTOR, BEG,END,TT Y) ;
	3510	"RTN","PRC ACPS",112, 0)
	3511	NEW Y
	3512	"RTN","PRC ACPS",113, 0)
	3513	; If Begi nning date is not de fined, set it to 0 t o start at beginning
	3514	"RTN","PRC ACPS",114, 0)
	3515	; If End date is no t defined, set it to today's d ate
	3516	"RTN","PRC ACPS",115, 0)
	3517	S:$G(BEG) ="" BEG=0 I $G(END)= "" D NOW^% DTC S END= % K %
	3518	"RTN","PRC ACPS",116, 0)
	3519	S TTY=$G( TTY) I TTY ="" D F430
	3520	"RTN","PRC ACPS",117, 0)
	3521	D F433
	3522	"RTN","PRC ACPS",118, 0)
	3523	Q Q
	3524	"RTN","PRC ACPS",119, 0)
	3525	F430 ; Che cks for AC COUNTS REC EIVABLE fi le (#430) for bills with (#3) ORIGINAL
	3526	AMOUNT has a value,
	3527	"RTN","PRC ACPS",120, 0)
	3528	; set thi s into the ^TMP glob al with _" ^0"
	3529	"RTN","PRC ACPS",121, 0)
	3530	NEW DAT,B N
	3531	"RTN","PRC ACPS",122, 0)
	3532	S DAT=BEG F S DAT= $O(^PRCA(4 30,"ATD",D EBTOR,DAT) ) Q:('DAT) !(DAT>END) S BN=0
	3533	F S BN=$O (^PRCA(430 ,"ATD",DEB TOR,DAT,BN )) Q:'BN D
	3534	"RTN","PRC ACPS",123, 0)
	3535	.; Add th e original amount if it is wit hin date r ange based on the da te of the
	3536	last stat ement
	3537	"RTN","PRC ACPS",124, 0)
	3538	.I $P(^PR CA(430,BN, 0),U,3) S ^TMP("PRCA GTPS",$J,D EBTOR,BN,0 )=$P(^PRCA (430,BN,0
	3539	),"^",3)_" ^0"
	3540	"RTN","PRC ACPS",125, 0)
	3541	Q
	3542	"RTN","PRC ACPS",126, 0)
	3543	F433 ;
	3544	"RTN","PRC ACPS",127, 0)
	3545	NEW DAT,T N
	3546	"RTN","PRC ACPS",128, 0)
	3547	; Loop th rough the Dates and Bills
	3548	"RTN","PRC ACPS",129, 0)
	3549	F DAT=BEG :0 S DAT=$ O(^PRCA(43 3,"ATD",DE BTOR,DAT)) Q:('DAT)! (DAT>END) F TN=0:0
	3550	S TN=$O(^ PRCA(433," ATD",DEBTO R,DAT,TN)) Q:'TN D
	3551	"RTN","PRC ACPS",130, 0)
	3552	.S TCMPLT ="",TMBSNC ="",TRDMRD ="",COMM=0
	3553	"RTN","PRC ACPS",131, 0)
	3554	.S TN0=$G (^PRCA(433 ,TN,0)) Q: TN0=""
	3555	"RTN","PRC ACPS",132, 0)
	3556	.S TN1=$G (^PRCA(433 ,TN,1))
	3557	"RTN","PRC ACPS",133, 0)
	3558	.S TN3=$G (^PRCA(433 ,TN,3))
	3559	"RTN","PRC ACPS",134, 0)
	3560	.I $P(TN1 ,U,2)="" Q ;MISSING TRANS TYP E
	3561	"RTN","PRC ACPS",135, 0)
	3562	.; PRCA4 .5313 - S kip proces sing twin transactio ns for Pre payments
	3563	"RTN","PRC ACPS",136, 0)
	3564	.I $P(TN0 ,U,10),$P( $G(^PRCA(4 33,TN,5)), U,1)'="" N HIT,TWIN D I HIT Q
	3565	"RTN","PRC ACPS",137, 0)
	3566	..S HIT=0
	3567	"RTN","PRC ACPS",138, 0)
	3568	..S TWIN= $P(^PRCA(4 33,TN,5),U ,1)
	3569	"RTN","PRC ACPS",139, 0)
	3570	..I '$D(^ PRCA(433,T WIN,0)) Q
	3571	"RTN","PRC ACPS",140, 0)
	3572	..S HIT=1
	3573	"RTN","PRC ACPS",141, 0)
	3574	..S TWIN( 2)=$P(^PRC A(433,TWIN ,0),U,2)
	3575	"RTN","PRC ACPS",142, 0)
	3576	..K ^TMP( "PRCAGTPS" ,$J,DEBTOR ,TWIN(2),T WIN)
	3577	"RTN","PRC ACPS",143, 0)
	3578	.;
	3579	"RTN","PRC ACPS",144, 0)
	3580	.I $P(TN0 ,U,10)=1 S TCMPLT=1
	3581	"RTN","PRC ACPS",145, 0)
	3582	.I $P(TN1 ,U,2)=45 S COMM=1 G F433A
	3583	"RTN","PRC ACPS",146, 0)
	3584	.I $G(TTY )'="" Q:TT Y'=$P(TN1, U,2)
	3585	"RTN","PRC ACPS",147, 0)
	3586	.; Quit i f Transact ion Type i s blank or one of th e followin g:
	3587	"RTN","PRC ACPS",148, 0)
	3588	.; 3:REFE R TO RC, 4 :REFER TO DOJ, 5:REE STABLISH T O RC/DOJ, 6:RETURNED BY RC/DO
	3589	J
	3590	"RTN","PRC ACPS",149, 0)
	3591	.; 7:CASH COLLECTIO N BY RC/DO J, 24:MARS HAL/COURT COST, 25:R EPAYMENT P LAN, 30:D
	3592	EBIT VOUCH ER (SF 551 5)
	3593	"RTN","PRC ACPS",150, 0)
	3594	.I TTY="" ,",3,4,5,6 ,7,24,25,3 0,"[(","_$ P(TN1,U,2) _",") Q
	3595	"RTN","PRC ACPS",151, 0)
	3596	.; QUIT i f BILL NUM BER (#.03) = blank OR TRANSACTI ON STATUS (#4) '= CO MPLETE
	3597	"RTN","PRC ACPS",152, 0)
	3598	.I ($P(TN 0,U,2)="") !($P(TN0,U ,4)'=2) Q
	3599	"RTN","PRC ACPS",153, 0)
	3600	.; IF PRC AHIST="THI ST" AND TR ANSACTION TYPE (#12) = COMMENT (#45) cal l F433A t
	3601	o Set the data into ^TMP("PRCA GTPS",$J,D EBTOR
	3602	"RTN","PRC ACPS",154, 0)
	3603	.I $G(PRC AHIST)="TH IST",$P(TN 1,U,2)=45 G F433A
	3604	"RTN","PRC ACPS",155, 0)
	3605	.; IF TRA NSACTION T YPE (#12) '= to 46 UNSUSPENDE D AND TRAN SACTION TY PE (#12)'
	3606	= to 47 C HARGE SUSP ENDED
	3607	"RTN","PRC ACPS",156, 0)
	3608	.I $P(TN1 ,"^",2)'=4 6,$P(TN1," ^",2)'=47 D I TN1=" " Q
	3609	"RTN","PRC ACPS",157, 0)
	3610	..N RCTRA NDA,RCSTOP ,TRANTYPE
	3611	"RTN","PRC ACPS",158, 0)
	3612	..S RCSTO P=0
	3613	"RTN","PRC ACPS",159, 0)
	3614	..; Loop BACKWARDS through th e BILL NUM BER "C" x- ref
	3615	"RTN","PRC ACPS",160, 0)
	3616	..S RCTRA NDA=TN
	3617	"RTN","PRC ACPS",161, 0)
	3618	..F S RC TRANDA=$O( ^PRCA(433, "C",+$P(TN 0,"^",2),R CTRANDA),- 1) Q:'RCTR ANDA D
	3619	I RCSTOP Q
	3620	"RTN","PRC ACPS",162, 0)
	3621	...; QUIT if TRANSA CTION STAT US (#4) '= COMPLETE
	3622	"RTN","PRC ACPS",163, 0)
	3623	...I $P($ G(^PRCA(43 3,RCTRANDA ,0)),"^",4 )'=2 Q
	3624	"RTN","PRC ACPS",164, 0)
	3625	...; Load Transacti on Type
	3626	"RTN","PRC ACPS",165, 0)
	3627	...S TRAN TYPE=$P($G (^PRCA(433 ,RCTRANDA, 1)),"^",2)
	3628	"RTN","PRC ACPS",166, 0)
	3629	...; IF T RANSACTION TYPE (#12 ) = 46 UNS USPENDED s et stop & Quit
	3630	"RTN","PRC ACPS",167, 0)
	3631	...I TRAN TYPE=46 S RCSTOP=1 Q
	3632	"RTN","PRC ACPS",168, 0)
	3633	...; IF T RANSACTION TYPE (#12 ) = 47 CHA RGE SUSPEN DED set st op & Quit
	3634	"RTN","PRC ACPS",169, 0)
	3635	...I TRAN TYPE=47 S RCSTOP=1,T N1="" Q
	3636	"RTN","PRC ACPS",170, 0)
	3637	F433A .
	3638	"RTN","PRC ACPS",171, 0)
	3639	.; The da ta in the ^TMP is as follows:
	3640	"RTN","PRC ACPS",172, 0)
	3641	.; Data =
	3642	"RTN","PRC ACPS",173, 0)
	3643	.; 1. TRA NS. AMOUNT (#15) $ P(TN1,U,5)
	3644	"RTN","PRC ACPS",174, 0)
	3645	.; 2. TRA NSACTION T YPE (#12) $ P(TN1,U,2)
	3646	"RTN","PRC ACPS",175, 0)
	3647	.; 3. PRI N.COLLECTE D (#31) $ P(TN3,U,1)
	3648	"RTN","PRC ACPS",176, 0)
	3649	.; 4. INT EREST COLL ECTED (#32 ) $ P(TN3,U,2)
	3650	"RTN","PRC ACPS",177, 0)
	3651	.; 5. ADM IN.COLLECT ED (#33) $ P(TN3,U,3)
	3652	"RTN","PRC ACPS",178, 0)
	3653	.; 6. MAR SHAL FEE C OLLECTED ( #34) $ P(TN3,U,4)
	3654	"RTN","PRC ACPS",179, 0)
	3655	.; 7. COU RT COST CO LLECTED (# 35) $ P(TN3,U,5)
	3656	"RTN","PRC ACPS",180, 0)
	3657	.; 8. TOT AL OF #3 - #7 $ P(TN3,U,1) +$P(TN3,U, 2)+$P(TN3, U,3)+$P(T
	3658	N3,U,4)+$P (TN3,U,5)
	3659	"RTN","PRC ACPS",181, 0)
	3660	.; 9. TCM PLT ( #10) INCOM PLETE TRAN SACTION FL AG
	3661	"RTN","PRC ACPS",182, 0)
	3662	.;10. TRD MRD - Does n't appear to be use d
	3663	"RTN","PRC ACPS",183, 0)
	3664	.;11. TMB SNC - Does n't appear to be use d
	3665	"RTN","PRC ACPS",184, 0)
	3666	.;12. Dup licate fla g for use in START2 1=duplicat e, 0=not a duplicate . Set in
	3667	BILLQUIT^P RCACPSA
	3668	"RTN","PRC ACPS",185, 0)
	3669	.;
	3670	"RTN","PRC ACPS",186, 0)
	3671	.N PRCATE MP
	3672	"RTN","PRC ACPS",187, 0)
	3673	.S PRCATE MP=$P(TN1, U,5)_U_$P( TN1,U,2)_U _$P(TN3,U, 1)_U_$P(TN 3,U,2)_U_$ P(TN3,U,3
	3674	)_U_$P(TN3 ,U,4)_U_$P (TN3,U,5)
	3675	"RTN","PRC ACPS",188, 0)
	3676	.S PRCATE MP=PRCATEM P_U_($P(TN 3,U,1)+$P( TN3,U,2)+$ P(TN3,U,3) +$P(TN3,U, 4)+$P(TN3
	3677	,U,5))
	3678	"RTN","PRC ACPS",189, 0)
	3679	.S PRCATE MP=PRCATEM P_U_TCMPLT
	3680	"RTN","PRC ACPS",190, 0)
	3681	.S PRCATE MP=PRCATEM P_U_TRDMRD
	3682	"RTN","PRC ACPS",191, 0)
	3683	.S PRCATE MP=PRCATEM P_U_TMBSNC
	3684	"RTN","PRC ACPS",192, 0)
	3685	.S ^TMP(" PRCAGTPS", $J,DEBTOR, $P(TN0,U,2 ),TN)=PRCA TEMP
	3686	"RTN","PRC ACPS",193, 0)
	3687	.K TN0,TN 1,TN3,TCMP LT,TRDMRD, TMBSNC,COM M
	3688	"RTN","PRC ACPS",194, 0)
	3689	K PRCAHIS T
	3690	"RTN","PRC ACPS",195, 0)
	3691	Q
	3692	"RTN","PRC ACPS",196, 0)
	3693	;
	3694	"RTN","PRC ACPS",197, 0)
	3695	START1 ;
	3696	"RTN","PRC ACPS",198, 0)
	3697	;
	3698	"RTN","PRC ACPS",199, 0)
	3699	S BILL=""
	3700	"RTN","PRC ACPS",200, 0)
	3701	S CBALTOT =0 ; Will be the tot al of all CURRENT BA LANCE fiel d (#11) fo r the acc
	3702	ount
	3703	"RTN","PRC ACPS",201, 0)
	3704	; ACCOUNT S RECEIVAB LE (#430) The C cros s-referenc e allows u ser look-u p of bill
	3705	s belongin g to a spe cific debt or.
	3706	"RTN","PRC ACPS",202, 0)
	3707	; Loop th rough bill s
	3708	"RTN","PRC ACPS",203, 0)
	3709	; ^TMP("P RCABILL",$ J,DEBTOR,B ILL)= Sum of CURRENT BALANCE f ield (#11) for the
	3710	Bill
	3711	"RTN","PRC ACPS",204, 0)
	3712	; ^Sum of TRANS. AMOUNT (#1 5) for all transact
	3713	ions for t he Bill
	3714	"RTN","PRC ACPS",205, 0)
	3715	; ^Stop Flag if t he Bill ha s more tha n one err
	3716	or
	3717	"RTN","PRC ACPS",206, 0)
	3718	K ^TMP("P RCABILL",$ J)
	3719	"RTN","PRC ACPS",207, 0)
	3720	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	3721	"RTN","PRC ACPS",208, 0)
	3722	.; BILLTO T is the C URRENT BAL ANCE field (#11) for each Bill for the D ebtor
	3723	"RTN","PRC ACPS",209, 0)
	3724	.N BILLTO T
	3725	"RTN","PRC ACPS",210, 0)
	3726	.S BN0=$G (^PRCA(430 ,BILL,0))
	3727	"RTN","PRC ACPS",211, 0)
	3728	.; QUIT: CURRENT ST ATUS (#8) '= ACTIVE
	3729	"RTN","PRC ACPS",212, 0)
	3730	.; I $P(B N0,U,8)'=1 6 Q based on call o n 11/28/16 process a ll bill wi th a stat
	3731	us other t han Refund Review
	3732	"RTN","PRC ACPS",213, 0)
	3733	.; Skip a ll Debtors with 1 or more Bill s with a s tatus of R EFEUND REV IEW (#44)
	3734	. This ch eck is don e in
	3735	"RTN","PRC ACPS",214, 0)
	3736	.; REFREV above.
	3737	"RTN","PRC ACPS",215, 0)
	3738	.; Sum up CURRENT B ALANCE (#1 1) for eac h ACTIVE B ill
	3739	"RTN","PRC ACPS",216, 0)
	3740	.; Set in CBALTOT f or BALDIFF and in PR CABILL for BILLDIFF in Start2
	3741	"RTN","PRC ACPS",217, 0)
	3742	.; S CBAL TOT=CBALTO T+$$GET1^D IQ(430,BIL L,11)
	3743	"RTN","PRC ACPS",218, 0)
	3744	.S BILLTO T=$$GET1^D IQ(430,BIL L,11) ; Ge t CURRENT BALANCE (# 11) which is comput
	3745	ed: #71+#7 2+#73+#74+ #75
	3746	"RTN","PRC ACPS",219, 0)
	3747	.S ^TMP(" PRCABILL", $J,DEBTOR, BILL)=+BIL LTOT
	3748	"RTN","PRC ACPS",220, 0)
	3749	.S CBALTO T=CBALTOT+ BILLTOT
	3750	"RTN","PRC ACPS",221, 0)
	3751	N BILL,I, TN,TRANSTO T,TNVAL,TT YPE,TNTOT
	3752	"RTN","PRC ACPS",222, 0)
	3753	S TN="",( BILL,TRANS TOT,TTYPE, TNVAL)=0
	3754	"RTN","PRC ACPS",223, 0)
	3755	; Loop th rough Bill s
	3756	"RTN","PRC ACPS",224, 0)
	3757	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	3758	"RTN","PRC ACPS",225, 0)
	3759	.; Call B ILLQUIT to determine if this b ill has mu ltiple iss ues
	3760	"RTN","PRC ACPS",226, 0)
	3761	.I $$BILL QUIT^PRCAC PSA(DEBTOR ,BILL) Q
	3762	"RTN","PRC ACPS",227, 0)
	3763	.; Initia lize TNTOT for Trans action Tot al for thi s bill
	3764	"RTN","PRC ACPS",228, 0)
	3765	.I $G(TNT OT(BILL))= "" S TNTOT (BILL)=0
	3766	"RTN","PRC ACPS",229, 0)
	3767	.; Loop t hrough Tra nsactions
	3768	"RTN","PRC ACPS",230, 0)
	3769	.S TN=0 F S TN=$O( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN)) Q:TN ="" D
	3770	"RTN","PRC ACPS",231, 0)
	3771	..; IF Tr ansaction # = 0 Add TRANS. AMO UNT (#15) to the Tra nsaction T otal
	3772	"RTN","PRC ACPS",232, 0)
	3773	..; I TN= 0 S TRANST OT=TRANSTO T+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN) Q
	3774	"RTN","PRC ACPS",233, 0)
	3775	..; S TNV AL = (#15) TRANS. AM OUNT from #433
	3776	"RTN","PRC ACPS",234, 0)
	3777	..S TNVAL =+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)
	3778	"RTN","PRC ACPS",235, 0)
	3779	..; S TTY PE = (#12) TRANSACTI ON TYPE fr om #433
	3780	"RTN","PRC ACPS",236, 0)
	3781	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	3782	"RTN","PRC ACPS",237, 0)
	3783	..; IF IN COMPLETE T RANSACTION FLAG is s et, set Tr ansaction amount = 0
	3784	"RTN","PRC ACPS",238, 0)
	3785	..S TCMPL T=+$P(^TMP ("PRCAGTPS ",$J,DEBTO R,BILL,TN) ,U,9)
	3786	"RTN","PRC ACPS",239, 0)
	3787	..I TCMPL T S TNVAL= 0
	3788	"RTN","PRC ACPS",240, 0)
	3789	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	3790	"RTN","PRC ACPS",241, 0)
	3791	..I TMBSN C S TNVAL= 0
	3792	"RTN","PRC ACPS",242, 0)
	3793	..; Set T NVAL =0 if one of th e followin g Transact ion Types:
	3794	"RTN","PRC ACPS",243, 0)
	3795	..; 3:REF ER TO RC, 4:REFER TO DOJ, 5:RE ESTABLISH TO RC/DOJ, 6:RETURNE D BY RC/D
	3796	OJ
	3797	"RTN","PRC ACPS",244, 0)
	3798	..; 25:RE PAYMENT PL AN, 32:RET URNED FOR AMENDMENT, 33:AMENDE D BILL
	3799	"RTN","PRC ACPS",245, 0)
	3800	..I (TTYP E=3)!(TTYP E=4)!(TTYP E=5)!(TTYP E=6)!(TTYP E=32)!(TTY PE=25)!(TT YPE=33) S
	3801	TNVAL=0
	3802	"RTN","PRC ACPS",246, 0)
	3803	..; Set T NVAL to ne gative val ue if one of the Tra nsaction T ypes:
	3804	"RTN","PRC ACPS",247, 0)
	3805	..; 2:PAY MENT (IN P ART), 8:TE RM.BY FIS. OFFICER, 9 :TERM.BY C OMPROMISE, 10:WAIVE
	3806	D IN FULL
	3807	"RTN","PRC ACPS",248, 0)
	3808	..; 11:WA IVED IN PA RT, 14:EXE MPT INT/AD M. COST, 2 9:TERM.BY RC/DOJ, 34 :PAYMENT
	3809	(IN FULL)
	3810	"RTN","PRC ACPS",249, 0)
	3811	..; 35:DE CREASE ADJ USTMENT, 4 1:REFUNDED , 47:CHARG E SUSPENDE D
	3812	"RTN","PRC ACPS",250, 0)
	3813	..I TTYPE =2!(TTYPE= 8)!(TTYPE= 9)!(TTYPE= 10)!(TTYPE =11)!(TTYP E=14)!(TTY PE=29)!(T
	3814	TYPE=34)!( TTYPE=35)! (TTYPE=41) !(TTYPE=47 ) S TNVAL= -TNVAL
	3815	"RTN","PRC ACPS",251, 0)
	3816	..; Updat e Transact ion Total
	3817	"RTN","PRC ACPS",252, 0)
	3818	..S TRANS TOT=TRANST OT+TNVAL
	3819	"RTN","PRC ACPS",253, 0)
	3820	..; Updat e Transact ion Total for this B ill
	3821	"RTN","PRC ACPS",254, 0)
	3822	..S TNTOT (BILL)=TNT OT(BILL)+T NVAL
	3823	"RTN","PRC ACPS",255, 0)
	3824	.; Update PRCABILL with Trans action Tot al for thi s Bill
	3825	"RTN","PRC ACPS",256, 0)
	3826	.S $P(^TM P("PRCABIL L",$J,DEBT OR,BILL),U ,2)=TNTOT( BILL)
	3827	"RTN","PRC ACPS",257, 0)
	3828	; Set Bal ance Diffe rence = Su m up CURRE NT BALANCE (#8) for each ACTIV E Bill -
	3829	Transactio n Total fo r all bill s - PBAL f rom AR EVE NT file (# 341)
	3830	"RTN","PRC ACPS",258, 0)
	3831	S BALDIFF =CBALTOT-T RANSTOT-PB AL
	3832	"RTN","PRC ACPS",259, 0)
	3833	K CBALTOT ,TRANSTOT, PBAL,TCMPL T,BILL,BN0
	3834	"RTN","PRC ACPS",260, 0)
	3835	Q
	3836	"RTN","PRC ACPS",261, 0)
	3837	;
	3838	"RTN","PRC ACPS",262, 0)
	3839	START2 ;
	3840	"RTN","PRC ACPS",263, 0)
	3841	N I,ATNLA ST,BILL,BI LLCNT,BILL CNTR,BILLN UM,FLAGGED ,TN,TN9,TR ANSTOT,TNV AL,TTYPE,
	3842	TCPLT,STOP ,TRANCRNT, TRANPREV,T NLAST
	3843	"RTN","PRC ACPS",264, 0)
	3844	S (BILL,B ILLCNTR,FL AGGED)=0,A TNLAST=""
	3845	"RTN","PRC ACPS",265, 0)
	3846	; ATNLAST = The las t number f or the acc ount
	3847	"RTN","PRC ACPS",266, 0)
	3848	; FLAGGED = Account level fla g noting i f audit da ta was mar ked for th is accoun
	3849	t
	3850	"RTN","PRC ACPS",267, 0)
	3851	; PRCAFIX (X) = Hold s the tota l of the n umber of t ransaction s for a bi ll that m
	3852	atch to ch eck criter ia X
	3853	"RTN","PRC ACPS",268, 0)
	3854	; Determi ne the num ber of bil l for this account
	3855	"RTN","PRC ACPS",269, 0)
	3856	S (BILLCN T,BILLCNTR )=0,BILLNU M=""
	3857	"RTN","PRC ACPS",270, 0)
	3858	; Determi ne the num ber of bil ls for thi s account
	3859	"RTN","PRC ACPS",271, 0)
	3860	F S BILL NUM=$O(^TM P("PRCAGTP S",$J,DEBT OR,BILLNUM )) Q:'BILL NUM S BIL LCNT=BILL
	3861	CNT+1
	3862	"RTN","PRC ACPS",272, 0)
	3863	; Loop th rough Bill s
	3864	"RTN","PRC ACPS",273, 0)
	3865	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	3866	"RTN","PRC ACPS",274, 0)
	3867	.S BILLCN TR=BILLCNT R+1
	3868	"RTN","PRC ACPS",275, 0)
	3869	.; QUIT i f STOP fla g is set f or this Bi ll
	3870	"RTN","PRC ACPS",276, 0)
	3871	.I $P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,3)=1 S FLAGGED= FLAGGED+1 Q
	3872	"RTN","PRC ACPS",277, 0)
	3873	.; New an d set Bill Balance D ifference
	3874	"RTN","PRC ACPS",278, 0)
	3875	.N BILLDI FF
	3876	"RTN","PRC ACPS",279, 0)
	3877	.; ***** The follow ing 2 form ulas will need to be re-evalua ted once t he VA sup
	3878	plies us t he necessa ry details *****
	3879	"RTN","PRC ACPS",280, 0)
	3880	.; If the Original Bill Amoun t is not n ull use th is formula
	3881	"RTN","PRC ACPS",281, 0)
	3882	.I +$G(^T MP("PRCAGT PS",$J,DEB TOR,BILL,0 )) D
	3883	"RTN","PRC ACPS",282, 0)
	3884	..S BILLD IFF=$P($G( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,0)),U,1)- $P($G(^TMP ("PRCABIL
	3885	L",$J,DEBT OR,BILL)), U,1)+$P($G (^TMP("PRC ABILL",$J, DEBTOR,BIL L)),U,2)
	3886	"RTN","PRC ACPS",283, 0)
	3887	.; If the Original Amount is null use t his formul a
	3888	"RTN","PRC ACPS",284, 0)
	3889	.I '+$G(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, 0)) D
	3890	"RTN","PRC ACPS",285, 0)
	3891	..S BILLD IFF=$P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,1)-$P ($G(^TMP(" PRCABILL"
	3892	,$J,DEBTOR ,BILL)),U, 2)
	3893	"RTN","PRC ACPS",286, 0)
	3894	.; Quit i f Bill Bal ance Diffe rence is z ero
	3895	"RTN","PRC ACPS",287, 0)
	3896	.I 'BILLD IFF Q
	3897	"RTN","PRC ACPS",288, 0)
	3898	.; PRCAFI X(X) = Hol ds the tot al of the number of transactio ns for a b ill that
	3899	match to c heck crite ria X
	3900	"RTN","PRC ACPS",289, 0)
	3901	.; PRCATT TF = Total Transacti on Types t o Fix
	3902	"RTN","PRC ACPS",290, 0)
	3903	.N PRCATT TF,PRCAFIX
	3904	"RTN","PRC ACPS",291, 0)
	3905	.S (PRCAT TTF,TRANST OT,TTYPE,T NVAL)=0
	3906	"RTN","PRC ACPS",292, 0)
	3907	.S (TN,TN LAST)=""
	3908	"RTN","PRC ACPS",293, 0)
	3909	.; Initia lize type of fix cou nts
	3910	"RTN","PRC ACPS",294, 0)
	3911	.F I=1:1: 4 S PRCAFI X(I)=""
	3912	"RTN","PRC ACPS",295, 0)
	3913	.;
	3914	"RTN","PRC ACPS",296, 0)
	3915	.F S TN= $O(^TMP("P RCAGTPS",$ J,DEBTOR,B ILL,TN)) Q :TN="" D
	3916	"RTN","PRC ACPS",297, 0)
	3917	..; Save first tran saction nu mber
	3918	"RTN","PRC ACPS",298, 0)
	3919	..S (ATNL AST,TNLAST )=TN
	3920	"RTN","PRC ACPS",299, 0)
	3921	..; IF Tr ansaction number = 0 update Tr ansaction Total with (#15) TRA NS. AMOUN
	3922	T from #43 3
	3923	"RTN","PRC ACPS",300, 0)
	3924	..I TN=0 S TRANSTOT =TRANSTOT+ ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN) Q
	3925	"RTN","PRC ACPS",301, 0)
	3926	..; Set T NVAL = (#1 5) TRANS. AMOUNT fro m #433
	3927	"RTN","PRC ACPS",302, 0)
	3928	..S TNVAL =$P(^TMP(" PRCAGTPS", $J,DEBTOR, BILL,TN),U ,1)
	3929	"RTN","PRC ACPS",303, 0)
	3930	..; Set T TYPE = (#1 2) TRANSAC TION TYPE from #433
	3931	"RTN","PRC ACPS",304, 0)
	3932	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	3933	"RTN","PRC ACPS",305, 0)
	3934	..; Set T CPLT = (#1 0) INCOMPL ETE TRANSA CTION FLAG
	3935	"RTN","PRC ACPS",306, 0)
	3936	..S TCPLT =+$P($G(^P RCA(433,TN ,0)),U,10)
	3937	"RTN","PRC ACPS",307, 0)
	3938	..; I thi nk this wi ll always be blank
	3939	"RTN","PRC ACPS",308, 0)
	3940	..S TRDMR D=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,10)
	3941	"RTN","PRC ACPS",309, 0)
	3942	..; I thi nk this wi ll always be blank
	3943	"RTN","PRC ACPS",310, 0)
	3944	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	3945	"RTN","PRC ACPS",311, 0)
	3946	..; Quit it this tr ansaction was previo usly used to correct an out of balance
	3947	scenario
	3948	"RTN","PRC ACPS",312, 0)
	3949	..S TN9=$ G(^PRCA(43 3,TN,9))
	3950	"RTN","PRC ACPS",313, 0)
	3951	..Q:$P(TN 9,U,4)'=""
	3952	"RTN","PRC ACPS",314, 0)
	3953	..;
	3954	"RTN","PRC ACPS",315, 0)
	3955	..; Check #1 - Tran saction wi th missing $ amount & Transact ion Type ' = Comment
	3956	(#45)
	3957	"RTN","PRC ACPS",316, 0)
	3958	..;I TNVA L="",(TTYP E'=45) D Q
	3959	"RTN","PRC ACPS",317, 0)
	3960	..;.S PRC AFIX(1)=$G (PRCAFIX(1 ))+1,IENCR RT=TN
	3961	"RTN","PRC ACPS",318, 0)
	3962	..;.S PRC AFIX(1,TN) =""
	3963	"RTN","PRC ACPS",319, 0)
	3964	..;
	3965	"RTN","PRC ACPS",320, 0)
	3966	..; Check #2 - Tran saction ma rked as In complete w ith +$ amo unt matchi ng off by
	3967	amount
	3968	"RTN","PRC ACPS",321, 0)
	3969	..I TNVAL =BILLDIFF I TCPLT D Q
	3970	"RTN","PRC ACPS",322, 0)
	3971	...Q:(TTY PE=45)
	3972	"RTN","PRC ACPS",323, 0)
	3973	...I TRDM RD Q
	3974	"RTN","PRC ACPS",324, 0)
	3975	...S PRCA FIX(2)=$G( PRCAFIX(2) )+1,IENCRR T=TN
	3976	"RTN","PRC ACPS",325, 0)
	3977	...S PRCA FIX(2,TN)= ""
	3978	"RTN","PRC ACPS",326, 0)
	3979	..;
	3980	"RTN","PRC ACPS",327, 0)
	3981	..; Check #3 - Tran saction ma rked as In complete w ith -$ amo unt matchi ng off by
	3982	amount
	3983	"RTN","PRC ACPS",328, 0)
	3984	..I -TNVA L=BILLDIFF I TCPLT D Q
	3985	"RTN","PRC ACPS",329, 0)
	3986	...Q:(TTY PE=45)
	3987	"RTN","PRC ACPS",330, 0)
	3988	...S PRCA FIX(3)=$G( PRCAFIX(3) )+1,IENCRR T=TN
	3989	"RTN","PRC ACPS",331, 0)
	3990	...S PRCA FIX(3,TN)= ""
	3991	"RTN","PRC ACPS",332, 0)
	3992	..;
	3993	"RTN","PRC ACPS",333, 0)
	3994	..; Check #4 - Dupl icate Tran saction
	3995	"RTN","PRC ACPS",334, 0)
	3996	..I TTYPE '=45,($P(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, TN),U,12)= 1) D
	3997	"RTN","PRC ACPS",335, 0)
	3998	...S PRCA FIX(4)=$G( PRCAFIX(4) )+1,IENCRR T=TN
	3999	"RTN","PRC ACPS",336, 0)
	4000	...S PRCA FIX(4,TN)= ""
	4001	"RTN","PRC ACPS",337, 0)
	4002	.;
	4003	"RTN","PRC ACPS",338, 0)
	4004	.; Quit i f there we re no tran sactions f or this bi ll
	4005	"RTN","PRC ACPS",339, 0)
	4006	.I $G(IEN CRRT)=""!( $G(TNLAST) ="") Q
	4007	"RTN","PRC ACPS",340, 0)
	4008	.; If we are on the last Bill and there were no t ransaction s for the entire ac
	4009	count Quit
	4010	"RTN","PRC ACPS",341, 0)
	4011	.I BILLCN TR=BILLCNT ,ATNLAST=" " Q
	4012	"RTN","PRC ACPS",342, 0)
	4013	.;
	4014	"RTN","PRC ACPS",343, 0)
	4015	.F I=1:1: 4 D
	4016	"RTN","PRC ACPS",344, 0)
	4017	..S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	4018	"RTN","PRC ACPS",345, 0)
	4019	.; if you get to he re the bil l was out of balance and if it shows not hing to f
	4020	ix, set la st transac tion
	4021	"RTN","PRC ACPS",346, 0)
	4022	.; for th is Bill to NOT FIXAB LE
	4023	"RTN","PRC ACPS",347, 0)
	4024	.I PRCATT TF=0 D UPD TLTR^PRCAC PSA($G(TNL AST)) S FL AGGED=1 Q
	4025	"RTN","PRC ACPS",348, 0)
	4026	.; Update this bill
	4027	"RTN","PRC ACPS",349, 0)
	4028	.D FIXBIL L(.FLAGGED )
	4029	"RTN","PRC ACPS",350, 0)
	4030	Q:FLAGGED
	4031	"RTN","PRC ACPS",351, 0)
	4032	; The acc ount was o ut of bala nce but no thing was found on a ny bill th at could
	4033	be fixed.
	4034	"RTN","PRC ACPS",352, 0)
	4035	; Mark th e last tra nsaction f or the las t bill for this acco unt as not fixable.
	4036	"RTN","PRC ACPS",353, 0)
	4037	I 'FLAGGE D D UPDTLT R^PRCACPSA ($G(ATNLAS T))
	4038	"RTN","PRC ACPS",354, 0)
	4039	Q
	4040	"RTN","PRC ACPS",355, 0)
	4041	;
	4042	"RTN","PRC ACPS",356, 0)
	4043	FIXBILL(FL AGGED) ;Up date a sin gle bill u sing PRCAF IX array
	4044	"RTN","PRC ACPS",357, 0)
	4045	; Make up date deter mination b ased on ch ecks 1 - 4 .
	4046	"RTN","PRC ACPS",358, 0)
	4047	; Sum up check tota ls
	4048	"RTN","PRC ACPS",359, 0)
	4049	;F I=1:1: 4 D
	4050	"RTN","PRC ACPS",360, 0)
	4051	;.S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	4052	"RTN","PRC ACPS",361, 0)
	4053	; Get cur rent date/ time
	4054	"RTN","PRC ACPS",362, 0)
	4055	N PRCADAT E
	4056	"RTN","PRC ACPS",363, 0)
	4057	D NOW^%DT C
	4058	"RTN","PRC ACPS",364, 0)
	4059	S PRCADAT E=X
	4060	"RTN","PRC ACPS",365, 0)
	4061	; Otherwi se there i s only 1 b ad transac tion so up date as ne eded
	4062	"RTN","PRC ACPS",366, 0)
	4063	; Lock Re cord
	4064	"RTN","PRC ACPS",367, 0)
	4065	L +^PRCA( 433,IENCRR T,9):DILOC KTM
	4066	"RTN","PRC ACPS",368, 0)
	4067	; If lock not obtai ned, updat e number o f transact ions that couldn't b e fixed
	4068	"RTN","PRC ACPS",369, 0)
	4069	Q:'$T
	4070	"RTN","PRC ACPS",370, 0)
	4071	; Set FDA array for the neces sary field s based on the type of fix ide ntified
	4072	"RTN","PRC ACPS",371, 0)
	4073	N PRCAFDA
	4074	"RTN","PRC ACPS",372, 0)
	4075	;I PRCAFI X(1) D
	4076	"RTN","PRC ACPS",373, 0)
	4077	;.S PRCAF DA(433,IEN CRRT_",",1 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	4078	"RTN","PRC ACPS",374, 0)
	4079	;.S PRCAF DA(433,IEN CRRT_",",9 4)=PRCADAT E
	4080	"RTN","PRC ACPS",375, 0)
	4081	;.S PRCAF DA(433,IEN CRRT_",",9 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	4082	"RTN","PRC ACPS",376, 0)
	4083	;.S PRCAF DA(433,IEN CRRT_",",9 6)="N" ; N ULL TRANSA CTION AMOU NT
	4084	"RTN","PRC ACPS",377, 0)
	4085	; Check # 2 - Transa ction mark ed as Inco mplete wit h +$ amoun t matching off by a
	4086	mount
	4087	"RTN","PRC ACPS",378, 0)
	4088	; Check # 3 - Transa ction mark ed as Inco mplete wit h -$ amoun t matching off by a
	4089	mount
	4090	"RTN","PRC ACPS",379, 0)
	4091	I PRCAFIX (2)!(PRCAF IX(3)) D
	4092	"RTN","PRC ACPS",380, 0)
	4093	.S PRCAFD A(433,IENC RRT_",",10 )=""
	4094	"RTN","PRC ACPS",381, 0)
	4095	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	4096	"RTN","PRC ACPS",382, 0)
	4097	.S PRCAFD A(433,IENC RRT_",",96 )="I" ; IN COMPLETE F LAG ERROR
	4098	"RTN","PRC ACPS",383, 0)
	4099	; Check # 4 - Duplic ate Transa ction
	4100	"RTN","PRC ACPS",384, 0)
	4101	I PRCAFIX (4) D
	4102	"RTN","PRC ACPS",385, 0)
	4103	.; Null o ut audit f ields on o riginal tr ansaction
	4104	"RTN","PRC ACPS",386, 0)
	4105	.S PRCAFD A(433,IENC RRT-1_",", 94)=""
	4106	"RTN","PRC ACPS",387, 0)
	4107	.S PRCAFD A(433,IENC RRT-1_",", 95)=""
	4108	"RTN","PRC ACPS",388, 0)
	4109	.S PRCAFD A(433,IENC RRT-1_",", 96)=""
	4110	"RTN","PRC ACPS",389, 0)
	4111	.L +^PRCA (433,IENCR RT-1,9):DI LOCKTM
	4112	"RTN","PRC ACPS",390, 0)
	4113	.Q:'$T
	4114	"RTN","PRC ACPS",391, 0)
	4115	.D FILE^D IE(,"PRCAF DA")
	4116	"RTN","PRC ACPS",392, 0)
	4117	.L -^PRCA (433,IENCR RT-1,9)
	4118	"RTN","PRC ACPS",393, 0)
	4119	.; Set th e fields f or the dup licate tra nsaction
	4120	"RTN","PRC ACPS",394, 0)
	4121	.S PRCAFD A(433,IENC RRT_",",10 )=1 ; INCO MPLETE TRA NSACTION
	4122	"RTN","PRC ACPS",395, 0)
	4123	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	4124	"RTN","PRC ACPS",396, 0)
	4125	.S PRCAFD A(433,IENC RRT_",",95 )=$S(BILLD IFF>0:BILL DIFF,1:-BI LLDIFF)
	4126	"RTN","PRC ACPS",397, 0)
	4127	.S PRCAFD A(433,IENC RRT_",",96 )="D" ; DU PLICATE TR ANSACTION
	4128	"RTN","PRC ACPS",398, 0)
	4129	; Update Transactio n
	4130	"RTN","PRC ACPS",399, 0)
	4131	D FILE^DI E(,"PRCAFD A")
	4132	"RTN","PRC ACPS",400, 0)
	4133	S FLAGGED =1
	4134	"RTN","PRC ACPS",401, 0)
	4135	; Unlock file
	4136	"RTN","PRC ACPS",402, 0)
	4137	L -^PRCA( 433,IENCRR T,9)
	4138	"RTN","PRC ACPS",403, 0)
	4139	K TMBSNC, IENCRRT
	4140	"RTN","PRC ACPS",404, 0)
	4141	Q
	4142	"RTN","PRC ACPS",405, 0)
	4143	;
	4144	"RTN","PRC ACPS",406, 0)
	4145	DIQOUTCS(D IQOUT) ;Re turn check sum for a processed DIQOUT arr ay.
	4146	"RTN","PRC ACPS",407, 0)
	4147	N CS,DATA ,FIELD,FNU M,IENS,IND ,SFN,STRIN G,TARGET,T EXT,WP
	4148	"RTN","PRC ACPS",408, 0)
	4149	S FNUM=$O (DIQOUT("" ))
	4150	"RTN","PRC ACPS",409, 0)
	4151	S (CS,FNU M)=0
	4152	"RTN","PRC ACPS",410, 0)
	4153	F S FNUM =$O(DIQOUT (FNUM)) Q: FNUM="" D
	4154	"RTN","PRC ACPS",411, 0)
	4155	.S IENS=" "
	4156	"RTN","PRC ACPS",412, 0)
	4157	.F S IEN S=$O(DIQOU T(FNUM,IEN S)) Q:IENS ="" D
	4158	"RTN","PRC ACPS",413, 0)
	4159	..S FIELD =0
	4160	"RTN","PRC ACPS",414, 0)
	4161	..F S FI ELD=$O(DIQ OUT(FNUM,I ENS,FIELD) ) Q:FIELD= "" D
	4162	"RTN","PRC ACPS",415, 0)
	4163	...S DATA =DIQOUT(FN UM,IENS,FI ELD)
	4164	"RTN","PRC ACPS",416, 0)
	4165	...S TEXT =FNUM_$L(I ENS,",")_F IELD_DATA
	4166	"RTN","PRC ACPS",417, 0)
	4167	...S CS=$ $CRC32^XLF CRC(TEXT,C S)
	4168	"RTN","PRC ACPS",418, 0)
	4169	Q CS
	4170	"RTN","PRC ACPS",419, 0)
	4171	;
	4172	"RTN","PRC ACPS",420, 0)
	4173	USRMSG ;se nds mailma n message to the PRC ACPS mail group
	4174	"RTN","PRC ACPS",421, 0)
	4175	N XMY,XMD UZ,XMSUB,X MTEXT,X
	4176	"RTN","PRC ACPS",422, 0)
	4177	S XMDUZ=" AR PACKAGE "
	4178	"RTN","PRC ACPS",423, 0)
	4179	S XMY("G. PRCACPS")= ""
	4180	"RTN","PRC ACPS",424, 0)
	4181	S XMSUB=" CPS AUTO-C ORRECTION COMPLETE " _$E(DT,4,5 )_"/"_$E(D T,6,7)_"/" _$E(DT,2,
	4182	3)
	4183	"RTN","PRC ACPS",425, 0)
	4184	S X(1)="C onsolidate d Patient Statement Auto-Corre ction"
	4185	"RTN","PRC ACPS",426, 0)
	4186	S X(2)="P rogram com pleted on "_$$FMTE^X LFDT($$NOW ^XLFDT()," 5P")
	4187	"RTN","PRC ACPS",427, 0)
	4188	S XMTEXT= "X("
	4189	"RTN","PRC ACPS",428, 0)
	4190	D ^XMD
	4191	"RTN","PRC ACPS",429, 0)
	4192	; Remove ^XTMP node
	4193	"RTN","PRC ACPS",430, 0)
	4194	K ^XTMP(" PRCACPS",0 )
	4195	"RTN","PRC ACPS",431, 0)
	4196	Q
	4197	"RTN","PRC ACPS1")
	4198	0^28^B1912 8158^n/a
	4199	"RTN","PRC ACPS1",1,0 )
	4200	PRCACPS1 ; ALBANY/BDB -PATIENT S TATEMENTS UPDATE ;03 /25/16 3:3 4 PM
	4201	"RTN","PRC ACPS1",2,0 )
	4202	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 124
	4203	"RTN","PRC ACPS1",3,0 )
	4204	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4205	"RTN","PRC ACPS1",4,0 )
	4206	;
	4207	"RTN","PRC ACPS1",5,0 )
	4208	Q
	4209	"RTN","PRC ACPS1",6,0 )
	4210	;
	4211	"RTN","PRC ACPS1",7,0 )
	4212	ENTER ;cal led by the cbs night ly account update pr ogram opti on
	4213	"RTN","PRC ACPS1",8,0 )
	4214	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K,ZTSAVE,R CFULL
	4215	"RTN","PRC ACPS1",9,0 )
	4216	S RCFULL= 1 ;run the full debt or list
	4217	"RTN","PRC ACPS1",10, 0)
	4218	W !,"Queu e the pati ent statem ent update program t o run:"
	4219	"RTN","PRC ACPS1",11, 0)
	4220	S ZTDESC= "Consolida ted Billin g Statemen t Update"
	4221	"RTN","PRC ACPS1",12, 0)
	4222	S ZTRTN=" DEBTOR^PRC ACPS1",ZTI O="",ZTSAV E("RCFULL" )=""
	4223	"RTN","PRC ACPS1",13, 0)
	4224	D ^%ZTLOA D
	4225	"RTN","PRC ACPS1",14, 0)
	4226	Q
	4227	"RTN","PRC ACPS1",15, 0)
	4228	;
	4229	"RTN","PRC ACPS1",16, 0)
	4230	DEBTOR ;ca lled by rc cpcbj
	4231	"RTN","PRC ACPS1",17, 0)
	4232	N DEBTOR, X,DEBTOR0, DEBTOR1,DE BTOR7,CBSS TOT,BALDT
	4233	"RTN","PRC ACPS1",18, 0)
	4234	K ^XTMP(" RCCBSS",$J )
	4235	"RTN","PRC ACPS1",19, 0)
	4236	S ^XTMP(" RCCBSS",$J ,0)=$$FMAD D^XLFDT(DT ,3)_"^"_DT
	4237	"RTN","PRC ACPS1",20, 0)
	4238	S DEBTOR= 0
	4239	"RTN","PRC ACPS1",21, 0)
	4240	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	4241	"RTN","PRC ACPS1",22, 0)
	4242	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) ),DEBTOR7= $G(^(7)),B ALDT=""
	4243	"RTN","PRC ACPS1",23, 0)
	4244	.Q:$P(DEB TOR0,"^")' ["DPT("
	4245	"RTN","PRC ACPS1",24, 0)
	4246	.I +$$GET ICN^MPIF00 1(+DEBTOR0 )<0 Q ;qu it if no i cn
	4247	"RTN","PRC ACPS1",25, 0)
	4248	.S BALDT= $$BILLS(DE BTOR) Q:$P (BALDT,U,2 )=9999999
	4249	"RTN","PRC ACPS1",26, 0)
	4250	.D RECPD
	4251	"RTN","PRC ACPS1",27, 0)
	4252	D COMPILE
	4253	"RTN","PRC ACPS1",28, 0)
	4254	K ^XTMP(" RCCBSS",$J )
	4255	"RTN","PRC ACPS1",29, 0)
	4256	Q
	4257	"RTN","PRC ACPS1",30, 0)
	4258	;
	4259	"RTN","PRC ACPS1",31, 0)
	4260	RECPD(BILL ) ;add a n ew account update
	4261	"RTN","PRC ACPS1",32, 0)
	4262	N REC,RCD FN
	4263	"RTN","PRC ACPS1",33, 0)
	4264	S RCDFN=+ DEBTOR0
	4265	"RTN","PRC ACPS1",34, 0)
	4266	S REC="PD ^"_$$GETIC N^MPIF001( RCDFN)_"^"
	4267	"RTN","PRC ACPS1",35, 0)
	4268	S REC=REC _$$SITE^RC MSITE_$$UP ^XLFSTR($S (($$SSN^RC FN01(DEBTO R)]"")&($$ NAM^RCFN0
	4269	1(DEBTOR)] ""):$TR($E ($$SSN^RCF N01(DEBTOR ),1,9)_$E( $P($$NAM^R CFN01(DEBT OR),","),
	4270	1,5)," "," "),1:""))_ "^"
	4271	"RTN","PRC ACPS1",36, 0)
	4272	S REC=REC _RCDFN_"^"
	4273	"RTN","PRC ACPS1",37, 0)
	4274	S BALDT=$ $BILLS(DEB TOR)
	4275	"RTN","PRC ACPS1",38, 0)
	4276	S CBSSTOT =+$P(DEBTO R7,U,6)
	4277	"RTN","PRC ACPS1",39, 0)
	4278	I '$G(RCF ULL) Q:CBS STOT=+BALD T
	4279	"RTN","PRC ACPS1",40, 0)
	4280	S $P(^RCD (340,DEBTO R,7),U,6)= +BALDT
	4281	"RTN","PRC ACPS1",41, 0)
	4282	S REC=REC _$$HEX(+BA LDT)_"^"_$ P(BALDT,U, 2)_"^\|"
	4283	"RTN","PRC ACPS1",42, 0)
	4284	S ^XTMP(" RCCBSS",$J ,DEBTOR)=R EC
	4285	"RTN","PRC ACPS1",43, 0)
	4286	Q
	4287	"RTN","PRC ACPS1",44, 0)
	4288	;
	4289	"RTN","PRC ACPS1",45, 0)
	4290	BILLS(DEBT OR) ;get o ldest bill date
	4291	"RTN","PRC ACPS1",46, 0)
	4292	N BALTOT, BILL,BN0,P RPDT,OLDDT
	4293	"RTN","PRC ACPS1",47, 0)
	4294	S BILL=""
	4295	"RTN","PRC ACPS1",48, 0)
	4296	S BALTOT= 0,OLDDT=99 99999
	4297	"RTN","PRC ACPS1",49, 0)
	4298	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	4299	"RTN","PRC ACPS1",50, 0)
	4300	.Q:$D(^PR CA(430,"TC SP",BILL)) ;cs chec k
	4301	"RTN","PRC ACPS1",51, 0)
	4302	.S BN0=$G (^PRCA(430 ,BILL,0))
	4303	"RTN","PRC ACPS1",52, 0)
	4304	.I $P(BN0 ,U,8)'=16 Q ;not ac tive
	4305	"RTN","PRC ACPS1",53, 0)
	4306	.S BALTOT =BALTOT+$$ GET1^DIQ(4 30,BILL,11 )
	4307	"RTN","PRC ACPS1",54, 0)
	4308	.S PRPDT= $P(^PRCA(4 30,BILL,0) ,U,10) I + PRPDT,OLDD T>PRPDT S OLDDT=PRPD T
	4309	"RTN","PRC ACPS1",55, 0)
	4310	Q BALTOT_ U_$S(OLDDT '=9999999: $$DTMDY(OL DDT),1:"")
	4311	"RTN","PRC ACPS1",56, 0)
	4312	;
	4313	"RTN","PRC ACPS1",57, 0)
	4314	COMPILE ;
	4315	"RTN","PRC ACPS1",58, 0)
	4316	N RCMSG,D CNTR,REC,R ECC,AMOUNT ,RCNTR,ACT ION,SEQ,SE QTOT
	4317	"RTN","PRC ACPS1",59, 0)
	4318	S DCNTR=0 ,REC=1,REC C=0,AMOUNT =0,SEQ=1,S EQTOT=0
	4319	"RTN","PRC ACPS1",60, 0)
	4320	F S DCNT R=$O(^XTMP ("RCCBSS", $J,DCNTR)) S:+DCNTR' >0 SEQTOT= SEQ Q:+DCN TR'>0 D
	4321	"RTN","PRC ACPS1",61, 0)
	4322	.I REC>45 0 D
	4323	"RTN","PRC ACPS1",62, 0)
	4324	..S ^XTMP ("RCCBSS", $J,"BUILD" ,SEQ,REC)= ^XTMP("RCC BSS",$J,"B UILD",SEQ, REC)_"~"
	4325	"RTN","PRC ACPS1",63, 0)
	4326	..D HEADE R
	4327	"RTN","PRC ACPS1",64, 0)
	4328	..D AITCM SG
	4329	"RTN","PRC ACPS1",65, 0)
	4330	..S REC=0 ,SEQ=SEQ+1
	4331	"RTN","PRC ACPS1",66, 0)
	4332	..Q
	4333	"RTN","PRC ACPS1",67, 0)
	4334	.S REC=RE C+1
	4335	"RTN","PRC ACPS1",68, 0)
	4336	.S ^XTMP( "RCCBSS",$ J,"BUILD", SEQ,REC)=^ XTMP("RCCB SS",$J,DCN TR)
	4337	"RTN","PRC ACPS1",69, 0)
	4338	.Q
	4339	"RTN","PRC ACPS1",70, 0)
	4340	Q:'$D(^XT MP("RCCBSS ",$J,"BUIL D",SEQ))
	4341	"RTN","PRC ACPS1",71, 0)
	4342	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,REC)=^X TMP("RCCBS S",$J,"BUI LD",SEQ,RE C)_"~"
	4343	"RTN","PRC ACPS1",72, 0)
	4344	D HEADER
	4345	"RTN","PRC ACPS1",73, 0)
	4346	D AITCMSG
	4347	"RTN","PRC ACPS1",74, 0)
	4348	Q
	4349	"RTN","PRC ACPS1",75, 0)
	4350	;
	4351	"RTN","PRC ACPS1",76, 0)
	4352	AITCMSG ;
	4353	"RTN","PRC ACPS1",77, 0)
	4354	N XMY,XMD UZ,XMSUB,X MTEXT
	4355	"RTN","PRC ACPS1",78, 0)
	4356	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	4357	"RTN","PRC ACPS1",79, 0)
	4358	S XMDUZ=" AR PACKAGE "
	4359	"RTN","PRC ACPS1",80, 0)
	4360	;S XMY("X XX@Q- D NS ")=""
	4361	"RTN","PRC ACPS1",81, 0)
	4362	S X=$O(^R CT(349.1," B","PU",0) )
	4363	"RTN","PRC ACPS1",82, 0)
	4364	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^")_" @"_$P($G(
	4365	^RCT(349.1 ,+X,3)),"^ ",3) S:$P( X,"@",2)]" " XMY(X)=" "
	4366	"RTN","PRC ACPS1",83, 0)
	4367	S XMY("G. PRCACPS")= ""
	4368	"RTN","PRC ACPS1",84, 0)
	4369	S XMSUB=S ITE_"/CBSS TRANSMISS ION/BATCH# : "_SEQ
	4370	"RTN","PRC ACPS1",85, 0)
	4371	S XMTEXT= "^XTMP(""R CCBSS"","_ $J_",""BUI LD"","_SEQ _","
	4372	"RTN","PRC ACPS1",86, 0)
	4373	D ^XMD
	4374	"RTN","PRC ACPS1",87, 0)
	4375	K ^XTMP(" RCCBSS",$J ,"BUILD",S EQ)
	4376	"RTN","PRC ACPS1",88, 0)
	4377	Q
	4378	"RTN","PRC ACPS1",89, 0)
	4379	;
	4380	"RTN","PRC ACPS1",90, 0)
	4381	HEADER ;
	4382	"RTN","PRC ACPS1",91, 0)
	4383	;incremen t batch se quence num ber, build new heade r
	4384	"RTN","PRC ACPS1",92, 0)
	4385	N RCMSG,S ITE
	4386	"RTN","PRC ACPS1",93, 0)
	4387	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	4388	"RTN","PRC ACPS1",94, 0)
	4389	S RCMSG=" PU"_"^"_SE Q_"^"_SEQT OT_"^"_(RE C-1)_"^"_S ITE_"^"_$$ DTMDY(DT)_ "^\|"
	4390	"RTN","PRC ACPS1",95, 0)
	4391	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,1)=RCMS G
	4392	"RTN","PRC ACPS1",96, 0)
	4393	Q
	4394	"RTN","PRC ACPS1",97, 0)
	4395	;
	4396	"RTN","PRC ACPS1",98, 0)
	4397	HEX(AMT) ; sets up am ount forma tted as 99 9999999V99 S w/no lea ding blank s and tra
	4398	iling sign
	4399	"RTN","PRC ACPS1",99, 0)
	4400	I $G(AMT) '?.1"-".N. 1".".N S A MT="" G Q
	4401	"RTN","PRC ACPS1",100 ,0)
	4402	S AMT=$TR ($J(AMT,9, 2)," ","")
	4403	"RTN","PRC ACPS1",101 ,0)
	4404	I $E(AMT) ="-" S AMT =$E(AMT,2, 99)_$E(AMT ,1)
	4405	"RTN","PRC ACPS1",102 ,0)
	4406	E S AMT= AMT_"+"
	4407	"RTN","PRC ACPS1",103 ,0)
	4408	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	4409	"RTN","PRC ACPS1",104 ,0)
	4410	Q Q AMT
	4411	"RTN","PRC ACPS1",105 ,0)
	4412	;
	4413	"RTN","PRC ACPS1",106 ,0)
	4414	DTMDY(DAT) ;Changes date from fm to mmdd yyyy forma t
	4415	"RTN","PRC ACPS1",107 ,0)
	4416	N YR
	4417	"RTN","PRC ACPS1",108 ,0)
	4418	I '$G(DAT ) G QDAT
	4419	"RTN","PRC ACPS1",109 ,0)
	4420	S YR=$E(( $E(DAT,1,3 )+1700),1, 2)
	4421	"RTN","PRC ACPS1",110 ,0)
	4422	Q $E(DAT, 4,5)_$E(DA T,6,7)_$G( YR)_$E(DAT ,2,3)
	4423	"RTN","PRC ACPS1",111 ,0)
	4424	QDAT Q ""
	4425	"RTN","PRC ACPS1",112 ,0)
	4426	;
	4427	"RTN","PRC ACPS1",113 ,0)
	4428	BLANK(X) ; returns 'x ' blank sp aces
	4429	"RTN","PRC ACPS1",114 ,0)
	4430	N BLANK
	4431	"RTN","PRC ACPS1",115 ,0)
	4432	S BLANK=" ",$P(BLANK ," ",X+1)= ""
	4433	"RTN","PRC ACPS1",116 ,0)
	4434	Q BLANK
	4435	"RTN","PRC ACPS1",117 ,0)
	4436	;
	4437	"RTN","PRC ACPS1",118 ,0)
	4438	RJZF(X,Y) ;right jus tify zero fill width Y
	4439	"RTN","PRC ACPS1",119 ,0)
	4440	S X=$E("0 0000000000 0",1,Y-$L( X))_X
	4441	"RTN","PRC ACPS1",120 ,0)
	4442	Q X
	4443	"RTN","PRC ACPS1",121 ,0)
	4444	;
	4445	"RTN","PRC ACPS1",122 ,0)
	4446	LJSF(X,Y) ;left just ified spac e filled
	4447	"RTN","PRC ACPS1",123 ,0)
	4448	S X=$E(X, 1,Y)
	4449	"RTN","PRC ACPS1",124 ,0)
	4450	S X=X_$$B LANK(Y-$L( X))
	4451	"RTN","PRC ACPS1",125 ,0)
	4452	Q X
	4453	"RTN","PRC ACPS1",126 ,0)
	4454	;
	4455	"RTN","PRC ACPS1",127 ,0)
	4456	JD() ; ret urns today 's Julian date YDOY
	4457	"RTN","PRC ACPS1",128 ,0)
	4458	N XMDDD,X MNOW,XMDT
	4459	"RTN","PRC ACPS1",129 ,0)
	4460	S XMNOW=$ $NOW^XLFDT
	4461	"RTN","PRC ACPS1",130 ,0)
	4462	S XMDT=$E (XMNOW,1,7 )
	4463	"RTN","PRC ACPS1",131 ,0)
	4464	S XMDDD=$ $RJ^XLFSTR ($$FMDIFF^ XLFDT(XMDT ,$E(XMDT,1 ,3)_"0101" ,1)+1,3,"0 ")
	4465	"RTN","PRC ACPS1",132 ,0)
	4466	Q $E(DT,3 )_XMDDD
	4467	"RTN","PRC ACPS1",133 ,0)
	4468	;
	4469	"RTN","PRC ACPS1",134 ,0)
	4470	AMOUNT(X) ;changes a mount to z ero filled , right ju stified
	4471	"RTN","PRC ACPS1",135 ,0)
	4472	S:X<0 X=- X
	4473	"RTN","PRC ACPS1",136 ,0)
	4474	S X=$TR($ J(X,0,2)," .")
	4475	"RTN","PRC ACPS1",137 ,0)
	4476	S X=$E("0 0000000000 0",1,14-$L (X))_X
	4477	"RTN","PRC ACPS1",138 ,0)
	4478	Q X
	4479	"RTN","PRC ACPS1",139 ,0)
	4480	;
	4481	"RTN","PRC ACPSA")
	4482	0^29^B3327 0653^n/a
	4483	"RTN","PRC ACPSA",1,0 )
	4484	PRCACPSA ; ALBANY/MGD -PATIENT S TATEMENTS AUTO-CORRE CTION ;09/ 21/15 3:34 PM
	4485	"RTN","PRC ACPSA",2,0 )
	4486	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 124
	4487	"RTN","PRC ACPSA",3,0 )
	4488	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4489	"RTN","PRC ACPSA",4,0 )
	4490	;
	4491	"RTN","PRC ACPSA",5,0 )
	4492	Q
	4493	"RTN","PRC ACPSA",6,0 )
	4494	;
	4495	"RTN","PRC ACPSA",7,0 )
	4496	BILLQUIT(D EBTOR,BILL ) ;
	4497	"RTN","PRC ACPSA",8,0 )
	4498	; check n ews and in itializati ons
	4499	"RTN","PRC ACPSA",9,0 )
	4500	N FILENUM ,IENCRRT,I ENPREV,PRC ABFIX,PRCA BST,PRCAFD A,PRCACUR, PRCACUR1,P RCAPRV,PR
	4501	CAPRV1,TN, TNLAST,TRN SCRRT,TRNS PREV,X
	4502	"RTN","PRC ACPSA",10, 0)
	4503	S TNLAST= ""
	4504	"RTN","PRC ACPSA",11, 0)
	4505	S PRCABFI X=0
	4506	"RTN","PRC ACPSA",12, 0)
	4507	S TN=0
	4508	"RTN","PRC ACPSA",13, 0)
	4509	F S TN=$ O(^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)) Q: 'TN D
	4510	"RTN","PRC ACPSA",14, 0)
	4511	.; Load 0 and 1 nod es
	4512	"RTN","PRC ACPSA",15, 0)
	4513	.S PRCACU R=$G(^PRCA (433,TN,0) )
	4514	"RTN","PRC ACPSA",16, 0)
	4515	.S PRCACU R1=$G(^PRC A(433,TN,1 ))
	4516	"RTN","PRC ACPSA",17, 0)
	4517	.; Quit i f this Tra nsaction i s a COMMEN T
	4518	"RTN","PRC ACPSA",18, 0)
	4519	.I $P(PRC ACUR1,U,2) =45 Q
	4520	"RTN","PRC ACPSA",19, 0)
	4521	.; Quit i f this tra nsaction w as updated earlier a s part of an previou s fix
	4522	"RTN","PRC ACPSA",20, 0)
	4523	.I $P($G( ^PRCA(433, TN,9)),U,4 ) Q
	4524	"RTN","PRC ACPSA",21, 0)
	4525	.S TNLAST =TN
	4526	"RTN","PRC ACPSA",22, 0)
	4527	.; Check if Transac tion is ma rked as IN COMPLETE
	4528	"RTN","PRC ACPSA",23, 0)
	4529	.I $P(PRC ACUR,U,10) =1 S PRCAB FIX=PRCABF IX+1,PRCAB FIX("I")=$ G(PRCABFIX ("I"))+1
	4530	"RTN","PRC ACPSA",24, 0)
	4531	.; Check if zero do llar amoun t
	4532	"RTN","PRC ACPSA",25, 0)
	4533	.;I $P(PR CACUR1,U,5 )="" S PRC ABFIX=PRCA BFIX+1,PRC ABFIX("N") =$G(PRCABF IX("N"))+
	4534	1
	4535	"RTN","PRC ACPSA",26, 0)
	4536	.S PRCAPR V=$G(^PRCA (433,TN-1, 0))
	4537	"RTN","PRC ACPSA",27, 0)
	4538	.S PRCAPR V1=$G(^PRC A(433,TN-1 ,1))
	4539	"RTN","PRC ACPSA",28, 0)
	4540	.; Perfor m quick hi gh level d uplicate c heck
	4541	"RTN","PRC ACPSA",29, 0)
	4542	.I $P(PRC ACUR,U,2)' =$P(PRCAPR V,U,2) Q ; QUIT if (#.03) BIL L NUMBER d on't matc
	4543	h
	4544	"RTN","PRC ACPSA",30, 0)
	4545	.I $P(PRC ACUR,U,9)' =$P(PRCAPR V,U,9) Q ; QUIT if (#42) PROC ESSED BY d on't matc
	4546	h
	4547	"RTN","PRC ACPSA",31, 0)
	4548	.I $P(PRC ACUR1,U,1) '=$P(PRCAP RV1,U,1) Q ; QUIT i f (#11) TR ANSACTION DATE don'
	4549	t match
	4550	"RTN","PRC ACPSA",32, 0)
	4551	.I $P(PRC ACUR1,U,5) '=$P(PRCAP RV1,U,5) Q ; QUIT i f (#15) TR ANS. AMOUN T don't m
	4552	atch
	4553	"RTN","PRC ACPSA",33, 0)
	4554	.; Perfor m detailed duplicate check
	4555	"RTN","PRC ACPSA",34, 0)
	4556	.S IENPRE V=TN-1,IEN CRRT=TN,FI LENUM=433
	4557	"RTN","PRC ACPSA",35, 0)
	4558	.K TRNSPR EV S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENP REV,"**"," N","TRNSPR EV","MSG"
	4559	)
	4560	"RTN","PRC ACPSA",36, 0)
	4561	.K TRNSCR RT S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENC RRT,"**"," N","TRNSCR RT","MSG"
	4562	)
	4563	"RTN","PRC ACPSA",37, 0)
	4564	.S TRNSCR RT(433,TN_ ",",.01)=T RNSPREV(43 3,(TN-1)_" ,",.01)
	4565	"RTN","PRC ACPSA",38, 0)
	4566	.I $D(TRN SPREV(433, (TN-1)_"," ,41)) S TR NSCRRT(433 ,TN_",",41 )=$G(TRNSP REV(433,(
	4567	TN-1)_",", 41))
	4568	"RTN","PRC ACPSA",39, 0)
	4569	.I $$DIQO UTCS^PRCAC PS(.TRNSPR EV)'=$$DIQ OUTCS^PRCA CPS(.TRNSC RRT) Q
	4570	"RTN","PRC ACPSA",40, 0)
	4571	.; Set du plicate fl ag which w ill be use d in START 2
	4572	"RTN","PRC ACPSA",41, 0)
	4573	.S $P(^TM P("PRCAGTP S",$J,DEBT OR,BILL,TN ),U,12)=1
	4574	"RTN","PRC ACPSA",42, 0)
	4575	.; we hav e a duplic ate so upd ate counte r
	4576	"RTN","PRC ACPSA",43, 0)
	4577	.S PRCABF IX=PRCABFI X+1,PRCABF IX("D")=$G (PRCABFIX( "D"))+1
	4578	"RTN","PRC ACPSA",44, 0)
	4579	; Get Bil l Status f or checks
	4580	"RTN","PRC ACPSA",45, 0)
	4581	S PRCABST =$P($G(^PR CA(430,BIL L,0)),U,8)
	4582	"RTN","PRC ACPSA",46, 0)
	4583	;
	4584	"RTN","PRC ACPSA",47, 0)
	4585	; 3rd pie ce of ^TMP ("PRCABILL ",$J,DEBTO R,BILL) is stop/go f lag for th is bill.
	4586	"RTN","PRC ACPSA",48, 0)
	4587	; Set bel ow and uti lized in S TART2^PRCA CPS
	4588	"RTN","PRC ACPSA",49, 0)
	4589	;
	4590	"RTN","PRC ACPSA",50, 0)
	4591	; Check f or Duplica te needs t o include Bill Statu s of ACTIV E (#16), O PEN (#42)
	4592	or CANCEL LATION (#3 9)
	4593	"RTN","PRC ACPSA",51, 0)
	4594	; If ther e was only 1 problem and that problem wa s a Duplic ate and th e Bill St
	4595	atus is AC TIVE or OP EN
	4596	"RTN","PRC ACPSA",52, 0)
	4597	; or CANC ELLATION Q uit and le t it get s et in CHEC K2
	4598	"RTN","PRC ACPSA",53, 0)
	4599	I PRCABFI X=1,$G(PRC ABFIX("D") )=1,(PRCAB ST=16!(PRC ABST=42)!( PRCABST=39 )) S $P(^
	4600	TMP("PRCAB ILL",$J,DE BTOR,BILL) ,U,3)=0 Q 0
	4601	"RTN","PRC ACPSA",54, 0)
	4602	; If a si ngle probl em on a Bi ll in a st atus other than Acti ve or Open mark las
	4603	t transact ion as NOT FIXABLE
	4604	"RTN","PRC ACPSA",55, 0)
	4605	I PRCABFI X=1,PRCABS T'=16&(PRC ABST'=42) D UPDTLTR( $G(TNLAST) )
	4606	"RTN","PRC ACPSA",56, 0)
	4607	; If a si ngle probl em on a Bi ll in a st atus of Ac tive or Op en will be further
	4608	checked in START2
	4609	"RTN","PRC ACPSA",57, 0)
	4610	I PRCABFI X=1,(PRCAB ST=16!(PRC ABST=42)) S PRCABFIX =0
	4611	"RTN","PRC ACPSA",58, 0)
	4612	; If mult iple probl ems set au dit fields for last transactio n for the Bill
	4613	"RTN","PRC ACPSA",59, 0)
	4614	I PRCABFI X>1 D UPDT LTR($G(TNL AST)) S PR CABFIX=1
	4615	"RTN","PRC ACPSA",60, 0)
	4616	; Update Bill level stop flag
	4617	"RTN","PRC ACPSA",61, 0)
	4618	S $P(^TMP ("PRCABILL ",$J,DEBTO R,BILL),U, 3)=PRCABFI X
	4619	"RTN","PRC ACPSA",62, 0)
	4620	Q PRCABFI X
	4621	"RTN","PRC ACPSA",63, 0)
	4622	;
	4623	"RTN","PRC ACPSA",64, 0)
	4624	UPDTLTR(TN LAST) ;
	4625	"RTN","PRC ACPSA",65, 0)
	4626	; Initial ize variab les
	4627	"RTN","PRC ACPSA",66, 0)
	4628	N PRCABIL L,PRCABILX ,PRCADTR,P RCATN,PRCA UPDT
	4629	"RTN","PRC ACPSA",67, 0)
	4630	; Initial ize PRCAUP DT to 0 (i .e. No). This flag is set to 1 when an transacti
	4631	on was upd ated with the audit data
	4632	"RTN","PRC ACPSA",68, 0)
	4633	S PRCAUPD T=0
	4634	"RTN","PRC ACPSA",69, 0)
	4635	; If TNLA ST was und efined or null or so mething ot her than a positive number, s
	4636	et TNLAST= 0
	4637	"RTN","PRC ACPSA",70, 0)
	4638	; If TNLA ST was a p ositive nu mber, leav e it as is
	4639	"RTN","PRC ACPSA",71, 0)
	4640	S TNLAST= +$G(TNLAST ,0)
	4641	"RTN","PRC ACPSA",72, 0)
	4642	; If the IEN was a decimal nu mber, stri p off the decimal am ount
	4643	"RTN","PRC ACPSA",73, 0)
	4644	S TNLAST= $P(TNLAST, ".",1)
	4645	"RTN","PRC ACPSA",74, 0)
	4646	; Init ch ecks for a positive IEN and no correspon ding trans action
	4647	"RTN","PRC ACPSA",75, 0)
	4648	I +TNLAST >0,'$D(^PR CA(433,TNL AST,0)) S TNLAST=0
	4649	"RTN","PRC ACPSA",76, 0)
	4650	; Init ch ecks for a positive IEN and th is Transac tion exist s
	4651	"RTN","PRC ACPSA",77, 0)
	4652	I +TNLAST >0,$D(^PRC A(433,TNLA ST,0)) D Q:PRCAUPDT
	4653	"RTN","PRC ACPSA",78, 0)
	4654	.; If thi s transact ion hasn't been prev iously use d to flag an account , use it
	4655	"RTN","PRC ACPSA",79, 0)
	4656	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="" S PRCAUPDT= 1 D UPDTSE T(TNLAST) Q
	4657	"RTN","PRC ACPSA",80, 0)
	4658	.; If thi s transact ion was pr eviously u sed to ide ntify a NO T FIXABLE issue
	4659	"RTN","PRC ACPSA",81, 0)
	4660	.; update it again to have to day's date
	4661	"RTN","PRC ACPSA",82, 0)
	4662	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="X" S PRCAUPDT =1 D UPDTS ET(TNLAST) Q
	4663	"RTN","PRC ACPSA",83, 0)
	4664	.; If thi s Transact ion was pr eviously u sed to fix an issue other than NOT FIXA
	4665	BLE,
	4666	"RTN","PRC ACPSA",84, 0)
	4667	.; reset to 0 to ma ke it find another t ransaction
	4668	"RTN","PRC ACPSA",85, 0)
	4669	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)'="", ($P($G(^PR CA(433,TNL AST,9)),U, 6)'="X")
	4670	S TNLAST=0
	4671	"RTN","PRC ACPSA",86, 0)
	4672	.Q
	4673	"RTN","PRC ACPSA",87, 0)
	4674	; If you get to her e, TNLAST was either sent in w ith a posi tive value that cou
	4675	ldn't be u sed
	4676	"RTN","PRC ACPSA",88, 0)
	4677	; OR TNLA ST was sen t in as a null or 0. Either wa y, try to find anoth er accept
	4678	able trans action to mark
	4679	"RTN","PRC ACPSA",89, 0)
	4680	; There i s a possib ility that no transa ction can be found t o mark, in which ca
	4681	se, just q uit
	4682	"RTN","PRC ACPSA",90, 0)
	4683	I +TNLAST <1 D Q:+T NLAST<1
	4684	"RTN","PRC ACPSA",91, 0)
	4685	.S PRCABI LX=""
	4686	"RTN","PRC ACPSA",92, 0)
	4687	.F S PRC ABILX=$O(^ TMP("PRCAG TPS",$J,DE BTOR,PRCAB ILX),-1) Q :'PRCABILX D Q:TN
	4688	LAST
	4689	"RTN","PRC ACPSA",93, 0)
	4690	..S PRCAT N=""
	4691	"RTN","PRC ACPSA",94, 0)
	4692	..F S PR CATN=$O(^T MP("PRCAGT PS",$J,DEB TOR,PRCABI LX,PRCATN) ,-1) Q:'PR CATN D
	4693	Q:TNLAST
	4694	"RTN","PRC ACPSA",95, 0)
	4695	...; Quit if this t ransaction from ^TMP doesn't e xist in ^P RCA(433
	4696	"RTN","PRC ACPSA",96, 0)
	4697	...I '$D( ^PRCA(433, PRCATN,0)) Q
	4698	"RTN","PRC ACPSA",97, 0)
	4699	...; If t his transa ction hasn 't been ma rked for a nything, u se it
	4700	"RTN","PRC ACPSA",98, 0)
	4701	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)="" S TNLAST= PRCATN Q
	4702	"RTN","PRC ACPSA",99, 0)
	4703	...; Chec k if this transactio n was prev iously fla gged as so me fix oth er than N
	4704	OT FIXABLE
	4705	"RTN","PRC ACPSA",100 ,0)
	4706	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)'=" X" Q
	4707	"RTN","PRC ACPSA",101 ,0)
	4708	...; If t his transc tion was p reviously marked as NOT FIXABL E, mark it again wi
	4709	th today's date
	4710	"RTN","PRC ACPSA",102 ,0)
	4711	...S TNLA ST=PRCATN
	4712	"RTN","PRC ACPSA",103 ,0)
	4713	; QUIT If no accept able trans action cou ld be foun d
	4714	"RTN","PRC ACPSA",104 ,0)
	4715	Q:+TNLAST <1
	4716	"RTN","PRC ACPSA",105 ,0)
	4717	; QUIT if this tran saction do esn't exis t for some reason
	4718	"RTN","PRC ACPSA",106 ,0)
	4719	Q:'$D(^PR CA(433,TNL AST,0))
	4720	"RTN","PRC ACPSA",107 ,0)
	4721	; Call UP DTSET to u pdate the transactio n that was identifie d
	4722	"RTN","PRC ACPSA",108 ,0)
	4723	D UPDTSET (TNLAST)
	4724	"RTN","PRC ACPSA",109 ,0)
	4725	Q
	4726	"RTN","PRC ACPSA",110 ,0)
	4727	;
	4728	"RTN","PRC ACPSA",111 ,0)
	4729	UPDTSET(TN LAST) ; On ce transac tion has b een identi fied, set the necess ary audit
	4730	fields
	4731	"RTN","PRC ACPSA",112 ,0)
	4732	; Identif y Bill for this Tran saction
	4733	"RTN","PRC ACPSA",113 ,0)
	4734	S PRCABIL L=$P($G(^P RCA(433,TN LAST,0)),U ,2)
	4735	"RTN","PRC ACPSA",114 ,0)
	4736	; Quit if bill can' t be ident ified
	4737	"RTN","PRC ACPSA",115 ,0)
	4738	Q:PRCABIL L=""
	4739	"RTN","PRC ACPSA",116 ,0)
	4740	; Use Bil l to ident ify Debtor
	4741	"RTN","PRC ACPSA",117 ,0)
	4742	S PRCADTR =$P($G(^PR CA(430,PRC ABILL,0)), U,9)
	4743	"RTN","PRC ACPSA",118 ,0)
	4744	; Quit if Debtor ca n't be def ined
	4745	"RTN","PRC ACPSA",119 ,0)
	4746	Q:PRCADTR =""
	4747	"RTN","PRC ACPSA",120 ,0)
	4748	; Quit if the stop flag for t his bill w as previou sly set in $$BILLQUI T^PRCACPS
	4749	A
	4750	"RTN","PRC ACPSA",121 ,0)
	4751	I $P($G(^ TMP("PRCAB ILL",$J,PR CADTR,PRCA BILL)),U,3 ) Q
	4752	"RTN","PRC ACPSA",122 ,0)
	4753	; Get cur rent date
	4754	"RTN","PRC ACPSA",123 ,0)
	4755	D NOW^%DT C
	4756	"RTN","PRC ACPSA",124 ,0)
	4757	N PRCADAT E
	4758	"RTN","PRC ACPSA",125 ,0)
	4759	S PRCADAT E=X
	4760	"RTN","PRC ACPSA",126 ,0)
	4761	; Set up Audit Fiel d Array
	4762	"RTN","PRC ACPSA",127 ,0)
	4763	S PRCAFDA (433,TNLAS T_",",94)= PRCADATE
	4764	"RTN","PRC ACPSA",128 ,0)
	4765	S PRCAFDA (433,TNLAS T_",",96)= "X" ; NOT FIXABLE
	4766	"RTN","PRC ACPSA",129 ,0)
	4767	S PRCAFDA (433,TNLAS T_",",97)= 1
	4768	"RTN","PRC ACPSA",130 ,0)
	4769	L +^PRCA( 433,TNLAST ,9):DILOCK TM
	4770	"RTN","PRC ACPSA",131 ,0)
	4771	; QUIT if lock not obtainable
	4772	"RTN","PRC ACPSA",132 ,0)
	4773	Q:'$T
	4774	"RTN","PRC ACPSA",133 ,0)
	4775	; Update record
	4776	"RTN","PRC ACPSA",134 ,0)
	4777	D FILE^DI E(,"PRCAFD A")
	4778	"RTN","PRC ACPSA",135 ,0)
	4779	; Unlock file
	4780	"RTN","PRC ACPSA",136 ,0)
	4781	L -^PRCA( 433,TNLAST ,9)
	4782	"RTN","PRC ACPSA",137 ,0)
	4783	Q
	4784	"RTN","PRC ACPSA",138 ,0)
	4785	;
	4786	"RTN","PRC ACPSA",139 ,0)
	4787	PRCAMAIL(P RCASTRT) ;
	4788	"RTN","PRC ACPSA",140 ,0)
	4789	; Send e- mail notif ication to the PRCAC PS mail gr oup if the Auto-Corr ect was m
	4790	anually ru n
	4791	"RTN","PRC ACPSA",141 ,0)
	4792	; when it showed to be curren tly runnin g or possi ble errore d out on a previous
	4793	attempt.
	4794	"RTN","PRC ACPSA",142 ,0)
	4795	;
	4796	"RTN","PRC ACPSA",143 ,0)
	4797	; PRCASTA RT = Exter nal format of date/t ime (i.e. OCT 12, 20 16@09:39:5 8) that t
	4798	he
	4799	"RTN","PRC ACPSA",144 ,0)
	4800	; Auto-Co rrect prog ram was la st started .
	4801	"RTN","PRC ACPSA",145 ,0)
	4802	N XMY,XMD UZ,XMSUB,X MTEXT,X
	4803	"RTN","PRC ACPSA",146 ,0)
	4804	S XMDUZ=" AR PACKAGE "
	4805	"RTN","PRC ACPSA",147 ,0)
	4806	S XMY("G. PRCACPS")= ""
	4807	"RTN","PRC ACPSA",148 ,0)
	4808	S XMSUB=" CPS AUTO-C ORRECTION FAILURE "_ $E(DT,4,5) _"/"_$E(DT ,6,7)_"/"_ $E(DT,2,3
	4809	)
	4810	"RTN","PRC ACPSA",149 ,0)
	4811	S X(1)="T he Patient Statement Auto-Corr ection Pro gram was s tarted on: "
	4812	"RTN","PRC ACPSA",150 ,0)
	4813	S X(2)=PR CASTRT_" a nd may not have comp leted norm ally."
	4814	"RTN","PRC ACPSA",151 ,0)
	4815	S X(3)=""
	4816	"RTN","PRC ACPSA",152 ,0)
	4817	S X(4)="P lease have OI&T chec k the erro r trap for any error s related to routin
	4818	e"
	4819	"RTN","PRC ACPSA",153 ,0)
	4820	S X(5)="P RCACPS on this date. "
	4821	"RTN","PRC ACPSA",154 ,0)
	4822	S XMTEXT= "X("
	4823	"RTN","PRC ACPSA",155 ,0)
	4824	D ^XMD
	4825	"RTN","PRC ACPSA",156 ,0)
	4826	Q
	4827	"RTN","PRC AG")
	4828	0^17^B7425 6403^B2201 6512
	4829	"RTN","PRC AG",1,0)
	4830	PRCAG ;WAS H-ISC@ALTO ONA,PA/CMS -Reprint S tatement/L etter Opti on Entries ;8/23/93
	4831	2:42 PM
	4832	"RTN","PRC AG",2,0)
	4833	V ;;4.5;Ac counts Rec eivable; 149,165,19 8,313;Ma r 20, 1995 ;Build 124
	4834	"RTN","PRC AG",3,0)
	4835	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	4836	"RTN","PRC AG",4,0)
	4837	REP ;ENTRY FROM REPR INT PAT ST ATEMENT
	4838	"RTN","PRC AG",5,0)
	4839	NEW BEG,E ND,DAT,DAT E,DEB,DIC, HDAT,IOP,S ITE,TYP,X, Y,ZTDESC,Z TRTN,ZTSAV E,SDT,%ZI
	4840	S,POP,ZTIO
	4841	"RTN","PRC AG",6,0)
	4842	W !!
	4843	"RTN","PRC AG",7,0)
	4844	ADT ; PRC A4.5313 - Build an d print a list of av ailable da tes for Pa tient Sta
	4845	tements wi thin the l ast month
	4846	"RTN","PRC AG",8,0)
	4847	W !,"Thes e dates in the previ ous month contain Pa tient Stat ements: "
	4848	"RTN","PRC AG",9,0)
	4849	S DAT="" F S DAT=$ O(^RCPS(34 9.2,"STDT" ,DAT)) Q:D AT="" I $ D(^RC(341, "STDT",DA
	4850	T)) W !,$$ DATE^RCCPC PS1(DAT)
	4851	"RTN","PRC AG",10,0)
	4852	W !!
	4853	"RTN","PRC AG",11,0)
	4854	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4855	"RTN","PRC AG",12,0)
	4856	S DIR(0)= "DAO^^K:'$ D(^RC(341, ""STDT"",Y )) X"
	4857	"RTN","PRC AG",13,0)
	4858	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	4859	"RTN","PRC AG",14,0)
	4860	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	4861	"RTN","PRC AG",15,0)
	4862	D ^DIR
	4863	"RTN","PRC AG",16,0)
	4864	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4865	"RTN","PRC AG",17,0)
	4866	S SDT=Y
	4867	"RTN","PRC AG",18,0)
	4868	W !!,"NOT E: The ran ge is in p rint order not alpha betic!",!
	4869	"RTN","PRC AG",19,0)
	4870	S X=""
	4871	"RTN","PRC AG",20,0)
	4872	S BEG=$O( ^RC(341,"S TDT",SDT," "))
	4873	"RTN","PRC AG",21,0)
	4874	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4875	"RTN","PRC AG",22,0)
	4876	S DIR(0)= "YAO"
	4877	"RTN","PRC AG",23,0)
	4878	S DIR("B" )="N"
	4879	"RTN","PRC AG",24,0)
	4880	S DIR("A" )="Do you want to St art with a Specific Patient? "
	4881	"RTN","PRC AG",25,0)
	4882	D ^DIR
	4883	"RTN","PRC AG",26,0)
	4884	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4885	"RTN","PRC AG",27,0)
	4886	I Y=0 S X =""
	4887	"RTN","PRC AG",28,0)
	4888	I Y=1 S X =$$SELNAME (SDT)
	4889	"RTN","PRC AG",29,0)
	4890	I X=-1 Q
	4891	"RTN","PRC AG",30,0)
	4892	I X'="" S BEG=X
	4893	"RTN","PRC AG",31,0)
	4894	; PRCA4. 5313 - Us e statemen t date cro ss-referen ce to prov ide a pati ent list
	4895	"RTN","PRC AG",32,0)
	4896	S X=""
	4897	"RTN","PRC AG",33,0)
	4898	S END=$O( ^RC(341,"S TDT",SDT," "),-1)
	4899	"RTN","PRC AG",34,0)
	4900	W !,"Endi ng Patient Bill must be printe d after th e Starting Patient B ill.",!
	4901	"RTN","PRC AG",35,0)
	4902	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4903	"RTN","PRC AG",36,0)
	4904	S DIR(0)= "YAO"
	4905	"RTN","PRC AG",37,0)
	4906	S DIR("B" )="N"
	4907	"RTN","PRC AG",38,0)
	4908	S DIR("A" )="Do you want to En d with a S pecific Pa tient? "
	4909	"RTN","PRC AG",39,0)
	4910	D ^DIR
	4911	"RTN","PRC AG",40,0)
	4912	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4913	"RTN","PRC AG",41,0)
	4914	I Y=0 S X =""
	4915	"RTN","PRC AG",42,0)
	4916	I Y=1 S X =$$SELNAME (SDT)
	4917	"RTN","PRC AG",43,0)
	4918	I X=-1 Q
	4919	"RTN","PRC AG",44,0)
	4920	I X'="" S END=X
	4921	"RTN","PRC AG",45,0)
	4922	I END>0,E ND<BEG W * 7,!,"Endin g bill is before sta rting bill !" D Q:$D (DTOUT)!$
	4923	D(DUOUT)!$ D(DIRUT)!$ D(DIROUT) G ADT
	4924	"RTN","PRC AG",46,0)
	4925	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4926	"RTN","PRC AG",47,0)
	4927	. S DIR(0 )="E"
	4928	"RTN","PRC AG",48,0)
	4929	. D ^DIR
	4930	"RTN","PRC AG",49,0)
	4931	S HDAT=99 99999-SDT
	4932	"RTN","PRC AG",50,0)
	4933	REPD W !! S %ZIS="QN ",IOP="Q", %ZIS("B")= $P($G(^RC( 342,1,0)), U,8) D ^%Z IS G:POP
	4934	REPQ
	4935	"RTN","PRC AG",51,0)
	4936	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REP D
	4937	"RTN","PRC AG",52,0)
	4938	S ZTRTN=" REP^PRCAGS ",ZTDESC=" Reprint AR Patient S tatements" ,ZTSAVE("B EG")="",Z
	4939	TSAVE("END ")="",ZTSA VE("HDAT") ="" D ^%ZT LOAD
	4940	"RTN","PRC AG",53,0)
	4941	REPQ ; PRC A4.5313 - Kill TMP ($J Lists prior to q uit
	4942	"RTN","PRC AG",54,0)
	4943	D ^%ZISC
	4944	"RTN","PRC AG",55,0)
	4945	K ^TMP($J ,"LISTNAME "),^TMP($J ,"LISTCNT" )
	4946	"RTN","PRC AG",56,0)
	4947	Q
	4948	"RTN","PRC AG",57,0)
	4949	UB ;ENTRY FROM REPRI NT UB BILL S
	4950	"RTN","PRC AG",58,0)
	4951	S ETY="UB " ;set eve nt type to UB and us e REB sub- routine
	4952	"RTN","PRC AG",59,0)
	4953	REB ;ENTRY FROM REPR INT FOLLOW -UP LETTER S
	4954	"RTN","PRC AG",60,0)
	4955	NEW BEG,E ND,DAT,DAT E,DEB,DIC, IOP,SITE,T YP,X,Y,ZTD ESC,ZTRTN, ZTSAVE,%DT ,DA,DIR,D
	4956	TOUT
	4957	"RTN","PRC AG",61,0)
	4958	D SITE^PR CAGU
	4959	"RTN","PRC AG",62,0)
	4960	S:'$D(ETY ) ETY="FL"
	4961	"RTN","PRC AG",63,0)
	4962	REBDT S %D T="AEXP",% DT(0)="-NO W",%DT("A" )="Enter a Date to R eprint: " D ^%DT G:
	4963	Y<1 REBQ
	4964	"RTN","PRC AG",64,0)
	4965	S Y=$P(Y, ".")
	4966	"RTN","PRC AG",65,0)
	4967	I $P($O(^ RC(341,"C" ,Y)),".")' =Y W !!,*7 ,"No notif ications s ent on tha t date",!
	4968	G REBDT
	4969	"RTN","PRC AG",66,0)
	4970	S DAT=999 9999-Y
	4971	"RTN","PRC AG",67,0)
	4972	W !!,"Pre ss return at the 'Bi ll:' promp ts to repr int all ", ETY," Lett ers",!,"f
	4973	or the dat e selected or select a start a nd/or end point."
	4974	"RTN","PRC AG",68,0)
	4975	W !,"Do n ot select bills that print on the Patien t Statemen t."
	4976	"RTN","PRC AG",69,0)
	4977	W !,"NOTE : The rang e is in pr int order not alphab etic!",!
	4978	"RTN","PRC AG",70,0)
	4979	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	4980	"RTN","PRC AG",71,0)
	4981	S DIC="^P RCA(430,", DIC(0)="AE MNQ",DIC(" A")="Start from Bill : ",DIC("S ")="I "",
	4982	18,25,5,24 ,1,2,3,4,2 3,22,""'[( "",""_$P(^ (0),U,2)_" ","")" D ^ DIC I ($D( DTOUT))!(
	4983	X["^") G R EBQ
	4984	"RTN","PRC AG",72,0)
	4985	S BEG=0,Y =+Y
	4986	"RTN","PRC AG",73,0)
	4987	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="
	4988	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
	4989	ATE,".")'= DAT D
	4990	"RTN","PRC AG",74,0)
	4991	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y
	4992	S BEG=DA, DEB=0 Q
	4993	"RTN","PRC AG",75,0)
	4994	.Q
	4995	"RTN","PRC AG",76,0)
	4996	I BEG=0 S BEG=$O(^R C(341,"C", +$O(^RC(34 1,"C",9999 999-DAT)), 0)) S:'BEG BEG=-1
	4997	"RTN","PRC AG",77,0)
	4998	I BEG<0 W *7,!," So rry, not f ound!" G R EBDT
	4999	"RTN","PRC AG",78,0)
	5000	S DIC("A" )="End aft er Bill: " D ^DIC I ($D(DTOUT) )!(X["^") G REBQ
	5001	"RTN","PRC AG",79,0)
	5002	S END="*" ,Y=+Y
	5003	"RTN","PRC AG",80,0)
	5004	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="
	5005	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
	5006	ATE,".")'= DAT D
	5007	"RTN","PRC AG",81,0)
	5008	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y
	5009	S END=DA, DEB=0 Q
	5010	"RTN","PRC AG",82,0)
	5011	.Q
	5012	"RTN","PRC AG",83,0)
	5013	I END<0 W *7,!," So rry, not f ound!" G R EBDT
	5014	"RTN","PRC AG",84,0)
	5015	I END'="* ",END<BEG W *7,!,"En ding bill is before starting b ill!" G RE BDT
	5016	"RTN","PRC AG",85,0)
	5017	W !!
	5018	"RTN","PRC AG",86,0)
	5019	REBD I ETY ="UB" S ZT IO="" G RE BD1
	5020	"RTN","PRC AG",87,0)
	5021	S %ZIS("B ")=$P($G(^ RC(342,1,0 )),U,8),%Z IS="QN",IO P="Q" D ^% ZIS G:POP REBQ
	5022	"RTN","PRC AG",88,0)
	5023	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REB D
	5024	"RTN","PRC AG",89,0)
	5025	REBD1 S ZT RTN="BILL^ PRCAGS",ZT SAVE("BEG" )="",ZTSAV E("END")=" ",ZTSAVE(" DAT")="",
	5026	ZTSAVE("SI TE")="",ZT SAVE("ETY" )=""
	5027	"RTN","PRC AG",90,0)
	5028	S ZTDESC= $S(ETY="UB ":"AR Repr int UB Let ters",1:"R eprint AR Follow-up Letters")
	5029	D ^%ZTLOA D
	5030	"RTN","PRC AG",91,0)
	5031	REBQ K ETY D ^%ZISC Q
	5032	"RTN","PRC AG",92,0)
	5033	PRDT ;ENTR Y FROM PRI NT STATEME NT/LETTER BY DATE OP TION
	5034	"RTN","PRC AG",93,0)
	5035	D PRDT^PR CAGP
	5036	"RTN","PRC AG",94,0)
	5037	Q
	5038	"RTN","PRC AG",95,0)
	5039	SELNAME(SD T) ; PRCA ^4.5^313 - Create a list and t hen select a patient name
	5040	"RTN","PRC AG",96,0)
	5041	; There a re three v alues to R eturn from this tag
	5042	"RTN","PRC AG",97,0)
	5043	; IEN -- Number from list of Selecte d Patient
	5044	"RTN","PRC AG",98,0)
	5045	; Null -- No Pati ent Select ed from li st - used to begin o r end Sele ction lis
	5046	t
	5047	"RTN","PRC AG",99,0)
	5048	; -1 -- Quit pr ocessing f rom called tag
	5049	"RTN","PRC AG",100,0)
	5050	N IEN,CNT ,NAME
	5051	"RTN","PRC AG",101,0)
	5052	W !,"Plea se wait wh ile we bui ld the pat ient list. ",!
	5053	"RTN","PRC AG",102,0)
	5054	K ^TMP($J ,"LISTNAME ")
	5055	"RTN","PRC AG",103,0)
	5056	S (IEN,CN T)=0
	5057	"RTN","PRC AG",104,0)
	5058	F S IEN= $O(^RC(341 ,"STDT",SD T,IEN)) Q: IEN="" D
	5059	"RTN","PRC AG",105,0)
	5060	. N PAT,N AME
	5061	"RTN","PRC AG",106,0)
	5062	. S PAT=$ P(^RCD(340 ,$P(^RC(34 1,IEN,0)," ^",5),0)," ;")
	5063	"RTN","PRC AG",107,0)
	5064	. S NAME= $P(^DPT(PA T,0),U)
	5065	"RTN","PRC AG",108,0)
	5066	. S ^TMP( $J,"LISTNA ME",NAME)= IEN
	5067	"RTN","PRC AG",109,0)
	5068	; Quit th e listing if no name s to displ ay
	5069	"RTN","PRC AG",110,0)
	5070	I '$D(^TM P($J,"LIST NAME")) D Q -1
	5071	"RTN","PRC AG",111,0)
	5072	. W !,"Th ere are no names to display fo r this dat e."
	5073	"RTN","PRC AG",112,0)
	5074	. S DIR(0 )="E" D ^D IR
	5075	"RTN","PRC AG",113,0)
	5076	S NAME=$$ ENTNAM
	5077	"RTN","PRC AG",114,0)
	5078	I NAME="^ " Q -1
	5079	"RTN","PRC AG",115,0)
	5080	I NAME="" Q NAME
	5081	"RTN","PRC AG",116,0)
	5082	I $G(NAME )'="",$D(^ TMP($J,"LI STNAME",NA ME)) S IEN =^(NAME) Q IEN
	5083	"RTN","PRC AG",117,0)
	5084	W !!,"Pat ient Name is not an exact matc h."
	5085	"RTN","PRC AG",118,0)
	5086	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	5087	"RTN","PRC AG",119,0)
	5088	S DIR(0)= "YAO"
	5089	"RTN","PRC AG",120,0)
	5090	S DIR("B" )="N"
	5091	"RTN","PRC AG",121,0)
	5092	S DIR("A" )="Would y ou like to search Pa tient Name s for "_$$ DATE^RCCPC PS1(SDT)_
	5093	"? "
	5094	"RTN","PRC AG",122,0)
	5095	D ^DIR
	5096	"RTN","PRC AG",123,0)
	5097	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	5098	"RTN","PRC AG",124,0)
	5099	I Y=0 N Q UIT D I Q UIT'=0 Q Q UIT
	5100	"RTN","PRC AG",125,0)
	5101	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	5102	"RTN","PRC AG",126,0)
	5103	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	5104	"RTN","PRC AG",127,0)
	5105	. S DIR(0 )="YAO"
	5106	"RTN","PRC AG",128,0)
	5107	. S DIR(" B")="Y"
	5108	"RTN","PRC AG",129,0)
	5109	. S DIR(" A")="Is th is correct ? "
	5110	"RTN","PRC AG",130,0)
	5111	. D ^DIR
	5112	"RTN","PRC AG",131,0)
	5113	. S QUIT= Y
	5114	"RTN","PRC AG",132,0)
	5115	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	5116	"RTN","PRC AG",133,0)
	5117	. I QUIT= 1 S QUIT=" "
	5118	"RTN","PRC AG",134,0)
	5119	; Select Name - If Zero (0) i s returned keep tryi ng
	5120	"RTN","PRC AG",135,0)
	5121	F S IEN= $$SELNM1(N AME) I IEN '=0 Q
	5122	"RTN","PRC AG",136,0)
	5123	Q IEN
	5124	"RTN","PRC AG",137,0)
	5125	SELNM1(NM) ; Select name
	5126	"RTN","PRC AG",138,0)
	5127	N DIRUT,X CNT,DIR,CN T
	5128	"RTN","PRC AG",139,0)
	5129	K ^TMP($J ,"LISTCNT" )
	5130	"RTN","PRC AG",140,0)
	5131	S CNT=0,N AME=""
	5132	"RTN","PRC AG",141,0)
	5133	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I $D(D IRUT) Q
	5134	"RTN","PRC AG",142,0)
	5135	. ; Add n ame to lis t only if first part of name m atches ent ered name
	5136	"RTN","PRC AG",143,0)
	5137	. I $E(NA ME,1,$L(NM ))'=NM Q
	5138	"RTN","PRC AG",144,0)
	5139	. I CNT=0 W @IOF,"N umber",?10 ,"Patient Name"
	5140	"RTN","PRC AG",145,0)
	5141	. S CNT=C NT+1
	5142	"RTN","PRC AG",146,0)
	5143	. S ^TMP( $J,"LISTCN T",CNT,NAM E)=^TMP($J ,"LISTNAME ",NAME)
	5144	"RTN","PRC AG",147,0)
	5145	. W !,CNT ,?10,NAME
	5146	"RTN","PRC AG",148,0)
	5147	. I ($Y+3 )>IOSL D Q:$D(DIRUT )
	5148	"RTN","PRC AG",149,0)
	5149	. . S DIR (0)="E" D ^DIR
	5150	"RTN","PRC AG",150,0)
	5151	. . I X=" ^" Q
	5152	"RTN","PRC AG",151,0)
	5153	. . W @IO F,"Number" ,?10,"Pati ent Name"
	5154	"RTN","PRC AG",152,0)
	5155	; If no n ames match ed entered name Quit to menu
	5156	"RTN","PRC AG",153,0)
	5157	I CNT=0 D Q QUIT
	5158	"RTN","PRC AG",154,0)
	5159	. W @IOF, "No Matche s to Patie nt Name en tered were found.",!
	5160	"RTN","PRC AG",155,0)
	5161	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	5162	"RTN","PRC AG",156,0)
	5163	. S DIR(0 )="E"
	5164	"RTN","PRC AG",157,0)
	5165	. D ^DIR
	5166	"RTN","PRC AG",158,0)
	5167	. S QUIT= 0
	5168	"RTN","PRC AG",159,0)
	5169	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	5170	"RTN","PRC AG",160,0)
	5171	W !,"Plea se enter n umber of s elected Pa tient Name : " R XCNT :DTIME
	5172	"RTN","PRC AG",161,0)
	5173	I XCNT="^ " Q -1
	5174	"RTN","PRC AG",162,0)
	5175	; If a va lue entere d is not i n LISTCNT, write err or and all ow retry i f request
	5176	ed
	5177	"RTN","PRC AG",163,0)
	5178	I XCNT'=" ",'$D(^TMP ($J,"LISTC NT",XCNT)) N QUIT D Q QUIT
	5179	"RTN","PRC AG",164,0)
	5180	. W !,"Va lue entere d not a li sted numbe r.",!
	5181	"RTN","PRC AG",165,0)
	5182	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	5183	"RTN","PRC AG",166,0)
	5184	. S DIR(0 )="E"
	5185	"RTN","PRC AG",167,0)
	5186	. D ^DIR
	5187	"RTN","PRC AG",168,0)
	5188	. S QUIT= 0
	5189	"RTN","PRC AG",169,0)
	5190	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	5191	"RTN","PRC AG",170,0)
	5192	I XCNT="" N QUIT D Q QUIT
	5193	"RTN","PRC AG",171,0)
	5194	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	5195	"RTN","PRC AG",172,0)
	5196	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	5197	"RTN","PRC AG",173,0)
	5198	. S DIR(0 )="YAO"
	5199	"RTN","PRC AG",174,0)
	5200	. S DIR(" B")="Y"
	5201	"RTN","PRC AG",175,0)
	5202	. S DIR(" A")="No Pa tient Sele cted. "
	5203	"RTN","PRC AG",176,0)
	5204	. S DIR(" A",1)="Is this corre ct? "
	5205	"RTN","PRC AG",177,0)
	5206	. D ^DIR
	5207	"RTN","PRC AG",178,0)
	5208	. S QUIT= Y
	5209	"RTN","PRC AG",179,0)
	5210	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	5211	"RTN","PRC AG",180,0)
	5212	. I QUIT= 1 S QUIT=" "
	5213	"RTN","PRC AG",181,0)
	5214	S CNT=XCN T
	5215	"RTN","PRC AG",182,0)
	5216	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	5217	"RTN","PRC AG",183,0)
	5218	S DIR(0)= "YAO"
	5219	"RTN","PRC AG",184,0)
	5220	S DIR("B" )="Y"
	5221	"RTN","PRC AG",185,0)
	5222	S DIR("A" )="...OK? "
	5223	"RTN","PRC AG",186,0)
	5224	S DIR("A" ,1)=""
	5225	"RTN","PRC AG",187,0)
	5226	S DIR("A" ,2)=$O(^TM P($J,"LIST CNT",CNT,0 ))
	5227	"RTN","PRC AG",188,0)
	5228	D ^DIR
	5229	"RTN","PRC AG",189,0)
	5230	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	5231	"RTN","PRC AG",190,0)
	5232	; If user answered No, then t ry again
	5233	"RTN","PRC AG",191,0)
	5234	I Y=0 Q Y
	5235	"RTN","PRC AG",192,0)
	5236	S NAME=$O (^TMP($J," LISTCNT",C NT,0))
	5237	"RTN","PRC AG",193,0)
	5238	Q ^TMP($J ,"LISTCNT" ,CNT,NAME)
	5239	"RTN","PRC AG",194,0)
	5240	;
	5241	"RTN","PRC AG",195,0)
	5242	ENTNAM() ; Enter na me and pri nt list of names if requested
	5243	"RTN","PRC AG",196,0)
	5244	;
	5245	"RTN","PRC AG",197,0)
	5246	N HIT,X
	5247	"RTN","PRC AG",198,0)
	5248	S HIT=0
	5249	"RTN","PRC AG",199,0)
	5250	F D I H IT Q
	5251	"RTN","PRC AG",200,0)
	5252	. W !,"Pl ease enter all or pa rt of Pati ent Name: " R NAME:D TIME
	5253	"RTN","PRC AG",201,0)
	5254	. I NAME' ["?" S HIT =1 Q
	5255	"RTN","PRC AG",202,0)
	5256	. I NAME= "?" D LIST NAME(1)
	5257	"RTN","PRC AG",203,0)
	5258	. I NAME= "??" D LIS TNAME(2)
	5259	"RTN","PRC AG",204,0)
	5260	. ; If th e user ent ers a care t in LISTN AME quit a nd return a caret in NAME to
	5261	Quit appli cation
	5262	"RTN","PRC AG",205,0)
	5263	. I X="^" S NAME=X, HIT=1
	5264	"RTN","PRC AG",206,0)
	5265	Q NAME
	5266	"RTN","PRC AG",207,0)
	5267	;
	5268	"RTN","PRC AG",208,0)
	5269	LISTNAME(H EADER) ; Display li st of name
	5270	"RTN","PRC AG",209,0)
	5271	;
	5272	"RTN","PRC AG",210,0)
	5273	N NAME,CN T,DIR,DTOU T,DUOUT,DI RUT,DIROUT
	5274	"RTN","PRC AG",211,0)
	5275	S NAME="" ,CNT=0
	5276	"RTN","PRC AG",212,0)
	5277	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I $D(D TOUT)!$D(D UOUT)!$D(
	5278	DIRUT)!$D( DIROUT) Q
	5279	"RTN","PRC AG",213,0)
	5280	. I CNT=0 ,HEADER=1 W @IOF,"Pa tient Name "
	5281	"RTN","PRC AG",214,0)
	5282	. I CNT=0 ,HEADER=2 D I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	5283	"RTN","PRC AG",215,0)
	5284	. . W @IO F,"The use r can ente r all or p art of a n ame or '?' for the"
	5285	"RTN","PRC AG",216,0)
	5286	. . W !," list of na mes availa ble for th e selected date."
	5287	"RTN","PRC AG",217,0)
	5288	. . S DIR (0)="E" D ^DIR
	5289	"RTN","PRC AG",218,0)
	5290	. . I $D( DTOUT)!$D( DUOUT)!$D( DIRUT)!$D( DIROUT) Q
	5291	"RTN","PRC AG",219,0)
	5292	. . W !!, "Patient N ame"
	5293	"RTN","PRC AG",220,0)
	5294	. S CNT=C NT+1
	5295	"RTN","PRC AG",221,0)
	5296	. W !,NAM E
	5297	"RTN","PRC AG",222,0)
	5298	. I ($Y+3 )>IOSL D I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	5299	"RTN","PRC AG",223,0)
	5300	. . S DIR (0)="E" D ^DIR
	5301	"RTN","PRC AG",224,0)
	5302	. . I $D( DTOUT)!$D( DUOUT)!$D( DIRUT)!$D( DIROUT) S X="" Q
	5303	"RTN","PRC AG",225,0)
	5304	. . W @IO F,"Patient Name"
	5305	"RTN","PRC AG",226,0)
	5306	Q
	5307	"RTN","RCB EADJ")
	5308	0^24^B7710 6309^B7712 5147
	5309	"RTN","RCB EADJ",1,0)
	5310	RCBEADJ ;W ISC/RFJ-ad justment ; Jun 06, 20 14@19:11:1 9
	5311	"RTN","RCB EADJ",2,0)
	5312	;;4.5;Acc ounts Rece ivable;1 69,172,204 ,173,208,2 33,298,301 ,313;Mar 20, 1995
	5313	;Build 124
	5314	"RTN","RCB EADJ",3,0)
	5315	;Per VA D irective 6 402, this routine sh ould not b e modified .
	5316	"RTN","RCB EADJ",4,0)
	5317	Q
	5318	"RTN","RCB EADJ",5,0)
	5319	;
	5320	"RTN","RCB EADJ",6,0)
	5321	;
	5322	"RTN","RCB EADJ",7,0)
	5323	DECREASE ; menu opt ion: creat e a decrea se adjustm ent
	5324	"RTN","RCB EADJ",8,0)
	5325	D ADJUST( "DECREASE" )
	5326	"RTN","RCB EADJ",9,0)
	5327	Q
	5328	"RTN","RCB EADJ",10,0 )
	5329	;
	5330	"RTN","RCB EADJ",11,0 )
	5331	;
	5332	"RTN","RCB EADJ",12,0 )
	5333	INCREASE ; menu opt ion: creat e an incre ase adjust ment
	5334	"RTN","RCB EADJ",13,0 )
	5335	D ADJUST( "INCREASE" )
	5336	"RTN","RCB EADJ",14,0 )
	5337	Q
	5338	"RTN","RCB EADJ",15,0 )
	5339	;
	5340	"RTN","RCB EADJ",16,0 )
	5341	ADJUST(RCB ETYPE,RCED I) ; crea te an adju stment
	5342	"RTN","RCB EADJ",17,0 )
	5343	; rcbety pe = INCRE ASE for in crease or DECREASE f or decreas e
	5344	"RTN","RCB EADJ",18,0 )
	5345	; rcedi = the ien of the bil l selected via the E DI Worklis t;ien of
	5346	"RTN","RCB EADJ",19,0 )
	5347	; XX the ER A entry or null/unde fined if b ill should be select ed
	5348	"RTN","RCB EADJ",20,0 )
	5349	N RCBILLD A
	5350	"RTN","RCB EADJ",21,0 )
	5351	F D Q:R CBILLDA<0! $G(RCEDI)
	5352	"RTN","RCB EADJ",22,0 )
	5353	. K RCT RANDA,RCLI ST
	5354	"RTN","RCB EADJ",23,0 )
	5355	. ;
	5356	"RTN","RCB EADJ",24,0 )
	5357	. ; se lect a bil l
	5358	"RTN","RCB EADJ",25,0 )
	5359	. S RCB ILLDA=$S(' $G(RCEDI): $$GETABILL ^RCBEUBIL, 1:+RCEDI)
	5360	"RTN","RCB EADJ",26,0 )
	5361	. I RCB ILLDA<1 Q
	5362	"RTN","RCB EADJ",27,0 )
	5363	. I $D( ^PRCA(430, "TCSP",RCB ILLDA)),(R CBETYPE="I NCREASE") W !,"BILL HAS BEEN
	5364	REFERRED T O CROSS-SE RVICING.", !,"NO MANU AL INCREAS E ADJUSTME NTS ARE AL LOWED." Q
	5365	;prca4. 5301
	5366	"RTN","RCB EADJ",28,0 )
	5367	. I $D( ^PRCA(430, "TCSP",RCB ILLDA)),(R CBETYPE="D ECREASE") S %=2 W !! ,"IS THIS
	5368	ACTION BE ING PERFOR MED DUE TO THE CLAIM S MATCHING PROCESS? " D YN^DIC N Q:(%<0)
	5369	!(%=2) ;p rca4.530 1
	5370	"RTN","RCB EADJ",29,0 )
	5371	. ;
	5372	"RTN","RCB EADJ",30,0 )
	5373	. ; ad just the b ill
	5374	"RTN","RCB EADJ",31,0 )
	5375	. D ADJ BILL(RCBET YPE,RCBILL DA,$P($G(R CEDI),";", 2))
	5376	"RTN","RCB EADJ",32,0 )
	5377	Q
	5378	"RTN","RCB EADJ",33,0 )
	5379	;
	5380	"RTN","RCB EADJ",34,0 )
	5381	ADJBILL(RC BETYPE,RCB ILLDA,RCED IWL) ; ad just a bil l
	5382	"RTN","RCB EADJ",35,0 )
	5383	; RCEDIWL = ien of ERA entry if called from workl ist
	5384	"RTN","RCB EADJ",36,0 )
	5385	N RCAMOUN T,RCBALANC ,RCDATA7,R CLIST,RCON TADJ,RCTRA NDA,TOTALC AL,TOTALST O,I,X,Y
	5386	"RTN","RCB EADJ",37,0 )
	5387	; lock t he bill
	5388	"RTN","RCB EADJ",38,0 )
	5389	L +^PRCA( 430,RCBILL DA):5 E W !,"ANOTHE R USER IS CURRENTLY WORKING WI TH THIS B
	5390	ILL." Q
	5391	"RTN","RCB EADJ",39,0 )
	5392	;
	5393	"RTN","RCB EADJ",40,0 )
	5394	; show d ata for th e bill
	5395	"RTN","RCB EADJ",41,0 )
	5396	D SHOWBIL L^RCWROFF1 (RCBILLDA)
	5397	"RTN","RCB EADJ",42,0 )
	5398	;
	5399	"RTN","RCB EADJ",43,0 )
	5400	; check the balanc e of the b ill
	5401	"RTN","RCB EADJ",44,0 )
	5402	W !!,"Che cking the bill's bal ance ..."
	5403	"RTN","RCB EADJ",45,0 )
	5404	S RCBALAN C=$$OUTOFB AL^RCBDBBA L(RCBILLDA )
	5405	"RTN","RCB EADJ",46,0 )
	5406	I RCBALAN C="" W " I N Balance! "
	5407	"RTN","RCB EADJ",47,0 )
	5408	;
	5409	"RTN","RCB EADJ",48,0 )
	5410	; out of balance, ask to fix it
	5411	"RTN","RCB EADJ",49,0 )
	5412	I RCBALAN C'="" D I RCBILLDA< 1 D UNLOCK Q
	5413	"RTN","RCB EADJ",50,0 )
	5414	. S TOT ALCAL=$P(R CBALANC,"^ ")+$P(RCBA LANC,"^",2 )+$P(RCBAL ANC,"^",3) +$P(RCBAL
	5415	ANC,"^",4) +$P(RCBALA NC,"^",5)
	5416	"RTN","RCB EADJ",51,0 )
	5417	. S RCD ATA7=$G(^P RCA(430,RC BILLDA,7))
	5418	"RTN","RCB EADJ",52,0 )
	5419	. S TOT ALSTO=$P(R CDATA7,"^" )+$P(RCDAT A7,"^",2)+ $P(RCDATA7 ,"^",3)+$P (RCDATA7,
	5420	"^",4)+$P( RCDATA7,"^ ",5)
	5421	"RTN","RCB EADJ",53,0 )
	5422	. W " O UT of Bala nce!"
	5423	"RTN","RCB EADJ",54,0 )
	5424	. W !!, " B ALANCE:",$ J("Calcula ted",12),$ J("Stored" ,12)
	5425	"RTN","RCB EADJ",55,0 )
	5426	. W !," -- ----- ",$J ("-------- ----",12), $J("------ ------",1
	5427	2)
	5428	"RTN","RCB EADJ",56,0 )
	5429	. W !," Pr incipal Ba lance:",$J ($P(RCBALA NC,"^",1), 12,2),$J($ P(RCDATA7
	5430	,"^",1),12 ,2)
	5431	"RTN","RCB EADJ",57,0 )
	5432	. I +$P (RCBALANC, "^",1)'=+$ P(RCDATA7, "^",1) W " <<-- OUT OF BALANC E"
	5433	"RTN","RCB EADJ",58,0 )
	5434	. W !," I nterest Ba lance:",$J ($P(RCBALA NC,"^",2), 12,2),$J($ P(RCDATA7
	5435	,"^",2),12 ,2)
	5436	"RTN","RCB EADJ",59,0 )
	5437	. I +$P (RCBALANC, "^",2)'=+$ P(RCDATA7, "^",2) W " <<-- OUT OF BALANC E"
	5438	"RTN","RCB EADJ",60,0 )
	5439	. W !," Admin Ba lance:",$J ($P(RCBALA NC,"^",3), 12,2),$J($ P(RCDATA7
	5440	,"^",3),12 ,2)
	5441	"RTN","RCB EADJ",61,0 )
	5442	. I +$P (RCBALANC, "^",3)'=+$ P(RCDATA7, "^",3) W " <<-- OUT OF BALANC E"
	5443	"RTN","RCB EADJ",62,0 )
	5444	. W !," MF Ba lance:",$J ($P(RCBALA NC,"^",4), 12,2),$J($ P(RCDATA7
	5445	,"^",4),12 ,2)
	5446	"RTN","RCB EADJ",63,0 )
	5447	. I +$P (RCBALANC, "^",4)'=+$ P(RCDATA7, "^",4) W " <<-- OUT OF BALANC E"
	5448	"RTN","RCB EADJ",64,0 )
	5449	. W !," CC Ba lance:",$J ($P(RCBALA NC,"^",5), 12,2),$J($ P(RCDATA7
	5450	,"^",5),12 ,2)
	5451	"RTN","RCB EADJ",65,0 )
	5452	. I +$P (RCBALANC, "^",5)'=+$ P(RCDATA7, "^",5) W " <<-- OUT OF BALANC E"
	5453	"RTN","RCB EADJ",66,0 )
	5454	. W !," -- ----- ",$J ("-------- -----",12) ,$J("----- --------"
	5455	,12)
	5456	"RTN","RCB EADJ",67,0 )
	5457	. W !," TOTAL:",$J (TOTALCAL, 12,2),$J(T OTALSTO,12 ,2)
	5458	"RTN","RCB EADJ",68,0 )
	5459	. I +TO TALCAL'=+T OTALSTO W " <<-- OU T OF BALAN CE"
	5460	"RTN","RCB EADJ",69,0 )
	5461	. ;
	5462	"RTN","RCB EADJ",70,0 )
	5463	. ; as k to fix t he balance s
	5464	"RTN","RCB EADJ",71,0 )
	5465	. S Y=$ $ASKFIX I Y'=1 W !," NOTE: Yo u must fix the Balan ce Discrep ancy befo
	5466	re process ing an adj ustment!" S RCBILLDA =0 Q
	5467	"RTN","RCB EADJ",72,0 )
	5468	. ;
	5469	"RTN","RCB EADJ",73,0 )
	5470	. ; fi x it
	5471	"RTN","RCB EADJ",74,0 )
	5472	. S $P( RCDATA7,"^ ",1)=+$P(R CBALANC,"^ ",1) ; pri ncipal
	5473	"RTN","RCB EADJ",75,0 )
	5474	. S $P( RCDATA7,"^ ",2)=+$P(R CBALANC,"^ ",2) ; int erest
	5475	"RTN","RCB EADJ",76,0 )
	5476	. S $P( RCDATA7,"^ ",3)=+$P(R CBALANC,"^ ",3) ; adm in
	5477	"RTN","RCB EADJ",77,0 )
	5478	. S $P( RCDATA7,"^ ",4)=+$P(R CBALANC,"^ ",4) ; mar shal fee
	5479	"RTN","RCB EADJ",78,0 )
	5480	. S $P( RCDATA7,"^ ",5)=+$P(R CBALANC,"^ ",5) ; cou rt cost
	5481	"RTN","RCB EADJ",79,0 )
	5482	. S $P( ^PRCA(430, RCBILLDA,7 ),"^",1,5) =$P(RCDATA 7,"^",1,5)
	5483	"RTN","RCB EADJ",80,0 )
	5484	. ;
	5485	"RTN","RCB EADJ",81,0 )
	5486	. W !," Balance Discrepanc y FIXED!"
	5487	"RTN","RCB EADJ",82,0 )
	5488	;
	5489	"RTN","RCB EADJ",83,0 )
	5490	; if the principal balance i s zero, do not allow it to be adjusted
	5491	"RTN","RCB EADJ",84,0 )
	5492	; ask to close/can cel it
	5493	"RTN","RCB EADJ",85,0 )
	5494	I RCBETYP E="DECREAS E",'$G(^PR CA(430,RCB ILLDA,7)) W !!,"Note : This bil l has NO
	5495	PRINCIPAL BALANCE to decrease !" D INTAD MIN(RCBILL DA),UNLOCK Q
	5496	"RTN","RCB EADJ",86,0 )
	5497	;
	5498	"RTN","RCB EADJ",87,0 )
	5499	; If entr y is from EDI Lockbo x worklist , display total adju stments in ERA
	5500	"RTN","RCB EADJ",88,0 )
	5501	N AP D
	5502	"RTN","RCB EADJ",89,0 )
	5503	.N BILL,E OB,ERA,SEQ S ERA="", AP=0
	5504	"RTN","RCB EADJ",90,0 )
	5505	.F S ERA =$O(^RCY(3 44.4,"AP", 1,ERA)) Q: 'ERA D Q :AP
	5506	"RTN","RCB EADJ",91,0 )
	5507	..S SEQ=0
	5508	"RTN","RCB EADJ",92,0 )
	5509	..F S SE Q=$O(^RCY( 344.4,"AP" ,1,ERA,SEQ )) Q:'SEQ D Q:AP
	5510	"RTN","RCB EADJ",93,0 )
	5511	...S EOB= $P($G(^RCY (344.4,ERA ,1,SEQ,0)) ,U,2) Q:'E OB
	5512	"RTN","RCB EADJ",94,0 )
	5513	...S:$P($ G(^IBM(361 .1,EOB,0)) ,U)=RCBILL DA AP=1 ;I A #4051
	5514	"RTN","RCB EADJ",95,0 )
	5515	;
	5516	"RTN","RCB EADJ",96,0 )
	5517	; Ask to enter tra nsaction e ven though it is mar ked for au topost PRC A4.5298
	5518	"RTN","RCB EADJ",97,0 )
	5519	I RCBETYP E="DECREAS E",AP S Y= $$ASKAUPO( ) I Y'=1 W !,"Exitin g bill adj ustment."
	5520	D UNLOCK Q
	5521	"RTN","RCB EADJ",98,0 )
	5522	;
	5523	"RTN","RCB EADJ",99,0 )
	5524	; ask to enter adj ustment am ount
	5525	"RTN","RCB EADJ",100, 0)
	5526	S RCAMOUN T=$$AMOUNT (RCBILLDA, RCBETYPE)
	5527	"RTN","RCB EADJ",101, 0)
	5528	I RCAMOUN T<0 D UNLO CK Q
	5529	"RTN","RCB EADJ",102, 0)
	5530	;
	5531	"RTN","RCB EADJ",103, 0)
	5532	; if dec rease, mak e negative
	5533	"RTN","RCB EADJ",104, 0)
	5534	I RCBETYP E="DECREAS E" S RCAMO UNT=-RCAMO UNT
	5535	"RTN","RCB EADJ",105, 0)
	5536	;
	5537	"RTN","RCB EADJ",106, 0)
	5538	; ask if it is a c ontract ad justment
	5539	"RTN","RCB EADJ",107, 0)
	5540	I RCBETYP E="DECREAS E","^9^28^ 29^30^32^" [("^"_$P($ G(^PRCA(43 0,RCBILLDA ,0)),"^",
	5541	2)_"^") S RCONTADJ=$ $ASKCONT I RCONTADJ< 0 D UNLOCK Q
	5542	"RTN","RCB EADJ",108, 0)
	5543	;
	5544	"RTN","RCB EADJ",109, 0)
	5545	; show w hat the ne w transact ion will l ook like
	5546	"RTN","RCB EADJ",110, 0)
	5547	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
	5548	"RTN","RCB EADJ",111, 0)
	5549	W !!,"If you proces s the tran saction, t he bill wi ll look li ke:"
	5550	"RTN","RCB EADJ",112, 0)
	5551	W !,"Curr ent Princi pal Balanc e: ",$J($P (RCDATA7," ^"),11,2)
	5552	"RTN","RCB EADJ",113, 0)
	5553	W !," NE W ",RCBETY PE," Adjus tment: ",$ J(RCAMOUNT ,11,2)
	5554	"RTN","RCB EADJ",114, 0)
	5555	W !," ------- ----"
	5556	"RTN","RCB EADJ",115, 0)
	5557	W !," NEW Princi pal Balanc e: ",$J($P (RCDATA7," ^")+RCAMOU NT,11,2)
	5558	"RTN","RCB EADJ",116, 0)
	5559	;
	5560	"RTN","RCB EADJ",117, 0)
	5561	; ask to enter tra nsaction
	5562	"RTN","RCB EADJ",118, 0)
	5563	S Y=$$ASK OK(RCBETYP E) I Y'=1 D UNLOCK Q
	5564	"RTN","RCB EADJ",119, 0)
	5565	;
	5566	"RTN","RCB EADJ",120, 0)
	5567	ADDADJ ; add adjust ment
	5568	"RTN","RCB EADJ",121, 0)
	5569	S RCTRAND A=$$INCDEC ^RCBEUTR1( RCBILLDA,R CAMOUNT,"" ,"","",$G( RCONTADJ))
	5570	"RTN","RCB EADJ",122, 0)
	5571	I 'RCTRAN DA W !," * W A R N I N G: A djustment NOT Proces sed! *" D UNLOCK
	5572	Q
	5573	"RTN","RCB EADJ",123, 0)
	5574	I RCTRAND A W !," A djustment Transactio n: ",RCTRA NDA," has been added ."
	5575	"RTN","RCB EADJ",124, 0)
	5576	I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D
	5577	DECADJ^RC TCSPU(RCBI LLDA,RCTRA NDA) ;prca 4.5301 a dd cs decr ease adjus tment
	5578	"RTN","RCB EADJ",125, 0)
	5579	I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD
	5580	^%DT W !!, " * * * * Transmis sion will be held un til "_Y_" * * * *"
	5581	"RTN","RCB EADJ",126, 0)
	5582	;
	5583	"RTN","RCB EADJ",127, 0)
	5584	; ask to enter a c omment
	5585	"RTN","RCB EADJ",128, 0)
	5586	W !!,"Ent er a comme nt for the ",RCBETYP E," Adjust ment:"
	5587	"RTN","RCB EADJ",129, 0)
	5588	S Y=$$EDI T433^RCBEU TRA(RCTRAN DA,"41;")
	5589	"RTN","RCB EADJ",130, 0)
	5590	;
	5591	"RTN","RCB EADJ",131, 0)
	5592	; ask to exempt in terest and admin cha rges
	5593	"RTN","RCB EADJ",132, 0)
	5594	I RCBETYP E="DECREAS E" D INTAD MIN(RCBILL DA)
	5595	"RTN","RCB EADJ",133, 0)
	5596	;
	5597	"RTN","RCB EADJ",134, 0)
	5598	; notifi cation of subsequent payer bul letin
	5599	"RTN","RCB EADJ",135, 0)
	5600	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7)),X=0
	5601	"RTN","RCB EADJ",136, 0)
	5602	F I=1:1:5 S X=X+$P( RCDATA7,"^ ",I)
	5603	"RTN","RCB EADJ",137, 0)
	5604	I RCDATA7 '="",'X D
	5605	"RTN","RCB EADJ",138, 0)
	5606	. N PRC ABN,PRCAEN ,PRCAMT
	5607	"RTN","RCB EADJ",139, 0)
	5608	. S PRC ABN=RCBILL DA,PRCAEN= RCTRANDA,P RCAMT=+$P( $G(^PRCA(4 33,RCTRAND A,1)),"^"
	5609	,5)
	5610	"RTN","RCB EADJ",140, 0)
	5611	. D EOB ^PRCADJ
	5612	"RTN","RCB EADJ",141, 0)
	5613	;
	5614	"RTN","RCB EADJ",142, 0)
	5615	; unlock and ask t he next bi ll to adju st
	5616	"RTN","RCB EADJ",143, 0)
	5617	D UNLOCK
	5618	"RTN","RCB EADJ",144, 0)
	5619	Q
	5620	"RTN","RCB EADJ",145, 0)
	5621	;
	5622	"RTN","RCB EADJ",146, 0)
	5623	;
	5624	"RTN","RCB EADJ",147, 0)
	5625	UNLOCK ; unlock bil l and tran saction
	5626	"RTN","RCB EADJ",148, 0)
	5627	L -^PRCA( 430,RCBILL DA)
	5628	"RTN","RCB EADJ",149, 0)
	5629	I $G(RCTR ANDA) L -^ PRCA(433,R CTRANDA)
	5630	"RTN","RCB EADJ",150, 0)
	5631	Q
	5632	"RTN","RCB EADJ",151, 0)
	5633	;
	5634	"RTN","RCB EADJ",152, 0)
	5635	;
	5636	"RTN","RCB EADJ",153, 0)
	5637	INTADMIN(R CBILLDA) ; ask and adjust the interest and admin
	5638	"RTN","RCB EADJ",154, 0)
	5639	N RCAMOUN T,RCTRANDA ,Y
	5640	"RTN","RCB EADJ",155, 0)
	5641	;
	5642	"RTN","RCB EADJ",156, 0)
	5643	; check to see if there is i nterest an d admin ch arges
	5644	"RTN","RCB EADJ",157, 0)
	5645	S RCAMOUN T=$G(^PRCA (430,RCBIL LDA,7))
	5646	"RTN","RCB EADJ",158, 0)
	5647	I '$P(RCA MOUNT,"^", 2),'$P(RCA MOUNT,"^", 3),'$P(RCA MOUNT,"^", 4),'$P(RCA MOUNT,"^"
	5648	,5) Q
	5649	"RTN","RCB EADJ",159, 0)
	5650	;
	5651	"RTN","RCB EADJ",160, 0)
	5652	; only a sk if ther e is no pr incipal
	5653	"RTN","RCB EADJ",161, 0)
	5654	I RCAMOUN T Q
	5655	"RTN","RCB EADJ",162, 0)
	5656	;
	5657	"RTN","RCB EADJ",163, 0)
	5658	W !!,"You have the option to automatica lly EXEMPT the inter est"
	5659	"RTN","RCB EADJ",164, 0)
	5660	W !,"and administra tive charg es. This will close the bill. "
	5661	"RTN","RCB EADJ",165, 0)
	5662	S Y=$$ASK EXEMP I Y' =1 Q
	5663	"RTN","RCB EADJ",166, 0)
	5664	;
	5665	"RTN","RCB EADJ",167, 0)
	5666	W !!,"Cre ating an E XEMPT tran saction .. ."
	5667	"RTN","RCB EADJ",168, 0)
	5668	S RCTRAND A=$$EXEMPT ^RCBEUTR2( RCBILLDA,$ P(RCAMOUNT ,"^",2)_"^ "_$P(RCAMO UNT,"^",3
	5669	)_"^^"_$P( RCAMOUNT," ^",4)_"^"_ $P(RCAMOUN T,"^",5))
	5670	"RTN","RCB EADJ",169, 0)
	5671	I 'RCTRAN DA W !," * W A R N I N G: E XEMPTION N OT Process ed! *" Q
	5672	"RTN","RCB EADJ",170, 0)
	5673	I RCTRAND A W !," Exempt Tra nsaction: ",RCTRANDA ," has bee n added."
	5674	"RTN","RCB EADJ",171, 0)
	5675	INTC35B ;C heck if CS 5B entry n eeded for exempt tra nsaction
	5676	"RTN","RCB EADJ",172, 0)
	5677	I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D
	5678	DECADJ^RC TCSPU(RCBI LLDA,RCTRA NDA) ;prca 4.5301 a dd cs exem pt
	5679	"RTN","RCB EADJ",173, 0)
	5680	I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD
	5681	^%DT W !!, " * * * * Transmis sion will be held un til "_Y_" * * * *"
	5682	"RTN","RCB EADJ",174, 0)
	5683	;
	5684	"RTN","RCB EADJ",175, 0)
	5685	W !," Cu rrent Bill Status: " ,$P($G(^PR CA(430.3,+ $P($G(^PRC A(430,RCBI LLDA,0)),
	5686	"^",8),0)) ,"^")
	5687	"RTN","RCB EADJ",176, 0)
	5688	Q
	5689	"RTN","RCB EADJ",177, 0)
	5690	;
	5691	"RTN","RCB EADJ",178, 0)
	5692	ASKOK(RCBE TYPE) ; a sk record decrease o r increase transacti on
	5693	"RTN","RCB EADJ",179, 0)
	5694	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5695	"RTN","RCB EADJ",180, 0)
	5696	S DIR(0)= "YO",DIR(" B")="YES"
	5697	"RTN","RCB EADJ",181, 0)
	5698	S DIR("A" )="Are you sure you want to en ter this " _RCBETYPE_ " adjustme nt "
	5699	"RTN","RCB EADJ",182, 0)
	5700	W ! D ^DI R
	5701	"RTN","RCB EADJ",183, 0)
	5702	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5703	"RTN","RCB EADJ",184, 0)
	5704	Q Y
	5705	"RTN","RCB EADJ",185, 0)
	5706	;
	5707	"RTN","RCB EADJ",186, 0)
	5708	ASKAUPO() ; ask rec ord even t hough mark ed for aut o post PRC A4.5298
	5709	"RTN","RCB EADJ",187, 0)
	5710	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5711	"RTN","RCB EADJ",188, 0)
	5712	S DIR(0)= "YOA",DIR( "B")="NO"
	5713	"RTN","RCB EADJ",189, 0)
	5714	S DIR("A" )="Marked for Auto-P ost. Are y ou sure? ( Y/N) "
	5715	"RTN","RCB EADJ",190, 0)
	5716	W ! D ^DI R
	5717	"RTN","RCB EADJ",191, 0)
	5718	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5719	"RTN","RCB EADJ",192, 0)
	5720	Q Y
	5721	"RTN","RCB EADJ",193, 0)
	5722	;
	5723	"RTN","RCB EADJ",194, 0)
	5724	ASKFIX() ; ask to f ix bill's balance
	5725	"RTN","RCB EADJ",195, 0)
	5726	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5727	"RTN","RCB EADJ",196, 0)
	5728	S DIR(0)= "YO",DIR(" B")="NO"
	5729	"RTN","RCB EADJ",197, 0)
	5730	S DIR("A" )=" Do yo u want to FIX the ba lance disc repancy "
	5731	"RTN","RCB EADJ",198, 0)
	5732	W ! D ^DI R
	5733	"RTN","RCB EADJ",199, 0)
	5734	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5735	"RTN","RCB EADJ",200, 0)
	5736	Q Y
	5737	"RTN","RCB EADJ",201, 0)
	5738	;
	5739	"RTN","RCB EADJ",202, 0)
	5740	;
	5741	"RTN","RCB EADJ",203, 0)
	5742	ASKEXEMP() ; ask to record an exempt tr ansaction
	5743	"RTN","RCB EADJ",204, 0)
	5744	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5745	"RTN","RCB EADJ",205, 0)
	5746	S DIR(0)= "YO",DIR(" B")="NO"
	5747	"RTN","RCB EADJ",206, 0)
	5748	S DIR("A" )=" Would you like to EXEMPT the intere st and adm in charges "
	5749	"RTN","RCB EADJ",207, 0)
	5750	D ^DIR
	5751	"RTN","RCB EADJ",208, 0)
	5752	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5753	"RTN","RCB EADJ",209, 0)
	5754	Q Y
	5755	"RTN","RCB EADJ",210, 0)
	5756	;
	5757	"RTN","RCB EADJ",211, 0)
	5758	;
	5759	"RTN","RCB EADJ",212, 0)
	5760	ASKCONT() ; ask if contract a djustment
	5761	"RTN","RCB EADJ",213, 0)
	5762	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5763	"RTN","RCB EADJ",214, 0)
	5764	S DIR(0)= "YO",DIR(" B")="YES"
	5765	"RTN","RCB EADJ",215, 0)
	5766	S DIR("A" )=" Is th is a CONTR ACT adjust ment "
	5767	"RTN","RCB EADJ",216, 0)
	5768	W ! D ^DI R
	5769	"RTN","RCB EADJ",217, 0)
	5770	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5771	"RTN","RCB EADJ",218, 0)
	5772	Q Y
	5773	"RTN","RCB EADJ",219, 0)
	5774	;
	5775	"RTN","RCB EADJ",220, 0)
	5776	ADJNUM(RCB ILLDA) ; get next a djustment number for a bill
	5777	"RTN","RCB EADJ",221, 0)
	5778	N %,ADJUS T,DATA1,RC TRANDA
	5779	"RTN","RCB EADJ",222, 0)
	5780	S RCTRAND A=0
	5781	"RTN","RCB EADJ",223, 0)
	5782	F S RCTR ANDA=$O(^P RCA(433,"C ",RCBILLDA ,RCTRANDA) ) Q:'RCTRA NDA S DAT A1=$G(^PR
	5783	CA(433,RCT RANDA,1)) I $P(DATA1 ,"^",4),$P (DATA1,"^" ,2)=1!($P( DATA1,"^", 2)=35) S
	5784	ADJUST=$P( DATA1,"^", 4)+1
	5785	"RTN","RCB EADJ",224, 0)
	5786	Q ADJUST
	5787	"RTN","RCB EADJ",225, 0)
	5788	;
	5789	"RTN","RCB EADJ",226, 0)
	5790	;
	5791	"RTN","RCB EADJ",227, 0)
	5792	AMOUNT(RCB ILLDA,RCBE TYPE) ; e nter the a djustment amount for a bill
	5793	"RTN","RCB EADJ",228, 0)
	5794	N DIR,DIR UT,DTOUT,D UOUT,PRINB AL,X,Y
	5795	"RTN","RCB EADJ",229, 0)
	5796	S PRINBAL =+$P($G(^P RCA(430,RC BILLDA,7)) ,"^")
	5797	"RTN","RCB EADJ",230, 0)
	5798	I RCBETYP E="INCREAS E" S PRINB AL=9999999 .99
	5799	"RTN","RCB EADJ",231, 0)
	5800	W !!,"Ent er the ",R CBETYPE," Adjustment AMOUNT, f rom .01 to ",$J(PRIN BAL,0,2),
	5801	"."
	5802	"RTN","RCB EADJ",232, 0)
	5803	S DIR(0)= "NAO^.01:" _PRINBAL_" :2"
	5804	"RTN","RCB EADJ",233, 0)
	5805	S DIR("A" )=" "_RCB ETYPE_" PR INCIPAL BA LANCE BY: "
	5806	"RTN","RCB EADJ",234, 0)
	5807	D ^DIR
	5808	"RTN","RCB EADJ",235, 0)
	5809	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5810	"RTN","RCB EADJ",236, 0)
	5811	Q $S(Y'=" ":Y,1:-1)
	5812	"RTN","RCB EADJ",237, 0)
	5813	;
	5814	"RTN","RCC PCAP")
	5815	0^21^B4318 9035^n/a
	5816	"RTN","RCC PCAP",1,0)
	5817	RCCPCAP ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT B UILD ; 2/3 /2016 11:3 0 am
	5818	"RTN","RCC PCAP",2,0)
	5819	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 124
	5820	"RTN","RCC PCAP",3,0)
	5821	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5822	"RTN","RCC PCAP",4,0)
	5823	EN(YEAR,SO URCE,DTTIM E) ; Bui ld the pay ment state ments for Year enter ed
	5824	"RTN","RCC PCAP",5,0)
	5825	; Year is the first three num bers of th e Internal Date form at and mus t be earl
	5826	ier than c urrent Yea r
	5827	"RTN","RCC PCAP",6,0)
	5828	; Source will be us ed to dete rmine whet her to sch edule or i mmediately start Tr
	5829	ansmit aft er Build
	5830	"RTN","RCC PCAP",7,0)
	5831	; DTTIME is the Tra nsmit date and time in Interna l time fro m Build an d Transmi
	5832	t menu opt ion
	5833	"RTN","RCC PCAP",8,0)
	5834	;
	5835	"RTN","RCC PCAP",9,0)
	5836	; Initial ize Incomi ng Variabl es - YEAR will be to Year befo re Current
	5837	"RTN","RCC PCAP",10,0 )
	5838	; Source will be to "B"ackgro und, and D TTIME to i ts current value, in cluding N
	5839	ULL
	5840	"RTN","RCC PCAP",11,0 )
	5841	I $G(YEAR )="" S YEA R=$E(DT,1, 3)-1
	5842	"RTN","RCC PCAP",12,0 )
	5843	I $G(SOUR CE)="" S S OURCE="B"
	5844	"RTN","RCC PCAP",13,0 )
	5845	S DTTIME= $G(DTTIME)
	5846	"RTN","RCC PCAP",14,0 )
	5847	;
	5848	"RTN","RCC PCAP",15,0 )
	5849	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5850	"RTN","RCC PCAP",16,0 )
	5851	L +^RCAP( 349.5):DIL OCKTM I '$ T D Q
	5852	"RTN","RCC PCAP",17,0 )
	5853	. S YEAR= 20_$E(YEAR ,2,3)
	5854	"RTN","RCC PCAP",18,0 )
	5855	. S ^TMP( $J,"MSG",1 ,0)="The B uild and T ransmit of the Annua l Payment File for
	5856	"_YEAR_" h as not com pleted."
	5857	"RTN","RCC PCAP",19,0 )
	5858	. D ERRMA IL^RCCPCAT
	5859	"RTN","RCC PCAP",20,0 )
	5860	;
	5861	"RTN","RCC PCAP",21,0 )
	5862	N %,%I,%H ,STARTDT,E NDDT,LINE, PSSEG,PSCN TR,EXIT,DE BTOR,END,N EXT,SIZE
	5863	"RTN","RCC PCAP",22,0 )
	5864	;
	5865	"RTN","RCC PCAP",23,0 )
	5866	; Remove previous e ntries fro m file pri or to buil ding new f ile
	5867	"RTN","RCC PCAP",24,0 )
	5868	K ^RCAP(3 49.5)
	5869	"RTN","RCC PCAP",25,0 )
	5870	S ^RCAP(3 49.5,0)="A R ANNUAL P AYMENT STA TEMENT^349 .5^^"
	5871	"RTN","RCC PCAP",26,0 )
	5872	;
	5873	"RTN","RCC PCAP",27,0 )
	5874	; Set Sta rt and End Dates
	5875	"RTN","RCC PCAP",28,0 )
	5876	S STARTDT =YEAR_"010 0"
	5877	"RTN","RCC PCAP",29,0 )
	5878	S ENDDT=Y EAR_1232
	5879	"RTN","RCC PCAP",30,0 )
	5880	S (DEBTOR ,END)=""
	5881	"RTN","RCC PCAP",31,0 )
	5882	F PSCNTR= 1:1 Q:END D
	5883	"RTN","RCC PCAP",32,0 )
	5884	. S (NEXT ,SIZE,LINE )=0
	5885	"RTN","RCC PCAP",33,0 )
	5886	. D SETPS (PSCNTR,YE AR)
	5887	"RTN","RCC PCAP",34,0 )
	5888	. N LASTP D
	5889	"RTN","RCC PCAP",35,0 )
	5890	. F S DE BTOR=$O(^P RCA(433,"A TD",DEBTOR )) Q:DEBTO R="" D I NEXT Q
	5891	"RTN","RCC PCAP",36,0 )
	5892	.. N SSN
	5893	"RTN","RCC PCAP",37,0 )
	5894	.. ; Quit if the de btor is no t a patien t
	5895	"RTN","RCC PCAP",38,0 )
	5896	.. I '$D( ^RCD(340," AB","DPT(" ,DEBTOR)) Q
	5897	"RTN","RCC PCAP",39,0 )
	5898	.. ; Quit if a test patient S SN contain s a "P" or is Null
	5899	"RTN","RCC PCAP",40,0 )
	5900	.. S SSN= $$SSN^RCFN 01(DEBTOR)
	5901	"RTN","RCC PCAP",41,0 )
	5902	.. I SSN[ "P"!(SSN=- 1) Q
	5903	"RTN","RCC PCAP",42,0 )
	5904	.. N PHSE T,PHCNTR,P HSEG,DATE, LTBDT
	5905	"RTN","RCC PCAP",43,0 )
	5906	.. S (PHS ET,PHCNTR, LTBDT)=0
	5907	"RTN","RCC PCAP",44,0 )
	5908	.. S DATE =STARTDT
	5909	"RTN","RCC PCAP",45,0 )
	5910	.. F S D ATE=$O(^PR CA(433,"AT D",DEBTOR, DATE)) Q:D ATE="" Q: DATE>ENDDT D
	5911	"RTN","RCC PCAP",46,0 )
	5912	... ; Rec heck and Q uit if the date is n ot within the Year
	5913	"RTN","RCC PCAP",47,0 )
	5914	... I DAT E<STARTDT! (DATE>ENDD T) Q
	5915	"RTN","RCC PCAP",48,0 )
	5916	... ; Set Final Dat e for this Debtor to determine final tra nsaction
	5917	"RTN","RCC PCAP",49,0 )
	5918	... N TRA NS
	5919	"RTN","RCC PCAP",50,0 )
	5920	... S TRA NS=""
	5921	"RTN","RCC PCAP",51,0 )
	5922	... F S TRANS=$O(^ PRCA(433," ATD",DEBTO R,DATE,TRA NS)) Q:TRA NS="" D
	5923	"RTN","RCC PCAP",52,0 )
	5924	.... ; Qu it if the Transactio n Type is not Paymen t in Part( 2) or Paym ent in Fu
	5925	ll(34)
	5926	"RTN","RCC PCAP",53,0 )
	5927	.... I $P (^PRCA(433 ,TRANS,1), U,2)'=2&($ P(^PRCA(43 3,TRANS,1) ,U,2)'=34) Q
	5928	"RTN","RCC PCAP",54,0 )
	5929	.... ; Se t PH Recor d if first time for this Debto r
	5930	"RTN","RCC PCAP",55,0 )
	5931	.... I 'P HSET D SET PH(DEBTOR, SSN,PSCNTR ) S PHSET= 1
	5932	"RTN","RCC PCAP",56,0 )
	5933	.... ; Se t PD Recor d for each Payment T ransaction
	5934	"RTN","RCC PCAP",57,0 )
	5935	.... D SE TPD(DEBTOR ,DATE,TRAN S,PSCNTR)
	5936	"RTN","RCC PCAP",58,0 )
	5937	.. ;
	5938	"RTN","RCC PCAP",59,0 )
	5939	.. ; Afte r completi ng each De btor, if t he Size is over 30K, set Next to create
	5940	a new PS Record,
	5941	"RTN","RCC PCAP",60,0 )
	5942	.. ; set Message De limiter at the end o f the PD r ecord, and set End D ate and T
	5943	ime
	5944	"RTN","RCC PCAP",61,0 )
	5945	.. I SIZE >30000 D
	5946	"RTN","RCC PCAP",62,0 )
	5947	... S ^RC AP(349.5,P SCNTR,1,LA STPD,0)=^R CAP(349.5, PSCNTR,1,L ASTPD,0)_" ~"
	5948	"RTN","RCC PCAP",63,0 )
	5949	... S NEX T=1
	5950	"RTN","RCC PCAP",64,0 )
	5951	... D NOW ^%DTC
	5952	"RTN","RCC PCAP",65,0 )
	5953	... S $P( ^RCAP(349. 5,PSCNTR,0 ),U,4)=%
	5954	"RTN","RCC PCAP",66,0 )
	5955	.. ;
	5956	"RTN","RCC PCAP",67,0 )
	5957	.. ; If t he last De btor in AT D has proc essed set End to sto p processi ng, if Ti
	5958	lde not fi nal
	5959	"RTN","RCC PCAP",68,0 )
	5960	.. ; char acter, set Tilde to Last PD re cord, and set End Da te and tim e
	5961	"RTN","RCC PCAP",69,0 )
	5962	. I DEBTO R="" D
	5963	"RTN","RCC PCAP",70,0 )
	5964	.. S END= 1
	5965	"RTN","RCC PCAP",71,0 )
	5966	.. I $G(L ASTPD)="" Q
	5967	"RTN","RCC PCAP",72,0 )
	5968	.. I $E(^ RCAP(349.5 ,PSCNTR,1, LASTPD,0), $L(^RCAP(3 49.5,PSCNT R,1,LASTPD ,0)))'="~
	5969	" S ^RCAP( 349.5,PSCN TR,1,LASTP D,0)=^RCAP (349.5,PSC NTR,1,LAST PD,0)_"~"
	5970	"RTN","RCC PCAP",73,0 )
	5971	.. D NOW^ %DTC
	5972	"RTN","RCC PCAP",74,0 )
	5973	.. S $P(^ RCAP(349.5 ,PSCNTR,0) ,U,4)=%
	5974	"RTN","RCC PCAP",75,0 )
	5975	;
	5976	"RTN","RCC PCAP",76,0 )
	5977	; PRCA4. 5313 - Un lock prior to transm ission
	5978	"RTN","RCC PCAP",77,0 )
	5979	L -^RCAP( 349.5):DIL OCKTM
	5980	"RTN","RCC PCAP",78,0 )
	5981	;
	5982	"RTN","RCC PCAP",79,0 )
	5983	; If the Source is Background (B) deter mine the d ate and ti me from th e schedul
	5984	e based up on site co de
	5985	"RTN","RCC PCAP",80,0 )
	5986	I SOURCE= "B" S DTTI ME=$$SCHED ^RCCPCAT($ $SITE^RCMS ITE)
	5987	"RTN","RCC PCAP",81,0 )
	5988	D EN^RCCP CAT(DTTIME )
	5989	"RTN","RCC PCAP",82,0 )
	5990	;
	5991	"RTN","RCC PCAP",83,0 )
	5992	Q
	5993	"RTN","RCC PCAP",84,0 )
	5994	;
	5995	"RTN","RCC PCAP",85,0 )
	5996	SETPS(PSCN TR,YEAR) ; Get and Set Data f or PS Reco rd into 34 9.5
	5997	"RTN","RCC PCAP",86,0 )
	5998	; Set Yea r and Buil d Start Da te and Tim e
	5999	"RTN","RCC PCAP",87,0 )
	6000	N PS,DR,D A,DIE,DIC, X,PRCAFDA
	6001	"RTN","RCC PCAP",88,0 )
	6002	S DIC="^R CAP(349.5, ",X=PSCNTR ,DA=.01,DI C(0)="" D FILE^DICN
	6003	"RTN","RCC PCAP",89,0 )
	6004	D NOW^%DT C
	6005	"RTN","RCC PCAP",90,0 )
	6006	S $P(^RCA P(349.5,PS CNTR,0),U, 2,3)=YEAR_ U_%
	6007	"RTN","RCC PCAP",91,0 )
	6008	; Increme nt Line nu mber
	6009	"RTN","RCC PCAP",92,0 )
	6010	S LINE=LI NE+1
	6011	"RTN","RCC PCAP",93,0 )
	6012	; Set PSS EG for thi s Segment to PS Coun ter
	6013	"RTN","RCC PCAP",94,0 )
	6014	S PSSEG(P SCNTR)=PSC NTR
	6015	"RTN","RCC PCAP",95,0 )
	6016	; Pieces 3 and 6 wi ll be upda ted during the creat ion of oth er PS and PH segmen
	6017	ts
	6018	"RTN","RCC PCAP",96,0 )
	6019	S PS="PS" _U_PSCNTR_ U_PSCNTR_U _$$SITE^RC MSITE_U_$$ FP^RCCPCFN _U_0_U_20_ $E(YEAR,2
	6020	,3)_U_$$DA T^RCCPCFN( DT)_U_"}"
	6021	"RTN","RCC PCAP",97,0 )
	6022	; Update File
	6023	"RTN","RCC PCAP",98,0 )
	6024	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P S
	6025	"RTN","RCC PCAP",99,0 )
	6026	D UPDATE^ DIE("","PR CAFDA","LI NE")
	6027	"RTN","RCC PCAP",100, 0)
	6028	; Add len gth to SIZ E
	6029	"RTN","RCC PCAP",101, 0)
	6030	S SIZE=SI ZE+$L(PS)
	6031	"RTN","RCC PCAP",102, 0)
	6032	; Update all previo us PS Segm ents piece 3 with cu rrent coun ter
	6033	"RTN","RCC PCAP",103, 0)
	6034	N I
	6035	"RTN","RCC PCAP",104, 0)
	6036	S I=0
	6037	"RTN","RCC PCAP",105, 0)
	6038	F S I=$O (PSSEG(I)) Q:I=PSCNT R S $P(^R CAP(349.5, I,1,1,0),U ,3)=PSCNTR
	6039	"RTN","RCC PCAP",106, 0)
	6040	;
	6041	"RTN","RCC PCAP",107, 0)
	6042	Q
	6043	"RTN","RCC PCAP",108, 0)
	6044	;
	6045	"RTN","RCC PCAP",109, 0)
	6046	SETPH(DEBT OR,SSN,PSC NTR) ; Ge t and Set Data for P H Record i nto 349.5
	6047	"RTN","RCC PCAP",110, 0)
	6048	N PH,SITE ,PATNAME,A DDRESS,I,A RFLAG,ARAD DR,COUNTRY ,DFN,ICN,D R,DA,DIE,P OSTCODE,P
	6049	RCAFDA
	6050	"RTN","RCC PCAP",111, 0)
	6051	; Increme nt Line nu mber
	6052	"RTN","RCC PCAP",112, 0)
	6053	S LINE=LI NE+1
	6054	"RTN","RCC PCAP",113, 0)
	6055	; Increme nt PH Coun ter
	6056	"RTN","RCC PCAP",114, 0)
	6057	S PHCNTR= PHCNTR+1
	6058	"RTN","RCC PCAP",115, 0)
	6059	; Set PHS EG for thi s Segment to Line
	6060	"RTN","RCC PCAP",116, 0)
	6061	S PHSEG(P HCNTR)=LIN E
	6062	"RTN","RCC PCAP",117, 0)
	6063	; Get DFN and ICN f or Debtor and Patien t - If the ICN retur ns a -1 in the firs
	6064	t piece
	6065	"RTN","RCC PCAP",118, 0)
	6066	; send a Null value as the IC N
	6067	"RTN","RCC PCAP",119, 0)
	6068	S DFN=+$P ($G(^RCD(3 40,DEBTOR, 0)),U)
	6069	"RTN","RCC PCAP",120, 0)
	6070	S ICN=$$G ETICN^MPIF 001(DFN)
	6071	"RTN","RCC PCAP",121, 0)
	6072	S ICN=$S( +ICN'=-1:I CN,1:"")
	6073	"RTN","RCC PCAP",122, 0)
	6074	; Get Acc ount Numbe r -- Sit e code and SSN
	6075	"RTN","RCC PCAP",123, 0)
	6076	S SITE=$$ SITE^RCMSI TE
	6077	"RTN","RCC PCAP",124, 0)
	6078	S PH="PH" _U_SITE_SS N
	6079	"RTN","RCC PCAP",125, 0)
	6080	; Get Pat ient Name
	6081	"RTN","RCC PCAP",126, 0)
	6082	S PATNAME =$$NAM^RCF N01(DEBTOR )
	6083	"RTN","RCC PCAP",127, 0)
	6084	S PH=PH_$ E($P(PATNA ME,","),1, 5)_U_$E($P (PATNAME," ,"),1,20)_ U_$E($P($P (PATNAME,
	6085	",",2)," " ),1,10)_U_ $E($P(PATN AME," ",2) ,1,10)
	6086	"RTN","RCC PCAP",128, 0)
	6087	; If Coun try is not '1' get C ountry Nam e and Post al Code
	6088	"RTN","RCC PCAP",129, 0)
	6089	S COUNTRY =$P($G(^DP T(+$P(^RCD (340,DEBTO R,0),U),.1 1)),U,10)
	6090	"RTN","RCC PCAP",130, 0)
	6091	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	6092	"RTN","RCC PCAP",131, 0)
	6093	; Get Add ress and A RFLAG
	6094	"RTN","RCC PCAP",132, 0)
	6095	S ADDRESS =$P($$DADD ^RCAMADD(D EBTOR,1),U ,1,6)
	6096	"RTN","RCC PCAP",133, 0)
	6097	F I=1:1:4 S $P(ADDR ESS,U,I)=$ E($P(ADDRE SS,U,I),1, 40)
	6098	"RTN","RCC PCAP",134, 0)
	6099	; If the Country is Null the State and Zip Code w ill be use d
	6100	"RTN","RCC PCAP",135, 0)
	6101	; If the Country is Not Null, the State will be F X and the
	6102	"RTN","RCC PCAP",136, 0)
	6103	; Zip Cod e will be Null
	6104	"RTN","RCC PCAP",137, 0)
	6105	S $P(ADDR ESS,U,5)=$ S(COUNTRY= "":$E($P(A DDRESS,U,5 ),1,2),1:" FX")
	6106	"RTN","RCC PCAP",138, 0)
	6107	S $P(ADDR ESS,U,6)=$ S(COUNTRY= "":$E($P(A DDRESS,U,6 ),1,9),1:" ")
	6108	"RTN","RCC PCAP",139, 0)
	6109	S PH=PH_U _ADDRESS
	6110	"RTN","RCC PCAP",140, 0)
	6111	S ARFLAG= "N"
	6112	"RTN","RCC PCAP",141, 0)
	6113	S ARADDR= $P($G(^RCD (340,DEBTO R,1)),U,1, 6)
	6114	"RTN","RCC PCAP",142, 0)
	6115	I ($P(ARA DDR,U)'="" ),($P(ARAD DR,U,4)'=" "),($P(ARA DDR,U,5)'= ""),(($P(A RADDR,U,6
	6116	)'="")) S ARFLAG="Y"
	6117	"RTN","RCC PCAP",143, 0)
	6118	S PH=PH_U _$E(COUNTR Y,1,11)
	6119	"RTN","RCC PCAP",144, 0)
	6120	; Set DFN and ICN f or Debtor and Patien t with Nul l space fo r Total Am ount Rece
	6121	ived
	6122	"RTN","RCC PCAP",145, 0)
	6123	S PH=PH_U _U_SITE_DF N_U_ICN
	6124	"RTN","RCC PCAP",146, 0)
	6125	; Set ARF LAG from a bove
	6126	"RTN","RCC PCAP",147, 0)
	6127	S PH=PH_U _ARFLAG
	6128	"RTN","RCC PCAP",148, 0)
	6129	; Set Nul l spaces f or Last Bi ll Prepare d Date for Debtor an d Number o f PD Segm
	6130	ents
	6131	"RTN","RCC PCAP",149, 0)
	6132	; and the n Record D elimiter
	6133	"RTN","RCC PCAP",150, 0)
	6134	S PH=PH_U _U_U_"}"
	6135	"RTN","RCC PCAP",151, 0)
	6136	; Update file
	6137	"RTN","RCC PCAP",152, 0)
	6138	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P H
	6139	"RTN","RCC PCAP",153, 0)
	6140	D UPDATE^ DIE("","PR CAFDA","LI NE")
	6141	"RTN","RCC PCAP",154, 0)
	6142	; Add len gth to SIZ E
	6143	"RTN","RCC PCAP",155, 0)
	6144	S SIZE=SI ZE+$L(PH)
	6145	"RTN","RCC PCAP",156, 0)
	6146	; Increme nt PS segm ent piece 6 with ano ther PH re cord
	6147	"RTN","RCC PCAP",157, 0)
	6148	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)
	6149	,U,6)+1
	6150	"RTN","RCC PCAP",158, 0)
	6151	Q
	6152	"RTN","RCC PCAP",159, 0)
	6153	;
	6154	"RTN","RCC PCAP",160, 0)
	6155	SETPD(DEBT OR,DATE,TR ANS,PSCNTR ) ; Get a nd Set Dat a for PD R ecord into 349.5
	6156	"RTN","RCC PCAP",161, 0)
	6157	N DR,DA,D IE,PD,AMT, PHTOT,BILL ,CURBDT,PR CAFDA
	6158	"RTN","RCC PCAP",162, 0)
	6159	; Get Tra nsaction A mount - Qu it if Amou nt is zero or null
	6160	"RTN","RCC PCAP",163, 0)
	6161	S AMT=$P( $G(^PRCA(4 33,TRANS,1 )),U,5)
	6162	"RTN","RCC PCAP",164, 0)
	6163	I 'AMT Q
	6164	"RTN","RCC PCAP",165, 0)
	6165	; Format Amount
	6166	"RTN","RCC PCAP",166, 0)
	6167	S AMT=$TR ($J(AMT,9, 2)," ","")
	6168	"RTN","RCC PCAP",167, 0)
	6169	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	6170	"RTN","RCC PCAP",168, 0)
	6171	;
	6172	"RTN","RCC PCAP",169, 0)
	6173	S LINE=LI NE+1
	6174	"RTN","RCC PCAP",170, 0)
	6175	S LASTPD= LINE
	6176	"RTN","RCC PCAP",171, 0)
	6177	; Format and Set Da te Entered , Amount, and Delimi ter
	6178	"RTN","RCC PCAP",172, 0)
	6179	S PD="PD" _U_$$DAT^R CCPCFN(DAT E)_U_AMT_U _"}"
	6180	"RTN","RCC PCAP",173, 0)
	6181	;
	6182	"RTN","RCC PCAP",174, 0)
	6183	; Add len gth to SIZ E
	6184	"RTN","RCC PCAP",175, 0)
	6185	S SIZE=SI ZE+$L(PD)
	6186	"RTN","RCC PCAP",176, 0)
	6187	;
	6188	"RTN","RCC PCAP",177, 0)
	6189	; Update file
	6190	"RTN","RCC PCAP",178, 0)
	6191	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P D
	6192	"RTN","RCC PCAP",179, 0)
	6193	D UPDATE^ DIE("","PR CAFDA","LI NE")
	6194	"RTN","RCC PCAP",180, 0)
	6195	;
	6196	"RTN","RCC PCAP",181, 0)
	6197	; Get cur rent PH To tal, add A mount, the n reset to PH Segmen t
	6198	"RTN","RCC PCAP",182, 0)
	6199	S PHTOT=$ P(^RCAP(34 9.5,PSSEG( PSCNTR),1, PHSEG(PHCN TR),0),U,1 3)
	6200	"RTN","RCC PCAP",183, 0)
	6201	S PHTOT=P HTOT+AMT
	6202	"RTN","RCC PCAP",184, 0)
	6203	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,PHSEG( PHCNTR),0) ,U,13)=PHT OT
	6204	"RTN","RCC PCAP",185, 0)
	6205	;
	6206	"RTN","RCC PCAP",186, 0)
	6207	; Determi ne the Cur rent Bill Date and i f greater than LTBDT , Latest B ill Date,
	6208
	6209	"RTN","RCC PCAP",187, 0)
	6210	; set to PH Segment and LTBDT
	6211	"RTN","RCC PCAP",188, 0)
	6212	S BILL=$P ($G(^PRCA( 433,TRANS, 0)),U,2)
	6213	"RTN","RCC PCAP",189, 0)
	6214	S CURBDT= $P($G(^PRC A(430,BILL ,0)),U,10)
	6215	"RTN","RCC PCAP",190, 0)
	6216	I CURBDT> LTBDT S $P (^RCAP(349 .5,PSSEG(P SCNTR),1,P HSEG(PHCNT R),0),U,17 )=$$DAT^R
	6217	CCPCFN(CUR BDT),LTBDT =CURBDT
	6218	"RTN","RCC PCAP",191, 0)
	6219	;
	6220	"RTN","RCC PCAP",192, 0)
	6221	; Increme nt PH segm ent piece 18 with an other PD r ecord
	6222	"RTN","RCC PCAP",193, 0)
	6223	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,PHSEG( PHCNTR),0) ,U,18)=$P( ^RCAP(349. 5,PSSEG(P
	6224	SCNTR),1,P HSEG(PHCNT R),0),U,18 )+1
	6225	"RTN","RCC PCAP",194, 0)
	6226	Q
	6227	"RTN","RCC PCAP",195, 0)
	6228	;
	6229	"RTN","RCC PCAR")
	6230	0^23^B4789 4432^n/a
	6231	"RTN","RCC PCAR",1,0)
	6232	RCCPCAR ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT R EPORT ; 2/ 3/2016 11: 30 am
	6233	"RTN","RCC PCAR",2,0)
	6234	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 124
	6235	"RTN","RCC PCAR",3,0)
	6236	;;Per VA Directive 6402, this routine s hould not be modifie d.
	6237	"RTN","RCC PCAR",4,0)
	6238	EN(YEAR) ; Report errors for the payme nt stateme nts for Ye ar entered
	6239	"RTN","RCC PCAR",5,0)
	6240	; Year is the first three num bers of th e Internal Date form at
	6241	"RTN","RCC PCAR",6,0)
	6242	;
	6243	"RTN","RCC PCAR",7,0)
	6244	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6245	"RTN","RCC PCAR",8,0)
	6246	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	6247	"RTN","RCC PCAR",9,0)
	6248	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	6249	"RTN","RCC PCAR",10,0 )
	6250	. W !,"Tr y again la ter."
	6251	"RTN","RCC PCAR",11,0 )
	6252	;
	6253	"RTN","RCC PCAR",12,0 )
	6254	K ^TMP($J ,"MSG")
	6255	"RTN","RCC PCAR",13,0 )
	6256	N STARTDT ,ENDDT,LIN E,DEBTOR,P ATSSN
	6257	"RTN","RCC PCAR",14,0 )
	6258	;
	6259	"RTN","RCC PCAR",15,0 )
	6260	; Initial ize YEAR t o current year if Nu ll
	6261	"RTN","RCC PCAR",16,0 )
	6262	I $G(YEAR )="" S YEA R=$E(DT,1, 3)
	6263	"RTN","RCC PCAR",17,0 )
	6264	;
	6265	"RTN","RCC PCAR",18,0 )
	6266	; Set Sta rt and End Dates
	6267	"RTN","RCC PCAR",19,0 )
	6268	S STARTDT =YEAR_"010 0"
	6269	"RTN","RCC PCAR",20,0 )
	6270	S ENDDT=Y EAR_1232
	6271	"RTN","RCC PCAR",21,0 )
	6272	S LINE=0
	6273	"RTN","RCC PCAR",22,0 )
	6274	S DEBTOR= ""
	6275	"RTN","RCC PCAR",23,0 )
	6276	F S DEBT OR=$O(^PRC A(433,"ATD ",DEBTOR)) Q:DEBTOR= "" D
	6277	"RTN","RCC PCAR",24,0 )
	6278	. ; Quit if the deb tor is not a patient
	6279	"RTN","RCC PCAR",25,0 )
	6280	. I '$D(^ RCD(340,"A B","DPT(", DEBTOR)) Q
	6281	"RTN","RCC PCAR",26,0 )
	6282	. N DATE, PATERROR,P HSET
	6283	"RTN","RCC PCAR",27,0 )
	6284	. S (PHSE T,PATERROR )=0
	6285	"RTN","RCC PCAR",28,0 )
	6286	. S DATE= STARTDT
	6287	"RTN","RCC PCAR",29,0 )
	6288	. F S DA TE=$O(^PRC A(433,"ATD ",DEBTOR,D ATE)) Q:DA TE="" Q:D ATE>ENDDT D
	6289	"RTN","RCC PCAR",30,0 )
	6290	.. ; Rech eck and Qu it if the date is no t within t he Year
	6291	"RTN","RCC PCAR",31,0 )
	6292	.. I DATE <STARTDT!( DATE>ENDDT ) Q
	6293	"RTN","RCC PCAR",32,0 )
	6294	.. ; Set Final Date for this Debtor to determine final tran saction
	6295	"RTN","RCC PCAR",33,0 )
	6296	.. N TRAN S
	6297	"RTN","RCC PCAR",34,0 )
	6298	.. S TRAN S=""
	6299	"RTN","RCC PCAR",35,0 )
	6300	.. F S T RANS=$O(^P RCA(433,"A TD",DEBTOR ,DATE,TRAN S)) Q:TRAN S="" D
	6301	"RTN","RCC PCAR",36,0 )
	6302	... ; Qui t if the T ransaction Type is n ot Payment in Part(2 ) or Payme nt in Ful
	6303	l(34)
	6304	"RTN","RCC PCAR",37,0 )
	6305	... I $P( ^PRCA(433, TRANS,1),U ,2)'=2&($P (^PRCA(433 ,TRANS,1), U,2)'=34) Q
	6306	"RTN","RCC PCAR",38,0 )
	6307	... ; Che ck PH Reco rd if firs t time for this Debt or
	6308	"RTN","RCC PCAR",39,0 )
	6309	... I 'PH SET D CHEC KPH(DEBTOR ) S PHSET= 1
	6310	"RTN","RCC PCAR",40,0 )
	6311	... ; Che ck PD Reco rd for eac h Payment Transactio n
	6312	"RTN","RCC PCAR",41,0 )
	6313	... D CHE CKPD(DEBTO R,DATE,TRA NS)
	6314	"RTN","RCC PCAR",42,0 )
	6315	;
	6316	"RTN","RCC PCAR",43,0 )
	6317	; If ther e are any errors Sen d MailMan Message wi th Errors in ^TMP($J ,"MSG")
	6318	"RTN","RCC PCAR",44,0 )
	6319	I $D(^TMP ($J,"MSG") ) D TRANSM IT
	6320	"RTN","RCC PCAR",45,0 )
	6321	; If ther e are no e rrors Send MailMan M essage wit h No Error s Line
	6322	"RTN","RCC PCAR",46,0 )
	6323	I '$D(^TM P($J,"MSG" )) D
	6324	"RTN","RCC PCAR",47,0 )
	6325	. S ^TMP( $J,"MSG",1 ,0)="No an nual patie nt payment data inco nsistencie s found."
	6326	"RTN","RCC PCAR",48,0 )
	6327	. D TRANS MIT
	6328	"RTN","RCC PCAR",49,0 )
	6329	;
	6330	"RTN","RCC PCAR",50,0 )
	6331	K ^TMP($J ,"MSG")
	6332	"RTN","RCC PCAR",51,0 )
	6333	; PRCA4. 5313 - Un lock follo wing trans mission
	6334	"RTN","RCC PCAR",52,0 )
	6335	L -^TMP($ J,"MSG"):D ILOCKTM
	6336	"RTN","RCC PCAR",53,0 )
	6337	Q
	6338	"RTN","RCC PCAR",54,0 )
	6339	;
	6340	"RTN","RCC PCAR",55,0 )
	6341	CHECKPH(DE BTOR) ; C heck Data for PH Rec ord
	6342	"RTN","RCC PCAR",56,0 )
	6343	N SSN,PAT NAME,I,ARA DDR,ADDRER ,DFN,ICN,B ILLDATE,CO UNTRY,ST
	6344	"RTN","RCC PCAR",57,0 )
	6345	;
	6346	"RTN","RCC PCAR",58,0 )
	6347	; Get and Check DFN for Debto r. If DFN is Null o r does not start wit h a numbe
	6348	r
	6349	"RTN","RCC PCAR",59,0 )
	6350	; write E rror with Debtor Num ber and th en Quit, a s other da ta is depe ndent upo
	6351	n DFN
	6352	"RTN","RCC PCAR",60,0 )
	6353	S DFN=+$P (^RCD(340, DEBTOR,0), U)
	6354	"RTN","RCC PCAR",61,0 )
	6355	I 'DFN D SETERROR(" Debtor Num ber: "_DEB TOR,"Missi ng DFN") Q
	6356	"RTN","RCC PCAR",62,0 )
	6357	;
	6358	"RTN","RCC PCAR",63,0 )
	6359	; Get Pat ient Name and SSN
	6360	"RTN","RCC PCAR",64,0 )
	6361	S PATNAME =$$NAM^RCF N01(DEBTOR )
	6362	"RTN","RCC PCAR",65,0 )
	6363	S SSN=$$S SN^RCFN01( DEBTOR)
	6364	"RTN","RCC PCAR",66,0 )
	6365	S PATSSN= PATNAME_" LAST-4: " _$E(SSN,6, 9)
	6366	"RTN","RCC PCAR",67,0 )
	6367	;
	6368	"RTN","RCC PCAR",68,0 )
	6369	; Get and Check DFN and ICN f or Debtor and Patien t
	6370	"RTN","RCC PCAR",69,0 )
	6371	I $L(DFN) >8 D SETER ROR(PATSSN ,"Invalid DFN")
	6372	"RTN","RCC PCAR",70,0 )
	6373	S ICN=$$G ETICN^MPIF 001(DFN)
	6374	"RTN","RCC PCAR",71,0 )
	6375	I +ICN=-1 !($L(ICN)> 17) D SETE RROR(PATSS N,"Missing or Invali d ICN")
	6376	"RTN","RCC PCAR",72,0 )
	6377	;
	6378	"RTN","RCC PCAR",73,0 )
	6379	; Check P atient Nam e and SSN
	6380	"RTN","RCC PCAR",74,0 )
	6381	I SSN=""! (SSN'?9N) D SETERROR (PATSSN,"M issing or Invalid SS N")
	6382	"RTN","RCC PCAR",75,0 )
	6383	I $P(PATN AME,",")=" " D SETERR OR(PATSSN, "Missing o r Invalid Last Name" )
	6384	"RTN","RCC PCAR",76,0 )
	6385	I $P($P(P ATNAME,"," ,2)," ")=" " D SETERR OR(PATSSN, "Missing o r Invalid First Nam
	6386	e")
	6387	"RTN","RCC PCAR",77,0 )
	6388	;
	6389	"RTN","RCC PCAR",78,0 )
	6390	; Get and Check Add ress
	6391	"RTN","RCC PCAR",79,0 )
	6392	S ARADDR= $P($$DADD^ RCAMADD(DE BTOR,1),U, 1,6)
	6393	"RTN","RCC PCAR",80,0 )
	6394	F I=1,4 I $P(ARADDR ,U,I)=""!( $L($P(ARAD DR,U,I))>4 0!('$L($TR ($P(ARADDR ,U,I)," "
	6395	,"")))) D
	6396	"RTN","RCC PCAR",81,0 )
	6397	. S ADDRE R(I)=$S(I= 1:"Address Line 1",I =4:"City")
	6398	"RTN","RCC PCAR",82,0 )
	6399	. D SETER ROR(PATSSN ,"Missing or Invalid "_ADDRER( I))
	6400	"RTN","RCC PCAR",83,0 )
	6401	N ADDRER
	6402	"RTN","RCC PCAR",84,0 )
	6403	F I=2,3 I $L($P(ARA DDR,U,I))> 40 D
	6404	"RTN","RCC PCAR",85,0 )
	6405	. S ADDRE R(I)=$S(I= 2:"Address Line 2",I =3:"Addres s Line 3")
	6406	"RTN","RCC PCAR",86,0 )
	6407	. D SETER ROR(PATSSN ,"Invalid "_ADDRER(I ))
	6408	"RTN","RCC PCAR",87,0 )
	6409	;
	6410	"RTN","RCC PCAR",88,0 )
	6411	; If the Zip Code i s Null fro m DADD^RCM ADD set Pi ece 6 of A RADDR to P iece 6 of
	6412	.11
	6413	"RTN","RCC PCAR",89,0 )
	6414	I $P(ARAD DR,U,6)="" S $P(ARAD DR,U,6)=$P ($G(^DPT(D FN,.11)),U ,6)
	6415	"RTN","RCC PCAR",90,0 )
	6416	;
	6417	"RTN","RCC PCAR",91,0 )
	6418	; If Coun try is not '1' get C ountry Nam e for use in validat ing the St ate and Z
	6419	ip Code
	6420	"RTN","RCC PCAR",92,0 )
	6421	S COUNTRY =$P($G(^DP T(DFN,.11) ),U,10)
	6422	"RTN","RCC PCAR",93,0 )
	6423	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	6424	"RTN","RCC PCAR",94,0 )
	6425	; State h as three E rror condi tions
	6426	"RTN","RCC PCAR",95,0 )
	6427	; If the State is N ot Null an d is not 2 character s
	6428	"RTN","RCC PCAR",96,0 )
	6429	; If the State is N ot Null an d is not a Valid US State
	6430	"RTN","RCC PCAR",97,0 )
	6431	; If the State is N ot Null an d the Coun try is Not Null
	6432	"RTN","RCC PCAR",98,0 )
	6433	; If the State is N ull and th e Country is Null
	6434	"RTN","RCC PCAR",99,0 )
	6435	I $P(ARAD DR,U,5)'=" ",$L($P(AR ADDR,U,5)) '=2 D SETE RROR(PATSS N,"Missing or Inval
	6436	id State")
	6437	"RTN","RCC PCAR",100, 0)
	6438	S ST=""
	6439	"RTN","RCC PCAR",101, 0)
	6440	I $P(ARAD DR,U,5)'=" " S ST=$O( ^DIC(5,"C" ,$P(ARADDR ,U,5),""))
	6441	"RTN","RCC PCAR",102, 0)
	6442	I $P(ARAD DR,U,5)'=" ",ST="" D SETERROR(P ATSSN,"Mis sing or In valid Stat e")
	6443	"RTN","RCC PCAR",103, 0)
	6444	I $P(ARAD DR,U,5)'=" ",ST'="",$ P(^DIC(5,S T,0),U,6)' =1 D SETER ROR(PATSSN ,"Missing
	6445	or Invali d State")
	6446	"RTN","RCC PCAR",104, 0)
	6447	I $P(ARAD DR,U,5)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid State
	6448	")
	6449	"RTN","RCC PCAR",105, 0)
	6450	I $P(ARAD DR,U,5)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d State")
	6451	"RTN","RCC PCAR",106, 0)
	6452	; Zip Cod e has thre e Error co nditions
	6453	"RTN","RCC PCAR",107, 0)
	6454	; If the Zip Code i s Not Null and is no t 5 to 9 N umerics
	6455	"RTN","RCC PCAR",108, 0)
	6456	; If the Zip Code i s Not Null and the C ountry is Not Null
	6457	"RTN","RCC PCAR",109, 0)
	6458	; If the Zip Code i s Null and the Count ry is Null
	6459	"RTN","RCC PCAR",110, 0)
	6460	I $P(ARAD DR,U,6)'=" "&($P(ARAD DR,U,6)'?5 .9N) D SET ERROR(PATS SN,"Missin g or Inva
	6461	lid Zip Co de")
	6462	"RTN","RCC PCAR",111, 0)
	6463	I $P(ARAD DR,U,6)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid Zip C
	6464	ode")
	6465	"RTN","RCC PCAR",112, 0)
	6466	I $P(ARAD DR,U,6)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d Zip Cod
	6467	e")
	6468	"RTN","RCC PCAR",113, 0)
	6469	Q
	6470	"RTN","RCC PCAR",114, 0)
	6471	;
	6472	"RTN","RCC PCAR",115, 0)
	6473	CHECKPD(DE BTOR,DATE, TRANS) ; Get and Se t Data for PD Record into 349. 5
	6474	"RTN","RCC PCAR",116, 0)
	6475	N AMT
	6476	"RTN","RCC PCAR",117, 0)
	6477	; Get and Check Tra nsaction A mount
	6478	"RTN","RCC PCAR",118, 0)
	6479	S AMT=$P( ^PRCA(433, TRANS,1),U ,5)
	6480	"RTN","RCC PCAR",119, 0)
	6481	; Format Amount
	6482	"RTN","RCC PCAR",120, 0)
	6483	S AMT=$TR ($J(AMT,9, 2)," ","")
	6484	"RTN","RCC PCAR",121, 0)
	6485	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	6486	"RTN","RCC PCAR",122, 0)
	6487	I 'AMT!($ L(AMT)>10) D SETERRO R(PATSSN," Amount in Transactio n "_TRANS_ " Invalid
	6488	")
	6489	"RTN","RCC PCAR",123, 0)
	6490	;
	6491	"RTN","RCC PCAR",124, 0)
	6492	; Get and Check Tra nsaction D ate
	6493	"RTN","RCC PCAR",125, 0)
	6494	I $P(DATE ,".")'?7N. N D SETERR OR(PATSSN, "Date for Transactio n "_TRANS_ " Invalid
	6495	")
	6496	"RTN","RCC PCAR",126, 0)
	6497	Q
	6498	"RTN","RCC PCAR",127, 0)
	6499	;
	6500	"RTN","RCC PCAR",128, 0)
	6501	SETERROR(P ATSSN,ERRO R) ; Set the error into TMP($ J,"MSG",LI NE,0) for transmiss
	6502	ion
	6503	"RTN","RCC PCAR",129, 0)
	6504	; If the first time thru for this patie nt set the Name and SSN in mes sage
	6505	"RTN","RCC PCAR",130, 0)
	6506	; with a blank line above the Patient D ata for sp acing
	6507	"RTN","RCC PCAR",131, 0)
	6508	I 'PATERR OR D
	6509	"RTN","RCC PCAR",132, 0)
	6510	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=" "
	6511	"RTN","RCC PCAR",133, 0)
	6512	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=P ATSSN
	6513	"RTN","RCC PCAR",134, 0)
	6514	. S PATER ROR=1
	6515	"RTN","RCC PCAR",135, 0)
	6516	; Write E rror to ne xt line wi th a doubl e space in front
	6517	"RTN","RCC PCAR",136, 0)
	6518	S LINE=LI NE+1 S ^TM P($J,"MSG" ,LINE,0)=" "_ERROR
	6519	"RTN","RCC PCAR",137, 0)
	6520	Q
	6521	"RTN","RCC PCAR",138, 0)
	6522	;
	6523	"RTN","RCC PCAR",139, 0)
	6524	TRANSMIT ; set up and send mail message - copied fr om RCCPCML
	6525	"RTN","RCC PCAR",140, 0)
	6526	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY
	6527	"RTN","RCC PCAR",141, 0)
	6528	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT ERROR R EPORT "_20 _$E(YEAR,2 ,3)_" TO
	6529	CURRENT DA TE"
	6530	"RTN","RCC PCAR",142, 0)
	6531	S XMDUZ=" AR PACKAGE "
	6532	"RTN","RCC PCAR",143, 0)
	6533	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	6534	CCPC STATE MENTS")=""
	6535	"RTN","RCC PCAR",144, 0)
	6536	S XMDUZ=" AR PACKAGE "
	6537	"RTN","RCC PCAR",145, 0)
	6538	D XMZ^XMA 2
	6539	"RTN","RCC PCAR",146, 0)
	6540	I XMZ<1 S RTY=RTY+1 G TRANSMI T:RTY<4 S ERROR=5,NM =0 D ERROR Q
	6541	"RTN","RCC PCAR",147, 0)
	6542	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
	6543	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	6544	"RTN","RCC PCAR",148, 0)
	6545	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	6546	"RTN","RCC PCAR",149, 0)
	6547	D ENT1^XM D
	6548	"RTN","RCC PCAR",150, 0)
	6549	D NOW^%DT C
	6550	"RTN","RCC PCAR",151, 0)
	6551	Q
	6552	"RTN","RCC PCAR",152, 0)
	6553	;
	6554	"RTN","RCC PCAR",153, 0)
	6555	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	6556	"RTN","RCC PCAR",154, 0)
	6557	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	6558	"RTN","RCC PCAR",155, 0)
	6559	Q
	6560	"RTN","RCC PCAR",156, 0)
	6561	;
	6562	"RTN","RCC PCAR",157, 0)
	6563	MANBLD ; Build and Transmit t he Annual Payment St atement Co nsistency Checker
	6564	"RTN","RCC PCAR",158, 0)
	6565	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6566	"RTN","RCC PCAR",159, 0)
	6567	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	6568	"RTN","RCC PCAR",160, 0)
	6569	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	6570	"RTN","RCC PCAR",161, 0)
	6571	. W !,"Tr y again la ter."
	6572	"RTN","RCC PCAR",162, 0)
	6573	; PRCA4. 5313 - Un lock prior to prepar ing and tr ansmitting
	6574	"RTN","RCC PCAR",163, 0)
	6575	L -^TMP($ J,"MSG"):D ILOCKTM
	6576	"RTN","RCC PCAR",164, 0)
	6577	;
	6578	"RTN","RCC PCAR",165, 0)
	6579	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T,%,%H
	6580	"RTN","RCC PCAR",166, 0)
	6581	S YEAR=20 _$E(DT,2,3 )
	6582	"RTN","RCC PCAR",167, 0)
	6583	S DIR(0)= "YAO"
	6584	"RTN","RCC PCAR",168, 0)
	6585	S DIR("B" )="N"
	6586	"RTN","RCC PCAR",169, 0)
	6587	S DIR("A" )="Do you want to Ru n and Tran smit the C onsistency Checker f or "_YEAR
	6588	_" to the current da te? "
	6589	"RTN","RCC PCAR",170, 0)
	6590	S DIR("?? ")="^D MAN HLP^RCCPCA R"
	6591	"RTN","RCC PCAR",171, 0)
	6592	D ^DIR
	6593	"RTN","RCC PCAR",172, 0)
	6594	I $E(X)'= "Y" Q
	6595	"RTN","RCC PCAR",173, 0)
	6596	S ZTIO="" ,ZTRTN="EN ^RCCPCAR(" _$E(DT,1,3 )_")"
	6597	"RTN","RCC PCAR",174, 0)
	6598	S ZTDESC= "Annual Pa yment Stat ement File Consisten cy Checker "
	6599	"RTN","RCC PCAR",175, 0)
	6600	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	6601	"RTN","RCC PCAR",176, 0)
	6602	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6603	"RTN","RCC PCAR",177, 0)
	6604	Q
	6605	"RTN","RCC PCAR",178, 0)
	6606	;
	6607	"RTN","RCC PCAR",179, 0)
	6608	MANHLP ; "??" Help for MANBLD
	6609	"RTN","RCC PCAR",180, 0)
	6610	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Run and Transmit t he Consist ency Chec
	6611	ker."
	6612	"RTN","RCC PCAR",181, 0)
	6613	Q
	6614	"RTN","RCC PCAT")
	6615	0^22^B5227 0242^n/a
	6616	"RTN","RCC PCAT",1,0)
	6617	RCCPCAT ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT T RANSMIT ; 2/3/2016 1 1:30 am
	6618	"RTN","RCC PCAT",2,0)
	6619	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 124
	6620	"RTN","RCC PCAT",3,0)
	6621	;;Per VA Directive 6402, this routine s hould not be modifie d.
	6622	"RTN","RCC PCAT",4,0)
	6623	EN(DTTIME) ;Schedul e the Tran smit
	6624	"RTN","RCC PCAT",5,0)
	6625	N ZTDESC, ZTASK,ZTDT H,ZTIO,ZTR TN
	6626	"RTN","RCC PCAT",6,0)
	6627	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	6628	"RTN","RCC PCAT",7,0)
	6629	S ZTDESC= "ANNUAL PA YMENT STAT EMENT TRAN SMISSION"
	6630	"RTN","RCC PCAT",8,0)
	6631	; Initial ize Transm it date an d time
	6632	"RTN","RCC PCAT",9,0)
	6633	I DTTIME= "" S DTTIM E=%H
	6634	"RTN","RCC PCAT",10,0 )
	6635	S ZTDTH=D TTIME
	6636	"RTN","RCC PCAT",11,0 )
	6637	D ^%ZTLOA D Q:$G(ZTS K)=""
	6638	"RTN","RCC PCAT",12,0 )
	6639	Q
	6640	"RTN","RCC PCAT",13,0 )
	6641	;
	6642	"RTN","RCC PCAT",14,0 )
	6643	TRANSMIT ; Send Ann ual Paymen t Statemen t Files to AITC from RCAP(349. 5
	6644	"RTN","RCC PCAT",15,0 )
	6645	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6646	"RTN","RCC PCAT",16,0 )
	6647	L +^RCAP( 349.5):DIL OCKTM I '$ T D Q
	6648	"RTN","RCC PCAT",17,0 )
	6649	. N YEAR
	6650	"RTN","RCC PCAT",18,0 )
	6651	. S YEAR= 20_$E($P(^ RCAP(349.5 ,1,0),U,2) ,2,3)
	6652	"RTN","RCC PCAT",19,0 )
	6653	. S ^TMP( $J,"MSG",1 ,0)="The T ransmit of the Annua l Payment File for " _YEAR_" h
	6654	as not com pleted."
	6655	"RTN","RCC PCAT",20,0 )
	6656	. D ERRMA IL^RCCPCAT
	6657	"RTN","RCC PCAT",21,0 )
	6658	;
	6659	"RTN","RCC PCAT",22,0 )
	6660	K ^TMP($J ,"MSG")
	6661	"RTN","RCC PCAT",23,0 )
	6662	N PSCNTR, %,%I,%H,YE AR
	6663	"RTN","RCC PCAT",24,0 )
	6664	S YEAR=20 _$E($P(^RC AP(349.5,1 ,0),U,2),2 ,3)
	6665	"RTN","RCC PCAT",25,0 )
	6666	S PSCNTR= 0
	6667	"RTN","RCC PCAT",26,0 )
	6668	F S PSCN TR=$O(^RCA P(349.5,PS CNTR)) Q:' PSCNTR D
	6669	"RTN","RCC PCAT",27,0 )
	6670	. ; Set T ransmit St art Date a nd Time
	6671	"RTN","RCC PCAT",28,0 )
	6672	. D NOW^% DTC
	6673	"RTN","RCC PCAT",29,0 )
	6674	. S $P(^R CAP(349.5, PSCNTR,0), U,5)=%
	6675	"RTN","RCC PCAT",30,0 )
	6676	. ; Merge all PS el ements int o TMP MSG file
	6677	"RTN","RCC PCAT",31,0 )
	6678	. M ^TMP( $J,"MSG")= ^RCAP(349. 5,PSCNTR,1 )
	6679	"RTN","RCC PCAT",32,0 )
	6680	. D MAIL
	6681	"RTN","RCC PCAT",33,0 )
	6682	. ; Set T ransmit En d Date and Time
	6683	"RTN","RCC PCAT",34,0 )
	6684	. D NOW^% DTC
	6685	"RTN","RCC PCAT",35,0 )
	6686	. S $P(^R CAP(349.5, PSCNTR,0), U,6)=%
	6687	"RTN","RCC PCAT",36,0 )
	6688	;
	6689	"RTN","RCC PCAT",37,0 )
	6690	; PRCA4. 5313 - Un lock prior to quit
	6691	"RTN","RCC PCAT",38,0 )
	6692	L -^RCAP( 349.5):DIL OCKTM
	6693	"RTN","RCC PCAT",39,0 )
	6694	Q
	6695	"RTN","RCC PCAT",40,0 )
	6696	;
	6697	"RTN","RCC PCAT",41,0 )
	6698	MAIL ;set up and sen d mail mes sage - cop ied from R CCPCML
	6699	"RTN","RCC PCAT",42,0 )
	6700	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	6701	"RTN","RCC PCAT",43,0 )
	6702	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT TRANSMI SSION "_YE AR
	6703	"RTN","RCC PCAT",44,0 )
	6704	S XMDUZ=" AR PACKAGE "
	6705	"RTN","RCC PCAT",45,0 )
	6706	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	6707	CCPC STATE MENTS")=""
	6708	"RTN","RCC PCAT",46,0 )
	6709	S X=$O(^R CT(349.1," B","PY",0) )
	6710	"RTN","RCC PCAT",47,0 )
	6711	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
	6712	(349.1,+X, 3)),U,3) S :$P(X,"@", 2)]"" XMY( X)=""
	6713	"RTN","RCC PCAT",48,0 )
	6714	I $P(X,"@ ",2)']"" D Q
	6715	"RTN","RCC PCAT",49,0 )
	6716	.S ERROR= 6,NM=0 D E RROR
	6717	"RTN","RCC PCAT",50,0 )
	6718	S XMDUZ=" AR PACKAGE "
	6719	"RTN","RCC PCAT",51,0 )
	6720	D XMZ^XMA 2
	6721	"RTN","RCC PCAT",52,0 )
	6722	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	6723	"RTN","RCC PCAT",53,0 )
	6724	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
	6725	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	6726	"RTN","RCC PCAT",54,0 )
	6727	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	6728	"RTN","RCC PCAT",55,0 )
	6729	D ENT1^XM D
	6730	"RTN","RCC PCAT",56,0 )
	6731	D NOW^%DT C
	6732	"RTN","RCC PCAT",57,0 )
	6733	K ^TMP($J ,"MSG")
	6734	"RTN","RCC PCAT",58,0 )
	6735	Q
	6736	"RTN","RCC PCAT",59,0 )
	6737	;
	6738	"RTN","RCC PCAT",60,0 )
	6739	ERRMAIL ;s et up and send mail message fo r Locking issues
	6740	"RTN","RCC PCAT",61,0 )
	6741	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	6742	"RTN","RCC PCAT",62,0 )
	6743	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT NOT COM PLETED "_Y EAR
	6744	"RTN","RCC PCAT",63,0 )
	6745	S XMDUZ=" AR PACKAGE "
	6746	"RTN","RCC PCAT",64,0 )
	6747	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	6748	CCPC STATE MENTS")=""
	6749	"RTN","RCC PCAT",65,0 )
	6750	S XMDUZ=" AR PACKAGE "
	6751	"RTN","RCC PCAT",66,0 )
	6752	D XMZ^XMA 2
	6753	"RTN","RCC PCAT",67,0 )
	6754	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	6755	"RTN","RCC PCAT",68,0 )
	6756	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
	6757	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	6758	"RTN","RCC PCAT",69,0 )
	6759	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	6760	"RTN","RCC PCAT",70,0 )
	6761	D ENT1^XM D
	6762	"RTN","RCC PCAT",71,0 )
	6763	D NOW^%DT C
	6764	"RTN","RCC PCAT",72,0 )
	6765	K ^TMP($J ,"MSG")
	6766	"RTN","RCC PCAT",73,0 )
	6767	Q
	6768	"RTN","RCC PCAT",74,0 )
	6769	;
	6770	"RTN","RCC PCAT",75,0 )
	6771	SCHED(SITE ) ; Deter mine the d ate and ti me for Tra nsmit base d upon Sit e Code an
	6772	d table AI TC provide d
	6773	"RTN","RCC PCAT",76,0 )
	6774	; Time wi ll always be 2:00 AM
	6775	"RTN","RCC PCAT",77,0 )
	6776	I SITE>40 1&(SITE<52 0) S DTTIM E=$E(DT,1, 5)_"03.020 000" Q DTT IME
	6777	"RTN","RCC PCAT",78,0 )
	6778	I SITE>51 9&(SITE<54 1) S DTTIM E=$E(DT,1, 5)_"04.020 000" Q DTT IME
	6779	"RTN","RCC PCAT",79,0 )
	6780	I SITE>54 0&(SITE<55 9) S DTTIM E=$E(DT,1, 5)_"05.020 000" Q DTT IME
	6781	"RTN","RCC PCAT",80,0 )
	6782	I SITE>56 0&(SITE<58 1) S DTTIM E=$E(DT,1, 5)_"06.020 000" Q DTT IME
	6783	"RTN","RCC PCAT",81,0 )
	6784	I SITE>58 0&(SITE<59 9) S DTTIM E=$E(DT,1, 5)_"07.020 000" Q DTT IME
	6785	"RTN","RCC PCAT",82,0 )
	6786	I SITE>59 9&(SITE<62 0) S DTTIM E=$E(DT,1, 5)_"08.020 000" Q DTT IME
	6787	"RTN","RCC PCAT",83,0 )
	6788	I SITE>61 9&(SITE<64 1) S DTTIM E=$E(DT,1, 5)_"09.020 000" Q DTT IME
	6789	"RTN","RCC PCAT",84,0 )
	6790	I SITE>64 1&(SITE<65 8) S DTTIM E=$E(DT,1, 5)_"10.020 000" Q DTT IME
	6791	"RTN","RCC PCAT",85,0 )
	6792	I SITE>65 7&(SITE<67 5) S DTTIM E=$E(DT,1, 5)_"11.020 000" Q DTT IME
	6793	"RTN","RCC PCAT",86,0 )
	6794	I SITE>67 4&(SITE<75 8) S DTTIM E=$E(DT,1, 5)_"12.020 000" Q DTT IME
	6795	"RTN","RCC PCAT",87,0 )
	6796	S DTTIME= ""
	6797	"RTN","RCC PCAT",88,0 )
	6798	Q DTTIME
	6799	"RTN","RCC PCAT",89,0 )
	6800	;
	6801	"RTN","RCC PCAT",90,0 )
	6802	MANBLD ; Build and Transmit t he Annual Payment St atement af ter initia l yearly
	6803	transmissi on
	6804	"RTN","RCC PCAT",91,0 )
	6805	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6806	"RTN","RCC PCAT",92,0 )
	6807	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	6808	"RTN","RCC PCAT",93,0 )
	6809	;
	6810	"RTN","RCC PCAT",94,0 )
	6811	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	6812	"RTN","RCC PCAT",95,0 )
	6813	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6814	"RTN","RCC PCAT",96,0 )
	6815	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	6816	"RTN","RCC PCAT",97,0 )
	6817	I YEAR="" S YEAR=$E (DT,1,3)-1
	6818	"RTN","RCC PCAT",98,0 )
	6819	S YEAR("E XT")=20_$E (YEAR,2,3)
	6820	"RTN","RCC PCAT",99,0 )
	6821	S DATE=+$ P($G(^RCAP (349.5,1,0 )),U,6)
	6822	"RTN","RCC PCAT",100, 0)
	6823	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	6824	"RTN","RCC PCAT",101, 0)
	6825	I 'DATE D L -^RCAP (349.5):DI LOCKTM Q
	6826	"RTN","RCC PCAT",102, 0)
	6827	. W !,"Th e Annual P ayment Fil e for "_YE AR("EXT")_ " has not been trans mitted."
	6828	"RTN","RCC PCAT",103, 0)
	6829	. W !,"Bu ild and Re transmit m ay not be manually r un until s cheduled j ob has co
	6830	mpleted.", !
	6831	"RTN","RCC PCAT",104, 0)
	6832	. N DIR
	6833	"RTN","RCC PCAT",105, 0)
	6834	. S DIR(0 )="E"
	6835	"RTN","RCC PCAT",106, 0)
	6836	. S DIR(" A")="Type <Enter> to return to the Menu. "
	6837	"RTN","RCC PCAT",107, 0)
	6838	. D ^DIR
	6839	"RTN","RCC PCAT",108, 0)
	6840	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	6841	"RTN","RCC PCAT",109, 0)
	6842	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_".
	6843	"
	6844	"RTN","RCC PCAT",110, 0)
	6845	S DIR(0)= "YAO"
	6846	"RTN","RCC PCAT",111, 0)
	6847	S DIR("B" )="N"
	6848	"RTN","RCC PCAT",112, 0)
	6849	S DIR("A" )="Do you want to Bu ild and Tr ansmit the file for "_YEAR("EX T")_"? "
	6850	"RTN","RCC PCAT",113, 0)
	6851	S DIR("?? ")="^D MAN HLP^RCCPCA T"
	6852	"RTN","RCC PCAT",114, 0)
	6853	D ^DIR
	6854	"RTN","RCC PCAT",115, 0)
	6855	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC AP(349.5): DILOCKTM Q
	6856	"RTN","RCC PCAT",116, 0)
	6857	I $E(X)'= "Y" Q
	6858	"RTN","RCC PCAT",117, 0)
	6859	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	6860	"RTN","RCC PCAT",118, 0)
	6861	S ZTIO="" ,ZTRTN="EN ^RCCPCAP(" _YEAR_","_ """F"""_", "_""""""_" )"
	6862	"RTN","RCC PCAT",119, 0)
	6863	S ZTDESC= "Build Ann ual Paymen t Statemen t File"
	6864	"RTN","RCC PCAT",120, 0)
	6865	S ZTDTH=" "
	6866	"RTN","RCC PCAT",121, 0)
	6867	;
	6868	"RTN","RCC PCAT",122, 0)
	6869	; PRCA4. 5313 - Un lock prior to transm itting
	6870	"RTN","RCC PCAT",123, 0)
	6871	L -^RCAP( 349.5):DIL OCKTM
	6872	"RTN","RCC PCAT",124, 0)
	6873	;
	6874	"RTN","RCC PCAT",125, 0)
	6875	D ^%ZTLOA D Q:$G(ZTS K)=""
	6876	"RTN","RCC PCAT",126, 0)
	6877	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6878	"RTN","RCC PCAT",127, 0)
	6879	Q
	6880	"RTN","RCC PCAT",128, 0)
	6881	;
	6882	"RTN","RCC PCAT",129, 0)
	6883	RETRANS ; Retransmi t the exis ting file and allow user to se lect date and time
	6884	"RTN","RCC PCAT",130, 0)
	6885	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6886	"RTN","RCC PCAT",131, 0)
	6887	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	6888	"RTN","RCC PCAT",132, 0)
	6889	;
	6890	"RTN","RCC PCAT",133, 0)
	6891	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	6892	"RTN","RCC PCAT",134, 0)
	6893	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6894	"RTN","RCC PCAT",135, 0)
	6895	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	6896	"RTN","RCC PCAT",136, 0)
	6897	S YEAR("E XT")=20_$E (YEAR,2,3)
	6898	"RTN","RCC PCAT",137, 0)
	6899	S DATE=$P ($G(^RCAP( 349.5,1,0) ),U,6)
	6900	"RTN","RCC PCAT",138, 0)
	6901	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	6902	"RTN","RCC PCAT",139, 0)
	6903	I '$P($G( ^RCAP(349. 5,1,0)),U, 4) D L -^ RCAP(349.5 ):DILOCKTM Q
	6904	"RTN","RCC PCAT",140, 0)
	6905	. W !,"Th e Annual P ayment Fil e for "_YE AR("EXT")_ " has not been Built and cann
	6906	ot be tran smitted."
	6907	"RTN","RCC PCAT",141, 0)
	6908	. N DIR
	6909	"RTN","RCC PCAT",142, 0)
	6910	. S DIR(0 )="E"
	6911	"RTN","RCC PCAT",143, 0)
	6912	. S DIR(" A")="Type <Enter> to return to the menu. "
	6913	"RTN","RCC PCAT",144, 0)
	6914	. D ^DIR
	6915	"RTN","RCC PCAT",145, 0)
	6916	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	6917	"RTN","RCC PCAT",146, 0)
	6918	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_".
	6919	"
	6920	"RTN","RCC PCAT",147, 0)
	6921	S DIR(0)= "YAO"
	6922	"RTN","RCC PCAT",148, 0)
	6923	S DIR("B" )="N"
	6924	"RTN","RCC PCAT",149, 0)
	6925	S DIR("A" )="Do you want to Re transmit t he existin g file for "_YEAR("E XT")_" ag
	6926	ain? "
	6927	"RTN","RCC PCAT",150, 0)
	6928	S DIR("?? ")="^D RET HLP^RCCPCA T"
	6929	"RTN","RCC PCAT",151, 0)
	6930	D ^DIR
	6931	"RTN","RCC PCAT",152, 0)
	6932	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC AP(349.5): DILOCKTM Q
	6933	"RTN","RCC PCAT",153, 0)
	6934	I $E(X)'= "Y" Q
	6935	"RTN","RCC PCAT",154, 0)
	6936	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	6937	"RTN","RCC PCAT",155, 0)
	6938	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	6939	"RTN","RCC PCAT",156, 0)
	6940	S ZTDESC= "Retransmi t Annual P ayment Sta tement Fil e"
	6941	"RTN","RCC PCAT",157, 0)
	6942	S ZTDTH=" "
	6943	"RTN","RCC PCAT",158, 0)
	6944	;
	6945	"RTN","RCC PCAT",159, 0)
	6946	; PRCA4. 5313 - Un lock prior to retran smitting
	6947	"RTN","RCC PCAT",160, 0)
	6948	L -^RCAP( 349.5):DIL OCKTM
	6949	"RTN","RCC PCAT",161, 0)
	6950	;
	6951	"RTN","RCC PCAT",162, 0)
	6952	D ^%ZTLOA D Q:$G(ZTS K)=""
	6953	"RTN","RCC PCAT",163, 0)
	6954	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6955	"RTN","RCC PCAT",164, 0)
	6956	Q
	6957	"RTN","RCC PCAT",165, 0)
	6958	;
	6959	"RTN","RCC PCAT",166, 0)
	6960	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	6961	"RTN","RCC PCAT",167, 0)
	6962	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	6963	"RTN","RCC PCAT",168, 0)
	6964	Q
	6965	"RTN","RCC PCAT",169, 0)
	6966	;
	6967	"RTN","RCC PCAT",170, 0)
	6968	MENUERR ; Print err or to scre en if Annu al Payment File has not comple ted for t
	6969	his year
	6970	"RTN","RCC PCAT",171, 0)
	6971	N YEAR
	6972	"RTN","RCC PCAT",172, 0)
	6973	S YEAR=20 _$E(DT,2,3 )-1
	6974	"RTN","RCC PCAT",173, 0)
	6975	W !!,"The Build and Transmit of the Ann ual Paymen t File for "_YEAR_" has not c
	6976	ompleted."
	6977	"RTN","RCC PCAT",174, 0)
	6978	W !,"You may not us e this opt ion until it complet es.",!
	6979	"RTN","RCC PCAT",175, 0)
	6980	D PAUSE^V ALM1
	6981	"RTN","RCC PCAT",176, 0)
	6982	Q
	6983	"RTN","RCC PCAT",177, 0)
	6984	;
	6985	"RTN","RCC PCAT",178, 0)
	6986	MANHLP ; "??" Help for MANBLD and RETRA NS
	6987	"RTN","RCC PCAT",179, 0)
	6988	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Build an d Retransm it file."
	6989	"RTN","RCC PCAT",180, 0)
	6990	Q
	6991	"RTN","RCC PCAT",181, 0)
	6992	;
	6993	"RTN","RCC PCAT",182, 0)
	6994	RETHLP ; "??" Help for MANBLD and RETRA NS
	6995	"RTN","RCC PCAT",183, 0)
	6996	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Retransm it file."
	6997	"RTN","RCC PCAT",184, 0)
	6998	Q
	6999	"RTN","RCC PCBJ")
	7000	0^5^B94409 06^B628849 1
	7001	"RTN","RCC PCBJ",1,0)
	7002	RCCPCBJ ;W ASH-ISC@AL TOONA,PA/N YB-Backgro und Driver for CCPC ;1/7/97 9 :42 AM
	7003	"RTN","RCC PCBJ",2,0)
	7004	;;4.5;Acc ounts Rece ivable;3 4,76,130,1 53,166,195 ,217,237,3 13;Mar 2 0, 1995;B
	7005	uild 124
	7006	"RTN","RCC PCBJ",3,0)
	7007	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	7008	"RTN","RCC PCBJ",4,0)
	7009	EN ;Starts the backg round job for CCPC 5 days befo re stateme nt day
	7010	"RTN","RCC PCBJ",5,0)
	7011	N X,X1,X2 ,X3,ZTRTN, ZTIO,ZTDTH ,ZTSK,ZTDE SC,SDT,RCF ULL
	7012	"RTN","RCC PCBJ",6,0)
	7013	;D ACK P RCA4.531 3 - Moved into OPEN
	7014	"RTN","RCC PCBJ",7,0)
	7015	D ;run t he cbs nig htly accou nt update program ev eryday
	7016	"RTN","RCC PCBJ",8,0)
	7017	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	7018	"RTN","RCC PCBJ",9,0)
	7019	.S RCFULL =0 ;do not send the full debto r list
	7020	"RTN","RCC PCBJ",10,0 )
	7021	.S ZTIO=" ",ZTRTN="D EBTOR^PRCA CPS1"
	7022	"RTN","RCC PCBJ",11,0 )
	7023	.S ZTDESC ="CBS NIGH TLY ACCOUN T UPDATE P ROGRAM",ZT DTH=$H
	7024	"RTN","RCC PCBJ",12,0 )
	7025	.D ^%ZTLO AD
	7026	"RTN","RCC PCBJ",13,0 )
	7027	;
	7028	"RTN","RCC PCBJ",14,0 )
	7029	I $$DOW^X LFDT(DT,1) =3 D ;run the cbs a uto-correc tion progr am on Wedn esdays
	7030	"RTN","RCC PCBJ",15,0 )
	7031	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	7032	"RTN","RCC PCBJ",16,0 )
	7033	.S ZTIO=" ",ZTRTN="S TART^PRCAC PS",ZTSAVE ("RCFULL") =""
	7034	"RTN","RCC PCBJ",17,0 )
	7035	.S ZTDESC ="PATIENT STATEMENTS AUTO-CORR ECTION PRO GRAM",ZTDT H=$H
	7036	"RTN","RCC PCBJ",18,0 )
	7037	.D ^%ZTLO AD
	7038	"RTN","RCC PCBJ",19,0 )
	7039	;
	7040	"RTN","RCC PCBJ",20,0 )
	7041	; PRCA4. 5313 - Ru n the Annu al Payment Statement Build and Transmit
	7042	"RTN","RCC PCBJ",21,0 )
	7043	; on Janu ary 2nd of each year for the p revious ye ar
	7044	"RTN","RCC PCBJ",22,0 )
	7045	I $E(DT,4 ,7)="0102" D
	7046	"RTN","RCC PCBJ",23,0 )
	7047	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	7048	"RTN","RCC PCBJ",24,0 )
	7049	. S ZTIO= "",ZTRTN=" EN^RCCPCAP ",ZTDTH=$H
	7050	"RTN","RCC PCBJ",25,0 )
	7051	. S ZTDES C="ANNUAL PAYMENT ST ATEMENT BU ILD AND TR ANSMIT"
	7052	"RTN","RCC PCBJ",26,0 )
	7053	. D ^%ZTL OAD
	7054	"RTN","RCC PCBJ",27,0 )
	7055	;
	7056	"RTN","RCC PCBJ",28,0 )
	7057	; PRCA4. 5313 - Ru n the Annu al Payment Error Rep ort on Mar ch, June, September
	7058	and
	7059	"RTN","RCC PCBJ",29,0 )
	7060	; Decembe r 15th
	7061	"RTN","RCC PCBJ",30,0 )
	7062	I $E(DT,4 ,5)="03"!( $E(DT,4,5) ="06")!($E (DT,4,5)=" 09")!($E(D T,4,5)=12) D
	7063	"RTN","RCC PCBJ",31,0 )
	7064	. I $E(DT ,6,7)'=15 Q
	7065	"RTN","RCC PCBJ",32,0 )
	7066	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	7067	"RTN","RCC PCBJ",33,0 )
	7068	. S ZTIO= "",ZTRTN=" EN^RCCPCAR ",ZTDTH=$H
	7069	"RTN","RCC PCBJ",34,0 )
	7070	. S ZTDES C="ANNUAL PAYMENT ER ROR REPORT "
	7071	"RTN","RCC PCBJ",35,0 )
	7072	. D ^%ZTL OAD
	7073	"RTN","RCC PCBJ",36,0 )
	7074	;
	7075	"RTN","RCC PCBJ",37,0 )
	7076	I DT'<$P( $G(^RC(342 ,1,30)),"^ ",1)&(DT'> $P($G(^RC( 342,1,30)) ,"^",2)) D ^RCEXINA
	7077	D
	7078	"RTN","RCC PCBJ",38,0 )
	7079	;
	7080	"RTN","RCC PCBJ",39,0 )
	7081	; PRCA4. 5313 - Se t Statemen t Date to two days i n future a nd save fo r Job
	7082	"RTN","RCC PCBJ",40,0 )
	7083	S X1=DT,X 2=2 D C^%D TC S SDT=X
	7084	"RTN","RCC PCBJ",41,0 )
	7085	S ZTSAVE( "SDT")=SDT
	7086	"RTN","RCC PCBJ",42,0 )
	7087	S ZTIO="" ,ZTRTN="OP EN^RCCPCBJ ",ZTDESC=" CBSS PATIE NT STATEME NT"
	7088	"RTN","RCC PCBJ",43,0 )
	7089	S ZTDTH=$ H D ^%ZTLO AD
	7090	"RTN","RCC PCBJ",44,0 )
	7091	Q
	7092	"RTN","RCC PCBJ",45,0 )
	7093	OPEN ;Upda te Open st atus bills to Active or Cancel lation sta tus
	7094	"RTN","RCC PCBJ",46,0 )
	7095	N DAY,BN, DEBTOR,DA, DIE,DR,P,A MT,DATE
	7096	"RTN","RCC PCBJ",47,0 )
	7097	N ZTSAVE, ZTRTN,ZTDE SC,ZTASK,% ZIS,ZTDTH
	7098	"RTN","RCC PCBJ",48,0 )
	7099	; PRCA4. 5313 - Ch eck the ac knowledgem ent for pr evious mon th
	7100	"RTN","RCC PCBJ",49,0 )
	7101	D TRANCHK ^RCCPCSV1
	7102	"RTN","RCC PCBJ",50,0 )
	7103	; PRCA4. 5313 - Se t DATE and day of mo nth from S DT and pro cess that date's de
	7104	btors
	7105	"RTN","RCC PCBJ",51,0 )
	7106	S DATE=SD T,DAY=+$E( SDT,6,7),D EBTOR=""
	7107	"RTN","RCC PCBJ",52,0 )
	7108	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	7109	"RTN","RCC PCBJ",53,0 )
	7110	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'B
	7111	N D
	7112	"RTN","RCC PCBJ",54,0 )
	7113	..S AMT=0 F P=1:1:5 S AMT=$P( $G(^PRCA(4 30,+BN,7)) ,"^",P)+AM T
	7114	"RTN","RCC PCBJ",55,0 )
	7115	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )),AMT Q
	7116	"RTN","RCC PCBJ",56,0 )
	7117	..S DIE=" ^PRCA(430, ",DA=+BN,D R="8////^S X="_$S(AM T:$O(^PRCA (430.3,"AC ",102,0))
	7118	,1:$O(^PRC A(430.3,"A C",111,0)) ) D ^DIE K DA,DIE,DR
	7119	"RTN","RCC PCBJ",57,0 )
	7120	..Q
	7121	"RTN","RCC PCBJ",58,0 )
	7122	.Q
	7123	"RTN","RCC PCBJ",59,0 )
	7124	;
	7125	"RTN","RCC PCBJ",60,0 )
	7126	; update patient a ccounts wi th interes t and admi n
	7127	"RTN","RCC PCBJ",61,0 )
	7128	N RCLASDA T
	7129	"RTN","RCC PCBJ",62,0 )
	7130	S RCLASDA T=DATE
	7131	"RTN","RCC PCBJ",63,0 )
	7132	I DT>3010 101 D FIRS TPTY^RCBEC HGS
	7133	"RTN","RCC PCBJ",64,0 )
	7134	; PRCA4. 5313 - Ad ded SDT to process a nd send
	7135	"RTN","RCC PCBJ",65,0 )
	7136	D EN^RCCP CPS(SDT)
	7137	"RTN","RCC PCBJ",66,0 )
	7138	D REFUND
	7139	"RTN","RCC PCBJ",67,0 )
	7140	D EN^RCCP CML(SDT)
	7141	"RTN","RCC PCBJ",68,0 )
	7142	Q
	7143	"RTN","RCC PCBJ",69,0 )
	7144	;
	7145	"RTN","RCC PCBJ",70,0 )
	7146	;
	7147	"RTN","RCC PCBJ",71,0 )
	7148	REFUND ;Up date Open status PRE PAYMENT bi lls to REF UND REVIEW
	7149	"RTN","RCC PCBJ",72,0 )
	7150	; PRCA4. 5313 - Ch anged DAY to stateme nt date
	7151	"RTN","RCC PCBJ",73,0 )
	7152	S DEBTOR= 0,DAY=SDT
	7153	"RTN","RCC PCBJ",74,0 )
	7154	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	7155	"RTN","RCC PCBJ",75,0 )
	7156	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'B
	7157	N D
	7158	"RTN","RCC PCBJ",76,0 )
	7159	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )) S X=$$E N^PRCARFU
	7160	(+BN)
	7161	"RTN","RCC PCBJ",77,0 )
	7162	..Q
	7163	"RTN","RCC PCBJ",78,0 )
	7164	.Q
	7165	"RTN","RCC PCBJ",79,0 )
	7166	Q
	7167	"RTN","RCC PCBJ",80,0 )
	7168	;
	7169	"RTN","RCC PCBJ",81,0 )
	7170	ACK ;CHECK FOR ACKNO WLEDGEMENT S PRCA4. 5313 - No longer us ed
	7171	"RTN","RCC PCBJ",82,0 )
	7172	N DEB,MSG ,NO,RCX,X, X1,X2
	7173	"RTN","RCC PCBJ",83,0 )
	7174	S X1=$$ST D^RCCPCFN, X2=DT D ^% DTC I X>3 D
	7175	"RTN","RCC PCBJ",84,0 )
	7176	. D TRANC HK^RCCPCSV 1
	7177	"RTN","RCC PCBJ",85,0 )
	7178	Q
	7179	"RTN","RCC PCFN1")
	7180	0^7^B71817 74^n/a
	7181	"RTN","RCC PCFN1",1,0 )
	7182	RCCPCFN1 ; ALB/TGH-Ad ditional F unction ca lls for CB SS ;12/31/ 96 9:27 A M
	7183	"RTN","RCC PCFN1",2,0 )
	7184	;;4.5;Acc ounts Rece ivable;3 13;Mar 3 1, 2016;Bu ild 124
	7185	"RTN","RCC PCFN1",3,0 )
	7186	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7187	"RTN","RCC PCFN1",4,0 )
	7188	ACSET(NAME ) ; Deter mine the d ay of the month for each new d ebtor to h ave their
	7189	patient s tatement s ent
	7190	"RTN","RCC PCFN1",5,0 )
	7191	; by the site to CB SS for con solidation .
	7192	"RTN","RCC PCFN1",6,0 )
	7193	; Input: NAME = Pa tient's Na me
	7194	"RTN","RCC PCFN1",7,0 )
	7195	; Output: DAY/GROUP = day of month for patient st atement tr ansmission and grou
	7196	p number
	7197	"RTN","RCC PCFN1",8,0 )
	7198	; 0 = if i nvalid fir st charact er of last name
	7199	"RTN","RCC PCFN1",9,0 )
	7200	;
	7201	"RTN","RCC PCFN1",10, 0)
	7202	N LTR,GRO UP,DAY,I
	7203	"RTN","RCC PCFN1",11, 0)
	7204	;
	7205	"RTN","RCC PCFN1",12, 0)
	7206	; Quit if the patie nt name is not cross -reference d in the P atient Fil e (#2) -
	7207	return 0
	7208	"RTN","RCC PCFN1",13, 0)
	7209	I $G(NAME )="" Q 0
	7210	"RTN","RCC PCFN1",14, 0)
	7211	I '$D(^DP T("B",NAME )) Q 0
	7212	"RTN","RCC PCFN1",15, 0)
	7213	;
	7214	"RTN","RCC PCFN1",16, 0)
	7215	F I=1,2 S LTR(I)=$E (NAME,I)
	7216	"RTN","RCC PCFN1",17, 0)
	7217	I "AB"[LT R(1) S GRO UP=1,DAY=$ $GRP1(.LTR ) Q DAY_" /"_GROUP
	7218	"RTN","RCC PCFN1",18, 0)
	7219	I "CD"[LT R(1) S GRO UP=2,DAY=$ $GRP2(.LTR ) Q DAY_" /"_GROUP
	7220	"RTN","RCC PCFN1",19, 0)
	7221	I "EFIQ"[ LTR(1) S G ROUP=3,DAY =$$GRP3(.L TR) Q DAY _"/"_GROUP
	7222	"RTN","RCC PCFN1",20, 0)
	7223	I "GH"[LT R(1) S GRO UP=4,DAY=$ $GRP4(.LTR ) Q DAY_" /"_GROUP
	7224	"RTN","RCC PCFN1",21, 0)
	7225	I "JK"[LT R(1) S GRO UP=5,DAY=$ $GRP5(.LTR ) Q DAY_" /"_GROUP
	7226	"RTN","RCC PCFN1",22, 0)
	7227	I "LO"[LT R(1) S GRO UP=6,DAY=$ $GRP6(.LTR ) Q DAY_" /"_GROUP
	7228	"RTN","RCC PCFN1",23, 0)
	7229	I "MN"[LT R(1) S GRO UP=7,DAY=$ $GRP7(.LTR ) Q DAY_" /"_GROUP
	7230	"RTN","RCC PCFN1",24, 0)
	7231	I "T"[LTR (1) S GROU P=8,DAY=$$ GRP8(.LTR) Q DAY_"/ "_GROUP
	7232	"RTN","RCC PCFN1",25, 0)
	7233	I "R"[LTR (1) S GROU P=9,DAY=$$ GRP9(.LTR) Q DAY_"/ "_GROUP
	7234	"RTN","RCC PCFN1",26, 0)
	7235	I "SV"[LT R(1) S GRO UP=10,DAY= $$GRP10(.L TR) Q DAY _"/"_GROUP
	7236	"RTN","RCC PCFN1",27, 0)
	7237	I "PUXYZ" [LTR(1) S GROUP=11,D AY=$$GRP11 (.LTR) Q DAY_"/"_GR OUP
	7238	"RTN","RCC PCFN1",28, 0)
	7239	I "W"[LTR (1) S GROU P=12,DAY=$ $GRP12(.LT R) Q DAY_ "/"_GROUP
	7240	"RTN","RCC PCFN1",29, 0)
	7241	;
	7242	"RTN","RCC PCFN1",30, 0)
	7243	Q 0
	7244	"RTN","RCC PCFN1",31, 0)
	7245	;
	7246	"RTN","RCC PCFN1",32, 0)
	7247	GRP1(LTR) ;AB
	7248	"RTN","RCC PCFN1",33, 0)
	7249	;
	7250	"RTN","RCC PCFN1",34, 0)
	7251	I LTR(1)= "A" S DAY= 1
	7252	"RTN","RCC PCFN1",35, 0)
	7253	I LTR(1)= "B" D
	7254	"RTN","RCC PCFN1",36, 0)
	7255	. I "AU"[ LTR(2) S D AY=1
	7256	"RTN","RCC PCFN1",37, 0)
	7257	. I "AU"' [LTR(2) S DAY=2
	7258	"RTN","RCC PCFN1",38, 0)
	7259	;
	7260	"RTN","RCC PCFN1",39, 0)
	7261	Q DAY
	7262	"RTN","RCC PCFN1",40, 0)
	7263	;
	7264	"RTN","RCC PCFN1",41, 0)
	7265	GRP2(LTR) ;CD
	7266	"RTN","RCC PCFN1",42, 0)
	7267	;
	7268	"RTN","RCC PCFN1",43, 0)
	7269	I LTR(1)= "D" S DAY= 4
	7270	"RTN","RCC PCFN1",44, 0)
	7271	I LTR(1)= "C" D
	7272	"RTN","RCC PCFN1",45, 0)
	7273	. I "IRU" [LTR(2) S DAY=4
	7274	"RTN","RCC PCFN1",46, 0)
	7275	. I "IRU" '[LTR(2) S DAY=6
	7276	"RTN","RCC PCFN1",47, 0)
	7277	;
	7278	"RTN","RCC PCFN1",48, 0)
	7279	Q DAY
	7280	"RTN","RCC PCFN1",49, 0)
	7281	;
	7282	"RTN","RCC PCFN1",50, 0)
	7283	GRP3(LTR) ;EFIQ
	7284	"RTN","RCC PCFN1",51, 0)
	7285	;
	7286	"RTN","RCC PCFN1",52, 0)
	7287	S DAY=7
	7288	"RTN","RCC PCFN1",53, 0)
	7289	;
	7290	"RTN","RCC PCFN1",54, 0)
	7291	Q DAY
	7292	"RTN","RCC PCFN1",55, 0)
	7293	;
	7294	"RTN","RCC PCFN1",56, 0)
	7295	GRP4(LTR) ;GH
	7296	"RTN","RCC PCFN1",57, 0)
	7297	;
	7298	"RTN","RCC PCFN1",58, 0)
	7299	I LTR(1)= "G" S DAY= 8
	7300	"RTN","RCC PCFN1",59, 0)
	7301	I LTR(1)= "H" D
	7302	"RTN","RCC PCFN1",60, 0)
	7303	. I "E"[L TR(2) S DA Y=8
	7304	"RTN","RCC PCFN1",61, 0)
	7305	. I "E"'[ LTR(2) S D AY=10
	7306	"RTN","RCC PCFN1",62, 0)
	7307	;
	7308	"RTN","RCC PCFN1",63, 0)
	7309	Q DAY
	7310	"RTN","RCC PCFN1",64, 0)
	7311	;
	7312	"RTN","RCC PCFN1",65, 0)
	7313	GRP5(LTR) ;JK
	7314	"RTN","RCC PCFN1",66, 0)
	7315	;
	7316	"RTN","RCC PCFN1",67, 0)
	7317	S DAY=12
	7318	"RTN","RCC PCFN1",68, 0)
	7319	;
	7320	"RTN","RCC PCFN1",69, 0)
	7321	Q DAY
	7322	"RTN","RCC PCFN1",70, 0)
	7323	;
	7324	"RTN","RCC PCFN1",71, 0)
	7325	GRP6(LTR) ;LO
	7326	"RTN","RCC PCFN1",72, 0)
	7327	;
	7328	"RTN","RCC PCFN1",73, 0)
	7329	S DAY=14
	7330	"RTN","RCC PCFN1",74, 0)
	7331	;
	7332	"RTN","RCC PCFN1",75, 0)
	7333	Q DAY
	7334	"RTN","RCC PCFN1",76, 0)
	7335	;
	7336	"RTN","RCC PCFN1",77, 0)
	7337	GRP7(LTR) ;MN
	7338	"RTN","RCC PCFN1",78, 0)
	7339	;
	7340	"RTN","RCC PCFN1",79, 0)
	7341	I LTR(1)= "N" S DAY= 17
	7342	"RTN","RCC PCFN1",80, 0)
	7343	I LTR(1)= "M" D
	7344	"RTN","RCC PCFN1",81, 0)
	7345	. I "CI"[ LTR(2) S D AY=17
	7346	"RTN","RCC PCFN1",82, 0)
	7347	. I "CI"' [LTR(2) S DAY=15
	7348	"RTN","RCC PCFN1",83, 0)
	7349	;
	7350	"RTN","RCC PCFN1",84, 0)
	7351	Q DAY
	7352	"RTN","RCC PCFN1",85, 0)
	7353	;
	7354	"RTN","RCC PCFN1",86, 0)
	7355	GRP8(LTR) ;T
	7356	"RTN","RCC PCFN1",87, 0)
	7357	;
	7358	"RTN","RCC PCFN1",88, 0)
	7359	I "ABCDE" [LTR(2) S DAY=19
	7360	"RTN","RCC PCFN1",89, 0)
	7361	I "FGH"[L TR(2) S DA Y=22
	7362	"RTN","RCC PCFN1",90, 0)
	7363	I "ABCDEF GH"'[LTR(2 ) S DAY=17
	7364	"RTN","RCC PCFN1",91, 0)
	7365	;
	7366	"RTN","RCC PCFN1",92, 0)
	7367	Q DAY
	7368	"RTN","RCC PCFN1",93, 0)
	7369	;
	7370	"RTN","RCC PCFN1",94, 0)
	7371	GRP9(LTR) ;R
	7372	"RTN","RCC PCFN1",95, 0)
	7373	;
	7374	"RTN","RCC PCFN1",96, 0)
	7375	S DAY=19
	7376	"RTN","RCC PCFN1",97, 0)
	7377	;
	7378	"RTN","RCC PCFN1",98, 0)
	7379	Q DAY
	7380	"RTN","RCC PCFN1",99, 0)
	7381	;
	7382	"RTN","RCC PCFN1",100 ,0)
	7383	GRP10(LTR) ;SV
	7384	"RTN","RCC PCFN1",101 ,0)
	7385	;
	7386	"RTN","RCC PCFN1",102 ,0)
	7387	I LTR(1)= "V" S DAY= 22
	7388	"RTN","RCC PCFN1",103 ,0)
	7389	I LTR(1)= "S" D
	7390	"RTN","RCC PCFN1",104 ,0)
	7391	. I "CHIM "[LTR(2) S DAY=22
	7392	"RTN","RCC PCFN1",105 ,0)
	7393	. I "CHIM "'[LTR(2) S DAY=21
	7394	"RTN","RCC PCFN1",106 ,0)
	7395	;
	7396	"RTN","RCC PCFN1",107 ,0)
	7397	Q DAY
	7398	"RTN","RCC PCFN1",108 ,0)
	7399	;
	7400	"RTN","RCC PCFN1",109 ,0)
	7401	GRP11(LTR) ;PUXYZ
	7402	"RTN","RCC PCFN1",110 ,0)
	7403	;
	7404	"RTN","RCC PCFN1",111 ,0)
	7405	S DAY=24
	7406	"RTN","RCC PCFN1",112 ,0)
	7407	;
	7408	"RTN","RCC PCFN1",113 ,0)
	7409	Q DAY
	7410	"RTN","RCC PCFN1",114 ,0)
	7411	;
	7412	"RTN","RCC PCFN1",115 ,0)
	7413	GRP12(LTR) ;W
	7414	"RTN","RCC PCFN1",116 ,0)
	7415	;
	7416	"RTN","RCC PCFN1",117 ,0)
	7417	S DAY=26
	7418	"RTN","RCC PCFN1",118 ,0)
	7419	;
	7420	"RTN","RCC PCFN1",119 ,0)
	7421	Q DAY
	7422	"RTN","RCC PCML")
	7423	0^8^B67061 934^B47881 024
	7424	"RTN","RCC PCML",1,0)
	7425	RCCPCML ;W ASH-ISC@AL TOONA,PA/L DB-Send CC PC transmi ssion ;12/ 19/96 4:1 6 PM
	7426	"RTN","RCC PCML",2,0)
	7427	V ;;4.5;Ac counts Rec eivable;** 34,80,93,1 18,133,140 ,160,165,1 87,195,206 ,223,260,
	7428	313**;Mar 20, 1995;B uild 124
	7429	"RTN","RCC PCML",3,0)
	7430	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	7431	"RTN","RCC PCML",4,0)
	7432	TRAN ;call from RCCP C TRANSMIT option to interacti vely allow transmiss ion of CC
	7433	PC mesages
	7434	"RTN","RCC PCML",5,0)
	7435	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	7436	"RTN","RCC PCML",6,0)
	7437	N SDT,X,Y ,ZTRTN,ZTS AVE,ZTDESC ,ZTIO,IEN
	7438	"RTN","RCC PCML",7,0)
	7439	I '$D(^XU SEC("RCCPC TRANSMIT" ,DUZ)) W * 7,*7,!,"Yo u do not h ave access to do th
	7440	is." Q
	7441	"RTN","RCC PCML",8,0)
	7442	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	7443	"RTN","RCC PCML",9,0)
	7444	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmi
	7445	tted. Try again lat er." Q
	7446	"RTN","RCC PCML",10,0 )
	7447	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7448	"RTN","RCC PCML",11,0 )
	7449	S DIR(0)= "DAO^^K:'$ D(^RCPS(34 9.2,""STDT "",Y)) X"
	7450	"RTN","RCC PCML",12,0 )
	7451	S DIR("A" )="Enter s tatement d ate as it will appea r on these statement s: "
	7452	"RTN","RCC PCML",13,0 )
	7453	S DIR("?" )="Enter s tatement d ate as it will appea r on these statement s or ^ to
	7454	exit."
	7455	"RTN","RCC PCML",14,0 )
	7456	D ^DIR
	7457	"RTN","RCC PCML",15,0 )
	7458	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	7459	"RTN","RCC PCML",16,0 )
	7460	; PRCA4. 5313 - Ch anged to a llow for s eparate da tes for st atements b ased upon
	7461	last name
	7462	"RTN","RCC PCML",17,0 )
	7463	S SDT=Y
	7464	"RTN","RCC PCML",18,0 )
	7465	; PRCA4. 5313 - Un lock prior to quitti ng
	7466	"RTN","RCC PCML",19,0 )
	7467	;I '$D(^R CPS(349.2, "STDT",SDT )) W !,"Th ere is not a CCPC fi le for thi s date."
	7468	L -^RCPS(3 49.2):DILO CKTM Q
	7469	"RTN","RCC PCML",20,0 )
	7470	; PRCA4. 5313 - Un lock prior to quitti ng
	7471	"RTN","RCC PCML",21,0 )
	7472	S IEN=$O( ^RCPS(349. 2,"STDT",S DT,0)) I ' $P($P($G(^ RCPS(349.2 ,IEN,0))," ^",10),".
	7473	") D Q
	7474	"RTN","RCC PCML",22,0 )
	7475	. W !,"Yo ur CBSS st atement fi le (349.2) is corrup ted. Pleas e rebuild it."
	7476	"RTN","RCC PCML",23,0 )
	7477	. L -^RCP S(349.2):D ILOCKTM
	7478	"RTN","RCC PCML",24,0 )
	7479	; PRCA4. 5313 - Un lock prior to jobbin g off
	7480	"RTN","RCC PCML",25,0 )
	7481	L -^RCPS( 349.2):DIL OCKTM
	7482	"RTN","RCC PCML",26,0 )
	7483	; PRCA4. 5313 - Al lows for m ultiple st atement da tes
	7484	"RTN","RCC PCML",27,0 )
	7485	S ZTSAVE( "SDT")=SDT ,ZTRTN="RE TRAN^RCCPC ML",ZTIO=" ",ZTDESC=" Re-transmi t CBSS pa
	7486	tient stat ements -us er activat ed"
	7487	"RTN","RCC PCML",28,0 )
	7488	D ^%ZTLOA D
	7489	"RTN","RCC PCML",29,0 )
	7490	Q
	7491	"RTN","RCC PCML",30,0 )
	7492	;
	7493	"RTN","RCC PCML",31,0 )
	7494	EN(SDT) ;c alled from backgroun d job - PR CA4.5313 Added SDT for backg round job
	7495	call
	7496	"RTN","RCC PCML",32,0 )
	7497	N DA,DIK, LPRINT
	7498	"RTN","RCC PCML",33,0 )
	7499	D NOW^%DT C
	7500	"RTN","RCC PCML",34,0 )
	7501	RETRAN N D A,DIK,ERRO R,RCT,X,X1 ,DEB
	7502	"RTN","RCC PCML",35,0 )
	7503	; PRCA4. 5313 - Pr ovides err or for inc omplete bu ild of 349 .2
	7504	"RTN","RCC PCML",36,0 )
	7505	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)
	7506	) S ERROR= 1,NM=0 D E RROR Q
	7507	"RTN","RCC PCML",37,0 )
	7508	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with Error .
	7509	"RTN","RCC PCML",38,0 )
	7510	L +^RCPS( 349.2):DIL OCKTM I '$ T S ERROR= 11,NM=0 D ERROR
	7511	"RTN","RCC PCML",39,0 )
	7512	I $G(ERRO R) D EXIT Q
	7513	"RTN","RCC PCML",40,0 )
	7514	K ^TMP($J )
	7515	"RTN","RCC PCML",41,0 )
	7516	; PRCA4. 5313 - Re moves exis ting 349 f or this da te
	7517	"RTN","RCC PCML",42,0 )
	7518	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
	7519	1,0)),U,2) ="PS" S DA =X1,DIK="^ RCT(349," D ^DIK
	7520	"RTN","RCC PCML",43,0 )
	7521	F X="PA", "IS","IT" S RCT=$O(^ RCT(349.1, "B",X,0)) I RCT K ^R CT(349.1,+ RCT,4,+$E
	7522	(SDT,6,7))
	7523	"RTN","RCC PCML",44,0 )
	7524	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
	7525	,TAMT,TMSG ,SZ,TRDESC
	7526	"RTN","RCC PCML",45,0 )
	7527	D DT^DICR W
	7528	"RTN","RCC PCML",46,0 )
	7529	S (ERROR, RTY)=0
	7530	"RTN","RCC PCML",47,0 )
	7531	S X=$O(^R CT(349.1," B","PS",0) )
	7532	"RTN","RCC PCML",48,0 )
	7533	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^",3)
	7534	"RTN","RCC PCML",49,0 )
	7535	I X']"" S ERROR=6,N M=0 D ERRO R,EXIT Q
	7536	"RTN","RCC PCML",50,0 )
	7537	D PHCT I 'PHCT S ER ROR=1,NM=0 D ERROR,E XIT Q
	7538	"RTN","RCC PCML",51,0 )
	7539	S MTOT=$O (^TMP($J," MCT",""),- 1)
	7540	"RTN","RCC PCML",52,0 )
	7541	; PRCA4. 5313 - Re set MTOT a nd MCT(1) for multip le dates o n one day
	7542	"RTN","RCC PCML",53,0 )
	7543	S MCT(1)= $O(^TMP($J ,"MCT","") )
	7544	"RTN","RCC PCML",54,0 )
	7545	S MTOT=MT OT-(MCT(1) -1)
	7546	"RTN","RCC PCML",55,0 )
	7547	S MCT(1)= 0
	7548	"RTN","RCC PCML",56,0 )
	7549	S MCT=0 F S MCT=$O (^TMP($J," MCT",MCT)) Q:'MCT D PS
	7550	"RTN","RCC PCML",57,0 )
	7551	EXIT D ERR ML^RCCPCML 1
	7552	"RTN","RCC PCML",58,0 )
	7553	K SDT,^TM P($J)
	7554	"RTN","RCC PCML",59,0 )
	7555	; PRCA4. 5313 - Un lock prior to exitin g
	7556	"RTN","RCC PCML",60,0 )
	7557	L -^RCPS( 349.2):DIL OCKTM
	7558	"RTN","RCC PCML",61,0 )
	7559	Q
	7560	"RTN","RCC PCML",62,0 )
	7561	;
	7562	"RTN","RCC PCML",63,0 )
	7563	F349 ;Get PS segment entry
	7564	"RTN","RCC PCML",64,0 )
	7565	N DA,D0,D IC,DLAYGO, X
	7566	"RTN","RCC PCML",65,0 )
	7567	S ERROR=0 K DD,DO S DIC="^RCT (349,",DIC (0)="L",DL AYGO=349,X ="PS."_$TR ($$FMTE^X
	7568	LFDT(DT,"2 D"),"/",". ")_"."_RCM D FILE^DI CN
	7569	"RTN","RCC PCML",66,0 )
	7570	I Y<0 S R TY=RTY+1 G F349:RTY< 4 S ERROR= 2,NM=0 D E RROR Q
	7571	"RTN","RCC PCML",67,0 )
	7572	S PSN=+Y
	7573	"RTN","RCC PCML",68,0 )
	7574	Q
	7575	"RTN","RCC PCML",69,0 )
	7576	;
	7577	"RTN","RCC PCML",70,0 )
	7578	PS ;Build PS,PH,PD s egments an d messages
	7579	"RTN","RCC PCML",71,0 )
	7580	S PSN=$O( ^TMP($J,"M CT",MCT,0) )
	7581	"RTN","RCC PCML",72,0 )
	7582	; PRCA4. 5313 - In crement Co unter for internal s torage
	7583	"RTN","RCC PCML",73,0 )
	7584	S MCT(1)= MCT(1)+1
	7585	"RTN","RCC PCML",74,0 )
	7586	; PRCA4. 5313 - Up date to ne w formatti ng
	7587	"RTN","RCC PCML",75,0 )
	7588	S $P(^RCT (349,+PSN, 0),"^",3,1 0)=MCT(1)_ "^"_MTOT_" ^"_$$SITE^ RCMSITE()_ "^"_$$FP^
	7589	RCCPCFN_"^ "_+^TMP($J ,"MCT",MCT )_"^"_$P(^ TMP($J,"MC T",MCT),"^ ",2)_"^"_$ $DAT^RCCP
	7590	CFN(SDT)_" ^"_$$DAT^R CCPCFN(DT)
	7591	"RTN","RCC PCML",76,0 )
	7592	S LN=+PSN ,^TMP($J," MSG",LN)=$ P($G(^RCT( 349,+PSN,0 )),"^",2,1 0)_"^\|"
	7593	"RTN","RCC PCML",77,0 )
	7594	; Reforma t Statemen t Date to Internal F ormat
	7595	"RTN","RCC PCML",78,0 )
	7596	S $P(^RCT (349,+PSN, 0),"^",9)= SDT
	7597	"RTN","RCC PCML",79,0 )
	7598	S MPT1=$P (^TMP($J," MCT",MCT), "^",3)
	7599	"RTN","RCC PCML",80,0 )
	7600	; PRCA4. 5313 - Su btract num ber of rec ords from last recor d to find number be
	7601	fore file starting p oint
	7602	"RTN","RCC PCML",81,0 )
	7603	S PT=MPT1 -$P(^TMP($ J,"MCT",MC T),"^",1)
	7604	"RTN","RCC PCML",82,0 )
	7605	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:PT="" Q :PT=$O(^RC PS(349.2,+ ($P(^TMP(
	7606	$J,"MCT",M CT),"^",3) ))) D
	7607	"RTN","RCC PCML",83,0 )
	7608	.Q:$D(^TM P($J,"ERRP T",+PT))
	7609	"RTN","RCC PCML",84,0 )
	7610	.S PT0=^R CPS(349.2, +PT,0)
	7611	"RTN","RCC PCML",85,0 )
	7612	. ; PRCA* 4.5*313 - Set DEB fr om PTO
	7613	"RTN","RCC PCML",86,0 )
	7614	. S DEB=$ P(PT0,"^")
	7615	"RTN","RCC PCML",87,0 )
	7616	.S LN=LN+ 1 S ^TMP($ J,"MSG",LN )="PH^"_$$ SITE^RCMSI TE_$$KEY^R CCPCFN(+PT )_"^"_$$N
	7617	M^RCCPCFN( +PT)_"^"
	7618	"RTN","RCC PCML",88,0 )
	7619	.S ADD=$G (^RCPS(349 .2,+PT,1))
	7620	"RTN","RCC PCML",89,0 )
	7621	.;
	7622	"RTN","RCC PCML",90,0 )
	7623	.;Remove special ch aracters c ausing pro blems (WIM -0402-2072 8)
	7624	"RTN","RCC PCML",91,0 )
	7625	.I ADD["~ " S ADD=$T R(ADD,"~", "") ;Remov e tilde
	7626	"RTN","RCC PCML",92,0 )
	7627	.I ADD["\| " S ADD=$T R(ADD,"\|", "") ;Remov e the pipe symbol
	7628	"RTN","RCC PCML",93,0 )
	7629	.;
	7630	"RTN","RCC PCML",94,0 )
	7631	.;Debtor needs larg e print (f ont) IF LP RINT=1
	7632	"RTN","RCC PCML",95,0 )
	7633	.S LPRINT =$G(^RCPS( 349.2,+PT, 7)) S:LPRI NT="" LPRI NT=0
	7634	"RTN","RCC PCML",96,0 )
	7635	.;
	7636	"RTN","RCC PCML",97,0 )
	7637	.F P=1:1: 7 S $P(^TM P($J,"MSG" ,LN),"^",P +5)=$S($P( ADD,"^",P) ]"":$P(ADD ,"^",P),1
	7638	:"")
	7639	"RTN","RCC PCML",98,0 )
	7640	.S ^TMP($ J,"MSG",LN )=^TMP($J, "MSG",LN)_ "^"
	7641	"RTN","RCC PCML",99,0 )
	7642	.S LN=LN+ 1
	7643	"RTN","RCC PCML",100, 0)
	7644	.F X=4:1: 8 S $P(AMT ,"^",X-3)= $$HEX^RCCP CFN($P(PT0 ,"^",X))
	7645	"RTN","RCC PCML",101, 0)
	7646	.S ^TMP($ J,"MSG",LN )=AMT_"^"_ $G(^RCPS(3 49.2,+PT,3 ))_"^"_$G( ^RCPS(349. 2,+PT,4))
	7647	_"^"_$O(^R CPS(349.2, +PT,2,""), -1)
	7648	"RTN","RCC PCML",102, 0)
	7649	.S LN=LN+ 1 I $P($G( ^RCD(340,+ DEB,0)),"; ") S ^TMP( $J,"MSG",L N)="^"_$$S ITE^RCMSI
	7650	TE_$$RJ^XL FSTR($TR($ P(^RCD(340 ,+DEB,0)," ;"),".","" ),13,0)
	7651	"RTN","RCC PCML",103, 0)
	7652	.; PRCA5 .4313 - S et ICN wit h Checksum , AR Flag, and Date of Latest Bill ino
	7653	PH data
	7654	"RTN","RCC PCML",104, 0)
	7655	.N PT8 S PT8=$G(^RC PS(349.2,+ PT,8))
	7656	"RTN","RCC PCML",105, 0)
	7657	.S ^TMP($ J,"MSG",LN )=$G(^TMP( $J,"MSG",L N))_"^"_LP RINT_"^"_$ P(PT8,"^") _"V"_$P(P
	7658	T8,"^",2,3 )_"^"_$$DA T^RCCPCFN( $P(PT8,"^" ,4))_"^\|"
	7659	"RTN","RCC PCML",106, 0)
	7660	.S $P(^RC PS(349.2,+ PT,0),"^", 11)=+PSN
	7661	"RTN","RCC PCML",107, 0)
	7662	.S PD=0 F S PD=$O( ^RCPS(349. 2,+PT,2,PD )) Q:'PD I $D(^(PD, 0)) S PD0= ^(0) D
	7663	"RTN","RCC PCML",108, 0)
	7664	..S AMT(0 )=$$HEX^RC CPCFN($P(P D0,"^",3))
	7665	"RTN","RCC PCML",109, 0)
	7666	..;Replac e special characters causing p roblem (PR CA*260)
	7667	"RTN","RCC PCML",110, 0)
	7668	..S TRDES C=$P(PD0," ^",2)
	7669	"RTN","RCC PCML",111, 0)
	7670	..I TRDES C["~" S TR DESC=$TR(T RDESC,"~", " ") ;Rep lace tilde
	7671	"RTN","RCC PCML",112, 0)
	7672	..I TRDES C["\|" S TR DESC=$TR(T RDESC,"\|", " ") ;Rep lace the p ipe symbol
	7673	"RTN","RCC PCML",113, 0)
	7674	..S LN=LN +1,^TMP($J ,"MSG",LN) ="PD^"_$$D AT^RCCPCFN (+PD0)_"^" _TRDESC_"^ "_AMT(0)_
	7675	"^"_$P(PD0 ,"^",4)_"^ \|"
	7676	"RTN","RCC PCML",114, 0)
	7677	S LN=LN+1 ,^TMP($J," MSG",LN)=" ~"
	7678	"RTN","RCC PCML",115, 0)
	7679	; PRCA4. 5313 - Se t all cros s-referenc es for Fil e
	7680	"RTN","RCC PCML",116, 0)
	7681	S DA=+PSN ,DIK="^RCT (349," D I X1^DIK
	7682	"RTN","RCC PCML",117, 0)
	7683	;
	7684	"RTN","RCC PCML",118, 0)
	7685	MAIL ;set up mail me ssage
	7686	"RTN","RCC PCML",119, 0)
	7687	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z
	7688	"RTN","RCC PCML",120, 0)
	7689	S XMSUB=$ $SITE^RCMS ITE()_" CB SS TRANSMI SSION "_SD T
	7690	"RTN","RCC PCML",121, 0)
	7691	S XMDUZ=" AR PACKAGE "
	7692	"RTN","RCC PCML",122, 0)
	7693	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),"^",12) S XMY("G
	7694	.RCCPC STA TEMENTS")= ""
	7695	"RTN","RCC PCML",123, 0)
	7696	S X=$O(^R CT(349.1," B","PS",0) )
	7697	"RTN","RCC PCML",124, 0)
	7698	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^")_" @"_$P($G(
	7699	^RCT(349.1 ,+X,3)),"^ ",3) S:$P( X,"@",2)]" " XMY(X)=" "
	7700	"RTN","RCC PCML",125, 0)
	7701	I $P(X,"@ ",2)']"" D Q
	7702	"RTN","RCC PCML",126, 0)
	7703	.S ERROR= 6,NM=0 D E RROR
	7704	"RTN","RCC PCML",127, 0)
	7705	S XMDUZ=" AR PACKAGE "
	7706	"RTN","RCC PCML",128, 0)
	7707	D XMZ^XMA 2
	7708	"RTN","RCC PCML",129, 0)
	7709	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	7710	"RTN","RCC PCML",130, 0)
	7711	S $P(^RCT (349,+PSN, 0),"^",11, 12)=DT_"^" _XMZ
	7712	"RTN","RCC PCML",131, 0)
	7713	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,
	7714	2,L,0)=^TM P($J,"MSG" ,L(1))
	7715	"RTN","RCC PCML",132, 0)
	7716	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_"^"_L_" ^"_DT
	7717	"RTN","RCC PCML",133, 0)
	7718	D ENT1^XM D
	7719	"RTN","RCC PCML",134, 0)
	7720	D NOW^%DT C
	7721	"RTN","RCC PCML",135, 0)
	7722	S $P(^RCT (349,+PSN, 0),"^",11, 12)=%_"^"_ XMZ
	7723	"RTN","RCC PCML",136, 0)
	7724	K ^TMP($J ,"MSG")
	7725	"RTN","RCC PCML",137, 0)
	7726	Q
	7727	"RTN","RCC PCML",138, 0)
	7728	;
	7729	"RTN","RCC PCML",139, 0)
	7730	PHCT ;PH c ount
	7731	"RTN","RCC PCML",140, 0)
	7732	S (ERROR, PT,PHCT,TA MT,SZ)=0,R CM=1
	7733	"RTN","RCC PCML",141, 0)
	7734	; PRCA4. 5313 - If last reco rd is for this date reset RCM to next va lue
	7735	"RTN","RCC PCML",142, 0)
	7736	N FINAL
	7737	"RTN","RCC PCML",143, 0)
	7738	S FINAL=$ O(^RCT(349 ,"@"),-1)
	7739	"RTN","RCC PCML",144, 0)
	7740	I FINAL,$ P($P(^RCT( 349,FINAL, 0),"^"),". ",2,4)=$TR ($$FMTE^XL FDT(DT,"2D "),"/",".
	7741	") S RCM=$ P($P(^RCT( 349,FINAL, 0),"^"),". ",5)+1
	7742	"RTN","RCC PCML",145, 0)
	7743	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:'PT S E RROR=0 D I ERROR,(E RROR<3) Q
	7744	"RTN","RCC PCML",146, 0)
	7745	.; PRCA4 .5313 - S et DEB to Debtor num ber
	7746	"RTN","RCC PCML",147, 0)
	7747	.S DEB=$P ($G(^RCPS( 349.2,PT,0 )),"^")
	7748	"RTN","RCC PCML",148, 0)
	7749	.S SZ(1)= 0 D ERRCHK Q:ERROR
	7750	"RTN","RCC PCML",149, 0)
	7751	.S PT0=^R CPS(349.2, +PT,0)
	7752	"RTN","RCC PCML",150, 0)
	7753	.S PHCT=P HCT+1
	7754	"RTN","RCC PCML",151, 0)
	7755	.S SZ=550 +SZ,SZ(1)= 550
	7756	"RTN","RCC PCML",152, 0)
	7757	.S:$G(^RC PS(349.2,+ PT,1))]"" SZ=SZ+$L(^ (1)),SZ(1) =SZ(1)+$L( ^(1))
	7758	"RTN","RCC PCML",153, 0)
	7759	.S:$G(^RC PS(349.2,+ PT,3))]"" SZ=SZ+$L(^ (3))+1,SZ( 1)=SZ(1)+$ L(^(3))+1
	7760	"RTN","RCC PCML",154, 0)
	7761	.S:$G(^RC PS(349.2,+ PT,4))]"" SZ=SZ+$L(^ (4))+1,SZ( 1)=SZ(1)+$ L(^(4))+1
	7762	"RTN","RCC PCML",155, 0)
	7763	.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(
	7764	1)=SZ(1)+$ L(^(0))
	7765	"RTN","RCC PCML",156, 0)
	7766	.S TAMT=T AMT+$P(^RC PS(349.2,+ PT,0),"^", 8)
	7767	"RTN","RCC PCML",157, 0)
	7768	.I SZ>270 00 D
	7769	"RTN","RCC PCML",158, 0)
	7770	..S RTY=0 D F349 Q: ERROR
	7771	"RTN","RCC PCML",159, 0)
	7772	..S TAMT= TAMT-$P(PT 0,"^",8)
	7773	"RTN","RCC PCML",160, 0)
	7774	..S TAMT= $$HEX^RCCP CFN(TAMT)
	7775	"RTN","RCC PCML",161, 0)
	7776	..S ^TMP( $J,"MCT",R CM)=(PHCT- 1)_"^"_TAM T_"^"_$O(^ RCPS(349.2 ,"STDT",SD T,PT),-1)
	7777	_"^"_(SZ-S Z(1))
	7778	"RTN","RCC PCML",162, 0)
	7779	..S ^TMP( $J,"MCT",R CM,+PSN)=" "
	7780	"RTN","RCC PCML",163, 0)
	7781	..S RCM=R CM+1,PHCT= 1
	7782	"RTN","RCC PCML",164, 0)
	7783	..S SZ=SZ (1)
	7784	"RTN","RCC PCML",165, 0)
	7785	..S TAMT= $P(PT0,"^" ,8)
	7786	"RTN","RCC PCML",166, 0)
	7787	I 'PT,$O( ^RCPS(349. 2,"STDT",S DT,0)) D
	7788	"RTN","RCC PCML",167, 0)
	7789	.S RTY=0 D F349 Q:E RROR S ^T MP($J,"MCT ",RCM)=PHC T_"^"_$$HE X^RCCPCFN( TAMT)_"^"
	7790	_$O(^RCPS( 349.2,"STD T",SDT,PT) ,-1)
	7791	"RTN","RCC PCML",168, 0)
	7792	.S ^TMP($ J,"MCT",RC M,+PSN)=""
	7793	"RTN","RCC PCML",169, 0)
	7794	Q
	7795	"RTN","RCC PCML",170, 0)
	7796	;
	7797	"RTN","RCC PCML",171, 0)
	7798	ERROR ;ERR OR FILE
	7799	"RTN","RCC PCML",172, 0)
	7800	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	7801	"RTN","RCC PCML",173, 0)
	7802	N SSN
	7803	"RTN","RCC PCML",174, 0)
	7804	S SSN=$$S SN^RCFN01( +DEB)
	7805	"RTN","RCC PCML",175, 0)
	7806	I SSN'=-1 S ^TMP($J ,"ERROR",E RROR,NM,SS N)=""
	7807	"RTN","RCC PCML",176, 0)
	7808	Q
	7809	"RTN","RCC PCML",177, 0)
	7810	;
	7811	"RTN","RCC PCML",178, 0)
	7812	ERRCHK ;Er ror check
	7813	"RTN","RCC PCML",179, 0)
	7814	I '$D(^RC PS(349.2,+ PT,0)) S E RROR=1,NM= 0 D ERROR Q
	7815	"RTN","RCC PCML",180, 0)
	7816	S PT(1)=P T,PT=$O(^R CPS(349.2, "STDT",SDT ,0)) I '$P (^RCPS(349 .2,PT,0)," ^",18) S
	7817	ERROR=1,NM =0 D ERROR S PT=PT(1 ) Q
	7818	"RTN","RCC PCML",181, 0)
	7819	S PT=PT(1 )
	7820	"RTN","RCC PCML",182, 0)
	7821	I $$KEY^R CCPCFN(+PT )']"" S ER ROR=4,NM=$ $NAM^RCFN0 1(+DEB) D ERROR S ^T MP($J,"ER
	7822	RPT",+PT)= "" Q
	7823	"RTN","RCC PCML",183, 0)
	7824	I '$D(^RC PS(349.2," AKEY",$$KE Y^RCCPCFN( +PT))) S E RROR=4,NM= $$NAM^RCFN 01(+DEB)
	7825	D ERROR S ^TMP($J,"E RRPT",+PT) ="" Q
	7826	"RTN","RCC PCML",184, 0)
	7827	S ADD=$G( ^RCPS(349. 2,+PT,1))
	7828	"RTN","RCC PCML",185, 0)
	7829	F P=1:1:7 S ADD(P)= $S($P(ADD, "^",P)]"": $P(ADD,"^" ,P),1:"")
	7830	"RTN","RCC PCML",186, 0)
	7831	I ADD(1)= "",ADD(2)= "",ADD(3)= "",ADD(4)= "",ADD(5)= "",ADD(6)= "" S ERROR =8,NM=$$N
	7832	AM^RCFN01( +DEB) D ER ROR S ^TMP ($J,"ERRPT ",+PT)="" Q
	7833	"RTN","RCC PCML",187, 0)
	7834	I ADD(1)= "",(ADD(2) =""),(ADD( 3)=""),(AD D(6)="") S ERROR=8,N M=$$NAM^RC FN01(+DEB
	7835	) D ERROR S ^TMP($J, "ERRPT",+P T)="" Q
	7836	"RTN","RCC PCML",188, 0)
	7837	I ADD(4)= ""!(ADD(5) ="")!(ADD( 6)="") S E RROR=8,NM= $$NAM^RCFN 01(+DEB) D ERROR S
	7838	^TMP($J,"E RRPT",+PT) =""
	7839	"RTN","RCC PCML",189, 0)
	7840	F ADD=1:1 :6 I ADD(A DD)'?.ANP S ERROR=10 ,NM=$$NAM^ RCFN01(+DE B),^TMP($J ,"ERRPT",
	7841	+PT)="" D ERROR Q
	7842	"RTN","RCC PCML",190, 0)
	7843	I $P($G(^ RCD(340,+D EB,1)),"^" ,9) S ^TMP ($J,"ERRPT ",+PT)="", ERROR=9,NM =$$NAM^RC
	7844	FN01(+DEB) D ERROR
	7845	"RTN","RCC PCML",191, 0)
	7846	Q
	7847	"RTN","RCC PCML1")
	7848	0^13^B8980 051^B66823 35
	7849	"RTN","RCC PCML1",1,0 )
	7850	RCCPCML1 ; ALB@ALTOON A,PA/LDB - Send CCPC transmiss ion (cont. );8/25/00 4:16 PM
	7851	"RTN","RCC PCML1",2,0 )
	7852	V ;;4.5;Ac counts Rec eivable; 160,313; Mar 20, 19 95;Build 1 24
	7853	"RTN","RCC PCML1",3,0 )
	7854	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7855	"RTN","RCC PCML1",4,0 )
	7856	ERRML ;ERR OR MESSAGE S
	7857	"RTN","RCC PCML1",5,0 )
	7858	N CT,ERRO R,LN,PT,SP ,XMDUZ,XMT EXT,XMSUB, XMY
	7859	"RTN","RCC PCML1",6,0 )
	7860	K ^TMP($J ,"ERRMSG")
	7861	"RTN","RCC PCML1",7,0 )
	7862	S (ERROR, LN)=0 F S ERROR=$O( ^TMP($J,"E RROR",ERRO R)) Q:'ERR OR D
	7863	"RTN","RCC PCML1",8,0 )
	7864	. ; PRCA* 4.5*313 - Add header identifyi ng the Sta tement Dat e
	7865	"RTN","RCC PCML1",9,0 )
	7866	. I LN=0 S LN=LN+1 D
	7867	"RTN","RCC PCML1",10, 0)
	7868	. . N Y
	7869	"RTN","RCC PCML1",11, 0)
	7870	. . S Y=S DT X ^DD(" DD")
	7871	"RTN","RCC PCML1",12, 0)
	7872	. . S ^TM P($J,"ERRM SG",LN)="E RRORS FOR PATIENT ST ATEMENT DA TE: "_Y
	7873	"RTN","RCC PCML1",13, 0)
	7874	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	7875	"RTN","RCC PCML1",14, 0)
	7876	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=$P($T (ERRMSG+ER ROR),";;", 2)
	7877	"RTN","RCC PCML1",15, 0)
	7878	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	7879	"RTN","RCC PCML1",16, 0)
	7880	.S CT=0,P T="" F S PT=$O(^TMP ($J,"ERROR ",ERROR,PT )) Q:PT="" D
	7881	"RTN","RCC PCML1",17, 0)
	7882	..S CT=CT +1,LN=LN+1
	7883	"RTN","RCC PCML1",18, 0)
	7884	..I PT=0 S ^TMP($J, "ERRMSG",L N)=" " Q
	7885	"RTN","RCC PCML1",19, 0)
	7886	..N Y I P T'=0 D
	7887	"RTN","RCC PCML1",20, 0)
	7888	...S PT(1 )="" F S PT(1)=$O(^ TMP($J,"ER ROR",ERROR ,PT,PT(1)) ) Q:PT(1)= "" D
	7889	"RTN","RCC PCML1",21, 0)
	7890	....S ^TM P($J,"ERRM SG",LN)=$S ($L(CT)<2: " "_CT,1:C T)_". "
	7891	"RTN","RCC PCML1",22, 0)
	7892	....S SP= " ",Y=PT,Y= PT_$E(SP,$ L(PT),30)
	7893	"RTN","RCC PCML1",23, 0)
	7894	....S ^TM P($J,"ERRM SG",LN)=^T MP($J,"ERR MSG",LN)_Y _PT(1)
	7895	"RTN","RCC PCML1",24, 0)
	7896	S XMDUZ=" AR PACKAGE "
	7897	"RTN","RCC PCML1",25, 0)
	7898	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= ""
	7899	"RTN","RCC PCML1",26, 0)
	7900	E S XMY( $G(DUZ))=" "
	7901	"RTN","RCC PCML1",27, 0)
	7902	; PRCA4. 5313 - Ch ange CCPC to CBSS an d add Stat ement Date
	7903	"RTN","RCC PCML1",28, 0)
	7904	N Y S Y=S DT D DD^%D T S SDT=Y
	7905	"RTN","RCC PCML1",29, 0)
	7906	S XMSUB=" CBSS ERROR S FOUND DU RING TRANS MISSION"
	7907	"RTN","RCC PCML1",30, 0)
	7908	S XMTEXT= "^TMP($J," "ERRMSG"", "
	7909	"RTN","RCC PCML1",31, 0)
	7910	D ^XMD
	7911	"RTN","RCC PCML1",32, 0)
	7912	K ^TMP($J ,"ERRMSG")
	7913	"RTN","RCC PCML1",33, 0)
	7914	Q
	7915	"RTN","RCC PCML1",34, 0)
	7916	;
	7917	"RTN","RCC PCML1",35, 0)
	7918	ERRMSG ;E rror messa ges PRCA 4.5313 - Change CC PC to CBSS
	7919	"RTN","RCC PCML1",36, 0)
	7920	1 ;;CBSS t ransmissio n process found no r ecords or an incompl ete file. Contact I
	7921	RM.
	7922	"RTN","RCC PCML1",37, 0)
	7923	2 ;;No CBS S transmis sion recor ds transmi tted. Chec k file 349 . Contact IRM.
	7924	"RTN","RCC PCML1",38, 0)
	7925	3 ;;Corrup ted PH seg ment has b een encoun tered for the follow ing patien t(s):
	7926	"RTN","RCC PCML1",39, 0)
	7927	4 ;;No key field in CBSS file for the fo llowing pa tient(s):
	7928	"RTN","RCC PCML1",40, 0)
	7929	5 ;;Mailma n message creation a borted. Pl ease conta ct IRM.
	7930	"RTN","RCC PCML1",41, 0)
	7931	6 ;;No tra nsmission sent. Defi ne REMOTE DOMAIN in AR TRANSMI SSION TYPE file (34
	7932	9.1).
	7933	"RTN","RCC PCML1",42, 0)
	7934	7 ;;Print Acknowledg ements exi st. Transm ission can not be res ent.
	7935	"RTN","RCC PCML1",43, 0)
	7936	8 ;;Addres s informat ion is mis sing for t he followi ng patient (s):
	7937	"RTN","RCC PCML1",44, 0)
	7938	9 ;;Addres s is marke d as ADDRE SS UNKNOWN for the f ollowing p atient(s):
	7939	"RTN","RCC PCML1",45, 0)
	7940	10 ;;Corru pted Addre ss. Re-ent er address informati on for the following patient(
	7941	s):
	7942	"RTN","RCC PCML1",46, 0)
	7943	11 ;;File did not bu ild or tra nsmit due to another build or transmissi on runnin
	7944	g.
	7945	"RTN","RCC PCPS")
	7946	0^10^B1314 32714^B808 98915
	7947	"RTN","RCC PCPS",1,0)
	7948	RCCPCPS ;W ASH-ISC@AL TOONA,PA/N YB-Build P atient Sta tement Fil e ;12/19/9 6 4:14 P
	7949	M
	7950	"RTN","RCC PCPS",2,0)
	7951	;;4.5;Acc ounts Rece ivable;**3 4,70,80,48 ,104,116,1 49,170,181 ,190,223,2 37,219,26
	7952	5,301,313* *;Mar 20,1 995;Build 124
	7953	"RTN","RCC PCPS",3,0)
	7954	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	7955	"RTN","RCC PCPS",4,0)
	7956	EN(SDT) ; PRCA4.5 313 - For use when c alled by B ackground Job
	7957	"RTN","RCC PCPS",5,0)
	7958	;
	7959	"RTN","RCC PCPS",6,0)
	7960	EN1 ;FOR U SE WHEN BU ILDING PS FILE (SDT MUST BE AV AILABLE AS A LOCAL V ARIABLE)
	7961	"RTN","RCC PCPS",7,0)
	7962	N CCPC,CN T,DAT,DEB, DIK,END,IN ADFL,LDT1, LDT3,PCC,P RN,RCDATE, RCT,SVADM, SVAMT,SVI
	7963	NT,SVOTH,S ITE,TXT,VA R,X,%,REP, ERROR,NM
	7964	"RTN","RCC PCPS",8,0)
	7965	N RCINFUL L,RCINPART S COMM=0
	7966	"RTN","RCC PCPS",9,0)
	7967	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	7968	"RTN","RCC PCPS",10,0 )
	7969	L +^RCPS( 349.2):DIL OCKTM I '$ T D Q
	7970	"RTN","RCC PCPS",11,0 )
	7971	. D NOW^% DTC S Y=% D DD^%DT
	7972	"RTN","RCC PCPS",12,0 )
	7973	. W Y W ! !,"Another date is b eing run o r transmit ted. Try again late r."
	7974	"RTN","RCC PCPS",13,0 )
	7975	. S ERROR =11,NM=0 D ERROR^RCC PCML,ERRML ^RCCPCML1
	7976	"RTN","RCC PCPS",14,0 )
	7977	; PRCA4. 5313 - Cl ear data f or date be ing create d
	7978	"RTN","RCC PCPS",15,0 )
	7979	D KILL^RC CPCPS1(SDT )
	7980	"RTN","RCC PCPS",16,0 )
	7981	; PRCA4. 5313 - Se t date to a month ag o and kill data for that date
	7982	"RTN","RCC PCPS",17,0 )
	7983	N OLDDT
	7984	"RTN","RCC PCPS",18,0 )
	7985	S OLDDT=$ $MONTHAGO^ RCCPCPS1(S DT)
	7986	"RTN","RCC PCPS",19,0 )
	7987	; PRCA4. 5313 - Mo ved to KIL L^RCCPCPS1
	7988	"RTN","RCC PCPS",20,0 )
	7989	D KILL^RC CPCPS1(OLD DT)
	7990	"RTN","RCC PCPS",21,0 )
	7991	;
	7992	"RTN","RCC PCPS",22,0 )
	7993	D DT^DICR W,SITE^PRC AGU
	7994	"RTN","RCC PCPS",23,0 )
	7995	I '$D(SIT E) W !!,"A R SITE PAR AMETER ENT RIES NOT D EFINED!",? 50 D Q
	7996	"RTN","RCC PCPS",24,0 )
	7997	. D NOW^% DTC S Y=% D DD^%DT W Y
	7998	"RTN","RCC PCPS",25,0 )
	7999	. W !!,"C OULD NOT P ROCESS AR PATIENT ST ATEMENTS"
	8000	"RTN","RCC PCPS",26,0 )
	8001	. ; PRCA* 4.5*313 - Unlock pri or to exit ing
	8002	"RTN","RCC PCPS",27,0 )
	8003	. L -^RCP S(349.2):D ILOCKTM
	8004	"RTN","RCC PCPS",28,0 )
	8005	;
	8006	"RTN","RCC PCPS",29,0 )
	8007	; PRCA4. 5313 - Cl ear ICN Er ror tempor ary storag e
	8008	"RTN","RCC PCPS",30,0 )
	8009	K ^TMP("I CNERROR",$ J)
	8010	"RTN","RCC PCPS",31,0 )
	8011	D NOW^%DT C S END=%
	8012	"RTN","RCC PCPS",32,0 )
	8013	S LDT1=$$ FPS^RCAMFN 01(DT,-1), RCDATE=DT
	8014	"RTN","RCC PCPS",33,0 )
	8015	S (CNT,DE B)=0,PRN=1
	8016	"RTN","RCC PCPS",34,0 )
	8017	F S DEB= $O(^RCD(34 0,"AC",+$E (SDT,6,7), DEB)) Q:DE B="" I $D (^RCD(340, "AB","DPT
	8018	(",DEB)) D
	8019	"RTN","RCC PCPS",35,0 )
	8020	. N AMT ,BBAL,BEG, BN,CAT,DES C,ETY,FC,N D,PAT,PBAL ,PC,PSIEN
	8021	"RTN","RCC PCPS",36,0 )
	8022	. N PDA T,PEND,ST, SVINT,SVAD M,SVOTH,AD DR,ARFLAG, DIC,FLBPD1 ,ICN
	8023	"RTN","RCC PCPS",37,0 )
	8024	. I $L( +$$SSN^RCF N01(DEB))< 5 Q
	8025	"RTN","RCC PCPS",38,0 )
	8026	. ;Chec k for Emer gency Resp onse Indic ator (ERI) Flag.
	8027	"RTN","RCC PCPS",39,0 )
	8028	. N RCD FN S RCDFN =+($P($G(^ RCD(340,DE B,0)),"^", 1)) I $$EM ERES^PRCAU TL(RCDFN)
	8029	]"" Q
	8030	"RTN","RCC PCPS",40,0 )
	8031	. ; ini tialize va riables fo r CS - PRC A4.5301
	8032	"RTN","RCC PCPS",41,0 )
	8033	. N CSB B,CSTCH,CS TPC,CSPREV S (CSBB,C STCH,CSTPC )=0
	8034	"RTN","RCC PCPS",42,0 )
	8035	. ; PRC A^4.5*313 - If ICN i s null set to send e rror email
	8036	"RTN","RCC PCPS",43,0 )
	8037	. S ICN =$$GETICN^ MPIF001(RC DFN)
	8038	"RTN","RCC PCPS",44,0 )
	8039	. I $P( ICN,U)=-1 S ^TMP("IC NERROR",$J ,RCDFN)="" Q
	8040	"RTN","RCC PCPS",45,0 )
	8041	. S FLB PD1=$$FLBP D1
	8042	"RTN","RCC PCPS",46,0 )
	8043	. I FLB PD1="" Q
	8044	"RTN","RCC PCPS",47,0 )
	8045	. I $P( ^PRCA(430, FLBPD1,0), U,10)="" Q
	8046	"RTN","RCC PCPS",48,0 )
	8047	. S INA DFL=0
	8048	"RTN","RCC PCPS",49,0 )
	8049	. S (SV ADM,SVAMT, SVINT,SVOT H)=0
	8050	"RTN","RCC PCPS",50,0 )
	8051	. N REF ,SBAL,TBAL ,TN,TTY,X, Y
	8052	"RTN","RCC PCPS",51,0 )
	8053	. K ^TM P("PRCAGT" ,$J)
	8054	"RTN","RCC PCPS",52,0 )
	8055	. S BEG =+$$LST^RC FN01(DEB,2 )
	8056	"RTN","RCC PCPS",53,0 )
	8057	. S LDT 3=$S(BEG>0 :$$FPS^RCA MFN01($P(B EG,"."),-3 ),1:0)
	8058	"RTN","RCC PCPS",54,0 )
	8059	. I $P( BEG,".")'< $P(RCDATE, ".") Q
	8060	"RTN","RCC PCPS",55,0 )
	8061	. D NOW ^%DTC S EN D=%
	8062	"RTN","RCC PCPS",56,0 )
	8063	. I BEG <1 S PDAT= "",BEG=0,P BAL=0
	8064	"RTN","RCC PCPS",57,0 )
	8065	. I BEG S PDAT=BE G,BEG=9999 999.999999 -BEG,PBAL= 0 D PBAL^P RCAGU(DEB, .BEG,.PBA
	8066	L) ;get pr ev bal
	8067	"RTN","RCC PCPS",58,0 )
	8068	. D EN^ PRCAGT(DEB ,BEG,.END)
	8069	"RTN","RCC PCPS",59,0 )
	8070	. S TBA L=0 D TBAL ^PRCAGT(DE B,.TBAL) ; get trans bal
	8071	"RTN","RCC PCPS",60,0 )
	8072	. S BBA L=0 D BBAL ^PRCAGU(DE B,.BBAL) ; get bill b al
	8073	"RTN","RCC PCPS",61,0 )
	8074	. ; ent ire accoun t has been referred to CS - PR CA4.5301
	8075	"RTN","RCC PCPS",62,0 )
	8076	. I CSB B,CSBB'<BB AL Q
	8077	"RTN","RCC PCPS",63,0 )
	8078	. S X=$ $PRE^PRCAG U(DEB) S P END=$P(X,U ,2),X=+X I X,BBAL D REF^PRCAGD (DEB,X,$G
	8079	(REP)) Q
	8080	"RTN","RCC PCPS",64,0 )
	8081	. I BBA L=0,PEND,- PEND=PBAL+ TBAL Q
	8082	"RTN","RCC PCPS",65,0 )
	8083	. I BBA L'=(PBAL+T BAL) D EN^ PRCAGD(DEB ,BBAL,TBAL ,PBAL,BEG, $G(REP)) Q
	8084	"RTN","RCC PCPS",66,0 )
	8085	. I BBA L'>0,'$D(^ TMP("PRCAG T",$J,DEB) ) Q
	8086	"RTN","RCC PCPS",67,0 )
	8087	. I BBA L=0,$G(SIT E("ZERO")) Q
	8088	"RTN","RCC PCPS",68,0 )
	8089	. I BBA L<0,BBAL>- .99 Q
	8090	"RTN","RCC PCPS",69,0 )
	8091	. I BBA L'<0,'$D(^ XTMP("PRCA GU",$J,DEB )),'COMM Q ;third l etter prin ted,not c
	8092	omment
	8093	"RTN","RCC PCPS",70,0 )
	8094	. S TBA L=TBAL+PBA L
	8095	"RTN","RCC PCPS",71,0 )
	8096	. ;adju st amounts to be fil ed in 349. 2 for CS b ills - PRC A4.5301
	8097	"RTN","RCC PCPS",72,0 )
	8098	. S TBA L=TBAL-CSB B ; reduce the total bill bala nce by CS balance
	8099	"RTN","RCC PCPS",73,0 )
	8100	. S CSP REV=CSBB-( CSTCH+CSTP C) ; compu te the CS previous b alance as the diffe
	8101	rence betw een the bi ll balance and the t ransaction balance
	8102	"RTN","RCC PCPS",74,0 )
	8103	. S PBA L=PBAL-CSP REV ; redu ce the pre vious bala nce by the CS previo us balanc
	8104	e
	8105	"RTN","RCC PCPS",75,0 )
	8106	. S TBA L("CH")=TB AL("CH")-C STCH ; red uce total charges by CS charge s
	8107	"RTN","RCC PCPS",76,0 )
	8108	. S TBA L("PC")=TB AL("PC")-C STPC ; red uce total credits by CS credit s
	8109	"RTN","RCC PCPS",77,0 )
	8110	. ;
	8111	"RTN","RCC PCPS",78,0 )
	8112	. I '$D (^RCPS(349 .2,0)) S ^ (0)="AR CB SS STATEME NTS^349.2I ^^"
	8113	"RTN","RCC PCPS",79,0 )
	8114	. S DIC ="^RCPS(34 9.2,",X=DE B,DA=.01,D IC(0)="" D FILE^DICN
	8115	"RTN","RCC PCPS",80,0 )
	8116	. S PSI EN=+Y
	8117	"RTN","RCC PCPS",81,0 )
	8118	. S ^RC PS(349.2,P SIEN,0)=DE B_"^"_$$SS N^RCFN01(D EB)_"^"
	8119	"RTN","RCC PCPS",82,0 )
	8120	. S ADD R=$$DADD^R CAMADD(DEB ,1) ;get p atient's a ddress, co nfidential if appli
	8121	cable
	8122	"RTN","RCC PCPS",83,0 )
	8123	. S ARF LAG="N" N X
	8124	"RTN","RCC PCPS",84,0 )
	8125	. S X=$ P($G(^RCD( 340,DEB,1) ),U,1,6) I ($P(X,U)' =""),($P(X ,U,4)'="") ,($P(X,U,
	8126	5)'=""),(( $P(X,U,6)' ="")) S AR FLAG="Y"
	8127	"RTN","RCC PCPS",85,0 )
	8128	. S ^RC PS(349.2,P SIEN,1)=$P (ADDR,"^", 1,6)
	8129	"RTN","RCC PCPS",86,0 )
	8130	. S ST= $P(ADDR,"^ ",5)
	8131	"RTN","RCC PCPS",87,0 )
	8132	. S ^RC PS(349.2,P SIEN,7)=$P (^RCD(340, DEB,0),U,7 ) ;large p rint
	8133	"RTN","RCC PCPS",88,0 )
	8134	. ; PRC A4.5313 - Add four new eleme nts for CB SS
	8135	"RTN","RCC PCPS",89,0 )
	8136	. S $P( ^RCPS(349. 2,PSIEN,8) ,U)=$P(ICN ,"V")
	8137	"RTN","RCC PCPS",90,0 )
	8138	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,2)=$P(I CN,"V",2)
	8139	"RTN","RCC PCPS",91,0 )
	8140	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,3)=ARFL AG
	8141	"RTN","RCC PCPS",92,0 )
	8142	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,4)=""
	8143	"RTN","RCC PCPS",93,0 )
	8144	. I FLB PD1 S $P(^ RCPS(349.2 ,PSIEN,8), U,4)=$P(^P RCA(430,FL BPD1,0),U, 10)
	8145	"RTN","RCC PCPS",94,0 )
	8146	. I $G( ST)'="" S ST=$O(^DIC (5,"C",ST, 0))
	8147	"RTN","RCC PCPS",95,0 )
	8148	. I $G( ST)>90,'$P ($G(^DIC(5 ,ST,0)),"^ ",6) S FC= $P($G(^DIC (5,ST,0)), "^")
	8149	"RTN","RCC PCPS",96,0 )
	8150	. S $P( ^RCPS(349. 2,PSIEN,1) ,"^",7)=$G (FC) S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1
	8151	),"^",5)=" FX"
	8152	"RTN","RCC PCPS",97,0 )
	8153	. S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1) ,"^",6)=$P (ADDR,"^", 8)
	8154	"RTN","RCC PCPS",98,0 )
	8155	. D NOW ^%DTC S $P (^RCPS(349 .2,PSIEN,0 ),"^",10)= %
	8156	"RTN","RCC PCPS",99,0 )
	8157	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",3)=$$ NAM^RCFN01 (DEB)
	8158	"RTN","RCC PCPS",100, 0)
	8159	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",4,7)= $S(TBAL'>0 :0,1:TBAL) _"^"_PBAL_ "^"_TBAL(
	8160	"CH")_"^"_ TBAL("PC") ,$P(^(0)," ^",8)=PBAL +TBAL("CH" )+TBAL("PC ")+TBAL("R F")
	8161	"RTN","RCC PCPS",101, 0)
	8162	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",13,17 )=BBAL("PB ")_"^"_BBA L("INT")_" ^"_BBAL("
	8163	ADM")_"^"_ BBAL("MF") _"^"_BBAL( "CT")
	8164	"RTN","RCC PCPS",102, 0)
	8165	. ;
	8166	"RTN","RCC PCPS",103, 0)
	8167	. N RCB ILLDA,RCDA TA1,RCDEBT DA,RCDESC, RCPSDA,RCT OTAL,RCTRA NDA,RCTRDA TE,VALUE,
	8168	RCCOM1,RCC OM2,RCCOM3
	8169	"RTN","RCC PCPS",104, 0)
	8170	. S RCD EBTDA=DEB
	8171	"RTN","RCC PCPS",105, 0)
	8172	. I '$D (^RCPS(349 .2,PSIEN,2 ,0)) S ^(0 )="^^^"
	8173	"RTN","RCC PCPS",106, 0)
	8174	. ;
	8175	"RTN","RCC PCPS",107, 0)
	8176	. S RCC OM1=$E($TR ($G(SITE(" COM1")),"~ \|^",""),1, 80),(RCCOM 2,RCCOM3)= ""
	8177	"RTN","RCC PCPS",108, 0)
	8178	. ; Add second co mment line for the G MT-reduced status
	8179	"RTN","RCC PCPS",109, 0)
	8180	. I $$G MT^PRCAGST (RCDEBTDA) S RCCOM2= "REDUCTION OF INPATI ENT COPAYM ENT DUE T
	8181	O GEOGRAPH IC MEANS T EST STATUS "
	8182	"RTN","RCC PCPS",110, 0)
	8183	. I TBA L'>0 S RCC OM3=" THI S IS NOT A BILL"
	8184	"RTN","RCC PCPS",111, 0)
	8185	. I RCC OM1'="",RC COM2'="" S $E(RCCOM1 ,80)=" " ; Make sure GMT messag e will be
	8186	printed o n separate line.
	8187	"RTN","RCC PCPS",112, 0)
	8188	. S ^RC PS(349.2,P SIEN,3)=RC COM1_RCCOM 2_RCCOM3
	8189	"RTN","RCC PCPS",113, 0)
	8190	. ;
	8191	"RTN","RCC PCPS",114, 0)
	8192	. S RCP SDA=0 ; th is variabl e used to set the de scription on the PS segment
	8193	"RTN","RCC PCPS",115, 0)
	8194	. S RCT RDATE=0 F S RCTRDAT E=$O(^TMP( "PRCAGT",$ J,RCDEBTDA ,RCTRDATE) ) Q:'RCTR
	8195	DATE S RC BILLDA=0 F S RCBILL DA=$O(^TMP ("PRCAGT", $J,RCDEBTD A,RCTRDATE ,RCBILLDA
	8196	)) Q:'RCBI LLDA D
	8197	"RTN","RCC PCPS",116, 0)
	8198	. . ; skip CS b ills/trans actions - PRCA4.53 01
	8199	"RTN","RCC PCPS",117, 0)
	8200	. . Q :$D(^PRCA( 430,"TCSP" ,RCBILLDA) )
	8201	"RTN","RCC PCPS",118, 0)
	8202	. . I $P($G(^RC PS(349.2,P SIEN,0))," ^",8)<0 S PC(75)=75
	8203	"RTN","RCC PCPS",119, 0)
	8204	. . I $P($G(^PR CA(430,RCB ILLDA,6)), "^",2)]"", ($P($G(^PR CA(430,RCB ILLDA,7))
	8205	,"^")>0) S PC(1)="01 "
	8206	"RTN","RCC PCPS",120, 0)
	8207	. . S CAT=$P($G (^PRCA(430 ,RCBILLDA, 0)),"^",2)
	8208	"RTN","RCC PCPS",121, 0)
	8209	. . S PC=$P($G( ^PRCA(430. 2,CAT,0)), "^",14)
	8210	"RTN","RCC PCPS",122, 0)
	8211	. . F X=1:1:100 I $P(PC," ,",X)'="" S PCC=$P(P C,",",X),P C(+PCC)=PC C Q:PCC="
	8212	"
	8213	"RTN","RCC PCPS",123, 0)
	8214	. . S PC="",X=0 F S X=$O (PC(X)) Q: X="" I $G (PC(X))'=" " S PC=PC_ PC(X)
	8215	"RTN","RCC PCPS",124, 0)
	8216	. . S $P(^RCPS( 349.2,PSIE N,4),"^")= PC
	8217	"RTN","RCC PCPS",125, 0)
	8218	. . ;
	8219	"RTN","RCC PCPS",126, 0)
	8220	. . I $D(^TMP(" PRCAGT",$J ,RCDEBTDA, RCTRDATE,R CBILLDA,0) ) S AMT=+^ (0) I AMT
	8221	D
	8222	"RTN","RCC PCPS",127, 0)
	8223	. . . ; get the descri ption for the bill
	8224	"RTN","RCC PCPS",128, 0)
	8225	. . . K RCDES C D BILLDE SC^RCCPCPS 1(RCBILLDA )
	8226	"RTN","RCC PCPS",129, 0)
	8227	. . . ;
	8228	"RTN","RCC PCPS",130, 0)
	8229	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	8230	"RTN","RCC PCPS",131, 0)
	8231	. . . S RCPSD A=RCPSDA+1
	8232	"RTN","RCC PCPS",132, 0)
	8233	. . . S $P(^R CPS(349.2, PSIEN,2,RC PSDA,0),"^ ",1,4)=$P( RCTRDATE," .")_"^"_$
	8234	G(RCDESC(1 ))_"^"_$G( AMT)_"^"_$ P($G(^PRCA (430,RCBIL LDA,0)),"^ ")
	8235	"RTN","RCC PCPS",133, 0)
	8236	. . . F X=2:1 Q:$G(RCDE SC(X))="" S RCPSDA= RCPSDA+1,^ RCPS(349.2 ,PSIEN,2,
	8237	RCPSDA,0)= "^"_RCDESC (X)_"^^"
	8238	"RTN","RCC PCPS",134, 0)
	8239	. . ;
	8240	"RTN","RCC PCPS",135, 0)
	8241	. . S RCTRANDA= 0 F S RCT RANDA=$O(^ TMP("PRCAG T",$J,RCDE BTDA,RCTRD ATE,RCBIL
	8242	LDA,RCTRAN DA)) D:'RC TRANDA NO Q:'RCTRAND A D
	8243	"RTN","RCC PCPS",136, 0)
	8244	. . . ; get the descri ption for the transa ction
	8245	"RTN","RCC PCPS",137, 0)
	8246	. . . K RCDES C D TRANDE SC^RCCPCPS 1(RCTRANDA ),RCDESC
	8247	"RTN","RCC PCPS",138, 0)
	8248	. . . ; if i t is an in terest/adm in charge, summarize it below
	8249	"RTN","RCC PCPS",139, 0)
	8250	. . . I $G(RC DESC(1))[" INTEREST" Q
	8251	"RTN","RCC PCPS",140, 0)
	8252	. . . ; get the value of the tra nsaction f or the sta tement
	8253	"RTN","RCC PCPS",141, 0)
	8254	. . . S VALUE =$$TRANVAL U^RCDPBTLM (RCTRANDA)
	8255	"RTN","RCC PCPS",142, 0)
	8256	. . . S VALUE =$P(VALUE, "^",2)+$P( VALUE,"^", 3)+$P(VALU E,"^",4)+$ P(VALUE,"
	8257	^",5)+$P(V ALUE,"^",6 )
	8258	"RTN","RCC PCPS",143, 0)
	8259	. . . ; if i t is a sus pended (47 ) or unsus pended (46 ) transact ion, show
	8260	value
	8261	"RTN","RCC PCPS",144, 0)
	8262	. . . ; make suspended charges a ppear as n egative
	8263	"RTN","RCC PCPS",145, 0)
	8264	. . . S RCDAT A1=$G(^PRC A(433,RCTR ANDA,1))
	8265	"RTN","RCC PCPS",146, 0)
	8266	. . . I $P(RC DATA1,"^", 2)=47!($P( RCDATA1,"^ ",2)=46) S VALUE=$P( RCDATA1,"
	8267	^",5) I $P (RCDATA1," ^",2)=47 S VALUE=-VA LUE
	8268	"RTN","RCC PCPS",147, 0)
	8269	. . . ; if i t is an am ended bill , show val ue
	8270	"RTN","RCC PCPS",148, 0)
	8271	. . . I $P(RC DATA1,"^", 2)=33 S VA LUE=$P(RCD ATA1,"^",5 )
	8272	"RTN","RCC PCPS",149, 0)
	8273	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	8274	"RTN","RCC PCPS",150, 0)
	8275	. . . S RCPSD A=RCPSDA+1
	8276	"RTN","RCC PCPS",151, 0)
	8277	. . . S $P(^R CPS(349.2, PSIEN,2,RC PSDA,0),"^ ",1,5)=$P( RCTRDATE," .")_"^"_$
	8278	G(RCDESC(1 ))_"^"_VAL UE_"^"_$P( $G(^PRCA(4 30,RCBILLD A,0)),"^")
	8279	"RTN","RCC PCPS",152, 0)
	8280	. . . F X=2:1 Q:$G(RCDE SC(X))="" S RCPSDA= RCPSDA+1,^ RCPS(349.2 ,PSIEN,2,
	8281	RCPSDA,0)= "^"_RCDESC (X)_"^^"
	8282	"RTN","RCC PCPS",153, 0)
	8283	. . . ;
	8284	"RTN","RCC PCPS",154, 0)
	8285	. . . ; for comment tr ansaction ... not su re what th is is for ?
	8286	"RTN","RCC PCPS",155, 0)
	8287	. . . I $P(RC DATA1,"^", 2)=45,$P($ G(^PRCA(43 3,RCTRANDA ,5)),"^",2 )["your w
	8288	aiver righ ts" S ^RCP S(349.2,PS IEN,4)="01 50"
	8289	"RTN","RCC PCPS",156, 0)
	8290	. ;
	8291	"RTN","RCC PCPS",157, 0)
	8292	. ; if interest, admin, or other, ad d them her e
	8293	"RTN","RCC PCPS",158, 0)
	8294	. S X=$ G(RCTOTAL( "INT"))+$G (RCTOTAL(" ADM"))+$G( RCTOTAL("O TH"))
	8295	"RTN","RCC PCPS",159, 0)
	8296	. I X>0 D
	8297	"RTN","RCC PCPS",160, 0)
	8298	. . S RCDESC="I NTEREST/AD M. CHARGE (Int:"_$J( $G(RCTOTAL ("INT")),1 ,2)_" Adm
	8299	:"_$J($G(R CTOTAL("AD M")),1,2)_ " Other:"_ $J($G(RCTO TAL("OTH") ),1,2)_")"
	8300	"RTN","RCC PCPS",161, 0)
	8301	. . S RCPSDA=RC PSDA+1
	8302	"RTN","RCC PCPS",162, 0)
	8303	. . S ^RCPS(349 .2,PSIEN,2 ,RCPSDA,0) ="^"_RCDES C_"^"_$J(X ,1,2)
	8304	"RTN","RCC PCPS",163, 0)
	8305	. . S ^RCPS(349 .2,PSIEN,2 ,0)="^^"_R CPSDA_"^"_ RCPSDA
	8306	"RTN","RCC PCPS",164, 0)
	8307	. ;
	8308	"RTN","RCC PCPS",165, 0)
	8309	. ; PRC A4.5313 - Set stat ement date into cros s-referenc e
	8310	"RTN","RCC PCPS",166, 0)
	8311	. S $P( ^RCPS(349. 2,PSIEN,0) ,U,19)=SDT
	8312	"RTN","RCC PCPS",167, 0)
	8313	. ;
	8314	"RTN","RCC PCPS",168, 0)
	8315	. ; se t 0th node
	8316	"RTN","RCC PCPS",169, 0)
	8317	. I RCP SDA S ^RCP S(349.2,PS IEN,2,0)=" ^^"_RCPSDA _"^"_RCPSD A
	8318	"RTN","RCC PCPS",170, 0)
	8319	. ;
	8320	"RTN","RCC PCPS",171, 0)
	8321	. ; PRC A4.5313 - Set Cros s-Referenc es for thi s Debtor
	8322	"RTN","RCC PCPS",172, 0)
	8323	. S DA= PSIEN,DIK= "^RCPS(349 .2," D IX1 ^DIK
	8324	"RTN","RCC PCPS",173, 0)
	8325	. ;
	8326	"RTN","RCC PCPS",174, 0)
	8327	. ; PRC A4.5313 - Remove d ata for ea ch debtor
	8328	"RTN","RCC PCPS",175, 0)
	8329	. K ^XT MP("PRCAGU ",$J,DEB)
	8330	"RTN","RCC PCPS",176, 0)
	8331	. ;
	8332	"RTN","RCC PCPS",177, 0)
	8333	. I RCP SDA'<287 S ^XTMP("RC CPC",0)=DT ,(^XTMP("R CCPC",RCDE BTDA),^XTM P("RCCPC1
	8334	",PSIEN))= "" Q
	8335	"RTN","RCC PCPS",178, 0)
	8336	. D NO
	8337	"RTN","RCC PCPS",179, 0)
	8338	;
	8339	"RTN","RCC PCPS",180, 0)
	8340	S PSIEN=0 S PSIEN=$ O(^RCPS(34 9.2,"STDT" ,SDT,PSIEN )) Q:PSIEN ="" S $P( ^RCPS(349
	8341	.2,PSIEN,0 ),"^",18)= 1
	8342	"RTN","RCC PCPS",181, 0)
	8343	;
	8344	"RTN","RCC PCPS",182, 0)
	8345	; PRCA4. 5313 - Se nd ICN Err or email i f necessar y
	8346	"RTN","RCC PCPS",183, 0)
	8347	I $D(^TMP ("ICNERROR ",$J)) D I CNERR^RCCP CPS1 K ^TM P("ICNERRO R",$J)
	8348	"RTN","RCC PCPS",184, 0)
	8349	;
	8350	"RTN","RCC PCPS",185, 0)
	8351	K COMM,TR ,TRNIEN
	8352	"RTN","RCC PCPS",186, 0)
	8353	;
	8354	"RTN","RCC PCPS",187, 0)
	8355	OSTM ;Proc ess old st atements
	8356	"RTN","RCC PCPS",188, 0)
	8357	S DIK="^R CPS(349.2, ",DA=0 F S DA=$O(^X TMP("RCCPC 1",DA)) Q: 'DA D ^DI K
	8358	"RTN","RCC PCPS",189, 0)
	8359	K DA,^XTM P("RCCPC1" )
	8360	"RTN","RCC PCPS",190, 0)
	8361	;
	8362	"RTN","RCC PCPS",191, 0)
	8363	STATMNT ;P rint patie nt stateme nts
	8364	"RTN","RCC PCPS",192, 0)
	8365	N IOP,ZTI O,ZTSAVE,Z TRTN,ZTDES C,ZTASK,%Z IS,ZTDTH,P RCADEV,POP
	8366	"RTN","RCC PCPS",193, 0)
	8367	S (IOP,PR CADEV)=$P( $G(^RC(342 ,1,0)),"^" ,8)
	8368	"RTN","RCC PCPS",194, 0)
	8369	I IOP]"" D
	8370	"RTN","RCC PCPS",195, 0)
	8371	.S ZTRTN= "STM^RCCPC STM",ZTDTH =$H,ZTDESC ="Print ol d AR State ments"
	8372	"RTN","RCC PCPS",196, 0)
	8373	.S %ZIS=" N0" D ^%ZI S Q:POP
	8374	"RTN","RCC PCPS",197, 0)
	8375	.S ZTSAVE ("PRCADEV" )="" D ^%Z TLOAD,^%ZI SC
	8376	"RTN","RCC PCPS",198, 0)
	8377	; PRCA4. 5313 - Un lock prior to exitin g
	8378	"RTN","RCC PCPS",199, 0)
	8379	L -^RCPS( 349.2):DIL OCKTM
	8380	"RTN","RCC PCPS",200, 0)
	8381	Q
	8382	"RTN","RCC PCPS",201, 0)
	8383	;
	8384	"RTN","RCC PCPS",202, 0)
	8385	NO ;If the re is no a ctivity
	8386	"RTN","RCC PCPS",203, 0)
	8387	I $G(^RCP S(349.2,PS IEN,4))["0 150" D
	8388	"RTN","RCC PCPS",204, 0)
	8389	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^NOTICE: Y ou now hav e delinque nt charges . Please^
	8390	^"
	8391	"RTN","RCC PCPS",205, 0)
	8392	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^review En forcement of Involun tary Colle ctions^^"
	8393	"RTN","RCC PCPS",206, 0)
	8394	.S ^RCPS( 349.2,PSIE N,2,3,0)=" ^on revers e.^^"
	8395	"RTN","RCC PCPS",207, 0)
	8396	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 3^3"
	8397	"RTN","RCC PCPS",208, 0)
	8398	I $G(^RCP S(349.2,PS IEN,2,1,0) )="" D
	8399	"RTN","RCC PCPS",209, 0)
	8400	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^No Activi ty in the Last 30 Da ys!^^"
	8401	"RTN","RCC PCPS",210, 0)
	8402	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^Please re fer to pre vious stat ement of r ights.^^"
	8403	"RTN","RCC PCPS",211, 0)
	8404	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 2^2"
	8405	"RTN","RCC PCPS",212, 0)
	8406	.I $G(^RC PS(349.2,P SIEN,4))=" " S ^(4)=" 90"
	8407	"RTN","RCC PCPS",213, 0)
	8408	Q
	8409	"RTN","RCC PCPS",214, 0)
	8410	BUILD ;Thi s is the e ntry point from the BUILD CCPC file opti on
	8411	"RTN","RCC PCPS",215, 0)
	8412	N TDT,QDT ,ZTDESC,ZT ASK,ZTSK,Z DTDTH,ZTIO ,ZTRTN,CNC L,%H,%DT,D IR,DTOUT
	8413	"RTN","RCC PCPS",216, 0)
	8414	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	8415	"RTN","RCC PCPS",217, 0)
	8416	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmi
	8417	tted. Try again lat er." Q
	8418	"RTN","RCC PCPS",218, 0)
	8419	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	8420	"RTN","RCC PCPS",219, 0)
	8421	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8422	"RTN","RCC PCPS",220, 0)
	8423	S DIR(0)= "DAO^^D:"" ,1,2,4,6,7 ,8,10,12,1 4,15,17,19 ,21,22,24, 26,""'[("" ,""_+$E(Y
	8424	,6,7)_""," ") BLDERR^ RCCPCPS"
	8425	"RTN","RCC PCPS",221, 0)
	8426	S DIR("A" )="Enter a Patient S tatement d ate for th is build: "
	8427	"RTN","RCC PCPS",222, 0)
	8428	S DIR("?" )="Enter a Patient S tatement d ate for th is build o r ^ to exi t."
	8429	"RTN","RCC PCPS",223, 0)
	8430	D ^DIR
	8431	"RTN","RCC PCPS",224, 0)
	8432	; PRCA4. 5313 - Un lock prior to quitti ng
	8433	"RTN","RCC PCPS",225, 0)
	8434	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	8435	"RTN","RCC PCPS",226, 0)
	8436	S SDT=Y
	8437	"RTN","RCC PCPS",227, 0)
	8438	S TDT=$O( ^RCPS(349. 2,"STDT",S DT,0)) I T DT D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$
	8439	D(DIROUT) Q
	8440	"RTN","RCC PCPS",228, 0)
	8441	.S TDT=$T R($$SLH^RC FN01(SDT), "/","")
	8442	"RTN","RCC PCPS",229, 0)
	8443	.W *7,!!, "The Patie nt Stateme nts for ", $E(TDT,1,2 )_"/"_$E(T DT,3,4)_"/ "_$E(TDT,
	8444	5,8)
	8445	"RTN","RCC PCPS",230, 0)
	8446	.I $D(^RC T(349,"SDT ",+$E(SDT, 6,7))) D
	8447	"RTN","RCC PCPS",231, 0)
	8448	..S TDT=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",+ $E(SDT,6,7 ),0)),0)," ^",10)
	8449	"RTN","RCC PCPS",232, 0)
	8450	..S TDT=$ TR($$SLH^R CFN01(TDT) ,"/","")
	8451	"RTN","RCC PCPS",233, 0)
	8452	..W " wer e transmit ted on ",$ E(TDT,1,2) _"/"_$E(TD T,3,4)_"/" _$E(TDT,5, 8)_"."
	8453	"RTN","RCC PCPS",234, 0)
	8454	.E W " d o not have a transmi ssion date !"
	8455	"RTN","RCC PCPS",235, 0)
	8456	.W !!,">> PLEASE CO NTACT CUST OMER SUPPO RT BEFORE PROCEEDING <<",!!
	8457	"RTN","RCC PCPS",236, 0)
	8458	.N DIR,DT OUT,DUOUT, DIRUT,DIRO UT
	8459	"RTN","RCC PCPS",237, 0)
	8460	.S DIR(0) ="E",DIR(" A")=" Pres s ENTER to Continue with Build or ^ to E xit" D ^D
	8461	IR
	8462	"RTN","RCC PCPS",238, 0)
	8463	.I $D(DTO UT)!$D(DUO UT)!$D(DIR UT)!$D(DIR OUT) L -^R CPS(349.2) :DILOCKTM Q
	8464	"RTN","RCC PCPS",239, 0)
	8465	; PRCA4. 5313 - Un lock prior to jobbin g off
	8466	"RTN","RCC PCPS",240, 0)
	8467	L -^RCPS( 349.2):DIL OCKTM
	8468	"RTN","RCC PCPS",241, 0)
	8469	I $D(DIRU T) K SDT Q
	8470	"RTN","RCC PCPS",242, 0)
	8471	TIME S ZTI O="",ZTRTN ="EN1^RCCP CPS",ZTDES C="Build C BSS Statem ent File"
	8472	"RTN","RCC PCPS",243, 0)
	8473	S ZTDTH=" ",ZTSAVE(" SDT")=SDT D ^%ZTLOAD Q:$G(ZTSK )=""
	8474	"RTN","RCC PCPS",244, 0)
	8475	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	8476	"RTN","RCC PCPS",245, 0)
	8477	; PRCA5. 4313 - Al low run an y time
	8478	"RTN","RCC PCPS",246, 0)
	8479	;I (QDT>D T_"."_0800 )&(QDT<(DT _"."_1801) ) D G TIM E
	8480	"RTN","RCC PCPS",247, 0)
	8481	;.W !!,*7 ,"You Can Not Queue this Job B etween 8:0 0am and 6: 00pm.",!
	8482	"RTN","RCC PCPS",248, 0)
	8483	;.D KILL^ %ZTLOAD
	8484	"RTN","RCC PCPS",249, 0)
	8485	W !,"Queu ed for Bui lding."
	8486	"RTN","RCC PCPS",250, 0)
	8487	; PRCA4. 5313 - Un lock prior to quitti ng
	8488	"RTN","RCC PCPS",251, 0)
	8489	L -^RCPS( 349.2):DIL OCKTM
	8490	"RTN","RCC PCPS",252, 0)
	8491	Q
	8492	"RTN","RCC PCPS",253, 0)
	8493	;
	8494	"RTN","RCC PCPS",254, 0)
	8495	RCDESC ;Re move "IN P ART" & "IN FULL" fro m the the bill descr iption
	8496	"RTN","RCC PCPS",255, 0)
	8497	QUIT:$G(R CDESC(1))= ""
	8498	"RTN","RCC PCPS",256, 0)
	8499	S RCINFUL L=" (IN FU LL)"
	8500	"RTN","RCC PCPS",257, 0)
	8501	S RCINPAR T=" (IN PA RT)"
	8502	"RTN","RCC PCPS",258, 0)
	8503	I RCDESC( 1)[RCINFUL L S RCDESC (1)=$P(RCD ESC(1),RCI NFULL)_$P( RCDESC(1), RCINFULL,
	8504	2)
	8505	"RTN","RCC PCPS",259, 0)
	8506	I RCDESC( 1)[RCINPAR T S RCDESC (1)=$P(RCD ESC(1),RCI NPART)_$P( RCDESC(1), RCINPART,
	8507	2)
	8508	"RTN","RCC PCPS",260, 0)
	8509	Q
	8510	"RTN","RCC PCPS",261, 0)
	8511	FLBPD1() ; PRCA4.5 313 - Retu rn last bi ll prep da te
	8512	"RTN","RCC PCPS",262, 0)
	8513	N X1,X2 S X1="" I ' $D(^PRCA(4 30,"ATD",R CDFN)) Q X 1
	8514	"RTN","RCC PCPS",263, 0)
	8515	S X2=$O(^ PRCA(430," ATD",RCDFN ,X1),-1)
	8516	"RTN","RCC PCPS",264, 0)
	8517	S X1=$O(^ PRCA(430," ATD",RCDFN ,X2,X1),-1 )
	8518	"RTN","RCC PCPS",265, 0)
	8519	Q X1
	8520	"RTN","RCC PCPS",266, 0)
	8521	BLDERR ; PRCA4.53 13 - Print Error and Kill X
	8522	"RTN","RCC PCPS",267, 0)
	8523	W !!,"INV ALID STATE MENT DATE"
	8524	"RTN","RCC PCPS",268, 0)
	8525	K X
	8526	"RTN","RCC PCPS",269, 0)
	8527	Q
	8528	"RTN","RCC PCPS1")
	8529	0^11^B6544 3378^B3737 0113
	8530	"RTN","RCC PCPS1",1,0 )
	8531	RCCPCPS1 ; WISC/RFJ-b uild descr iption for patient s tatement ; 08 Aug 200 1
	8532	"RTN","RCC PCPS1",2,0 )
	8533	;;4.5;Acc ounts Rece ivable;3 4,48,104,1 70,176,192 ,265,313 ;Mar 20, 1 995;Build
	8534	124
	8535	"RTN","RCC PCPS1",3,0 )
	8536	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8537	"RTN","RCC PCPS1",4,0 )
	8538	Q
	8539	"RTN","RCC PCPS1",5,0 )
	8540	;
	8541	"RTN","RCC PCPS1",6,0 )
	8542	;
	8543	"RTN","RCC PCPS1",7,0 )
	8544	TRANDESC(R CTRANDA,RC WIDTH) ; build the descriptio n array fo r a transa ction
	8545	"RTN","RCC PCPS1",8,0 )
	8546	;
	8547	"RTN","RCC PCPS1",9,0 )
	8548	; initia lize
	8549	"RTN","RCC PCPS1",10, 0)
	8550	N DESCRIP T,RCBILLDA ,RCCATEG,R CCATTXT,RC DATA0,RCDA TA1,RCDATA 3,RCLINE,T RANTYPE,X
	8551	"RTN","RCC PCPS1",11, 0)
	8552	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	8553	"RTN","RCC PCPS1",12, 0)
	8554	K RCDESC
	8555	"RTN","RCC PCPS1",13, 0)
	8556	S RCLINE= 1,RCDESC(1 )=""
	8557	"RTN","RCC PCPS1",14, 0)
	8558	;
	8559	"RTN","RCC PCPS1",15, 0)
	8560	S RCBILLD A=+$P($G(^ PRCA(433,R CTRANDA,0) ),"^",2) I 'RCBILLDA Q
	8561	"RTN","RCC PCPS1",16, 0)
	8562	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	8563	"RTN","RCC PCPS1",17, 0)
	8564	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	8565	"RTN","RCC PCPS1",18, 0)
	8566	S RCDATA1 =^PRCA(433 ,RCTRANDA, 1)
	8567	"RTN","RCC PCPS1",19, 0)
	8568	S TRANTYP E=$P(RCDAT A1,"^",2)
	8569	"RTN","RCC PCPS1",20, 0)
	8570	;
	8571	"RTN","RCC PCPS1",21, 0)
	8572	; build the first line descr iption
	8573	"RTN","RCC PCPS1",22, 0)
	8574	; if tra nsaction t ype is an increase o r decrease , set desc ription
	8575	"RTN","RCC PCPS1",23, 0)
	8576	I TRANTYP E=1!(TRANT YPE=35) D
	8577	"RTN","RCC PCPS1",24, 0)
	8578	. ; if c means t est, set d escription to catego ry for c m eans test
	8579	"RTN","RCC PCPS1",25, 0)
	8580	. I RCC ATEG=18 S DESCRIPT=$ S($P(RCDAT A0,"^",16) :$P(^PRCA( 430.2,$P(R CDATA0,"^
	8581	",16),0)," ^"),1:RCCA TTXT) Q
	8582	"RTN","RCC PCPS1",26, 0)
	8583	. ; ot herwise, s et to cate gory name
	8584	"RTN","RCC PCPS1",27, 0)
	8585	. S DES CRIPT=RCCA TTXT
	8586	"RTN","RCC PCPS1",28, 0)
	8587	;
	8588	"RTN","RCC PCPS1",29, 0)
	8589	; if the bill cate gory is a rx-copay a nd it is a n increase adjustmen t
	8590	"RTN","RCC PCPS1",30, 0)
	8591	; then s et the des cription t o copay
	8592	"RTN","RCC PCPS1",31, 0)
	8593	I RCCATEG =22!(RCCAT EG=23),TRA NTYPE=1 S DESCRIPT=" COPAY"
	8594	"RTN","RCC PCPS1",32, 0)
	8595	;
	8596	"RTN","RCC PCPS1",33, 0)
	8597	; if the bill cate gory is ad ult day he alth care, remove he alth
	8598	"RTN","RCC PCPS1",34, 0)
	8599	I RCCATEG =33 S DESC RIPT="ADUL T DAY CARE "
	8600	"RTN","RCC PCPS1",35, 0)
	8601	;
	8602	"RTN","RCC PCPS1",36, 0)
	8603	; if the bill cate gory is re spite or g eriatric e val,
	8604	"RTN","RCC PCPS1",37, 0)
	8605	; take t he 2nd pie ce removin g institut ional
	8606	"RTN","RCC PCPS1",38, 0)
	8607	I RCCATEG =35!(RCCAT EG=36)!(RC CATEG=37)! (RCCATEG=3 8) S DESCR IPT=$P(RCC ATTXT,"-"
	8608	)_$S(RCCAT EG=35!(RCC ATEG=37):" IN",1:" O UT")_"PATI ENT"
	8609	"RTN","RCC PCPS1",39, 0)
	8610	;
	8611	"RTN","RCC PCPS1",40, 0)
	8612	; if it is a comme nt transac tion
	8613	"RTN","RCC PCPS1",41, 0)
	8614	I TRANTYP E=45 S DES CRIPT="COM MENT: "_$P ($G(^PRCA( 433,RCTRAN DA,5)),"^" ,2)
	8615	"RTN","RCC PCPS1",42, 0)
	8616	;
	8617	"RTN","RCC PCPS1",43, 0)
	8618	; prepay ment bill (1=increas e, 35=decr ease, othe rwise refu nd)
	8619	"RTN","RCC PCPS1",44, 0)
	8620	I RCCATEG =26 S DESC RIPT=$S(TR ANTYPE=1:" OVERPAYMEN T CREDIT", TRANTYPE=3 5:"OVERPA
	8621	YMENT CRED IT DECREAS E",1:"OVER PAYMENT RE FUND")
	8622	"RTN","RCC PCPS1",45, 0)
	8623	;
	8624	"RTN","RCC PCPS1",46, 0)
	8625	; if the first lin e descript ion not se t (like pa yments), s et it
	8626	"RTN","RCC PCPS1",47, 0)
	8627	; to the type of t ransaction
	8628	"RTN","RCC PCPS1",48, 0)
	8629	I $G(DESC RIPT)="" S DESCRIPT= $P($G(^PRC A(430.3,+$ P(RCDATA1, "^",2),0)) ,"^")
	8630	"RTN","RCC PCPS1",49, 0)
	8631	;
	8632	"RTN","RCC PCPS1",50, 0)
	8633	; if the transacti on date is different from the process da te,
	8634	"RTN","RCC PCPS1",51, 0)
	8635	; show i t with the descripti on
	8636	"RTN","RCC PCPS1",52, 0)
	8637	I $P(RCDA TA1,"^"),$ P($P(RCDAT A1,"^"),". ")'=$P($P( RCDATA1,"^ ",9),".") S DESCRIP
	8638	T=DESCRIPT _" ("_$$D ATE($P($P( RCDATA1,"^ "),"."))_" )"
	8639	"RTN","RCC PCPS1",53, 0)
	8640	;
	8641	"RTN","RCC PCPS1",54, 0)
	8642	; set th e first de scription line
	8643	"RTN","RCC PCPS1",55, 0)
	8644	D SETDESC (DESCRIPT)
	8645	"RTN","RCC PCPS1",56, 0)
	8646	;
	8647	"RTN","RCC PCPS1",57, 0)
	8648	; if it is a payme nt transac tion, show amount pa id interes t, admin, other
	8649	"RTN","RCC PCPS1",58, 0)
	8650	I TRANTYP E=2!(TRANT YPE=34) D
	8651	"RTN","RCC PCPS1",59, 0)
	8652	. S RCD ATA3=$G(^P RCA(433,RC TRANDA,3))
	8653	"RTN","RCC PCPS1",60, 0)
	8654	. ; if not inter est, admin , or other , quit
	8655	"RTN","RCC PCPS1",61, 0)
	8656	. I '$P (RCDATA3," ^",2),'$P( RCDATA3,"^ ",3),'$P(R CDATA3,"^" ,4),'$P(RC DATA3,"^"
	8657	,5) Q
	8658	"RTN","RCC PCPS1",62, 0)
	8659	. ;
	8660	"RTN","RCC PCPS1",63, 0)
	8661	. S DES CRIPT=" ( Int:"_$J(+ $P(RCDATA3 ,"^",2),1, 2)_" Adm: "_$J(+$P(R CDATA3,"^
	8662	",3),1,2)
	8663	"RTN","RCC PCPS1",64, 0)
	8664	. ; ca lculate ot her
	8665	"RTN","RCC PCPS1",65, 0)
	8666	. S X=$ P(RCDATA1, "^",5)-$P( RCDATA3,"^ ")-$P(RCDA TA3,"^",2) -$P(RCDATA 3,"^",3)
	8667	"RTN","RCC PCPS1",66, 0)
	8668	. S DES CRIPT=DESC RIPT_$S(X: " Other:"_ $J(X,1,2)_ ")",1:")")
	8669	"RTN","RCC PCPS1",67, 0)
	8670	. D SET DESC(DESCR IPT)
	8671	"RTN","RCC PCPS1",68, 0)
	8672	;
	8673	"RTN","RCC PCPS1",69, 0)
	8674	; if it is a admin cost or i nterest ch arge, tota l the amou nts
	8675	"RTN","RCC PCPS1",70, 0)
	8676	I TRANTYP E=13!(TRAN TYPE=12) D Q
	8677	"RTN","RCC PCPS1",71, 0)
	8678	. S X=$ G(^PRCA(43 3,RCTRANDA ,2)) I X=" " Q
	8679	"RTN","RCC PCPS1",72, 0)
	8680	. S RCT OTAL("INT" )=$G(RCTOT AL("INT")) +$P(X,"^", 7)
	8681	"RTN","RCC PCPS1",73, 0)
	8682	. S RCT OTAL("ADM" )=$G(RCTOT AL("ADM")) +$P(X,"^", 8)
	8683	"RTN","RCC PCPS1",74, 0)
	8684	. S RCT OTAL("OTH" )=$G(RCTOT AL("OTH")) +($P(RCDAT A1,"^",5)- $P(X,"^",7 )-$P(X,"^
	8685	",8))
	8686	"RTN","RCC PCPS1",75, 0)
	8687	;
	8688	"RTN","RCC PCPS1",76, 0)
	8689	; if not an increa se adjustm ent, quit
	8690	"RTN","RCC PCPS1",77, 0)
	8691	I TRANTYP E'=1 Q
	8692	"RTN","RCC PCPS1",78, 0)
	8693	;
	8694	"RTN","RCC PCPS1",79, 0)
	8695	; increa se to c me ans test, ltc or rx- copay, get data from ib
	8696	"RTN","RCC PCPS1",80, 0)
	8697	I RCCATEG =18!(RCCAT EG=22)!(RC CATEG=23)! ((RCCATEG> 32)&(RCCAT EG<40)) D
	8698	"RTN","RCC PCPS1",81, 0)
	8699	. S X=" IBRFN1" X ^%ZOSF("TE ST") I '$T Q
	8700	"RTN","RCC PCPS1",82, 0)
	8701	. K ^TM P("IBRFN1" ,$J)
	8702	"RTN","RCC PCPS1",83, 0)
	8703	. D STM T^IBRFN1(R CTRANDA)
	8704	"RTN","RCC PCPS1",84, 0)
	8705	. D IBD ATA
	8706	"RTN","RCC PCPS1",85, 0)
	8707	Q
	8708	"RTN","RCC PCPS1",86, 0)
	8709	;
	8710	"RTN","RCC PCPS1",87, 0)
	8711	;
	8712	"RTN","RCC PCPS1",88, 0)
	8713	; Return s RCDESC(1 ..n) array of Bill D escription
	8714	"RTN","RCC PCPS1",89, 0)
	8715	BILLDESC(R CBILLDA,RC WIDTH) ;
	8716	"RTN","RCC PCPS1",90, 0)
	8717	; initia lize
	8718	"RTN","RCC PCPS1",91, 0)
	8719	N DESCRIP T,RCCATEG, RCCATTXT,R CDATA0,RCL INE,X
	8720	"RTN","RCC PCPS1",92, 0)
	8721	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	8722	"RTN","RCC PCPS1",93, 0)
	8723	K RCDESC
	8724	"RTN","RCC PCPS1",94, 0)
	8725	S RCLINE= 1,RCDESC(1 )=""
	8726	"RTN","RCC PCPS1",95, 0)
	8727	;
	8728	"RTN","RCC PCPS1",96, 0)
	8729	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	8730	"RTN","RCC PCPS1",97, 0)
	8731	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	8732	"RTN","RCC PCPS1",98, 0)
	8733	;
	8734	"RTN","RCC PCPS1",99, 0)
	8735	; if cat egory=c me ans test, set the de scription and quit
	8736	"RTN","RCC PCPS1",100 ,0)
	8737	I RCCATEG =18 S DESC RIPT=$S($P (RCDATA0," ^",16):$P( ^PRCA(430. 2,$P(RCDAT A0,"^",16
	8738	),0),"^"), 1:RCCATTXT ) D SETDES C(DESCRIPT ) Q
	8739	"RTN","RCC PCPS1",101 ,0)
	8740	;
	8741	"RTN","RCC PCPS1",102 ,0)
	8742	; set th e category descripti on
	8743	"RTN","RCC PCPS1",103 ,0)
	8744	D SETDESC (RCCATTXT)
	8745	"RTN","RCC PCPS1",104 ,0)
	8746	;
	8747	"RTN","RCC PCPS1",105 ,0)
	8748	; if cat egory not champva su bsitence a nd not tri care patie nt, quit
	8749	"RTN","RCC PCPS1",106 ,0)
	8750	I RCCATEG '=27,RCCAT EG'=31 Q
	8751	"RTN","RCC PCPS1",107 ,0)
	8752	;
	8753	"RTN","RCC PCPS1",108 ,0)
	8754	; build descriptio n for cham pva subsis tence and tricare pa tient bill s
	8755	"RTN","RCC PCPS1",109 ,0)
	8756	; get da ta from ib
	8757	"RTN","RCC PCPS1",110 ,0)
	8758	S X="IBRF N1" X ^%ZO SF("TEST") I '$T Q
	8759	"RTN","RCC PCPS1",111 ,0)
	8760	K ^TMP("I BRFN1",$J)
	8761	"RTN","RCC PCPS1",112 ,0)
	8762	D STMTB^I BRFN1($P(R CDATA0,"^" ))
	8763	"RTN","RCC PCPS1",113 ,0)
	8764	D IBDATA
	8765	"RTN","RCC PCPS1",114 ,0)
	8766	Q
	8767	"RTN","RCC PCPS1",115 ,0)
	8768	;
	8769	"RTN","RCC PCPS1",116 ,0)
	8770	;
	8771	"RTN","RCC PCPS1",117 ,0)
	8772	IBDATA ; get data f rom IB for descripti on
	8773	"RTN","RCC PCPS1",118 ,0)
	8774	N IBDATA, IBJ
	8775	"RTN","RCC PCPS1",119 ,0)
	8776	;
	8777	"RTN","RCC PCPS1",120 ,0)
	8778	; show I B data
	8779	"RTN","RCC PCPS1",121 ,0)
	8780	S IBJ=0 F S IBJ=$O (^TMP("IBR FN1",$J,IB J)) Q:'IBJ S IBDATA =^TMP("IBR FN1",$J,I
	8781	BJ) D
	8782	"RTN","RCC PCPS1",122 ,0)
	8783	. ;
	8784	"RTN","RCC PCPS1",123 ,0)
	8785	. ; if no drug o r bill dat e returned from IB, then it is outpatien t
	8786	"RTN","RCC PCPS1",124 ,0)
	8787	. I $P( IBDATA,"^" ,3)="" D:$ P(IBDATA," ^",2) SETD ESC("VISIT DATE: "_$ $DATE($P(
	8788	IBDATA,"^" ,2))) Q
	8789	"RTN","RCC PCPS1",125 ,0)
	8790	. ;
	8791	"RTN","RCC PCPS1",126 ,0)
	8792	. ; if no drug q uantity re turned fro m ib, then it is inp atient
	8793	"RTN","RCC PCPS1",127 ,0)
	8794	. I '$P (IBDATA,"^ ",6) D Q
	8795	"RTN","RCC PCPS1",128 ,0)
	8796	. . I $P(IBDATA ,"^",2) D SETDESC(" ADMISSION DATE: "_$ $DATE($P(I BDATA,"^"
	8797	,2)))
	8798	"RTN","RCC PCPS1",129 ,0)
	8799	. . I $P(IBDATA ,"^",3) D SETDESC(" BEGINNING DATE OF B ILLING CYC LE: "_$$D
	8800	ATE($P(IBD ATA,"^",3) ))
	8801	"RTN","RCC PCPS1",130 ,0)
	8802	. . I $P(IBDATA ,"^",4) D SETDESC(" ENDING DA TE OF BILL ING CYCLE: "_$$DATE
	8803	($P(IBDATA ,"^",4)))
	8804	"RTN","RCC PCPS1",131 ,0)
	8805	. . I $P(IBDATA ,"^",5) D SETDESC(" DISCHARGE DATE: "_$ $DATE($P(I BDATA,"^"
	8806	,5)))
	8807	"RTN","RCC PCPS1",132 ,0)
	8808	. ;
	8809	"RTN","RCC PCPS1",133 ,0)
	8810	. ; ph armacy
	8811	"RTN","RCC PCPS1",134 ,0)
	8812	. D:$P( IBDATA,"^" ,2) SETDES C("RX:"_$P (IBDATA,"^ ",2))
	8813	"RTN","RCC PCPS1",135 ,0)
	8814	. D:$P( IBDATA,"^" ,7) SETDES C("FD:"_$$ DATE($P(IB DATA,"^",7 )))
	8815	"RTN","RCC PCPS1",136 ,0)
	8816	. ;
	8817	"RTN","RCC PCPS1",137 ,0)
	8818	. ; if not patie nt stateme nt detail, quit
	8819	"RTN","RCC PCPS1",138 ,0)
	8820	. I $$D ET^RCFN01( $P(RCDATA0 ,"^",9))'= 2 Q
	8821	"RTN","RCC PCPS1",139 ,0)
	8822	. ;
	8823	"RTN","RCC PCPS1",140 ,0)
	8824	. ; re turn pharm acy detail
	8825	"RTN","RCC PCPS1",141 ,0)
	8826	. I $P( IBDATA,"^" ,3)'="" D SETDESC(" DRUG:"_$TR ($P(IBDATA ,"^",3),"\| ~"))
	8827	"RTN","RCC PCPS1",142 ,0)
	8828	. I $P( IBDATA,"^" ,4) D SETD ESC(" DAYS :"_$P(IBDA TA,"^",4))
	8829	"RTN","RCC PCPS1",143 ,0)
	8830	. I $P( IBDATA,"^" ,6) D SETD ESC(" QTY: "_$P(IBDAT A,"^",6))
	8831	"RTN","RCC PCPS1",144 ,0)
	8832	. I $P( IBDATA,"^" ,5)'="" D SETDESC(" PHY:"_$P(I BDATA,"^", 5))
	8833	"RTN","RCC PCPS1",145 ,0)
	8834	. I $P( IBDATA,"^" ,8) D SETD ESC(" CHG: $"_$J($P(I BDATA,"^", 8),0,2))
	8835	"RTN","RCC PCPS1",146 ,0)
	8836	;
	8837	"RTN","RCC PCPS1",147 ,0)
	8838	K ^TMP("I BRFN1",$J)
	8839	"RTN","RCC PCPS1",148 ,0)
	8840	Q
	8841	"RTN","RCC PCPS1",149 ,0)
	8842	;
	8843	"RTN","RCC PCPS1",150 ,0)
	8844	;
	8845	"RTN","RCC PCPS1",151 ,0)
	8846	; Add lin e to the d escription , not long er than RC WIDTH
	8847	"RTN","RCC PCPS1",152 ,0)
	8848	; Input: RCLINE,RCW IDTH
	8849	"RTN","RCC PCPS1",153 ,0)
	8850	; Output: RCDESC
	8851	"RTN","RCC PCPS1",154 ,0)
	8852	SETDESC(DE SCRIPT) N LENGTH
	8853	"RTN","RCC PCPS1",155 ,0)
	8854	; calcul ate the le ngth of th e descript ion
	8855	"RTN","RCC PCPS1",156 ,0)
	8856	S LENGTH= $L(RCDESC( RCLINE))+$ L(DESCRIPT )
	8857	"RTN","RCC PCPS1",157 ,0)
	8858	I RCDESC( RCLINE)'=" " S LENGTH =LENGTH+1
	8859	"RTN","RCC PCPS1",158 ,0)
	8860	;
	8861	"RTN","RCC PCPS1",159 ,0)
	8862	; the de scription line canno t go over RCWIDTH ch aracters
	8863	"RTN","RCC PCPS1",160 ,0)
	8864	I LENGTH< RCWIDTH S RCDESC(RCL INE)=RCDES C(RCLINE)_ $S(RCDESC( RCLINE)="" :"",1:" "
	8865	)_DESCRIPT Q
	8866	"RTN","RCC PCPS1",161 ,0)
	8867	;
	8868	"RTN","RCC PCPS1",162 ,0)
	8869	; Descrip tion line to add is over RCWID TH
	8870	"RTN","RCC PCPS1",163 ,0)
	8871	; The giv en string will be sp litted _on ly_ if the limit is more than 44 charac
	8872	ters.
	8873	"RTN","RCC PCPS1",164 ,0)
	8874	I $L(DESC RIPT)>RCWI DTH D Q
	8875	"RTN","RCC PCPS1",165 ,0)
	8876	. I RCD ESC(RCLINE )'="" S RC LINE=RCLIN E+1
	8877	"RTN","RCC PCPS1",166 ,0)
	8878	. S RCD ESC(RCLINE )=$E(DESCR IPT,1,RCWI DTH)
	8879	"RTN","RCC PCPS1",167 ,0)
	8880	. S RCL INE=RCLINE +1
	8881	"RTN","RCC PCPS1",168 ,0)
	8882	. S RCD ESC(RCLINE )=$E(DESCR IPT,RCWIDT H+1,2*RCWI DTH)
	8883	"RTN","RCC PCPS1",169 ,0)
	8884	;
	8885	"RTN","RCC PCPS1",170 ,0)
	8886	; over R CWIDTH cha racters, s tart new l ine
	8887	"RTN","RCC PCPS1",171 ,0)
	8888	I RCDESC( RCLINE)'=" " S RCLINE =RCLINE+1
	8889	"RTN","RCC PCPS1",172 ,0)
	8890	S RCDESC( RCLINE)=DE SCRIPT
	8891	"RTN","RCC PCPS1",173 ,0)
	8892	Q
	8893	"RTN","RCC PCPS1",174 ,0)
	8894	;
	8895	"RTN","RCC PCPS1",175 ,0)
	8896	DATE(FMDT) ; format date mm/d d/yyyy
	8897	"RTN","RCC PCPS1",176 ,0)
	8898	I 'FMDT Q ""
	8899	"RTN","RCC PCPS1",177 ,0)
	8900	N X,Y,%DT S %DT="TX ",X=FMDT D ^%DT Q:Y< 0 ""
	8901	"RTN","RCC PCPS1",178 ,0)
	8902	Q $E(FMDT ,4,5)_"/"_ $E(FMDT,6, 7)_"/"_(17 00+$E(FMDT ,1,3))
	8903	"RTN","RCC PCPS1",179 ,0)
	8904	;
	8905	"RTN","RCC PCPS1",180 ,0)
	8906	KILL(SDT) ; PRCA4 .5313 - k ill data p rior to re creating f or this da y of mont
	8907	h
	8908	"RTN","RCC PCPS1",181 ,0)
	8909	;
	8910	"RTN","RCC PCPS1",182 ,0)
	8911	; Set dat e back one month
	8912	"RTN","RCC PCPS1",183 ,0)
	8913	N IEN,X,R CT,DA,DIK, ACK
	8914	"RTN","RCC PCPS1",184 ,0)
	8915	;
	8916	"RTN","RCC PCPS1",185 ,0)
	8917	S IEN=""
	8918	"RTN","RCC PCPS1",186 ,0)
	8919	F S IEN= $O(^RCPS(3 49.2,"STDT ",SDT,IEN) ) Q:IEN="" S DA=IEN ,DIK="^RCP S(349.2,"
	8920	D ^DIK
	8921	"RTN","RCC PCPS1",187 ,0)
	8922	;
	8923	"RTN","RCC PCPS1",188 ,0)
	8924	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T D
	8925	"RTN","RCC PCPS1",189 ,0)
	8926	. S ACK=" " F S ACK =$O(^RCT(3 49.1,RCT,4 ,"STDT4",S DT,ACK)) Q :ACK="" D
	8927	"RTN","RCC PCPS1",190 ,0)
	8928	. . S IEN =0 F S IE N=$O(^RCT( 349.1,RCT, 4,"STDT4", SDT,ACK,IE N)) Q:IEN= "" S DA=
	8929	IEN,DIK="^ RCT(349.1, "_RCT_",4, " D ^DIK K ^RCT(349. 1,RCT,4,"S TDT4",SDT, ACK,IEN)
	8930	"RTN","RCC PCPS1",191 ,0)
	8931	. S IEN=0 F S IEN= $O(^RCT(34 9.1,RCT,5, "STDT5",SD T,IEN)) Q: IEN="" S DA=IEN,DI
	8932	K="^RCT(34 9.1,"_RCT_ ",5," D ^D IK K ^RCT( 349.1,RCT, 5,"STDT5", SDT,IEN)
	8933	"RTN","RCC PCPS1",192 ,0)
	8934	;
	8935	"RTN","RCC PCPS1",193 ,0)
	8936	K ^XTMP(" RCCPC")
	8937	"RTN","RCC PCPS1",194 ,0)
	8938	;
	8939	"RTN","RCC PCPS1",195 ,0)
	8940	Q
	8941	"RTN","RCC PCPS1",196 ,0)
	8942	;
	8943	"RTN","RCC PCPS1",197 ,0)
	8944	MONTHAGO(S DT) ; PRC A4.5313 - Return d ate one mo nth prior to entered date - S
	8945	DT is stat ement date
	8946	"RTN","RCC PCPS1",198 ,0)
	8947	; and Sta tement dat e cannot e xceed 26th day of th e month.
	8948	"RTN","RCC PCPS1",199 ,0)
	8949	; New OLD DT in call ing routin e
	8950	"RTN","RCC PCPS1",200 ,0)
	8951	S OLDDT=S DT-100
	8952	"RTN","RCC PCPS1",201 ,0)
	8953	I $E(SDT, 4,5)="01" S OLDDT=($ E(SDT,1,3) -1)_12_$E( SDT,6,7)
	8954	"RTN","RCC PCPS1",202 ,0)
	8955	Q OLDDT
	8956	"RTN","RCC PCPS1",203 ,0)
	8957	;
	8958	"RTN","RCC PCPS1",204 ,0)
	8959	ICNERR ; PRCA4.5 313 - Send email to RCCPC STAT EMENTS Mai l Group wi th all mi
	8960	ssing ICNs
	8961	"RTN","RCC PCPS1",205 ,0)
	8962	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ,XMY, DFN,CNT,I
	8963	"RTN","RCC PCPS1",206 ,0)
	8964	;
	8965	"RTN","RCC PCPS1",207 ,0)
	8966	; Create Message at MSG level of tempor ary storag e
	8967	"RTN","RCC PCPS1",208 ,0)
	8968	S CNT=1,^ TMP("ICNER ROR",$J,"M SG",CNT)=" The Patien t Statemen ts for the se patien
	8969	ts were no t sent to CBSS due t o a"
	8970	"RTN","RCC PCPS1",209 ,0)
	8971	S CNT=2,^ TMP("ICNER ROR",$J,"M SG",CNT)=" missing IC N."
	8972	"RTN","RCC PCPS1",210 ,0)
	8973	S CNT=3,^ TMP("ICNER ROR",$J,"M SG",CNT)=" NAME SSN
	8974	"
	8975	"RTN","RCC PCPS1",211 ,0)
	8976	S CNT=4,^ TMP("ICNER ROR",$J,"M SG",CNT)=" ========== ========== ========== =========
	8977	======="
	8978	"RTN","RCC PCPS1",212 ,0)
	8979	S DFN="" F S DFN=$ O(^TMP("IC NERROR",$J ,DFN)) Q:D FN="" Q:D FN="MSG" D
	8980	"RTN","RCC PCPS1",213 ,0)
	8981	. N DPTDA TA,NAME
	8982	"RTN","RCC PCPS1",214 ,0)
	8983	. S DPTDA TA=$G(^DPT (DFN,0))
	8984	"RTN","RCC PCPS1",215 ,0)
	8985	. I DPTDA TA="" Q
	8986	"RTN","RCC PCPS1",216 ,0)
	8987	. S NAME= $P(DPTDATA ,U)
	8988	"RTN","RCC PCPS1",217 ,0)
	8989	. I $L(NA ME)<35 S $ E(NAME,35) =" "
	8990	"RTN","RCC PCPS1",218 ,0)
	8991	. S CNT=C NT+1
	8992	"RTN","RCC PCPS1",219 ,0)
	8993	. S ^TMP( "ICNERROR" ,$J,"MSG", CNT)=NAME_ $P(DPTDATA ,U,9)
	8994	"RTN","RCC PCPS1",220 ,0)
	8995	;
	8996	"RTN","RCC PCPS1",221 ,0)
	8997	S XMDUZ=D UZ
	8998	"RTN","RCC PCPS1",222 ,0)
	8999	S XMTO(DU Z)=""
	9000	"RTN","RCC PCPS1",223 ,0)
	9001	S XMTO("G .RCCPC STA TEMENTS")= ""
	9002	"RTN","RCC PCPS1",224 ,0)
	9003	S XMSUBJ= "PATIENTS WITH MISSI NG ICNS"
	9004	"RTN","RCC PCPS1",225 ,0)
	9005	S XMBODY= "^TMP(""IC NERROR"",$ J,""MSG"") "
	9006	"RTN","RCC PCPS1",226 ,0)
	9007	S XMINSTR ("FLAGS")= "X"
	9008	"RTN","RCC PCPS1",227 ,0)
	9009	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	9010	"RTN","RCC PCPS1",228 ,0)
	9011	Q
	9012	"RTN","RCC PCSE")
	9013	0^14^B1650 7603^B5810 439
	9014	"RTN","RCC PCSE",1,0)
	9015	RCCPCSE ;W ASH-ISC@AL TOONA,PA/L DB - CCPC Statements Errors;5/ 30/96 10: 20 AM ;10
	9016	/16/96 8: 42 AM
	9017	"RTN","RCC PCSE",2,0)
	9018	V ;;4.5;Ac counts Rec eivable; 34,313;M ar 20, 199 5;Build 12 4
	9019	"RTN","RCC PCSE",3,0)
	9020	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9021	"RTN","RCC PCSE",4,0)
	9022	;
	9023	"RTN","RCC PCSE",5,0)
	9024	K ^TMP($J )
	9025	"RTN","RCC PCSE",6,0)
	9026	N ADD,DIR ,DIRUT,ERR ,ERROR,HDR ,LINE,LN,P G,POP,PT,X ,X1,Y,%ZIS ,Z,ZTRTN,Z TDESC,%,%
	9027	Y,ZTSAVE
	9028	"RTN","RCC PCSE",7,0)
	9029	I '$O(^RC PS(349.2," AD","E",0) ) W !,"THE RE ARE NO CBSS PATIE NT STATEME NT ERRORS
	9030	" Q
	9031	"RTN","RCC PCSE",8,0)
	9032	E W !,"C BSS PATIEN T STATEMEN T ERROR RE PORT"
	9033	"RTN","RCC PCSE",9,0)
	9034	N IEN,%D, DTOUT,SDT, SDAT,TMPQ, ALL,DTPT
	9035	"RTN","RCC PCSE",10,0 )
	9036	S (TMPQ,A LL)=0
	9037	"RTN","RCC PCSE",11,0 )
	9038	S IEN="" F S IEN=$ O(^RCPS(34 9.2,"AD"," E",IEN)) Q :IEN="" I $G(^RCPS( 349.2,IEN
	9039	,5))'="" D
	9040	"RTN","RCC PCSE",12,0 )
	9041	. S SDT=$ P(^RCPS(34 9.2,IEN,0) ,U,19)
	9042	"RTN","RCC PCSE",13,0 )
	9043	. S DTPT( SDT,IEN)=" "
	9044	"RTN","RCC PCSE",14,0 )
	9045	. S DTPT( SDT)=$G(DT PT(SDT))+1
	9046	"RTN","RCC PCSE",15,0 )
	9047	; PRCA4. 5313 - As k about al l dates or specific
	9048	"RTN","RCC PCSE",16,0 )
	9049	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9050	"RTN","RCC PCSE",17,0 )
	9051	S DIR(0)= "YAO"
	9052	"RTN","RCC PCSE",18,0 )
	9053	S DIR("B" )="Y"
	9054	"RTN","RCC PCSE",19,0 )
	9055	S DIR("A" )="Do you want to pr int errors for all d ates avail able? "
	9056	"RTN","RCC PCSE",20,0 )
	9057	D ^DIR
	9058	"RTN","RCC PCSE",21,0 )
	9059	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9060	"RTN","RCC PCSE",22,0 )
	9061	I Y=1 S A LL=1 D PRI NT Q
	9062	"RTN","RCC PCSE",23,0 )
	9063	; PRCA4. 5313 - Ad d date pro mpts
	9064	"RTN","RCC PCSE",24,0 )
	9065	W !,"The following dates have errors to print:"
	9066	"RTN","RCC PCSE",25,0 )
	9067	S SDT="" F S SDT=$ O(DTPT(SDT )) Q:SDT= "" W !,$$ DATE^RCCPC PS1(SDT)
	9068	"RTN","RCC PCSE",26,0 )
	9069	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9070	"RTN","RCC PCSE",27,0 )
	9071	S DIR(0)= "DAO^^K:'$ D(DTPT(Y)) X"
	9072	"RTN","RCC PCSE",28,0 )
	9073	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	9074	"RTN","RCC PCSE",29,0 )
	9075	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	9076	"RTN","RCC PCSE",30,0 )
	9077	D ^DIR
	9078	"RTN","RCC PCSE",31,0 )
	9079	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9080	"RTN","RCC PCSE",32,0 )
	9081	S SDT=Y
	9082	"RTN","RCC PCSE",33,0 )
	9083	D PRINT
	9084	"RTN","RCC PCSE",34,0 )
	9085	Q
	9086	"RTN","RCC PCSE",35,0 )
	9087	PRINT ; P RCA4.531 3 Determin e print de vice then enter Sort
	9088	"RTN","RCC PCSE",36,0 )
	9089	D HOME^%Z IS S %ZIS= "QN" D ^%Z IS Q:POP
	9090	"RTN","RCC PCSE",37,0 )
	9091	I $D(IO(" Q")) D Q
	9092	"RTN","RCC PCSE",38,0 )
	9093	.S ZTRTN= "SORT^RCCP CSE",ZTDES C="CBSS PA TIENT STAT EMENT ERRO R REPORT"
	9094	"RTN","RCC PCSE",39,0 )
	9095	. S TMPQ= 1,(ZTSAVE( "DTPT("),Z TSAVE("SDT "),ZTSAVE( "ALL"),ZTS AVE("TMPQ" ))=""
	9096	"RTN","RCC PCSE",40,0 )
	9097	.D ^%ZTLO AD
	9098	"RTN","RCC PCSE",41,0 )
	9099	SORT ; PR CA4.5313 - Rewritt en to prin t by date
	9100	"RTN","RCC PCSE",42,0 )
	9101	S HDR="CB SS PATIENT STATEMENT ERROR REP ORT",LINE= "",$P(LINE ,"=",79)=" ",PG=1
	9102	"RTN","RCC PCSE",43,0 )
	9103	I 'ALL D SORT1,PRNT Q
	9104	"RTN","RCC PCSE",44,0 )
	9105	I ALL S S DT=""
	9106	"RTN","RCC PCSE",45,0 )
	9107	F S SDT= $O(DTPT(SD T)) Q:SDT= "" D SORT 1
	9108	"RTN","RCC PCSE",46,0 )
	9109	D PRNT
	9110	"RTN","RCC PCSE",47,0 )
	9111	; PRCA4. 5313 - Re move TMP s torage
	9112	"RTN","RCC PCSE",48,0 )
	9113	K ^TMP($J )
	9114	"RTN","RCC PCSE",49,0 )
	9115	Q
	9116	"RTN","RCC PCSE",50,0 )
	9117	SORT1 ;PR CA4.5313 Print a d ay of erro rs
	9118	"RTN","RCC PCSE",51,0 )
	9119	N IEN
	9120	"RTN","RCC PCSE",52,0 )
	9121	S IEN="" F S IEN=$ O(DTPT(SDT ,IEN)) Q:I EN="" D
	9122	"RTN","RCC PCSE",53,0 )
	9123	.S ERR=$G (^RCPS(349 .2,IEN,5))
	9124	"RTN","RCC PCSE",54,0 )
	9125	.S ^TMP($ J,"ERR",SD T,IEN)=$P( $G(^RCPS(3 49.2,IEN,0 )),"^",3)_ "^"_$P(^(0 ),"^",2)
	9126	"RTN","RCC PCSE",55,0 )
	9127	.S ADD=$G (^RCPS(349 .2,IEN,1))
	9128	"RTN","RCC PCSE",56,0 )
	9129	.F X=1:1: 6 S ADD(X) =$P(ADD,"^ ",X),^TMP( $J,"ERR",S DT,IEN,1+X )=ADD(X)
	9130	"RTN","RCC PCSE",57,0 )
	9131	.F X=1:5 S X1=X+4,E RROR=$E(ER R,X,X1) Q: ERROR="" D
	9132	"RTN","RCC PCSE",58,0 )
	9133	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=ERROR
	9134	"RTN","RCC PCSE",59,0 )
	9135	..S ERROR =$O(^RCPSE (349.7,"B" ,$E(ERROR, 1,5),""))
	9136	"RTN","RCC PCSE",60,0 )
	9137	..S ERROR =$P($G(^RC PSE(349.7, +ERROR,0)) ,"^",4)
	9138	"RTN","RCC PCSE",61,0 )
	9139	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=^TMP($J ,"ERR",SDT ,IEN,X+10) _"^"_ERROR
	9140	"RTN","RCC PCSE",62,0 )
	9141	;
	9142	"RTN","RCC PCSE",63,0 )
	9143	K ADD
	9144	"RTN","RCC PCSE",64,0 )
	9145	Q
	9146	"RTN","RCC PCSE",65,0 )
	9147	PRNT ; PR CA4.5313 - Print b ased upon statement date
	9148	"RTN","RCC PCSE",66,0 )
	9149	K DIRUT
	9150	"RTN","RCC PCSE",67,0 )
	9151	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9152	"RTN","RCC PCSE",68,0 )
	9153	S (SDT,IE N)=""
	9154	"RTN","RCC PCSE",69,0 )
	9155	F S SDT= $O(^TMP($J ,"ERR",SDT )) Q:SDT=" " D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$
	9156	D(DIROUT) Q
	9157	"RTN","RCC PCSE",70,0 )
	9158	. W @IOF, ?25,HDR,?7 5,PG,!,LIN E S PG=PG+ 1
	9159	"RTN","RCC PCSE",71,0 )
	9160	. W !,?20 ,"Patient Statement Date: "_$$ DATE^RCCPC PS1(SDT),! ,LINE
	9161	"RTN","RCC PCSE",72,0 )
	9162	. F S IE N=$O(^TMP( $J,"ERR",S DT,IEN)) Q :IEN="" D PRNT1 I $ D(DTOUT)!$ D(DUOUT)!
	9163	$D(DIRUT)! $D(DIROUT) Q
	9164	"RTN","RCC PCSE",73,0 )
	9165	. I 'TMPQ S DIR(0)= "E" D ^DIR I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9166	"RTN","RCC PCSE",74,0 )
	9167	Q
	9168	"RTN","RCC PCSE",75,0 )
	9169	PRNT1 ; P RCA4.531 3 - Print based upon statement date
	9170	"RTN","RCC PCSE",76,0 )
	9171	I ($Y+12) >IOSL D
	9172	"RTN","RCC PCSE",77,0 )
	9173	.I 'TMPQ S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	9174	"RTN","RCC PCSE",78,0 )
	9175	.W @IOF,? 25,HDR,?75 ,PG S PG=P G+1
	9176	"RTN","RCC PCSE",79,0 )
	9177	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9178	"RTN","RCC PCSE",80,0 )
	9179	W !!,$E($ P(^TMP($J, "ERR",SDT, IEN),"^"), 1,25),?37, "ERROR COD ES",!,$P(^ (IEN),"^"
	9180	,2),?30,$E (LINE,1,48 )
	9181	"RTN","RCC PCSE",81,0 )
	9182	F X=2:1:4 S:$G(^TMP ($J,"ERR", SDT,IEN,X) )]"" ADD(X )=^(X)
	9183	"RTN","RCC PCSE",82,0 )
	9184	S ADD(5)= $G(^TMP($J ,"ERR",SDT ,IEN,5))_" , "_$G(^(6 ))_" "_$G( ^(7))
	9185	"RTN","RCC PCSE",83,0 )
	9186	S X=7 F S X=$O(^TM P($J,"ERR" ,SDT,IEN,X )) Q:'X S ERR(X-1)= ^(X)
	9187	"RTN","RCC PCSE",84,0 )
	9188	S (Z,Y)=0 F D Q:Y =""&(Z="")
	9189	"RTN","RCC PCSE",85,0 )
	9190	.W !
	9191	"RTN","RCC PCSE",86,0 )
	9192	.I Z'="" S Z=$O(ADD (Z)) I Z'= "",(ADD(Z) ]"") W ADD (Z)
	9193	"RTN","RCC PCSE",87,0 )
	9194	.I Y'="" S Y=$O(ERR (Y)) I Y'= "" W ?30,$ P(ERR(Y)," ^"),?40,$P (ERR(Y),"^ ",2)
	9195	"RTN","RCC PCSE",88,0 )
	9196	W !,LINE
	9197	"RTN","RCC PCSE",89,0 )
	9198	Q
	9199	"RTN","RCC PCSV")
	9200	0^9^B11825 361^B51994 90
	9201	"RTN","RCC PCSV",1,0)
	9202	RCCPCSV ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 11
	9203	:36 AM
	9204	"RTN","RCC PCSV",2,0)
	9205	V ;;4.5;Ac counts Rec eivable; 34,70,87,3 13;Mar 2 0, 1995;Bu ild 124
	9206	"RTN","RCC PCSV",3,0)
	9207	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9208	"RTN","RCC PCSV",4,0)
	9209	;
	9210	"RTN","RCC PCSV",5,0)
	9211	EN ;INPUT FROM MESSA GE
	9212	"RTN","RCC PCSV",6,0)
	9213	RREC ;READ INCOMING MESSAGE
	9214	"RTN","RCC PCSV",7,0)
	9215	N DAT,DEB ,END,ERR,E RROR,EVN,K EY,LABEL,L N,MSG,P,RC MSG,RCTR,R CX,RCX1,RE ,SBAL,STO
	9216	T,TR,TR0,T R1,TXT
	9217	"RTN","RCC PCSV",8,0)
	9218	N SDT,NOE RR,X,Y,DA
	9219	"RTN","RCC PCSV",9,0)
	9220	K ^TMP($J )
	9221	"RTN","RCC PCSV",10,0 )
	9222	S (LN,MSG ,RCX,RE)=0
	9223	"RTN","RCC PCSV",11,0 )
	9224	S TXT=0 F X XMREC Q:XMER<0!( XMRG="") S TXT=TXT+ 1,^TMP($J, "MSG",TXT) =XMRG
	9225	"RTN","RCC PCSV",12,0 )
	9226	S (DA(1), NOERR)=""
	9227	"RTN","RCC PCSV",13,0 )
	9228	S TXT=1 F S TXT=$O (^TMP($J," MSG",TXT)) Q:'TXT D
	9229	"RTN","RCC PCSV",14,0 )
	9230	. S:^TMP( $J,"MSG",T XT)?1"PA^" .E DA(1)=4 S:^TMP($J ,"MSG",TXT )?1"IS".E DA(1)=3
	9231	"RTN","RCC PCSV",15,0 )
	9232	. ; PRCA* 4.5*313 - Set Statem ent date f rom PA or IS records
	9233	"RTN","RCC PCSV",16,0 )
	9234	. I "PAIS "[$E(^TMP( $J,"MSG",T XT),1,2) S X=$P(^TMP ($J,"MSG", TXT),"^",7 ) D ^%DT
	9235	S SDT=Y
	9236	"RTN","RCC PCSV",17,0 )
	9237	. ; PRCA* 4.5*313 - If the dat e and sequ ence numbe r have alr eady been processed
	9238	quit afte r setting an error
	9239	"RTN","RCC PCSV",18,0 )
	9240	. I "PAIS "[$P(^TMP( $J,"MSG",T XT),U) I ( $D(^RCT(34 9.1,DA(1), 4,"STDT4", SDT,$P(^T
	9241	MP($J,"MSG ",TXT),U,2 )))) D Q
	9242	"RTN","RCC PCSV",19,0 )
	9243	. . S ERR ="Duplicat e file was received for Patien t Statemen t Date: "_ $P(^TMP($
	9244	J,"MSG",TX T),U,7) D ERRMSG
	9245	"RTN","RCC PCSV",20,0 )
	9246	. . S ERR ="Last Mes sage Ackno wledgement Number: " _$P(^TMP($ J,"MSG",TX T),U,2) D
	9247	ERRMSG
	9248	"RTN","RCC PCSV",21,0 )
	9249	. . S SDT =$P(^TMP($ J,"MSG",TX T),U,7)
	9250	"RTN","RCC PCSV",22,0 )
	9251	. ; PRCA* 4.5*313 - If IT is r eceived it always pr ocesses
	9252	"RTN","RCC PCSV",23,0 )
	9253	. I $P(^T MP($J,"MSG ",TXT),U)= "IT" S SDT =$P(^TMP($ J,"MSG",TX T),"^",6), NOERR=1 Q
	9254	"RTN","RCC PCSV",24,0 )
	9255	. I $G(XM Z)=""!('DA (1))!($D(E RR)) Q
	9256	"RTN","RCC PCSV",25,0 )
	9257	. S RCX=R CX+1
	9258	"RTN","RCC PCSV",26,0 )
	9259	. I "PAIS ADID"[$E(^ TMP($J,"MS G",TXT),1, 2) D
	9260	"RTN","RCC PCSV",27,0 )
	9261	. . ; PRC A4.5313 - Add Stat ement Date to 349.1, five leve l for PA, IS, AD, a
	9262	nd ID reco rds
	9263	"RTN","RCC PCSV",28,0 )
	9264	. . N DIN UM,DIC,X
	9265	"RTN","RCC PCSV",29,0 )
	9266	. . S DIN UM=+$G(XMZ )_RCX
	9267	"RTN","RCC PCSV",30,0 )
	9268	. . S DIC ="^RCT(349 .1,DA(1),5 ,"
	9269	"RTN","RCC PCSV",31,0 )
	9270	. . S X=$ P(^TMP($J, "MSG",TXT) ,"^",2)
	9271	"RTN","RCC PCSV",32,0 )
	9272	. . S DIC (0)="L"
	9273	"RTN","RCC PCSV",33,0 )
	9274	. . S DIC ("DR")=".0 2////"_$P( ^TMP($J,"M SG",TXT)," ^",3)_";.0 3////"_$G( XMZ)_";.0
	9275	4////"_SDT
	9276	"RTN","RCC PCSV",34,0 )
	9277	. . D FIL E^DICN
	9278	"RTN","RCC PCSV",35,0 )
	9279	. ; PRCA* 4.5*313 - If process ing has oc curred
	9280	"RTN","RCC PCSV",36,0 )
	9281	. S NOERR =1
	9282	"RTN","RCC PCSV",37,0 )
	9283	;
	9284	"RTN","RCC PCSV",38,0 )
	9285	K DA(1)
	9286	"RTN","RCC PCSV",39,0 )
	9287	I NOERR D SEG,KILL^ XM
	9288	"RTN","RCC PCSV",40,0 )
	9289	I $O(^TMP ($J,"ERR", 0)) D
	9290	"RTN","RCC PCSV",41,0 )
	9291	. ; PRCA* 4.5*313 - Change CCP C to CBSS and add da te
	9292	"RTN","RCC PCSV",42,0 )
	9293	. S XMSUB ="CBSS ERR OR MESSAGE TO STATIO N FOR "_SD T
	9294	"RTN","RCC PCSV",43,0 )
	9295	. S XMDUZ ="AR PACKA GE"
	9296	"RTN","RCC PCSV",44,0 )
	9297	. S XMTEX T="^TMP($J ,"_"""ERR" ","
	9298	"RTN","RCC PCSV",45,0 )
	9299	. I $O(^X MB(3.8,"B" ,"RCCPC ST ATEMENTS", 0)) S XMY( "G.RCCPC S TATEMENTS" )=""
	9300	"RTN","RCC PCSV",46,0 )
	9301	. D ^XMD
	9302	"RTN","RCC PCSV",47,0 )
	9303	. K ^TMP( $J)
	9304	"RTN","RCC PCSV",48,0 )
	9305	. ; PRCA* 4.5*313 - Change to send SDT f or resend
	9306	"RTN","RCC PCSV",49,0 )
	9307	. D:$G(RE )="R"&($G( SDT)'="") EN^RCCPCML (SDT)
	9308	"RTN","RCC PCSV",50,0 )
	9309	E S XMZ= XQMSG,XMSE R="S."_XQS OP D REMSB MSG^XMA1C
	9310	"RTN","RCC PCSV",51,0 )
	9311	Q
	9312	"RTN","RCC PCSV",52,0 )
	9313	;
	9314	"RTN","RCC PCSV",53,0 )
	9315	SEG S RCMS G=1 S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) D
	9316	"RTN","RCC PCSV",54,0 )
	9317	.S RCTR=^ TMP($J,"MS G",RCMSG)
	9318	"RTN","RCC PCSV",55,0 )
	9319	.S LABEL= $S(($P(RCT R,"^")]"") &($T(@($P( RCTR,"^")) )]""):$P(R CTR,"^"),1 :"ERROR")
	9320	"RTN","RCC PCSV",56,0 )
	9321	.D @(LABE L)
	9322	"RTN","RCC PCSV",57,0 )
	9323	Q
	9324	"RTN","RCC PCSV",58,0 )
	9325	;
	9326	"RTN","RCC PCSV",59,0 )
	9327	ERROR ;SEN D ERROR ME SSAGE TO M AIL GROUP
	9328	"RTN","RCC PCSV",60,0 )
	9329	;
	9330	"RTN","RCC PCSV",61,0 )
	9331	; PRCA4. 5313 - Ch ange CCPC to CBSS
	9332	"RTN","RCC PCSV",62,0 )
	9333	S ERR="CB SS ERROR - CANNOT RE AD MESSAGE FROM CBSS " D ERRMSG
	9334	"RTN","RCC PCSV",63,0 )
	9335	S ERR="An error has occurred in reading a message from the CBSS."
	9336	"RTN","RCC PCSV",64,0 )
	9337	D ERRMSG
	9338	"RTN","RCC PCSV",65,0 )
	9339	S ERR="Pl ease conta ct your IR M for assi stance."
	9340	"RTN","RCC PCSV",66,0 )
	9341	D ERRMSG
	9342	"RTN","RCC PCSV",67,0 )
	9343	S ERR="Th e MESSAGE WAS AS FOL LOWS:"
	9344	"RTN","RCC PCSV",68,0 )
	9345	D ERRMSG
	9346	"RTN","RCC PCSV",69,0 )
	9347	S ERR=^TM P($J,"MSG" ,RCMSG)
	9348	"RTN","RCC PCSV",70,0 )
	9349	D ERRMSG
	9350	"RTN","RCC PCSV",71,0 )
	9351	Q
	9352	"RTN","RCC PCSV",72,0 )
	9353	;
	9354	"RTN","RCC PCSV",73,0 )
	9355	IS ;INVALI D STATEMEN T
	9356	"RTN","RCC PCSV",74,0 )
	9357	D IS^RCCP CSV1
	9358	"RTN","RCC PCSV",75,0 )
	9359	Q
	9360	"RTN","RCC PCSV",76,0 )
	9361	;
	9362	"RTN","RCC PCSV",77,0 )
	9363	PA ;STATEM ENT ACKNOW LEDGEMENT
	9364	"RTN","RCC PCSV",78,0 )
	9365	D PA^RCCP CSV1
	9366	"RTN","RCC PCSV",79,0 )
	9367	Q
	9368	"RTN","RCC PCSV",80,0 )
	9369	;
	9370	"RTN","RCC PCSV",81,0 )
	9371	IT ;INVALI D TRANSMIS SION
	9372	"RTN","RCC PCSV",82,0 )
	9373	D IT^RCCP CSV1
	9374	"RTN","RCC PCSV",83,0 )
	9375	Q
	9376	"RTN","RCC PCSV",84,0 )
	9377	;
	9378	"RTN","RCC PCSV",85,0 )
	9379	ERRMSG ;ER ROR MESSAG E
	9380	"RTN","RCC PCSV",86,0 )
	9381	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	9382	"RTN","RCC PCSV",87,0 )
	9383	Q
	9384	"RTN","RCC PCSV1")
	9385	0^12^B4331 3841^B3201 7096
	9386	"RTN","RCC PCSV1",1,0 )
	9387	RCCPCSV1 ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 2:
	9388	54 PM
	9389	"RTN","RCC PCSV1",2,0 )
	9390	;;4.5;Acc ounts Rece ivable;*3 4,70,76,13 0,153,313 *;Mar 20, 1995;Build 124
	9391	"RTN","RCC PCSV1",3,0 )
	9392	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9393	"RTN","RCC PCSV1",4,0 )
	9394	;
	9395	"RTN","RCC PCSV1",5,0 )
	9396	IS ;INVALI D STATEMEN T
	9397	"RTN","RCC PCSV1",6,0 )
	9398	; PRCA4. 5313 - Ad d SDT for Patient St atement Da te
	9399	"RTN","RCC PCSV1",7,0 )
	9400	N SDAT,SD T,X,Y,ERR
	9401	"RTN","RCC PCSV1",8,0 )
	9402	S SDAT=$P (RCTR,"^", 7) S (X,SD T)=SDAT D ^%DT S SDA T=Y
	9403	"RTN","RCC PCSV1",9,0 )
	9404	D CHKTRAN (LABEL)
	9405	"RTN","RCC PCSV1",10, 0)
	9406	S ERR="Th e followin g statemen ts did not print due to errors :" D ERRMS G
	9407	"RTN","RCC PCSV1",11, 0)
	9408	S ERR=" " D ERRMSG
	9409	"RTN","RCC PCSV1",12, 0)
	9410	S ERR=" KEY ER ROR" D ERR MSG S ERR= " " D ERRM SG
	9411	"RTN","RCC PCSV1",13, 0)
	9412	D ID
	9413	"RTN","RCC PCSV1",14, 0)
	9414	S ERR="If these err ors are co rrected, t hese state ments will not print until" D
	9415	ERRMSG S ERR="the n ext billin g cycle." D ERRMSG
	9416	"RTN","RCC PCSV1",15, 0)
	9417	Q
	9418	"RTN","RCC PCSV1",16, 0)
	9419	;
	9420	"RTN","RCC PCSV1",17, 0)
	9421	ID ;INVALI D STATEMEN T DETAIL E RROR
	9422	"RTN","RCC PCSV1",18, 0)
	9423	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	9424	"RTN","RCC PCSV1",19, 0)
	9425	.; PRCA4 .5313 - C lean up va riables
	9426	"RTN","RCC PCSV1",20, 0)
	9427	.N KEY,DE B,ERROR,RC X,RCX1,ERR ,LN
	9428	"RTN","RCC PCSV1",21, 0)
	9429	.I $P(^TM P($J,"MSG" ,RCMSG),"^ ")'="ID" S ERR="ERRO R IN READI NG CBSS ER ROR RECOR
	9430	D" D ERRMS G Q
	9431	"RTN","RCC PCSV1",22, 0)
	9432	.S KEY=$P (^TMP($J," MSG",RCMSG ),"^",2),K EY=$TR(KEY ," ",""),K EY=$E(KEY, $F(KEY,$$
	9433	SITE^RCMSI TE),999)
	9434	"RTN","RCC PCSV1",23, 0)
	9435	.I KEY']" " D KEYERR Q
	9436	"RTN","RCC PCSV1",24, 0)
	9437	.S DEB=$O (^RCPS(349 .2,"AKEY", KEY,0)) I 'DEB D KEY ERR Q
	9438	"RTN","RCC PCSV1",25, 0)
	9439	.S ERROR= $P(^TMP($J ,"MSG",RCM SG),"^",3) ,^RCPS(349 .2,+DEB,5) =ERROR
	9440	"RTN","RCC PCSV1",26, 0)
	9441	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERR(0)=$E( ERROR,RCX, RCX1) Q:ER R(0)="" D
	9442	"RTN","RCC PCSV1",27, 0)
	9443	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERR(0)," "))
	9444	"RTN","RCC PCSV1",28, 0)
	9445	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RR(0)
	9446	"RTN","RCC PCSV1",29, 0)
	9447	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 )
	9448	"RTN","RCC PCSV1",30, 0)
	9449	..S ERR=K EY_" "_ERR (0)_" "_ER R
	9450	"RTN","RCC PCSV1",31, 0)
	9451	..D ERRMS G
	9452	"RTN","RCC PCSV1",32, 0)
	9453	..S ERR=" " D ERRMS G
	9454	"RTN","RCC PCSV1",33, 0)
	9455	.S ^RCPS( 349.2,+DEB ,5)=$P(^TM P($J,"MSG" ,RCMSG),"^ ",3)
	9456	"RTN","RCC PCSV1",34, 0)
	9457	.S ^RCPS( 349.2,"AD" ,"E",+DEB) =""
	9458	"RTN","RCC PCSV1",35, 0)
	9459	Q
	9460	"RTN","RCC PCSV1",36, 0)
	9461	;
	9462	"RTN","RCC PCSV1",37, 0)
	9463	;
	9464	"RTN","RCC PCSV1",38, 0)
	9465	KEYERR ;SE ND MESSAGE TO MAIL G ROUP INDIC ATING NO K EY
	9466	"RTN","RCC PCSV1",39, 0)
	9467	S ERR="CB SS ERROR M ESSAGE - N O AR KEY I D FOR CBSS KEY: "_KE Y D ERRMSG
	9468	"RTN","RCC PCSV1",40, 0)
	9469	S ERR="Th is patient record is corrupted . Please c ontact IRM ." D ERRMS G
	9470	"RTN","RCC PCSV1",41, 0)
	9471	S ERR=" " D ERRMSG
	9472	"RTN","RCC PCSV1",42, 0)
	9473	Q
	9474	"RTN","RCC PCSV1",43, 0)
	9475	;
	9476	"RTN","RCC PCSV1",44, 0)
	9477	PA ;STATEM ENT ACKNOW LEDGEMENT
	9478	"RTN","RCC PCSV1",45, 0)
	9479	N STDT,SS TDT,SDAT,S DT,IEN,DEB ,X,Y,STOT, SEQ,KEY,EN D,SBAL,EVN ,DA,DIK
	9480	"RTN","RCC PCSV1",46, 0)
	9481	Q:$P(RCTR ,"^")'="PA "
	9482	"RTN","RCC PCSV1",47, 0)
	9483	; D CHKTR AN(LABEL)
	9484	"RTN","RCC PCSV1",48, 0)
	9485	S (X,SDT) =$P(RCTR," ^",7) D ^% DT S SDAT= Y
	9486	"RTN","RCC PCSV1",49, 0)
	9487	D CHKTRAN (LABEL)
	9488	"RTN","RCC PCSV1",50, 0)
	9489	S STOT=+$ P(RCTR,"^" ,6)
	9490	"RTN","RCC PCSV1",51, 0)
	9491	S SEQ=+$P (RCTR,"^", 3)
	9492	"RTN","RCC PCSV1",52, 0)
	9493	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	9494	"RTN","RCC PCSV1",53, 0)
	9495	.N P
	9496	"RTN","RCC PCSV1",54, 0)
	9497	.S RCTR=^ TMP($J,"MS G",RCMSG)
	9498	"RTN","RCC PCSV1",55, 0)
	9499	.Q:$P(RCT R,"^")'="A D"
	9500	"RTN","RCC PCSV1",56, 0)
	9501	.S KEY=$P (RCTR,"^", 2),KEY=$TR (KEY," "," "),KEY=$E( KEY,$F(KEY ,$$SITE^RC MSITE),99
	9502	9)
	9503	"RTN","RCC PCSV1",57, 0)
	9504	.I KEY']" " D KEYERR Q
	9505	"RTN","RCC PCSV1",58, 0)
	9506	.;PRCA4. 5313 - Fi nd Debtor using IEN from 349.2
	9507	"RTN","RCC PCSV1",59, 0)
	9508	.S IEN=$O (^RCPS(349 .2,"AKEY", KEY,0))
	9509	"RTN","RCC PCSV1",60, 0)
	9510	.I '$G(IE N) D KEYER R Q
	9511	"RTN","RCC PCSV1",61, 0)
	9512	.S DEB=$P ($G(^RCPS( 349.2,IEN, 0)),U)
	9513	"RTN","RCC PCSV1",62, 0)
	9514	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	9515	"RTN","RCC PCSV1",63, 0)
	9516	.I IEN S END=$P(^RC PS(349.2,+ IEN,0),"^" ,10)
	9517	"RTN","RCC PCSV1",64, 0)
	9518	.S:'$G(EN D) END=$O( ^RCPS(349. 2,"STDT",S DAT,0)),EN D=$P($G(^( +END,0))," ^",10)
	9519	"RTN","RCC PCSV1",65, 0)
	9520	.F P=13:1 :17 S SBAL (P)=$P(^RC PS(349.2,+ IEN,0),"^" ,P)
	9521	"RTN","RCC PCSV1",66, 0)
	9522	.;update patient st atement da te in 341 to end pro cess time
	9523	"RTN","RCC PCSV1",67, 0)
	9524	.D OPEN^R CEVDRV1(2, $P(^RCD(34 0,DEB,0),U ),END,DUZ, $$SITE^RCM SITE,.ERR, .EVN,SBAL
	9525	(13)_U_SBA L(14)_U_SB AL(15)_U_S BAL(16)_U_ SBAL(17))
	9526	"RTN","RCC PCSV1",68, 0)
	9527	.I EVN S DR=".07/// /"_END_";. 11////"_1, DA=+EVN,DI E="^RC(341 ," D ^DIE K DIE,DR,
	9528	DA
	9529	"RTN","RCC PCSV1",69, 0)
	9530	.; PRCA4 .5313 - A dd cross-r eference f or File
	9531	"RTN","RCC PCSV1",70, 0)
	9532	.I EVN S $P(^RC(341 ,+EVN,6)," ^")=$G(SDA T) D
	9533	"RTN","RCC PCSV1",71, 0)
	9534	. .S DA=+ EVN,DIK="^ RC(341," D IX1^DIK
	9535	"RTN","RCC PCSV1",72, 0)
	9536	.;update bill file 430 letter fields
	9537	"RTN","RCC PCSV1",73, 0)
	9538	.NEW BN,D A,DIC,DIE, DR,II,LET, NOT,X,Y
	9539	"RTN","RCC PCSV1",74, 0)
	9540	.S DIE="^ PRCA(430," ,NOT=0,BN= 0
	9541	"RTN","RCC PCSV1",75, 0)
	9542	.F S BN= $O(^PRCA(4 30,"AS",DE B,16,BN)) Q:'BN S D A=BN D
	9543	"RTN","RCC PCSV1",76, 0)
	9544	..S LET=$ G(^PRCA(43 0,BN,6))
	9545	"RTN","RCC PCSV1",77, 0)
	9546	..I $P(LE T,"^",21)> END Q
	9547	"RTN","RCC PCSV1",78, 0)
	9548	..S END=$ G(SDAT)
	9549	"RTN","RCC PCSV1",79, 0)
	9550	..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=
	9551	3:63,1:68) _"////^S X ="_END_";6 8.1////^S X="_END D ^DIE Q
	9552	"RTN","RCC PCSV1",80, 0)
	9553	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	9554	"RTN","RCC PCSV1",81, 0)
	9555	.S ^RCPS( 349.2,+IEN ,6)=1
	9556	"RTN","RCC PCSV1",82, 0)
	9557	PAMAIL ;
	9558	"RTN","RCC PCSV1",83, 0)
	9559	N XMSUB,X MY,XMDUZ,X MTEXT,MSG
	9560	"RTN","RCC PCSV1",84, 0)
	9561	; PRCA4. 5313 - Ch ange to CB SS
	9562	"RTN","RCC PCSV1",85, 0)
	9563	S XMSUB=" Patient Ac knowledgem ents recei ved from C BSS."
	9564	"RTN","RCC PCSV1",86, 0)
	9565	S XMY("G. RCCPC STAT EMENTS")=" ",XMDUZ="A R PACKAGE" ,XMTEXT="M SG("
	9566	"RTN","RCC PCSV1",87, 0)
	9567	; PRCA4. 5313 - Ad d Patient Statement Date and r enumber ot her lines
	9568	"RTN","RCC PCSV1",88, 0)
	9569	S MSG(1)= "For Patie nt Stateme nt Date of "_SDT_"."
	9570	"RTN","RCC PCSV1",89, 0)
	9571	S MSG(2)= "Patient a cknowledge ment messa ge "_$G(XM Z)_" recei ved."
	9572	"RTN","RCC PCSV1",90, 0)
	9573	S MSG(3)= "This mean s that CBS S has prin ted patien t statemen ts for thi s stateme
	9574	nt period. "
	9575	"RTN","RCC PCSV1",91, 0)
	9576	D ^XMD
	9577	"RTN","RCC PCSV1",92, 0)
	9578	Q
	9579	"RTN","RCC PCSV1",93, 0)
	9580	;
	9581	"RTN","RCC PCSV1",94, 0)
	9582	CHKTRAN(LA BEL) ;Chec k for inco mplete mes sage from CCPC
	9583	"RTN","RCC PCSV1",95, 0)
	9584	; PRCA4. 5313 - Ad d multiple entries b ased upon date to fo ur level
	9585	"RTN","RCC PCSV1",96, 0)
	9586	Q:$G(LABE L)']""
	9587	"RTN","RCC PCSV1",97, 0)
	9588	N PSIEN,D A,DIK,DO,D IC,X
	9589	"RTN","RCC PCSV1",98, 0)
	9590	S LABEL(1 )=+$O(^RCT (349.1,"B" ,LABEL,0))
	9591	"RTN","RCC PCSV1",99, 0)
	9592	; PRCA4. 5313 - Ad d Patient Statement Date to fo ur level
	9593	"RTN","RCC PCSV1",100 ,0)
	9594	I LABEL(1 ),$P(^TMP( $J,"MSG",R CMSG),"^", 2)=$P(^TMP ($J,"MSG", RCMSG),"^" ,3) D
	9595	"RTN","RCC PCSV1",101 ,0)
	9596	. S DIC=" ^RCT(349.1 ,LABEL(1), 4,"
	9597	"RTN","RCC PCSV1",102 ,0)
	9598	. S X=$P( ^TMP($J,"M SG",RCMSG) ,"^",2)
	9599	"RTN","RCC PCSV1",103 ,0)
	9600	. S DA(1) =LABEL(1), DIC(0)="L"
	9601	"RTN","RCC PCSV1",104 ,0)
	9602	. S DIC(" DR")=".02/ ///"_$P(^T MP($J,"MSG ",RCMSG)," ^",3)_";.0 3////"_$G( XMZ)_";.0
	9603	4////"_SDA T
	9604	"RTN","RCC PCSV1",105 ,0)
	9605	. D FILE^ DICN
	9606	"RTN","RCC PCSV1",106 ,0)
	9607	Q
	9608	"RTN","RCC PCSV1",107 ,0)
	9609	;
	9610	"RTN","RCC PCSV1",108 ,0)
	9611	TRANCHK ;C heck for c omplete AC K transmis sion
	9612	"RTN","RCC PCSV1",109 ,0)
	9613	; PRCA4. 5313 - Ch eck for st atement da tes five t o seven da ys in past since bu
	9614	ild and tr ansmit.
	9615	"RTN","RCC PCSV1",110 ,0)
	9616	N X,Y,DAT E,SDT,I,X1 ,X2
	9617	"RTN","RCC PCSV1",111 ,0)
	9618	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
	9619	"RTN","RCC PCSV1",112 ,0)
	9620	Q
	9621	"RTN","RCC PCSV1",113 ,0)
	9622	;
	9623	"RTN","RCC PCSV1",114 ,0)
	9624	TRANCHK1 ; PRCA4.5 313 - Vali date trans mission co mpleteness for date provided.
	9625	"RTN","RCC PCSV1",115 ,0)
	9626	N MSG,RCT ,SEG,SEQ,C NT,IEN,XMD UZ,XMSUB,X MTEXT,XMY
	9627	"RTN","RCC PCSV1",116 ,0)
	9628	F RCT=3,4 S CNT=$O( ^RCT(349.1 ,RCT,4,"ST DT4",SDT,0 )) I CNT'= "" D
	9629	"RTN","RCC PCSV1",117 ,0)
	9630	.S IEN=$O (^RCT(349. 1,RCT,4,"S TDT4",SDT, CNT,0)) D
	9631	"RTN","RCC PCSV1",118 ,0)
	9632	..I IEN'= "",$P($G(^ RCT(349.1, +RCT,4,IEN ,0)),"^")' =$P($G(^RC T(349.1,+R CT,4,IEN,
	9633	0)),"^",2) D TRANSEN D
	9634	"RTN","RCC PCSV1",119 ,0)
	9635	Q
	9636	"RTN","RCC PCSV1",120 ,0)
	9637	;
	9638	"RTN","RCC PCSV1",121 ,0)
	9639	TRANSEND ; PRCA4.5 313 Send Transmissi on
	9640	"RTN","RCC PCSV1",122 ,0)
	9641	S XMDUZ=" AR PACKAGE "
	9642	"RTN","RCC PCSV1",123 ,0)
	9643	; PRCA4. 5313 - Ch ange CCPC to CBSS
	9644	"RTN","RCC PCSV1",124 ,0)
	9645	S XMSUB=" CBSS ACKNO WLEDGEMENT TRANSMISS ION(S) INC OMPLETE"
	9646	"RTN","RCC PCSV1",125 ,0)
	9647	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= "" E S X
	9648	MY(.5)=""
	9649	"RTN","RCC PCSV1",126 ,0)
	9650	S XMTEXT= "MSG("
	9651	"RTN","RCC PCSV1",127 ,0)
	9652	S SEG=$S( RCT=3:"IS" ,1:"PA")
	9653	"RTN","RCC PCSV1",128 ,0)
	9654	S SEG(1)= $P(^RCT(34 9.1,+RCT,4 ,IEN,0),"^ ",2)
	9655	"RTN","RCC PCSV1",129 ,0)
	9656	; PRCA4. 5313 - Ad d line ide ntifying P atient Sta tement Dat e that err ored
	9657	"RTN","RCC PCSV1",130 ,0)
	9658	S MSG(2)= "For Patie nt Stateme nt Date of "_DATE_". "
	9659	"RTN","RCC PCSV1",131 ,0)
	9660	; PRCA4. 5313 - Ch ange CCPC to CBSS
	9661	"RTN","RCC PCSV1",132 ,0)
	9662	S MSG(3)= "The last "_SEG_" se gment mess age receiv ed from CB SS was num bered "_S
	9663	EG(1)_"."
	9664	"RTN","RCC PCSV1",133 ,0)
	9665	S MSG(4)= "This was not labele d the fina l message in that se gment type transmis
	9666	sion."
	9667	"RTN","RCC PCSV1",134 ,0)
	9668	S MSG(5)= "This may cause pati ent statem ent inform ation to b e missing. "
	9669	"RTN","RCC PCSV1",135 ,0)
	9670	S MSG(6)= "The last message nu mber recei ved was "_ $P($G(^RCT (349.1,RCT ,4,IEN,0)
	9671	),"^",3)_" ."
	9672	"RTN","RCC PCSV1",136 ,0)
	9673	; PRCA4 .5313 - C hange CCPC to CBSS
	9674	"RTN","RCC PCSV1",137 ,0)
	9675	S MSG(7)= "Please co ntact the CBSS in Au stin."
	9676	"RTN","RCC PCSV1",138 ,0)
	9677	D ^XMD
	9678	"RTN","RCC PCSV1",139 ,0)
	9679	Q
	9680	"RTN","RCC PCSV1",140 ,0)
	9681	;
	9682	"RTN","RCC PCSV1",141 ,0)
	9683	;
	9684	"RTN","RCC PCSV1",142 ,0)
	9685	IT ;INVALI D TRANSMIS SION
	9686	"RTN","RCC PCSV1",143 ,0)
	9687	; PRCA4. 5313 - Ch ange messa ge from CC PC to CBSS
	9688	"RTN","RCC PCSV1",144 ,0)
	9689	N SDT,ERR ,MSG,RCX,R CX1,ERROR, RE
	9690	"RTN","RCC PCSV1",145 ,0)
	9691	S ERR="Th e CBSS pat ient state ment messa ges were n ot accepte d by CBSS" D ERRMSG
	9692	"RTN","RCC PCSV1",146 ,0)
	9693	; PRCA4. 5313 - Ad d statemen t date to error mess age
	9694	"RTN","RCC PCSV1",147 ,0)
	9695	S SDT=$P( ^TMP($J,"M SG",RCMSG) ,"^",6)
	9696	"RTN","RCC PCSV1",148 ,0)
	9697	S ERR="fo r "_SDT_" due to the following error(s): " D ERRMSG
	9698	"RTN","RCC PCSV1",149 ,0)
	9699	S ERR=" " D ERRMSG
	9700	"RTN","RCC PCSV1",150 ,0)
	9701	S RCMSG=1 F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	9702	"RTN","RCC PCSV1",151 ,0)
	9703	.S MSG=^T MP($J,"MSG ",RCMSG)
	9704	"RTN","RCC PCSV1",152 ,0)
	9705	.S MSG=$P (MSG,"^",8 )
	9706	"RTN","RCC PCSV1",153 ,0)
	9707	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERROR=$E(M SG,RCX,RCX 1) Q:ERROR ="" D
	9708	"RTN","RCC PCSV1",154 ,0)
	9709	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERROR,"" ))
	9710	"RTN","RCC PCSV1",155 ,0)
	9711	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RROR
	9712	"RTN","RCC PCSV1",156 ,0)
	9713	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 ),ERR=ERRO R_" "_ERR
	9714	"RTN","RCC PCSV1",157 ,0)
	9715	..I ERR(1 ) S:$P(^RC PSE(349.7, +ERR(1),0) ,"^",3)="R " RE=1
	9716	"RTN","RCC PCSV1",158 ,0)
	9717	..D ERRMS G
	9718	"RTN","RCC PCSV1",159 ,0)
	9719	S ERR=" " D ERRMSG
	9720	"RTN","RCC PCSV1",160 ,0)
	9721	S ERR="Pl ease conta ct IRM."
	9722	"RTN","RCC PCSV1",161 ,0)
	9723	D ERRMSG
	9724	"RTN","RCC PCSV1",162 ,0)
	9725	Q
	9726	"RTN","RCC PCSV1",163 ,0)
	9727	;
	9728	"RTN","RCC PCSV1",164 ,0)
	9729	ERRMSG ;ER ROR MESSAG E
	9730	"RTN","RCC PCSV1",165 ,0)
	9731	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	9732	"RTN","RCC PCSV1",166 ,0)
	9733	Q
	9734	"RTN","RCC PCT")
	9735	0^15^B2933 0001^B2489 697
	9736	"RTN","RCC PCT",1,0)
	9737	RCCPCT ;WA SH-ISC@ALT OONA,PA/LD B - CCPC P atient Sta tement mes sage total s ;11/7/9
	9738	6 10:53 A M
	9739	"RTN","RCC PCT",2,0)
	9740	;;4.5;Acc ounts Rece ivable;3 4,313;Ma r 20, 1995 ;Build 124
	9741	"RTN","RCC PCT",3,0)
	9742	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9743	"RTN","RCC PCT",4,0)
	9744	EN ;
	9745	"RTN","RCC PCT",5,0)
	9746	D GO
	9747	"RTN","RCC PCT",6,0)
	9748	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
	9749	T,LAST
	9750	"RTN","RCC PCT",7,0)
	9751	Q
	9752	"RTN","RCC PCT",8,0)
	9753	GO ;
	9754	"RTN","RCC PCT",9,0)
	9755	W @IOF W !,"This re port will print the total Pati ent Statem ents sent to CBSS a
	9756	nd the"
	9757	"RTN","RCC PCT",10,0)
	9758	W !,"tota l acknowle dged as ha ving been printed wi th three d ifferent r eport"
	9759	"RTN","RCC PCT",11,0)
	9760	W !,"form ats availa ble."
	9761	"RTN","RCC PCT",12,0)
	9762	W !!,"The first for mat is jus t a single summary t otal repor t of all S tatement"
	9763	"RTN","RCC PCT",13,0)
	9764	W !,"Date s."
	9765	"RTN","RCC PCT",14,0)
	9766	W !!,"The second fo rmat is al l Statemen t Dates pr inted indi vidually w ith total
	9767	s"
	9768	"RTN","RCC PCT",15,0)
	9769	W !,"and a summary total at t he end."
	9770	"RTN","RCC PCT",16,0)
	9771	W !!,"The third for mat is pri nting the totals for a single Statement Date sele
	9772	cted.",!
	9773	"RTN","RCC PCT",17,0)
	9774	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9775	"RTN","RCC PCT",18,0)
	9776	S DIR(0)= "E" D ^DIR
	9777	"RTN","RCC PCT",19,0)
	9778	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9779	"RTN","RCC PCT",20,0)
	9780	S IEN="" F S IEN=$ O(^RCT(349 ,"SDT",IEN )) Q:IEN=" " S TDT(I EN)=""
	9781	"RTN","RCC PCT",21,0)
	9782	W @IOF W !!,"The fo llowing Pa tient Stat ement Date s are avai lable for the Total
	9783	s Report:" ,!
	9784	"RTN","RCC PCT",22,0)
	9785	S (TDT1,F IRST,LAST) ="" F S T DT1=$O(TDT (TDT1)) Q: TDT1="" D
	9786	"RTN","RCC PCT",23,0)
	9787	.S TDT3=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",T DT1,0)),0) ,"^",9) W !,$$DATE^R CCPCPS1(T
	9788	DT3)
	9789	"RTN","RCC PCT",24,0)
	9790	.I TDT3<F IRST S FIR ST=TDT3
	9791	"RTN","RCC PCT",25,0)
	9792	.I TDT3>L AST S LAST =TDT3
	9793	"RTN","RCC PCT",26,0)
	9794	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9795	"RTN","RCC PCT",27,0)
	9796	S DIR(0)= "YAO"
	9797	"RTN","RCC PCT",28,0)
	9798	S DIR("B" )="Y"
	9799	"RTN","RCC PCT",29,0)
	9800	S DIR("A" )="Do you want to pr int a sing le total f or ALL the available dates? "
	9801	"RTN","RCC PCT",30,0)
	9802	D ^DIR
	9803	"RTN","RCC PCT",31,0)
	9804	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9805	"RTN","RCC PCT",32,0)
	9806	I Y=1 D Q
	9807	"RTN","RCC PCT",33,0)
	9808	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	9809	"RTN","RCC PCT",34,0)
	9810	.I $D(IO( "Q")) D Q
	9811	"RTN","RCC PCT",35,0)
	9812	..S Q=1
	9813	"RTN","RCC PCT",36,0)
	9814	..S ZTRTN ="STARTS^R CCPCT",ZTD ESC="CBSS ALL PATIEN T STATEMEN TS TOTAL R EPORT"
	9815	"RTN","RCC PCT",37,0)
	9816	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	9817	"RTN","RCC PCT",38,0)
	9818	..D ^%ZTL OAD
	9819	"RTN","RCC PCT",39,0)
	9820	..K ZTRTN ,ZTDESC,ZT SAVE
	9821	"RTN","RCC PCT",40,0)
	9822	.E D STA RTS Q
	9823	"RTN","RCC PCT",41,0)
	9824	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9825	"RTN","RCC PCT",42,0)
	9826	S DIR(0)= "YAO"
	9827	"RTN","RCC PCT",43,0)
	9828	S DIR("B" )="Y"
	9829	"RTN","RCC PCT",44,0)
	9830	S DIR("A" )="Do you want to pr int separa te totals for ALL th e availabl e dates?
	9831	"
	9832	"RTN","RCC PCT",45,0)
	9833	D ^DIR
	9834	"RTN","RCC PCT",46,0)
	9835	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9836	"RTN","RCC PCT",47,0)
	9837	I Y=1 D Q
	9838	"RTN","RCC PCT",48,0)
	9839	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	9840	"RTN","RCC PCT",49,0)
	9841	.I $D(IO( "Q")) D Q
	9842	"RTN","RCC PCT",50,0)
	9843	..S Q=1
	9844	"RTN","RCC PCT",51,0)
	9845	..S ZTRTN ="START^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	9846	"RTN","RCC PCT",52,0)
	9847	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	9848	"RTN","RCC PCT",53,0)
	9849	..D ^%ZTL OAD
	9850	"RTN","RCC PCT",54,0)
	9851	..K ZTRTN ,ZTDESC,ZT SAVE
	9852	"RTN","RCC PCT",55,0)
	9853	.E D STA RT Q
	9854	"RTN","RCC PCT",56,0)
	9855	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9856	"RTN","RCC PCT",57,0)
	9857	S DIR(0)= "DAO^"_FIR ST_":"_LAS T_":EX^K:' $D(TDT(+$E (Y,6,7))) X"
	9858	"RTN","RCC PCT",58,0)
	9859	S DIR("A" )="Enter a single Pa tient Stat ement date from list above: "
	9860	"RTN","RCC PCT",59,0)
	9861	S DIR("?" )="Enter a single Pa tient Stat ement date from list above or ^ to exit
	9862	."
	9863	"RTN","RCC PCT",60,0)
	9864	D ^DIR
	9865	"RTN","RCC PCT",61,0)
	9866	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9867	"RTN","RCC PCT",62,0)
	9868	S Y1=+$E( Y,6,7),Y2= Y
	9869	"RTN","RCC PCT",63,0)
	9870	;I '$D(TD T(Y1)) W ! ,"There ar e no recor ds for tha t date." Q
	9871	"RTN","RCC PCT",64,0)
	9872	D HOME^%Z IS S %ZIS= "AEQ" D ^% ZIS Q:POP
	9873	"RTN","RCC PCT",65,0)
	9874	I $D(IO(" Q")) D Q
	9875	"RTN","RCC PCT",66,0)
	9876	.S Q=1
	9877	"RTN","RCC PCT",67,0)
	9878	.S ZTRTN= "START1^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	9879	"RTN","RCC PCT",68,0)
	9880	.S ZTSAVE ("Q")="",Z TSAVE("Y1" )="",ZTSAV E("Y2")=""
	9881	"RTN","RCC PCT",69,0)
	9882	.D ^%ZTLO AD
	9883	"RTN","RCC PCT",70,0)
	9884	.K ZTRTN, ZTDESC,ZTS AVE
	9885	"RTN","RCC PCT",71,0)
	9886	START1 ;Th is will pr int a summ ary total for a sing le date
	9887	"RTN","RCC PCT",72,0)
	9888	N PTOT,TT OT,X,D
	9889	"RTN","RCC PCT",73,0)
	9890	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9891	"RTN","RCC PCT",74,0)
	9892	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
	9893	TTOT=$P(^R CT(349,X,0 ),"^",7)+T TOT
	9894	"RTN","RCC PCT",75,0)
	9895	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,"STD T",Y2,X)) Q:'X I $G (^RCPS(349 .2,X,6))
	9896	S PTOT=PTO T+1
	9897	"RTN","RCC PCT",76,0)
	9898	I IOST?1" C".E W @IO F
	9899	"RTN","RCC PCT",77,0)
	9900	W !,?10," CBSS Messa ge Totals for ",$$DA TE^RCCPCPS 1(Y2),!!
	9901	"RTN","RCC PCT",78,0)
	9902	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	9903	"RTN","RCC PCT",79,0)
	9904	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	9905	"RTN","RCC PCT",80,0)
	9906	W !,"==== ========== ========== ======="
	9907	"RTN","RCC PCT",81,0)
	9908	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	9909	"RTN","RCC PCT",82,0)
	9910	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	9911	"RTN","RCC PCT",83,0)
	9912	Q
	9913	"RTN","RCC PCT",84,0)
	9914	START ;Thi s will pri nt separat e totals f or all ava ilable sta tement dat es
	9915	"RTN","RCC PCT",85,0)
	9916	N PTOT,TT OT,X,X1,DA TE
	9917	"RTN","RCC PCT",86,0)
	9918	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9919	"RTN","RCC PCT",87,0)
	9920	S (TTOT,P TOT,X,X1)= 0 S DATE=" "
	9921	"RTN","RCC PCT",88,0)
	9922	U IO S (T DT1,TDT2)= ""
	9923	"RTN","RCC PCT",89,0)
	9924	I IOST?1" C".E W @IO F
	9925	"RTN","RCC PCT",90,0)
	9926	F S TDT1 =$O(TDT(TD T1)) Q:TDT 1="" D I $D(DTOUT) !$D(DUOUT) !$D(DIRUT) !$D(DIROU
	9927	T) Q
	9928	"RTN","RCC PCT",91,0)
	9929	.I X="^" Q
	9930	"RTN","RCC PCT",92,0)
	9931	.S TTOT=0
	9932	"RTN","RCC PCT",93,0)
	9933	.F S TDT 2=$O(^RCT( 349,"SDT", TDT1,TDT2) ) Q:TDT2=" " D
	9934	"RTN","RCC PCT",94,0)
	9935	..S Y=$P( ^RCT(349,T DT2,0),"^" ,9)
	9936	"RTN","RCC PCT",95,0)
	9937	..S Y1=+$ E(Y,3,4),D ATE=$$DATE ^RCCPCPS1( Y)
	9938	"RTN","RCC PCT",96,0)
	9939	..S X=Y D ^%DT
	9940	"RTN","RCC PCT",97,0)
	9941	..I $D(^R CT(349,TDT 2,0)) S TT OT=$P(^RCT (349,TDT2, 0),"^",7)+ TTOT
	9942	"RTN","RCC PCT",98,0)
	9943	..S PTOT= 0,X1="" I $D(^RCPS(3 49.2,"STDT ",Y)) F S X1=$O(^RC PS(349.2," STDT",Y,X
	9944	1)) Q:'X1 I $G(^RCP S(349.2,X1 ,6)) S PTO T=PTOT+1
	9945	"RTN","RCC PCT",99,0)
	9946	.W !,?10, "CBSS Mess age Totals for ",DAT E,!!
	9947	"RTN","RCC PCT",100,0 )
	9948	.W "Trans mission St atement To tal : ",$ J(TTOT,9)
	9949	"RTN","RCC PCT",101,0 )
	9950	.W !,"CBS S Statemen ts Printed Total : " ,$J(PTOT,9 )
	9951	"RTN","RCC PCT",102,0 )
	9952	.W !,"=== ========== ========== ========"
	9953	"RTN","RCC PCT",103,0 )
	9954	.W !,"Tot al Not Pri nted : " ,$J(TTOT-P TOT,9),!
	9955	"RTN","RCC PCT",104,0 )
	9956	.I '$D(Q) I $Y+4>IO SL D
	9957	"RTN","RCC PCT",105,0 )
	9958	..S DIR(0 )="E" D ^D IR I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	9959	"RTN","RCC PCT",106,0 )
	9960	..W @IOF
	9961	"RTN","RCC PCT",107,0 )
	9962	I X="^" Q
	9963	"RTN","RCC PCT",108,0 )
	9964	W !!!," ****** ****** ****** ****** ******** *"
	9965	"RTN","RCC PCT",109,0 )
	9966	STARTS ; T his will p rint the s ummary tot al for ALL available statement s
	9967	"RTN","RCC PCT",110,0 )
	9968	N DATE,PT OT,TTOT,X, D
	9969	"RTN","RCC PCT",111,0 )
	9970	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9971	"RTN","RCC PCT",112,0 )
	9972	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
	9973	)) Q:X="" I $D(^RCT (349,X,0)) S TTOT=$P (^RCT(349, X,0),"^",7 )+TTOT
	9974	"RTN","RCC PCT",113,0 )
	9975	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,X)) Q:'X I $G (^(X,6)) S PTOT=PTOT +1
	9976	"RTN","RCC PCT",114,0 )
	9977	W !!,?10, "CBSS Mess age Totals for ALL a vailable d ates ",!!
	9978	"RTN","RCC PCT",115,0 )
	9979	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	9980	"RTN","RCC PCT",116,0 )
	9981	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	9982	"RTN","RCC PCT",117,0 )
	9983	W !,"==== ========== ========== ======="
	9984	"RTN","RCC PCT",118,0 )
	9985	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	9986	"RTN","RCC PCT",119,0 )
	9987	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	9988	"RTN","RCD PBTLM")
	9989	0^26^B5588 5939^B4947 6140
	9990	"RTN","RCD PBTLM",1,0 )
	9991	RCDPBTLM ; WISC/RFJ - bill tran sactions L ist Manage r top rout ine ;1 Jun 99
	9992	"RTN","RCD PBTLM",2,0 )
	9993	;;4.5;Acc ounts Rece ivable;1 14,148,153 ,168,169,1 98,247,271 ,276,313 ;Mar 20,
	9994	1995;Build 124
	9995	"RTN","RCD PBTLM",3,0 )
	9996	;;Per VHA Directive 2004-038, this rout ine should not be mo dified.Sub j: PRCA4. 5313 TEST v9 [#852 26764] P age 2
	9997	---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
	9998	"RTN","RCD PBTLM",4,0 )
	9999	;
	10000	"RTN","RCD PBTLM",5,0 )
	10001	; Referen ce to $$RE C^IBRFN su pported by DBIA 2031
	10002	"RTN","RCD PBTLM",6,0 )
	10003	;
	10004	"RTN","RCD PBTLM",7,0 )
	10005	; called from menu option (1 9)
	10006	"RTN","RCD PBTLM",8,0 )
	10007	;
	10008	"RTN","RCD PBTLM",9,0 )
	10009	N RCBILLD A,RCDPFXIT
	10010	"RTN","RCD PBTLM",10, 0)
	10011	;
	10012	"RTN","RCD PBTLM",11, 0)
	10013	F D Q:' RCBILLDA
	10014	"RTN","RCD PBTLM",12, 0)
	10015	. W !! S RCBILLDA =$$SELBILL
	10016	"RTN","RCD PBTLM",13, 0)
	10017	. I RCB ILLDA<1 S RCBILLDA=0 Q
	10018	"RTN","RCD PBTLM",14, 0)
	10019	. D EN^ VALM("RCDP TRANSACTI ONS LIST")
	10020	"RTN","RCD PBTLM",15, 0)
	10021	. ; fa st exit
	10022	"RTN","RCD PBTLM",16, 0)
	10023	. I $G( RCDPFXIT) S RCBILLDA =0
	10024	"RTN","RCD PBTLM",17, 0)
	10025	Q
	10026	"RTN","RCD PBTLM",18, 0)
	10027	;
	10028	"RTN","RCD PBTLM",19, 0)
	10029	;
	10030	"RTN","RCD PBTLM",20, 0)
	10031	INIT ; in itializati on for lis t manager list
	10032	"RTN","RCD PBTLM",21, 0)
	10033	; requir es rcbilld a
	10034	"RTN","RCD PBTLM",22, 0)
	10035	N ADMIN,D ATE,RCLINE ,RCLIST,RC TOTAL,RCTR AN,RCTRAND A
	10036	"RTN","RCD PBTLM",23, 0)
	10037	K ^TMP("R CDPBTLM",$ J),^TMP("V ALM VIDEO" ,$J)
	10038	"RTN","RCD PBTLM",24, 0)
	10039	;
	10040	"RTN","RCD PBTLM",25, 0)
	10041	; fast e xit
	10042	"RTN","RCD PBTLM",26, 0)
	10043	I $G(RCDP FXIT) S VA LMQUIT=1 Q
	10044	"RTN","RCD PBTLM",27, 0)
	10045	;
	10046	"RTN","RCD PBTLM",28, 0)
	10047	; set th e List Man ager line number
	10048	"RTN","RCD PBTLM",29, 0)
	10049	S RCLINE= 0
	10050	"RTN","RCD PBTLM",30, 0)
	10051	; set th e List Man ager trans action num ber
	10052	"RTN","RCD PBTLM",31, 0)
	10053	S RCTRAN= 0
	10054	"RTN","RCD PBTLM",32, 0)
	10055	;
	10056	"RTN","RCD PBTLM",33, 0)
	10057	; get tr ansactions and balan ce for bil l
	10058	"RTN","RCD PBTLM",34, 0)
	10059	S RCTOTAL =$$GETTRAN S(RCBILLDA )
	10060	"RTN","RCD PBTLM",35, 0)
	10061	;
	10062	"RTN","RCD PBTLM",36, 0)
	10063	S DATE="" F S DATE =$O(RCLIST (DATE)) Q: 'DATE D
	10064	"RTN","RCD PBTLM",37, 0)
	10065	. S RCT RANDA="" F S RCTRAN DA=$O(RCLI ST(DATE,RC TRANDA)) Q :RCTRANDA= "" D
	10066	"RTN","RCD PBTLM",38, 0)
	10067	. . S RCLINE=RC LINE+1
	10068	"RTN","RCD PBTLM",39, 0)
	10069	. . ;
	10070	"RTN","RCD PBTLM",40, 0)
	10071	. . ; create a n index ar ray for tr ansaction lookup in list
	10072	"RTN","RCD PBTLM",41, 0)
	10073	. . I RCTRANDA D
	10074	"RTN","RCD PBTLM",42, 0)
	10075	. . . S RCTRA N=RCTRAN+1
	10076	"RTN","RCD PBTLM",43, 0)
	10077	. . . S ^TMP( "RCDPBTLM" ,$J,"IDX", RCTRAN,RCT RAN)=RCTRA NDA
	10078	"RTN","RCD PBTLM",44, 0)
	10079	. . . D SET^R CDPAPLI(RC TRAN,RCLIN E,1,80,0,I ORVON,IORV OFF)
	10080	"RTN","RCD PBTLM",45, 0)
	10081	. . ;
	10082	"RTN","RCD PBTLM",46, 0)
	10083	. . D SET^RCDPA PLI($S(RCT RANDA:RCTR ANDA,1:" " ),RCLINE,4 ,80)
	10084	"RTN","RCD PBTLM",47, 0)
	10085	. . D SET^RCDPA PLI($E(DAT E,4,5)_"/" _$E(DATE,6 ,7)_"/"_$E (DATE,2,3) ,RCLINE,1
	10086	3,21)
	10087	"RTN","RCD PBTLM",48, 0)
	10088	. . D SET^RCDPA PLI($TR($P (RCLIST(DA TE,RCTRAND A),"^"),"A BCDEFGHIJK LMNOPQRST
	10089	UVWXYZ","a bcdefghijk lmnopqrstu vwxyz"),RC LINE,25,50 )
	10090	"RTN","RCD PBTLM",49, 0)
	10091	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),"^",2),9 ,2),RCLINE ,53,62)
	10092	"RTN","RCD PBTLM",50, 0)
	10093	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),"^",3),9 ,2),RCLINE ,62,71)
	10094	"RTN","RCD PBTLM",51, 0)
	10095	. . ; add mars hal fee an d court co st to crea te admin d ollars
	10096	"RTN","RCD PBTLM",52, 0)
	10097	. . S ADMIN=$P( RCLIST(DAT E,RCTRANDA ),"^",4)+$ P(RCLIST(D ATE,RCTRAN DA),"^",5
	10098	)+$P(RCLIS T(DATE,RCT RANDA),"^" ,6)
	10099	"RTN","RCD PBTLM",53, 0)
	10100	. . D SET^RCDPA PLI($J(ADM IN,9,2),RC LINE,71,80 )
	10101	"RTN","RCD PBTLM",54, 0)
	10102	;
	10103	"RTN","RCD PBTLM",55, 0)
	10104	; show t otals
	10105	"RTN","RCD PBTLM",56, 0)
	10106	S RCLINE= RCLINE+1
	10107	"RTN","RCD PBTLM",57, 0)
	10108	D SET^RCD PAPLI(" - --------
	10109	-------- - -------",R CLINE,1,80 )
	10110	"RTN","RCD PBTLM",58, 0)
	10111	S RCLINE= RCLINE+1
	10112	"RTN","RCD PBTLM",59, 0)
	10113	D SET^RCD PAPLI(" TOTAL BALA NCE FOR BI LL",RCLINE ,1,80)
	10114	"RTN","RCD PBTLM",60, 0)
	10115	D SET^RCD PAPLI($J($ P(RCTOTAL, "^",1),9,2 ),RCLINE,5 3,62)
	10116	"RTN","RCD PBTLM",61, 0)
	10117	D SET^RCD PAPLI($J($ P(RCTOTAL, "^",2),9,2 ),RCLINE,6 2,71)
	10118	"RTN","RCD PBTLM",62, 0)
	10119	D SET^RCD PAPLI($J($ P(RCTOTAL, "^",3)+$P( RCTOTAL,"^ ",4)+$P(RC TOTAL,"^", 5),9,2),R
	10120	CLINE,71,8 0)
	10121	"RTN","RCD PBTLM",63, 0)
	10122	;
	10123	"RTN","RCD PBTLM",64, 0)
	10124	; compar e totals t o what is stored in the file
	10125	"RTN","RCD PBTLM",65, 0)
	10126	N RCDATA7 ,RCFOUT
	10127	"RTN","RCD PBTLM",66, 0)
	10128	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
	10129	"RTN","RCD PBTLM",67, 0)
	10130	; for a write-off bill, the balance sh ould equal all zeros , for
	10131	"RTN","RCD PBTLM",68, 0)
	10132	; these bills, nod e 7 is the write-off amount, s o for the out of
	10133	"RTN","RCD PBTLM",69, 0)
	10134	; balanc e check to work, nod e 7 needs to be adju sted to al l zeros
	10135	"RTN","RCD PBTLM",70, 0)
	10136	I $P(^PRC A(430,RCBI LLDA,0),"^ ",8)=23 S RCDATA7="0 ^0^0^0^0"
	10137	"RTN","RCD PBTLM",71, 0)
	10138	I +$P(RCD ATA7,"^",1 )'=+$P(RCT OTAL,"^",1 ) S RCFOUT =1
	10139	"RTN","RCD PBTLM",72, 0)
	10140	I +$P(RCD ATA7,"^",2 )'=+$P(RCT OTAL,"^",2 ) S RCFOUT =1
	10141	"RTN","RCD PBTLM",73, 0)
	10142	I ($P(RCD ATA7,"^",3 )+$P(RCDAT A7,"^",4)+ $P(RCDATA7 ,"^",5))'= +$P(RCTOTA L,"^",3)
	10143	S RCFOUT=1
	10144	"RTN","RCD PBTLM",74, 0)
	10145	I $G(RCFO UT) D
	10146	"RTN","RCD PBTLM",75, 0)
	10147	. S RCL INE=RCLINE +1
	10148	"RTN","RCD PBTLM",76, 0)
	10149	. D SET ^RCDPAPLI( " ",RCLINE ,1,80)
	10150	"RTN","RCD PBTLM",77, 0)
	10151	. S RCL INE=RCLINE +1
	10152	"RTN","RCD PBTLM",78, 0)
	10153	. D SET ^RCDPAPLI( " STORED BALANCE FO R BILL ( INCORRECT )",RCLI NE,1,80)
	10154	"RTN","RCD PBTLM",79, 0)
	10155	. D SET ^RCDPAPLI( $J($P(RCDA TA7,"^",1) ,9,2),RCLI NE,53,62)
	10156	"RTN","RCD PBTLM",80, 0)
	10157	. D SET ^RCDPAPLI( $J($P(RCDA TA7,"^",2) ,9,2),RCLI NE,62,71)
	10158	"RTN","RCD PBTLM",81, 0)
	10159	. D SET ^RCDPAPLI( $J($P(RCDA TA7,"^",3) +$P(RCDATA 7,"^",4)+$ P(RCDATA7, "^",5),9,
	10160	2),RCLINE, 71,80)
	10161	"RTN","RCD PBTLM",82, 0)
	10162	;
	10163	"RTN","RCD PBTLM",83, 0)
	10164	; set va lmcnt to n umber of l ines in th e list
	10165	"RTN","RCD PBTLM",84, 0)
	10166	S VALMCNT =RCLINE
	10167	"RTN","RCD PBTLM",85, 0)
	10168	D HDR
	10169	"RTN","RCD PBTLM",86, 0)
	10170	Q
	10171	"RTN","RCD PBTLM",87, 0)
	10172	;
	10173	"RTN","RCD PBTLM",88, 0)
	10174	;
	10175	"RTN","RCD PBTLM",89, 0)
	10176	HDR ; hea der code f or list ma nager disp lay
	10177	"RTN","RCD PBTLM",90, 0)
	10178	; requir es rcbilld a
	10179	"RTN","RCD PBTLM",91, 0)
	10180	N %,DATA, RCDEBTDA,R CDPDATA
	10181	"RTN","RCD PBTLM",92, 0)
	10182	;
	10183	"RTN","RCD PBTLM",93, 0)
	10184	D DIQ430^ RCDPBPLM(R CBILLDA,". 01;8;")
	10185	"RTN","RCD PBTLM",94, 0)
	10186	;
	10187	"RTN","RCD PBTLM",95, 0)
	10188	S RCDEBTD A=$P(^PRCA (430,RCBIL LDA,0),"^" ,9)
	10189	"RTN","RCD PBTLM",96, 0)
	10190	S DATA=$$ ACCNTHDR^R CDPAPLM(RC DEBTDA)
	10191	"RTN","RCD PBTLM",97, 0)
	10192	;
	10193	"RTN","RCD PBTLM",98, 0)
	10194	S %="",$P (%," ",80) =""
	10195	"RTN","RCD PBTLM",99, 0)
	10196	; PRCA4. 5276 - ge t EEOB ind icator for 1st/3rd p arty payme nt and att ach to bi
	10197	ll when ap plicable
	10198	"RTN","RCD PBTLM",100 ,0)
	10199	S PRCOUT= $$COMP3^PR CAAPR(RCBI LLDA)
	10200	"RTN","RCD PBTLM",101 ,0)
	10201	I PRCOUT' ="%" S PRC OUT=$$IBEE OBCK^PRCAA PR1(RCBILL DA)
	10202	"RTN","RCD PBTLM",102 ,0)
	10203	S VALMHDR (1)=$E("Bi ll #: "_$G (PRCOUT)_$ G(RCDPDATA (430,RCBIL LDA,.01,"E "))_%,1,2
	10204	5)_"Accoun t: "_$P(DA TA,"^")_$P (DATA,"^", 2)
	10205	"RTN","RCD PBTLM",103 ,0)
	10206	S VALMHDR (2)=$E("St atus: "_$G (RCDPDATA( 430,RCBILL DA,8,"E")) _%,1,25)_$ E(" Add
	10207	r: "_$P(DA TA,"^",4)_ ", "_$P(DA TA,"^",7)_ ", "_$P(DA TA,"^",8)_ " "_$P(DA TA,"^",9)
	10208	_%,1,55)
	10209	"RTN","RCD PBTLM",104 ,0)
	10210	; PRCA4. 5276 - sh ow caption for user
	10211	"RTN","RCD PBTLM",105 ,0)
	10212	S VALMSG= "\|% EEOB \| Enter ?? for more a ctions \|" ; PRCA4.5 276
	10213	"RTN","RCD PBTLM",106 ,0)
	10214	Q
	10215	"RTN","RCD PBTLM",107 ,0)
	10216	S VALMHDR (3)=" "_I ORVON_$E(" Bill Balan ce: "_$J($ P(RCTOTAL, "^")+$P(RC TOTAL,"^"
	10217	,2)+$P(RCT OTAL,"^",3 )+$P(RCTOT AL,"^",4)+ $P(RCTOTAL ,"^",5),0, 2)_%,1,23) _IORVOFF_
	10218	" Phone: "_$P(DATA, "^",10)
	10219	"RTN","RCD PBTLM",108 ,0)
	10220	Q
	10221	"RTN","RCD PBTLM",109 ,0)
	10222	;
	10223	"RTN","RCD PBTLM",110 ,0)
	10224	;
	10225	"RTN","RCD PBTLM",111 ,0)
	10226	EXIT ; ex it list ma nager opti on and cle an up
	10227	"RTN","RCD PBTLM",112 ,0)
	10228	K ^TMP("R CDPBTLM",$ J),^TMP("R CDPBTLMX", $J)
	10229	"RTN","RCD PBTLM",113 ,0)
	10230	Q
	10231	"RTN","RCD PBTLM",114 ,0)
	10232	;
	10233	"RTN","RCD PBTLM",115 ,0)
	10234	;
	10235	"RTN","RCD PBTLM",116 ,0)
	10236	SELBILL() ; select a bill
	10237	"RTN","RCD PBTLM",117 ,0)
	10238	; return s -1 for t imeout or ^, 0 for n o selectio n, or ien of bill
	10239	"RTN","RCD PBTLM",118 ,0)
	10240	N %,%Y,C, DIC,DTOUT, DUOUT,RCBE FLUP,X,Y
	10241	"RTN","RCD PBTLM",119 ,0)
	10242	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	10243	"RTN","RCD PBTLM",120 ,0)
	10244	N RCY,DIR ,DIRUT
	10245	"RTN","RCD PBTLM",121 ,0)
	10246	; allow u ser to get the recor d using bi ll# or ECM E#
	10247	"RTN","RCD PBTLM",122 ,0)
	10248	S DIR("A" )="Select (B)ILL or (E)CME#: "
	10249	"RTN","RCD PBTLM",123 ,0)
	10250	S DIR(0)= "SA^B:BILL NUMBER;E: ECME#"
	10251	"RTN","RCD PBTLM",124 ,0)
	10252	S DIR("B" )="B"
	10253	"RTN","RCD PBTLM",125 ,0)
	10254	D ^DIR K DIR I $D(D IRUT) Q 0
	10255	"RTN","RCD PBTLM",126 ,0)
	10256	S RCY=Y
	10257	"RTN","RCD PBTLM",127 ,0)
	10258	I RCY="E" Q $$SELEC ME
	10259	"RTN","RCD PBTLM",128 ,0)
	10260	S DIC="^P RCA(430,", DIC(0)="QE AM",DIC("A ")="Select BILL: "
	10261	"RTN","RCD PBTLM",129 ,0)
	10262	S DIC("W" )="D DICW^ RCBEUBI1"
	10263	"RTN","RCD PBTLM",130 ,0)
	10264	; specia l lookup o n input
	10265	"RTN","RCD PBTLM",131 ,0)
	10266	S RCBEFLU P=1
	10267	"RTN","RCD PBTLM",132 ,0)
	10268	D ^DIC
	10269	"RTN","RCD PBTLM",133 ,0)
	10270	I Y<0,'$G (DUOUT),'$ G(DTOUT) S Y=0
	10271	"RTN","RCD PBTLM",134 ,0)
	10272	Q +Y
	10273	"RTN","RCD PBTLM",135 ,0)
	10274	;
	10275	"RTN","RCD PBTLM",136 ,0)
	10276	;
	10277	"RTN","RCD PBTLM",137 ,0)
	10278	GETTRANS(B ILLDA) ; original a mount goes first for bill
	10279	"RTN","RCD PBTLM",138 ,0)
	10280	; return s list of transactio ns in
	10281	"RTN","RCD PBTLM",139 ,0)
	10282	; rclist (date,tran da)=tranty pe ^ princ iple ^ int erest ^ ad min
	10283	"RTN","RCD PBTLM",140 ,0)
	10284	; return s principl e balance ^ interest balance ^ admin bal ance
	10285	"RTN","RCD PBTLM",141 ,0)
	10286	; ^ marshall fee balan ce ^ court cost bala nce
	10287	"RTN","RCD PBTLM",142 ,0)
	10288	N %,ADMBA L,AMTDISP, CCBAL,DATA 0,DATA1,DA TA9,DATE,I NTBAL,MFBA L,PRINBAL, RCDPDATA,
	10289	TRANDA,VAL UE
	10290	"RTN","RCD PBTLM",143 ,0)
	10291	;
	10292	"RTN","RCD PBTLM",144 ,0)
	10293	D DIQ430^ RCDPBPLM(B ILLDA,"3;6 0;")
	10294	"RTN","RCD PBTLM",145 ,0)
	10295	;
	10296	"RTN","RCD PBTLM",146 ,0)
	10297	K RCLIST
	10298	"RTN","RCD PBTLM",147 ,0)
	10299	S (ADMBAL ,CCBAL,INT BAL,MFBAL, PRINBAL)=0
	10300	"RTN","RCD PBTLM",148 ,0)
	10301	S PRINBAL =RCDPDATA( 430,BILLDA ,3,"I")
	10302	"RTN","RCD PBTLM",149 ,0)
	10303	; loop t ransaction and add t o list
	10304	"RTN","RCD PBTLM",150 ,0)
	10305	S TRANDA= 0 F S TRA NDA=$O(^PR CA(433,"C" ,BILLDA,TR ANDA)) Q:' TRANDA D
	10306	"RTN","RCD PBTLM",151 ,0)
	10307	. S DATA1 =$G(^PRCA( 433,TRANDA ,1))
	10308	"RTN","RCD PBTLM",152 ,0)
	10309	. S DATE= $P(DATA1," ^",9) I 'D ATE Q
	10310	"RTN","RCD PBTLM",153 ,0)
	10311	. ; Don't include t ransaction s that hav e the INCO MPLETE TRA NSACTION F LAG (#10)
	10312	set to YE S and
	10313	"RTN","RCD PBTLM",154 ,0)
	10314	. ; this transactio n was prev iously use d by the a uto-correc t program to correc
	10315	t an earli er issue. PRCA4.53 13
	10316	"RTN","RCD PBTLM",155 ,0)
	10317	. S DATA0 =$G(^PRCA( 433,TRANDA ,0))
	10318	"RTN","RCD PBTLM",156 ,0)
	10319	. S DATA9 =$G(^PRCA( 433,TRANDA ,9))
	10320	"RTN","RCD PBTLM",157 ,0)
	10321	. ; Check for Incom plete and previously fixed by auto-corre ct
	10322	"RTN","RCD PBTLM",158 ,0)
	10323	. I $P(DA TA0,U,10), ($P(DATA9, U,4)) S VA LUE="" Q
	10324	"RTN","RCD PBTLM",159 ,0)
	10325	. S VALUE =$$TRANVAL U(TRANDA) I VALUE="" Q
	10326	"RTN","RCD PBTLM",160 ,0)
	10327	. S RCLIS T($P(DATE, "."),TRAND A)=$P($G(^ PRCA(430.3 ,+$P(DATA1 ,"^",2),0) ),"^")_VA
	10328	LUE
	10329	"RTN","RCD PBTLM",161 ,0)
	10330	. ;
	10331	"RTN","RCD PBTLM",162 ,0)
	10332	. ; calc ulate bill 's balance
	10333	"RTN","RCD PBTLM",163 ,0)
	10334	. S PRINB AL=PRINBAL +$P(VALUE, "^",2)
	10335	"RTN","RCD PBTLM",164 ,0)
	10336	. S INTBA L=INTBAL+$ P(VALUE,"^ ",3)
	10337	"RTN","RCD PBTLM",165 ,0)
	10338	. S ADMBA L=ADMBAL+$ P(VALUE,"^ ",4)
	10339	"RTN","RCD PBTLM",166 ,0)
	10340	. S MFBAL =MFBAL+$P( VALUE,"^", 5)
	10341	"RTN","RCD PBTLM",167 ,0)
	10342	. S CCBAL =CCBAL+$P( VALUE,"^", 6)
	10343	"RTN","RCD PBTLM",168 ,0)
	10344	;
	10345	"RTN","RCD PBTLM",169 ,0)
	10346	S DATE=$G (RCDPDATA( 430,BILLDA ,60,"I"))
	10347	"RTN","RCD PBTLM",170 ,0)
	10348	; check to make su re activat ion date i s not grea ter than f irst trans action
	10349	"RTN","RCD PBTLM",171 ,0)
	10350	S %=$O(RC LIST(0)) I DATE>% S DATE=%
	10351	"RTN","RCD PBTLM",172 ,0)
	10352	S RCLIST( +$P(DATE," ."),0)="or iginal amo unt^"_RCDP DATA(430,B ILLDA,3,"I ")
	10353	"RTN","RCD PBTLM",173 ,0)
	10354	;
	10355	"RTN","RCD PBTLM",174 ,0)
	10356	Q PRINBAL _"^"_INTBA L_"^"_ADMB AL_"^"_MFB AL_"^"_CCB AL
	10357	"RTN","RCD PBTLM",175 ,0)
	10358	;
	10359	"RTN","RCD PBTLM",176 ,0)
	10360	;
	10361	"RTN","RCD PBTLM",177 ,0)
	10362	TRANVALU(T RANDA) ; return the transacti on value a s displaye d (with + or - sign
	10363	)
	10364	"RTN","RCD PBTLM",178 ,0)
	10365	N TYPE,VA LUE
	10366	"RTN","RCD PBTLM",179 ,0)
	10367	S VALUE=$ $TRANBAL^R CRJRCOT(TR ANDA)
	10368	"RTN","RCD PBTLM",180 ,0)
	10369	; no dol lars on tr ansaction
	10370	"RTN","RCD PBTLM",181 ,0)
	10371	I '$P(VAL UE,"^"),'$ P(VALUE,"^ ",2),'$P(V ALUE,"^",3 ),'$P(VALU E,"^",4),' $P(VALUE,
	10372	"^",5) Q " "
	10373	"RTN","RCD PBTLM",182 ,0)
	10374	; check type for p ayments, e tc, make v alues (-) to subtrac t
	10375	"RTN","RCD PBTLM",183 ,0)
	10376	S TYPE=$P ($G(^PRCA( 433,TRANDA ,1)),"^",2 )
	10377	"RTN","RCD PBTLM",184 ,0)
	10378	I TYPE=2! (TYPE=8)!( TYPE=9)!(T YPE=10)!(T YPE=11)!(T YPE=14)!(T YPE=29)!(T YPE=34)!(
	10379	TYPE=35)!( TYPE=41) D
	10380	"RTN","RCD PBTLM",185 ,0)
	10381	. S $P( VALUE,"^", 1)=-$P(VAL UE,"^",1)
	10382	"RTN","RCD PBTLM",186 ,0)
	10383	. S $P( VALUE,"^", 2)=-$P(VAL UE,"^",2)
	10384	"RTN","RCD PBTLM",187 ,0)
	10385	. S $P( VALUE,"^", 3)=-$P(VAL UE,"^",3)
	10386	"RTN","RCD PBTLM",188 ,0)
	10387	. S $P( VALUE,"^", 4)=-$P(VAL UE,"^",4)
	10388	"RTN","RCD PBTLM",189 ,0)
	10389	. S $P( VALUE,"^", 5)=-$P(VAL UE,"^",5)
	10390	"RTN","RCD PBTLM",190 ,0)
	10391	;
	10392	"RTN","RCD PBTLM",191 ,0)
	10393	; the fo llowing tr ansaction types shou ld not cha nge the bi lls balanc e
	10394	"RTN","RCD PBTLM",192 ,0)
	10395	; return the amoun t displaye d in the d escription and 0 for value
	10396	"RTN","RCD PBTLM",193 ,0)
	10397	; refe r to RC 3, refer to DOJ 4, ree stablish 5 , returned 6 and 32
	10398	"RTN","RCD PBTLM",194 ,0)
	10399	; repa yment plan 25, amend ed 33, sus pended 47, unsuspend ed 46
	10400	"RTN","RCD PBTLM",195 ,0)
	10401	K AMTDISP
	10402	"RTN","RCD PBTLM",196 ,0)
	10403	I TYPE=3! (TYPE=4)!( TYPE=5)!(T YPE=6)!(TY PE=25)!(TY PE=32)!(TY PE=33)!(TY PE=46)!(T
	10404	YPE=47) D
	10405	"RTN","RCD PBTLM",197 ,0)
	10406	. S AMT DISP=" ($" _$J($P(VAL UE,"^")+$P (VALUE,"^" ,2)+$P(VAL UE,"^",3)+ $P(VALUE,
	10407	"^",4)+$P( VALUE,"^", 5),0,2)_") "
	10408	"RTN","RCD PBTLM",198 ,0)
	10409	. S VAL UE=""
	10410	"RTN","RCD PBTLM",199 ,0)
	10411	Q $G(AMTD ISP)_"^"_V ALUE
	10412	"RTN","RCD PBTLM",200 ,0)
	10413	;
	10414	"RTN","RCD PBTLM",201 ,0)
	10415	SELECME() ;
	10416	"RTN","RCD PBTLM",202 ,0)
	10417	; functio n takes th e user inp ut of the ECME # to return a v alid ien o f file 43
	10418	0
	10419	"RTN","RCD PBTLM",203 ,0)
	10420	; if an i nvalid ECM E is evalu ated then the proces s keeps as king the u ser for E
	10421	CME #
	10422	"RTN","RCD PBTLM",204 ,0)
	10423	; until a valid ECM E# is ente red or unt il the use r enters a "^" or nu ll value
	10424	"RTN","RCD PBTLM",205 ,0)
	10425	; output - returns the IEN of the recor d entry in the ACCOU NT RECEIVA BLE file
	10426	(#430) or "??"
	10427	"RTN","RCD PBTLM",206 ,0)
	10428	N RCECME, RCBILL,DIR ,DIRUT,Y
	10429	"RTN","RCD PBTLM",207 ,0)
	10430	S DIR(0)= "FO^1:12^I X'?1.12N W !!,""Can not contai n alpha ch aracters"" K X"
	10431	"RTN","RCD PBTLM",208 ,0)
	10432	S DIR("A" )="Select ECME#"
	10433	"RTN","RCD PBTLM",209 ,0)
	10434	RET D ^DIR I $D(DIRU T) Q 0
	10435	"RTN","RCD PBTLM",210 ,0)
	10436	S RCECME= $S(+Y>0:Y, 1:0)
	10437	"RTN","RCD PBTLM",211 ,0)
	10438	S RCBILL= $$REC^IBRF N(RCECME) ; IA 20 31
	10439	"RTN","RCD PBTLM",212 ,0)
	10440	I RCBILL< 0 W !!,"?? " G RET
	10441	"RTN","RCD PBTLM",213 ,0)
	10442	E W !!,$ P($G(^PRCA (430,+RCBI LL,0)),"^" )," "
	10443	"RTN","RCD PBTLM",214 ,0)
	10444	Q RCBILL
	10445	"RTN","RCD PBTLM",215 ,0)
	10446	;RCDPBTLM
	10447	"VER")
	10448	8.0^22.2
	10449	"^DD",340, 340,.01,0)
	10450	DEBTOR^RV^ ^0;1^
	10451	"^DD",340, 340,.01,1, 0)
	10452	^.1
	10453	"^DD",340, 340,.01,1, 1,0)
	10454	340^B
	10455	"^DD",340, 340,.01,1, 1,1)
	10456	S ^RCD(340 ,"B",$E(X, 1,30),DA)= ""
	10457	"^DD",340, 340,.01,1, 1,2)
	10458	K ^RCD(340 ,"B",$E(X, 1,30),DA)
	10459	"^DD",340, 340,.01,1, 1,3)
	10460	Needed for look-up o f informat ion by Deb tor
	10461	"^DD",340, 340,.01,1, 1,"%D",0)
	10462	^^2^2^2931 014^^^^
	10463	"^DD",340, 340,.01,1, 1,"%D",1,0 )
	10464	This is th e regular FileMan 'B ' cross-re ference an d is used throughout the
	10465	"^DD",340, 340,.01,1, 1,"%D",2,0 )
	10466	AR package for users to look u p informat ion by deb tor.
	10467	"^DD",340, 340,.01,1, 2,0)
	10468	^^TRIGGER^ 340^.03
	10469	"^DD",340, 340,.01,1, 2,1)
	10470	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=
	10471	$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)
	10472	"^DD",340, 340,.01,1, 2,1.1)
	10473	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),";"),0), U)) S:X X
	10474	=+X
	10475	"^DD",340, 340,.01,1, 2,1.3)
	10476	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:"")
	10477	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
	10478	"^DD",340, 340,.01,1, 2,1.4)
	10479	S DIH=$S($ D(^RCD(340 ,DIV(0),0) ):^(0),1:" "),DIV=X S $P(^(0),U ,3)=DIV,DI H=340,DIG
	10480	=.03 D ^DI CR:$O(^DD( DIH,DIG,1, 0))>0
	10481	"^DD",340, 340,.01,1, 2,2)
	10482	Q
	10483	"^DD",340, 340,.01,1, 2,3)
	10484	Needed for assigning statement days for patients
	10485	"^DD",340, 340,.01,1, 2,"%D",0)
	10486	^.101^2^2^ 3160502^^^
	10487	"^DD",340, 340,.01,1, 2,"%D",1,0 )
	10488	This cross -reference sets the statement day for ne w patients as determ ined
	10489	"^DD",340, 340,.01,1, 2,"%D",2,0 )
	10490	by the fir st two let ters of th e patient' s last nam e.
	10491	"^DD",340, 340,.01,1, 2,"CREATE CONDITION" )
	10492	STATEMENT DAY=""&(IN TERNAL(DEB TOR)[";DPT (")
	10493	"^DD",340, 340,.01,1, 2,"CREATE VALUE")
	10494	S X=$$ACSE T^RCCPCFN1 ($P(^DPT($ P($P(^RCD( 340,D0,0) ,U),";"),0 ),U) S:X X =+X
	10495	"^DD",340, 340,.01,1, 2,"DELETE VALUE")
	10496	NO EFFECT
	10497	"^DD",340, 340,.01,1, 2,"DT")
	10498	2961010
	10499	"^DD",340, 340,.01,1, 2,"FIELD")
	10500	STATEMENT DAY
	10501	"^DD",340, 340,.01,1, 3,0)
	10502	340^AB^MUM PS
	10503	"^DD",340, 340,.01,1, 3,1)
	10504	S ^RCD(340 ,"AB",$P(X ,";",2),DA )=""
	10505	"^DD",340, 340,.01,1, 3,2)
	10506	K ^RCD(340 ,"AB",$P(X ,";",2),DA )
	10507	"^DD",340, 340,.01,1, 3,3)
	10508	Needed to cross-refe rence debt or file by 'type' of debtor
	10509	"^DD",340, 340,.01,1, 3,"%D",0)
	10510	^^5^5^2931 014^^^^
	10511	"^DD",340, 340,.01,1, 3,"%D",1,0 )
	10512	This cross -reference allows ra pid look-u p of debto rs in the debtor fil e
	10513	"^DD",340, 340,.01,1, 3,"%D",2,0 )
	10514	by the 'ty pe' of deb tor. Ther e are five types of debtors (P atient,
	10515	"^DD",340, 340,.01,1, 3,"%D",3,0 )
	10516	Insurance Company, I nstitution , Vendor, and Person ). This a llows
	10517	"^DD",340, 340,.01,1, 3,"%D",4,0 )
	10518	the AR sof tware to s can the fi le for onl y a specif ic type of debtor
	10519	"^DD",340, 340,.01,1, 3,"%D",5,0 )
	10520	rather tha n having t o look at each entry .
	10521	"^DD",340, 340,.01,1, 3,"DT")
	10522	2930526
	10523	"^DD",340, 340,.01,1. 1)
	10524	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),"";""),0 ),U) S:X
	10525	X=+X
	10526	"^DD",340, 340,.01,3)
	10527	Enter Debt or Informa tion
	10528	"^DD",340, 340,.01,7. 5)
	10529	S:$D(PRCAB T) DIC("V" )="I +Y(0) ="_$P("440 !(+Y(0)=4) ^440!(+Y(0 )=4)^440!( +Y(0)=200
	10530	)",U,PRCAB T) S:$D(PR CAT) DIC(" V")="I +Y( 0)="_$S("C P"[PRCAT:2 ,"FV"[PRCA T:440,"T"
	10531	[PRCAT:36, "N"[PRCAT: 4,"O"[PRCA T:200,1:"2 00!(+Y(0)= 440)")
	10532	"^DD",340, 340,.01,21 ,0)
	10533	^^5^5^2970 219^^^^
	10534	"^DD",340, 340,.01,21 ,1,0)
	10535	This field contains the debtor to which this accou nt belongs to. An
	10536	"^DD",340, 340,.01,21 ,2,0)
	10537	account ca n belong t o an insur ance compa ny, vendor , institut ion, perso n,
	10538	"^DD",340, 340,.01,21 ,3,0)
	10539	or patient . Account s can be s et up for Medical Ca re Cost Re covery cha rges
	10540	"^DD",340, 340,.01,21 ,4,0)
	10541	and also f or non-ben efit debts , such as: Employee bills, Ex- employee b ills,
	10542	"^DD",340, 340,.01,21 ,5,0)
	10543	and Vendor bills.
	10544	"^DD",340, 340,.01,"D T")
	10545	3160428
	10546	"^DD",340, 340,.01,"V ",0)
	10547	^.12P^5^5
	10548	"^DD",340, 340,.01,"V ",1,0)
	10549	2^PATIENT^ 1^P^n^n
	10550	"^DD",340, 340,.01,"V ",1,1)
	10551
	10552	"^DD",340, 340,.01,"V ",1,2)
	10553
	10554	"^DD",340, 340,.01,"V ",2,0)
	10555	200^OTHER (PERSON)^2 ^O^n^y
	10556	"^DD",340, 340,.01,"V ",3,0)
	10557	36^3RD PAR TY^4^I^n^n
	10558	"^DD",340, 340,.01,"V ",4,0)
	10559	4^INSTITUT ION^5^N^n^ n
	10560	"^DD",340, 340,.01,"V ",5,0)
	10561	440^VENDOR ^3^V^n^n
	10562	"^DD",340, 340,.03,0)
	10563	STATEMENT DAY^NJ2,0^ ^0;3^K:+X' =X!(X>28)! (X<1)!(X?. E1"."1N.N) X
	10564	"^DD",340, 340,.03,1, 0)
	10565	^.1
	10566	"^DD",340, 340,.03,1, 1,0)
	10567	340^AC
	10568	"^DD",340, 340,.03,1, 1,1)
	10569	S ^RCD(340 ,"AC",$E(X ,1,30),DA) =""
	10570	"^DD",340, 340,.03,1, 1,2)
	10571	K ^RCD(340 ,"AC",$E(X ,1,30),DA)
	10572	"^DD",340, 340,.03,1, 1,3)
	10573	Needed for printing of patient statement s and foll ow-up lett ers
	10574	"^DD",340, 340,.03,1, 1,"%D",0)
	10575	^^4^4^2931 014^^^^
	10576	"^DD",340, 340,.03,1, 1,"%D",1,0 )
	10577	This cross -reference is used t o print pa tient stat ements and Vendor, P erson,
	10578	"^DD",340, 340,.03,1, 1,"%D",2,0 )
	10579	and Instit ution foll ow-up lett ers. Sinc e these ty pe of debt ors get no tified
	10580	"^DD",340, 340,.03,1, 1,"%D",3,0 )
	10581	based on t heir state ment day, this cross -reference allows ra pid look-u p
	10582	"^DD",340, 340,.03,1, 1,"%D",4,0 )
	10583	of which d ebtor is d ue a notif ication on a particu lar day.
	10584	"^DD",340, 340,.03,1, 1,"DT")
	10585	2930309
	10586	"^DD",340, 340,.03,3)
	10587	Type a Num ber betwee n 1 and 28 , 0 Decima l Digits
	10588	"^DD",340, 340,.03,5, 1,0)
	10589	340^.01^2
	10590	"^DD",340, 340,.03,21 ,0)
	10591	^^19^19^31 60428^
	10592	"^DD",340, 340,.03,21 ,1,0)
	10593	A statemen t day is a ssigned to all types of debtor s, except insurance
	10594	"^DD",340, 340,.03,21 ,2,0)
	10595	companies. A statem ent day is the day t hat a stat ement is g enerated o r a
	10596	"^DD",340, 340,.03,21 ,3,0)
	10597	follow-up letter is generated for non-be nefit debt s. Except for
	10598	"^DD",340, 340,.03,21 ,4,0)
	10599	Patient St atements w hich are g enerated t wo days pr ior to thi s day.
	10600	"^DD",340, 340,.03,21 ,5,0)
	10601	The AR pac kage will hold 'noti fications' from bein g sent unt il the
	10602	"^DD",340, 340,.03,21 ,6,0)
	10603	debtor's ' statement day' arriv es. This allows all activity since the
	10604	"^DD",340, 340,.03,21 ,7,0)
	10605	previous s tatement t o print an d update t he debtor on the acc ount
	10606	"^DD",340, 340,.03,21 ,8,0)
	10607	activity.
	10608	"^DD",340, 340,.03,21 ,9,0)
	10609
	10610	"^DD",340, 340,.03,21 ,10,0)
	10611	Patient st atement da ys never c hange, but Instituti on, Person , and Vend or
	10612	"^DD",340, 340,.03,21 ,11,0)
	10613	statement days are c hanged by the AR sof tware. Wh en these t ype debtor s
	10614	"^DD",340, 340,.03,21 ,12,0)
	10615	have a new active bi ll, the da te the new active bi ll is crea ted become s
	10616	"^DD",340, 340,.03,21 ,13,0)
	10617	their 'sta tement day '. This s tatement d ay remains in effect until no
	10618	"^DD",340, 340,.03,21 ,14,0)
	10619	active bil ls exist f or the deb tor, at wh ich time t he stateme nt day
	10620	"^DD",340, 340,.03,21 ,15,0)
	10621	is 'delete d'.
	10622	"^DD",340, 340,.03,21 ,16,0)
	10623
	10624	"^DD",340, 340,.03,21 ,17,0)
	10625	Insurance companies are notifi ed based o n a bill-s pecific da te.
	10626	"^DD",340, 340,.03,21 ,18,0)
	10627	Since insu rance comp anies have much more activity, they are notified
	10628	"^DD",340, 340,.03,21 ,19,0)
	10629	on a const ant basis depending on each in dividual b ill 'due-d ate'.
	10630	"^DD",340, 340,.03,"D T")
	10631	3160428
	10632	"^DD",340, 340,7.06,0 )
	10633	CURRENT CB S DEBT AMO UNT^NJ9,2^ ^7;6^S:X[" $" X=$P(X, "$",2) K:X '?."-".N.1 ".".2N!(X
	10634	>999999)!( X<-999999) X
	10635	"^DD",340, 340,7.06,3 )
	10636	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	10637	"^DD",340, 340,7.06,2 1,0)
	10638	^^7^7^3160 401^
	10639	"^DD",340, 340,7.06,2 1,1,0)
	10640	This field stores th e debt amo unt curren tly
	10641	"^DD",340, 340,7.06,2 1,2,0)
	10642	updated to the Conso lidated Bi lling Stat ement Syst em
	10643	"^DD",340, 340,7.06,2 1,3,0)
	10644	CBSS. Thi s field is used to c ompare the current
	10645	"^DD",340, 340,7.06,2 1,4,0)
	10646	amount at the CBSS w ith the am ount curre ntly
	10647	"^DD",340, 340,7.06,2 1,5,0)
	10648	available for receiv ing paymen t. For in creases
	10649	"^DD",340, 340,7.06,2 1,6,0)
	10650	or decreas es, the de bt amount is forward ed to
	10651	"^DD",340, 340,7.06,2 1,7,0)
	10652	CBSS.
	10653	"^DD",340, 340,7.06," DT")
	10654	3160401
	10655	"^DD",341, 341,6.01,0 )
	10656	CCPC STATE MENT DATE^ D^^6;1^S % DT="EX" D ^%DT S X=Y K:X<1 X
	10657	"^DD",341, 341,6.01,1 ,0)
	10658	^.1
	10659	"^DD",341, 341,6.01,1 ,1,0)
	10660	341^STDT
	10661	"^DD",341, 341,6.01,1 ,1,1)
	10662	S ^RC(341, "STDT",$E( X,1,30),DA )=""
	10663	"^DD",341, 341,6.01,1 ,1,2)
	10664	K ^RC(341, "STDT",$E( X,1,30),DA )
	10665	"^DD",341, 341,6.01,1 ,1,"%D",0)
	10666	^.101^2^2^ 3160809^^
	10667	"^DD",341, 341,6.01,1 ,1,"%D",1, 0)
	10668	This cross reference is used t o sort and print eve nts by the ir Patient
	10669	"^DD",341, 341,6.01,1 ,1,"%D",2, 0)
	10670	Statement date.
	10671	"^DD",341, 341,6.01,1 ,1,"DT")
	10672	3160803
	10673	"^DD",341, 341,6.01,3 )
	10674	Enter date of Patien t Statemen t.
	10675	"^DD",341, 341,6.01,2 1,0)
	10676	^^1^1^3160 921^
	10677	"^DD",341, 341,6.01,2 1,1,0)
	10678	This is th e date of the Patien t Statemen t from CBS S.
	10679	"^DD",341, 341,6.01," DT")
	10680	3160921
	10681	"^DD",349, 349,.09,0)
	10682	STATEMENT DATE^D^^0; 9^S %DT="E X" D ^%DT S X=Y K:X< 1 X
	10683	"^DD",349, 349,.09,3)
	10684	Enter the statement date.
	10685	"^DD",349, 349,.09,21 ,0)
	10686	^^1^1^3161 019^
	10687	"^DD",349, 349,.09,21 ,1,0)
	10688	This is th e patient statement date.
	10689	"^DD",349, 349,.09,"D T")
	10690	3161103
	10691	"^DD",349. 1,349.1,0)
	10692	FIELD^^40^ 14
	10693	"^DD",349. 1,349.1,0, "DDA")
	10694	N
	10695	"^DD",349. 1,349.1,0, "DT")
	10696	3161103
	10697	"^DD",349. 1,349.1,0, "IX","B",3 49.1,.01)
	10698
	10699	"^DD",349. 1,349.1,0, "NM","AR T RANSMISSIO N TYPE")
	10700
	10701	"^DD",349. 1,349.1,0, "PT",349.9 ,.01)
	10702
	10703	"^DD",349. 1,349.1,0, "VRPK")
	10704	PRCA
	10705	"^DD",349. 1,349.1,.0 1,0)
	10706	CODE^RF^^0 ;1^K:$L(X) >10!($L(X) <2)!'(X'?1 P.E) X
	10707	"^DD",349. 1,349.1,.0 1,1,0)
	10708	^.1
	10709	"^DD",349. 1,349.1,.0 1,1,1,0)
	10710	349.1^B
	10711	"^DD",349. 1,349.1,.0 1,1,1,1)
	10712	S ^RCT(349 .1,"B",$E( X,1,30),DA )=""
	10713	"^DD",349. 1,349.1,.0 1,1,1,2)
	10714	K ^RCT(349 .1,"B",$E( X,1,30),DA )
	10715	"^DD",349. 1,349.1,.0 1,3)
	10716	Answer mus t be 2-10 characters in length .
	10717	"^DD",349. 1,349.1,.0 1,21,0)
	10718	^.001^1^1^ 3040601^^^
	10719	"^DD",349. 1,349.1,.0 1,21,1,0)
	10720	This field will hold the uniqu e codes fo r the tran smission t ypes.
	10721	"^DD",349. 1,349.1,.0 1,23,0)
	10722	^^1^1^3040 601^
	10723	"^DD",349. 1,349.1,.0 1,23,1,0)
	10724
	10725	"^DD",349. 1,349.1,.0 1,"DT")
	10726	2960216
	10727	"^DD",349. 1,349.1,.0 2,0)
	10728	EXPANDED N AME^F^^0;2 ^K:$L(X)>3 0!($L(X)<3 ) X
	10729	"^DD",349. 1,349.1,.0 2,3)
	10730	Answer mus t be 3-30 characters in length .
	10731	"^DD",349. 1,349.1,.0 2,21,0)
	10732	^^1^1^2960 216^^
	10733	"^DD",349. 1,349.1,.0 2,21,1,0)
	10734	This is th e expanded name of t he transmi ssion type .
	10735	"^DD",349. 1,349.1,.0 2,"DT")
	10736	2960216
	10737	"^DD",349. 1,349.1,.0 3,0)
	10738	ACTIVE^S^0 :NO;1:YES; ^0;3^Q
	10739	"^DD",349. 1,349.1,.0 3,21,0)
	10740	^^1^1^2960 216^
	10741	"^DD",349. 1,349.1,.0 3,21,1,0)
	10742	This field will indi cate if th e transmis sion type is being u sed.
	10743	"^DD",349. 1,349.1,.0 3,"DT")
	10744	2960216
	10745	"^DD",349. 1,349.1,.0 4,0)
	10746	PURGE FREQ UENCY^NJ4, 0^^0;4^K:+ X'=X!(X>36 50)!(X<30) !(X?.E1"." 1N.N) X
	10747	"^DD",349. 1,349.1,.0 4,3)
	10748	Type a Num ber betwee n 30 and 3 650, 0 Dec imal Digit s
	10749	"^DD",349. 1,349.1,.0 4,21,0)
	10750	^^2^2^2960 216^^
	10751	"^DD",349. 1,349.1,.0 4,21,1,0)
	10752	This field indicates if and wh en a purge of the en tries will take
	10753	"^DD",349. 1,349.1,.0 4,21,2,0)
	10754	place.
	10755	"^DD",349. 1,349.1,.0 4,23,0)
	10756	^^2^2^2960 216^
	10757	"^DD",349. 1,349.1,.0 4,23,1,0)
	10758	Number of days that transmissi on records are on-li ne before
	10759	"^DD",349. 1,349.1,.0 4,23,2,0)
	10760	purging oc curs.
	10761	"^DD",349. 1,349.1,.0 4,"DT")
	10762	2960216
	10763	"^DD",349. 1,349.1,1, 0)
	10764	LOCAL ADDR ESSEE^349. 11P^^1;0
	10765	"^DD",349. 1,349.1,2, 0)
	10766	LOCAL MAIL GROUP^349. 12P^^2;0
	10767	"^DD",349. 1,349.1,31 ,0)
	10768	REMOTE ADD RESSEE^F^^ 3;1^K:$L(X )>30!($L(X )<1)!'(X?. A) X
	10769	"^DD",349. 1,349.1,31 ,3)
	10770	Answer mus t be 1-30 characters in length .
	10771	"^DD",349. 1,349.1,31 ,21,0)
	10772	^^1^1^2960 430^^^
	10773	"^DD",349. 1,349.1,31 ,21,1,0)
	10774	This is th e addresse e name at the remote domain.
	10775	"^DD",349. 1,349.1,31 ,"DT")
	10776	2960430
	10777	"^DD",349. 1,349.1,32 ,0)
	10778	REMOTE DOM AIN^P4.2'^ DIC(4.2,^3 ;2^Q
	10779	"^DD",349. 1,349.1,32 ,1,0)
	10780	^.1
	10781	"^DD",349. 1,349.1,32 ,1,1,0)
	10782	^^TRIGGER^ 349.1^33
	10783	"^DD",349. 1,349.1,32 ,1,1,1)
	10784	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(
	10785	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)
	10786	"^DD",349. 1,349.1,32 ,1,1,1.1)
	10787	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
	10788	)=$S($D(^D IC(4.2,D0, 0)):^(0),1 :"") S X=$ P(Y(101),U ,1) S D0=I (0,0)
	10789	"^DD",349. 1,349.1,32 ,1,1,1.4)
	10790	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1
	10791	,DIG=33 D ^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	10792	"^DD",349. 1,349.1,32 ,1,1,2)
	10793	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(
	10794	Y(1),U,3), X=X S DIU= X K Y S X= "" X ^DD(3 49.1,32,1, 1,2.4)
	10795	"^DD",349. 1,349.1,32 ,1,1,2.4)
	10796	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1
	10797	,DIG=33 D ^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	10798	"^DD",349. 1,349.1,32 ,1,1,"CREA TE VALUE")
	10799	REMOTE DOM AIN:.01
	10800	"^DD",349. 1,349.1,32 ,1,1,"DELE TE VALUE")
	10801	@
	10802	"^DD",349. 1,349.1,32 ,1,1,"FIEL D")
	10803	DOMAIN NAM E
	10804	"^DD",349. 1,349.1,32 ,21,0)
	10805	^.001^2^2^ 3000524^^^
	10806	"^DD",349. 1,349.1,32 ,21,1,0)
	10807	This is th e remote d omain wher e the tran smission r ecord is b eing
	10808	"^DD",349. 1,349.1,32 ,21,2,0)
	10809	sent.
	10810	"^DD",349. 1,349.1,32 ,"DT")
	10811	2960902
	10812	"^DD",349. 1,349.1,33 ,0)
	10813	DOMAIN NAM E^F^^3;3^K :$L(X)>30! ($L(X)<3) X
	10814	"^DD",349. 1,349.1,33 ,3)
	10815	Answer mus t be 3-30 characters in length .
	10816	"^DD",349. 1,349.1,33 ,5,1,0)
	10817	349.1^32^1
	10818	"^DD",349. 1,349.1,33 ,9)
	10819	^
	10820	"^DD",349. 1,349.1,33 ,21,0)
	10821	^^1^1^2960 902^
	10822	"^DD",349. 1,349.1,33 ,21,1,0)
	10823	This is th e name of the DOMAIN from file 4.2 DOMAI N.
	10824	"^DD",349. 1,349.1,33 ,"DT")
	10825	2960902
	10826	"^DD",349. 1,349.1,34 ,0)
	10827	RC MAIL AD DRESS^RFX^ ^3;4^K:$L( X)>30!($L( X)<3) X
	10828	"^DD",349. 1,349.1,34 ,3)
	10829	Answer mus t be 3-30 characters in length .
	10830	"^DD",349. 1,349.1,34 ,4)
	10831	D MAILADD^ RCRCXMS
	10832	"^DD",349. 1,349.1,34 ,21,0)
	10833	^.001^2^2^ 3040429^^^ ^
	10834	"^DD",349. 1,349.1,34 ,21,1,0)
	10835	This field will cont ain the Re gional Cou nsel mail address fo r the
	10836	"^DD",349. 1,349.1,34 ,21,2,0)
	10837	primary si te. It wi ll be the default ma il address .
	10838	"^DD",349. 1,349.1,34 ,23,0)
	10839	^.001^1^1^ 3040429^^^ ^
	10840	"^DD",349. 1,349.1,34 ,23,1,0)
	10841
	10842	"^DD",349. 1,349.1,34 ,"DT")
	10843	3040407
	10844	"^DD",349. 1,349.1,35 ,0)
	10845	RC DEATH N OTIFICATIO N ADDRESS^ RF^^3;5^K: $L(X)>40!( $L(X)<2) X
	10846	"^DD",349. 1,349.1,35 ,3)
	10847	Answer mus t be 2-40 characters in length .
	10848	"^DD",349. 1,349.1,35 ,4)
	10849	D DEATHADD ^RCRCXMS
	10850	"^DD",349. 1,349.1,35 ,21,0)
	10851	^.001^3^3^ 3040429^^^ ^
	10852	"^DD",349. 1,349.1,35 ,21,1,0)
	10853	This field contains the Region al Counsel mail addr ess for de ath
	10854	"^DD",349. 1,349.1,35 ,21,2,0)
	10855	notificati ons for th e primary site. Thi s will be the defaul t for deat h
	10856	"^DD",349. 1,349.1,35 ,21,3,0)
	10857	notificati ons.
	10858	"^DD",349. 1,349.1,35 ,23,0)
	10859	^.001^1^1^ 3040429^^^ ^
	10860	"^DD",349. 1,349.1,35 ,23,1,0)
	10861
	10862	"^DD",349. 1,349.1,35 ,"DT")
	10863	3040428
	10864	"^DD",349. 1,349.1,40 ,0)
	10865	MESSAGE AC KNOWLEDGEM ENT^349.14 1A^^4;0
	10866	"^DD",349. 1,349.1,40 ,21,0)
	10867	^^5^5^3160 429^
	10868	"^DD",349. 1,349.1,40 ,21,1,0)
	10869	Message Ac knowledgem ents conta in the top level of data for m essages
	10870	"^DD",349. 1,349.1,40 ,21,2,0)
	10871	received f rom Austin .
	10872	"^DD",349. 1,349.1,40 ,21,3,0)
	10873
	10874	"^DD",349. 1,349.1,40 ,21,4,0)
	10875	The IEN fo r the mult iple Messa ge Acknowl edgements is set in the code t o
	10876	"^DD",349. 1,349.1,40 ,21,5,0)
	10877	the day of the month for the P atient Sta tement.
	10878	"^DD",349. 1,349.1,51 ,0)
	10879	ACK MESSAG ES^349.151 A^^5;0
	10880	"^DD",349. 1,349.1,51 ,21,0)
	10881	^^1^1^3161 006^
	10882	"^DD",349. 1,349.1,51 ,21,1,0)
	10883	Acknowledg ement Mess ages recei ved from e xternal so urces.
	10884	"^DD",349. 1,349.1,61 ,0)
	10885	DIVISION O F CARE^349 .161PA^^6; 0
	10886	"^DD",349. 1,349.1,61 ,21,0)
	10887	^.001^4^4^ 3040517^^^ ^
	10888	"^DD",349. 1,349.1,61 ,21,1,0)
	10889	This field is a mult iple that allows div isions to be entered if their
	10890	"^DD",349. 1,349.1,61 ,21,2,0)
	10891	Regional C ounsel mai l addresse s and deat h notifica tion addre sses are
	10892	"^DD",349. 1,349.1,61 ,21,3,0)
	10893	different from the p rimary add resses.
	10894	"^DD",349. 1,349.1,61 ,21,4,0)
	10895
	10896	"^DD",349. 1,349.1,61 ,23,0)
	10897	^.001^1^1^ 3040517^^^ ^
	10898	"^DD",349. 1,349.1,61 ,23,1,0)
	10899
	10900	"^DD",349. 1,349.1,61 ,"DT")
	10901	3040514
	10902	"^DD",349. 1,349.11,0 )
	10903	LOCAL ADDR ESSEE SUB- FIELD^^.01 ^1
	10904	"^DD",349. 1,349.11,0 ,"DT")
	10905	2960216
	10906	"^DD",349. 1,349.11,0 ,"IX","B", 349.11,.01 )
	10907
	10908	"^DD",349. 1,349.11,0 ,"NM","LOC AL ADDRESS EE")
	10909
	10910	"^DD",349. 1,349.11,0 ,"UP")
	10911	349.1
	10912	"^DD",349. 1,349.11,. 01,0)
	10913	LOCAL ADDR ESSEE^MP20 0'^VA(200, ^0;1^Q
	10914	"^DD",349. 1,349.11,. 01,1,0)
	10915	^.1
	10916	"^DD",349. 1,349.11,. 01,1,1,0)
	10917	349.11^B
	10918	"^DD",349. 1,349.11,. 01,1,1,1)
	10919	S ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)= ""
	10920	"^DD",349. 1,349.11,. 01,1,1,2)
	10921	K ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)
	10922	"^DD",349. 1,349.11,. 01,21,0)
	10923	^^2^2^2960 216^
	10924	"^DD",349. 1,349.11,. 01,21,1,0)
	10925	The local users who wish to be recepient s of the t ransmissio n messages
	10926	"^DD",349. 1,349.11,. 01,21,2,0)
	10927	will named in this f ield.
	10928	"^DD",349. 1,349.11,. 01,"DT")
	10929	2960216
	10930	"^DD",349. 1,349.12,0 )
	10931	LOCAL MAIL GROUP SUB- FIELD^^.01 ^1
	10932	"^DD",349. 1,349.12,0 ,"DT")
	10933	2960216
	10934	"^DD",349. 1,349.12,0 ,"IX","B", 349.12,.01 )
	10935
	10936	"^DD",349. 1,349.12,0 ,"NM","LOC AL MAILGRO UP")
	10937
	10938	"^DD",349. 1,349.12,0 ,"UP")
	10939	349.1
	10940	"^DD",349. 1,349.12,. 01,0)
	10941	LOCAL MAIL GROUP^MP3. 8'^XMB(3.8 ,^0;1^Q
	10942	"^DD",349. 1,349.12,. 01,1,0)
	10943	^.1
	10944	"^DD",349. 1,349.12,. 01,1,1,0)
	10945	349.12^B
	10946	"^DD",349. 1,349.12,. 01,1,1,1)
	10947	S ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)= ""
	10948	"^DD",349. 1,349.12,. 01,1,1,2)
	10949	K ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)
	10950	"^DD",349. 1,349.12,. 01,21,0)
	10951	^^2^2^2960 216^
	10952	"^DD",349. 1,349.12,. 01,21,1,0)
	10953	This field is used t o define a ny mailgro ups which should rec eive the
	10954	"^DD",349. 1,349.12,. 01,21,2,0)
	10955	transmissi on message s.
	10956	"^DD",349. 1,349.12,. 01,"DT")
	10957	2960216
	10958	"^DD",349. 1,349.141, 0)
	10959	MESSAGE AC KNOWLEDGEM ENT SUB-FI ELD^^.04^4
	10960	"^DD",349. 1,349.141, 0,"DT")
	10961	3160425
	10962	"^DD",349. 1,349.141, 0,"NM","ME SSAGE ACKN OWLEDGEMEN T")
	10963
	10964	"^DD",349. 1,349.141, 0,"UP")
	10965	349.1
	10966	"^DD",349. 1,349.141, .01,0)
	10967	LAST MESSA GE ACK^NJ3 ,0X^^0;1^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	10968	"^DD",349. 1,349.141, .01,1,0)
	10969	^.1^^0
	10970	"^DD",349. 1,349.141, .01,3)
	10971	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	10972	"^DD",349. 1,349.141, .01,21,0)
	10973	^^1^1^3160 425^
	10974	"^DD",349. 1,349.141, .01,21,1,0 )
	10975	Number of last messa ge type se nt from CB SS.
	10976	"^DD",349. 1,349.141, .01,"DT")
	10977	3161007
	10978	"^DD",349. 1,349.141, .02,0)
	10979	FINAL MESS AGE ACK^NJ 3,0^^0;2^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	10980	"^DD",349. 1,349.141, .02,3)
	10981	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	10982	"^DD",349. 1,349.141, .02,21,0)
	10983	^^1^1^3160 425^
	10984	"^DD",349. 1,349.141, .02,21,1,0 )
	10985	Final mess age number of this t ype from C BSS.
	10986	"^DD",349. 1,349.141, .02,"DT")
	10987	3160425
	10988	"^DD",349. 1,349.141, .03,0)
	10989	LAST MESSA GE NUMBER^ NJ8,0^^0;3 ^K:+X'=X!( X>99999999 )!(X<1)!(X ?.E1"."1.N ) X
	10990	"^DD",349. 1,349.141, .03,3)
	10991	Type a num ber betwee n 1 and 99 999999, 0 decimal di gits.
	10992	"^DD",349. 1,349.141, .03,21,0)
	10993	^^2^2^3160 425^
	10994	"^DD",349. 1,349.141, .03,21,1,0 )
	10995	This is th e last mes sage numbe r of this type for t he last tr ansmission
	10996	"^DD",349. 1,349.141, .03,21,2,0 )
	10997	from CBSS.
	10998	"^DD",349. 1,349.141, .03,"DT")
	10999	3160425
	11000	"^DD",349. 1,349.141, .04,0)
	11001	PATIENT ST ATEMENT DA TE^DX^^0;4 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	11002	"^DD",349. 1,349.141, .04,1,0)
	11003	^.1^^0
	11004	"^DD",349. 1,349.141, .04,3)
	11005	Enter date of Patien t Statemen t.
	11006	"^DD",349. 1,349.141, .04,21,0)
	11007	^^1^1^3161 025^
	11008	"^DD",349. 1,349.141, .04,21,1,0 )
	11009	This is th e Patient Statement Date.
	11010	"^DD",349. 1,349.141, .04,"DT")
	11011	3161025
	11012	"^DD",349. 1,349.151, 0)
	11013	ACK MESSAG ES SUB-FIE LD^^.04^4
	11014	"^DD",349. 1,349.151, 0,"DT")
	11015	3161103
	11016	"^DD",349. 1,349.151, 0,"NM","AC K MESSAGES ")
	11017
	11018	"^DD",349. 1,349.151, 0,"UP")
	11019	349.1
	11020	"^DD",349. 1,349.151, .01,0)
	11021	ACK MESSAG ES^F^^0;1^ K:$L(X)>80 !($L(X)<3) X
	11022	"^DD",349. 1,349.151, .01,1,0)
	11023	^.1^^0
	11024	"^DD",349. 1,349.151, .01,3)
	11025	Answer mus t be 3-80 characters in length .
	11026	"^DD",349. 1,349.151, .01,21,0)
	11027	^^1^1^2970 106^^
	11028	"^DD",349. 1,349.151, .01,21,1,0 )
	11029	This multi ple will s tore the A cknowlegme nt message s from Aus tin.
	11030	"^DD",349. 1,349.151, .01,"DT")
	11031	3161005
	11032	"^DD",349. 1,349.151, .02,0)
	11033	ACCOUNT/SE G ID^F^^0; 2^K:$L(X)> 25!($L(X)< 3) X
	11034	"^DD",349. 1,349.151, .02,3)
	11035	Answer mus t be 3-25 characters in length .
	11036	"^DD",349. 1,349.151, .02,21,0)
	11037	^^1^1^2961 114^
	11038	"^DD",349. 1,349.151, .02,21,1,0 )
	11039	This field stores th e account id for the record.
	11040	"^DD",349. 1,349.151, .02,"DT")
	11041	2961205
	11042	"^DD",349. 1,349.151, .03,0)
	11043	ACCOUNT/SE G INFO^F^^ 0;3^K:$L(X )>40!($L(X )<3) X
	11044	"^DD",349. 1,349.151, .03,3)
	11045	Answer mus t be 3-40 characters in length .
	11046	"^DD",349. 1,349.151, .03,21,0)
	11047	^^1^1^2961 114^
	11048	"^DD",349. 1,349.151, .03,21,1,0 )
	11049	This field will stor e the deta iled infor mation abo ut the rec ord if any .
	11050	"^DD",349. 1,349.151, .03,"DT")
	11051	2961205
	11052	"^DD",349. 1,349.151, .04,0)
	11053	PATIENT ST ATEMENT DA TE^D^^0;4^ S %DT="EX" D ^%DT S X=Y K:X<1 X
	11054	"^DD",349. 1,349.151, .04,3)
	11055	Enter date of Patien t Statemen t.
	11056	"^DD",349. 1,349.151, .04,21,0)
	11057	^^1^1^3161 006^
	11058	"^DD",349. 1,349.151, .04,21,1,0 )
	11059	The Patien t Statemen t date for Acknowled gement Mes sages.
	11060	"^DD",349. 1,349.151, .04,"DT")
	11061	3161103
	11062	"^DD",349. 1,349.161, 0)
	11063	DIVISION O F CARE SUB -FIELD^^.0 4^4
	11064	"^DD",349. 1,349.161, 0,"DT")
	11065	3040429
	11066	"^DD",349. 1,349.161, 0,"IX","B" ,349.161,. 01)
	11067
	11068	"^DD",349. 1,349.161, 0,"NM","DI VISION OF CARE")
	11069
	11070	"^DD",349. 1,349.161, 0,"UP")
	11071	349.1
	11072	"^DD",349. 1,349.161, .01,0)
	11073	DIVISION O F CARE^P40 .8'^DG(40. 8,^0;1^Q
	11074	"^DD",349. 1,349.161, .01,1,0)
	11075	^.1
	11076	"^DD",349. 1,349.161, .01,1,1,0)
	11077	349.161^B
	11078	"^DD",349. 1,349.161, .01,1,1,1)
	11079	S ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)= ""
	11080	"^DD",349. 1,349.161, .01,1,1,2)
	11081	K ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)
	11082	"^DD",349. 1,349.161, .01,21,0)
	11083	^.001^1^1^ 3040517^^^ ^
	11084	"^DD",349. 1,349.161, .01,21,1,0 )
	11085	Enter divi sions of c are where bill charg es origina te for thi s site.
	11086	"^DD",349. 1,349.161, .01,"DT")
	11087	3000524
	11088	"^DD",349. 1,349.161, .02,0)
	11089	REMOTE DOM AIN^P4.2'^ DIC(4.2,^0 ;2^Q
	11090	"^DD",349. 1,349.161, .02,3)
	11091
	11092	"^DD",349. 1,349.161, .02,21,0)
	11093	^.001^1^1^ 3000524^^
	11094	"^DD",349. 1,349.161, .02,21,1,0 )
	11095	This is th e Remote D omain addr ess where transmissi ons will b e sent for this div
	11096	ision.
	11097	"^DD",349. 1,349.161, .02,"DT")
	11098	3000524
	11099	"^DD",349. 1,349.161, .03,0)
	11100	RC MAIL AD DRESS^F^^0 ;3^K:$L(X) >30!($L(X) <3) X
	11101	"^DD",349. 1,349.161, .03,3)
	11102	Answer mus t be 3-30 characters in length .
	11103	"^DD",349. 1,349.161, .03,4)
	11104	D MAILADD^ RCRCXMS
	11105	"^DD",349. 1,349.161, .03,21,0)
	11106	^.001^4^4^ 3040429^^
	11107	"^DD",349. 1,349.161, .03,21,1,0 )
	11108	This field will cont ain the na me of the Regional C ounsel mai l address
	11109	"^DD",349. 1,349.161, .03,21,2,0 )
	11110	that trans actions fr om the ass ociated Di vision of Care will be sent.
	11111	"^DD",349. 1,349.161, .03,21,3,0 )
	11112	This field s address will be di fferent fr om the pri mary divis ion's
	11113	"^DD",349. 1,349.161, .03,21,4,0 )
	11114	RC mail ad dress.
	11115	"^DD",349. 1,349.161, .03,23,0)
	11116	^^1^1^3040 429^
	11117	"^DD",349. 1,349.161, .03,23,1,0 )
	11118
	11119	"^DD",349. 1,349.161, .03,"DT")
	11120	3040325
	11121	"^DD",349. 1,349.161, .04,0)
	11122	RC DEATH N OTIFICATIO N ADDRESS^ F^^0;4^K:$ L(X)>40!($ L(X)<3) X
	11123	"^DD",349. 1,349.161, .04,3)
	11124	Answer mus t be 3-40 characters in length .
	11125	"^DD",349. 1,349.161, .04,4)
	11126	D DEATHADD ^RCRCXMS
	11127	"^DD",349. 1,349.161, .04,21,0)
	11128	^.001^4^4^ 3040429^^^
	11129	"^DD",349. 1,349.161, .04,21,1,0 )
	11130	This field will cont ain the na me of the RC death n otificatio ns address
	11131	"^DD",349. 1,349.161, .04,21,2,0 )
	11132	that death notices f rom the as sociated D ivision of Care will be sent.
	11133	"^DD",349. 1,349.161, .04,21,3,0 )
	11134	This field s address will be di fferent fr om the pri mary divis ion's
	11135	"^DD",349. 1,349.161, .04,21,4,0 )
	11136	RC death n otificatio n address.
	11137	"^DD",349. 1,349.161, .04,23,0)
	11138	^.001^1^1^ 3040429^^
	11139	"^DD",349. 1,349.161, .04,23,1,0 )
	11140
	11141	"^DD",349. 1,349.161, .04,"DT")
	11142	3040429
	11143	"^DD",349. 2,349.2,.0 1,0)
	11144	PATIENT^RP 340'X^RCD( 340,^0;1^Q
	11145	"^DD",349. 2,349.2,.0 1,1,0)
	11146	^.1^^0
	11147	"^DD",349. 2,349.2,.0 1,3)
	11148	Enter the Debtor Num ber for th e Patient Statement.
	11149	"^DD",349. 2,349.2,.0 1,21,0)
	11150	^^2^2^3161 011^^
	11151	"^DD",349. 2,349.2,.0 1,21,1,0)
	11152	This is th e Debtor n umber to r eceive the Patient S tatement a ssociated
	11153	"^DD",349. 2,349.2,.0 1,21,2,0)
	11154	with the s pecific Pa tient.
	11155	"^DD",349. 2,349.2,.0 1,"DT")
	11156	3161011
	11157	"^DD",349. 2,349.2,.0 2,0)
	11158	SSN^RFXO^^ 0;2^K:$L(X )>10!($L(X )<9) X S X =$$SSN^RCF N01(+DA)
	11159	"^DD",349. 2,349.2,.0 2,1,0)
	11160	^.1
	11161	"^DD",349. 2,349.2,.0 2,1,1,0)
	11162	349.2^AKEY 1^MUMPS
	11163	"^DD",349. 2,349.2,.0 2,1,1,1)
	11164	I $P(^RCPS (349.2,+DA ,0),"^",3) ]"" S ^RCP S(349.2,"A KEY",$E(X, 1,9)_$TR($ E($P($P(^
	11165	RCPS(349.2 ,+DA,0),"^ ",3),","), 1,5)," "," "),DA)=""
	11166	"^DD",349. 2,349.2,.0 2,1,1,2)
	11167	K ^RCPS(34 9.2,"AKEY" ,$E(X,1,9) _$TR($E($P ($P(^RCPS( 349.2,+DA, 0),"^",3), ","),1,5)
	11168	," ",""))
	11169	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,0)
	11170	^.101^1^1^ 3160427^^
	11171	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,1,0)
	11172	This cross -reference is used t o key the statements for CBSS.
	11173	"^DD",349. 2,349.2,.0 2,1,1,"DT" )
	11174	2960924
	11175	"^DD",349. 2,349.2,.0 2,2)
	11176	S Y(0)=Y S Y=Y
	11177	"^DD",349. 2,349.2,.0 2,2.1)
	11178	S Y=Y
	11179	"^DD",349. 2,349.2,.0 2,3)
	11180	Answer mus t be 9-10 characters in length .
	11181	"^DD",349. 2,349.2,.0 2,21,0)
	11182	^^1^1^2960 418^^
	11183	"^DD",349. 2,349.2,.0 2,21,1,0)
	11184	This is th e SSN for the patien t.
	11185	"^DD",349. 2,349.2,.0 2,"DT")
	11186	2960924
	11187	"^DD",349. 2,349.2,.0 3,0)
	11188	PATIENT NA ME^RFX^^0; 3^K:$L(X)> 44!($L(X)< 3) X S X=$ $NAM^RCFN0 1(+DA)
	11189	"^DD",349. 2,349.2,.0 3,1,0)
	11190	^.1
	11191	"^DD",349. 2,349.2,.0 3,1,1,0)
	11192	349.2^AKEY 2^MUMPS
	11193	"^DD",349. 2,349.2,.0 3,1,1,1)
	11194	I $$KEY^RC CPCFN(+DA) ]"" S ^RCP S(349.2,"A KEY",$$KEY ^RCCPCFN(+ DA),DA)=""
	11195	"^DD",349. 2,349.2,.0 3,1,1,2)
	11196	I $P(^RCPS (349.2,+DA ,0),"^",2) >1 K ^RCPS (349.2,"AK EY",$E($P( ^RCPS(349. 2,+DA,0),
	11197	"^",2),1,9 )_$TR($E($ P(X,","),1 ,5)," ","" ))
	11198	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,0)
	11199	^^1^1^3160 427^
	11200	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,1,0)
	11201	This cross -reference is used t o key the statements for CBSS.
	11202	"^DD",349. 2,349.2,.0 3,1,1,"DT" )
	11203	2960924
	11204	"^DD",349. 2,349.2,.0 3,3)
	11205	Answer mus t be 3-44 characters in length .
	11206	"^DD",349. 2,349.2,.0 3,21,0)
	11207	^^1^1^2960 418^^^^
	11208	"^DD",349. 2,349.2,.0 3,21,1,0)
	11209	This is th e patient name as it appears o n the stat ement.
	11210	"^DD",349. 2,349.2,.0 3,"DT")
	11211	2960924
	11212	"^DD",349. 2,349.2,.1 2,0)
	11213	INVALID ST ATEMENT ER ROR^P349.7 '^RCPSE(34 9.7,^0;12^ Q
	11214	"^DD",349. 2,349.2,.1 2,3)
	11215	Enter the error code for the r ecord that was not a ccepted by CBSS.
	11216	"^DD",349. 2,349.2,.1 2,21,0)
	11217	^^1^1^3160 427^
	11218	"^DD",349. 2,349.2,.1 2,21,1,0)
	11219	This is th e error co de for the record th at was not accepted by CBSS.
	11220	"^DD",349. 2,349.2,.1 2,"DT")
	11221	3160909
	11222	"^DD",349. 2,349.2,.1 8,0)
	11223	CBSS FILE BUILT^S^0: NOT BUILT; 1:BUILT;^0 ;18^Q
	11224	"^DD",349. 2,349.2,.1 8,3)
	11225	Enter a '1 ' when the CBSS PATI ENT STATEM ENTS file is complet e.
	11226	"^DD",349. 2,349.2,.1 8,21,0)
	11227	^^2^2^3160 909^^
	11228	"^DD",349. 2,349.2,.1 8,21,1,0)
	11229	This field will stor e a marker that the CBSS PATIE NT STATEME NTS file
	11230	"^DD",349. 2,349.2,.1 8,21,2,0)
	11231	(349.2) is a complet e file for that stat ement day.
	11232	"^DD",349. 2,349.2,.1 8,"DT")
	11233	3160921
	11234	"^DD",349. 2,349.2,.1 9,0)
	11235	PATIENT ST ATEMENT DA TE^D^^0;19 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	11236	"^DD",349. 2,349.2,.1 9,3)
	11237	Enter the date of th e Patient Statement.
	11238	"^DD",349. 2,349.2,.1 9,21,0)
	11239	^^2^2^3161 019^
	11240	"^DD",349. 2,349.2,.1 9,21,1,0)
	11241	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	11242	"^DD",349. 2,349.2,.1 9,21,2,0)
	11243	standardly two days after the statement is transmi tted
	11244	"^DD",349. 2,349.2,.1 9,"DT")
	11245	3161103
	11246	"^DD",349. 2,349.2,51 ,0)
	11247	ERROR CODE (S)^F^^5;1 ^K:$L(X)>3 0!($L(X)<5 ) X
	11248	"^DD",349. 2,349.2,51 ,1,0)
	11249	^.1^^0
	11250	"^DD",349. 2,349.2,51 ,3)
	11251	Answer mus t be 5-30 characters in length .
	11252	"^DD",349. 2,349.2,51 ,21,0)
	11253	^^2^2^3161 007^
	11254	"^DD",349. 2,349.2,51 ,21,1,0)
	11255	These are the error codes sent back by C BSS when a statement cannot be
	11256	"^DD",349. 2,349.2,51 ,21,2,0)
	11257	printed.
	11258	"^DD",349. 2,349.2,51 ,"DT")
	11259	3161007
	11260	"^DD",349. 2,349.2,61 ,0)
	11261	CBSS PRINT ED^S^1:Y;0 :N;^6;1^Q
	11262	"^DD",349. 2,349.2,61 ,3)
	11263	Enter whet her the pa tient stat ement for this patie nt printed at the CB SS.
	11264	"^DD",349. 2,349.2,61 ,21,0)
	11265	^^2^2^3160 909^^
	11266	"^DD",349. 2,349.2,61 ,21,1,0)
	11267	This field indicates whether t he patient statement for this patient pr inted
	11268	"^DD",349. 2,349.2,61 ,21,2,0)
	11269	at the CCP C or not.
	11270	"^DD",349. 2,349.2,61 ,"DT")
	11271	3160921
	11272	"^DD",349. 2,349.2,81 ,0)
	11273	INTEGRATIO N CONTROL NUMBER^NJ1 2,0^^8;1^K :+X'=X!(X> 9999999999 99)!(X<0)! (X?.E1"."
	11274	1.N) X
	11275	"^DD",349. 2,349.2,81 ,3)
	11276	Enter the ICN, a num ber betwee n 0 and 99 9999999999 with no d ecimal dig its.
	11277	"^DD",349. 2,349.2,81 ,21,0)
	11278	^^2^2^3160 909^
	11279	"^DD",349. 2,349.2,81 ,21,1,0)
	11280	Machine to machine i dentifier for a pati ent. This field can only be
	11281	"^DD",349. 2,349.2,81 ,21,2,0)
	11282	edited by CIRN.
	11283	"^DD",349. 2,349.2,81 ,"DT")
	11284	3160921
	11285	"^DD",349. 2,349.2,82 ,0)
	11286	ICN CHECKS UM^F^^8;2^ K:$L(X)>6! ($L(X)<6) X
	11287	"^DD",349. 2,349.2,82 ,3)
	11288	Answer mus t be 6 cha racters in length.
	11289	"^DD",349. 2,349.2,82 ,21,0)
	11290	^^2^2^3160 428^
	11291	"^DD",349. 2,349.2,82 ,21,1,0)
	11292	This check sum is the calculate d checksum for the I ntegration Control
	11293	"^DD",349. 2,349.2,82 ,21,2,0)
	11294	Number. I t verifies the integ rity of th e ICN.
	11295	"^DD",349. 2,349.2,82 ,"DT")
	11296	3160428
	11297	"^DD",349. 2,349.2,83 ,0)
	11298	AR FLAG^S^ T:TRUE;F:F ALSE;^8;3^ Q
	11299	"^DD",349. 2,349.2,83 ,3)
	11300	Enter T fo r 'TRUE' o r F for 'F alse', for whether t he patient address w as obtain
	11301	ed from AR storage.
	11302	"^DD",349. 2,349.2,83 ,21,0)
	11303	^^2^2^3160 428^
	11304	"^DD",349. 2,349.2,83 ,21,1,0)
	11305	This is a set of cod e, indicat ing whethe r or not t he address was taken
	11306	"^DD",349. 2,349.2,83 ,21,2,0)
	11307	from the A R DEBTOR ( #340).
	11308	"^DD",349. 2,349.2,83 ,"DT")
	11309	3160921
	11310	"^DD",349. 2,349.2,84 ,0)
	11311	DATE OF LA TEST BILL^ DX^^8;4^S %DT="EX" D ^%DT S X= Y K:X<1 X
	11312	"^DD",349. 2,349.2,84 ,3)
	11313	Enter the date on wh ich the la test bill was establ ished.
	11314	"^DD",349. 2,349.2,84 ,21,0)
	11315	^^1^1^3160 428^^
	11316	"^DD",349. 2,349.2,84 ,21,1,0)
	11317	The date t he latest bill was p repared. Time is no t allowed.
	11318	"^DD",349. 2,349.2,84 ,"DT")
	11319	3160921
	11320	"^DD",349. 5,349.5,0)
	11321	FIELD^^1^7
	11322	"^DD",349. 5,349.5,0, "DT")
	11323	3170224
	11324	"^DD",349. 5,349.5,0, "IX","B",3 49.5,.01)
	11325
	11326	"^DD",349. 5,349.5,0, "NM","AR A NNUAL PAYM ENT STATEM ENT")
	11327
	11328	"^DD",349. 5,349.5,.0 1,0)
	11329	PS SEGMENT NUMBER^RN J4,0^^0;1^ K:+X'=X!(X >9999)!(X< 1)!(X?.E1" ."1.N) X
	11330	"^DD",349. 5,349.5,.0 1,1,0)
	11331	^.1
	11332	"^DD",349. 5,349.5,.0 1,1,1,0)
	11333	349.5^B
	11334	"^DD",349. 5,349.5,.0 1,1,1,1)
	11335	S ^RCAP(34 9.5,"B",$E (X,1,30),D A)=""
	11336	"^DD",349. 5,349.5,.0 1,1,1,2)
	11337	K ^RCAP(34 9.5,"B",$E (X,1,30),D A)
	11338	"^DD",349. 5,349.5,.0 1,3)
	11339	Enter the PS Segment Number (a number be tween 1 an d 9999).
	11340	"^DD",349. 5,349.5,.0 1,21,0)
	11341	^^1^1^3170 223^
	11342	"^DD",349. 5,349.5,.0 1,21,1,0)
	11343	This is th e Segment Number for the "PS" Record Ide ntifier.
	11344	"^DD",349. 5,349.5,.0 1,"DT")
	11345	3170224
	11346	"^DD",349. 5,349.5,.0 2,0)
	11347	YEAR^NJ3,0 ^^0;2^K:+X '=X!(X>400 )!(X<300)! (X?.E1"."1 .N) X
	11348	"^DD",349. 5,349.5,.0 2,3)
	11349	Enter the Year for t his segmen t in Inter nal FileMa n Format ( a number b etween 30
	11350	0 and 400) .
	11351	"^DD",349. 5,349.5,.0 2,21,0)
	11352	^^1^1^3170 223^
	11353	"^DD",349. 5,349.5,.0 2,21,1,0)
	11354	This is th e Annual P ayment Fil e Year to be process ed.
	11355	"^DD",349. 5,349.5,.0 2,"DT")
	11356	3170224
	11357	"^DD",349. 5,349.5,.0 3,0)
	11358	DATE/TIME BUILD STAR TED^D^^0;3 ^S %DT="ES TXR" D ^%D T S X=Y K: 3170101>X X
	11359	"^DD",349. 5,349.5,.0 3,3)
	11360	Enter the Date and T ime Build Started.
	11361	"^DD",349. 5,349.5,.0 3,21,0)
	11362	^^1^1^3170 223^
	11363	"^DD",349. 5,349.5,.0 3,21,1,0)
	11364	This is th e Date and Time that the Build for this file start ed.
	11365	"^DD",349. 5,349.5,.0 3,"DT")
	11366	3170224
	11367	"^DD",349. 5,349.5,.0 4,0)
	11368	DATE/TIME BUILD ENDE D^D^^0;4^S %DT="ESTX R" D ^%DT S X=Y K:31 70101>X X
	11369	"^DD",349. 5,349.5,.0 4,3)
	11370	Enter the Date and T ime Build Ended.
	11371	"^DD",349. 5,349.5,.0 4,21,0)
	11372	^^1^1^3170 223^
	11373	"^DD",349. 5,349.5,.0 4,21,1,0)
	11374	This is th e Date and Time that the Build for this file ended .
	11375	"^DD",349. 5,349.5,.0 4,"DT")
	11376	3170224
	11377	"^DD",349. 5,349.5,.0 5,0)
	11378	DATE/TIME TRANSMIT S TARTED^D^^ 0;5^S %DT= "ESTXR" D ^%DT S X=Y K:3170101 >X X
	11379	"^DD",349. 5,349.5,.0 5,3)
	11380	Enter the Date and T ime Transm it Started .
	11381	"^DD",349. 5,349.5,.0 5,21,0)
	11382	^^1^1^3170 223^
	11383	"^DD",349. 5,349.5,.0 5,21,1,0)
	11384	This is th e Date and Time that the Trans mit for th is file st arted.
	11385	"^DD",349. 5,349.5,.0 5,"DT")
	11386	3170224
	11387	"^DD",349. 5,349.5,.0 6,0)
	11388	DATE/TIME TRANSMIT E NDED^D^^0; 6^S %DT="E STXR" D ^% DT S X=Y K :3170101>X X
	11389	"^DD",349. 5,349.5,.0 6,3)
	11390	Enter Date /Time Tran smit Ended .
	11391	"^DD",349. 5,349.5,.0 6,21,0)
	11392	^^1^1^3170 223^
	11393	"^DD",349. 5,349.5,.0 6,21,1,0)
	11394	This is th e Date and Time that the Trans mit for th is file en ded.
	11395	"^DD",349. 5,349.5,.0 6,"DT")
	11396	3170224
	11397	"^DD",349. 5,349.5,1, 0)
	11398	STATEMENT FILE LINES ^349.51^^1 ;0
	11399	"^DD",349. 5,349.5,1, 21,0)
	11400	^^1^1^3170 224^^
	11401	"^DD",349. 5,349.5,1, 21,1,0)
	11402	This is th e multiple for the A nnual Paym ent Statem ent file l ines.
	11403	"^DD",349. 5,349.51,0 )
	11404	STATEMENT FILE LINES SUB-FIELD ^^.01^1
	11405	"^DD",349. 5,349.51,0 ,"DT")
	11406	3170224
	11407	"^DD",349. 5,349.51,0 ,"NM","STA TEMENT FIL E LINES")
	11408
	11409	"^DD",349. 5,349.51,0 ,"UP")
	11410	349.5
	11411	"^DD",349. 5,349.51,. 01,0)
	11412	STATEMENT FILE LINES ^MFJ342^^0 ;1^K:$L(X) >342!($L(X )<1) X
	11413	"^DD",349. 5,349.51,. 01,1,0)
	11414	^.1^^0
	11415	"^DD",349. 5,349.51,. 01,3)
	11416	Enter File Lines for Annual Pa yment Stat ement (1 t o 342 char acters).
	11417	"^DD",349. 5,349.51,. 01,21,0)
	11418	^^1^1^3170 224^
	11419	"^DD",349. 5,349.51,. 01,21,1,0)
	11420	These are the File L ines for A nnual Paym ent Statem ent.
	11421	"^DD",349. 5,349.51,. 01,"DT")
	11422	3170224
	11423	"^DD",433, 433,94,0)
	11424	AUTO-CORRE CTION DATE ^D^^9;4^S %DT="EX" D ^%DT S X= Y K:Y<1 X
	11425	"^DD",433, 433,94,3)
	11426	Type the d ate that t he stateme nt discrep ancy was c orrected.
	11427	"^DD",433, 433,94,21, 0)
	11428	^^2^2^3160 428^
	11429	"^DD",433, 433,94,21, 1,0)
	11430	The is the date that the auto- correction program c orrected t he
	11431	"^DD",433, 433,94,21, 2,0)
	11432	statement discrepanc y for this transacti on.
	11433	"^DD",433, 433,94,"DT ")
	11434	3160920
	11435	"^DD",433, 433,95,0)
	11436	AUTO-CORRE CTION TRAN S. AMOUNT^ NJ9,2^^9;5 ^S:X["$" X =$P(X,"$", 2) K:X'?." -".N.1"."
	11437	.2N!(X>999 999)!(X<-9 99999) X
	11438	"^DD",433, 433,95,3)
	11439	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	11440	"^DD",433, 433,95,21, 0)
	11441	^.001^1^1^ 3160428^^
	11442	"^DD",433, 433,95,21, 1,0)
	11443	This is th e transact ion amount associate d with the statement discrepan cy.
	11444	"^DD",433, 433,95,"DT ")
	11445	3160428
	11446	"^DD",433, 433,96,0)
	11447	AUTO-CORRE CTION TYPE OF ERROR^ S^I:INCOMP LETE FLAG ERROR;D:DU PLICATE TR ANSACTION
	11448	;N:NULL TR ANSACTION AMOUNT;X:N OT FIXABLE ;^9;6^Q
	11449	"^DD",433, 433,96,3)
	11450	Type the k ind of sta tement dis crepancy e rror that was correc ted.
	11451	"^DD",433, 433,96,21, 0)
	11452	^^5^5^3161 004^
	11453	"^DD",433, 433,96,21, 1,0)
	11454	This field stores th e type of error that was corre cted
	11455	"^DD",433, 433,96,21, 2,0)
	11456	for the st atement di screpancy. The erro rs are thr ee
	11457	"^DD",433, 433,96,21, 3,0)
	11458	types: inc omplete fl ag error, a duplicat e transact ion,
	11459	"^DD",433, 433,96,21, 4,0)
	11460	a null tra nsaction a mount, or not fixabl e for all other
	11461	"^DD",433, 433,96,21, 5,0)
	11462	errors.
	11463	"^DD",433, 433,96,"DT ")
	11464	3161004
	11465	"^DD",433, 433,97,0)
	11466	AUTO-CORRE CTION TICK ET FLAG^S^ 1:YES;0:NO ;^9;7^Q
	11467	"^DD",433, 433,97,3)
	11468	Enter Yes if this tr ansaction will need to be manu ally revie wed and co rrected.
	11469	"^DD",433, 433,97,21, 0)
	11470	^^2^2^3161 027^
	11471	"^DD",433, 433,97,21, 1,0)
	11472	Flag notin g that thi s transact ion will n eed to be manually r eviewed an d
	11473	"^DD",433, 433,97,21, 2,0)
	11474	corrected.
	11475	"^DD",433, 433,97,"DT ")
	11476	3161027
	11477	"^DIC",349 .1,349.1,0 )
	11478	AR TRANSMI SSION TYPE ^349.1
	11479	"^DIC",349 .1,349.1,0 ,"GL")
	11480	^RCT(349.1 ,
	11481	"^DIC",349 .1,349.1," %D",0)
	11482	^1.001^2^2 ^3160422^^ ^^
	11483	"^DIC",349 .1,349.1," %D",1,0)
	11484	This file stores the transmiss ion types used in fi le 349
	11485	"^DIC",349 .1,349.1," %D",2,0)
	11486	AR TRANSMI SSION RECO RDS.
	11487	"^DIC",349 .1,"B","AR TRANSMISS ION TYPE", 349.1)
	11488
	11489	"^DIC",349 .5,349.5,0 )
	11490	AR ANNUAL PAYMENT ST ATEMENT^34 9.5
	11491	"^DIC",349 .5,349.5,0 ,"GL")
	11492	^RCAP(349. 5,
	11493	"^DIC",349 .5,349.5," %",0)
	11494	^1.005^^
	11495	"^DIC",349 .5,349.5," %D",0)
	11496	^^3^3^3170 223^
	11497	"^DIC",349 .5,349.5," %D",1,0)
	11498	This file will hold all of the previous year's pat ient payme nt data fo r
	11499	"^DIC",349 .5,349.5," %D",2,0)
	11500	that calen dar year a nd persist for only one year t o then be deleted an d
	11501	"^DIC",349 .5,349.5," %D",3,0)
	11502	replaced a t the begi nning of t he next ca lendar yea r.
	11503	"^DIC",349 .5,"B","AR ANNUAL PA YMENT STAT EMENT",349 .5)
	11504
	11505	"BLD",1011 1,6)
	11506	9^
	11507	$END KID P RCA4.531 3