2. EPMO Open Source Coordination Office Redaction File Detail Report

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

2.1 Files compared

#	Location	File	Last Modified
1	PSE Patch PRCA_4_5_313 v4 _Apr_2017.zip	PRCA_45_313 v4 Patch.docx	Thu Apr 6 05:35:52 2017 UTC
2	PSE Patch PRCA_4_5_313 v4 _Apr_2017.zip	PRCA_45_313 v4 Patch.docx	Mon Apr 24 23:58:33 2017 UTC

2.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	16	16838
Changed	15	37
Inserted	0	0
Removed	0	0

2.3 Comparison options

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

2.4 Active regular expressions

No regular expressions were active.

2.5 Comparison detail

	1	========== ========== ========== ========== ========== ========== ========== =======
	2	Run Date: APR 05, 20 17 Designa tion: PRCA 4.5313
	3	Package : PRCA - ACC OUNTS RECE IVABLE Prio rity: Mand atory
	4	Version : 4.5 St atus: Unde r Developm ent
	5	========== ========== ========== ========== ========== ========== ========== =======
	6
	7	Associated patches: (v)XMDB1 0 i nstall wit h patch `PRCA* 4.5*313'
	8	(u)PRCA4. 5307<<= m ust be ins talled BEF ORE `PRCA* 4.5*313'
	9
	10	Subject: P ATIENT STA TEMENT ENH ANCEMENT - Phase Two
	11
	12	Category:
	13	- Other
	14	- Routin e
	15	- Data D ictionary
	16	- Enhanc ement (Man datory)
	17
	18	Descriptio n:
	19
	20	Type <Ente r> to cont inue or '^ ' to exit: ^
	21
	22	Enter mess age action (in IN ba sket): Ign ore// Prin t
	23	Print just the descr iptive tex t of this KIDS build ? Yes// NO
	24	Print reci pient list ? No// N O
	25	DEVICE: HO ME// ;;999 9 VIRTUAL TELNET
	26
	27	MailMan me ssage for PI I
	28	Printed at DEVESS. D NSURL 04/06/17@0 1:31
	29	Subj: PRCA 4.5313 T EST v4 [# 34932] 5 A pr 2017 15 :46:44 -04 00 (EDT) 8069 lines
	30	From: <"NP M [#8354 1442]"@FOR UM.VA.GOV> In 'IN' basket. Page 1 N ew
	31	---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
	32	$TXT Creat ed by PI I at DEVESS . D NSURL (KIDS) on Wednesday, 04/05/17 at 15:43 f
	33	========== ========== ========== ========== ========== ========== ========== =======
	34	Run Date: APR 05, 20 17 Designa tion: PRCA 4.5313
	35	Package : PRCA - ACC OUNTS RECE IVABLE Prio rity: Mand atory
	36	Version : 4.5 St atus: Unde r Developm ent
	37	========== ========== ========== ========== ========== ========== ========== =======
	38
	39	Associated patches: (v)XMDB1 0 i nstall wit h patch `PRCA* 4.5*313'
	40	(u)PRCA4. 5307<<= m ust be ins talled BEF ORE `PRCA* 4.5*313'
	41
	42	Subject: P ATIENT STA TEMENT ENH ANCEMENT - Phase Two
	43
	44	Category:
	45	- Other
	46	- Routin e
	47	- Data D ictionary
	48	- Enhanc ement (Man datory)
	49
	50	Descriptio n:
	51	========== ==
	52
	53	****** ****** ****** ****** ****** ****** ****** ***
	54	This patch supp orts chang es to the Veterans H ealth Info rmation
	55	Syste m and Tech nology Arc hitecture (VistA) fo r the Pati ent Statem ent
	56	Enhan cements Pr oject (PSE ).
	57
	58	It is imperativ e that the se patches be instal led no lat er than th e
	59	compl iance date . Your und erstanding and suppo rt is appr eciated.
	60	****** ****** ****** ****** ****** ****** ****** ***
	61
	62	The Chief Business Office (CB O) request ed modific ations to the VistA
	63	Accounts Receivable (AR) pack age to rem edy defici encies ide ntified wi th
	64	patient s tatements. The main goals of t his projec t include the
	65	remediati on and enh ancement o f the AR a pplication software to correct
	66	these dis crepancies . Addition ally this project wi ll perform the initi al
	67	developme nt of the VistA AR e nhancement s to creat e a single , consolid ated
	68	patient s tatement, self-servi ce options for payme nt, and ot her
	69	modificat ions.
	70
	71	This patc h modifies the Accou nt Receiva ble (AR) v 4.5 applic ation as
	72	described below:
	73
	74	1. Change the sched ule of pri nting Pati ent Statem ents to se nd patient s
	75	with the first lett ers of the last name on the sa me day eve ry month. The
	76	day of th e month fo r each let ter combin ation is c ontained i n the
	77	Post-Inst allation s ection.
	78
	79	2. Update the Patie nt Stateme nt Build a nd Transmi t code to create and send
	80	the appro priate sta tements wi th an upda ted format . The Buil d and Tran smit
	81	will occu r two days prior to the listed date to a llow for p rocessing by
	82	the Conso lidated Co -payment P rocessing Center (CC PC) and th e Consolid ated
	83	Billing S tatement S ystem (CBS S) for pri nting on t he assigne d date.
	84
	85	3. Receiv e and proc ess the Pr int Acknow ledgements from CCPC using cur rent
	86	procedure s.
	87
	88	4. Create and trans mit a Nigh tly Patien t Update t o provide CBSS with the
	89	oldest bi ll balance and amoun t for each Veteran o n a nightl y basis.
	90
	91	5. Provid e CBSS Nig htly Accou nt Update Program, a s a menu o ption to r un
	92	the Night ly Patient Update fr om the PRC A ACCOUNTS MANAGEMEN T Menu.
	93
	94	6. Update the follo wing menu options to work with the multi ple statem ent
	95	date:
	96
	97	a. CCPC Statement Errors [RCCPC ER ROR]
	98	b. CCPC Totals [RCCPC TO TALS REPOR T]
	99	c. Repr int Patien t Statemen ts [PRCAE PR STATEMENT ]
	100	d. Buil d CCPC fil e for tran smission [RCCPC BU ILD]
	101	e. Tran smit CCPC messages [RCCPC TR ANSMIT]
	102
	103	7. The Au to-Correct Patient D iscrepancy Report ha s been upd ated to
	104	include a new Auto- Correct Re ason sort order. The report no w defaults to
	105	the Auto- Correct Re ason sort order and the four e xisting so rt orders have
	106	been rear ranged and ordered b elow this new sort o rder.
	107
	108	Additiona lly, the r eport sort descripti on that ap pears on t he page
	109	headers h as been up dated to b e more des criptive.
	110
	111	8. Build and Transm it a yearl y Annual P atient Pay ment Summa ry (APPS)
	112	Statement file for every Pati ent paymen t made in the previo us year.
	113	Payment i n Full (34 ) and Paym ent in Par t (2) will be the on ly Account s
	114	Receivabl e Transact ion Types sent in th e file. Th e Build wi ll begin
	115	automatic ally on Ja nuary 2nd of each ye ar for the previous year.
	116	Transmiss ion will b e based up on the Vis tA Site Co de and wil l occur at
	117	02:00 hou rs from Ja nuary 3rd to January 12th. Tra nsmission will be to a
	118	new queue at CCPC.
	119
	120	9. Three new option s have bee n added to the Follo w-up Lette r Menu
	121	[PRCAE FO LLOW-UP].
	122
	123	Build an d Transmit Annual Pa yment File [RCCPC AP PS BUILD A ND TRANS] will
	124	allow ma nual creat ion and tr ansmission of the AP PS Stateme nt file.
	125
	126	Retransm it Current Annual Pa yment File [RCCPC AP PS RETRANS ] will all ow
	127	manual r e-transmis sion of th e APPS Sta tement Fil e.
	128
	129	Annual P ayment Fil e Consiste ncy Check (RCCPC APP S DATA CHE CK) will a llow
	130	Validati on of the APPS State ment File data for t he current calendar year
	131	to the p resent dat e.
	132
	133	Patch Com ponents
	134	========= =======
	135
	136	Files & F ields Asso ciated:
	137	File Name (#) Field Name (#) New/ Mod/Del
	138	--------- ---------- ---------- - ----- ---------- ---------- ---- ---- -------
	139	AR DEBTOR (#340) DEBTO R (#.01) Mod
	140	STATE MENT DAY ( #.03) Mod
	141	CURRE NT CBS DEB T AMOUNT ( #7.06) New
	142
	143	AR EVENT (#341) CCPC STATEMENT DATE (#6.0 1) Mod
	144
	145	AR TRANSM ISSION REC ORDS (#349 ) STATE MENT DATE (#.09) Mod
	146
	147	AR TRANSM ISSION TYP E (#349.1) LAST MESSAGE AC K (#41) Del
	148	FINAL MESSAGE A CK (#42) Del
	149	LAST MESSAGE NU MBER (#43) Del
	150	MESSA GE ACKNOWL EDGEMENT ( #40) New
	151	LAST MESSAGE AC K (#349.14 1,.01) New
	152	FINAL MESSAGE A CK (#349.1 41,.02) New
	153	LAST MESSAGE NU MBER (#349 .141,.03) New
	154	PATIE NT STATEME NT DATE New
	155	(#349 .141,.04)
	156	ACK M ESSAGES (# 50) Mod
	157	PATIE NT STATEME NT DATE New
	158	(#349 .151,.04)
	159
	160	AR CBSS S TATEMENTS (#349.2) PATIE NT (#.01) Mod
	161	SSN ( #.02) Mod
	162	PATIE NT NAME (# .03) Mod
	163	INVAL ID STATEME NT ERROR ( #.12) Mod
	164	CBSS FILE BUILD (#.18) Mod
	165	PATIE NT STATEME NT DATE (# .19) New
	166	ERROR CODE(S) ( #51) Mod
	167	CBSS PRINTED (# 61) Mod
	168	INTEG RATION CON TROL NUMBE R (#81) New
	169	ICN C HECKSUM (# 82) New
	170	AR FL AG (#83) New
	171	DATE OF LATEST BILL (#84) New
	172
	173	AR ANNUAL PAYMENT S TATEMENT F ILE PS SE GMENT NUMB ER (#.01) New
	174	(#349.5) YEAR (#.02) New
	175	DATE/ TIME BUILD STARTED ( #.03) New
	176	DATE/ TIME BUILD ENDED (#. 04) New
	177	DATE/ TIME TRANS MIT STARTE D (#.05) New
	178	DATE/ TIME TRANS MIT ENDED (#.06) New
	179	STATE MENT FILE LINES (#1) New
	180	STATE MENT FILE LINES (#34 9.51,.01) New
	181
	182	Forms Ass ociated:
	183
	184	Form Name Fil e # New/M odified/De leted
	185	--------- --- --- ----- ---------- -----
	186	N/A
	187
	188	Mail Grou ps Associa ted:
	189
	190	Mail Grou p Name New /Modified/ Deleted
	191	--------- ------ --- ---------- -------
	192	N/A
	193
	194	Options A ssociated:
	195
	196	Option Na me Type New/Mo dified/Del eted
	197	--------- -- - ---------- ------ ---------- ----
	198	PRCA CBS NIGHTLY UP DATE R un Routine New
	199	RCCPC APP S BUILD AN D TRANS A ction New
	200	RCCPC APP S RETRANS A ction New
	201	RCCPC APP S DATA CHE CK A ction New
	202
	203	Protocols Associate d:
	204
	205	Protocol Name New /Modified/ Deleted
	206	--------- ---- --- ---------- -------
	207	N/A
	208
	209	Security Keys Assoc iated:
	210
	211	Security Key Name
	212	--------- --------
	213	N/A
	214
	215	Templates Associate d:
	216
	217	Template Name Typ e File Name (Numb er) New/M odified/De leted
	218	--------- ---- --- - ----- ---------- --- ----- ---------- -----
	219	N/A
	220
	221	Additiona l Informat ion:
	222	N/A
	223
	224	New Servi ce Request s (NSRs):
	225	--------- ---------- ---------
	226	N/A
	227
	228	Patient S afety Issu es (PSIs):
	229	--------- ---------- ----------
	230	N/A
	231
	232	Defect Tr acking Sys tem Ticket (s) & Over view:
	233	--------- ---------- ---------- ---------- -----
	234	N/A
	235
	236	Problem:
	237	-------
	238	N/A
	239
	240	Resolutio n:
	241	--------- -
	242	N/A
	243
	244	Test Site s:
	245	--------- -
	246	Bay Pines VA HCS
	247	James A. Haley VAMC
	248
	249	Software and Docume ntation Re trieval In structions :
	250	--------- ---------- ---------- ---------- ---------- ---
	251	Software being rele ased as a host file and/or doc umentation describin g
	252	the new f unctionali ty introdu ced by thi s patch ar e availabl e.
	253
	254	The prefe rred metho d is to re trieve fil es from do wnload. URL .
	255	This tran smits the files from the first available server. S ites may
	256	also elec t to retri eve files directly f rom a spec ific serve r.
	257
	258	Sites may retrieve the softwa re and/or documentat ion direct ly using
	259	Secure Fi le Transfe r Protocol (SFTP) fr om the ANO NYMOUS.SOF TWARE
	260	directory at the fo llowing OI Field Off ices:
	261
	262	Albany: D NS.URL
	263	Hines: D NS.URL
	264	Salt Lake City: DNS . URL
	265
	266	Documenta tion can a lso be fou nd on the VA Softwar e Document ation Libr ary
	267	at: http: // URL /
	268
	269	Title F ile Name FTP M ode
	270	--------- ---------- ---------- ---------- ---------- ---------- ---------- --
	271	<Document ation titl e>
	272
	273	Patch Ins tallation:
	274
	275	Pre/Post Installati on Overvie w:
	276	--------- ---------- ---------- --
	277	The Pre-I nstallatio n removes elements f rom the AR Transacti on and AR
	278	Transacti on Type fi les. The P ost-Instal lation rem oves curre nt monthly
	279	Patient S tatement D ata, reset s each Deb tor's Pati ent Statem ent date t o
	280	the date matching t he last na me of the patient, a nd insures the Patie nt
	281	Statement and Night ly Update queues are set to th e proper d omains.
	282
	283	Pre-Insta llation In structions :
	284	--------- ---------- ---------- -
	285	The Pre-I nstallatio n removes elements f rom the AR Transmiss ion Record s
	286	and AR Tr ansmission Type file s.
	287
	288	The AR TR ANSMISSION RECORDS f ile (#349) will have the STATE MENT DATE field
	289	(#.09) re moved prio r to enter ing a New Style Cros s-Referenc e.
	290
	291	The AR TR ANSMISSION TYPE file (#349.1) will have the LAST M ESSAGE ACK
	292	field (#4 1), FINAL MESSAGE AC K field (# 42), and t he LAST ME SSAGE NUMB ER
	293	field (#4 3) removed . These el ements wil l be repla ced with a multiple
	294	record ME SSAGE ACKN OWLEDGEMEN T field (# 349.141) d uring the data dicti onary
	295	load.
	296
	297	This patc h may be i nstalled w ith users on the sys tem althou gh it is
	298	recommend ed that it be instal led during non-peak hours to m inimize
	299	potential disruptio n to users . This pat ch should take less than 30
	300	minutes t o install.
	301
	302	No Menu O ptions nee d to be di sabled dur ing this i nstallatio n.
	303
	304	Installat ion Instru ctions:
	305	--------- ---------- -------
	306	This patc h modifies the Accou nt Receiva ble (AR) v 4.5 applic ation for a
	307	single, c onsolidate d patient statement.
	308
	309	1. Cho ose the Pa ckMan mess age contai ning this patch.
	310
	311	2. Cho ose the IN STALL/CHEC K MESSAGE PackMan op tion.
	312
	313	3. Fro m the Kern el Install ation and Distributi on System Menu, sele ct
	314	the Installat ion Menu. From this menu, you may elect to use the
	315	fol lowing opt ions. When prompted for the IN STALL NAME enter the
	316	pat ch PRCA4. 5313.
	317
	318	a. Backup a T ransport G lobal - Th is option will creat e a backup
	319	message of any routi nes export ed with th is patch. It will no t
	320	backup any other cha nges such as DDs or templates.
	321
	322	b. Compare Tr ansport Gl obal to Cu rrent Syst em - This option wil l
	323	allow you to view al l changes that will be made wh en this
	324	patch is i nstalled. It compare s all comp onents of this patch
	325	routines, DDs, templ ates, etc.
	326
	327	c. Verify Che cksums in Transport Global - T his option will allo w
	328	you to ens ure the in tegrity of the routi nes that a re in the
	329	transport global.
	330
	331	4. Fro m the Inst allation M enu, selec t the Inst all Packag e(s)
	332	opt ion and ch oose the p atch to in stall.
	333
	334	5. Whe n prompted 'Want KID S to Rebui ld Menu Tr ees Upon C ompletion
	335	of Install? Y ES//' repl y 'YES' un less your system reb uilds menu
	336	tre es nightly using Tas kMan. Answ ering Yes during nor mal busine ss
	337	hou rs could a ffect user s on the s ystem and installati on times w ill
	338	inc rease.
	339
	340	7. Whe n Prompted "Want KID S to INHIB IT LOGONs during the install?
	341	NO //", respo nd NO.
	342
	343	8. Whe n Prompted "Want to DISABLE Sc heduled Op tions, Men u Options, and
	344	Pr otocols? N O//", resp ond NO.
	345
	346	9. Whe n prompted "Delay In stall (Min utes): (0 -60): 0//" enter an
	347	app ropriate n umber of m inutes to delay the installati on in
	348	ord er to give users eno ugh time t o exit the disabled options
	349	bef ore the in stallation starts.
	350
	351	10. Whe n prompted "Device: Home//" r espond wit h the corr ect device .
	352
	353	Post-Inst allation I nstruction s:
	354	--------- ---------- ---------- --
	355	The Post- Installati on removes current m onthly Pat ient State ment Data,
	356	resets ea ch Debtor' s Patient Statement date to th e date mat ching the last
	357	name of t he Patient , and insu res the Pa tient Stat ement and Nightly Up date
	358	transmiss ion queues are set t o the prop er domains .
	359
	360	The previ ous month' s Patient Statement data is re moved at e ach site p rior
	361	to the cr eation of the curren t month's data. To i mplement 1 6 days dur ing
	362	the month for alpha betically based Pati ent Statem ents, all data must be
	363	removed. This is pe rformed du ring the P ost-Instal l. Should a site fee l
	364	it requir es these o lder Patie nt Stateme nts, a Rep rint Patie nt Stateme nts
	365	[PRCAE PR STATEMENT ] may be p erformed. It is STRO NGLY RECOM MENDED, du e to
	366	the size of this fi le, each s ite run a single rep rint to a single Mai lMan
	367	account a nd share t hat data u ntil the p atient's n ew stateme nt prints
	368	within th e next 31 days.
	369
	370	The Post- Installati on will re set each A R Debtor's account t hat proces ses
	371	Patient S tatements with the P atient Sta tement Dat e correspo nding to t he
	372	table pro vided. The letters u se the Pat ient's Las t Name. Th e SITE
	373	STATEMENT DATE fiel d (#.11) i n the AR S ITE PARAME NTER file (#342) is set
	374	to Null t o prevent a possible transmiss ion using the previo us format.
	375
	376	Day of th e Month Lette rs of last name
	377	--------- ------- ----- ---------- -----
	378	1 A,BA, BU
	379	2 B EXC LUDE (BA,B U)
	380	4 CI,CR ,CU,D
	381	6 C EXC LUDE (CI,C R,CU)
	382	7 E,F,I ,Q
	383	8 G,HE
	384	10 H EXC LUDE HE
	385	12 J,K
	386	14 L,O
	387	15 M EXC LUDE (MC,M I)
	388	17 MC,MI ,N,TI-TZ
	389	19 R,TA- TE
	390	21 S EXC LUDE (SC,S H,SI,SM)
	391	22 SC,SH ,SI,SM,TF- TH,V
	392	24 P,U,X ,Y,Z
	393	26 W
	394
	395	VistA Mai lMan is us ed to send the Patie nt Stateme nt and Nig htly Updat e
	396	files. Th e addresse s for thes e transmis sions are taken from the AR
	397	TRANSMISS ION TYPE f ile (#349. 1). The Po st-Install ation vali dates and
	398	updates t he CCPC Do main and A ddressee f or both tr ansmission types. As the
	399	Nightly U pdate and Annual Pat ient Payme nt Summery transmiss ions are s ent
	400	to a new Domain, Pa tch XMDB1 .00 a req uired Patc h must hav e been
	401	previousl y loaded.
	402
	403	Routine In formation:
	404	========== ==========
	405	The second line of e ach of the se routine s now look s like:
	406	;;4.5;Acc ounts Rece ivable;[ Patch List ];Mar 20 , 1995;Bui ld 113
	407
	408	The checks ums below are new ch ecksums, a nd
	409	can be ch ecked with CHECK1^XT SUMBLD.
	410
	411	Routine Na me: PRCA31 3P
	412	Before : n/ a After: B18697460 313
	413	Routine Na me: PRCAAC R
	414	Before : n/ a After: B124955572 307,31 3
	415	Routine Na me: PRCAAC R1
	416	Before : n/ a After: B151271441 307,31 3
	417	Routine Na me: PRCACP S1
	418	Before : n/ a After: B18771251 313
	419	Routine Na me: PRCAG
	420	Before : B2201651 2 After: B36104045 *149,16 5,198,313 *
	421	Routine Na me: RCCPCA P
	422	Before : n/ a After: B39742487 313
	423	Routine Na me: RCCPCA R
	424	Before : n/ a After: B48587779 313
	425	Routine Na me: RCCPCA T
	426	Before : n/ a After: B33146754 313
	427	Routine Na me: RCCPCB J
	428	Before : B628849 1 After: B9466054 **34,76, 130,153,16 6,195,217,
	429	237,307 ,313**
	430	Routine Na me: RCCPCF N1
	431	Before : n/ a After: B6869513 313
	432	Routine Na me: RCCPCM L
	433	Before : B4788102 4 After: B65098323 **34,80, 93,118,133 ,140,160,1 65,
	434	187,195 ,206,223,2 60,313**
	435	Routine Na me: RCCPCM L1
	436	Before : B668233 5 After: B8787618 160,31 3
	437	Routine Na me: RCCPCP S
	438	Before : B8089891 5 After: B126292904 **34,70, 80,48,104, 116,149,17 0,
	439	181,190 ,223,237,2 19,265,301 ,
	440	313**
	441	Routine Na me: RCCPCP S1
	442	Before : B3737011 3 After: B64833684 34,48, 104,170,17 6,192,265, 313
	443	Routine Na me: RCCPCS E
	444	Before : B581043 9 After: B13492869 34,313
	445	Routine Na me: RCCPCS V
	446	Before : B519949 0 After: B11821725 34,70, 87,313
	447	Routine Na me: RCCPCS V1
	448	Before : B3201709 6 After: B43663255 34,70, 76,130,153 ,313
	449	Routine Na me: RCCPCT
	450	Before : B248969 7 After: B23641825 34,313
	451
	452	Routine li st of prec eding patc hes: 87, 1 98, 260, 3 01, 307
	453
	454	========== ========== ========== ========== ========== ========== ========== =======
	455	User Infor mation:
	456	Entered By : PI I Date Enter ed : MAY 04, 2016
	457	Completed By: Date C ompleted:
	458	Released B y : Date R eleased :
	459	========== ========== ========== ========== ========== ========== ========== =======
	460
	461	Packman Ma il Message :
	462	========== ========== =
	463
	464	$END TXT
	465	$KID PRCA* 4.5*313
	466	INSTALL NAME
	467	PRCA4.53 13
	468	"BLD",1011 1,0)
	469	PRCA4.53 13^ACCOUNT S RECEIVAB LE^0^31704 05^y
	470	"BLD",1011 1,1,0)
	471	^^1^1^3160 811^^^^
	472	"BLD",1011 1,1,1,0)
	473	Consolidat ed Patient Statement
	474	"BLD",1011 1,4,0)
	475	^9.64PA^34 9.5^6
	476	"BLD",1011 1,4,340,0)
	477	340
	478	"BLD",1011 1,4,340,2, 0)
	479	^9.641^340 ^1
	480	"BLD",1011 1,4,340,2, 340,0)
	481	AR DEBTOR (File-top level)
	482	"BLD",1011 1,4,340,2, 340,1,0)
	483	^9.6411^.0 3^3
	484	"BLD",1011 1,4,340,2, 340,1,.01, 0)
	485	DEBTOR
	486	"BLD",1011 1,4,340,2, 340,1,.03, 0)
	487	STATEMENT DAY
	488	"BLD",1011 1,4,340,2, 340,1,7.06 ,0)
	489	CURRENT CB S DEBT AMO UNT
	490	"BLD",1011 1,4,340,22 2)
	491	y^n^p^^^^n ^^n
	492	"BLD",1011 1,4,340,22 4)
	493
	494	"BLD",1011 1,4,341,0)
	495	341
	496	"BLD",1011 1,4,341,2, 0)
	497	^9.641^341 ^1
	498	"BLD",1011 1,4,341,2, 341,0)
	499	AR EVENT (File-top level)
	500	"BLD",1011 1,4,341,2, 341,1,0)
	501	^9.6411^6. 01^1
	502	"BLD",1011 1,4,341,2, 341,1,6.01 ,0)
	503	CCPC STATE MENT DATE
	504	"BLD",1011 1,4,341,22 2)
	505	y^n^p^^^^n ^^n
	506	"BLD",1011 1,4,341,22 4)
	507
	508	"BLD",1011 1,4,349,0)
	509	349
	510	"BLD",1011 1,4,349,2, 0)
	511	^9.641^349 ^1
	512	"BLD",1011 1,4,349,2, 349,0)
	513	AR TRANSMI SSION RECO RDS (File -top level )
	514	"BLD",1011 1,4,349,2, 349,1,0)
	515	^9.6411^.0 9^1
	516	"BLD",1011 1,4,349,2, 349,1,.09, 0)
	517	STATEMENT DATE
	518	"BLD",1011 1,4,349,22 2)
	519	y^n^p^^^^n ^^n
	520	"BLD",1011 1,4,349,22 4)
	521
	522	"BLD",1011 1,4,349.1, 0)
	523	349.1
	524	"BLD",1011 1,4,349.1, 222)
	525	y^n^f^^^^n ^^n
	526	"BLD",1011 1,4,349.1, 224)
	527
	528	"BLD",1011 1,4,349.2, 0)
	529	349.2
	530	"BLD",1011 1,4,349.2, 2,0)
	531	^9.641^349 .2^1
	532	"BLD",1011 1,4,349.2, 2,349.2,0)
	533	AR CBSS ST ATEMENTS (File-top level)
	534	"BLD",1011 1,4,349.2, 2,349.2,1, 0)
	535	^9.6411^61 ^12
	536	"BLD",1011 1,4,349.2, 2,349.2,1, .01,0)
	537	PATIENT
	538	"BLD",1011 1,4,349.2, 2,349.2,1, .02,0)
	539	SSN
	540	"BLD",1011 1,4,349.2, 2,349.2,1, .03,0)
	541	PATIENT NA ME
	542	"BLD",1011 1,4,349.2, 2,349.2,1, .12,0)
	543	INVALID ST ATEMENT ER ROR
	544	"BLD",1011 1,4,349.2, 2,349.2,1, .18,0)
	545	CBSS FILE BUILT
	546	"BLD",1011 1,4,349.2, 2,349.2,1, .19,0)
	547	PATIENT ST ATEMENT DA TE
	548	"BLD",1011 1,4,349.2, 2,349.2,1, 51,0)
	549	ERROR CODE (S)
	550	"BLD",1011 1,4,349.2, 2,349.2,1, 61,0)
	551	CBSS PRINT ED
	552	"BLD",1011 1,4,349.2, 2,349.2,1, 81,0)
	553	INTEGRATIO N CONTROL NUMBER
	554	"BLD",1011 1,4,349.2, 2,349.2,1, 82,0)
	555	ICN CHECKS UM
	556	"BLD",1011 1,4,349.2, 2,349.2,1, 83,0)
	557	AR FLAG
	558	"BLD",1011 1,4,349.2, 2,349.2,1, 84,0)
	559	DATE OF LA TEST BILL
	560	"BLD",1011 1,4,349.2, 222)
	561	y^n^p^^^^n ^^n
	562	"BLD",1011 1,4,349.2, 224)
	563
	564	"BLD",1011 1,4,349.5, 0)
	565	349.5
	566	"BLD",1011 1,4,349.5, 222)
	567	y^n^f^^^^n ^^n
	568	"BLD",1011 1,4,349.5, 224)
	569
	570	"BLD",1011 1,4,"APDD" ,340,340)
	571
	572	"BLD",1011 1,4,"APDD" ,340,340,. 01)
	573
	574	"BLD",1011 1,4,"APDD" ,340,340,. 03)
	575
	576	"BLD",1011 1,4,"APDD" ,340,340,7 .06)
	577
	578	"BLD",1011 1,4,"APDD" ,341,341)
	579
	580	"BLD",1011 1,4,"APDD" ,341,341,6 .01)
	581
	582	"BLD",1011 1,4,"APDD" ,349,349)
	583
	584	"BLD",1011 1,4,"APDD" ,349,349,. 09)
	585
	586	"BLD",1011 1,4,"APDD" ,349.2,349 .2)
	587
	588	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.01)
	589
	590	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.02)
	591
	592	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.03)
	593
	594	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.12)
	595
	596	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.18)
	597
	598	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.19)
	599
	600	"BLD",1011 1,4,"APDD" ,349.2,349 .2,51)
	601
	602	"BLD",1011 1,4,"APDD" ,349.2,349 .2,61)
	603
	604	"BLD",1011 1,4,"APDD" ,349.2,349 .2,81)
	605
	606	"BLD",1011 1,4,"APDD" ,349.2,349 .2,82)
	607
	608	"BLD",1011 1,4,"APDD" ,349.2,349 .2,83)
	609
	610	"BLD",1011 1,4,"APDD" ,349.2,349 .2,84)
	611
	612	"BLD",1011 1,4,"B",34 0,340)
	613
	614	"BLD",1011 1,4,"B",34 1,341)
	615
	616	"BLD",1011 1,4,"B",34 9,349)
	617
	618	"BLD",1011 1,4,"B",34 9.1,349.1)
	619
	620	"BLD",1011 1,4,"B",34 9.2,349.2)
	621
	622	"BLD",1011 1,4,"B",34 9.5,349.5)
	623
	624	"BLD",1011 1,6)
	625	2^
	626	"BLD",1011 1,6.3)
	627	113
	628	"BLD",1011 1,"ABPKG")
	629	n
	630	"BLD",1011 1,"INI")
	631	PRE^PRCA31 3P
	632	"BLD",1011 1,"INID")
	633	^y^y
	634	"BLD",1011 1,"INIT")
	635	EN^PRCA313 P
	636	"BLD",1011 1,"KRN",0)
	637	^9.67PA^77 9.2^20
	638	"BLD",1011 1,"KRN",.4 ,0)
	639	.4
	640	"BLD",1011 1,"KRN",.4 ,"NM",0)
	641	^9.68A^^0
	642	"BLD",1011 1,"KRN",.4 01,0)
	643	.401
	644	"BLD",1011 1,"KRN",.4 02,0)
	645	.402
	646	"BLD",1011 1,"KRN",.4 02,"NM",0)
	647	^9.68A^^0
	648	"BLD",1011 1,"KRN",.4 03,0)
	649	.403
	650	"BLD",1011 1,"KRN",.5 ,0)
	651	.5
	652	"BLD",1011 1,"KRN",.8 4,0)
	653	.84
	654	"BLD",1011 1,"KRN",3. 6,0)
	655	3.6
	656	"BLD",1011 1,"KRN",3. 8,0)
	657	3.8
	658	"BLD",1011 1,"KRN",3. 8,"NM",0)
	659	^9.68A^^0
	660	"BLD",1011 1,"KRN",9. 2,0)
	661	9.2
	662	"BLD",1011 1,"KRN",9. 8,0)
	663	9.8
	664	"BLD",1011 1,"KRN",9. 8,"NM",0)
	665	^9.68A^23^ 18
	666	"BLD",1011 1,"KRN",9. 8,"NM",5,0 )
	667	RCCPCBJ^^0 ^B9466054
	668	"BLD",1011 1,"KRN",9. 8,"NM",6,0 )
	669	PRCACPS1^^ 0^B1877125 1
	670	"BLD",1011 1,"KRN",9. 8,"NM",7,0 )
	671	RCCPCFN1^^ 0^B6869513
	672	"BLD",1011 1,"KRN",9. 8,"NM",8,0 )
	673	RCCPCML^^0 ^B65098323
	674	"BLD",1011 1,"KRN",9. 8,"NM",9,0 )
	675	RCCPCSV^^0 ^B11821725
	676	"BLD",1011 1,"KRN",9. 8,"NM",10, 0)
	677	RCCPCPS^^0 ^B12629290 4
	678	"BLD",1011 1,"KRN",9. 8,"NM",11, 0)
	679	RCCPCPS1^^ 0^B6483368 4
	680	"BLD",1011 1,"KRN",9. 8,"NM",12, 0)
	681	RCCPCSV1^^ 0^B4366325 5
	682	"BLD",1011 1,"KRN",9. 8,"NM",13, 0)
	683	RCCPCML1^^ 0^B8787618
	684	"BLD",1011 1,"KRN",9. 8,"NM",14, 0)
	685	RCCPCSE^^0 ^B13492869
	686	"BLD",1011 1,"KRN",9. 8,"NM",15, 0)
	687	RCCPCT^^0^ B23641825
	688	"BLD",1011 1,"KRN",9. 8,"NM",17, 0)
	689	PRCAG^^0^B 36104045
	690	"BLD",1011 1,"KRN",9. 8,"NM",18, 0)
	691	PRCA313P^^ 0^B1869746 0
	692	"BLD",1011 1,"KRN",9. 8,"NM",19, 0)
	693	PRCAACR^^0 ^B12495557 2
	694	"BLD",1011 1,"KRN",9. 8,"NM",20, 0)
	695	PRCAACR1^^ 0^B1512714 41
	696	"BLD",1011 1,"KRN",9. 8,"NM",21, 0)
	697	RCCPCAP^^0 ^B39742487
	698	"BLD",1011 1,"KRN",9. 8,"NM",22, 0)
	699	RCCPCAT^^0 ^B33146754
	700	"BLD",1011 1,"KRN",9. 8,"NM",23, 0)
	701	RCCPCAR^^0 ^B48587779
	702	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCA313P ",18)
	703
	704	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR" ,19)
	705
	706	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR1 ",20)
	707
	708	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPS1 ",6)
	709
	710	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAG",1 7)
	711
	712	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAP" ,21)
	713
	714	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAR" ,23)
	715
	716	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAT" ,22)
	717
	718	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCBJ" ,5)
	719
	720	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCFN1 ",7)
	721
	722	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML" ,8)
	723
	724	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML1 ",13)
	725
	726	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS" ,10)
	727
	728	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS1 ",11)
	729
	730	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSE" ,14)
	731
	732	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV" ,9)
	733
	734	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV1 ",12)
	735
	736	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCT", 15)
	737
	738	"BLD",1011 1,"KRN",19 ,0)
	739	19
	740	"BLD",1011 1,"KRN",19 ,"NM",0)
	741	^9.68A^8^5
	742	"BLD",1011 1,"KRN",19 ,"NM",4,0)
	743	PRCA CBS N IGHTLY UPD ATE^^0
	744	"BLD",1011 1,"KRN",19 ,"NM",5,0)
	745	PRCAE FOLL OW-UP^^2
	746	"BLD",1011 1,"KRN",19 ,"NM",6,0)
	747	RCCPC APPS BUILD AND TRANS^^0
	748	"BLD",1011 1,"KRN",19 ,"NM",7,0)
	749	RCCPC APPS RETRANS^^ 0
	750	"BLD",1011 1,"KRN",19 ,"NM",8,0)
	751	RCCPC APPS DATA CHEC K^^0
	752	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA CBS NIGHTLY UP DATE",4)
	753
	754	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCAE FOL LOW-UP",5)
	755
	756	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S BUILD AN D TRANS",6 )
	757
	758	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S DATA CHE CK",8)
	759
	760	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S RETRANS" ,7)
	761
	762	"BLD",1011 1,"KRN",19 .1,0)
	763	19.1
	764	"BLD",1011 1,"KRN",19 .1,"NM",0)
	765	^9.68A^^0
	766	"BLD",1011 1,"KRN",10 1,0)
	767	101
	768	"BLD",1011 1,"KRN",40 9.61,0)
	769	409.61
	770	"BLD",1011 1,"KRN",77 1,0)
	771	771
	772	"BLD",1011 1,"KRN",77 9.2,0)
	773	779.2
	774	"BLD",1011 1,"KRN",87 0,0)
	775	870
	776	"BLD",1011 1,"KRN",89 89.51,0)
	777	8989.51
	778	"BLD",1011 1,"KRN",89 89.52,0)
	779	8989.52
	780	"BLD",1011 1,"KRN",89 94,0)
	781	8994
	782	"BLD",1011 1,"KRN","B ",.4,.4)
	783
	784	"BLD",1011 1,"KRN","B ",.401,.40 1)
	785
	786	"BLD",1011 1,"KRN","B ",.402,.40 2)
	787
	788	"BLD",1011 1,"KRN","B ",.403,.40 3)
	789
	790	"BLD",1011 1,"KRN","B ",.5,.5)
	791
	792	"BLD",1011 1,"KRN","B ",.84,.84)
	793
	794	"BLD",1011 1,"KRN","B ",3.6,3.6)
	795
	796	"BLD",1011 1,"KRN","B ",3.8,3.8)
	797
	798	"BLD",1011 1,"KRN","B ",9.2,9.2)
	799
	800	"BLD",1011 1,"KRN","B ",9.8,9.8)
	801
	802	"BLD",1011 1,"KRN","B ",19,19)
	803
	804	"BLD",1011 1,"KRN","B ",19.1,19. 1)
	805
	806	"BLD",1011 1,"KRN","B ",101,101)
	807
	808	"BLD",1011 1,"KRN","B ",409.61,4 09.61)
	809
	810	"BLD",1011 1,"KRN","B ",771,771)
	811
	812	"BLD",1011 1,"KRN","B ",779.2,77 9.2)
	813
	814	"BLD",1011 1,"KRN","B ",870,870)
	815
	816	"BLD",1011 1,"KRN","B ",8989.51, 8989.51)
	817
	818	"BLD",1011 1,"KRN","B ",8989.52, 8989.52)
	819
	820	"BLD",1011 1,"KRN","B ",8994,899 4)
	821
	822	"BLD",1011 1,"QDEF")
	823	^^^^^^^^YE S
	824	"BLD",1011 1,"QUES",0 )
	825	^9.62^^
	826	"BLD",1011 1,"REQB",0 )
	827	^9.611^2^2
	828	"BLD",1011 1,"REQB",1 ,0)
	829	PRCA4.53 07^2
	830	"BLD",1011 1,"REQB",2 ,0)
	831	XMDB1.00 ^2
	832	"BLD",1011 1,"REQB"," B","PRCA4 .5307",1)
	833
	834	"BLD",1011 1,"REQB"," B","XMDB1 .00",2)
	835
	836	"FIA",340)
	837	AR DEBTOR
	838	"FIA",340, 0)
	839	^RCD(340,
	840	"FIA",340, 0,0)
	841	340V
	842	"FIA",340, 0,1)
	843	y^n^p^^^^n ^^n
	844	"FIA",340, 0,10)
	845
	846	"FIA",340, 0,11)
	847
	848	"FIA",340, 0,"RLRO")
	849
	850	"FIA",340, 0,"VR")
	851	4.5^PRCA
	852	"FIA",340, 340)
	853	1
	854	"FIA",340, 340,.01)
	855
	856	"FIA",340, 340,.03)
	857
	858	"FIA",340, 340,7.06)
	859
	860	"FIA",341)
	861	AR EVENT
	862	"FIA",341, 0)
	863	^RC(341,
	864	"FIA",341, 0,0)
	865	341I
	866	"FIA",341, 0,1)
	867	y^n^p^^^^n ^^n
	868	"FIA",341, 0,10)
	869
	870	"FIA",341, 0,11)
	871
	872	"FIA",341, 0,"RLRO")
	873
	874	"FIA",341, 0,"VR")
	875	4.5^PRCA
	876	"FIA",341, 341)
	877	1
	878	"FIA",341, 341,6.01)
	879
	880	"FIA",349)
	881	AR TRANSMI SSION RECO RDS
	882	"FIA",349, 0)
	883	^RCT(349,
	884	"FIA",349, 0,0)
	885	349I
	886	"FIA",349, 0,1)
	887	y^n^p^^^^n ^^n
	888	"FIA",349, 0,10)
	889
	890	"FIA",349, 0,11)
	891
	892	"FIA",349, 0,"RLRO")
	893
	894	"FIA",349, 0,"VR")
	895	4.5^PRCA
	896	"FIA",349, 349)
	897	1
	898	"FIA",349, 349,.09)
	899
	900	"FIA",349. 1)
	901	AR TRANSMI SSION TYPE
	902	"FIA",349. 1,0)
	903	^RCT(349.1 ,
	904	"FIA",349. 1,0,0)
	905	349.1I
	906	"FIA",349. 1,0,1)
	907	y^n^f^^^^n ^^n
	908	"FIA",349. 1,0,10)
	909
	910	"FIA",349. 1,0,11)
	911
	912	"FIA",349. 1,0,"RLRO" )
	913
	914	"FIA",349. 1,0,"VR")
	915	4.5^PRCA
	916	"FIA",349. 1,349.1)
	917	0
	918	"FIA",349. 1,349.11)
	919	0
	920	"FIA",349. 1,349.12)
	921	0
	922	"FIA",349. 1,349.141)
	923	0
	924	"FIA",349. 1,349.151)
	925	0
	926	"FIA",349. 1,349.161)
	927	0
	928	"FIA",349. 2)
	929	AR CBSS ST ATEMENTS
	930	"FIA",349. 2,0)
	931	^RCPS(349. 2,
	932	"FIA",349. 2,0,0)
	933	349.2I
	934	"FIA",349. 2,0,1)
	935	y^n^p^^^^n ^^n
	936	"FIA",349. 2,0,10)
	937
	938	"FIA",349. 2,0,11)
	939
	940	"FIA",349. 2,0,"RLRO" )
	941
	942	"FIA",349. 2,0,"VR")
	943	4.5^PRCA
	944	"FIA",349. 2,349.2)
	945	1
	946	"FIA",349. 2,349.2,.0 1)
	947
	948	"FIA",349. 2,349.2,.0 2)
	949
	950	"FIA",349. 2,349.2,.0 3)
	951
	952	"FIA",349. 2,349.2,.1 2)
	953
	954	"FIA",349. 2,349.2,.1 8)
	955
	956	"FIA",349. 2,349.2,.1 9)
	957
	958	"FIA",349. 2,349.2,51 )
	959
	960	"FIA",349. 2,349.2,61 )
	961
	962	"FIA",349. 2,349.2,81 )
	963
	964	"FIA",349. 2,349.2,82 )
	965
	966	"FIA",349. 2,349.2,83 )
	967
	968	"FIA",349. 2,349.2,84 )
	969
	970	"FIA",349. 5)
	971	AR ANNUAL PAYMENT ST ATEMENT
	972	"FIA",349. 5,0)
	973	^RCAP(349. 5,
	974	"FIA",349. 5,0,0)
	975	349.5
	976	"FIA",349. 5,0,1)
	977	y^n^f^^^^n ^^n
	978	"FIA",349. 5,0,10)
	979
	980	"FIA",349. 5,0,11)
	981
	982	"FIA",349. 5,0,"RLRO" )
	983
	984	"FIA",349. 5,0,"VR")
	985	4.5^PRCA
	986	"FIA",349. 5,349.5)
	987	0
	988	"FIA",349. 5,349.51)
	989	0
	990	"INI")
	991	PRE^PRCA31 3P
	992	"INIT")
	993	EN^PRCA313 P
	994	"IX",349,3 49,"SDT",0 )
	995	349^SDT^Pa tient Stat ement Day of the Mon th^R^^F^IR ^I^349^^^^ ^LS
	996	"IX",349,3 49,"SDT",. 1,0)
	997	^^1^1^3161 007^
	998	"IX",349,3 49,"SDT",. 1,1,0)
	999	This cross -reference is the Pa tient Stat ement Day of the Mon th.
	1000	"IX",349,3 49,"SDT",1 )
	1001	S ^RCT(349 ,"SDT",$E( X,1,2),DA) =""
	1002	"IX",349,3 49,"SDT",2 )
	1003	K ^RCT(349 ,"SDT",$E( X,1,2),DA)
	1004	"IX",349,3 49,"SDT",2 .5)
	1005	K ^RCT(349 ,"SDT")
	1006	"IX",349,3 49,"SDT",1 1.1,0)
	1007	^.114IA^1^ 1
	1008	"IX",349,3 49,"SDT",1 1.1,1,0)
	1009	1^F^349^.0 9^2^1^F
	1010	"IX",349,3 49,"SDT",1 1.1,1,2)
	1011	S X=+$E(X, 6,7)
	1012	"IX",349.1 ,349.141," STDT4",0)
	1013	349.141^ST DT4^Patien t Statemen t Date and Last Mess age ACK^R^ ^R^IR^I^34 9.141^^^^
	1014	^LS
	1015	"IX",349.1 ,349.141," STDT4",.1, 0)
	1016	^^2^2^3161 007^
	1017	"IX",349.1 ,349.141," STDT4",.1, 1,0)
	1018	This cross -reference is used t o sort by the Patien t Statemen t Date and the
	1019	"IX",349.1 ,349.141," STDT4",.1, 2,0)
	1020	Last Messa ge ACK.
	1021	"IX",349.1 ,349.141," STDT4",1)
	1022	S ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)=" "
	1023	"IX",349.1 ,349.141," STDT4",2)
	1024	K ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)
	1025	"IX",349.1 ,349.141," STDT4",2.5 )
	1026	K ^RCT(349 .1,DA(1),4 ,"STDT4")
	1027	"IX",349.1 ,349.141," STDT4",11. 1,0)
	1028	^.114IA^2^ 2
	1029	"IX",349.1 ,349.141," STDT4",11. 1,1,0)
	1030	1^F^349.14 1^.04^7^1^ F
	1031	"IX",349.1 ,349.141," STDT4",11. 1,1,3)
	1032
	1033	"IX",349.1 ,349.141," STDT4",11. 1,2,0)
	1034	2^F^349.14 1^.01^3^2^ F
	1035	"IX",349.1 ,349.141," STDT4",11. 1,2,3)
	1036
	1037	"IX",349.1 ,349.151," STDT5",0)
	1038	349.151^ST DT5^Patien t Statemen t Date Ind ex^R^^F^IR ^I^349.151 ^^^^^LS
	1039	"IX",349.1 ,349.151," STDT5",.1, 0)
	1040	^^1^1^3161 006^
	1041	"IX",349.1 ,349.151," STDT5",.1, 1,0)
	1042	This cross -reference is used t o sort by the Patien t Statemen t Date.
	1043	"IX",349.1 ,349.151," STDT5",1)
	1044	S ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)=""
	1045	"IX",349.1 ,349.151," STDT5",2)
	1046	K ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)
	1047	"IX",349.1 ,349.151," STDT5",2.5 )
	1048	K ^RCT(349 .1,DA(1),5 ,"STDT5")
	1049	"IX",349.1 ,349.151," STDT5",11. 1,0)
	1050	^.114IA^1^ 1
	1051	"IX",349.1 ,349.151," STDT5",11. 1,1,0)
	1052	1^F^349.15 1^.04^7^1^ F
	1053	"IX",349.2 ,349.2,"AD ",0)
	1054	349.2^AD^P atient Sta tement Err ors^R^^F^I R^I^349.2^ ^^^^S
	1055	"IX",349.2 ,349.2,"AD ",.1,0)
	1056	^^2^2^3161 007^
	1057	"IX",349.2 ,349.2,"AD ",.1,1,0)
	1058	This is th e cross-re ference to find pati ent statem ent errors that are
	1059	"IX",349.2 ,349.2,"AD ",.1,2,0)
	1060	returned f rom CBSS.
	1061	"IX",349.2 ,349.2,"AD ",1)
	1062	S ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)=""
	1063	"IX",349.2 ,349.2,"AD ",2)
	1064	K ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)
	1065	"IX",349.2 ,349.2,"AD ",2.5)
	1066	K ^RCPS(34 9.2,"AD")
	1067	"IX",349.2 ,349.2,"AD ",11.1,0)
	1068	^.114IA^1^ 1
	1069	"IX",349.2 ,349.2,"AD ",11.1,1,0 )
	1070	1^F^349.2^ 51^1^1^F
	1071	"IX",349.2 ,349.2,"AD ",11.1,1,1 )
	1072
	1073	"IX",349.2 ,349.2,"AD ",11.1,1,2 )
	1074	S X="E"
	1075	"IX",349.2 ,349.2,"ST DT",0)
	1076	349.2^STDT ^Patient S tatement D ate^R^^F^I R^I^349.2^ ^^^^LS
	1077	"IX",349.2 ,349.2,"ST DT",.1,0)
	1078	^^2^2^3161 007^
	1079	"IX",349.2 ,349.2,"ST DT",.1,1,0 )
	1080	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	1081	"IX",349.2 ,349.2,"ST DT",.1,2,0 )
	1082	standardly two days after the statement is transmi tted.
	1083	"IX",349.2 ,349.2,"ST DT",1)
	1084	S ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)=""
	1085	"IX",349.2 ,349.2,"ST DT",2)
	1086	K ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)
	1087	"IX",349.2 ,349.2,"ST DT",2.5)
	1088	K ^RCPS(34 9.2,"STDT" )
	1089	"IX",349.2 ,349.2,"ST DT",11.1,0 )
	1090	^.114IA^1^ 1
	1091	"IX",349.2 ,349.2,"ST DT",11.1,1 ,0)
	1092	1^F^349.2^ .19^7^1^F
	1093	"KRN",19,3 026,-1)
	1094	2^5
	1095	"KRN",19,3 026,0)
	1096	PRCAE FOLL OW-UP^Foll ow-up Lett er Menu^^M ^1^^^^^^^5 3
	1097	"KRN",19,3 026,10,0)
	1098	^19.01IP^1 9^15
	1099	"KRN",19,3 026,10,17, 0)
	1100	11666^^14
	1101	"KRN",19,3 026,10,17, "^")
	1102	RCCPC APPS BUILD AND TRANS
	1103	"KRN",19,3 026,10,18, 0)
	1104	11667^^15
	1105	"KRN",19,3 026,10,18, "^")
	1106	RCCPC APPS RETRANS
	1107	"KRN",19,3 026,10,19, 0)
	1108	11668^^16
	1109	"KRN",19,3 026,10,19, "^")
	1110	RCCPC APPS DATA CHEC K
	1111	"KRN",19,3 026,"U")
	1112	FOLLOW-UP LETTER MEN U
	1113	"KRN",19,1 1657,-1)
	1114	0^4
	1115	"KRN",19,1 1657,0)
	1116	PRCA CBS N IGHTLY UPD ATE^CBS Ni ghtly Acco unt Update Program^^ R^^^^^^^^
	1117	"KRN",19,1 1657,1,0)
	1118	^^2^2^3160 622^
	1119	"KRN",19,1 1657,1,1,0 )
	1120	This optio n runs the Consolida ted Billin g System
	1121	"KRN",19,1 1657,1,2,0 )
	1122	Nightly Ac count Upda te program .
	1123	"KRN",19,1 1657,25)
	1124	ENTER^PRCA CPS1
	1125	"KRN",19,1 1657,"U")
	1126	CBS NIGHTL Y ACCOUNT UPDATE PRO
	1127	"KRN",19,1 1666,-1)
	1128	0^6
	1129	"KRN",19,1 1666,0)
	1130	RCCPC APPS BUILD AND TRANS^Bui ld and Tra nsmit Annu al Payment File^^A^^ ^^^^^^^^1
	1131	"KRN",19,1 1666,1,0)
	1132	^^3^3^3170 224^
	1133	"KRN",19,1 1666,1,1,0 )
	1134	This optio n will bui ld the Ann ual Paymen t Statemen t file for the previ ous
	1135	"KRN",19,1 1666,1,2,0 )
	1136	year for e very patie nt who has one or mo re payment s in the p revious ye ar
	1137	"KRN",19,1 1666,1,3,0 )
	1138	and transm it the fil e to AITC.
	1139	"KRN",19,1 1666,20)
	1140	D MANBLD^R CCPCAT
	1141	"KRN",19,1 1666,"U")
	1142	BUILD AND TRANSMIT A NNUAL PAYM
	1143	"KRN",19,1 1667,-1)
	1144	0^7
	1145	"KRN",19,1 1667,0)
	1146	RCCPC APPS RETRANS^R etransmit Current An nual Payme nt File^^A ^^^^^^^^^^ 1
	1147	"KRN",19,1 1667,1,0)
	1148	^19.06^3^3 ^3170320^^ ^^
	1149	"KRN",19,1 1667,1,1,0 )
	1150	This optio n should o nly to be used when AITC has r equested t he current
	1151	"KRN",19,1 1667,1,2,0 )
	1152	Annual Pay ment State ment file be retrans mitted. Th is file wi ll include
	1153	"KRN",19,1 1667,1,3,0 )
	1154	every pati ent who ha s one or m ore paymen ts in the previous y ear.
	1155	"KRN",19,1 1667,20)
	1156	D RETRANS^ RCCPCAT
	1157	"KRN",19,1 1667,"U")
	1158	RETRANSMIT CURRENT A NNUAL PAYM
	1159	"KRN",19,1 1668,-1)
	1160	0^8
	1161	"KRN",19,1 1668,0)
	1162	RCCPC APPS DATA CHEC K^Annual P ayment Fil e Consiste ncy Check^ ^A^^^^^^^^ ^^1
	1163	"KRN",19,1 1668,1,0)
	1164	^^5^5^3170 321^
	1165	"KRN",19,1 1668,1,1,0 )
	1166	AR data is extracted from the VistA site s and is s ent to CBS S who then
	1167	"KRN",19,1 1668,1,2,0 )
	1168	consolidat es the dat a into the annual pa yment stat ement. The VistA dat a
	1169	"KRN",19,1 1668,1,3,0 )
	1170	needs to b e validate d prior to its trans mission. T his menu o ption will
	1171	"KRN",19,1 1668,1,4,0 )
	1172	produce a report det ailing whi ch APPS da ta needs t o be revie wed and
	1173	"KRN",19,1 1668,1,5,0 )
	1174	updated pr ior to its transmiss ion to CBS S.
	1175	"KRN",19,1 1668,20)
	1176	D MANBLD^R CCPCAR
	1177	"KRN",19,1 1668,"U")
	1178	ANNUAL PAY MENT FILE CONSISTENC
	1179	"MBREQ")
	1180	0
	1181	"ORD",18,1 9)
	1182	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	1183	"ORD",18,1 9,0)
	1184	OPTION
	1185	"PKG",53,- 1)
	1186	1^1
	1187	"PKG",53,0 )
	1188	ACCOUNTS R ECEIVABLE^ PRCA^FMS
	1189	"PKG",53,2 0,0)
	1190	^9.402P^1^ 1
	1191	"PKG",53,2 0,1,0)
	1192	2^^PRCAMRG
	1193	"PKG",53,2 0,1,1)
	1194
	1195	"PKG",53,2 0,"B",2,1)
	1196
	1197	"PKG",53,2 2,0)
	1198	^9.49I^1^1
	1199	"PKG",53,2 2,1,0)
	1200	4.5^305111 9^2960627
	1201	"PKG",53,2 2,1,"PAH", 1,0)
	1202	313^317040 5^85
	1203	"PKG",53,2 2,1,"PAH", 1,1,0)
	1204	^^1^1^3170 405
	1205	"PKG",53,2 2,1,"PAH", 1,1,1,0)
	1206	Consolidat ed Patient Statement
	1207	"QUES","XP F1",0)
	1208	Y
	1209	"QUES","XP F1","??")
	1210	^D REP^XPD H
	1211	"QUES","XP F1","A")
	1212	Shall I wr ite over y our \|FLAG\| File
	1213	"QUES","XP F1","B")
	1214	YES
	1215	"QUES","XP F1","M")
	1216	D XPF1^XPD IQ
	1217	"QUES","XP F2",0)
	1218	Y
	1219	"QUES","XP F2","??")
	1220	^D DTA^XPD H
	1221	"QUES","XP F2","A")
	1222	Want my da ta \|FLAG\| yours
	1223	"QUES","XP F2","B")
	1224	YES
	1225	"QUES","XP F2","M")
	1226	D XPF2^XPD IQ
	1227	"QUES","XP I1",0)
	1228	YO
	1229	"QUES","XP I1","??")
	1230	^D INHIBIT ^XPDH
	1231	"QUES","XP I1","A")
	1232	Want KIDS to INHIBIT LOGONs du ring the i nstall
	1233	"QUES","XP I1","B")
	1234	NO
	1235	"QUES","XP I1","M")
	1236	D XPI1^XPD IQ
	1237	"QUES","XP M1",0)
	1238	PO^VA(200, :EM
	1239	"QUES","XP M1","??")
	1240	^D MG^XPDH
	1241	"QUES","XP M1","A")
	1242	Enter the Coordinato r for Mail Group '\|F LAG\|'
	1243	"QUES","XP M1","B")
	1244
	1245	"QUES","XP M1","M")
	1246	D XPM1^XPD IQ
	1247	"QUES","XP O1",0)
	1248	Y
	1249	"QUES","XP O1","??")
	1250	^D MENU^XP DH
	1251	"QUES","XP O1","A")
	1252	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	1253	"QUES","XP O1","B")
	1254	YES
	1255	"QUES","XP O1","M")
	1256	D XPO1^XPD IQ
	1257	"QUES","XP Z1",0)
	1258	Y
	1259	"QUES","XP Z1","??")
	1260	^D OPT^XPD H
	1261	"QUES","XP Z1","A")
	1262	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	1263	"QUES","XP Z1","B")
	1264	NO
	1265	"QUES","XP Z1","M")
	1266	D XPZ1^XPD IQ
	1267	"QUES","XP Z2",0)
	1268	Y
	1269	"QUES","XP Z2","??")
	1270	^D RTN^XPD H
	1271	"QUES","XP Z2","A")
	1272	Want to MO VE routine s to other CPUs
	1273	"QUES","XP Z2","B")
	1274	NO
	1275	"QUES","XP Z2","M")
	1276	D XPZ2^XPD IQ
	1277	"RTN")
	1278	18
	1279	"RTN","PRC A313P")
	1280	0^18^B1869 7460^n/a
	1281	"RTN","PRC A313P",1,0 )
	1282	PRCA313P ; ALB/BDB - PATCH PRCA 4.5313 P OST-INSTAL L ROUTINE ; 11/2/15 4:15pm
	1283	"RTN","PRC A313P",2,0 )
	1284	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 113
	1285	"RTN","PRC A313P",3,0 )
	1286	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1287	"RTN","PRC A313P",4,0 )
	1288	; This ro utine queu es the Pat ient State ment Auto- Correction Program
	1289	"RTN","PRC A313P",5,0 )
	1290	;
	1291	"RTN","PRC A313P",6,0 )
	1292	Q
	1293	"RTN","PRC A313P",7,0 )
	1294	EN ;Entry point for PRCA4.53 13 post-in stall
	1295	"RTN","PRC A313P",8,0 )
	1296	;
	1297	"RTN","PRC A313P",9,0 )
	1298	; Delete DD previou s monthly data
	1299	"RTN","PRC A313P",10, 0)
	1300	D CLEANUP
	1301	"RTN","PRC A313P",11, 0)
	1302	; Set Pat ient State ment days
	1303	"RTN","PRC A313P",12, 0)
	1304	D STDT
	1305	"RTN","PRC A313P",13, 0)
	1306	; Set AR Transactio n Types
	1307	"RTN","PRC A313P",14, 0)
	1308	D SET3491
	1309	"RTN","PRC A313P",15, 0)
	1310	;
	1311	"RTN","PRC A313P",16, 0)
	1312	Q
	1313	"RTN","PRC A313P",17, 0)
	1314	;
	1315	"RTN","PRC A313P",18, 0)
	1316	STDT ; En try point for PRCA4 .5313 set of Patien t Statemen t date dep endent up
	1317	on the Pat ient Last Name
	1318	"RTN","PRC A313P",19, 0)
	1319	W !,"Star ting Patie nt Stateme nt Date Re set."
	1320	"RTN","PRC A313P",20, 0)
	1321	N DEBT,PA T,DIE
	1322	"RTN","PRC A313P",21, 0)
	1323	S DIE="^R CD(340,"
	1324	"RTN","PRC A313P",22, 0)
	1325	S DEBT=""
	1326	"RTN","PRC A313P",23, 0)
	1327	F S DEBT =$O(^RCD(3 40,"AB","D PT(",DEBT) ) Q:DEBT=" " S PAT=$ P($G(^RCD( 340,DEBT,
	1328	0)),U) D
	1329	"RTN","PRC A313P",24, 0)
	1330	. N DPT,N AME,DA,DR
	1331	"RTN","PRC A313P",25, 0)
	1332	. S DPT=$ P(PAT,";", 1)
	1333	"RTN","PRC A313P",26, 0)
	1334	. S NAME= $P(^DPT(DP T,0),U)
	1335	"RTN","PRC A313P",27, 0)
	1336	. S DA=DE BT
	1337	"RTN","PRC A313P",28, 0)
	1338	. S DR=". 03////"_+$ $ACSET^RCC PCFN1(NAME )
	1339	"RTN","PRC A313P",29, 0)
	1340	. D ^DIE
	1341	"RTN","PRC A313P",30, 0)
	1342	;
	1343	"RTN","PRC A313P",31, 0)
	1344	; Set cro ss-referen ce in AR E vent (341) if Patien t Statemen t date exi sts
	1345	"RTN","PRC A313P",32, 0)
	1346	N DA,DIK
	1347	"RTN","PRC A313P",33, 0)
	1348	S DIK="^R C(341,"
	1349	"RTN","PRC A313P",34, 0)
	1350	S DA="" F S DA=$O( ^RC(341,DA )) Q:DA="" I $G(^RC (341,DA,6) )'="" D IX 1^DIK
	1351	"RTN","PRC A313P",35, 0)
	1352	;
	1353	"RTN","PRC A313P",36, 0)
	1354	W !,"Pati ent Statem ent Date R eset Compl ete."
	1355	"RTN","PRC A313P",37, 0)
	1356	Q
	1357	"RTN","PRC A313P",38, 0)
	1358	;
	1359	"RTN","PRC A313P",39, 0)
	1360	CLEANUP ; PRCA4.5 313
	1361	"RTN","PRC A313P",40, 0)
	1362	; Remove site state ment date
	1363	"RTN","PRC A313P",41, 0)
	1364	W !,"Star ting Patie nt Stateme nt Cleanup ."
	1365	"RTN","PRC A313P",42, 0)
	1366	N DA,DR,D IE,X,RCT
	1367	"RTN","PRC A313P",43, 0)
	1368	S DA=1
	1369	"RTN","PRC A313P",44, 0)
	1370	S DR=".11 ///@"
	1371	"RTN","PRC A313P",45, 0)
	1372	S DIE="^R C(342,"
	1373	"RTN","PRC A313P",46, 0)
	1374	D ^DIE
	1375	"RTN","PRC A313P",47, 0)
	1376	;
	1377	"RTN","PRC A313P",48, 0)
	1378	; Remove all monthl y data
	1379	"RTN","PRC A313P",49, 0)
	1380	S DIK="^R CT(349,"
	1381	"RTN","PRC A313P",50, 0)
	1382	S DA=0 F S DA=$O(^ RCT(349,DA )) Q:DA="" D ^DIK
	1383	"RTN","PRC A313P",51, 0)
	1384	S ^RCT(34 9,0)="AR T RANSMISSIO N RECORDS^ 349I^^"
	1385	"RTN","PRC A313P",52, 0)
	1386	S DIK="^R CPS(349.2, "
	1387	"RTN","PRC A313P",53, 0)
	1388	S DA=0 F S DA=$O(^ RCPS(349.2 ,DA)) Q:DA ="" D ^DI K
	1389	"RTN","PRC A313P",54, 0)
	1390	S ^RCPS(3 49.2,0)="A R CBSS STA TEMENTS^34 9.2I^^"
	1391	"RTN","PRC A313P",55, 0)
	1392	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T K ^RCT( 349.1,+RCT ,4),^RCT(
	1393	349.1,+RCT ,5)
	1394	"RTN","PRC A313P",56, 0)
	1395	;
	1396	"RTN","PRC A313P",57, 0)
	1397	W !,"Pati ent Statem ent Cleanu p complete ."
	1398	"RTN","PRC A313P",58, 0)
	1399	Q
	1400	"RTN","PRC A313P",59, 0)
	1401	;
	1402	"RTN","PRC A313P",60, 0)
	1403	SET3491 ; PRCA4.5 313
	1404	"RTN","PRC A313P",61, 0)
	1405	; Set val ues for Pr oduction o r Test AR Transmissi on Type
	1406	"RTN","PRC A313P",62, 0)
	1407	N PROD,CC ,CP,CA,IEN ,TT,TTVAL
	1408	"RTN","PRC A313P",63, 0)
	1409	;
	1410	"RTN","PRC A313P",64, 0)
	1411	W !,"Star ting AR Tr ansaction Type Updat e."
	1412	"RTN","PRC A313P",65, 0)
	1413	;
	1414	"RTN","PRC A313P",66, 0)
	1415	; Set whe ther envir onment is Production or Test a nd define expected/n ew values
	1416	"RTN","PRC A313P",67, 0)
	1417	S PROD=$$ PROD^XUPRO D
	1418	"RTN","PRC A313P",68, 0)
	1419	S (CC(1), CP(1),CA(1 ))="XXX"
	1420	"RTN","PRC A313P",69, 0)
	1421	S CC(3)=" Q-"_$S(PRO D:"CBS",1: "CCT")_" URL "
	1422	"RTN","PRC A313P",70, 0)
	1423	S CP(3)=" Q-"_$S(PRO D:"CPP",1: "CPT")_" URL "
	1424	"RTN","PRC A313P",71, 0)
	1425	S CA(3)=" Q-"_$S(PRO D:"CAP",1: "CAT")_" URL "
	1426	"RTN","PRC A313P",72, 0)
	1427	;
	1428	"RTN","PRC A313P",73, 0)
	1429	; Validat e Domains are availa ble. Writ e error if not
	1430	"RTN","PRC A313P",74, 0)
	1431	I '$D(^DI C(4.2,"B", CC(3)))!(' $D(^DIC(4. 2,"B",CP(3 ))))!('$D( ^DIC(4.2," B",CA(3))
	1432	)) D Q
	1433	"RTN","PRC A313P",75, 0)
	1434	. N LINE S $P(LINE, "*",79)=""
	1435	"RTN","PRC A313P",76, 0)
	1436	. W !,LIN E,!
	1437	"RTN","PRC A313P",77, 0)
	1438	. W "Doma ins for PR CA4.5313 have not been fully set up.", !
	1439	"RTN","PRC A313P",78, 0)
	1440	. W "Plea se establi sh Domains for: ",!
	1441	"RTN","PRC A313P",79, 0)
	1442	. W "CCPC PATIENT S TATEMENTS, PATIENT S TATEMENT U PDATE, and ANNUAL PA YMENT STA
	1443	TEMENTS."
	1444	"RTN","PRC A313P",80, 0)
	1445	. W !,LIN E,!
	1446	"RTN","PRC A313P",81, 0)
	1447	;
	1448	"RTN","PRC A313P",82, 0)
	1449	; Validat e 'PS', 'P U', and 'P Y' are set for Patie nt Stateme nt, Nightl y Update,
	1450	and Annua l Payment Statement
	1451	"RTN","PRC A313P",83, 0)
	1452	F TT="PS" ,"PU","PY" S IEN=$O( ^RCT(349.1 ,"B",TT,0) ) D
	1453	"RTN","PRC A313P",84, 0)
	1454	. N DOMAI N,I
	1455	"RTN","PRC A313P",85, 0)
	1456	. I TT="P S" M DOMAI N=CC
	1457	"RTN","PRC A313P",86, 0)
	1458	. I TT="P U" M DOMAI N=CP
	1459	"RTN","PRC A313P",87, 0)
	1460	. I TT="P Y" M DOMAI N=CA
	1461	"RTN","PRC A313P",88, 0)
	1462	. ; If no IEN creat e new leve l one and three with cross-ref erences
	1463	"RTN","PRC A313P",89, 0)
	1464	. I IEN=" " D SET1(T T,.DOMAIN) Q
	1465	"RTN","PRC A313P",90, 0)
	1466	. ; If no 3 level o r it is no t set to e xpected va lue reset 3 level
	1467	"RTN","PRC A313P",91, 0)
	1468	. I IEN'= "" D
	1469	"RTN","PRC A313P",92, 0)
	1470	. F I=1,3 S TTVAL(I )=$P($G(^R CT(349.1,I EN,3)),U,I )
	1471	"RTN","PRC A313P",93, 0)
	1472	. I DOMAI N(1)_DOMAI N(3)'=TTVA L(1)_TTVAL (3) D SET3 (IEN,.DOMA IN)
	1473	"RTN","PRC A313P",94, 0)
	1474	;
	1475	"RTN","PRC A313P",95, 0)
	1476	W !,"AR T ransaction Type Upda te complet e."
	1477	"RTN","PRC A313P",96, 0)
	1478	;
	1479	"RTN","PRC A313P",97, 0)
	1480	Q
	1481	"RTN","PRC A313P",98, 0)
	1482	;
	1483	"RTN","PRC A313P",99, 0)
	1484	SET1(TT,DO MAIN) ; P RCA4.531 3
	1485	"RTN","PRC A313P",100 ,0)
	1486	; Set bot h the 1 an d 3 level for 349.1
	1487	"RTN","PRC A313P",101 ,0)
	1488	; New and Set Field values fo r DIC(4.2
	1489	"RTN","PRC A313P",102 ,0)
	1490	N TTNAME, ZZ,DIC,Y
	1491	"RTN","PRC A313P",103 ,0)
	1492	I TT="PS" S TTNAME= "CCPC PATI ENT STATEM ENT"
	1493	"RTN","PRC A313P",104 ,0)
	1494	I TT="PU" S TTNAME= "PATIENT S TATEMENT U PDATE"
	1495	"RTN","PRC A313P",105 ,0)
	1496	I TT="PY" S TTNAME= "ANNUAL PA YMENT STAT EMENTS"
	1497	"RTN","PRC A313P",106 ,0)
	1498	;
	1499	"RTN","PRC A313P",107 ,0)
	1500	; Set 1 l evel value s
	1501	"RTN","PRC A313P",108 ,0)
	1502	S DIC="^R CT(349.1," ,DIC(0)="L "
	1503	"RTN","PRC A313P",109 ,0)
	1504	S X=TT
	1505	"RTN","PRC A313P",110 ,0)
	1506	S DIC("DR ")=".02/// /"_TTNAME_ ";.03////" _1_";"
	1507	"RTN","PRC A313P",111 ,0)
	1508	D FILE^DI CN
	1509	"RTN","PRC A313P",112 ,0)
	1510	S IEN=+Y
	1511	"RTN","PRC A313P",113 ,0)
	1512	;
	1513	"RTN","PRC A313P",114 ,0)
	1514	; Set 3 l evel
	1515	"RTN","PRC A313P",115 ,0)
	1516	D SET3(IE N,.DOMAIN)
	1517	"RTN","PRC A313P",116 ,0)
	1518	;
	1519	"RTN","PRC A313P",117 ,0)
	1520	Q
	1521	"RTN","PRC A313P",118 ,0)
	1522	SET3(IEN,D OMAIN) ; PRCA4.53 13
	1523	"RTN","PRC A313P",119 ,0)
	1524	; Set 3 l evel for 3 49.1
	1525	"RTN","PRC A313P",120 ,0)
	1526	S DOMAIN( "IEN")=$O( ^DIC(4.2," B",DOMAIN( 3),0))
	1527	"RTN","PRC A313P",121 ,0)
	1528	S ^RCT(34 9.1,IEN,3) =DOMAIN(1) _U_DOMAIN( "IEN")_U_D OMAIN(3)
	1529	"RTN","PRC A313P",122 ,0)
	1530	;
	1531	"RTN","PRC A313P",123 ,0)
	1532	Q
	1533	"RTN","PRC A313P",124 ,0)
	1534	;
	1535	"RTN","PRC A313P",125 ,0)
	1536	PRE ; Pre -install a ctions for the Data Dictionary
	1537	"RTN","PRC A313P",126 ,0)
	1538	;
	1539	"RTN","PRC A313P",127 ,0)
	1540	W !,"Star ting Pre-I nstall Cha nges."
	1541	"RTN","PRC A313P",128 ,0)
	1542	;
	1543	"RTN","PRC A313P",129 ,0)
	1544	N DIK,DA
	1545	"RTN","PRC A313P",130 ,0)
	1546	; Remove DD for 349 .1, elemen ts 41, 42, and 43 - new elemen ts are ent ered duri
	1547	ng regular install
	1548	"RTN","PRC A313P",131 ,0)
	1549	S DIK="^D D(349.1,", DA(1)=349. 1
	1550	"RTN","PRC A313P",132 ,0)
	1551	F DA=41,4 2,43 D ^DI K
	1552	"RTN","PRC A313P",133 ,0)
	1553	;
	1554	"RTN","PRC A313P",134 ,0)
	1555	; Remove DD for 349 , element .09 to cha nge from o ld to new Style Cros s Referen
	1556	ce.
	1557	"RTN","PRC A313P",135 ,0)
	1558	S DIK="^D D(349,",DA (1)=349
	1559	"RTN","PRC A313P",136 ,0)
	1560	S DA=.09 D ^DIK
	1561	"RTN","PRC A313P",137 ,0)
	1562	;
	1563	"RTN","PRC A313P",138 ,0)
	1564	W !,"Pre- Install Ch anges comp lete."
	1565	"RTN","PRC A313P",139 ,0)
	1566	Q
	1567	"RTN","PRC AACR")
	1568	0^19^B1249 55572^n/a
	1569	"RTN","PRC AACR",1,0)
	1570	PRCAACR ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION REPOR T ;09/21/1 5 3:34 PM
	1571	"RTN","PRC AACR",2,0)
	1572	;;4.5;Acc ounts Rece ivable;3 07,313;M ar 20, 199 5;Build 11 3
	1573	"RTN","PRC AACR",3,0)
	1574	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1575	"RTN","PRC AACR",4,0)
	1576	;
	1577	"RTN","PRC AACR",5,0)
	1578	Q
	1579	"RTN","PRC AACR",6,0)
	1580	;
	1581	"RTN","PRC AACR",7,0)
	1582	PSACRT ; r eport, pri nts sorted individua l transact ions that have been auto-corr
	1583	ected
	1584	"RTN","PRC AACR",8,0)
	1585	N DIC,PAG E,BY,DHD,F ILENUM,FLD S,FR,L,TO, PRCABDT,PR CAEDT,PRCA SORT
	1586	"RTN","PRC AACR",9,0)
	1587	W !
	1588	"RTN","PRC AACR",10,0 )
	1589	PSDATE ;
	1590	"RTN","PRC AACR",11,0 )
	1591	; Determi ne if Auto Correct p rocess is currently running
	1592	"RTN","PRC AACR",12,0 )
	1593	N PRCASTR T,QUIT,X,X 1,X2,Y
	1594	"RTN","PRC AACR",13,0 )
	1595	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= ""
	1596	"RTN","PRC AACR",14,0 )
	1597	; QUIT if Auto Corr ect proces s is curre ntly runni ng
	1598	"RTN","PRC AACR",15,0 )
	1599	I PRCASTR T'="" D Q :QUIT
	1600	"RTN","PRC AACR",16,0 )
	1601	.S Y=$P(P RCASTRT,U, 2)
	1602	"RTN","PRC AACR",17,0 )
	1603	.D DD^%DT
	1604	"RTN","PRC AACR",18,0 )
	1605	.S PRCAST RT=Y
	1606	"RTN","PRC AACR",19,0 )
	1607	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram is cur rently run ning."
	1608	"RTN","PRC AACR",20,0 )
	1609	.W !,"It was starte d at ",PRC ASTRT," an d can take up to 1 h our to com plete."
	1610	"RTN","PRC AACR",21,0 )
	1611	.W !!,"If you choos e to conti nue with t his report , it may n ot reflect all of t
	1612	he"
	1613	"RTN","PRC AACR",22,0 )
	1614	.W !,"cha nges from this lates t run of t he Patient Statement Auto-Corr ection Pr
	1615	ogram."
	1616	"RTN","PRC AACR",23,0 )
	1617	.W !
	1618	"RTN","PRC AACR",24,0 )
	1619	.S DIR(0) ="Y",DIR(" A")="Do yo u want to continue", DIR("B")=" NO"
	1620	"RTN","PRC AACR",25,0 )
	1621	.D ^DIR
	1622	"RTN","PRC AACR",26,0 )
	1623	.W !
	1624	"RTN","PRC AACR",27,0 )
	1625	.; Quit i f ^, ^^, T imeout or No
	1626	"RTN","PRC AACR",28,0 )
	1627	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	1628	"RTN","PRC AACR",29,0 )
	1629	.; Send M ailMan mes sage to PR CACPS mail group if Yes
	1630	"RTN","PRC AACR",30,0 )
	1631	.I Y=1 D PRCAMAIL^P RCACPS(PRC ASTRT)
	1632	"RTN","PRC AACR",31,0 )
	1633	.K DTOUT, DUOUT,DIRO UT
	1634	"RTN","PRC AACR",32,0 )
	1635	;
	1636	"RTN","PRC AACR",33,0 )
	1637	N DIROUT, DIS,DTOUT, DUOUT
	1638	"RTN","PRC AACR",34,0 )
	1639	S DIR("A" )="Date Ra nge: FROM: ",DIR("B" )="T-7"
	1640	"RTN","PRC AACR",35,0 )
	1641	S DIR("?" )="The def ault date is T-7. F uture date s may not be entered ."
	1642	"RTN","PRC AACR",36,0 )
	1643	S DIR(0)= "DO" D ^DI R
	1644	"RTN","PRC AACR",37,0 )
	1645	S:Y'="" P RCABDT=Y
	1646	"RTN","PRC AACR",38,0 )
	1647	I $D(DIRU T)&'Y K DI RUT Q
	1648	"RTN","PRC AACR",39,0 )
	1649	I PRCABDT >DT G PSDA TE
	1650	"RTN","PRC AACR",40,0 )
	1651	W "(",Y(0 ),")"
	1652	"RTN","PRC AACR",41,0 )
	1653	K DIR,X,Y
	1654	"RTN","PRC AACR",42,0 )
	1655	S DIR(0)= "DO"
	1656	"RTN","PRC AACR",43,0 )
	1657	S DIR("A" )="Date Ra nge: TO: ",DIR("B" )="T"
	1658	"RTN","PRC AACR",44,0 )
	1659	S DIR("?" )="The def ault date is T, but any date m ay be ente red."
	1660	"RTN","PRC AACR",45,0 )
	1661	D ^DIR S: Y="" Y=DT
	1662	"RTN","PRC AACR",46,0 )
	1663	I $D(DIRU T)&'Y K DI RUT Q
	1664	"RTN","PRC AACR",47,0 )
	1665	W "(",Y(0 ),")"
	1666	"RTN","PRC AACR",48,0 )
	1667	S PRCAEDT =Y
	1668	"RTN","PRC AACR",49,0 )
	1669	I PRCABDT >PRCAEDT G PSDATE
	1670	"RTN","PRC AACR",50,0 )
	1671	K DIR
	1672	"RTN","PRC AACR",51,0 )
	1673	S DIR(0)= "S^1:Auto- Correct Re ason;2:Deb tor Name;3 :Bill Numb er;4:Trans action Nu
	1674	mber;5:Aut o-Correct Date",DIR( "A")="Sort by"
	1675	"RTN","PRC AACR",52,0 )
	1676	S DIR("B" )=1
	1677	"RTN","PRC AACR",53,0 )
	1678	D ^DIR K DIR
	1679	"RTN","PRC AACR",54,0 )
	1680	S PRCASOR T=Y
	1681	"RTN","PRC AACR",55,0 )
	1682	Q:$D(DTOU T)!($D(DUO UT))!($D(D IROUT))
	1683	"RTN","PRC AACR",56,0 )
	1684	;
	1685	"RTN","PRC AACR",57,0 )
	1686	; Prompt for device
	1687	"RTN","PRC AACR",58,0 )
	1688	W !
	1689	"RTN","PRC AACR",59,0 )
	1690	N ZTRTN,Z TDESC,ZTSA VE
	1691	"RTN","PRC AACR",60,0 )
	1692	K IOP,%ZI S,POP,IO(" Q")
	1693	"RTN","PRC AACR",61,0 )
	1694	S %ZIS="Q "
	1695	"RTN","PRC AACR",62,0 )
	1696	D ^%ZIS Q :POP
	1697	"RTN","PRC AACR",63,0 )
	1698	; If Queu ed
	1699	"RTN","PRC AACR",64,0 )
	1700	I $D(IO(" Q")) D Q
	1701	"RTN","PRC AACR",65,0 )
	1702	.K IO("Q" )
	1703	"RTN","PRC AACR",66,0 )
	1704	.I $G(IOS T)["P-MES" S ZTRTN=" PRT^PRCAAC R1"
	1705	"RTN","PRC AACR",67,0 )
	1706	.I $G(IOS T)'["P-MES " S ZTRTN= "PRT^PRCAA CR"
	1707	"RTN","PRC AACR",68,0 )
	1708	.S ZTSAVE ("PRCABDT" )="",ZTSAV E("PRCAEDT ")="",ZTSA VE("PRCASO RT")=""
	1709	"RTN","PRC AACR",69,0 )
	1710	.D ^%ZTLO AD
	1711	"RTN","PRC AACR",70,0 )
	1712	.D HOME^% ZIS
	1713	"RTN","PRC AACR",71,0 )
	1714	.I $D(ZTS K)[0 W !!? 5,"Report cancelled! "
	1715	"RTN","PRC AACR",72,0 )
	1716	.E W !!? 5,"Report queued!"
	1717	"RTN","PRC AACR",73,0 )
	1718	.K POP
	1719	"RTN","PRC AACR",74,0 )
	1720	;
	1721	"RTN","PRC AACR",75,0 )
	1722	;Print Re port if no t QUEUED
	1723	"RTN","PRC AACR",76,0 )
	1724	PRT ;
	1725	"RTN","PRC AACR",77,0 )
	1726	; If not queued and output se nt to P-ME S
	1727	"RTN","PRC AACR",78,0 )
	1728	I $G(IOST )["P-MES" D PRT^PRCA ACR1 Q
	1729	"RTN","PRC AACR",79,0 )
	1730	;If not q ueued and output not sent to P -MES
	1731	"RTN","PRC AACR",80,0 )
	1732	U IO
	1733	"RTN","PRC AACR",81,0 )
	1734	K ^TMP("P RCAACR",$J )
	1735	"RTN","PRC AACR",82,0 )
	1736	S PAGE=0
	1737	"RTN","PRC AACR",83,0 )
	1738	S DASH="" ,$P(DASH," -",79)=""
	1739	"RTN","PRC AACR",84,0 )
	1740	S DIS(0)= "I $D(^PRC A(433,""TA CD"",PRCAT SRT,D0))", L=0
	1741	"RTN","PRC AACR",85,0 )
	1742	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AACTF,PRC
	1743	ATNTF
	1744	"RTN","PRC AACR",86,0 )
	1745	S PRCATSR T=PRCABDT- .00001
	1746	"RTN","PRC AACR",87,0 )
	1747	; Loop th rough the specified date range
	1748	"RTN","PRC AACR",88,0 )
	1749	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	1750	D
	1751	"RTN","PRC AACR",89,0 )
	1752	.S PRCATN =""
	1753	"RTN","PRC AACR",90,0 )
	1754	.; Loop t hrough the transacti ons for th e current date
	1755	"RTN","PRC AACR",91,0 )
	1756	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	1757	"RTN","PRC AACR",92,0 )
	1758	..; Load associated data fiel ds for rep ort
	1759	"RTN","PRC AACR",93,0 )
	1760	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	1761	"RTN","PRC AACR",94,0 )
	1762	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	1763	"RTN","PRC AACR",95,0 )
	1764	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	1765	"RTN","PRC AACR",96,0 )
	1766	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	1767	"RTN","PRC AACR",97,0 )
	1768	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	1769	"RTN","PRC AACR",98,0 )
	1770	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	1771	"RTN","PRC AACR",99,0 )
	1772	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	1773	"RTN","PRC AACR",100, 0)
	1774	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	1775	"RTN","PRC AACR",101, 0)
	1776	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	1777	"RTN","PRC AACR",102, 0)
	1778	..S PRCAA CR=$E(PRCA ACR,1,14)
	1779	"RTN","PRC AACR",103, 0)
	1780	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	1781	"RTN","PRC AACR",104, 0)
	1782	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	1783	"RTN","PRC AACR",105, 0)
	1784	..I PRCAA CTF="YES" S PRCATNTF =""
	1785	"RTN","PRC AACR",106, 0)
	1786	..;
	1787	"RTN","PRC AACR",107, 0)
	1788	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number
	1789	"RTN","PRC AACR",108, 0)
	1790	..I PRCAS ORT=1 D Q
	1791	"RTN","PRC AACR",109, 0)
	1792	...S ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_PR CABN_U_PR
	1793	CATNTF_U_P RCAACD_U_P RCASSN
	1794	"RTN","PRC AACR",110, 0)
	1795	..;
	1796	"RTN","PRC AACR",111, 0)
	1797	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	1798	"RTN","PRC AACR",112, 0)
	1799	..I PRCAS ORT=2 D Q
	1800	"RTN","PRC AACR",113, 0)
	1801	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	1802	ATNTF_U_PR CAACD_U_PR CAACR
	1803	"RTN","PRC AACR",114, 0)
	1804	..;
	1805	"RTN","PRC AACR",115, 0)
	1806	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1807	"RTN","PRC AACR",116, 0)
	1808	..I PRCAS ORT=3 D Q
	1809	"RTN","PRC AACR",117, 0)
	1810	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	1811	ATNTF_U_PR CAACD_U_PR CAACR
	1812	"RTN","PRC AACR",118, 0)
	1813	..;
	1814	"RTN","PRC AACR",119, 0)
	1815	..; Store in ^TMP s orted by T ransaction , Debtor a nd Bill Nu mber
	1816	"RTN","PRC AACR",120, 0)
	1817	..I PRCAS ORT=4 D Q
	1818	"RTN","PRC AACR",121, 0)
	1819	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	1820	CASSN_U_PR CAACD_U_PR CAACR
	1821	"RTN","PRC AACR",122, 0)
	1822	..;
	1823	"RTN","PRC AACR",123, 0)
	1824	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number and Tran
	1825	saction Nu mber
	1826	"RTN","PRC AACR",124, 0)
	1827	..I PRCAS ORT=5 D Q
	1828	"RTN","PRC AACR",125, 0)
	1829	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	1830	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	1831	"RTN","PRC AACR",126, 0)
	1832	;
	1833	"RTN","PRC AACR",127, 0)
	1834	;
	1835	"RTN","PRC AACR",128, 0)
	1836	N QUIT ; QUIT befor e end of r eport
	1837	"RTN","PRC AACR",129, 0)
	1838	S QUIT=""
	1839	"RTN","PRC AACR",130, 0)
	1840	; Display Auto-Corr ect data s orted by A uto Correc tion Reaso n
	1841	"RTN","PRC AACR",131, 0)
	1842	I PRCASOR T=1 D
	1843	"RTN","PRC AACR",132, 0)
	1844	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_P
	1845	RCABN_U_PR CATNTF_U_P RCAACD_U_P RCASSN
	1846	"RTN","PRC AACR",133, 0)
	1847	.; Displa y Auto Cor rection Re ason heade r
	1848	"RTN","PRC AACR",134, 0)
	1849	.N Y
	1850	"RTN","PRC AACR",135, 0)
	1851	.D PSACRT P1
	1852	"RTN","PRC AACR",136, 0)
	1853	.S PRCAAC R=""
	1854	"RTN","PRC AACR",137, 0)
	1855	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D Q:QUIT
	1856	"RTN","PRC AACR",138, 0)
	1857	..S PRCAD TR=""
	1858	"RTN","PRC AACR",139, 0)
	1859	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	1860	"RTN","PRC AACR",140, 0)
	1861	...S PRCA BN=""
	1862	"RTN","PRC AACR",141, 0)
	1863	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:Q
	1864	UIT
	1865	"RTN","PRC AACR",142, 0)
	1866	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	1867	"RTN","PRC AACR",143, 0)
	1868	....S Y=$ P(PRCADATA ,U,5)
	1869	"RTN","PRC AACR",144, 0)
	1870	....D DD^ %DT
	1871	"RTN","PRC AACR",145, 0)
	1872	....S $P( PRCADATA,U ,5)=Y
	1873	"RTN","PRC AACR",146, 0)
	1874	....W !,$ P(PRCADATA ,U,1),?16, $E($P(PRCA DATA,U,2), 1,18),?36, $E($P(PRCA DATA,U,6)
	1875	,6,9),?42, $E($P(PRCA DATA,U,3), 1,11),?55, $J($P(PRCA DATA,U,4), 9),?66,$P( PRCADATA,
	1876	U,5)
	1877	"RTN","PRC AACR",147, 0)
	1878	....I $Y> (IOSL-3) D
	1879	"RTN","PRC AACR",148, 0)
	1880	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1881	"RTN","PRC AACR",149, 0)
	1882	......D P RTC
	1883	"RTN","PRC AACR",150, 0)
	1884	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1885	"RTN","PRC AACR",151, 0)
	1886	.....D PS ACRTP1
	1887	"RTN","PRC AACR",152, 0)
	1888	;
	1889	"RTN","PRC AACR",153, 0)
	1890	; Display Auto-Corr ect data s orted by D ebtor
	1891	"RTN","PRC AACR",154, 0)
	1892	I PRCASOR T=2 D
	1893	"RTN","PRC AACR",155, 0)
	1894	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	1895	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1896	"RTN","PRC AACR",156, 0)
	1897	.; Displa y Debtor h eader
	1898	"RTN","PRC AACR",157, 0)
	1899	.D PSACRT P2
	1900	"RTN","PRC AACR",158, 0)
	1901	.S PRCADT R=""
	1902	"RTN","PRC AACR",159, 0)
	1903	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D Q:QUIT
	1904	"RTN","PRC AACR",160, 0)
	1905	..S PRCAB N=""
	1906	"RTN","PRC AACR",161, 0)
	1907	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D Q:Q UIT
	1908	"RTN","PRC AACR",162, 0)
	1909	...S PRCA TN=""
	1910	"RTN","PRC AACR",163, 0)
	1911	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D Q:QU
	1912	IT
	1913	"RTN","PRC AACR",164, 0)
	1914	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	1915	"RTN","PRC AACR",165, 0)
	1916	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1917	"RTN","PRC AACR",166, 0)
	1918	....W !,$ E($P(PRCAD ATA,U,1),1 ,18),?20,$ P(PRCADATA ,U,2),?33, $E($P(PRCA DATA,U,3)
	1919	,6,9),?39, $J($P(PRCA DATA,U,4), 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	1920	"RTN","PRC AACR",167, 0)
	1921	....I $Y> (IOSL-3) D
	1922	"RTN","PRC AACR",168, 0)
	1923	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1924	"RTN","PRC AACR",169, 0)
	1925	......D P RTC
	1926	"RTN","PRC AACR",170, 0)
	1927	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1928	"RTN","PRC AACR",171, 0)
	1929	.....D PS ACRTP2
	1930	"RTN","PRC AACR",172, 0)
	1931	;
	1932	"RTN","PRC AACR",173, 0)
	1933	; Display Auto-Corr ect data s orted by A UTO-C DATE
	1934	"RTN","PRC AACR",174, 0)
	1935	I PRCASOR T=3 D
	1936	"RTN","PRC AACR",175, 0)
	1937	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	1938	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1939	"RTN","PRC AACR",176, 0)
	1940	.; Displa y Bill Num ber header
	1941	"RTN","PRC AACR",177, 0)
	1942	.D PSACRT P3
	1943	"RTN","PRC AACR",178, 0)
	1944	.S PRCABN =""
	1945	"RTN","PRC AACR",179, 0)
	1946	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D Q: QUIT
	1947	"RTN","PRC AACR",180, 0)
	1948	..S PRCAD TR=""
	1949	"RTN","PRC AACR",181, 0)
	1950	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1951	"RTN","PRC AACR",182, 0)
	1952	...S PRCA TN=""
	1953	"RTN","PRC AACR",183, 0)
	1954	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D Q:QU
	1955	IT
	1956	"RTN","PRC AACR",184, 0)
	1957	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	1958	"RTN","PRC AACR",185, 0)
	1959	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1960	"RTN","PRC AACR",186, 0)
	1961	....W !,$ P(PRCADATA ,U,1),?13, $E($P(PRCA DATA,U,2), 1,18),?33, $E($P(PRCA DATA,U,3)
	1962	,6,9),?39, $J($P(PRCA DATA,U,4), 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	1963	"RTN","PRC AACR",187, 0)
	1964	....I $Y> (IOSL-3) D
	1965	"RTN","PRC AACR",188, 0)
	1966	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1967	"RTN","PRC AACR",189, 0)
	1968	......D P RTC
	1969	"RTN","PRC AACR",190, 0)
	1970	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1971	"RTN","PRC AACR",191, 0)
	1972	.....D PS ACRTP3
	1973	"RTN","PRC AACR",192, 0)
	1974	;
	1975	"RTN","PRC AACR",193, 0)
	1976	; Display Auto-Corr ect data s orted by T ransaction Number
	1977	"RTN","PRC AACR",194, 0)
	1978	I PRCASOR T=4 D
	1979	"RTN","PRC AACR",195, 0)
	1980	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	1981	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	1982	"RTN","PRC AACR",196, 0)
	1983	.; Displa y AUTO-C D ATE header
	1984	"RTN","PRC AACR",197, 0)
	1985	.D PSACRT P4
	1986	"RTN","PRC AACR",198, 0)
	1987	.S PRCATN =""
	1988	"RTN","PRC AACR",199, 0)
	1989	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D Q: QUIT
	1990	"RTN","PRC AACR",200, 0)
	1991	..S PRCAD TR=""
	1992	"RTN","PRC AACR",201, 0)
	1993	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1994	"RTN","PRC AACR",202, 0)
	1995	...S PRCA BN=""
	1996	"RTN","PRC AACR",203, 0)
	1997	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D Q:QU
	1998	IT
	1999	"RTN","PRC AACR",204, 0)
	2000	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	2001	"RTN","PRC AACR",205, 0)
	2002	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2003	"RTN","PRC AACR",206, 0)
	2004	....W !,$ J($P(PRCAD ATA,U,1),9 ),?11,$E($ P(PRCADATA ,U,2),1,18 ),?31,$P(P RCADATA,U
	2005	,3),?44,$E ($P(PRCADA TA,U,4),6, 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	2006	"RTN","PRC AACR",207, 0)
	2007	....I $Y> (IOSL-3) D
	2008	"RTN","PRC AACR",208, 0)
	2009	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	2010	"RTN","PRC AACR",209, 0)
	2011	......D P RTC
	2012	"RTN","PRC AACR",210, 0)
	2013	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	2014	"RTN","PRC AACR",211, 0)
	2015	.....D PS ACRTP4
	2016	"RTN","PRC AACR",212, 0)
	2017	;
	2018	"RTN","PRC AACR",213, 0)
	2019	; Display Auto-Corr ect data s orted by A uto-Correc t date
	2020	"RTN","PRC AACR",214, 0)
	2021	I PRCASOR T=5 D
	2022	"RTN","PRC AACR",215, 0)
	2023	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	2024	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2025	"RTN","PRC AACR",216, 0)
	2026	.; Displa y AUTO-C D ATE header
	2027	"RTN","PRC AACR",217, 0)
	2028	.D PSACRT P5
	2029	"RTN","PRC AACR",218, 0)
	2030	.S PRCAAC D=""
	2031	"RTN","PRC AACR",219, 0)
	2032	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D Q:QUIT
	2033	"RTN","PRC AACR",220, 0)
	2034	..S PRCAD TR=""
	2035	"RTN","PRC AACR",221, 0)
	2036	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	2037	"RTN","PRC AACR",222, 0)
	2038	...S PRCA BN=""
	2039	"RTN","PRC AACR",223, 0)
	2040	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:Q
	2041	UIT
	2042	"RTN","PRC AACR",224, 0)
	2043	....S PRC ATN=""
	2044	"RTN","PRC AACR",225, 0)
	2045	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	2046	D Q:QUI T
	2047	"RTN","PRC AACR",226, 0)
	2048	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	2049	"RTN","PRC AACR",227, 0)
	2050	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	2051	"RTN","PRC AACR",228, 0)
	2052	.....W !, $P(PRCADAT A,U,1),?14 ,$E($P(PRC ADATA,U,2) ,1,18),?34 ,$P(PRCADA TA,U,3),?
	2053	47,$E($P(P RCADATA,U, 4),6,9),?5 3,$J($P(PR CADATA,U,5 ),9),?64,$ P(PRCADATA ,U,6)
	2054	"RTN","PRC AACR",229, 0)
	2055	.....I $Y >(IOSL-3) D
	2056	"RTN","PRC AACR",230, 0)
	2057	......I $ E(IOST,1,2 )="C-" D Q:QUIT
	2058	"RTN","PRC AACR",231, 0)
	2059	.......D PRTC
	2060	"RTN","PRC AACR",232, 0)
	2061	.......I $D(DIRUT)! ($D(DTOUT) ) S QUIT=1
	2062	"RTN","PRC AACR",233, 0)
	2063	......D P SACRTP5
	2064	"RTN","PRC AACR",234, 0)
	2065	D ^%ZISC
	2066	"RTN","PRC AACR",235, 0)
	2067	I $E(IOST ,1,2)="C-" ,'$D(DUOUT ),('$D(DTO UT)) W ! S DIR(0)="E " D ^DIR
	2068	"RTN","PRC AACR",236, 0)
	2069	K X,Y,DAS H,D0
	2070	"RTN","PRC AACR",237, 0)
	2071	Q
	2072	"RTN","PRC AACR",238, 0)
	2073	;
	2074	"RTN","PRC AACR",239, 0)
	2075	PRTC ; Pre ss Return To Continu e
	2076	"RTN","PRC AACR",240, 0)
	2077	S DIR(0)= "E" D ^DIR
	2078	"RTN","PRC AACR",241, 0)
	2079	Q
	2080	"RTN","PRC AACR",242, 0)
	2081	;
	2082	"RTN","PRC AACR",243, 0)
	2083	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	2084	"RTN","PRC AACR",244, 0)
	2085	W @IOF
	2086	"RTN","PRC AACR",245, 0)
	2087	S PAGE=PA GE+1
	2088	"RTN","PRC AACR",246, 0)
	2089	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION RE ASON)",?6
	2090	6,$$UPPER^ VALM1($$FM TE^XLFDT(D T))
	2091	"RTN","PRC AACR",247, 0)
	2092	W !,DASH, !
	2093	"RTN","PRC AACR",248, 0)
	2094	W !,"AUTO -C REASON" ,?16,"DEBT OR",?36,"S SN",?42,"B ILL NO.",? 55,"TRANS NUM",?66,
	2095	"AUTO-C DA TE"
	2096	"RTN","PRC AACR",249, 0)
	2097	W !,"---- ---------- ",?16,"--- ---------- -----",?36 ,"----",?4 2,"------- ----",?55
	2098	,"-------- -",?66,"-- ---------- "
	2099	"RTN","PRC AACR",250, 0)
	2100	Q
	2101	"RTN","PRC AACR",251, 0)
	2102	;
	2103	"RTN","PRC AACR",252, 0)
	2104	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2105	"RTN","PRC AACR",253, 0)
	2106	W @IOF
	2107	"RTN","PRC AACR",254, 0)
	2108	S PAGE=PA GE+1
	2109	"RTN","PRC AACR",255, 0)
	2110	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y DEBTOR)" ,?66,$$UPP ER^VALM1(
	2111	$$FMTE^XLF DT(DT))
	2112	"RTN","PRC AACR",256, 0)
	2113	W !,DASH, !
	2114	"RTN","PRC AACR",257, 0)
	2115	W !,"DEBT OR",?20,"B ILL NO.",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	2116	UTO-C REAS ON"
	2117	"RTN","PRC AACR",258, 0)
	2118	W !,"---- ---------- ----",?20, "--------- --",?33,"- ---",?39," ---------" ,?50,"---
	2119	---------" ,?64,"---- ---------- "
	2120	"RTN","PRC AACR",259, 0)
	2121	Q
	2122	"RTN","PRC AACR",260, 0)
	2123	;
	2124	"RTN","PRC AACR",261, 0)
	2125	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2126	"RTN","PRC AACR",262, 0)
	2127	W @IOF
	2128	"RTN","PRC AACR",263, 0)
	2129	S PAGE=PA GE+1
	2130	"RTN","PRC AACR",264, 0)
	2131	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y BILL #)" ,?66,$$UPP ER^VALM1(
	2132	$$FMTE^XLF DT(DT))
	2133	"RTN","PRC AACR",265, 0)
	2134	W !,DASH, !
	2135	"RTN","PRC AACR",266, 0)
	2136	W !,"BILL NO.",?13, "DEBTOR",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	2137	UTO-C REAS ON"
	2138	"RTN","PRC AACR",267, 0)
	2139	W !,"---- -------",? 13,"------ ---------- --",?33,"- ---",?39," ---------" ,?50,"---
	2140	---------" ,?64,"---- ---------- "
	2141	"RTN","PRC AACR",268, 0)
	2142	Q
	2143	"RTN","PRC AACR",269, 0)
	2144	;
	2145	"RTN","PRC AACR",270, 0)
	2146	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2147	"RTN","PRC AACR",271, 0)
	2148	W @IOF
	2149	"RTN","PRC AACR",272, 0)
	2150	S PAGE=PA GE+1
	2151	"RTN","PRC AACR",273, 0)
	2152	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y TRANSACT ION NUMBER )",?66,$$
	2153	UPPER^VALM 1($$FMTE^X LFDT(DT))
	2154	"RTN","PRC AACR",274, 0)
	2155	W !,DASH, !
	2156	"RTN","PRC AACR",275, 0)
	2157	W !,"TRAN S NUM",?11 ,"DEBTOR", ?31,"BILL NO.",?44," SSN",?50," AUTO-C DAT E",?64,"A
	2158	UTO-C REAS ON"
	2159	"RTN","PRC AACR",276, 0)
	2160	W !,"---- -----",?11 ,"-------- ---------- ",?31,"--- --------", ?44,"----" ,?50,"---
	2161	---------" ,?64,"---- ---------- "
	2162	"RTN","PRC AACR",277, 0)
	2163	Q
	2164	"RTN","PRC AACR",278, 0)
	2165	;
	2166	"RTN","PRC AACR",279, 0)
	2167	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	2168	"RTN","PRC AACR",280, 0)
	2169	W @IOF
	2170	"RTN","PRC AACR",281, 0)
	2171	S PAGE=PA GE+1
	2172	"RTN","PRC AACR",282, 0)
	2173	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION DA TE)",?66,
	2174	$$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2175	"RTN","PRC AACR",283, 0)
	2176	W !,DASH, !
	2177	"RTN","PRC AACR",284, 0)
	2178	W !,"AUTO -C DATE",? 14,"DEBTOR ",?34,"BIL L NO.",?47 ,"SSN",?53 ,"TRANS NU M",?64,"A
	2179	UTO-C REAS ON"
	2180	"RTN","PRC AACR",285, 0)
	2181	W !,"---- --------", ?14,"----- ---------- ---",?34," ---------- -",?47,"-- --",?53,"
	2182	---------" ,?64,"---- ---------- "
	2183	"RTN","PRC AACR",286, 0)
	2184	Q
	2185	"RTN","PRC AACR",287, 0)
	2186	;
	2187	"RTN","PRC AACR",288, 0)
	2188	EXIT ;
	2189	"RTN","PRC AACR",289, 0)
	2190	Q
	2191	"RTN","PRC AACR1")
	2192	0^20^B1512 71441^n/a
	2193	"RTN","PRC AACR1",1,0 )
	2194	PRCAACR1 ; ALBANY/BDB -PATIENT S TATEMENTS AUTO-CORRE CTION REPO RT ;09/21/ 15 3:34 P
	2195	M
	2196	"RTN","PRC AACR1",2,0 )
	2197	;;4.5;Acc ounts Rece ivable;3 07,313;M ar 20, 199 5;Build 11 3
	2198	"RTN","PRC AACR1",3,0 )
	2199	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2200	"RTN","PRC AACR1",4,0 )
	2201	;
	2202	"RTN","PRC AACR1",5,0 )
	2203	Q
	2204	"RTN","PRC AACR1",6,0 )
	2205	;Print Re port when Queued to P-MES
	2206	"RTN","PRC AACR1",7,0 )
	2207	PRT ;
	2208	"RTN","PRC AACR1",8,0 )
	2209	U IO
	2210	"RTN","PRC AACR1",9,0 )
	2211	; build a rray of tr ansaction auto-corre cted
	2212	"RTN","PRC AACR1",10, 0)
	2213	K ^TMP("P RCAACR1",$ J)
	2214	"RTN","PRC AACR1",11, 0)
	2215	N DASH,PA GE
	2216	"RTN","PRC AACR1",12, 0)
	2217	S PAGE=0
	2218	"RTN","PRC AACR1",13, 0)
	2219	S DASH="" ,$P(DASH," -",79)=""
	2220	"RTN","PRC AACR1",14, 0)
	2221	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AIEN,PRCA
	2222	ACTF,PRCAT NTF,PRCATE MP
	2223	"RTN","PRC AACR1",15, 0)
	2224	S PRCATSR T=PRCABDT- .00001,PRC AIEN=0
	2225	"RTN","PRC AACR1",16, 0)
	2226	; Loop th rough the specified date range
	2227	"RTN","PRC AACR1",17, 0)
	2228	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	2229	D
	2230	"RTN","PRC AACR1",18, 0)
	2231	.S PRCATN =""
	2232	"RTN","PRC AACR1",19, 0)
	2233	.; Loop t hrough the transacti ons for th e current date
	2234	"RTN","PRC AACR1",20, 0)
	2235	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	2236	"RTN","PRC AACR1",21, 0)
	2237	..; Load associated data fiel ds for rep ort
	2238	"RTN","PRC AACR1",22, 0)
	2239	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	2240	"RTN","PRC AACR1",23, 0)
	2241	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	2242	"RTN","PRC AACR1",24, 0)
	2243	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	2244	"RTN","PRC AACR1",25, 0)
	2245	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	2246	"RTN","PRC AACR1",26, 0)
	2247	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	2248	"RTN","PRC AACR1",27, 0)
	2249	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	2250	"RTN","PRC AACR1",28, 0)
	2251	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	2252	"RTN","PRC AACR1",29, 0)
	2253	..S PRCAS SN=$E(PRCA SSN,6,9)
	2254	"RTN","PRC AACR1",30, 0)
	2255	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	2256	"RTN","PRC AACR1",31, 0)
	2257	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	2258	"RTN","PRC AACR1",32, 0)
	2259	..S PRCAA CR=$E(PRCA ACR,1,14)
	2260	"RTN","PRC AACR1",33, 0)
	2261	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	2262	"RTN","PRC AACR1",34, 0)
	2263	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	2264	"RTN","PRC AACR1",35, 0)
	2265	..I PRCAA CTF="YES" S PRCATNTF =""
	2266	"RTN","PRC AACR1",36, 0)
	2267	..;
	2268	"RTN","PRC AACR1",37, 0)
	2269	..; Stor e in ^TMP sorted by Auto-Corre ct Reason, Debtor an d Bill Num ber #
	2270	"RTN","PRC AACR1",38, 0)
	2271	..I PRCAS ORT=1 D Q
	2272	"RTN","PRC AACR1",39, 0)
	2273	...S ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_PR CABN_U_PR
	2274	CATNTF_U_P RCAACD_U_P RCASSN
	2275	"RTN","PRC AACR1",40, 0)
	2276	..;
	2277	"RTN","PRC AACR1",41, 0)
	2278	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	2279	"RTN","PRC AACR1",42, 0)
	2280	..I PRCAS ORT=2 D Q
	2281	"RTN","PRC AACR1",43, 0)
	2282	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	2283	ATNTF_U_PR CAACD_U_PR CAACR
	2284	"RTN","PRC AACR1",44, 0)
	2285	..;
	2286	"RTN","PRC AACR1",45, 0)
	2287	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	2288	"RTN","PRC AACR1",46, 0)
	2289	..I PRCAS ORT=3 D Q
	2290	"RTN","PRC AACR1",47, 0)
	2291	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	2292	ATNTF_U_PR CAACD_U_PR CAACR
	2293	"RTN","PRC AACR1",48, 0)
	2294	..;
	2295	"RTN","PRC AACR1",49, 0)
	2296	..; Store in ^TMP s orted by T ransaction , Debtor a nd #Bill N umber
	2297	"RTN","PRC AACR1",50, 0)
	2298	..I PRCAS ORT=4 D Q
	2299	"RTN","PRC AACR1",51, 0)
	2300	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	2301	CASSN_U_PR CAACD_U_PR CAACR
	2302	"RTN","PRC AACR1",52, 0)
	2303	..;
	2304	"RTN","PRC AACR1",53, 0)
	2305	..; Store in ^TMP s orted by A uto-Correc t Date, De btor, #Bil l Number a nd Transa
	2306	ction Numb er
	2307	"RTN","PRC AACR1",54, 0)
	2308	..I PRCAS ORT=5 D Q
	2309	"RTN","PRC AACR1",55, 0)
	2310	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	2311	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2312	"RTN","PRC AACR1",56, 0)
	2313	..Q
	2314	"RTN","PRC AACR1",57, 0)
	2315	;
	2316	"RTN","PRC AACR1",58, 0)
	2317	; Display Auto-Corr ect data s orted by B ill Number
	2318	"RTN","PRC AACR1",59, 0)
	2319	I PRCASOR T=1 D
	2320	"RTN","PRC AACR1",60, 0)
	2321	.; Print Header
	2322	"RTN","PRC AACR1",61, 0)
	2323	.D PSACRT P1
	2324	"RTN","PRC AACR1",62, 0)
	2325	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_P
	2326	RCABN_U_PR CATNTF_U_P RCAACD_U_P RCASSN
	2327	"RTN","PRC AACR1",63, 0)
	2328	.S PRCAAC R=""
	2329	"RTN","PRC AACR1",64, 0)
	2330	.N Y
	2331	"RTN","PRC AACR1",65, 0)
	2332	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D
	2333	"RTN","PRC AACR1",66, 0)
	2334	..S PRCAD TR=""
	2335	"RTN","PRC AACR1",67, 0)
	2336	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D
	2337	"RTN","PRC AACR1",68, 0)
	2338	...S PRCA BN=""
	2339	"RTN","PRC AACR1",69, 0)
	2340	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2341	"RTN","PRC AACR1",70, 0)
	2342	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	2343	"RTN","PRC AACR1",71, 0)
	2344	....S Y=$ P(PRCADATA ,U,5)
	2345	"RTN","PRC AACR1",72, 0)
	2346	....D DD^ %DT
	2347	"RTN","PRC AACR1",73, 0)
	2348	....S $P( PRCADATA,U ,5)=Y
	2349	"RTN","PRC AACR1",74, 0)
	2350	....S PRC AIEN=PRCAI EN+1
	2351	"RTN","PRC AACR1",75, 0)
	2352	....; Add Auto-Corr ect Reason
	2353	"RTN","PRC AACR1",76, 0)
	2354	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,14 ),$E(PRCAT EMP,16)=" "
	2355	"RTN","PRC AACR1",77, 0)
	2356	....; Add 18 chars of Debtor' s name
	2357	"RTN","PRC AACR1",78, 0)
	2358	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,36)=" "
	2359	"RTN","PRC AACR1",79, 0)
	2360	....; Add SSN
	2361	"RTN","PRC AACR1",80, 0)
	2362	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 ),$E(PRCAT EMP,42)=" "
	2363	"RTN","PRC AACR1",81, 0)
	2364	....; Add Bill Numb er
	2365	"RTN","PRC AACR1",82, 0)
	2366	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,55)=" "
	2367	"RTN","PRC AACR1",83, 0)
	2368	....; Add Transacti on Number
	2369	"RTN","PRC AACR1",84, 0)
	2370	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 66)=" "
	2371	"RTN","PRC AACR1",85, 0)
	2372	....; Add Auto-Corr ect Date
	2373	"RTN","PRC AACR1",86, 0)
	2374	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,74)=" "
	2375	"RTN","PRC AACR1",87, 0)
	2376	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2377	"RTN","PRC AACR1",88, 0)
	2378	....Q
	2379	"RTN","PRC AACR1",89, 0)
	2380	;
	2381	"RTN","PRC AACR1",90, 0)
	2382	; Store i n ^TMP sor ted by Deb tor, Bill Number and Transacti on #
	2383	"RTN","PRC AACR1",91, 0)
	2384	I PRCASOR T=2 D
	2385	"RTN","PRC AACR1",92, 0)
	2386	.; Print Header
	2387	"RTN","PRC AACR1",93, 0)
	2388	.D PSACRT P2
	2389	"RTN","PRC AACR1",94, 0)
	2390	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	2391	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2392	"RTN","PRC AACR1",95, 0)
	2393	.S PRCADT R=""
	2394	"RTN","PRC AACR1",96, 0)
	2395	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D
	2396	"RTN","PRC AACR1",97, 0)
	2397	..S PRCAB N=""
	2398	"RTN","PRC AACR1",98, 0)
	2399	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D
	2400	"RTN","PRC AACR1",99, 0)
	2401	...S PRCA TN=""
	2402	"RTN","PRC AACR1",100 ,0)
	2403	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D
	2404	"RTN","PRC AACR1",101 ,0)
	2405	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	2406	"RTN","PRC AACR1",102 ,0)
	2407	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2408	"RTN","PRC AACR1",103 ,0)
	2409	....S PRC AIEN=PRCAI EN+1
	2410	"RTN","PRC AACR1",104 ,0)
	2411	....; Add 18 chars of Debtor' s name
	2412	"RTN","PRC AACR1",105 ,0)
	2413	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,18 ),$E(PRCAT EMP,20)=" "
	2414	"RTN","PRC AACR1",106 ,0)
	2415	....; Add Bill Numb er
	2416	"RTN","PRC AACR1",107 ,0)
	2417	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,2 ),$E(PRCAT EMP,33)=" "
	2418	"RTN","PRC AACR1",108 ,0)
	2419	....; Add SSN
	2420	"RTN","PRC AACR1",109 ,0)
	2421	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2422	"RTN","PRC AACR1",110 ,0)
	2423	....; Add Transacti on Number
	2424	"RTN","PRC AACR1",111 ,0)
	2425	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2426	"RTN","PRC AACR1",112 ,0)
	2427	....; Add Auto-Corr ect Date
	2428	"RTN","PRC AACR1",113 ,0)
	2429	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2430	"RTN","PRC AACR1",114 ,0)
	2431	....; Add Auto-Corr ect Reason
	2432	"RTN","PRC AACR1",115 ,0)
	2433	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2434	"RTN","PRC AACR1",116 ,0)
	2435	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2436	"RTN","PRC AACR1",117 ,0)
	2437	....Q
	2438	"RTN","PRC AACR1",118 ,0)
	2439	;
	2440	"RTN","PRC AACR1",119 ,0)
	2441	; Store i n ^TMP sor ted by Aut o-Correct Date, Debt or, Bill N umber and Transacti
	2442	on #
	2443	"RTN","PRC AACR1",120 ,0)
	2444	I PRCASOR T=3 D
	2445	"RTN","PRC AACR1",121 ,0)
	2446	.; Print Header
	2447	"RTN","PRC AACR1",122 ,0)
	2448	.D PSACRT P3
	2449	"RTN","PRC AACR1",123 ,0)
	2450	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	2451	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2452	"RTN","PRC AACR1",124 ,0)
	2453	.S PRCABN =""
	2454	"RTN","PRC AACR1",125 ,0)
	2455	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D
	2456	"RTN","PRC AACR1",126 ,0)
	2457	..S PRCAD TR=""
	2458	"RTN","PRC AACR1",127 ,0)
	2459	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D
	2460	"RTN","PRC AACR1",128 ,0)
	2461	...S PRCA TN=""
	2462	"RTN","PRC AACR1",129 ,0)
	2463	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D
	2464	"RTN","PRC AACR1",130 ,0)
	2465	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	2466	"RTN","PRC AACR1",131 ,0)
	2467	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2468	"RTN","PRC AACR1",132 ,0)
	2469	....S PRC AIEN=PRCAI EN+1
	2470	"RTN","PRC AACR1",133 ,0)
	2471	....; Add Bill Numb er
	2472	"RTN","PRC AACR1",134 ,0)
	2473	....S PRC ATEMP=$P(P RCADATA,U, 1),$E(PRCA TEMP,13)=" "
	2474	"RTN","PRC AACR1",135 ,0)
	2475	....; Add 18 chars of Debtor' s name
	2476	"RTN","PRC AACR1",136 ,0)
	2477	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,33)=" "
	2478	"RTN","PRC AACR1",137 ,0)
	2479	....; Add SSN
	2480	"RTN","PRC AACR1",138 ,0)
	2481	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2482	"RTN","PRC AACR1",139 ,0)
	2483	....; Add Transacti on Number
	2484	"RTN","PRC AACR1",140 ,0)
	2485	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2486	"RTN","PRC AACR1",141 ,0)
	2487	....; Add Auto-Corr ect Date
	2488	"RTN","PRC AACR1",142 ,0)
	2489	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2490	"RTN","PRC AACR1",143 ,0)
	2491	....; Add Auto-Corr ect Reason
	2492	"RTN","PRC AACR1",144 ,0)
	2493	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2494	"RTN","PRC AACR1",145 ,0)
	2495	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2496	"RTN","PRC AACR1",146 ,0)
	2497	....Q
	2498	"RTN","PRC AACR1",147 ,0)
	2499	;
	2500	"RTN","PRC AACR1",148 ,0)
	2501	; Store i n ^TMP sor ted by Tra nsaction, Debtor and #Bill Num ber
	2502	"RTN","PRC AACR1",149 ,0)
	2503	I PRCASOR T=4 D
	2504	"RTN","PRC AACR1",150 ,0)
	2505	.; Print Header
	2506	"RTN","PRC AACR1",151 ,0)
	2507	.D PSACRT P4
	2508	"RTN","PRC AACR1",152 ,0)
	2509	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	2510	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	2511	"RTN","PRC AACR1",153 ,0)
	2512	.S PRCATN =""
	2513	"RTN","PRC AACR1",154 ,0)
	2514	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D
	2515	"RTN","PRC AACR1",155 ,0)
	2516	..S PRCAD TR=""
	2517	"RTN","PRC AACR1",156 ,0)
	2518	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D
	2519	"RTN","PRC AACR1",157 ,0)
	2520	...S PRCA BN=""
	2521	"RTN","PRC AACR1",158 ,0)
	2522	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D
	2523	"RTN","PRC AACR1",159 ,0)
	2524	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	2525	"RTN","PRC AACR1",160 ,0)
	2526	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2527	"RTN","PRC AACR1",161 ,0)
	2528	....S PRC AIEN=PRCAI EN+1
	2529	"RTN","PRC AACR1",162 ,0)
	2530	....; Add Transacti on Number
	2531	"RTN","PRC AACR1",163 ,0)
	2532	....S PRC ATEMP=$J($ P(PRCADATA ,U,1),9),$ E(PRCATEMP ,11)=" "
	2533	"RTN","PRC AACR1",164 ,0)
	2534	....; Add 18 chars of Debtor' s name
	2535	"RTN","PRC AACR1",165 ,0)
	2536	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,31)=" "
	2537	"RTN","PRC AACR1",166 ,0)
	2538	....; Add Bill Numb er
	2539	"RTN","PRC AACR1",167 ,0)
	2540	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,44)=" "
	2541	"RTN","PRC AACR1",168 ,0)
	2542	....; Add SSN
	2543	"RTN","PRC AACR1",169 ,0)
	2544	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,4 ),$E(PRCAT EMP,50)=" "
	2545	"RTN","PRC AACR1",170 ,0)
	2546	....; Add Auto-Corr ect Date
	2547	"RTN","PRC AACR1",171 ,0)
	2548	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2549	"RTN","PRC AACR1",172 ,0)
	2550	....; Add Auto-Corr ect Reason
	2551	"RTN","PRC AACR1",173 ,0)
	2552	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2553	"RTN","PRC AACR1",174 ,0)
	2554	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2555	"RTN","PRC AACR1",175 ,0)
	2556	....Q
	2557	"RTN","PRC AACR1",176 ,0)
	2558	;
	2559	"RTN","PRC AACR1",177 ,0)
	2560	; Display Auto-Corr ect data s orted by A uto-Correc t Reason
	2561	"RTN","PRC AACR1",178 ,0)
	2562	I PRCASOR T=5 D
	2563	"RTN","PRC AACR1",179 ,0)
	2564	.; Print Header
	2565	"RTN","PRC AACR1",180 ,0)
	2566	.D PSACRT P5
	2567	"RTN","PRC AACR1",181 ,0)
	2568	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	2569	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2570	"RTN","PRC AACR1",182 ,0)
	2571	.S PRCAAC D=""
	2572	"RTN","PRC AACR1",183 ,0)
	2573	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D
	2574	"RTN","PRC AACR1",184 ,0)
	2575	..S PRCAD TR=""
	2576	"RTN","PRC AACR1",185 ,0)
	2577	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D
	2578	"RTN","PRC AACR1",186 ,0)
	2579	...S PRCA BN=""
	2580	"RTN","PRC AACR1",187 ,0)
	2581	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2582	"RTN","PRC AACR1",188 ,0)
	2583	....S PRC ATN=""
	2584	"RTN","PRC AACR1",189 ,0)
	2585	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	2586	D
	2587	"RTN","PRC AACR1",190 ,0)
	2588	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	2589	"RTN","PRC AACR1",191 ,0)
	2590	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	2591	"RTN","PRC AACR1",192 ,0)
	2592	.....S PR CAIEN=PRCA IEN+1
	2593	"RTN","PRC AACR1",193 ,0)
	2594	.....; Ad d Auto-Cor rect Date
	2595	"RTN","PRC AACR1",194 ,0)
	2596	.....S PR CATEMP=$P( PRCADATA,U ,1),$E(PRC ATEMP,14)= " "
	2597	"RTN","PRC AACR1",195 ,0)
	2598	.....; Ad d 18 chars of Debtor 's name
	2599	"RTN","PRC AACR1",196 ,0)
	2600	.....S PR CATEMP=PRC ATEMP_$E($ P(PRCADATA ,U,2),1,18 ),$E(PRCAT EMP,34)=" "
	2601	"RTN","PRC AACR1",197 ,0)
	2602	.....; Ad d Bill Num ber
	2603	"RTN","PRC AACR1",198 ,0)
	2604	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 3),$E(PRCA TEMP,47)=" "
	2605	"RTN","PRC AACR1",199 ,0)
	2606	.....; Ad d SSN
	2607	"RTN","PRC AACR1",200 ,0)
	2608	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 4),$E(PRCA TEMP,53)=" "
	2609	"RTN","PRC AACR1",201 ,0)
	2610	.....; Ad d Transact ion Number
	2611	"RTN","PRC AACR1",202 ,0)
	2612	.....S PR CATEMP=PRC ATEMP_$J($ P(PRCADATA ,U,5),9),$ E(PRCATEMP ,64)=" "
	2613	"RTN","PRC AACR1",203 ,0)
	2614	.....; Ad d Auto-Cor rect Reaso n
	2615	"RTN","PRC AACR1",204 ,0)
	2616	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 6)
	2617	"RTN","PRC AACR1",205 ,0)
	2618	.....S ^T MP("PRCAAC R1",$J,PRC AIEN)=PRCA TEMP
	2619	"RTN","PRC AACR1",206 ,0)
	2620	.....Q
	2621	"RTN","PRC AACR1",207 ,0)
	2622	;
	2623	"RTN","PRC AACR1",208 ,0)
	2624	; Send Ma ilMan mess age with N o Forward
	2625	"RTN","PRC AACR1",209 ,0)
	2626	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ
	2627	"RTN","PRC AACR1",210 ,0)
	2628	I PRCASOR T=1 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N REASON)
	2629	"
	2630	"RTN","PRC AACR1",211 ,0)
	2631	I PRCASOR T=2 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY DEBT OR)"
	2632	"RTN","PRC AACR1",212 ,0)
	2633	I PRCASOR T=3 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY BILL #)"
	2634	"RTN","PRC AACR1",213 ,0)
	2635	I PRCASOR T=4 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY TRAN SACTION NU MBER)"
	2636	"RTN","PRC AACR1",214 ,0)
	2637	I PRCASOR T=5 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N DATE)"
	2638	"RTN","PRC AACR1",215 ,0)
	2639	S XMTO(DU Z)=""
	2640	"RTN","PRC AACR1",216 ,0)
	2641	S XMBODY= "^TMP(""PR CAACR1"",$ J)"
	2642	"RTN","PRC AACR1",217 ,0)
	2643	S XMINSTR ("FLAGS")= "X"
	2644	"RTN","PRC AACR1",218 ,0)
	2645	S XMDUZ=D UZ
	2646	"RTN","PRC AACR1",219 ,0)
	2647	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	2648	"RTN","PRC AACR1",220 ,0)
	2649	D HOME^%Z IS
	2650	"RTN","PRC AACR1",221 ,0)
	2651	K IO("Q") ,POP
	2652	"RTN","PRC AACR1",222 ,0)
	2653	K ^TMP("P RCAACR",$J )
	2654	"RTN","PRC AACR1",223 ,0)
	2655	K ^TMP("P RCAACR1",$ J)
	2656	"RTN","PRC AACR1",224 ,0)
	2657	K PRCABDT ,PRCAEDT,P RCASORT
	2658	"RTN","PRC AACR1",225 ,0)
	2659	Q
	2660	"RTN","PRC AACR1",226 ,0)
	2661	;
	2662	"RTN","PRC AACR1",227 ,0)
	2663	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	2664	"RTN","PRC AACR1",228 ,0)
	2665	S PAGE=PA GE+1
	2666	"RTN","PRC AACR1",229 ,0)
	2667	S PRCAIEN =PRCAIEN+1
	2668	"RTN","PRC AACR1",230 ,0)
	2669	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2670	"RTN","PRC AACR1",231 ,0)
	2671	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2672	"RTN","PRC AACR1",232 ,0)
	2673	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION REASON)"
	2674	"RTN","PRC AACR1",233 ,0)
	2675	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2676	"RTN","PRC AACR1",234 ,0)
	2677	S PRCAIEN =PRCAIEN+1
	2678	"RTN","PRC AACR1",235 ,0)
	2679	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2680	"RTN","PRC AACR1",236 ,0)
	2681	S PRCAIEN =PRCAIEN+1
	2682	"RTN","PRC AACR1",237 ,0)
	2683	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2684	"RTN","PRC AACR1",238 ,0)
	2685	S PRCAIEN =PRCAIEN+1
	2686	"RTN","PRC AACR1",239 ,0)
	2687	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2688	"RTN","PRC AACR1",240 ,0)
	2689	S PRCADAT A="AUTO-C REASON D EBTOR S SN BILL NO. TR ANS NUM
	2690	AUTO-C DAT E"
	2691	"RTN","PRC AACR1",241 ,0)
	2692	S PRCAIEN =PRCAIEN+1
	2693	"RTN","PRC AACR1",242 ,0)
	2694	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2695	"RTN","PRC AACR1",243 ,0)
	2696	S PRCADAT A="------- ------- - ---------- ------- - --- ----- ------ -- -------
	2697	---------- --"
	2698	"RTN","PRC AACR1",244 ,0)
	2699	S PRCAIEN =PRCAIEN+1
	2700	"RTN","PRC AACR1",245 ,0)
	2701	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2702	"RTN","PRC AACR1",246 ,0)
	2703	Q
	2704	"RTN","PRC AACR1",247 ,0)
	2705	;
	2706	"RTN","PRC AACR1",248 ,0)
	2707	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2708	"RTN","PRC AACR1",249 ,0)
	2709	S PAGE=PA GE+1
	2710	"RTN","PRC AACR1",250 ,0)
	2711	S PRCAIEN =PRCAIEN+1
	2712	"RTN","PRC AACR1",251 ,0)
	2713	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2714	"RTN","PRC AACR1",252 ,0)
	2715	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2716	"RTN","PRC AACR1",253 ,0)
	2717	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY DEBTOR )"
	2718	"RTN","PRC AACR1",254 ,0)
	2719	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2720	"RTN","PRC AACR1",255 ,0)
	2721	S PRCAIEN =PRCAIEN+1
	2722	"RTN","PRC AACR1",256 ,0)
	2723	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2724	"RTN","PRC AACR1",257 ,0)
	2725	S PRCAIEN =PRCAIEN+1
	2726	"RTN","PRC AACR1",258 ,0)
	2727	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2728	"RTN","PRC AACR1",259 ,0)
	2729	S PRCAIEN =PRCAIEN+1
	2730	"RTN","PRC AACR1",260 ,0)
	2731	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2732	"RTN","PRC AACR1",261 ,0)
	2733	S PRCADAT A="DEBTOR BILL NO . SSN TRANS NU M AUTO-C DATE AU
	2734	TO-C REASO N"
	2735	"RTN","PRC AACR1",262 ,0)
	2736	S PRCAIEN =PRCAIEN+1
	2737	"RTN","PRC AACR1",263 ,0)
	2738	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2739	"RTN","PRC AACR1",264 ,0)
	2740	S PRCADAT A="------- ---------- - ------- ---- ---- -------- - ------- ----- --
	2741	---------- --"
	2742	"RTN","PRC AACR1",265 ,0)
	2743	S PRCAIEN =PRCAIEN+1
	2744	"RTN","PRC AACR1",266 ,0)
	2745	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2746	"RTN","PRC AACR1",267 ,0)
	2747	Q
	2748	"RTN","PRC AACR1",268 ,0)
	2749	;
	2750	"RTN","PRC AACR1",269 ,0)
	2751	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2752	"RTN","PRC AACR1",270 ,0)
	2753	S PAGE=PA GE+1
	2754	"RTN","PRC AACR1",271 ,0)
	2755	S PRCAIEN =PRCAIEN+1
	2756	"RTN","PRC AACR1",272 ,0)
	2757	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2758	"RTN","PRC AACR1",273 ,0)
	2759	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2760	"RTN","PRC AACR1",274 ,0)
	2761	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY BILL # )"
	2762	"RTN","PRC AACR1",275 ,0)
	2763	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2764	"RTN","PRC AACR1",276 ,0)
	2765	S PRCAIEN =PRCAIEN+1
	2766	"RTN","PRC AACR1",277 ,0)
	2767	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2768	"RTN","PRC AACR1",278 ,0)
	2769	S PRCAIEN =PRCAIEN+1
	2770	"RTN","PRC AACR1",279 ,0)
	2771	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2772	"RTN","PRC AACR1",280 ,0)
	2773	S PRCAIEN =PRCAIEN+1
	2774	"RTN","PRC AACR1",281 ,0)
	2775	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2776	"RTN","PRC AACR1",282 ,0)
	2777	S PRCADAT A="BILL NO . DEBT OR SSN TRANS NU M AUTO-C DATE AU
	2778	TO-C REASO N"
	2779	"RTN","PRC AACR1",283 ,0)
	2780	S PRCAIEN =PRCAIEN+1
	2781	"RTN","PRC AACR1",284 ,0)
	2782	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2783	"RTN","PRC AACR1",285 ,0)
	2784	S PRCADAT A="------- ---- ---- ---------- ---- ---- -------- - ------- ----- --
	2785	---------- --"
	2786	"RTN","PRC AACR1",286 ,0)
	2787	S PRCAIEN =PRCAIEN+1
	2788	"RTN","PRC AACR1",287 ,0)
	2789	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2790	"RTN","PRC AACR1",288 ,0)
	2791	Q
	2792	"RTN","PRC AACR1",289 ,0)
	2793	;
	2794	"RTN","PRC AACR1",290 ,0)
	2795	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2796	"RTN","PRC AACR1",291 ,0)
	2797	S PAGE=PA GE+1
	2798	"RTN","PRC AACR1",292 ,0)
	2799	S PRCAIEN =PRCAIEN+1
	2800	"RTN","PRC AACR1",293 ,0)
	2801	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2802	"RTN","PRC AACR1",294 ,0)
	2803	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2804	"RTN","PRC AACR1",295 ,0)
	2805	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY TRANSA CTION NUMB ER)"
	2806	"RTN","PRC AACR1",296 ,0)
	2807	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2808	"RTN","PRC AACR1",297 ,0)
	2809	S PRCAIEN =PRCAIEN+1
	2810	"RTN","PRC AACR1",298 ,0)
	2811	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2812	"RTN","PRC AACR1",299 ,0)
	2813	S PRCAIEN =PRCAIEN+1
	2814	"RTN","PRC AACR1",300 ,0)
	2815	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2816	"RTN","PRC AACR1",301 ,0)
	2817	S PRCAIEN =PRCAIEN+1
	2818	"RTN","PRC AACR1",302 ,0)
	2819	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2820	"RTN","PRC AACR1",303 ,0)
	2821	S PRCADAT A="TRANS N UM DEBTOR BILL N O. SSN AUTO-C DATE AU
	2822	TO-C REASO N"
	2823	"RTN","PRC AACR1",304 ,0)
	2824	S PRCAIEN =PRCAIEN+1
	2825	"RTN","PRC AACR1",305 ,0)
	2826	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2827	"RTN","PRC AACR1",306 ,0)
	2828	S PRCADAT A="------- -- ------ ---------- -- ------ ----- --- - ------- ----- --
	2829	---------- --"
	2830	"RTN","PRC AACR1",307 ,0)
	2831	S PRCAIEN =PRCAIEN+1
	2832	"RTN","PRC AACR1",308 ,0)
	2833	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2834	"RTN","PRC AACR1",309 ,0)
	2835	Q
	2836	"RTN","PRC AACR1",310 ,0)
	2837	;
	2838	"RTN","PRC AACR1",311 ,0)
	2839	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	2840	"RTN","PRC AACR1",312 ,0)
	2841	S PAGE=PA GE+1
	2842	"RTN","PRC AACR1",313 ,0)
	2843	S PRCAIEN =PRCAIEN+1
	2844	"RTN","PRC AACR1",314 ,0)
	2845	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2846	"RTN","PRC AACR1",315 ,0)
	2847	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2848	"RTN","PRC AACR1",316 ,0)
	2849	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION DATE)"
	2850	"RTN","PRC AACR1",317 ,0)
	2851	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2852	"RTN","PRC AACR1",318 ,0)
	2853	S PRCAIEN =PRCAIEN+1
	2854	"RTN","PRC AACR1",319 ,0)
	2855	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2856	"RTN","PRC AACR1",320 ,0)
	2857	S PRCAIEN =PRCAIEN+1
	2858	"RTN","PRC AACR1",321 ,0)
	2859	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2860	"RTN","PRC AACR1",322 ,0)
	2861	S PRCAIEN =PRCAIEN+1
	2862	"RTN","PRC AACR1",323 ,0)
	2863	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2864	"RTN","PRC AACR1",324 ,0)
	2865	S PRCADAT A="AUTO-C DATE DEB TOR BIL L NO. SSN TRAN S NUM AU
	2866	TO-C REASO N"
	2867	"RTN","PRC AACR1",325 ,0)
	2868	S PRCAIEN =PRCAIEN+1
	2869	"RTN","PRC AACR1",326 ,0)
	2870	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2871	"RTN","PRC AACR1",327 ,0)
	2872	S PRCADAT A="------- ----- --- ---------- ----- --- -------- ---- ---- ----- --
	2873	---------- --"
	2874	"RTN","PRC AACR1",328 ,0)
	2875	S PRCAIEN =PRCAIEN+1
	2876	"RTN","PRC AACR1",329 ,0)
	2877	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2878	"RTN","PRC AACR1",330 ,0)
	2879	Q
	2880	"RTN","PRC AACR1",331 ,0)
	2881	;
	2882	"RTN","PRC AACR1",332 ,0)
	2883	EXIT ;
	2884	"RTN","PRC AACR1",333 ,0)
	2885	Q
	2886	"RTN","PRC ACPS1")
	2887	0^6^B18771 251^n/a
	2888	"RTN","PRC ACPS1",1,0 )
	2889	PRCACPS1 ; ALBANY/BDB -PATIENT S TATEMENTS UPDATE ;03 /25/16 3:3 4 PM
	2890	"RTN","PRC ACPS1",2,0 )
	2891	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 113
	2892	"RTN","PRC ACPS1",3,0 )
	2893	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2894	"RTN","PRC ACPS1",4,0 )
	2895	;
	2896	"RTN","PRC ACPS1",5,0 )
	2897	Q
	2898	"RTN","PRC ACPS1",6,0 )
	2899	;
	2900	"RTN","PRC ACPS1",7,0 )
	2901	ENTER ;cal led by the cbs night ly account update pr ogram opti on
	2902	"RTN","PRC ACPS1",8,0 )
	2903	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K,ZTSAVE,R CFULL
	2904	"RTN","PRC ACPS1",9,0 )
	2905	S RCFULL= 1 ;run the full debt or list
	2906	"RTN","PRC ACPS1",10, 0)
	2907	W !,"Queu e the pati ent statem ent update program t o run:"
	2908	"RTN","PRC ACPS1",11, 0)
	2909	S ZTDESC= "Consolida ted Billin g Statemen t Update"
	2910	"RTN","PRC ACPS1",12, 0)
	2911	S ZTRTN=" DEBTOR^PRC ACPS1",ZTI O="",ZTSAV E("RCFULL" )=""
	2912	"RTN","PRC ACPS1",13, 0)
	2913	D ^%ZTLOA D
	2914	"RTN","PRC ACPS1",14, 0)
	2915	Q
	2916	"RTN","PRC ACPS1",15, 0)
	2917	;
	2918	"RTN","PRC ACPS1",16, 0)
	2919	DEBTOR ;ca lled by rc cpcbj
	2920	"RTN","PRC ACPS1",17, 0)
	2921	N DEBTOR, X,DEBTOR0, DEBTOR1,DE BTOR7,CBSS TOT,BALDT
	2922	"RTN","PRC ACPS1",18, 0)
	2923	K ^XTMP(" RCCBSS",$J )
	2924	"RTN","PRC ACPS1",19, 0)
	2925	S ^XTMP(" RCCBSS",$J ,0)=$$FMAD D^XLFDT(DT ,3)_"^"_DT
	2926	"RTN","PRC ACPS1",20, 0)
	2927	S DEBTOR= 0
	2928	"RTN","PRC ACPS1",21, 0)
	2929	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	2930	"RTN","PRC ACPS1",22, 0)
	2931	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) ),DEBTOR7= $G(^(7)),B ALDT=""
	2932	"RTN","PRC ACPS1",23, 0)
	2933	.Q:$P(DEB TOR0,"^")' ["DPT("
	2934	"RTN","PRC ACPS1",24, 0)
	2935	.I +$$GET ICN^MPIF00 1(+DEBTOR0 )<0 Q ;qu it if no i cn
	2936	"RTN","PRC ACPS1",25, 0)
	2937	.S BALDT= $$BILLS(DE BTOR) Q:$P (BALDT,U,2 )=9999999
	2938	"RTN","PRC ACPS1",26, 0)
	2939	.D RECPD
	2940	"RTN","PRC ACPS1",27, 0)
	2941	D COMPILE
	2942	"RTN","PRC ACPS1",28, 0)
	2943	Q
	2944	"RTN","PRC ACPS1",29, 0)
	2945	;
	2946	"RTN","PRC ACPS1",30, 0)
	2947	RECPD(BILL ) ;add a n ew account update
	2948	"RTN","PRC ACPS1",31, 0)
	2949	N REC,RCD FN
	2950	"RTN","PRC ACPS1",32, 0)
	2951	S RCDFN=+ DEBTOR0
	2952	"RTN","PRC ACPS1",33, 0)
	2953	S REC="PD ^"_$$GETIC N^MPIF001( RCDFN)_"^"
	2954	"RTN","PRC ACPS1",34, 0)
	2955	S REC=REC _$$SITE^RC MSITE_$$UP ^XLFSTR($S (($$SSN^RC FN01(DEBTO R)]"")&($$ NAM^RCFN0
	2956	1(DEBTOR)] ""):$TR($E ($$SSN^RCF N01(DEBTOR ),1,9)_$E( $P($$NAM^R CFN01(DEBT OR),","),
	2957	1,5)," "," "),1:""))_ "^"
	2958	"RTN","PRC ACPS1",35, 0)
	2959	S REC=REC _RCDFN_"^"
	2960	"RTN","PRC ACPS1",36, 0)
	2961	S BALDT=$ $BILLS(DEB TOR)
	2962	"RTN","PRC ACPS1",37, 0)
	2963	S CBSSTOT =+$P(DEBTO R7,U,6)
	2964	"RTN","PRC ACPS1",38, 0)
	2965	I '$G(RCF ULL) Q:CBS STOT=+BALD T
	2966	"RTN","PRC ACPS1",39, 0)
	2967	S $P(^RCD (340,DEBTO R,7),U,6)= +BALDT
	2968	"RTN","PRC ACPS1",40, 0)
	2969	S REC=REC _$$HEX(+BA LDT)_"^"_$ P(BALDT,U, 2)_"^\|"
	2970	"RTN","PRC ACPS1",41, 0)
	2971	S ^XTMP(" RCCBSS",$J ,DEBTOR)=R EC
	2972	"RTN","PRC ACPS1",42, 0)
	2973	Q
	2974	"RTN","PRC ACPS1",43, 0)
	2975	;
	2976	"RTN","PRC ACPS1",44, 0)
	2977	BILLS(DEBT OR) ;get o ldest bill date
	2978	"RTN","PRC ACPS1",45, 0)
	2979	N BALTOT, BILL,BN0,P RPDT,OLDDT
	2980	"RTN","PRC ACPS1",46, 0)
	2981	S BILL=""
	2982	"RTN","PRC ACPS1",47, 0)
	2983	S BALTOT= 0,OLDDT=99 99999
	2984	"RTN","PRC ACPS1",48, 0)
	2985	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	2986	"RTN","PRC ACPS1",49, 0)
	2987	.Q:$D(^PR CA(430,"TC SP",BILL)) ;cs chec k
	2988	"RTN","PRC ACPS1",50, 0)
	2989	.S BN0=$G (^PRCA(430 ,BILL,0))
	2990	"RTN","PRC ACPS1",51, 0)
	2991	.I $P(BN0 ,U,8)'=16 Q ;not ac tive
	2992	"RTN","PRC ACPS1",52, 0)
	2993	.S BALTOT =BALTOT+$$ GET1^DIQ(4 30,BILL,11 )
	2994	"RTN","PRC ACPS1",53, 0)
	2995	.S PRPDT= $P(^PRCA(4 30,BILL,0) ,U,10) I + PRPDT,OLDD T>PRPDT S OLDDT=PRPD T
	2996	"RTN","PRC ACPS1",54, 0)
	2997	Q BALTOT_ U_$S(OLDDT '=9999999: $$DTMDY(OL DDT),1:"")
	2998	"RTN","PRC ACPS1",55, 0)
	2999	;
	3000	"RTN","PRC ACPS1",56, 0)
	3001	COMPILE ;
	3002	"RTN","PRC ACPS1",57, 0)
	3003	N RCMSG,D CNTR,REC,R ECC,AMOUNT ,RCNTR,ACT ION,SEQ,SE QTOT
	3004	"RTN","PRC ACPS1",58, 0)
	3005	S DCNTR=0 ,REC=1,REC C=0,AMOUNT =0,SEQ=1,S EQTOT=0
	3006	"RTN","PRC ACPS1",59, 0)
	3007	F S DCNT R=$O(^XTMP ("RCCBSS", $J,DCNTR)) S:+DCNTR' >0 SEQTOT= SEQ Q:+DCN TR'>0 D
	3008	"RTN","PRC ACPS1",60, 0)
	3009	.I REC>45 0 D
	3010	"RTN","PRC ACPS1",61, 0)
	3011	..S ^XTMP ("RCCBSS", $J,"BUILD" ,SEQ,REC)= ^XTMP("RCC BSS",$J,"B UILD",SEQ, REC)_"~"
	3012	"RTN","PRC ACPS1",62, 0)
	3013	..D HEADE R
	3014	"RTN","PRC ACPS1",63, 0)
	3015	..D AITCM SG
	3016	"RTN","PRC ACPS1",64, 0)
	3017	..S REC=0 ,SEQ=SEQ+1
	3018	"RTN","PRC ACPS1",65, 0)
	3019	..Q
	3020	"RTN","PRC ACPS1",66, 0)
	3021	.I REC=0
	3022	"RTN","PRC ACPS1",67, 0)
	3023	.S REC=RE C+1
	3024	"RTN","PRC ACPS1",68, 0)
	3025	.S ^XTMP( "RCCBSS",$ J,"BUILD", SEQ,REC)=^ XTMP("RCCB SS",$J,DCN TR)
	3026	"RTN","PRC ACPS1",69, 0)
	3027	.Q
	3028	"RTN","PRC ACPS1",70, 0)
	3029	Q:'$D(^XT MP("RCCBSS ",$J,"BUIL D",SEQ))
	3030	"RTN","PRC ACPS1",71, 0)
	3031	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,REC)=^X TMP("RCCBS S",$J,"BUI LD",SEQ,RE C)_"~"
	3032	"RTN","PRC ACPS1",72, 0)
	3033	D HEADER
	3034	"RTN","PRC ACPS1",73, 0)
	3035	D AITCMSG
	3036	"RTN","PRC ACPS1",74, 0)
	3037	Q
	3038	"RTN","PRC ACPS1",75, 0)
	3039	;
	3040	"RTN","PRC ACPS1",76, 0)
	3041	AITCMSG ;
	3042	"RTN","PRC ACPS1",77, 0)
	3043	N XMY,XMD UZ,XMSUB,X MTEXT
	3044	"RTN","PRC ACPS1",78, 0)
	3045	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3046	"RTN","PRC ACPS1",79, 0)
	3047	S XMDUZ=" AR PACKAGE "
	3048	"RTN","PRC ACPS1",80, 0)
	3049	;S XMY(" P II ")=""
	3050	"RTN","PRC ACPS1",81, 0)
	3051	S X=$O(^R CT(349.1," B","PU",0) )
	3052	"RTN","PRC ACPS1",82, 0)
	3053	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^")_" @"_$P($G(
	3054	^RCT(349.1 ,+X,3)),"^ ",3) S:$P( X,"@",2)]" " XMY(X)=" "
	3055	"RTN","PRC ACPS1",83, 0)
	3056	S XMY("G. PRCACPS")= ""
	3057	"RTN","PRC ACPS1",84, 0)
	3058	S XMSUB=S ITE_"/CBSS TRANSMISS ION/BATCH# : "_SEQ
	3059	"RTN","PRC ACPS1",85, 0)
	3060	S XMTEXT= "^XTMP(""R CCBSS"","_ $J_",""BUI LD"","_SEQ _","
	3061	"RTN","PRC ACPS1",86, 0)
	3062	D ^XMD
	3063	"RTN","PRC ACPS1",87, 0)
	3064	Q
	3065	"RTN","PRC ACPS1",88, 0)
	3066	;
	3067	"RTN","PRC ACPS1",89, 0)
	3068	HEADER ;
	3069	"RTN","PRC ACPS1",90, 0)
	3070	;incremen t batch se quence num ber, build new heade r
	3071	"RTN","PRC ACPS1",91, 0)
	3072	N RCMSG,S ITE
	3073	"RTN","PRC ACPS1",92, 0)
	3074	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3075	"RTN","PRC ACPS1",93, 0)
	3076	S RCMSG=" PU"_"^"_SE Q_"^"_SEQT OT_"^"_(RE C-1)_"^"_S ITE_"^"_$$ DTMDY(DT)_ "^\|"
	3077	"RTN","PRC ACPS1",94, 0)
	3078	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,1)=RCMS G
	3079	"RTN","PRC ACPS1",95, 0)
	3080	Q
	3081	"RTN","PRC ACPS1",96, 0)
	3082	;
	3083	"RTN","PRC ACPS1",97, 0)
	3084	HEX(AMT) ; sets up am ount forma tted as 99 9999999V99 S w/no lea ding blank s and tra
	3085	iling sign
	3086	"RTN","PRC ACPS1",98, 0)
	3087	I $G(AMT) '?.1"-".N. 1".".N S A MT="" G Q
	3088	"RTN","PRC ACPS1",99, 0)
	3089	S AMT=$TR ($J(AMT,9, 2)," ","")
	3090	"RTN","PRC ACPS1",100 ,0)
	3091	I $E(AMT) ="-" S AMT =$E(AMT,2, 99)_$E(AMT ,1)
	3092	"RTN","PRC ACPS1",101 ,0)
	3093	E S AMT= AMT_"+"
	3094	"RTN","PRC ACPS1",102 ,0)
	3095	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	3096	"RTN","PRC ACPS1",103 ,0)
	3097	Q Q AMT
	3098	"RTN","PRC ACPS1",104 ,0)
	3099	;
	3100	"RTN","PRC ACPS1",105 ,0)
	3101	DTMDY(DAT) ;Changes date from fm to mmdd yyyy forma t
	3102	"RTN","PRC ACPS1",106 ,0)
	3103	N YR
	3104	"RTN","PRC ACPS1",107 ,0)
	3105	I '$G(DAT ) G QDAT
	3106	"RTN","PRC ACPS1",108 ,0)
	3107	S YR=$E(( $E(DAT,1,3 )+1700),1, 2)
	3108	"RTN","PRC ACPS1",109 ,0)
	3109	Q $E(DAT, 4,5)_$E(DA T,6,7)_$G( YR)_$E(DAT ,2,3)
	3110	"RTN","PRC ACPS1",110 ,0)
	3111	QDAT Q ""
	3112	"RTN","PRC ACPS1",111 ,0)
	3113	;
	3114	"RTN","PRC ACPS1",112 ,0)
	3115	BLANK(X) ; returns 'x ' blank sp aces
	3116	"RTN","PRC ACPS1",113 ,0)
	3117	N BLANK
	3118	"RTN","PRC ACPS1",114 ,0)
	3119	S BLANK=" ",$P(BLANK ," ",X+1)= ""
	3120	"RTN","PRC ACPS1",115 ,0)
	3121	Q BLANK
	3122	"RTN","PRC ACPS1",116 ,0)
	3123	;
	3124	"RTN","PRC ACPS1",117 ,0)
	3125	RJZF(X,Y) ;right jus tify zero fill width Y
	3126	"RTN","PRC ACPS1",118 ,0)
	3127	S X=$E("0 0000000000 0",1,Y-$L( X))_X
	3128	"RTN","PRC ACPS1",119 ,0)
	3129	Q X
	3130	"RTN","PRC ACPS1",120 ,0)
	3131	;
	3132	"RTN","PRC ACPS1",121 ,0)
	3133	LJSF(X,Y) ;left just ified spac e filled
	3134	"RTN","PRC ACPS1",122 ,0)
	3135	S X=$E(X, 1,Y)
	3136	"RTN","PRC ACPS1",123 ,0)
	3137	S X=X_$$B LANK(Y-$L( X))
	3138	"RTN","PRC ACPS1",124 ,0)
	3139	Q X
	3140	"RTN","PRC ACPS1",125 ,0)
	3141	;
	3142	"RTN","PRC ACPS1",126 ,0)
	3143	JD() ; ret urns today 's Julian date YDOY
	3144	"RTN","PRC ACPS1",127 ,0)
	3145	N XMDDD,X MNOW,XMDT
	3146	"RTN","PRC ACPS1",128 ,0)
	3147	S XMNOW=$ $NOW^XLFDT
	3148	"RTN","PRC ACPS1",129 ,0)
	3149	S XMDT=$E (XMNOW,1,7 )
	3150	"RTN","PRC ACPS1",130 ,0)
	3151	S XMDDD=$ $RJ^XLFSTR ($$FMDIFF^ XLFDT(XMDT ,$E(XMDT,1 ,3)_"0101" ,1)+1,3,"0 ")
	3152	"RTN","PRC ACPS1",131 ,0)
	3153	Q $E(DT,3 )_XMDDD
	3154	"RTN","PRC ACPS1",132 ,0)
	3155	;
	3156	"RTN","PRC ACPS1",133 ,0)
	3157	AMOUNT(X) ;changes a mount to z ero filled , right ju stified
	3158	"RTN","PRC ACPS1",134 ,0)
	3159	S:X<0 X=- X
	3160	"RTN","PRC ACPS1",135 ,0)
	3161	S X=$TR($ J(X,0,2)," .")
	3162	"RTN","PRC ACPS1",136 ,0)
	3163	S X=$E("0 0000000000 0",1,14-$L (X))_X
	3164	"RTN","PRC ACPS1",137 ,0)
	3165	Q X
	3166	"RTN","PRC ACPS1",138 ,0)
	3167	;
	3168	"RTN","PRC AG")
	3169	0^17^B3610 4045^B2201 6512
	3170	"RTN","PRC AG",1,0)
	3171	PRCAG ;WAS H-ISC@ALTO ONA,PA/CMS -Reprint S tatement/L etter Opti on Entries ;8/23/93
	3172	2:42 PM
	3173	"RTN","PRC AG",2,0)
	3174	V ;;4.5;Ac counts Rec eivable; 149,165,19 8,313;Ma r 20, 1995 ;Build 113
	3175	"RTN","PRC AG",3,0)
	3176	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	3177	"RTN","PRC AG",4,0)
	3178	REP ;ENTRY FROM REPR INT PAT ST ATEMENT
	3179	"RTN","PRC AG",5,0)
	3180	NEW BEG,E ND,DAT,DAT E,DEB,DIC, HDAT,IOP,S ITE,TYP,X, Y,ZTDESC,Z TRTN,ZTSAV E,%DT,SDT
	3181	,%,XDIRUT, %ZIS,POP,Z TIO
	3182	"RTN","PRC AG",6,0)
	3183	W !!
	3184	"RTN","PRC AG",7,0)
	3185	ADT ; PRC A4.5313 - Build an d print a list of av ailable da tes for Pa tient Sta
	3186	tements wi thin the l ast month
	3187	"RTN","PRC AG",8,0)
	3188	W !,"Thes e dates in the previ ous month contain Pa tient Stat ements: "
	3189	"RTN","PRC AG",9,0)
	3190	S DAT="" F S DAT=$ O(^RCPS(34 9.2,"STDT" ,DAT)) Q:D AT="" I $ D(^RC(341, "STDT",DA
	3191	T)) W !,$$ DATE^RCCPC PS1(DAT)
	3192	"RTN","PRC AG",10,0)
	3193	W !!
	3194	"RTN","PRC AG",11,0)
	3195	S %DT="AE XP",%DT(0) ="-NOW",%D T("A")="En ter a Date to Reprin t: " D ^%D T I Y<1 G
	3196	REPQ
	3197	"RTN","PRC AG",12,0)
	3198	S Y=$P(Y, ".")
	3199	"RTN","PRC AG",13,0)
	3200	; PRCA4. 5313 - Va lidate tha t Patient Statement Date exist s in 341
	3201	"RTN","PRC AG",14,0)
	3202	I '$D(^RC (341,"STDT ",Y)) W !! ,*7,"No no tification s sent on that date" ,! G ADT
	3203	"RTN","PRC AG",15,0)
	3204	S SDT=Y
	3205	"RTN","PRC AG",16,0)
	3206	W !!,"NOT E: The ran ge is in p rint order not alpha betic!",!
	3207	"RTN","PRC AG",17,0)
	3208	S X=""
	3209	"RTN","PRC AG",18,0)
	3210	S BEG=$O( ^RC(341,"S TDT",SDT," "))
	3211	"RTN","PRC AG",19,0)
	3212	W !,"Do y ou want to Start wit h a Specif ic Patient : "
	3213	"RTN","PRC AG",20,0)
	3214	S %=2 D Y N^DICN
	3215	"RTN","PRC AG",21,0)
	3216	I %<0 Q
	3217	"RTN","PRC AG",22,0)
	3218	I %=1 S X =$$SELNAME (SDT)
	3219	"RTN","PRC AG",23,0)
	3220	I $D(XDIR UT) Q
	3221	"RTN","PRC AG",24,0)
	3222	I X'="" S BEG=X
	3223	"RTN","PRC AG",25,0)
	3224	; PRCA4. 5313 - Us e statemen t date cro ss-referen ce to prov ide a pati ent list
	3225	"RTN","PRC AG",26,0)
	3226	S X=""
	3227	"RTN","PRC AG",27,0)
	3228	S END=$O( ^RC(341,"S TDT",SDT," "),-1)
	3229	"RTN","PRC AG",28,0)
	3230	W !,"Endi ng Patient Bill must be printe d after th e Starting Patient B ill.",!
	3231	"RTN","PRC AG",29,0)
	3232	W !,"Do y ou want to End with a Specific Patient? "
	3233	"RTN","PRC AG",30,0)
	3234	S %=2 D Y N^DICN
	3235	"RTN","PRC AG",31,0)
	3236	I %<0 Q
	3237	"RTN","PRC AG",32,0)
	3238	I %=1 S X =$$SELNAME (SDT)
	3239	"RTN","PRC AG",33,0)
	3240	I $D(XDIR UT) Q
	3241	"RTN","PRC AG",34,0)
	3242	I X'="" S END=X
	3243	"RTN","PRC AG",35,0)
	3244	I END>0,E ND<BEG W * 7,!,"Endin g bill is before sta rting bill !" G ADT
	3245	"RTN","PRC AG",36,0)
	3246	S HDAT=99 99999-SDT
	3247	"RTN","PRC AG",37,0)
	3248	REPD W !! S %ZIS="QN ",IOP="Q", %ZIS("B")= $P($G(^RC( 342,1,0)), U,8) D ^%Z IS G:POP
	3249	REPQ
	3250	"RTN","PRC AG",38,0)
	3251	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REP D
	3252	"RTN","PRC AG",39,0)
	3253	S ZTRTN=" REP^PRCAGS ",ZTDESC=" Reprint AR Patient S tatements" ,ZTSAVE("B EG")="",Z
	3254	TSAVE("END ")="",ZTSA VE("HDAT") ="" D ^%ZT LOAD
	3255	"RTN","PRC AG",40,0)
	3256	REPQ D ^%Z ISC Q
	3257	"RTN","PRC AG",41,0)
	3258	UB ;ENTRY FROM REPRI NT UB BILL S
	3259	"RTN","PRC AG",42,0)
	3260	S ETY="UB " ;set eve nt type to UB and us e REB sub- routine
	3261	"RTN","PRC AG",43,0)
	3262	REB ;ENTRY FROM REPR INT FOLLOW -UP LETTER S
	3263	"RTN","PRC AG",44,0)
	3264	NEW BEG,E ND,DAT,DAT E,DEB,DIC, IOP,SITE,T YP,X,Y,ZTD ESC,ZTRTN, ZTSAVE,%DT ,DA,DIR,D
	3265	TOUT
	3266	"RTN","PRC AG",45,0)
	3267	D SITE^PR CAGU
	3268	"RTN","PRC AG",46,0)
	3269	S:'$D(ETY ) ETY="FL"
	3270	"RTN","PRC AG",47,0)
	3271	REBDT S %D T="AEXP",% DT(0)="-NO W",%DT("A" )="Enter a Date to R eprint: " D ^%DT G:
	3272	Y<1 REBQ
	3273	"RTN","PRC AG",48,0)
	3274	S Y=$P(Y, ".")
	3275	"RTN","PRC AG",49,0)
	3276	I $P($O(^ RC(341,"C" ,Y)),".")' =Y W !!,*7 ,"No notif ications s ent on tha t date",!
	3277	G REBDT
	3278	"RTN","PRC AG",50,0)
	3279	S DAT=999 9999-Y
	3280	"RTN","PRC AG",51,0)
	3281	W !!,"Pre ss return at the 'Bi ll:' promp ts to repr int all ", ETY," Lett ers",!,"f
	3282	or the dat e selected or select a start a nd/or end point."
	3283	"RTN","PRC AG",52,0)
	3284	W !,"Do n ot select bills that print on the Patien t Statemen t."
	3285	"RTN","PRC AG",53,0)
	3286	W !,"NOTE : The rang e is in pr int order not alphab etic!",!
	3287	"RTN","PRC AG",54,0)
	3288	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	3289	"RTN","PRC AG",55,0)
	3290	S DIC="^P RCA(430,", DIC(0)="AE MNQ",DIC(" A")="Start from Bill : ",DIC("S ")="I "",
	3291	18,25,5,24 ,1,2,3,4,2 3,22,""'[( "",""_$P(^ (0),U,2)_" ","")" D ^ DIC I ($D( DTOUT))!(
	3292	X["^") G R EBQ
	3293	"RTN","PRC AG",56,0)
	3294	S BEG=0,Y =+Y
	3295	"RTN","PRC AG",57,0)
	3296	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="
	3297	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
	3298	ATE,".")'= DAT D
	3299	"RTN","PRC AG",58,0)
	3300	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y
	3301	S BEG=DA, DEB=0 Q
	3302	"RTN","PRC AG",59,0)
	3303	.Q
	3304	"RTN","PRC AG",60,0)
	3305	I BEG=0 S BEG=$O(^R C(341,"C", +$O(^RC(34 1,"C",9999 999-DAT)), 0)) S:'BEG BEG=-1
	3306	"RTN","PRC AG",61,0)
	3307	I BEG<0 W *7,!," So rry, not f ound!" G R EBDT
	3308	"RTN","PRC AG",62,0)
	3309	S DIC("A" )="End aft er Bill: " D ^DIC I ($D(DTOUT) )!(X["^") G REBQ
	3310	"RTN","PRC AG",63,0)
	3311	S END="*" ,Y=+Y
	3312	"RTN","PRC AG",64,0)
	3313	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="
	3314	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
	3315	ATE,".")'= DAT D
	3316	"RTN","PRC AG",65,0)
	3317	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y
	3318	S END=DA, DEB=0 Q
	3319	"RTN","PRC AG",66,0)
	3320	.Q
	3321	"RTN","PRC AG",67,0) RCCPCAT ;A LB/TGH - P ATCH PRCA* 4.5ANNUAL PAYMENT T RANSMIT I END<0 W 7,!," So rry, not f ound!" G R EBDT

	3322	"RTN","PRC AG",68,0)
	3323	I END'="* ",END<BEG W *7,!,"En ding bill is before starting b ill!" G RE BDT
	3324	"RTN","PRC AG",69,0)
	3325	W !!
	3326	"RTN","PRC AG",70,0)
	3327	REBD I ETY ="UB" S ZT IO="" G RE BD1
	3328	"RTN","PRC AG",71,0)
	3329	S %ZIS("B ")=$P($G(^ RC(342,1,0 )),U,8),%Z IS="QN",IO P="Q" D ^% ZIS G:POP REBQ
	3330	"RTN","PRC AG",72,0)
	3331	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REB D
	3332	"RTN","PRC AG",73,0)
	3333	REBD1 S ZT RTN="BILL^ PRCAGS",ZT SAVE("BEG" )="",ZTSAV E("END")=" ",ZTSAVE(" DAT")="",
	3334	ZTSAVE("SI TE")="",ZT SAVE("ETY" )=""
	3335	"RTN","PRC AG",74,0)
	3336	S ZTDESC= $S(ETY="UB ":"AR Repr int UB Let ters",1:"R eprint AR Follow-up Letters")
	3337	D ^%ZTLOA D
	3338	"RTN","PRC AG",75,0)
	3339	REBQ K ETY D ^%ZISC Q
	3340	"RTN","PRC AG",76,0)
	3341	PRDT ;ENTR Y FROM PRI NT STATEME NT/LETTER BY DATE OP TION
	3342	"RTN","PRC AG",77,0)
	3343	D PRDT^PR CAGP
	3344	"RTN","PRC AG",78,0)
	3345	Q
	3346	"RTN","PRC AG",79,0)
	3347	SELNAME(SD T) ; PRCA ^4.5^313 - Create a list and t hen select a patient name
	3348	"RTN","PRC AG",80,0)
	3349	N IEN,CNT ,NAME
	3350	"RTN","PRC AG",81,0)
	3351	W !,"Plea se wait wh ile we bui ld the pat ient list. ",!
	3352	"RTN","PRC AG",82,0)
	3353	K ^TMP($J ,"LISTNAME ")
	3354	"RTN","PRC AG",83,0)
	3355	S (IEN,CN T)=0
	3356	"RTN","PRC AG",84,0)
	3357	F S IEN= $O(^RC(341 ,"STDT",SD T,IEN)) Q: IEN="" D
	3358	"RTN","PRC AG",85,0)
	3359	. N PAT,N AME
	3360	"RTN","PRC AG",86,0)
	3361	. S PAT=$ P(^RCD(340 ,$P(^RC(34 1,IEN,0)," ^",5),0)," ;")
	3362	"RTN","PRC AG",87,0)
	3363	. S NAME= $P(^DPT(PA T,0),U)
	3364	"RTN","PRC AG",88,0)
	3365	. S ^TMP( $J,"LISTNA ME",NAME)= IEN
	3366	"RTN","PRC AG",89,0)
	3367	W !,"Plea se enter a ll or part of Patien t Name: " R NAME:DTI ME
	3368	"RTN","PRC AG",90,0)
	3369	I NAME="^ " S XDIRUT =1 Q ""
	3370	"RTN","PRC AG",91,0)
	3371	I $G(NAME )'="",$D(^ TMP($J,"LI STNAME",NA ME)) S IEN =^(NAME) Q IEN
	3372	"RTN","PRC AG",92,0)
	3373	W !!,"Pat ient Name is not an exact matc h."
	3374	"RTN","PRC AG",93,0)
	3375	W !,"Woul d you like a list of Patient N ames for " _$$DATE^RC CPCPS1(SDT )_"? "
	3376	"RTN","PRC AG",94,0)
	3377	S %=2 D Y N^DICN
	3378	"RTN","PRC AG",95,0)
	3379	I %=2 N Q UIT D I Q UIT=1 S Y= -1 Q -1
	3380	"RTN","PRC AG",96,0)
	3381	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	3382	"RTN","PRC AG",97,0)
	3383	. W !,"Is this corr ect? "
	3384	"RTN","PRC AG",98,0)
	3385	. S %=1 D YN^DICN S QUIT=%
	3386	"RTN","PRC AG",99,0)
	3387	S IEN=""
	3388	"RTN","PRC AG",100,0)
	3389	D SELNM1
	3390	"RTN","PRC AG",101,0)
	3391	Q IEN
	3392	"RTN","PRC AG",102,0)
	3393	SELNM1() ; Select n ame
	3394	"RTN","PRC AG",103,0)
	3395	N DIRUT,X CNT
	3396	"RTN","PRC AG",104,0)
	3397	K ^TMP($J ,"LISTCNT" )
	3398	"RTN","PRC AG",105,0)
	3399	; Quit th e listing if no name s to displ ay
	3400	"RTN","PRC AG",106,0)
	3401	I $O(^TMP ($J,"LISTN AME",NAME) )="" Q
	3402	"RTN","PRC AG",107,0)
	3403	W @IOF,"N umber",?20 ,"Patient Name"
	3404	"RTN","PRC AG",108,0)
	3405	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I $D(D IRUT) Q
	3406	"RTN","PRC AG",109,0)
	3407	. S CNT=C NT+1
	3408	"RTN","PRC AG",110,0)
	3409	. S ^TMP( $J,"LISTCN T",CNT,NAM E)=^TMP($J ,"LISTNAME ",NAME)
	3410	"RTN","PRC AG",111,0)
	3411	. W !,CNT ,?20,NAME
	3412	"RTN","PRC AG",112,0)
	3413	. I ($Y+3 )>IOSL D Q:$D(DIRUT )
	3414	"RTN","PRC AG",113,0)
	3415	. . S DIR (0)="E" D ^DIR
	3416	"RTN","PRC AG",114,0)
	3417	. . I X=" ^",($Y+3)< IOSL
	3418	"RTN","PRC AG",115,0)
	3419	. . W @IO F
	3420	"RTN","PRC AG",116,0)
	3421	. . I X'= "^" W "Num ber",?20," Patient Na me"
	3422	"RTN","PRC AG",117,0)
	3423	W !,"Plea se enter n umber of s elected Pa tient Name : " R XCNT :DTIME
	3424	"RTN","PRC AG",118,0)
	3425	I XCNT="^ "!(XCNT="" ) N % D I %=1 Q
	3426	"RTN","PRC AG",119,0)
	3427	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	3428	"RTN","PRC AG",120,0)
	3429	. W !,"Is this corr ect?"
	3430	"RTN","PRC AG",121,0)
	3431	. S %=1 D YN^DICN
	3432	"RTN","PRC AG",122,0)
	3433	I XCNT="" !('$D(^TMP ($J,"LISTC NT",XCNT)) ) Q
	3434	"RTN","PRC AG",123,0)
	3435	S CNT=XCN T
	3436	"RTN","PRC AG",124,0)
	3437	W !!,$O(^ TMP($J,"LI STCNT",CNT ,0)),!,".. .OK? "
	3438	"RTN","PRC AG",125,0)
	3439	S %=1 D Y N^DICN
	3440	"RTN","PRC AG",126,0)
	3441	I %=2 D Q
	3442	"RTN","PRC AG",127,0)
	3443	. W !,"No Patient S elected. "
	3444	"RTN","PRC AG",128,0)
	3445	. S DIR(0 )="E" D ^D IR
	3446	"RTN","PRC AG",129,0)
	3447	S NAME=$O (^TMP($J," LISTCNT",C NT,0))
	3448	"RTN","PRC AG",130,0)
	3449	S IEN=^TM P($J,"LIST CNT",CNT,N AME)
	3450	"RTN","PRC AG",131,0)
	3451	Q 1
	3452	"RTN","RCC PCAP")
	3453	0^21^B3974 2487^n/a
	3454	"RTN","RCC PCAP",1,0)
	3455	RCCPCAP ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT B UILD ; 2/3 /2016 11:3 0 am
	3456	"RTN","RCC PCAP",2,0)
	3457	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 113
	3458	"RTN","RCC PCAP",3,0)
	3459	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3460	"RTN","RCC PCAP",4,0)
	3461	EN(YEAR,SO URCE,DTTIM E) ; Bui ld the pay ment state ments for Year enter ed
	3462	"RTN","RCC PCAP",5,0)
	3463	; Year is the first three num bers of th e Internal Date form at and mus t be earl
	3464	ier than c urrent Yea r
	3465	"RTN","RCC PCAP",6,0)
	3466	; Source will be us ed to dete rmine whet her to sch edule or i mmediately start Tr
	3467	ansmit aft er Build
	3468	"RTN","RCC PCAP",7,0)
	3469	; DTTIME is the Tra nsmit date and time in Interna l time fro m Build an d Transmi
	3470	t menu opt ion
	3471	"RTN","RCC PCAP",8,0)
	3472	;
	3473	"RTN","RCC PCAP",9,0)
	3474	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	3475	"RTN","RCC PCAP",10,0 )
	3476	L +^RCAP( 349.5):DIL OCKTM I '$ T W 7,7, !,"Annual Payment is already b eing run
	3477	or transmi tted. Try again lat er." Q
	3478	"RTN","RCC PCAP",11,0 )
	3479	;
	3480	"RTN","RCC PCAP",12,0 )
	3481	N %,%I,%H ,STARTDT,E NDDT,LINE, PSSEG,PSCN TR,EXIT,DE BTOR,END,N EXT,SIZE
	3482	"RTN","RCC PCAP",13,0 )
	3483	;
	3484	"RTN","RCC PCAP",14,0 )
	3485	; Initial ize Incomi ng Variabl es - YEAR will be to Year befo re Current
	3486	"RTN","RCC PCAP",15,0 )
	3487	; Source will be to "B"ackgro und, and D TTIME to i ts current value, in cluding N
	3488	ULL
	3489	"RTN","RCC PCAP",16,0 )
	3490	I $G(YEAR )="" S YEA R=$E(DT,1, 3)-1
	3491	"RTN","RCC PCAP",17,0 )
	3492	I $G(SOUR CE)="" S S OURCE="B"
	3493	"RTN","RCC PCAP",18,0 )
	3494	S DTTIME= $G(DTTIME)
	3495	"RTN","RCC PCAP",19,0 )
	3496	;
	3497	"RTN","RCC PCAP",20,0 )
	3498	; Remove previous e ntries fro m file pri or to buil ding new f ile
	3499	"RTN","RCC PCAP",21,0 )
	3500	D KILL
	3501	"RTN","RCC PCAP",22,0 )
	3502	;
	3503	"RTN","RCC PCAP",23,0 )
	3504	; Set Sta rt and End Dates
	3505	"RTN","RCC PCAP",24,0 )
	3506	S STARTDT =YEAR_"010 0"
	3507	"RTN","RCC PCAP",25,0 )
	3508	S ENDDT=Y EAR_1232
	3509	"RTN","RCC PCAP",26,0 )
	3510	S (DEBTOR ,END)=""
	3511	"RTN","RCC PCAP",27,0 )
	3512	F PSCNTR= 1:1 Q:END D
	3513	"RTN","RCC PCAP",28,0 )
	3514	. S (NEXT ,SIZE,LINE )=0
	3515	"RTN","RCC PCAP",29,0 )
	3516	. D SETPS (PSCNTR,YE AR)
	3517	"RTN","RCC PCAP",30,0 )
	3518	. N LASTP D
	3519	"RTN","RCC PCAP",31,0 )
	3520	. F S DE BTOR=$O(^P RCA(433,"A TD",DEBTOR )) Q:DEBTO R="" D I NEXT Q
	3521	"RTN","RCC PCAP",32,0 )
	3522	.. ; Quit if the de btor is no t a patien t
	3523	"RTN","RCC PCAP",33,0 )
	3524	.. I '$D( ^RCD(340," AB","DPT(" ,DEBTOR)) Q
	3525	"RTN","RCC PCAP",34,0 )
	3526	.. N PHSE T,PHCNTR,P HSEG,DATE, LTBDT
	3527	"RTN","RCC PCAP",35,0 )
	3528	.. S (PHS ET,PHCNTR, LTBDT)=0
	3529	"RTN","RCC PCAP",36,0 )
	3530	.. S DATE =STARTDT
	3531	"RTN","RCC PCAP",37,0 )
	3532	.. F S D ATE=$O(^PR CA(433,"AT D",DEBTOR, DATE)) Q:D ATE="" Q: DATE>ENDDT D
	3533	"RTN","RCC PCAP",38,0 )
	3534	... ; Rec heck and Q uit if the date is n ot within the Year
	3535	"RTN","RCC PCAP",39,0 )
	3536	... I DAT E<STARTDT! (DATE>ENDD T) Q
	3537	"RTN","RCC PCAP",40,0 )
	3538	... ; Set Final Dat e for this Debtor to determine final tra nsaction
	3539	"RTN","RCC PCAP",41,0 )
	3540	... N TRA NS
	3541	"RTN","RCC PCAP",42,0 )
	3542	... S TRA NS=""
	3543	"RTN","RCC PCAP",43,0 )
	3544	... F S TRANS=$O(^ PRCA(433," ATD",DEBTO R,DATE,TRA NS)) Q:TRA NS="" D
	3545	"RTN","RCC PCAP",44,0 )
	3546	.... ; Qu it if the Transactio n Type is not Paymen t in Part( 2) or Paym ent in Fu
	3547	ll(34)
	3548	"RTN","RCC PCAP",45,0 )
	3549	.... I $P (^PRCA(433 ,TRANS,1), U,2)'=2&($ P(^PRCA(43 3,TRANS,1) ,U,2)'=34) Q
	3550	"RTN","RCC PCAP",46,0 )
	3551	.... ; Se t PH Recor d if first time for this Debto r
	3552	"RTN","RCC PCAP",47,0 )
	3553	.... I 'P HSET D SET PH(DEBTOR, PSCNTR) S PHSET=1
	3554	"RTN","RCC PCAP",48,0 )
	3555	.... ; Se t PD Recor d for each Payment T ransaction
	3556	"RTN","RCC PCAP",49,0 )
	3557	.... D SE TPD(DEBTOR ,DATE,TRAN S,PSCNTR)
	3558	"RTN","RCC PCAP",50,0 )
	3559	.. ;
	3560	"RTN","RCC PCAP",51,0 )
	3561	.. ; Afte r completi ng each De btor, if t he Size is over 30K, set Next to create
	3562	a new PS Record,
	3563	"RTN","RCC PCAP",52,0 )
	3564	.. ; set Message De limiter at the end o f the PD r ecord, and set End D ate and T
	3565	ime
	3566	"RTN","RCC PCAP",53,0 )
	3567	.. I SIZE >30000 D
	3568	"RTN","RCC PCAP",54,0 )
	3569	... S ^RC AP(349.5,P SCNTR,LAST PD,0)=^RCA P(349.5,PS CNTR,LASTP D,0)_"~"
	3570	"RTN","RCC PCAP",55,0 )
	3571	... S NEX T=1
	3572	"RTN","RCC PCAP",56,0 )
	3573	... D NOW ^%DTC
	3574	"RTN","RCC PCAP",57,0 )
	3575	... S $P( ^RCAP(349. 5,PSCNTR,0 ),U,4)=%
	3576	"RTN","RCC PCAP",58,0 )
	3577	.. ;
	3578	"RTN","RCC PCAP",59,0 )
	3579	.. ; If t he last De btor in AT D has proc essed set End to sto p processi ng, if Ti
	3580	lde not fi nal
	3581	"RTN","RCC PCAP",60,0 )
	3582	.. ; char acter, set Tilde to Last PD re cord, and set End Da te and tim e
	3583	"RTN","RCC PCAP",61,0 )
	3584	. I DEBTO R="" D
	3585	"RTN","RCC PCAP",62,0 )
	3586	.. S END= 1
	3587	"RTN","RCC PCAP",63,0 )
	3588	.. I $E(^ RCAP(349.5 ,PSCNTR,LA STPD,0),$L (^RCAP(349 .5,PSCNTR, LASTPD,0)) )'="~" S
	3589	^RCAP(349. 5,PSCNTR,L ASTPD,0)=^ RCAP(349.5 ,PSCNTR,LA STPD,0)_"~ "
	3590	"RTN","RCC PCAP",64,0 )
	3591	.. D NOW^ %DTC
	3592	"RTN","RCC PCAP",65,0 )
	3593	.. S $P(^ RCAP(349.5 ,PSCNTR,0) ,U,4)=%
	3594	"RTN","RCC PCAP",66,0 )
	3595	;
	3596	"RTN","RCC PCAP",67,0 )
	3597	; PRCA4. 5313 - Un lock prior to transm ission
	3598	"RTN","RCC PCAP",68,0 )
	3599	L -^RCAP( 349.5):DIL OCKTM
	3600	"RTN","RCC PCAP",69,0 )
	3601	;
	3602	"RTN","RCC PCAP",70,0 )
	3603	; If the Source is Background (B) deter mine the d ate and ti me from th e schedul
	3604	e based up on site co de
	3605	"RTN","RCC PCAP",71,0 )
	3606	I SOURCE= "B" S DTTI ME=$$SCHED ^RCCPCAT($ $SITE^RCMS ITE)
	3607	"RTN","RCC PCAP",72,0 )
	3608	D EN^RCCP CAT(DTTIME )
	3609	"RTN","RCC PCAP",73,0 )
	3610	;
	3611	"RTN","RCC PCAP",74,0 )
	3612	Q
	3613	"RTN","RCC PCAP",75,0 )
	3614	;
	3615	"RTN","RCC PCAP",76,0 )
	3616	SETPS(PSCN TR,YEAR) ; Get and Set Data f or PS Reco rd into 34 9.5
	3617	"RTN","RCC PCAP",77,0 )
	3618	; Set Yea r and Buil d Start Da te and Tim e
	3619	"RTN","RCC PCAP",78,0 )
	3620	N PS,DR,D A,DIE,DIC, X
	3621	"RTN","RCC PCAP",79,0 )
	3622	S DIC="^R CAP(349.5, ",X=PSCNTR ,DA=.01,DI C(0)="" D FILE^DICN
	3623	"RTN","RCC PCAP",80,0 )
	3624	D NOW^%DT C
	3625	"RTN","RCC PCAP",81,0 )
	3626	S $P(^RCA P(349.5,PS CNTR,0),U, 2,3)=YEAR_ U_%
	3627	"RTN","RCC PCAP",82,0 )
	3628	; Increme nt Line nu mber
	3629	"RTN","RCC PCAP",83,0 )
	3630	S LINE=LI NE+1
	3631	"RTN","RCC PCAP",84,0 )
	3632	; Set PSS EG for thi s Segment to PS Coun ter
	3633	"RTN","RCC PCAP",85,0 )
	3634	S PSSEG(P SCNTR)=PSC NTR
	3635	"RTN","RCC PCAP",86,0 )
	3636	; Pieces 3 and 6 wi ll be upda ted during the creat ion of oth er PS and PH segmen
	3637	ts
	3638	"RTN","RCC PCAP",87,0 )
	3639	S PS="PS" _U_PSCNTR_ U_PSCNTR_U _$$SITE^RC MSITE_U_$$ FP^RCCPCFN _U_0_U_20_ $E(YEAR,2
	3640	,3)_U_$$DA T^RCCPCFN( DT)_U_"}"
	3641	"RTN","RCC PCAP",88,0 )
	3642	; Update File
	3643	"RTN","RCC PCAP",89,0 )
	3644	S ^RCAP(3 49.5,PSCNT R,LINE,0)= PS
	3645	"RTN","RCC PCAP",90,0 )
	3646	; Add len gth to SIZ E
	3647	"RTN","RCC PCAP",91,0 )
	3648	S SIZE=SI ZE+$L(PS)
	3649	"RTN","RCC PCAP",92,0 )
	3650	; Update all previo us PS Segm ents piece 3 with cu rrent coun ter
	3651	"RTN","RCC PCAP",93,0 )
	3652	N I
	3653	"RTN","RCC PCAP",94,0 )
	3654	S I=0
	3655	"RTN","RCC PCAP",95,0 )
	3656	F S I=$O (PSSEG(I)) Q:I=PSCNT R S $P(^R CAP(349.5, I,1,0),U,3 )=PSCNTR
	3657	"RTN","RCC PCAP",96,0 )
	3658	;
	3659	"RTN","RCC PCAP",97,0 )
	3660	Q
	3661	"RTN","RCC PCAP",98,0 )
	3662	;
	3663	"RTN","RCC PCAP",99,0 )
	3664	SETPH(DEBT OR,PSCNTR) ; Get an d Set Data for PH Re cord into 349.5
	3665	"RTN","RCC PCAP",100, 0)
	3666	N PH,SITE ,PATNAME,A DDRESS,I,A RFLAG,ARAD DR,COUNTRY ,DFN,ICN,D R,DA,DIE,P OSTCODE
	3667	"RTN","RCC PCAP",101, 0)
	3668	; Increme nt Line nu mber
	3669	"RTN","RCC PCAP",102, 0)
	3670	S LINE=LI NE+1
	3671	"RTN","RCC PCAP",103, 0)
	3672	; Increme nt PH Coun ter
	3673	"RTN","RCC PCAP",104, 0)
	3674	S PHCNTR= PHCNTR+1
	3675	"RTN","RCC PCAP",105, 0)
	3676	; Set PHS EG for thi s Segment to Line
	3677	"RTN","RCC PCAP",106, 0)
	3678	S PHSEG(P HCNTR)=LIN E
	3679	"RTN","RCC PCAP",107, 0)
	3680	; Get DFN and ICN f or Debtor and Patien t - If the ICN retur ns a -1 in the firs
	3681	t piece
	3682	"RTN","RCC PCAP",108, 0)
	3683	; send a Null value as the IC N
	3684	"RTN","RCC PCAP",109, 0)
	3685	S DFN=+$P (^RCD(340, DEBTOR,0), U)
	3686	"RTN","RCC PCAP",110, 0)
	3687	S ICN=$$G ETICN^MPIF 001(DFN)
	3688	"RTN","RCC PCAP",111, 0)
	3689	S ICN=$S( +ICN'=-1:I CN,1:"")
	3690	"RTN","RCC PCAP",112, 0)
	3691	; Get Acc ount Numbe r -- Sit e code and SSN
	3692	"RTN","RCC PCAP",113, 0)
	3693	S SITE=$$ SITE^RCMSI TE
	3694	"RTN","RCC PCAP",114, 0)
	3695	S PH="PH" _U_SITE_$$ SSN^RCFN01 (DEBTOR)
	3696	"RTN","RCC PCAP",115, 0)
	3697	; Get Pat ient Name
	3698	"RTN","RCC PCAP",116, 0)
	3699	S PATNAME =$$NAM^RCF N01(DEBTOR )
	3700	"RTN","RCC PCAP",117, 0)
	3701	S PH=PH_$ E($P(PATNA ME,","),1, 5)_U_$E($P (PATNAME," ,"),1,20)_ U_$E($P($P (PATNAME,
	3702	",",2)," " ),1,10)_U_ $E($P(PATN AME," ",2) ,1,10)
	3703	"RTN","RCC PCAP",118, 0)
	3704	; If Coun try is not '1' get C ountry Nam e and Post al Code
	3705	"RTN","RCC PCAP",119, 0)
	3706	S COUNTRY =$P($G(^DP T(+$P(^RCD (340,DEBTO R,0),U),.1 1)),U,10)
	3707	"RTN","RCC PCAP",120, 0)
	3708	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	3709	"RTN","RCC PCAP",121, 0)
	3710	I COUNTRY '="" S POS TCODE=$P($ G(^DPT(DFN ,.11)),U,9 )
	3711	"RTN","RCC PCAP",122, 0)
	3712	; Get Add ress and A RFLAG
	3713	"RTN","RCC PCAP",123, 0)
	3714	S ADDRESS =$P($$DADD ^RCAMADD(D EBTOR,1),U ,1,6)
	3715	"RTN","RCC PCAP",124, 0)
	3716	F I=1:1:4 S $P(ADDR ESS,U,I)=$ E($P(ADDRE SS,U,I),1, 40)
	3717	"RTN","RCC PCAP",125, 0)
	3718	; If the Country is Null the State and Zip Code w ill be use d
	3719	"RTN","RCC PCAP",126, 0)
	3720	; If the Country is Not Null, the State will be F X and the
	3721	"RTN","RCC PCAP",127, 0)
	3722	; Zip Cod e will be the Postal Code from the Patie nt (#2) fi le
	3723	"RTN","RCC PCAP",128, 0)
	3724	S $P(ADDR ESS,U,5)=$ S(COUNTRY= "":$E($P(A DDRESS,U,5 ),1,2),1:" FX")
	3725	"RTN","RCC PCAP",129, 0)
	3726	S $P(ADDR ESS,U,6)=$ S(COUNTRY= "":$E($P(A DDRESS,U,6 ),1,9),1:$ E(POSTCODE ,1,11))
	3727	"RTN","RCC PCAP",130, 0)
	3728	S PH=PH_U _ADDRESS
	3729	"RTN","RCC PCAP",131, 0)
	3730	S ARFLAG= "N"
	3731	"RTN","RCC PCAP",132, 0)
	3732	S ARADDR= $P($G(^RCD (340,DEBTO R,1)),U,1, 6)
	3733	"RTN","RCC PCAP",133, 0)
	3734	I ($P(ARA DDR,U)'="" ),($P(ARAD DR,U,4)'=" "),($P(ARA DDR,U,5)'= ""),(($P(A RADDR,U,6
	3735	)'="")) S ARFLAG="Y"
	3736	"RTN","RCC PCAP",134, 0)
	3737	S PH=PH_U _$E(COUNTR Y,1,11)
	3738	"RTN","RCC PCAP",135, 0)
	3739	; Set DFN and ICN f or Debtor and Patien t with Bla nk space f or Total A mount Rec
	3740	eived
	3741	"RTN","RCC PCAP",136, 0)
	3742	S PH=PH_U _U_SITE_DF N_U_ICN
	3743	"RTN","RCC PCAP",137, 0)
	3744	; Set ARF LAG from a bove
	3745	"RTN","RCC PCAP",138, 0)
	3746	S PH=PH_U _ARFLAG
	3747	"RTN","RCC PCAP",139, 0)
	3748	; Set Bla nk spaces for Last B ill Prepar ed Date fo r Debtor a nd Number of PD Seg
	3749	ments
	3750	"RTN","RCC PCAP",140, 0)
	3751	; and the n Record D elimiter
	3752	"RTN","RCC PCAP",141, 0)
	3753	S PH=PH_U _U_U_"}"
	3754	"RTN","RCC PCAP",142, 0)
	3755	; Update file
	3756	"RTN","RCC PCAP",143, 0)
	3757	S ^RCAP(3 49.5,PSCNT R,LINE,0)= PH
	3758	"RTN","RCC PCAP",144, 0)
	3759	; Add len gth to SIZ E
	3760	"RTN","RCC PCAP",145, 0)
	3761	S SIZE=SI ZE+$L(PH)
	3762	"RTN","RCC PCAP",146, 0)
	3763	; Increme nt PS segm ent piece 6 with ano ther PH re cord
	3764	"RTN","RCC PCAP",147, 0)
	3765	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,0),U,6 )=$P(^RCAP (349.5,PSS EG(PSCNTR) ,1,0),U,6
	3766	)+1
	3767	"RTN","RCC PCAP",148, 0)
	3768	Q
	3769	"RTN","RCC PCAP",149, 0)
	3770	;
	3771	"RTN","RCC PCAP",150, 0)
	3772	SETPD(DEBT OR,DATE,TR ANS,PSCNTR ) ; Get a nd Set Dat a for PD R ecord into 349.5
	3773	"RTN","RCC PCAP",151, 0)
	3774	N DR,DA,D IE,PD,AMT, PHTOT,BILL ,CURBDT
	3775	"RTN","RCC PCAP",152, 0)
	3776	; Get Tra nsaction A mount - Qu it if Amou nt is zero or null
	3777	"RTN","RCC PCAP",153, 0)
	3778	S AMT=$P( ^PRCA(433, TRANS,1),U ,5)
	3779	"RTN","RCC PCAP",154, 0)
	3780	I 'AMT Q
	3781	"RTN","RCC PCAP",155, 0)
	3782	; Format Amount
	3783	"RTN","RCC PCAP",156, 0)
	3784	S AMT=$TR ($J(AMT,9, 2)," ","")
	3785	"RTN","RCC PCAP",157, 0)
	3786	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	3787	"RTN","RCC PCAP",158, 0)
	3788	;
	3789	"RTN","RCC PCAP",159, 0)
	3790	S LINE=LI NE+1
	3791	"RTN","RCC PCAP",160, 0)
	3792	S LASTPD= LINE
	3793	"RTN","RCC PCAP",161, 0)
	3794	; Format and Set Da te Entered , Amount, and Delimi ter
	3795	"RTN","RCC PCAP",162, 0)
	3796	S PD="PD" _U_$$DAT^R CCPCFN(DAT E)_U_AMT_U _"}"
	3797	"RTN","RCC PCAP",163, 0)
	3798	;
	3799	"RTN","RCC PCAP",164, 0)
	3800	; Add len gth to SIZ E
	3801	"RTN","RCC PCAP",165, 0)
	3802	S SIZE=SI ZE+$L(PD)
	3803	"RTN","RCC PCAP",166, 0)
	3804	;
	3805	"RTN","RCC PCAP",167, 0)
	3806	; Update file
	3807	"RTN","RCC PCAP",168, 0)
	3808	S ^RCAP(3 49.5,PSCNT R,LINE,0)= PD
	3809	"RTN","RCC PCAP",169, 0)
	3810	;
	3811	"RTN","RCC PCAP",170, 0)
	3812	; Get cur rent PH To tal, add A mount, the n reset to PH Segmen t
	3813	"RTN","RCC PCAP",171, 0)
	3814	S PHTOT=$ P(^RCAP(34 9.5,PSSEG( PSCNTR),PH SEG(PHCNTR ),0),U,13)
	3815	"RTN","RCC PCAP",172, 0)
	3816	S PHTOT=P HTOT+AMT
	3817	"RTN","RCC PCAP",173, 0)
	3818	S $P(^RCA P(349.5,PS SEG(PSCNTR ),PHSEG(PH CNTR),0),U ,13)=PHTOT
	3819	"RTN","RCC PCAP",174, 0)
	3820	;
	3821	"RTN","RCC PCAP",175, 0)
	3822	; Determi ne the Cur rent Bill Date and i f greater than LTBDT , Latest B ill Date,
	3823
	3824	"RTN","RCC PCAP",176, 0)
	3825	; set to PH Segment and LTBDT
	3826	"RTN","RCC PCAP",177, 0)
	3827	S BILL=$P (^PRCA(433 ,TRANS,0), U,2)
	3828	"RTN","RCC PCAP",178, 0)
	3829	S CURBDT= $P(^PRCA(4 30,BILL,0) ,U,10)
	3830	"RTN","RCC PCAP",179, 0)
	3831	I CURBDT> LTBDT S $P (^RCAP(349 .5,PSSEG(P SCNTR),PHS EG(PHCNTR) ,0),U,17)= $$DAT^RCC
	3832	PCFN(CURBD T),LTBDT=C URBDT
	3833	"RTN","RCC PCAP",180, 0)
	3834	;
	3835	"RTN","RCC PCAP",181, 0)
	3836	; Increme nt PH segm ent piece 18 with an other PD r ecord
	3837	"RTN","RCC PCAP",182, 0)
	3838	S $P(^RCA P(349.5,PS SEG(PSCNTR ),PHSEG(PH CNTR),0),U ,18)=$P(^R CAP(349.5, PSSEG(PSC
	3839	NTR),PHSEG (PHCNTR),0 ),U,18)+1
	3840	"RTN","RCC PCAP",183, 0)
	3841	Q
	3842	"RTN","RCC PCAP",184, 0)
	3843	;
	3844	"RTN","RCC PCAP",185, 0)
	3845	KILL ; Re move exist ing RCAP(3 49.5 Entri es
	3846	"RTN","RCC PCAP",186, 0)
	3847	N DA,DIK
	3848	"RTN","RCC PCAP",187, 0)
	3849	S DIK="^R CAP(349.5, "
	3850	"RTN","RCC PCAP",188, 0)
	3851	S DA=0 F S DA=$O(^ RCAP(349.5 ,DA)) Q:DA ="" D ^DI K
	3852	"RTN","RCC PCAP",189, 0)
	3853	Q
	3854	"RTN","RCC PCAP",190, 0)
	3855	;
	3856	"RTN","RCC PCAR")
	3857	0^23^B4858 7779^n/a
	3858	"RTN","RCC PCAR",1,0)
	3859	RCCPCAR ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT R EPORT ; 2/ 3/2016 11: 30 am
	3860	"RTN","RCC PCAR",2,0)
	3861	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 113
	3862	"RTN","RCC PCAR",3,0)
	3863	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3864	"RTN","RCC PCAR",4,0)
	3865	EN(YEAR) ; Report errors for the payme nt stateme nts for Ye ar entered
	3866	"RTN","RCC PCAR",5,0)
	3867	; Year is the first three num bers of th e Internal Date form at
	3868	"RTN","RCC PCAR",6,0)
	3869	;
	3870	"RTN","RCC PCAR",7,0)
	3871	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	3872	"RTN","RCC PCAR",8,0)
	3873	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	3874	"RTN","RCC PCAR",9,0)
	3875	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	3876	"RTN","RCC PCAR",10,0 )
	3877	. W !,"Tr y again la ter."
	3878	"RTN","RCC PCAR",11,0 )
	3879	;
	3880	"RTN","RCC PCAR",12,0 )
	3881	K ^TMP($J ,"MSG")
	3882	"RTN","RCC PCAR",13,0 )
	3883	N STARTDT ,ENDDT,LIN E,DEBTOR,P ATSSN
	3884	"RTN","RCC PCAR",14,0 )
	3885	;
	3886	"RTN","RCC PCAR",15,0 )
	3887	; Initial ize YEAR t o current year if Nu ll
	3888	"RTN","RCC PCAR",16,0 )
	3889	I $G(YEAR )="" S YEA R=$E(DT,1, 3)
	3890	"RTN","RCC PCAR",17,0 )
	3891	;
	3892	"RTN","RCC PCAR",18,0 )
	3893	; Set Sta rt and End Dates
	3894	"RTN","RCC PCAR",19,0 )
	3895	S STARTDT =YEAR_"010 0"
	3896	"RTN","RCC PCAR",20,0 )
	3897	S ENDDT=Y EAR_1232
	3898	"RTN","RCC PCAR",21,0 )
	3899	S LINE=0
	3900	"RTN","RCC PCAR",22,0 )
	3901	S DEBTOR= ""
	3902	"RTN","RCC PCAR",23,0 )
	3903	F S DEBT OR=$O(^PRC A(433,"ATD ",DEBTOR)) Q:DEBTOR= "" D
	3904	"RTN","RCC PCAR",24,0 )
	3905	. ; Quit if the deb tor is not a patient
	3906	"RTN","RCC PCAR",25,0 )
	3907	. I '$D(^ RCD(340,"A B","DPT(", DEBTOR)) Q
	3908	"RTN","RCC PCAR",26,0 )
	3909	. N DATE, PATERROR,P HSET
	3910	"RTN","RCC PCAR",27,0 )
	3911	. S (PHSE T,PATERROR )=0
	3912	"RTN","RCC PCAR",28,0 )
	3913	. S DATE= STARTDT
	3914	"RTN","RCC PCAR",29,0 )
	3915	. F S DA TE=$O(^PRC A(433,"ATD ",DEBTOR,D ATE)) Q:DA TE="" Q:D ATE>ENDDT D
	3916	"RTN","RCC PCAR",30,0 )
	3917	.. ; Rech eck and Qu it if the date is no t within t he Year
	3918	"RTN","RCC PCAR",31,0 )
	3919	.. I DATE <STARTDT!( DATE>ENDDT ) Q
	3920	"RTN","RCC PCAR",32,0 )
	3921	.. ; Set Final Date for this Debtor to determine final tran saction
	3922	"RTN","RCC PCAR",33,0 )
	3923	.. N TRAN S
	3924	"RTN","RCC PCAR",34,0 )
	3925	.. S TRAN S=""
	3926	"RTN","RCC PCAR",35,0 )
	3927	.. F S T RANS=$O(^P RCA(433,"A TD",DEBTOR ,DATE,TRAN S)) Q:TRAN S="" D
	3928	"RTN","RCC PCAR",36,0 )
	3929	... ; Qui t if the T ransaction Type is n ot Payment in Part(2 ) or Payme nt in Ful
	3930	l(34)
	3931	"RTN","RCC PCAR",37,0 )
	3932	... I $P( ^PRCA(433, TRANS,1),U ,2)'=2&($P (^PRCA(433 ,TRANS,1), U,2)'=34) Q
	3933	"RTN","RCC PCAR",38,0 )
	3934	... ; Che ck PH Reco rd if firs t time for this Debt or
	3935	"RTN","RCC PCAR",39,0 )
	3936	... I 'PH SET D CHEC KPH(DEBTOR ) S PHSET= 1
	3937	"RTN","RCC PCAR",40,0 )
	3938	... ; Che ck PD Reco rd for eac h Payment Transactio n
	3939	"RTN","RCC PCAR",41,0 )
	3940	... D CHE CKPD(DEBTO R,DATE,TRA NS)
	3941	"RTN","RCC PCAR",42,0 )
	3942	;
	3943	"RTN","RCC PCAR",43,0 )
	3944	; If ther e are any errors Sen d MailMan Message wi th Errors in ^TMP($J ,"MSG")
	3945	"RTN","RCC PCAR",44,0 )
	3946	I $D(^TMP ($J,"MSG") ) D TRANSM IT
	3947	"RTN","RCC PCAR",45,0 )
	3948	; If ther e are no e rrors Send MailMan M essage wit h No Error s Line
	3949	"RTN","RCC PCAR",46,0 )
	3950	I '$D(^TM P($J,"MSG" )) D
	3951	"RTN","RCC PCAR",47,0 )
	3952	. S ^TMP( $J,"MSG",1 ,0)="No an nual patie nt payment data inco nsistencie s found."
	3953	"RTN","RCC PCAR",48,0 )
	3954	. D TRANS MIT
	3955	"RTN","RCC PCAR",49,0 )
	3956	;
	3957	"RTN","RCC PCAR",50,0 )
	3958	K ^TMP($J ,"MSG")
	3959	"RTN","RCC PCAR",51,0 )
	3960	; PRCA4. 5313 - Un lock follo wing trans mission
	3961	"RTN","RCC PCAR",52,0 )
	3962	L -^TMP($ J,"MSG"):D ILOCKTM
	3963	"RTN","RCC PCAR",53,0 )
	3964	Q
	3965	"RTN","RCC PCAR",54,0 )
	3966	;
	3967	"RTN","RCC PCAR",55,0 )
	3968	CHECKPH(DE BTOR) ; C heck Data for PH Rec ord
	3969	"RTN","RCC PCAR",56,0 )
	3970	N SSN,PAT NAME,I,ARA DDR,ADDRER ,DFN,ICN,B ILLDATE,CO UNTRY,ST
	3971	"RTN","RCC PCAR",57,0 )
	3972	;
	3973	"RTN","RCC PCAR",58,0 )
	3974	; Get and Check DFN for Debto r. If DFN is Null o r does not start wit h a numbe
	3975	r
	3976	"RTN","RCC PCAR",59,0 )
	3977	; write E rror with Debtor Num ber and th en Quit, a s other da ta is depe ndent upo
	3978	n DFN
	3979	"RTN","RCC PCAR",60,0 )
	3980	S DFN=+$P (^RCD(340, DEBTOR,0), U)
	3981	"RTN","RCC PCAR",61,0 )
	3982	I 'DFN D SETERROR(" Debtor Num ber: "_DEB TOR,"Missi ng DFN") Q
	3983	"RTN","RCC PCAR",62,0 )
	3984	;
	3985	"RTN","RCC PCAR",63,0 )
	3986	; Get Pat ient Name and SSN
	3987	"RTN","RCC PCAR",64,0 )
	3988	S PATNAME =$$NAM^RCF N01(DEBTOR )
	3989	"RTN","RCC PCAR",65,0 )
	3990	S SSN=$$S SN^RCFN01( DEBTOR)
	3991	"RTN","RCC PCAR",66,0 )
	3992	S PATSSN= PATNAME_" LAST-4: " _$E(SSN,6, 9)
	3993	"RTN","RCC PCAR",67,0 )
	3994	;
	3995	"RTN","RCC PCAR",68,0 )
	3996	; Get and Check DFN and ICN f or Debtor and Patien t
	3997	"RTN","RCC PCAR",69,0 )
	3998	I $L(DFN) >8 D SETER ROR(PATSSN ,"Invalid DFN")
	3999	"RTN","RCC PCAR",70,0 )
	4000	S ICN=$$G ETICN^MPIF 001(DFN)
	4001	"RTN","RCC PCAR",71,0 )
	4002	I +ICN=-1 !($L(ICN)> 17) D SETE RROR(PATSS N,"Missing or Invali d ICN")
	4003	"RTN","RCC PCAR",72,0 )
	4004	;
	4005	"RTN","RCC PCAR",73,0 )
	4006	; Check P atient Nam e and SSN
	4007	"RTN","RCC PCAR",74,0 )
	4008	I SSN=""! (SSN'?9N) D SETERROR (PATSSN,"M issing or Invalid SS N")
	4009	"RTN","RCC PCAR",75,0 )
	4010	I $P(PATN AME,",")=" " D SETERR OR(PATSSN, "Missing o r Invalid Last Name" )
	4011	"RTN","RCC PCAR",76,0 )
	4012	I $P($P(P ATNAME,"," ,2)," ")=" " D SETERR OR(PATSSN, "Missing o r Invalid First Nam
	4013	e")
	4014	"RTN","RCC PCAR",77,0 )
	4015	;
	4016	"RTN","RCC PCAR",78,0 )
	4017	; Get and Check Add ress
	4018	"RTN","RCC PCAR",79,0 )
	4019	S ARADDR= $P($$DADD^ RCAMADD(DE BTOR,1),U, 1,6)
	4020	"RTN","RCC PCAR",80,0 )
	4021	F I=1,4 I $P(ARADDR ,U,I)=""!( $L($P(ARAD DR,U,I))>4 0) D
	4022	"RTN","RCC PCAR",81,0 )
	4023	. S ADDRE R(I)=$S(I= 1:"Address Line 1",I =4:"City")
	4024	"RTN","RCC PCAR",82,0 )
	4025	. D SETER ROR(PATSSN ,"Missing or Invalid "_ADDRER( I))
	4026	"RTN","RCC PCAR",83,0 )
	4027	N ADDRER
	4028	"RTN","RCC PCAR",84,0 )
	4029	F I=2,3 I $L($P(ARA DDR,U,I))> 40 D
	4030	"RTN","RCC PCAR",85,0 )
	4031	. S ADDRE R(I)=$S(I= 2:"Address Line 2",I =3:"Addres s Line 3")
	4032	"RTN","RCC PCAR",86,0 )
	4033	. D SETER ROR(PATSSN ,"Invalid "_ADDRER(I ))
	4034	"RTN","RCC PCAR",87,0 )
	4035	;
	4036	"RTN","RCC PCAR",88,0 )
	4037	; If the Zip Code i s Null fro m DADD^RCM ADD set Pi ece 6 of A RADDR to P iece 6 of
	4038	.11
	4039	"RTN","RCC PCAR",89,0 )
	4040	I $P(ARAD DR,U,6)="" S $P(ARAD DR,U,6)=$P ($G(^DPT(D FN,.11)),U ,6)
	4041	"RTN","RCC PCAR",90,0 )
	4042	;
	4043	"RTN","RCC PCAR",91,0 )
	4044	; If Coun try is not '1' get C ountry Nam e for use in validat ing the St ate and Z
	4045	ip Code
	4046	"RTN","RCC PCAR",92,0 )
	4047	S COUNTRY =$P($G(^DP T(DFN,.11) ),U,10)
	4048	"RTN","RCC PCAR",93,0 )
	4049	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	4050	"RTN","RCC PCAR",94,0 )
	4051	; If the Country Co de is Not Null and t he Postal Code is gr eater than 11 chara
	4052	cters writ e error
	4053	"RTN","RCC PCAR",95,0 )
	4054	I COUNTRY '="",$L($P ($G(^DPT(D FN,.11)),U ,9))>11 D SETERROR(P ATSSN,"Inv alid Fore
	4055	ign Postal Code")
	4056	"RTN","RCC PCAR",96,0 )
	4057	; State h as three E rror condi tions
	4058	"RTN","RCC PCAR",97,0 )
	4059	; If the State is N ot Null an d is not 2 character s
	4060	"RTN","RCC PCAR",98,0 )
	4061	; If the State is N ot Null an d is not a Valid US State
	4062	"RTN","RCC PCAR",99,0 )
	4063	; If the State is N ot Null an d the Coun try is Not Null
	4064	"RTN","RCC PCAR",100, 0)
	4065	; If the State is N ull and th e Country is Null
	4066	"RTN","RCC PCAR",101, 0)
	4067	I $P(ARAD DR,U,5)'=" ",$L($P(AR ADDR,U,5)) '=2 D SETE RROR(PATSS N,"Missing or Inval
	4068	id State")
	4069	"RTN","RCC PCAR",102, 0)
	4070	S ST=$O(^ DIC(5,"C", $P(ARADDR, U,5),""))
	4071	"RTN","RCC PCAR",103, 0)
	4072	I $P(ARAD DR,U,5)'=" ",ST="" D SETERROR(P ATSSN,"Mis sing or In valid Stat e")
	4073	"RTN","RCC PCAR",104, 0)
	4074	I $P(ARAD DR,U,5)'=" ",ST'="",$ P(^DIC(5,S T,0),U,6)' =1 D SETER ROR(PATSSN ,"Missing
	4075	or Invali d State")
	4076	"RTN","RCC PCAR",105, 0)
	4077	I $P(ARAD DR,U,5)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid State
	4078	")
	4079	"RTN","RCC PCAR",106, 0)
	4080	I $P(ARAD DR,U,5)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d State")
	4081	"RTN","RCC PCAR",107, 0)
	4082	; Zip Cod e has thre e Error co nditions
	4083	"RTN","RCC PCAR",108, 0)
	4084	; If the Zip Code i s Not Null and is no t 5 to 9 N umerics
	4085	"RTN","RCC PCAR",109, 0)
	4086	; If the Zip Code i s Not Null and the C ountry is Not Null
	4087	"RTN","RCC PCAR",110, 0)
	4088	; If the Zip Code i s Null and the Count ry is Null
	4089	"RTN","RCC PCAR",111, 0)
	4090	I $P(ARAD DR,U,6)'=" "&($P(ARAD DR,U,6)'?5 .9N) D SET ERROR(PATS SN,"Missin g or Inva
	4091	lid Zip Co de")
	4092	"RTN","RCC PCAR",112, 0)
	4093	I $P(ARAD DR,U,6)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid Zip C
	4094	ode")
	4095	"RTN","RCC PCAR",113, 0)
	4096	I $P(ARAD DR,U,6)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d Zip Cod
	4097	e")
	4098	"RTN","RCC PCAR",114, 0)
	4099	Q
	4100	"RTN","RCC PCAR",115, 0)
	4101	;
	4102	"RTN","RCC PCAR",116, 0)
	4103	CHECKPD(DE BTOR,DATE, TRANS) ; Get and Se t Data for PD Record into 349. 5
	4104	"RTN","RCC PCAR",117, 0)
	4105	N AMT
	4106	"RTN","RCC PCAR",118, 0)
	4107	; Get and Check Tra nsaction A mount
	4108	"RTN","RCC PCAR",119, 0)
	4109	S AMT=$P( ^PRCA(433, TRANS,1),U ,5)
	4110	"RTN","RCC PCAR",120, 0)
	4111	; Format Amount
	4112	"RTN","RCC PCAR",121, 0)
	4113	S AMT=$TR ($J(AMT,9, 2)," ","")
	4114	"RTN","RCC PCAR",122, 0)
	4115	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	4116	"RTN","RCC PCAR",123, 0)
	4117	I 'AMT!($ L(AMT)>10) D SETERRO R(PATSSN," Amount in Transactio n "_TRANS_ " Invalid
	4118	")
	4119	"RTN","RCC PCAR",124, 0)
	4120	;
	4121	"RTN","RCC PCAR",125, 0)
	4122	; Get and Check Tra nsaction D ate
	4123	"RTN","RCC PCAR",126, 0)
	4124	I $P(DATE ,".")'?7N. N D SETERR OR(PATSSN, "Date for Transactio n "_TRANS_ " Invalid
	4125	")
	4126	"RTN","RCC PCAR",127, 0)
	4127	Q
	4128	"RTN","RCC PCAR",128, 0)
	4129	;
	4130	"RTN","RCC PCAR",129, 0)
	4131	SETERROR(P ATSSN,ERRO R) ; Set the error into TMP($ J,"MSG",LI NE,0) for transmiss
	4132	ion
	4133	"RTN","RCC PCAR",130, 0)
	4134	; If the first time thru for this patie nt set the Name and SSN in mes sage
	4135	"RTN","RCC PCAR",131, 0)
	4136	; with a blank line above the Patient D ata for sp acing
	4137	"RTN","RCC PCAR",132, 0)
	4138	I 'PATERR OR D
	4139	"RTN","RCC PCAR",133, 0)
	4140	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=" "
	4141	"RTN","RCC PCAR",134, 0)
	4142	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=P ATSSN
	4143	"RTN","RCC PCAR",135, 0)
	4144	. S PATER ROR=1
	4145	"RTN","RCC PCAR",136, 0)
	4146	; Write E rror to ne xt line wi th a doubl e space in front
	4147	"RTN","RCC PCAR",137, 0)
	4148	S LINE=LI NE+1 S ^TM P($J,"MSG" ,LINE,0)=" "_ERROR
	4149	"RTN","RCC PCAR",138, 0)
	4150	Q
	4151	"RTN","RCC PCAR",139, 0)
	4152	;
	4153	"RTN","RCC PCAR",140, 0)
	4154	TRANSMIT ; set up and send mail message - copied fr om RCCPCML
	4155	"RTN","RCC PCAR",141, 0)
	4156	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY
	4157	"RTN","RCC PCAR",142, 0)
	4158	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT ERROR R EPORT "_20 _$E(YEAR,2 ,3)_" TO
	4159	CURRENT DA TE"
	4160	"RTN","RCC PCAR",143, 0)
	4161	S XMDUZ=" AR PACKAGE "
	4162	"RTN","RCC PCAR",144, 0)
	4163	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	4164	CCPC STATE MENTS")=""
	4165	"RTN","RCC PCAR",145, 0)
	4166	S XMDUZ=" AR PACKAGE "
	4167	"RTN","RCC PCAR",146, 0)
	4168	D XMZ^XMA 2
	4169	"RTN","RCC PCAR",147, 0)
	4170	I XMZ<1 S RTY=RTY+1 G TRANSMI T:RTY<4 S ERROR=5,NM =0 D ERROR Q
	4171	"RTN","RCC PCAR",148, 0)
	4172	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
	4173	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	4174	"RTN","RCC PCAR",149, 0)
	4175	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	4176	"RTN","RCC PCAR",150, 0)
	4177	D ENT1^XM D
	4178	"RTN","RCC PCAR",151, 0)
	4179	D NOW^%DT C
	4180	"RTN","RCC PCAR",152, 0)
	4181	Q
	4182	"RTN","RCC PCAR",153, 0)
	4183	;
	4184	"RTN","RCC PCAR",154, 0)
	4185	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	4186	"RTN","RCC PCAR",155, 0)
	4187	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	4188	"RTN","RCC PCAR",156, 0)
	4189	Q
	4190	"RTN","RCC PCAR",157, 0)
	4191	;
	4192	"RTN","RCC PCAR",158, 0)
	4193	MANBLD ; Build and Transmit t he Annual Payment St atement Co nsistency Checker
	4194	"RTN","RCC PCAR",159, 0)
	4195	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	4196	"RTN","RCC PCAR",160, 0)
	4197	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	4198	"RTN","RCC PCAR",161, 0)
	4199	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	4200	"RTN","RCC PCAR",162, 0)
	4201	. W !,"Tr y again la ter."
	4202	"RTN","RCC PCAR",163, 0)
	4203	; PRCA4. 5313 - Un lock prior to prepar ing and tr ansmitting
	4204	"RTN","RCC PCAR",164, 0)
	4205	L -^TMP($ J,"MSG"):D ILOCKTM
	4206	"RTN","RCC PCAR",165, 0)
	4207	;
	4208	"RTN","RCC PCAR",166, 0)
	4209	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T,%,%H
	4210	"RTN","RCC PCAR",167, 0)
	4211	S YEAR=20 _$E(DT,2,3 )
	4212	"RTN","RCC PCAR",168, 0)
	4213	S DIR(0)= "YAO"
	4214	"RTN","RCC PCAR",169, 0)
	4215	S DIR("B" )="N"
	4216	"RTN","RCC PCAR",170, 0)
	4217	S DIR("A" )="Do you want to Ru n and Tran smit the C onsistency Checker f or "_YEAR
	4218	_" to the current da te? "
	4219	"RTN","RCC PCAR",171, 0)
	4220	S DIR("?? ")="^D MAN HLP^RCCPCA R"
	4221	"RTN","RCC PCAR",172, 0)
	4222	D ^DIR
	4223	"RTN","RCC PCAR",173, 0)
	4224	I $E(X)'= "Y" Q
	4225	"RTN","RCC PCAR",174, 0)
	4226	S ZTIO="" ,ZTRTN="EN ^RCCPCAR(" _$E(DT,1,3 )_")"
	4227	"RTN","RCC PCAR",175, 0)
	4228	S ZTDESC= "Annual Pa yment Stat ement File Consisten cy Checker "
	4229	"RTN","RCC PCAR",176, 0)
	4230	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	4231	"RTN","RCC PCAR",177, 0)
	4232	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	4233	"RTN","RCC PCAR",178, 0)
	4234	Q
	4235	"RTN","RCC PCAR",179, 0)
	4236	;
	4237	"RTN","RCC PCAR",180, 0)
	4238	MANHLP ; "??" Help for MANBLD
	4239	"RTN","RCC PCAR",181, 0)
	4240	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Run and Transmit t he Consist ency Chec
	4241	ker."
	4242	"RTN","RCC PCAR",182, 0)
	4243	Q
	4244	"RTN","RCC PCAT")
	4245	0^22^B3314 6754^n/a
	4246	"RTN","RCC PCAT",1,0)
	4247	RCCPCAT ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT T RANSMIT ; 2/3/2016 1 1:30 am
	4248	"RTN","RCC PCAT",2,0)
	4249	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 113
	4250	"RTN","RCC PCAT",3,0)
	4251	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4252	"RTN","RCC PCAT",4,0)
	4253	EN(DTTIME) ;Schedul e the Tran smit
	4254	"RTN","RCC PCAT",5,0)
	4255	N ZTDESC, ZTASK,ZTDT H,ZTIO,ZTR TN
	4256	"RTN","RCC PCAT",6,0)
	4257	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	4258	"RTN","RCC PCAT",7,0)
	4259	S ZTDESC= "ANNUAL PA YMENT STAT EMENT TRAN SMISSION"
	4260	"RTN","RCC PCAT",8,0)
	4261	; Initial ize Transm it date an d time
	4262	"RTN","RCC PCAT",9,0)
	4263	I DTTIME= "" S DTTIM E=%H
	4264	"RTN","RCC PCAT",10,0 )
	4265	S ZTDTH=D TTIME
	4266	"RTN","RCC PCAT",11,0 )
	4267	D ^%ZTLOA D Q:$G(ZTS K)=""
	4268	"RTN","RCC PCAT",12,0 )
	4269	Q
	4270	"RTN","RCC PCAT",13,0 )
	4271	;
	4272	"RTN","RCC PCAT",14,0 )
	4273	TRANSMIT ; Send Ann ual Paymen t Statemen t Files to AITC from RCAP(349. 5
	4274	"RTN","RCC PCAT",15,0 )
	4275	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	4276	"RTN","RCC PCAT",16,0 )
	4277	L +^RCAP( 349.5):DIL OCKTM I '$ T W 7,7, !,"Annual Payment is already b eing run
	4278	or transmi tted. Try again lat er." Q
	4279	"RTN","RCC PCAT",17,0 )
	4280	;
	4281	"RTN","RCC PCAT",18,0 )
	4282	K ^TMP($J ,"MSG")
	4283	"RTN","RCC PCAT",19,0 )
	4284	N PSCNTR, %,%I,%H,YE AR
	4285	"RTN","RCC PCAT",20,0 )
	4286	S YEAR=20 _$E($P(^RC AP(349.5,1 ,0),U,2),2 ,3)
	4287	"RTN","RCC PCAT",21,0 )
	4288	S PSCNTR= 0
	4289	"RTN","RCC PCAT",22,0 )
	4290	F S PSCN TR=$O(^RCA P(349.5,PS CNTR)) Q:P SCNTR="" Q:PSCNTR=" B" D
	4291	"RTN","RCC PCAT",23,0 )
	4292	. ; Set T ransmit St art Date a nd Time
	4293	"RTN","RCC PCAT",24,0 )
	4294	. D NOW^% DTC
	4295	"RTN","RCC PCAT",25,0 )
	4296	. S $P(^R CAP(349.5, PSCNTR,0), U,5)=%
	4297	"RTN","RCC PCAT",26,0 )
	4298	. ; Merge all PS el ements int o TMP MSG file
	4299	"RTN","RCC PCAT",27,0 )
	4300	. M ^TMP( $J,"MSG")= ^RCAP(349. 5,PSCNTR)
	4301	"RTN","RCC PCAT",28,0 )
	4302	. D MAIL
	4303	"RTN","RCC PCAT",29,0 )
	4304	. ; Set T ransmit En d Date and Time
	4305	"RTN","RCC PCAT",30,0 )
	4306	. D NOW^% DTC
	4307	"RTN","RCC PCAT",31,0 )
	4308	. S $P(^R CAP(349.5, PSCNTR,0), U,6)=%
	4309	"RTN","RCC PCAT",32,0 )
	4310	;
	4311	"RTN","RCC PCAT",33,0 )
	4312	; PRCA4. 5313 - Un lock prior to quit
	4313	"RTN","RCC PCAT",34,0 )
	4314	L -^RCAP( 349.5):DIL OCKTM
	4315	"RTN","RCC PCAT",35,0 )
	4316	Q
	4317	"RTN","RCC PCAT",36,0 )
	4318	;
	4319	"RTN","RCC PCAT",37,0 )
	4320	MAIL ;set up and sen d mail mes sage - cop ied from R CCPCML
	4321	"RTN","RCC PCAT",38,0 )
	4322	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	4323	"RTN","RCC PCAT",39,0 )
	4324	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT TRANSMI SSION "_YE AR
	4325	"RTN","RCC PCAT",40,0 )
	4326	S XMDUZ=" AR PACKAGE "
	4327	"RTN","RCC PCAT",41,0 )
	4328	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	4329	CCPC STATE MENTS")=""
	4330	"RTN","RCC PCAT",42,0 )
	4331	S X=$O(^R CT(349.1," B","PY",0) )
	4332	"RTN","RCC PCAT",43,0 )
	4333	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
	4334	(349.1,+X, 3)),U,3) S :$P(X,"@", 2)]"" XMY( X)=""
	4335	"RTN","RCC PCAT",44,0 )
	4336	I $P(X,"@ ",2)']"" D Q
	4337	"RTN","RCC PCAT",45,0 )
	4338	.S ERROR= 6,NM=0 D E RROR
	4339	"RTN","RCC PCAT",46,0 )
	4340	S XMDUZ=" AR PACKAGE "
	4341	"RTN","RCC PCAT",47,0 )
	4342	D XMZ^XMA 2
	4343	"RTN","RCC PCAT",48,0 )
	4344	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	4345	"RTN","RCC PCAT",49,0 )
	4346	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
	4347	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	4348	"RTN","RCC PCAT",50,0 )
	4349	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	4350	"RTN","RCC PCAT",51,0 )
	4351	D ENT1^XM D
	4352	"RTN","RCC PCAT",52,0 )
	4353	D NOW^%DT C
	4354	"RTN","RCC PCAT",53,0 )
	4355	K ^TMP($J ,"MSG")
	4356	"RTN","RCC PCAT",54,0 )
	4357	Q
	4358	"RTN","RCC PCAT",55,0 )
	4359	;
	4360	"RTN","RCC PCAT",56,0 )
	4361	SCHED(SITE ) ; Deter mine the d ate and ti me for Tra nsmit base d upon Sit e Code an
	4362	d table AI TC provide d
	4363	"RTN","RCC PCAT",57,0 )
	4364	; Time wi ll always be 2:00 AM
	4365	"RTN","RCC PCAT",58,0 )
	4366	I SITE>40 1&(SITE<52 0) S DTTIM E=$E(DT,1, 5)_"03.020 000" Q DTT IME
	4367	"RTN","RCC PCAT",59,0 )
	4368	I SITE>51 9&(SITE<54 1) S DTTIM E=$E(DT,1, 5)_"04.020 000" Q DTT IME
	4369	"RTN","RCC PCAT",60,0 )
	4370	I SITE>54 0&(SITE<55 9) S DTTIM E=$E(DT,1, 5)_"05.020 000" Q DTT IME
	4371	"RTN","RCC PCAT",61,0 )
	4372	I SITE>56 0&(SITE<58 1) S DTTIM E=$E(DT,1, 5)_"06.020 000" Q DTT IME
	4373	"RTN","RCC PCAT",62,0 )
	4374	I SITE>58 0&(SITE<59 9) S DTTIM E=$E(DT,1, 5)_"07.020 000" Q DTT IME
	4375	"RTN","RCC PCAT",63,0 )
	4376	I SITE>59 9&(SITE<62 0) S DTTIM E=$E(DT,1, 5)_"08.020 000" Q DTT IME
	4377	"RTN","RCC PCAT",64,0 )
	4378	I SITE>61 9&(SITE<64 1) S DTTIM E=$E(DT,1, 5)_"09.020 000" Q DTT IME
	4379	"RTN","RCC PCAT",65,0 )
	4380	I SITE>64 1&(SITE<65 8) S DTTIM E=$E(DT,1, 5)_"10.020 000" Q DTT IME
	4381	"RTN","RCC PCAT",66,0 )
	4382	I SITE>65 7&(SITE<67 5) S DTTIM E=$E(DT,1, 5)_"11.020 000" Q DTT IME
	4383	"RTN","RCC PCAT",67,0 )
	4384	I SITE>67 4&(SITE<75 8) S DTTIM E=$E(DT,1, 5)_"12.020 000" Q DTT IME
	4385	"RTN","RCC PCAT",68,0 )
	4386	S DTTIME= ""
	4387	"RTN","RCC PCAT",69,0 )
	4388	Q DTTIME
	4389	"RTN","RCC PCAT",70,0 )
	4390	;
	4391	"RTN","RCC PCAT",71,0 )
	4392	MANBLD ; Build and Transmit t he Annual Payment St atement af ter initia l yearly
	4393	transmissi on
	4394	"RTN","RCC PCAT",72,0 )
	4395	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	4396	"RTN","RCC PCAT",73,0 )
	4397	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	4398	"RTN","RCC PCAT",74,0 )
	4399	; PRCA4. 5313 - Un lock prior to transm itting
	4400	"RTN","RCC PCAT",75,0 )
	4401	L -^RCAP( 349.5):DIL OCKTM
	4402	"RTN","RCC PCAT",76,0 )
	4403	;
	4404	"RTN","RCC PCAT",77,0 )
	4405	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	4406	"RTN","RCC PCAT",78,0 )
	4407	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	4408	"RTN","RCC PCAT",79,0 )
	4409	S YEAR("E XT")=20_$E (YEAR,2,3)
	4410	"RTN","RCC PCAT",80,0 )
	4411	S DATE=$P ($G(^RCAP( 349.5,$P(^ RCAP(349.5 ,0),U,4),0 )),U,6)
	4412	"RTN","RCC PCAT",81,0 )
	4413	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	4414	"RTN","RCC PCAT",82,0 )
	4415	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_".
	4416	"
	4417	"RTN","RCC PCAT",83,0 )
	4418	S DIR(0)= "YAO"
	4419	"RTN","RCC PCAT",84,0 )
	4420	S DIR("B" )="N"
	4421	"RTN","RCC PCAT",85,0 )
	4422	S DIR("A" )="Do you want to Bu ild and Tr ansmit the file for "_YEAR("EX T")_" aga
	4423	in? "
	4424	"RTN","RCC PCAT",86,0 )
	4425	S DIR("?? ")="^D MAN HLP^RCCPCA T"
	4426	"RTN","RCC PCAT",87,0 )
	4427	D ^DIR
	4428	"RTN","RCC PCAT",88,0 )
	4429	I $E(X)'= "Y" Q
	4430	"RTN","RCC PCAT",89,0 )
	4431	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	4432	"RTN","RCC PCAT",90,0 )
	4433	S ZTIO="" ,ZTRTN="EN ^RCCPCAP(" _YEAR_","_ """F"""_", "_""""""_" )"
	4434	"RTN","RCC PCAT",91,0 )
	4435	S ZTDESC= "Build Ann ual Paymen t Statemen t File"
	4436	"RTN","RCC PCAT",92,0 )
	4437	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	4438	"RTN","RCC PCAT",93,0 )
	4439	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	4440	"RTN","RCC PCAT",94,0 )
	4441	Q
	4442	"RTN","RCC PCAT",95,0 )
	4443	;
	4444	"RTN","RCC PCAT",96,0 )
	4445	RETRANS ; Retransmi t the exis ting file and allow user to se lect date and time
	4446	"RTN","RCC PCAT",97,0 )
	4447	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	4448	"RTN","RCC PCAT",98,0 )
	4449	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	4450	"RTN","RCC PCAT",99,0 )
	4451	; PRCA4. 5313 - Un lock prior to retran smitting
	4452	"RTN","RCC PCAT",100, 0)
	4453	L -^RCAP( 349.5):DIL OCKTM
	4454	"RTN","RCC PCAT",101, 0)
	4455	;
	4456	"RTN","RCC PCAT",102, 0)
	4457	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	4458	"RTN","RCC PCAT",103, 0)
	4459	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	4460	"RTN","RCC PCAT",104, 0)
	4461	S YEAR("E XT")=20_$E (YEAR,2,3)
	4462	"RTN","RCC PCAT",105, 0)
	4463	S DATE=$P ($G(^RCAP( 349.5,$P(^ RCAP(349.5 ,0),U,4),0 )),U,6)
	4464	"RTN","RCC PCAT",106, 0)
	4465	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	4466	"RTN","RCC PCAT",107, 0)
	4467	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_".
	4468	"
	4469	"RTN","RCC PCAT",108, 0)
	4470	S DIR(0)= "YAO"
	4471	"RTN","RCC PCAT",109, 0)
	4472	S DIR("B" )="N"
	4473	"RTN","RCC PCAT",110, 0)
	4474	S DIR("A" )="Do you want to Re transmit t he existin g file for "_YEAR("E XT")_" ag
	4475	ain? "
	4476	"RTN","RCC PCAT",111, 0)
	4477	S DIR("?? ")="^D RET HLP^RCCPCA T"
	4478	"RTN","RCC PCAT",112, 0)
	4479	D ^DIR
	4480	"RTN","RCC PCAT",113, 0)
	4481	I $E(X)'= "Y" Q
	4482	"RTN","RCC PCAT",114, 0)
	4483	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	4484	"RTN","RCC PCAT",115, 0)
	4485	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	4486	"RTN","RCC PCAT",116, 0)
	4487	S ZTDESC= "Retransmi t Annual P ayment Sta tement Fil e"
	4488	"RTN","RCC PCAT",117, 0)
	4489	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	4490	"RTN","RCC PCAT",118, 0)
	4491	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	4492	"RTN","RCC PCAT",119, 0)
	4493	Q
	4494	"RTN","RCC PCAT",120, 0)
	4495	;
	4496	"RTN","RCC PCAT",121, 0)
	4497	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	4498	"RTN","RCC PCAT",122, 0)
	4499	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	4500	"RTN","RCC PCAT",123, 0)
	4501	Q
	4502	"RTN","RCC PCAT",124, 0)
	4503	;
	4504	"RTN","RCC PCAT",125, 0)
	4505	MENUERR ; Print err or to scre en if Annu al Payment File has not comple ted for t
	4506	his year
	4507	"RTN","RCC PCAT",126, 0)
	4508	N YEAR
	4509	"RTN","RCC PCAT",127, 0)
	4510	S YEAR=20 _$E(DT,2,3 )-1
	4511	"RTN","RCC PCAT",128, 0)
	4512	W !!,"The Build and Transmit of the Ann ual Paymen t File for "_YEAR_" has not c
	4513	ompleted."
	4514	"RTN","RCC PCAT",129, 0)
	4515	W !,"You may not us e this opt ion until it complet es.",!
	4516	"RTN","RCC PCAT",130, 0)
	4517	D PAUSE^V ALM1
	4518	"RTN","RCC PCAT",131, 0)
	4519	Q
	4520	"RTN","RCC PCAT",132, 0)
	4521	;
	4522	"RTN","RCC PCAT",133, 0)
	4523	MANHLP ; "??" Help for MANBLD and RETRA NS
	4524	"RTN","RCC PCAT",134, 0)
	4525	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Build an d Retransm it file."
	4526	"RTN","RCC PCAT",135, 0)
	4527	Q
	4528	"RTN","RCC PCAT",136, 0)
	4529	;
	4530	"RTN","RCC PCAT",137, 0)
	4531	RETHLP ; "??" Help for MANBLD and RETRA NS
	4532	"RTN","RCC PCAT",138, 0)
	4533	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Retransm it file."
	4534	"RTN","RCC PCAT",139, 0)
	4535	Q
	4536	"RTN","RCC PCBJ")
	4537	0^5^B94660 54^B628849 1
	4538	"RTN","RCC PCBJ",1,0)
	4539	RCCPCBJ ;W ASH-ISC@AL TOONA,PA/N YB-Backgro und Driver for CCPC ;1/7/97 9 :42 AM
	4540	"RTN","RCC PCBJ",2,0)
	4541	;;4.5;Acc ounts Rece ivable;3 4,76,130,1 53,166,195 ,217,237,3 07,313;M ar 20, 19
	4542	95;Build 1 13
	4543	"RTN","RCC PCBJ",3,0)
	4544	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	4545	"RTN","RCC PCBJ",4,0)
	4546	EN ;Starts the backg round job for CCPC 5 days befo re stateme nt day
	4547	"RTN","RCC PCBJ",5,0)
	4548	N X,X1,X2 ,X3,ZTRTN, ZTIO,ZTDTH ,ZTSK,ZTDE SC,SDT,RCF ULL
	4549	"RTN","RCC PCBJ",6,0)
	4550	;D ACK P RCA4.531 3 - Moved into OPEN
	4551	"RTN","RCC PCBJ",7,0)
	4552	D ;run t he cbs nig htly accou nt update program ev eryday
	4553	"RTN","RCC PCBJ",8,0)
	4554	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	4555	"RTN","RCC PCBJ",9,0)
	4556	.S RCFULL =0 ;do not send the full debto r list
	4557	"RTN","RCC PCBJ",10,0 )
	4558	.S ZTIO=" ",ZTRTN="D EBTOR^PRCA CPS1"
	4559	"RTN","RCC PCBJ",11,0 )
	4560	.S ZTDESC ="CBS NIGH TLY ACCOUN T UPDATE P ROGRAM",ZT DTH=$H
	4561	"RTN","RCC PCBJ",12,0 )
	4562	.D ^%ZTLO AD
	4563	"RTN","RCC PCBJ",13,0 )
	4564	;
	4565	"RTN","RCC PCBJ",14,0 )
	4566	I $$DOW^X LFDT(DT,1) =3 D ;run the cbs a uto-correc tion progr am on Wedn esdays
	4567	"RTN","RCC PCBJ",15,0 )
	4568	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	4569	"RTN","RCC PCBJ",16,0 )
	4570	.S ZTIO=" ",ZTRTN="S TART^PRCAC PS",ZTSAVE ("RCFULL") =""
	4571	"RTN","RCC PCBJ",17,0 )
	4572	.S ZTDESC ="PATIENT STATEMENTS AUTO-CORR ECTION PRO GRAM",ZTDT H=$H
	4573	"RTN","RCC PCBJ",18,0 )
	4574	.D ^%ZTLO AD
	4575	"RTN","RCC PCBJ",19,0 )
	4576	;
	4577	"RTN","RCC PCBJ",20,0 )
	4578	; PRCA4. 5313 - Ru n the Annu al Payment Statement Build and Transmit
	4579	"RTN","RCC PCBJ",21,0 )
	4580	; on Janu ary 2nd of each year for the p revious ye ar
	4581	"RTN","RCC PCBJ",22,0 )
	4582	I $E(DT,4 ,7)="0102" D
	4583	"RTN","RCC PCBJ",23,0 )
	4584	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	4585	"RTN","RCC PCBJ",24,0 )
	4586	. S ZTIO= "",ZTRTN=" EN^RCCPCAP ",ZTDTH=$H
	4587	"RTN","RCC PCBJ",25,0 )
	4588	. S ZTDES C="ANNUAL PAYMENT ST ATEMENT BU ILD AND TR ANSMIT"
	4589	"RTN","RCC PCBJ",26,0 )
	4590	. D ^%ZTL OAD
	4591	"RTN","RCC PCBJ",27,0 )
	4592	;
	4593	"RTN","RCC PCBJ",28,0 )
	4594	; PRCA4. 5313 - Ru n the Annu al Payment Error Rep ort on Mar ch, June, September
	4595	and
	4596	"RTN","RCC PCBJ",29,0 )
	4597	; Decembe r 15th
	4598	"RTN","RCC PCBJ",30,0 )
	4599	I $E(DT,4 ,5)="03"!( $E(DT,4,5) ="06")!($E (DT,4,5)=" 09")!($E(D T,4,5)=12) D
	4600	"RTN","RCC PCBJ",31,0 )
	4601	. I $E(DT ,6,7)'=15 Q
	4602	"RTN","RCC PCBJ",32,0 )
	4603	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	4604	"RTN","RCC PCBJ",33,0 )
	4605	. S ZTIO= "",ZTRTN=" EN^RCCPCAR ",ZTDTH=$H
	4606	"RTN","RCC PCBJ",34,0 )
	4607	. S ZTDES C="ANNUAL PAYMENT ER ROR REPORT "
	4608	"RTN","RCC PCBJ",35,0 )
	4609	. D ^%ZTL OAD
	4610	"RTN","RCC PCBJ",36,0 )
	4611	;
	4612	"RTN","RCC PCBJ",37,0 )
	4613	I DT'<$P( $G(^RC(342 ,1,30)),"^ ",1)&(DT'> $P($G(^RC( 342,1,30)) ,"^",2)) D ^RCEXINA
	4614	D
	4615	"RTN","RCC PCBJ",38,0 )
	4616	;
	4617	"RTN","RCC PCBJ",39,0 )
	4618	; PRCA4. 5313 - Se t Statemen t Date to two days i n future a nd save fo r Job
	4619	"RTN","RCC PCBJ",40,0 )
	4620	S X1=DT,X 2=2 D C^%D TC S SDT=X
	4621	"RTN","RCC PCBJ",41,0 )
	4622	S ZTSAVE( "SDT")=SDT
	4623	"RTN","RCC PCBJ",42,0 )
	4624	S ZTIO="" ,ZTRTN="OP EN^RCCPCBJ ",ZTDESC=" CBSS PATIE NT STATEME NT"
	4625	"RTN","RCC PCBJ",43,0 )
	4626	S ZTDTH=$ H D ^%ZTLO AD
	4627	"RTN","RCC PCBJ",44,0 )
	4628	Q
	4629	"RTN","RCC PCBJ",45,0 )
	4630	OPEN ;Upda te Open st atus bills to Active or Cancel lation sta tus
	4631	"RTN","RCC PCBJ",46,0 )
	4632	N DAY,BN, DEBTOR,DA, DIE,DR,P,A MT,DATE
	4633	"RTN","RCC PCBJ",47,0 )
	4634	N ZTSAVE, ZTRTN,ZTDE SC,ZTASK,% ZIS,ZTDTH
	4635	"RTN","RCC PCBJ",48,0 )
	4636	; PRCA4. 5313 - Ch eck the ac knowledgem ent for pr evious mon th
	4637	"RTN","RCC PCBJ",49,0 )
	4638	D TRANCHK ^RCCPCSV1
	4639	"RTN","RCC PCBJ",50,0 )
	4640	; PRCA4. 5313 - Se t DATE and day of mo nth from S DT and pro cess that date's de
	4641	btors
	4642	"RTN","RCC PCBJ",51,0 )
	4643	S DATE=SD T,DAY=+$E( SDT,6,7),D EBTOR=""
	4644	"RTN","RCC PCBJ",52,0 )
	4645	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	4646	"RTN","RCC PCBJ",53,0 )
	4647	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'B
	4648	N D
	4649	"RTN","RCC PCBJ",54,0 )
	4650	..S AMT=0 F P=1:1:5 S AMT=$P( $G(^PRCA(4 30,+BN,7)) ,"^",P)+AM T
	4651	"RTN","RCC PCBJ",55,0 )
	4652	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )),AMT Q
	4653	"RTN","RCC PCBJ",56,0 )
	4654	..S DIE=" ^PRCA(430, ",DA=+BN,D R="8////^S X="_$S(AM T:$O(^PRCA (430.3,"AC ",102,0))
	4655	,1:$O(^PRC A(430.3,"A C",111,0)) ) D ^DIE K DA,DIE,DR
	4656	"RTN","RCC PCBJ",57,0 )
	4657	..Q
	4658	"RTN","RCC PCBJ",58,0 )
	4659	.Q
	4660	"RTN","RCC PCBJ",59,0 )
	4661	;
	4662	"RTN","RCC PCBJ",60,0 )
	4663	; update patient a ccounts wi th interes t and admi n
	4664	"RTN","RCC PCBJ",61,0 )
	4665	N RCLASDA T
	4666	"RTN","RCC PCBJ",62,0 )
	4667	S RCLASDA T=DATE
	4668	"RTN","RCC PCBJ",63,0 )
	4669	I DT>3010 101 D FIRS TPTY^RCBEC HGS
	4670	"RTN","RCC PCBJ",64,0 )
	4671	; PRCA4. 5313 - Ad ded SDT to process a nd send
	4672	"RTN","RCC PCBJ",65,0 )
	4673	D EN^RCCP CPS(SDT)
	4674	"RTN","RCC PCBJ",66,0 )
	4675	D REFUND
	4676	"RTN","RCC PCBJ",67,0 )
	4677	D EN^RCCP CML(SDT)
	4678	"RTN","RCC PCBJ",68,0 )
	4679	Q
	4680	"RTN","RCC PCBJ",69,0 )
	4681	;
	4682	"RTN","RCC PCBJ",70,0 )
	4683	;
	4684	"RTN","RCC PCBJ",71,0 )
	4685	REFUND ;Up date Open status PRE PAYMENT bi lls to REF UND REVIEW
	4686	"RTN","RCC PCBJ",72,0 )
	4687	; PRCA4. 5313 - Ch anged DAY to stateme nt date
	4688	"RTN","RCC PCBJ",73,0 )
	4689	S DEBTOR= 0,DAY=SDT
	4690	"RTN","RCC PCBJ",74,0 )
	4691	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	4692	"RTN","RCC PCBJ",75,0 )
	4693	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'B
	4694	N D
	4695	"RTN","RCC PCBJ",76,0 )
	4696	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )) S X=$$E N^PRCARFU
	4697	(+BN)
	4698	"RTN","RCC PCBJ",77,0 )
	4699	..Q
	4700	"RTN","RCC PCBJ",78,0 )
	4701	.Q
	4702	"RTN","RCC PCBJ",79,0 )
	4703	Q
	4704	"RTN","RCC PCBJ",80,0 )
	4705	;
	4706	"RTN","RCC PCBJ",81,0 )
	4707	ACK ;CHECK FOR ACKNO WLEDGEMENT S PRCA4. 5313 - No longer us ed
	4708	"RTN","RCC PCBJ",82,0 )
	4709	N DEB,MSG ,NO,RCX,X, X1,X2
	4710	"RTN","RCC PCBJ",83,0 )
	4711	S X1=$$ST D^RCCPCFN, X2=DT D ^% DTC I X>3 D
	4712	"RTN","RCC PCBJ",84,0 )
	4713	. D TRANC HK^RCCPCSV 1
	4714	"RTN","RCC PCBJ",85,0 )
	4715	Q
	4716	"RTN","RCC PCFN1")
	4717	0^7^B68695 13^n/a
	4718	"RTN","RCC PCFN1",1,0 )
	4719	RCCPCFN1 ; ALB/TGH-Ad ditional F unction ca lls for CB SS ;12/31/ 96 9:27 A M
	4720	"RTN","RCC PCFN1",2,0 )
	4721	;;4.5;Acc ounts Rece ivable;3 13;Mar 3 1, 2016;Bu ild 113
	4722	"RTN","RCC PCFN1",3,0 )
	4723	;
	4724	"RTN","RCC PCFN1",4,0 )
	4725	ACSET(NAME ) ; Deter mine the d ay of the month for each new d ebtor to h ave their
	4726	patient s tatement s ent
	4727	"RTN","RCC PCFN1",5,0 )
	4728	; by the site to CB SS for con solidation .
	4729	"RTN","RCC PCFN1",6,0 )
	4730	; Input: NAME = Pa tient's Na me
	4731	"RTN","RCC PCFN1",7,0 )
	4732	; Output: DAY/GROUP = day of month for patient st atement tr ansmission and grou
	4733	p number
	4734	"RTN","RCC PCFN1",8,0 )
	4735	; 0 = if i nvalid fir st charact er of last name
	4736	"RTN","RCC PCFN1",9,0 )
	4737	;
	4738	"RTN","RCC PCFN1",10, 0)
	4739	N LTR,GRO UP,DAY,I
	4740	"RTN","RCC PCFN1",11, 0)
	4741	;
	4742	"RTN","RCC PCFN1",12, 0)
	4743	; Quit if the patie nt name is not cross -reference d in the P atient Fil e (#2) -
	4744	return 0
	4745	"RTN","RCC PCFN1",13, 0)
	4746	Q:'$D(^DP T("B",NAME )) 0
	4747	"RTN","RCC PCFN1",14, 0)
	4748	;
	4749	"RTN","RCC PCFN1",15, 0)
	4750	F I=1,2 S LTR(I)=$E (NAME,I)
	4751	"RTN","RCC PCFN1",16, 0)
	4752	I "AB"[LT R(1) S GRO UP=1,DAY=$ $GRP1(.LTR ) Q DAY_" /"_GROUP
	4753	"RTN","RCC PCFN1",17, 0)
	4754	I "CD"[LT R(1) S GRO UP=2,DAY=$ $GRP2(.LTR ) Q DAY_" /"_GROUP
	4755	"RTN","RCC PCFN1",18, 0)
	4756	I "EFIQ"[ LTR(1) S G ROUP=3,DAY =$$GRP3(.L TR) Q DAY _"/"_GROUP
	4757	"RTN","RCC PCFN1",19, 0)
	4758	I "GH"[LT R(1) S GRO UP=4,DAY=$ $GRP4(.LTR ) Q DAY_" /"_GROUP
	4759	"RTN","RCC PCFN1",20, 0)
	4760	I "JK"[LT R(1) S GRO UP=5,DAY=$ $GRP5(.LTR ) Q DAY_" /"_GROUP
	4761	"RTN","RCC PCFN1",21, 0)
	4762	I "LO"[LT R(1) S GRO UP=6,DAY=$ $GRP6(.LTR ) Q DAY_" /"_GROUP
	4763	"RTN","RCC PCFN1",22, 0)
	4764	I "MN"[LT R(1) S GRO UP=7,DAY=$ $GRP7(.LTR ) Q DAY_" /"_GROUP
	4765	"RTN","RCC PCFN1",23, 0)
	4766	I "T"[LTR (1) S GROU P=8,DAY=$$ GRP8(.LTR) Q DAY_"/ "_GROUP
	4767	"RTN","RCC PCFN1",24, 0)
	4768	I "R"[LTR (1) S GROU P=9,DAY=$$ GRP9(.LTR) Q DAY_"/ "_GROUP
	4769	"RTN","RCC PCFN1",25, 0)
	4770	I "SV"[LT R(1) S GRO UP=10,DAY= $$GRP10(.L TR) Q DAY _"/"_GROUP
	4771	"RTN","RCC PCFN1",26, 0)
	4772	I "PUXYZ" [LTR(1) S GROUP=11,D AY=$$GRP11 (.LTR) Q DAY_"/"_GR OUP
	4773	"RTN","RCC PCFN1",27, 0)
	4774	I "W"[LTR (1) S GROU P=12,DAY=$ $GRP12(.LT R) Q DAY_ "/"_GROUP
	4775	"RTN","RCC PCFN1",28, 0)
	4776	;
	4777	"RTN","RCC PCFN1",29, 0)
	4778	Q 0
	4779	"RTN","RCC PCFN1",30, 0)
	4780	;
	4781	"RTN","RCC PCFN1",31, 0)
	4782	GRP1(LTR) ;AB
	4783	"RTN","RCC PCFN1",32, 0)
	4784	;
	4785	"RTN","RCC PCFN1",33, 0)
	4786	I LTR(1)= "A" S DAY= 1
	4787	"RTN","RCC PCFN1",34, 0)
	4788	I LTR(1)= "B" D
	4789	"RTN","RCC PCFN1",35, 0)
	4790	. I "AU"[ LTR(2) S D AY=1
	4791	"RTN","RCC PCFN1",36, 0)
	4792	. I "AU"' [LTR(2) S DAY=2
	4793	"RTN","RCC PCFN1",37, 0)
	4794	;
	4795	"RTN","RCC PCFN1",38, 0)
	4796	Q DAY
	4797	"RTN","RCC PCFN1",39, 0)
	4798	;
	4799	"RTN","RCC PCFN1",40, 0)
	4800	GRP2(LTR) ;CD
	4801	"RTN","RCC PCFN1",41, 0)
	4802	;
	4803	"RTN","RCC PCFN1",42, 0)
	4804	I LTR(1)= "D" S DAY= 4
	4805	"RTN","RCC PCFN1",43, 0)
	4806	I LTR(1)= "C" D
	4807	"RTN","RCC PCFN1",44, 0)
	4808	. I "IRU" [LTR(2) S DAY=4
	4809	"RTN","RCC PCFN1",45, 0)
	4810	. I "IRU" '[LTR(2) S DAY=6
	4811	"RTN","RCC PCFN1",46, 0)
	4812	;
	4813	"RTN","RCC PCFN1",47, 0)
	4814	Q DAY
	4815	"RTN","RCC PCFN1",48, 0)
	4816	;
	4817	"RTN","RCC PCFN1",49, 0)
	4818	GRP3(LTR) ;EFIQ
	4819	"RTN","RCC PCFN1",50, 0)
	4820	;
	4821	"RTN","RCC PCFN1",51, 0)
	4822	S DAY=7
	4823	"RTN","RCC PCFN1",52, 0)
	4824	;
	4825	"RTN","RCC PCFN1",53, 0)
	4826	Q DAY
	4827	"RTN","RCC PCFN1",54, 0)
	4828	;
	4829	"RTN","RCC PCFN1",55, 0)
	4830	GRP4(LTR) ;GH
	4831	"RTN","RCC PCFN1",56, 0)
	4832	;
	4833	"RTN","RCC PCFN1",57, 0)
	4834	I LTR(1)= "G" S DAY= 8
	4835	"RTN","RCC PCFN1",58, 0)
	4836	I LTR(1)= "H" D
	4837	"RTN","RCC PCFN1",59, 0)
	4838	. I "E"[L TR(2) S DA Y=8
	4839	"RTN","RCC PCFN1",60, 0)
	4840	. I "E"'[ LTR(2) S D AY=10
	4841	"RTN","RCC PCFN1",61, 0)
	4842	;
	4843	"RTN","RCC PCFN1",62, 0)
	4844	Q DAY
	4845	"RTN","RCC PCFN1",63, 0)
	4846	;
	4847	"RTN","RCC PCFN1",64, 0)
	4848	GRP5(LTR) ;JK
	4849	"RTN","RCC PCFN1",65, 0)
	4850	;
	4851	"RTN","RCC PCFN1",66, 0)
	4852	S DAY=12
	4853	"RTN","RCC PCFN1",67, 0)
	4854	;
	4855	"RTN","RCC PCFN1",68, 0)
	4856	Q DAY
	4857	"RTN","RCC PCFN1",69, 0)
	4858	;
	4859	"RTN","RCC PCFN1",70, 0)
	4860	GRP6(LTR) ;LO
	4861	"RTN","RCC PCFN1",71, 0)
	4862	;
	4863	"RTN","RCC PCFN1",72, 0)
	4864	S DAY=14
	4865	"RTN","RCC PCFN1",73, 0)
	4866	;
	4867	"RTN","RCC PCFN1",74, 0)
	4868	Q DAY
	4869	"RTN","RCC PCFN1",75, 0)
	4870	;
	4871	"RTN","RCC PCFN1",76, 0)
	4872	GRP7(LTR) ;MN
	4873	"RTN","RCC PCFN1",77, 0)
	4874	;
	4875	"RTN","RCC PCFN1",78, 0)
	4876	I LTR(1)= "N" S DAY= 17
	4877	"RTN","RCC PCFN1",79, 0)
	4878	I LTR(1)= "M" D
	4879	"RTN","RCC PCFN1",80, 0)
	4880	. I "CI"[ LTR(2) S D AY=17
	4881	"RTN","RCC PCFN1",81, 0)
	4882	. I "CI"' [LTR(2) S DAY=15
	4883	"RTN","RCC PCFN1",82, 0)
	4884	;
	4885	"RTN","RCC PCFN1",83, 0)
	4886	Q DAY
	4887	"RTN","RCC PCFN1",84, 0)
	4888	;
	4889	"RTN","RCC PCFN1",85, 0)
	4890	GRP8(LTR) ;T
	4891	"RTN","RCC PCFN1",86, 0)
	4892	;
	4893	"RTN","RCC PCFN1",87, 0)
	4894	I "ABCDE" [LTR(2) S DAY=19
	4895	"RTN","RCC PCFN1",88, 0)
	4896	I "FGH"[L TR(2) S DA Y=22
	4897	"RTN","RCC PCFN1",89, 0)
	4898	I "ABCDEF GH"'[LTR(2 ) S DAY=17
	4899	"RTN","RCC PCFN1",90, 0)
	4900	;
	4901	"RTN","RCC PCFN1",91, 0)
	4902	Q DAY
	4903	"RTN","RCC PCFN1",92, 0)
	4904	;
	4905	"RTN","RCC PCFN1",93, 0)
	4906	GRP9(LTR) ;R
	4907	"RTN","RCC PCFN1",94, 0)
	4908	;
	4909	"RTN","RCC PCFN1",95, 0)
	4910	S DAY=19
	4911	"RTN","RCC PCFN1",96, 0)
	4912	;
	4913	"RTN","RCC PCFN1",97, 0)
	4914	Q DAY
	4915	"RTN","RCC PCFN1",98, 0)
	4916	;
	4917	"RTN","RCC PCFN1",99, 0)
	4918	GRP10(LTR) ;SV
	4919	"RTN","RCC PCFN1",100 ,0)
	4920	;
	4921	"RTN","RCC PCFN1",101 ,0)
	4922	I LTR(1)= "V" S DAY= 22
	4923	"RTN","RCC PCFN1",102 ,0)
	4924	I LTR(1)= "S" D
	4925	"RTN","RCC PCFN1",103 ,0)
	4926	. I "CHIM "[LTR(2) S DAY=22
	4927	"RTN","RCC PCFN1",104 ,0)
	4928	. I "CHIM "'[LTR(2) S DAY=21
	4929	"RTN","RCC PCFN1",105 ,0)
	4930	;
	4931	"RTN","RCC PCFN1",106 ,0)
	4932	Q DAY
	4933	"RTN","RCC PCFN1",107 ,0)
	4934	;
	4935	"RTN","RCC PCFN1",108 ,0)
	4936	GRP11(LTR) ;PUXYZ
	4937	"RTN","RCC PCFN1",109 ,0)
	4938	;
	4939	"RTN","RCC PCFN1",110 ,0)
	4940	S DAY=24
	4941	"RTN","RCC PCFN1",111 ,0)
	4942	;
	4943	"RTN","RCC PCFN1",112 ,0)
	4944	Q DAY
	4945	"RTN","RCC PCFN1",113 ,0)
	4946	;
	4947	"RTN","RCC PCFN1",114 ,0)
	4948	GRP12(LTR) ;W
	4949	"RTN","RCC PCFN1",115 ,0)
	4950	;
	4951	"RTN","RCC PCFN1",116 ,0)
	4952	S DAY=26
	4953	"RTN","RCC PCFN1",117 ,0)
	4954	;
	4955	"RTN","RCC PCFN1",118 ,0)
	4956	Q DAY
	4957	"RTN","RCC PCML")
	4958	0^8^B65098 323^B47881 024
	4959	"RTN","RCC PCML",1,0)
	4960	RCCPCML ;W ASH-ISC@AL TOONA,PA/L DB-Send CC PC transmi ssion ;12/ 19/96 4:1 6 PM
	4961	"RTN","RCC PCML",2,0)
	4962	V ;;4.5;Ac counts Rec eivable;** 34,80,93,1 18,133,140 ,160,165,1 87,195,206 ,223,260,
	4963	313**;Mar 20, 1995;B uild 113
	4964	"RTN","RCC PCML",3,0)
	4965	;;Per VHA Directive 2004-038, this rout ine should not be mo dified.
	4966	"RTN","RCC PCML",4,0)
	4967	TRAN ;call from RCCP C TRANSMIT option to interacti vely allow transmiss ion of CC
	4968	PC mesages
	4969	"RTN","RCC PCML",5,0)
	4970	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	4971	"RTN","RCC PCML",6,0)
	4972	N %DT,DTO UT,SDT,X,Y ,ZTRTN,ZTS AVE,ZTDESC ,ZTIO,IEN
	4973	"RTN","RCC PCML",7,0)
	4974	I '$D(^XU SEC("RCCPC TRANSMIT" ,DUZ)) W * 7,*7,!,"Yo u do not h ave access to do th
	4975	is." Q
	4976	"RTN","RCC PCML",8,0)
	4977	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	4978	"RTN","RCC PCML",9,0)
	4979	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmi
	4980	tted. Try again lat er." Q
	4981	"RTN","RCC PCML",10,0 )
	4982	S %DT="AE XP"
	4983	"RTN","RCC PCML",11,0 )
	4984	S %DT("A" )="Enter s tatement d ate as it will appea r on these statement s: "
	4985	"RTN","RCC PCML",12,0 )
	4986	; PRCA4. 5313 - Ch anged to a llow for s eparate da tes for st atements b ased upon
	4987	last name
	4988	"RTN","RCC PCML",13,0 )
	4989	D ^%DT Q: (X="^")!($ D(DTOUT))! (Y=-1)
	4990	"RTN","RCC PCML",14,0 )
	4991	S SDT=Y
	4992	"RTN","RCC PCML",15,0 )
	4993	; PRCA4. 5313 - Un lock prior to quitti ng
	4994	"RTN","RCC PCML",16,0 )
	4995	I '$D(^RC PS(349.2," STDT",SDT) ) W !,"The re is not a CCPC fil e for this date." L
	4996	-^RCPS(34 9.2):DILOC KTM Q
	4997	"RTN","RCC PCML",17,0 )
	4998	; PRCA4. 5313 - Un lock prior to quitti ng
	4999	"RTN","RCC PCML",18,0 )
	5000	S IEN=$O( ^RCPS(349. 2,"STDT",S DT,0)) I ' $P($P($G(^ RCPS(349.2 ,IEN,0))," ^",10),".
	5001	") D Q
	5002	"RTN","RCC PCML",19,0 )
	5003	. W !,"Yo ur CBSS st atement fi le (349.2) is corrup ted. Pleas e rebuild it."
	5004	"RTN","RCC PCML",20,0 )
	5005	. L -^RCP S(349.2):D ILOCKTM
	5006	"RTN","RCC PCML",21,0 )
	5007	; PRCA4. 5313 - Un lock prior to jobbin g off
	5008	"RTN","RCC PCML",22,0 )
	5009	L -^RCPS( 349.2):DIL OCKTM
	5010	"RTN","RCC PCML",23,0 )
	5011	; PRCA4. 5313 - Al lows for m ultiple st atement da tes
	5012	"RTN","RCC PCML",24,0 )
	5013	S ZTSAVE( "SDT")=SDT ,ZTRTN="RE TRAN^RCCPC ML",ZTIO=" ",ZTDESC=" Re-transmi t CBSS pa
	5014	tient stat ements -us er activat ed"
	5015	"RTN","RCC PCML",25,0 )
	5016	D ^%ZTLOA D
	5017	"RTN","RCC PCML",26,0 )
	5018	Q
	5019	"RTN","RCC PCML",27,0 )
	5020	;
	5021	"RTN","RCC PCML",28,0 )
	5022	EN(SDT) ;c alled from backgroun d job - PR CA4.5313 Added SDT for backg round job
	5023	call
	5024	"RTN","RCC PCML",29,0 )
	5025	N DA,DIK, LPRINT
	5026	"RTN","RCC PCML",30,0 )
	5027	D NOW^%DT C
	5028	"RTN","RCC PCML",31,0 )
	5029	RETRAN N D A,DIK,ERRO R,RCT,X,X1 ,DEB
	5030	"RTN","RCC PCML",32,0 )
	5031	; PRCA4. 5313 - Pr ovides err or for inc omplete bu ild of 349 .2
	5032	"RTN","RCC PCML",33,0 )
	5033	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)
	5034	) S ERROR= 1,NM=0 D E RROR Q
	5035	"RTN","RCC PCML",34,0 )
	5036	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with Error .
	5037	"RTN","RCC PCML",35,0 )
	5038	L +^RCPS( 349.2):DIL OCKTM I '$ T S ERROR= 11,NM=0 D ERROR
	5039	"RTN","RCC PCML",36,0 )
	5040	I $G(ERRO R) D EXIT Q
	5041	"RTN","RCC PCML",37,0 )
	5042	K ^TMP($J )
	5043	"RTN","RCC PCML",38,0 )
	5044	; PRCA4. 5313 - Re moves exis ting 349 f or this da te
	5045	"RTN","RCC PCML",39,0 )
	5046	S X1=0 F S X1=$O(^ RCT(349,"S DT",+$E(SD T,6,7),X1) ) Q:X1="" I $P(^RCT (349,X1,0
	5047	),U,2)="PS " S DA=X1, DIK="^RCT( 349," D ^D IK
	5048	"RTN","RCC PCML",40,0 )
	5049	F X="PA", "IS","IT" S RCT=$O(^ RCT(349.1, "B",X,0)) I RCT K ^R CT(349.1,+ RCT,4,+$E
	5050	(SDT,6,7))
	5051	"RTN","RCC PCML",41,0 )
	5052	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
	5053	,TAMT,TMSG ,SZ,TRDESC
	5054	"RTN","RCC PCML",42,0 )
	5055	D DT^DICR W
	5056	"RTN","RCC PCML",43,0 )
	5057	S (ERROR, RTY)=0
	5058	"RTN","RCC PCML",44,0 )
	5059	S X=$O(^R CT(349.1," B","PS",0) )
	5060	"RTN","RCC PCML",45,0 )
	5061	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^",3)
	5062	"RTN","RCC PCML",46,0 )
	5063	I X']"" S ERROR=6,N M=0 D ERRO R,EXIT Q
	5064	"RTN","RCC PCML",47,0 )
	5065	D PHCT I 'PHCT S ER ROR=1,NM=0 D ERROR,E XIT Q
	5066	"RTN","RCC PCML",48,0 )
	5067	S MTOT=$O (^TMP($J," MCT",""),- 1)
	5068	"RTN","RCC PCML",49,0 )
	5069	; PRCA4. 5313 - Re set MTOT a nd MCT(1) for multip le dates o n one day
	5070	"RTN","RCC PCML",50,0 )
	5071	S MCT(1)= $O(^TMP($J ,"MCT","") )
	5072	"RTN","RCC PCML",51,0 )
	5073	S MTOT=MT OT-(MCT(1) -1)
	5074	"RTN","RCC PCML",52,0 )
	5075	S MCT(1)= 0
	5076	"RTN","RCC PCML",53,0 )
	5077	S MCT=0 F S MCT=$O (^TMP($J," MCT",MCT)) Q:'MCT D PS
	5078	"RTN","RCC PCML",54,0 )
	5079	EXIT D ERR ML^RCCPCML 1
	5080	"RTN","RCC PCML",55,0 )
	5081	K SDT,^TM P($J)
	5082	"RTN","RCC PCML",56,0 )
	5083	; PRCA4. 5313 - Un lock prior to exitin g
	5084	"RTN","RCC PCML",57,0 )
	5085	L -^RCPS( 349.2):DIL OCKTM
	5086	"RTN","RCC PCML",58,0 )
	5087	Q
	5088	"RTN","RCC PCML",59,0 )
	5089	;
	5090	"RTN","RCC PCML",60,0 )
	5091	F349 ;Get PS segment entry
	5092	"RTN","RCC PCML",61,0 )
	5093	N DA,D0,D IC,DLAYGO, X
	5094	"RTN","RCC PCML",62,0 )
	5095	S ERROR=0 K DD,DO S DIC="^RCT (349,",DIC (0)="L",DL AYGO=349,X ="PS."_$TR ($$FMTE^X
	5096	LFDT(DT,"2 D"),"/",". ")_"."_RCM D FILE^DI CN
	5097	"RTN","RCC PCML",63,0 )
	5098	I Y<0 S R TY=RTY+1 G F349:RTY< 4 S ERROR= 2,NM=0 D E RROR Q
	5099	"RTN","RCC PCML",64,0 )
	5100	S PSN=+Y
	5101	"RTN","RCC PCML",65,0 )
	5102	Q
	5103	"RTN","RCC PCML",66,0 )
	5104	;
	5105	"RTN","RCC PCML",67,0 )
	5106	PS ;Build PS,PH,PD s egments an d messages
	5107	"RTN","RCC PCML",68,0 )
	5108	S PSN=$O( ^TMP($J,"M CT",MCT,0) )
	5109	"RTN","RCC PCML",69,0 )
	5110	; PRCA4. 5313 - In crement Co unter for internal s torage
	5111	"RTN","RCC PCML",70,0 )
	5112	S MCT(1)= MCT(1)+1
	5113	"RTN","RCC PCML",71,0 )
	5114	; PRCA4. 5313 - Up date to ne w formatti ng
	5115	"RTN","RCC PCML",72,0 )
	5116	S $P(^RCT (349,+PSN, 0),"^",3,1 0)=MCT(1)_ "^"_MTOT_" ^"_$$SITE^ RCMSITE()_ "^"_$$FP^
	5117	RCCPCFN_"^ "_+^TMP($J ,"MCT",MCT )_"^"_$P(^ TMP($J,"MC T",MCT),"^ ",2)_"^"_$ $DAT^RCCP
	5118	CFN(SDT)_" ^"_$$DAT^R CCPCFN(DT)
	5119	"RTN","RCC PCML",73,0 )
	5120	S LN=+PSN ,^TMP($J," MSG",LN)=$ P($G(^RCT( 349,+PSN,0 )),"^",2,1 0)_"^\|"
	5121	"RTN","RCC PCML",74,0 )
	5122	; Reforma t Statemen t Date to Internal F ormat
	5123	"RTN","RCC PCML",75,0 )
	5124	S $P(^RCT (349,+PSN, 0),"^",9)= SDT
	5125	"RTN","RCC PCML",76,0 )
	5126	S MPT1=$P (^TMP($J," MCT",MCT), "^",3)
	5127	"RTN","RCC PCML",77,0 )
	5128	; PRCA4. 5313 - Su btract num ber of rec ords from last recor d to find number be
	5129	fore file starting p oint
	5130	"RTN","RCC PCML",78,0 )
	5131	S PT=MPT1 -$P(^TMP($ J,"MCT",MC T),"^",1)
	5132	"RTN","RCC PCML",79,0 )
	5133	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:PT="" Q :PT=$O(^RC PS(349.2,+ ($P(^TMP(
	5134	$J,"MCT",M CT),"^",3) ))) D
	5135	"RTN","RCC PCML",80,0 )
	5136	.Q:$D(^TM P($J,"ERRP T",+PT))
	5137	"RTN","RCC PCML",81,0 )
	5138	.S PT0=^R CPS(349.2, +PT,0)
	5139	"RTN","RCC PCML",82,0 )
	5140	. ; PRCA* 4.5*313 - Set DEB fr om PTO
	5141	"RTN","RCC PCML",83,0 )
	5142	. S DEB=$ P(PT0,"^")
	5143	"RTN","RCC PCML",84,0 )
	5144	.S LN=LN+ 1 S ^TMP($ J,"MSG",LN )="PH^"_$$ SITE^RCMSI TE_$$KEY^R CCPCFN(+PT )_"^"_$$N
	5145	M^RCCPCFN( +PT)_"^"
	5146	"RTN","RCC PCML",85,0 )
	5147	.S ADD=$G (^RCPS(349 .2,+PT,1))
	5148	"RTN","RCC PCML",86,0 )
	5149	.;
	5150	"RTN","RCC PCML",87,0 )
	5151	.;Remove special ch aracters c ausing pro blems (WIM -0402-2072 8)
	5152	"RTN","RCC PCML",88,0 )
	5153	.I ADD["~ " S ADD=$T R(ADD,"~", "") ;Remov e tilde
	5154	"RTN","RCC PCML",89,0 )
	5155	.I ADD["\| " S ADD=$T R(ADD,"\|", "") ;Remov e the pipe symbol
	5156	"RTN","RCC PCML",90,0 )
	5157	.;
	5158	"RTN","RCC PCML",91,0 )
	5159	.;Debtor needs larg e print (f ont) IF LP RINT=1
	5160	"RTN","RCC PCML",92,0 )
	5161	.S LPRINT =$G(^RCPS( 349.2,+PT, 7)) S:LPRI NT="" LPRI NT=0
	5162	"RTN","RCC PCML",93,0 )
	5163	.;
	5164	"RTN","RCC PCML",94,0 )
	5165	.F P=1:1: 7 S $P(^TM P($J,"MSG" ,LN),"^",P +5)=$S($P( ADD,"^",P) ]"":$P(ADD ,"^",P),1
	5166	:"")
	5167	"RTN","RCC PCML",95,0 )
	5168	.S ^TMP($ J,"MSG",LN )=^TMP($J, "MSG",LN)_ "^"
	5169	"RTN","RCC PCML",96,0 )
	5170	.S LN=LN+ 1
	5171	"RTN","RCC PCML",97,0 )
	5172	.F X=4:1: 8 S $P(AMT ,"^",X-3)= $$HEX^RCCP CFN($P(PT0 ,"^",X))
	5173	"RTN","RCC PCML",98,0 )
	5174	.S ^TMP($ J,"MSG",LN )=AMT_"^"_ $G(^RCPS(3 49.2,+PT,3 ))_"^"_$G( ^RCPS(349. 2,+PT,4))
	5175	_"^"_$O(^R CPS(349.2, +PT,2,""), -1)
	5176	"RTN","RCC PCML",99,0 )
	5177	.S LN=LN+ 1 I $P($G( ^RCD(340,+ DEB,0)),"; ") S ^TMP( $J,"MSG",L N)="^"_$$S ITE^RCMSI
	5178	TE_$$RJ^XL FSTR($TR($ P(^RCD(340 ,+DEB,0)," ;"),".","" ),13,0)
	5179	"RTN","RCC PCML",100, 0)
	5180	.; PRCA5 .4313 - S et ICN wit h Checksum , AR Flag, and Date of Latest Bill ino
	5181	PH data
	5182	"RTN","RCC PCML",101, 0)
	5183	.N PT8 S PT8=$G(^RC PS(349.2,+ PT,8))
	5184	"RTN","RCC PCML",102, 0)
	5185	.S ^TMP($ J,"MSG",LN )=$G(^TMP( $J,"MSG",L N))_"^"_LP RINT_"^"_$ P(PT8,"^") _"V"_$P(P
	5186	T8,"^",2,3 )_"^"_$$DA T^RCCPCFN( $P(PT8,"^" ,4))_"^\|"
	5187	"RTN","RCC PCML",103, 0)
	5188	.S $P(^RC PS(349.2,+ PT,0),"^", 11)=+PSN
	5189	"RTN","RCC PCML",104, 0)
	5190	.S PD=0 F S PD=$O( ^RCPS(349. 2,+PT,2,PD )) Q:'PD I $D(^(PD, 0)) S PD0= ^(0) D
	5191	"RTN","RCC PCML",105, 0)
	5192	..S AMT(0 )=$$HEX^RC CPCFN($P(P D0,"^",3))
	5193	"RTN","RCC PCML",106, 0)
	5194	..;Replac e special characters causing p roblem (PR CA*260)
	5195	"RTN","RCC PCML",107, 0)
	5196	..S TRDES C=$P(PD0," ^",2)
	5197	"RTN","RCC PCML",108, 0)
	5198	..I TRDES C["~" S TR DESC=$TR(T RDESC,"~", " ") ;Rep lace tilde
	5199	"RTN","RCC PCML",109, 0)
	5200	..I TRDES C["\|" S TR DESC=$TR(T RDESC,"\|", " ") ;Rep lace the p ipe symbol
	5201	"RTN","RCC PCML",110, 0)
	5202	..S LN=LN +1,^TMP($J ,"MSG",LN) ="PD^"_$$D AT^RCCPCFN (+PD0)_"^" _TRDESC_"^ "_AMT(0)_
	5203	"^"_$P(PD0 ,"^",4)_"^ \|"
	5204	"RTN","RCC PCML",111, 0)
	5205	S LN=LN+1 ,^TMP($J," MSG",LN)=" ~"
	5206	"RTN","RCC PCML",112, 0)
	5207	; PRCA4. 5313 - Se t all cros s-referenc es for Fil e
	5208	"RTN","RCC PCML",113, 0)
	5209	S DA=+PSN ,DIK="^RCT (349," D I X1^DIK
	5210	"RTN","RCC PCML",114, 0)
	5211	;
	5212	"RTN","RCC PCML",115, 0)
	5213	MAIL ;set up mail me ssage
	5214	"RTN","RCC PCML",116, 0)
	5215	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z
	5216	"RTN","RCC PCML",117, 0)
	5217	S XMSUB=$ $SITE^RCMS ITE()_" CB SS TRANSMI SSION "_SD T
	5218	"RTN","RCC PCML",118, 0)
	5219	S XMDUZ=" AR PACKAGE "
	5220	"RTN","RCC PCML",119, 0)
	5221	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),"^",12) S XMY("G
	5222	.RCCPC STA TEMENTS")= ""
	5223	"RTN","RCC PCML",120, 0)
	5224	S X=$O(^R CT(349.1," B","PS",0) )
	5225	"RTN","RCC PCML",121, 0)
	5226	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^")_" @"_$P($G(
	5227	^RCT(349.1 ,+X,3)),"^ ",3) S:$P( X,"@",2)]" " XMY(X)=" "
	5228	"RTN","RCC PCML",122, 0)
	5229	I $P(X,"@ ",2)']"" D Q
	5230	"RTN","RCC PCML",123, 0)
	5231	.S ERROR= 6,NM=0 D E RROR
	5232	"RTN","RCC PCML",124, 0)
	5233	S XMDUZ=" AR PACKAGE "
	5234	"RTN","RCC PCML",125, 0)
	5235	D XMZ^XMA 2
	5236	"RTN","RCC PCML",126, 0)
	5237	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	5238	"RTN","RCC PCML",127, 0)
	5239	S $P(^RCT (349,+PSN, 0),"^",11, 12)=DT_"^" _XMZ
	5240	"RTN","RCC PCML",128, 0)
	5241	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,
	5242	2,L,0)=^TM P($J,"MSG" ,L(1))
	5243	"RTN","RCC PCML",129, 0)
	5244	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_"^"_L_" ^"_DT
	5245	"RTN","RCC PCML",130, 0)
	5246	D ENT1^XM D
	5247	"RTN","RCC PCML",131, 0)
	5248	D NOW^%DT C
	5249	"RTN","RCC PCML",132, 0)
	5250	S $P(^RCT (349,+PSN, 0),"^",11, 12)=%_"^"_ XMZ
	5251	"RTN","RCC PCML",133, 0)
	5252	K ^TMP($J ,"MSG")
	5253	"RTN","RCC PCML",134, 0)
	5254	Q
	5255	"RTN","RCC PCML",135, 0)
	5256	;
	5257	"RTN","RCC PCML",136, 0)
	5258	PHCT ;PH c ount
	5259	"RTN","RCC PCML",137, 0)
	5260	S (ERROR, PT,PHCT,TA MT,SZ)=0,R CM=1
	5261	"RTN","RCC PCML",138, 0)
	5262	; PRCA4. 5313 - If last reco rd is for this date reset RCM to next va lue
	5263	"RTN","RCC PCML",139, 0)
	5264	N FINAL
	5265	"RTN","RCC PCML",140, 0)
	5266	S FINAL=$ O(^RCT(349 ,"@"),-1)
	5267	"RTN","RCC PCML",141, 0)
	5268	I FINAL,$ P($P(^RCT( 349,FINAL, 0),"^"),". ",2,4)=$TR ($$FMTE^XL FDT(DT,"2D "),"/",".
	5269	") S RCM=$ P($P(^RCT( 349,FINAL, 0),"^"),". ",5)+1
	5270	"RTN","RCC PCML",142, 0)
	5271	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:'PT S E RROR=0 D I ERROR,(E RROR<3) Q
	5272	"RTN","RCC PCML",143, 0)
	5273	. ; PRCA* 4.5*313 - Set DEB to Debtor nu mber
	5274	"RTN","RCC PCML",144, 0)
	5275	. S DEB=$ P(^RCPS(34 9.2,PT,0), "^")
	5276	"RTN","RCC PCML",145, 0)
	5277	.S SZ(1)= 0 D ERRCHK Q:ERROR
	5278	"RTN","RCC PCML",146, 0)
	5279	.S PT0=^R CPS(349.2, +PT,0)
	5280	"RTN","RCC PCML",147, 0)
	5281	.S PHCT=P HCT+1
	5282	"RTN","RCC PCML",148, 0)
	5283	.S SZ=550 +SZ,SZ(1)= 550
	5284	"RTN","RCC PCML",149, 0)
	5285	.S:$G(^RC PS(349.2,+ PT,1))]"" SZ=SZ+$L(^ (1)),SZ(1) =SZ(1)+$L( ^(1))
	5286	"RTN","RCC PCML",150, 0)
	5287	.S:$G(^RC PS(349.2,+ PT,3))]"" SZ=SZ+$L(^ (3))+1,SZ( 1)=SZ(1)+$ L(^(3))+1
	5288	"RTN","RCC PCML",151, 0)
	5289	.S:$G(^RC PS(349.2,+ PT,4))]"" SZ=SZ+$L(^ (4))+1,SZ( 1)=SZ(1)+$ L(^(4))+1
	5290	"RTN","RCC PCML",152, 0)
	5291	.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(
	5292	1)=SZ(1)+$ L(^(0))
	5293	"RTN","RCC PCML",153, 0)
	5294	.S TAMT=T AMT+$P(^RC PS(349.2,+ PT,0),"^", 8)
	5295	"RTN","RCC PCML",154, 0)
	5296	.I SZ>270 00 D
	5297	"RTN","RCC PCML",155, 0)
	5298	..S RTY=0 D F349 Q: ERROR
	5299	"RTN","RCC PCML",156, 0)
	5300	..S TAMT= TAMT-$P(PT 0,"^",8)
	5301	"RTN","RCC PCML",157, 0)
	5302	..S TAMT= $$HEX^RCCP CFN(TAMT)
	5303	"RTN","RCC PCML",158, 0)
	5304	..S ^TMP( $J,"MCT",R CM)=(PHCT- 1)_"^"_TAM T_"^"_$O(^ RCPS(349.2 ,"STDT",SD T,PT),-1)
	5305	_"^"_(SZ-S Z(1))
	5306	"RTN","RCC PCML",159, 0)
	5307	..S ^TMP( $J,"MCT",R CM,+PSN)=" "
	5308	"RTN","RCC PCML",160, 0)
	5309	..S RCM=R CM+1,PHCT= 1
	5310	"RTN","RCC PCML",161, 0)
	5311	..S SZ=SZ (1)
	5312	"RTN","RCC PCML",162, 0)
	5313	..S TAMT= $P(PT0,"^" ,8)
	5314	"RTN","RCC PCML",163, 0)
	5315	I 'PT,$O( ^RCPS(349. 2,"STDT",S DT,0)) D
	5316	"RTN","RCC PCML",164, 0)
	5317	.S RTY=0 D F349 Q:E RROR S ^T MP($J,"MCT ",RCM)=PHC T_"^"_$$HE X^RCCPCFN( TAMT)_"^"
	5318	_$O(^RCPS( 349.2,"STD T",SDT,PT) ,-1)
	5319	"RTN","RCC PCML",165, 0)
	5320	.S ^TMP($ J,"MCT",RC M,+PSN)=""
	5321	"RTN","RCC PCML",166, 0)
	5322	Q
	5323	"RTN","RCC PCML",167, 0)
	5324	;
	5325	"RTN","RCC PCML",168, 0)
	5326	ERROR ;ERR OR FILE
	5327	"RTN","RCC PCML",169, 0)
	5328	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	5329	"RTN","RCC PCML",170, 0)
	5330	S ^TMP($J ,"ERROR",E RROR,NM,$$ SSN^RCFN01 (+DEB))=""
	5331	"RTN","RCC PCML",171, 0)
	5332	Q
	5333	"RTN","RCC PCML",172, 0)
	5334	;
	5335	"RTN","RCC PCML",173, 0)
	5336	ERRCHK ;Er ror check
	5337	"RTN","RCC PCML",174, 0)
	5338	I '$D(^RC PS(349.2,+ PT,0)) S E RROR=1,NM= 0 D ERROR Q
	5339	"RTN","RCC PCML",175, 0)
	5340	S PT(1)=P T,PT=$O(^R CPS(349.2, "STDT",SDT ,0)) I '$P (^RCPS(349 .2,PT,0)," ^",18) S
	5341	ERROR=1,NM =0 D ERROR S PT=PT(1 ) Q
	5342	"RTN","RCC PCML",176, 0)
	5343	S PT=PT(1 )
	5344	"RTN","RCC PCML",177, 0)
	5345	I $$KEY^R CCPCFN(+PT )']"" S ER ROR=4,NM=$ $NAM^RCFN0 1(+DEB) D ERROR S ^T MP($J,"ER
	5346	RPT",+PT)= "" Q
	5347	"RTN","RCC PCML",178, 0)
	5348	I '$D(^RC PS(349.2," AKEY",$$KE Y^RCCPCFN( +PT))) S E RROR=4,NM= $$NAM^RCFN 01(+DEB)
	5349	D ERROR S ^TMP($J,"E RRPT",+PT) ="" Q
	5350	"RTN","RCC PCML",179, 0)
	5351	S ADD=$G( ^RCPS(349. 2,+PT,1))
	5352	"RTN","RCC PCML",180, 0)
	5353	F P=1:1:7 S ADD(P)= $S($P(ADD, "^",P)]"": $P(ADD,"^" ,P),1:"")
	5354	"RTN","RCC PCML",181, 0)
	5355	I ADD(1)= "",ADD(2)= "",ADD(3)= "",ADD(4)= "",ADD(5)= "",ADD(6)= "" S ERROR =8,NM=$$N
	5356	AM^RCFN01( +DEB) D ER ROR S ^TMP ($J,"ERRPT ",+PT)="" Q
	5357	"RTN","RCC PCML",182, 0)
	5358	I ADD(1)= "",(ADD(2) =""),(ADD( 3)=""),(AD D(6)="") S ERROR=8,N M=$$NAM^RC FN01(+DEB
	5359	) D ERROR S ^TMP($J, "ERRPT",+P T)="" Q
	5360	"RTN","RCC PCML",183, 0)
	5361	I ADD(4)= ""!(ADD(5) ="")!(ADD( 6)="") S E RROR=8,NM= $$NAM^RCFN 01(+DEB) D ERROR S
	5362	^TMP($J,"E RRPT",+PT) =""
	5363	"RTN","RCC PCML",184, 0)
	5364	F ADD=1:1 :6 I ADD(A DD)'?.ANP S ERROR=10 ,NM=$$NAM^ RCFN01(+DE B),^TMP($J ,"ERRPT",
	5365	+PT)="" D ERROR Q
	5366	"RTN","RCC PCML",185, 0)
	5367	I $P($G(^ RCD(340,+D EB,1)),"^" ,9) S ^TMP ($J,"ERRPT ",+PT)="", ERROR=9,NM =$$NAM^RC
	5368	FN01(+DEB) D ERROR
	5369	"RTN","RCC PCML",186, 0)
	5370	Q
	5371	"RTN","RCC PCML1")
	5372	0^13^B8787 618^B66823 35
	5373	"RTN","RCC PCML1",1,0 )
	5374	RCCPCML1 ; ALB@ALTOON A,PA/LDB - Send CCPC transmiss ion (cont. );8/25/00 4:16 PM
	5375	"RTN","RCC PCML1",2,0 )
	5376	V ;;4.5;Ac counts Rec eivable; 160,313; Mar 20, 19 95;Build 1 13
	5377	"RTN","RCC PCML1",3,0 )
	5378	;
	5379	"RTN","RCC PCML1",4,0 )
	5380	ERRML ;ERR OR MESSAGE S
	5381	"RTN","RCC PCML1",5,0 )
	5382	N CT,ERRO R,LN,PT,SP ,XMDUZ,XMT EXT,XMSUB, XMY
	5383	"RTN","RCC PCML1",6,0 )
	5384	K ^TMP($J ,"ERRMSG")
	5385	"RTN","RCC PCML1",7,0 )
	5386	S (ERROR, LN)=0 F S ERROR=$O( ^TMP($J,"E RROR",ERRO R)) Q:'ERR OR D
	5387	"RTN","RCC PCML1",8,0 )
	5388	. ; PRCA* 4.5*313 - Add header identifyi ng the Sta tement Dat e
	5389	"RTN","RCC PCML1",9,0 )
	5390	. I LN=0 S LN=LN+1 D
	5391	"RTN","RCC PCML1",10, 0)
	5392	. . N Y
	5393	"RTN","RCC PCML1",11, 0)
	5394	. . S Y=S DT X ^DD(" DD")
	5395	"RTN","RCC PCML1",12, 0)
	5396	. . S ^TM P($J,"ERRM SG",LN)="E RRORS FOR PATIENT ST ATEMENT DA TE: "_Y
	5397	"RTN","RCC PCML1",13, 0)
	5398	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	5399	"RTN","RCC PCML1",14, 0)
	5400	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=$P($T (ERRMSG+ER ROR),";;", 2)
	5401	"RTN","RCC PCML1",15, 0)
	5402	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	5403	"RTN","RCC PCML1",16, 0)
	5404	.S CT=0,P T="" F S PT=$O(^TMP ($J,"ERROR ",ERROR,PT )) Q:PT="" D
	5405	"RTN","RCC PCML1",17, 0)
	5406	..S CT=CT +1,LN=LN+1
	5407	"RTN","RCC PCML1",18, 0)
	5408	..I PT=0 S ^TMP($J, "ERRMSG",L N)=" " Q
	5409	"RTN","RCC PCML1",19, 0)
	5410	..N Y I P T'=0 D
	5411	"RTN","RCC PCML1",20, 0)
	5412	...S PT(1 )="" F S PT(1)=$O(^ TMP($J,"ER ROR",ERROR ,PT,PT(1)) ) Q:PT(1)= "" D
	5413	"RTN","RCC PCML1",21, 0)
	5414	....S ^TM P($J,"ERRM SG",LN)=$S ($L(CT)<2: " "_CT,1:C T)_". "
	5415	"RTN","RCC PCML1",22, 0)
	5416	....S SP= " ",Y=PT,Y= PT_$E(SP,$ L(PT),30)
	5417	"RTN","RCC PCML1",23, 0)
	5418	....S ^TM P($J,"ERRM SG",LN)=^T MP($J,"ERR MSG",LN)_Y _PT(1)
	5419	"RTN","RCC PCML1",24, 0)
	5420	S XMDUZ=" AR PACKAGE "
	5421	"RTN","RCC PCML1",25, 0)
	5422	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= ""
	5423	"RTN","RCC PCML1",26, 0)
	5424	E S XMY( $G(DUZ))=" "
	5425	"RTN","RCC PCML1",27, 0)
	5426	; PRCA4. 5313 - Ch ange CCPC to CBSS an d add Stat ement Date
	5427	"RTN","RCC PCML1",28, 0)
	5428	N Y S Y=S DT D DD^%D T S SDT=Y
	5429	"RTN","RCC PCML1",29, 0)
	5430	S XMSUB=" CBSS ERROR S FOUND DU RING TRANS MISSION"
	5431	"RTN","RCC PCML1",30, 0)
	5432	S XMTEXT= "^TMP($J," "ERRMSG"", "
	5433	"RTN","RCC PCML1",31, 0)
	5434	D ^XMD
	5435	"RTN","RCC PCML1",32, 0)
	5436	K ^TMP($J ,"ERRMSG")
	5437	"RTN","RCC PCML1",33, 0)
	5438	Q
	5439	"RTN","RCC PCML1",34, 0)
	5440	;
	5441	"RTN","RCC PCML1",35, 0)
	5442	ERRMSG ;E rror messa ges PRCA 4.5313 - Change CC PC to CBSS
	5443	"RTN","RCC PCML1",36, 0)
	5444	1 ;;CBSS t ransmissio n process found no r ecords or an incompl ete file. Contact I
	5445	RM.
	5446	"RTN","RCC PCML1",37, 0)
	5447	2 ;;No CBS S transmis sion recor ds transmi tted. Chec k file 349 . Contact IRM.
	5448	"RTN","RCC PCML1",38, 0)
	5449	3 ;;Corrup ted PH seg ment has b een encoun tered for the follow ing patien t(s):
	5450	"RTN","RCC PCML1",39, 0)
	5451	4 ;;No key field in CBSS file for the fo llowing pa tient(s):
	5452	"RTN","RCC PCML1",40, 0)
	5453	5 ;;Mailma n message creation a borted. Pl ease conta ct IRM.
	5454	"RTN","RCC PCML1",41, 0)
	5455	6 ;;No tra nsmission sent. Defi ne REMOTE DOMAIN in AR TRANSMI SSION TYPE file (34
	5456	9.1).
	5457	"RTN","RCC PCML1",42, 0)
	5458	7 ;;Print Acknowledg ements exi st. Transm ission can not be res ent.
	5459	"RTN","RCC PCML1",43, 0)
	5460	8 ;;Addres s informat ion is mis sing for t he followi ng patient (s):
	5461	"RTN","RCC PCML1",44, 0)
	5462	9 ;;Addres s is marke d as ADDRE SS UNKNOWN for the f ollowing p atient(s):
	5463	"RTN","RCC PCML1",45, 0)
	5464	10 ;;Corru pted Addre ss. Re-ent er address informati on for the following patient(
	5465	s):
	5466	"RTN","RCC PCML1",46, 0)
	5467	11 ;;File did not bu ild or tra nsmit due to another build or transmissi on runnin
	5468	g.
	5469	"RTN","RCC PCPS")
	5470	0^10^B1262 92904^B808 98915
	5471	"RTN","RCC PCPS",1,0)
	5472	RCCPCPS ;W ASH-ISC@AL TOONA,PA/N YB-Build P atient Sta tement Fil e ;12/19/9 6 4:14 P
	5473	M
	5474	"RTN","RCC PCPS",2,0)
	5475	;;4.5;Acc ounts Rece ivable;**3 4,70,80,48 ,104,116,1 49,170,181 ,190,223,2 37,219,26
	5476	5,301,313* *;Mar 20,1 995;Build 113
	5477	"RTN","RCC PCPS",3,0)
	5478	;;Per VHA Directive 2004-038, this rout ine should not be mo dified.
	5479	"RTN","RCC PCPS",4,0)
	5480	EN(SDT) ; PRCA4.5 313 - For use when c alled by B ackground Job
	5481	"RTN","RCC PCPS",5,0)
	5482	;
	5483	"RTN","RCC PCPS",6,0)
	5484	EN1 ;FOR U SE WHEN BU ILDING PS FILE (SDT MUST BE AV AILABLE AS A LOCAL V ARIABLE)
	5485	"RTN","RCC PCPS",7,0)
	5486	N CCPC,CN T,DAT,DEB, DIK,END,IN ADFL,LDT1, LDT3,PCC,P RN,RCDATE, RCT,SVADM, SVAMT,SVI
	5487	NT,SVOTH,S ITE,TXT,VA R,X,%,REP, ERROR,NM
	5488	"RTN","RCC PCPS",8,0)
	5489	N RCINFUL L,RCINPART S COMM=0
	5490	"RTN","RCC PCPS",9,0)
	5491	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5492	"RTN","RCC PCPS",10,0 )
	5493	L +^RCPS( 349.2):DIL OCKTM I '$ T D Q
	5494	"RTN","RCC PCPS",11,0 )
	5495	. D NOW^% DTC S Y=% D DD^%DT
	5496	"RTN","RCC PCPS",12,0 )
	5497	. W Y W ! !,"Another date is b eing run o r transmit ted. Try again late r."
	5498	"RTN","RCC PCPS",13,0 )
	5499	. S ERROR =11,NM=0 D ERROR^RCC PCML,ERRML ^RCCPCML1
	5500	"RTN","RCC PCPS",14,0 )
	5501	; PRCA4. 5313 - Cl ear data f or date be ing create d
	5502	"RTN","RCC PCPS",15,0 )
	5503	D KILL^RC CPCPS1(SDT )
	5504	"RTN","RCC PCPS",16,0 )
	5505	; PRCA4. 5313 - Se t date to a month ag o and kill data for that date
	5506	"RTN","RCC PCPS",17,0 )
	5507	N OLDDT
	5508	"RTN","RCC PCPS",18,0 )
	5509	S OLDDT=$ $MONTHAGO^ RCCPCPS1(S DT)
	5510	"RTN","RCC PCPS",19,0 )
	5511	; PRCA4. 5313 - Mo ved to KIL L^RCCPCPS1
	5512	"RTN","RCC PCPS",20,0 )
	5513	D KILL^RC CPCPS1(OLD DT)
	5514	"RTN","RCC PCPS",21,0 )
	5515	;
	5516	"RTN","RCC PCPS",22,0 )
	5517	D DT^DICR W,SITE^PRC AGU
	5518	"RTN","RCC PCPS",23,0 )
	5519	I '$D(SIT E) W !!,"A R SITE PAR AMETER ENT RIES NOT D EFINED!",? 50 D Q
	5520	"RTN","RCC PCPS",24,0 )
	5521	. D NOW^% DTC S Y=% D DD^%DT W Y
	5522	"RTN","RCC PCPS",25,0 )
	5523	. W !!,"C OULD NOT P ROCESS AR PATIENT ST ATEMENTS"
	5524	"RTN","RCC PCPS",26,0 )
	5525	. ; PRCA* 4.5*313 - Unlock pri or to exit ing
	5526	"RTN","RCC PCPS",27,0 )
	5527	. L -^RCP S(349.2):D ILOCKTM
	5528	"RTN","RCC PCPS",28,0 )
	5529	;
	5530	"RTN","RCC PCPS",29,0 )
	5531	; PRCA4. 5313 - Cl ear ICN Er ror tempor ary storag e
	5532	"RTN","RCC PCPS",30,0 )
	5533	K ^TMP("I CNERROR",$ J)
	5534	"RTN","RCC PCPS",31,0 )
	5535	D NOW^%DT C S END=%
	5536	"RTN","RCC PCPS",32,0 )
	5537	S LDT1=$$ FPS^RCAMFN 01(DT,-1), RCDATE=DT
	5538	"RTN","RCC PCPS",33,0 )
	5539	S (CNT,DE B)=0,PRN=1
	5540	"RTN","RCC PCPS",34,0 )
	5541	F S DEB= $O(^RCD(34 0,"AC",+$E (SDT,6,7), DEB)) Q:DE B="" I $D (^RCD(340, "AB","DPT
	5542	(",DEB)) D
	5543	"RTN","RCC PCPS",35,0 )
	5544	. N AMT ,BBAL,BEG, BN,CAT,DES C,ETY,FC,N D,PAT,PBAL ,PC,PSIEN
	5545	"RTN","RCC PCPS",36,0 )
	5546	. N PDA T,PEND,ST, SVINT,SVAD M,SVOTH,AD DR,ARFLAG, DIC
	5547	"RTN","RCC PCPS",37,0 )
	5548	. I $L( +$$SSN^RCF N01(DEB))< 5 Q
	5549	"RTN","RCC PCPS",38,0 )
	5550	. ;Chec k for Emer gency Resp onse Indic ator (ERI) Flag.
	5551	"RTN","RCC PCPS",39,0 )
	5552	. N RCD FN S RCDFN =+($P($G(^ RCD(340,DE B,0)),"^", 1)) I $$EM ERES^PRCAU TL(RCDFN)
	5553	]"" Q
	5554	"RTN","RCC PCPS",40,0 )
	5555	. ; ini tialize va riables fo r CS - PRC A4.5301
	5556	"RTN","RCC PCPS",41,0 )
	5557	. N CSB B,CSTCH,CS TPC,CSPREV S (CSBB,C STCH,CSTPC )=0
	5558	"RTN","RCC PCPS",42,0 )
	5559	. ; PRC A^4.5*313 - If ICN i s null set to send e rror email
	5560	"RTN","RCC PCPS",43,0 )
	5561	. I $P( $$GETICN^M PIF001(RCD FN),U)=-1 S ^TMP("IC NERROR",$J ,RCDFN)="" Q
	5562	"RTN","RCC PCPS",44,0 )
	5563	. I $$F LBPD1="" Q
	5564	"RTN","RCC PCPS",45,0 )
	5565	. I $P( ^PRCA(430, $$FLBPD1,0 ),U,10)="" Q
	5566	"RTN","RCC PCPS",46,0 )
	5567	. S INA DFL=0
	5568	"RTN","RCC PCPS",47,0 )
	5569	. S (SV ADM,SVAMT, SVINT,SVOT H)=0
	5570	"RTN","RCC PCPS",48,0 )
	5571	. N REF ,SBAL,TBAL ,TN,TTY,X, Y
	5572	"RTN","RCC PCPS",49,0 )
	5573	. K ^TM P("PRCAGT" ,$J)
	5574	"RTN","RCC PCPS",50,0 )
	5575	. S BEG =+$$LST^RC FN01(DEB,2 )
	5576	"RTN","RCC PCPS",51,0 )
	5577	. S LDT 3=$S(BEG>0 :$$FPS^RCA MFN01($P(B EG,"."),-3 ),1:0)
	5578	"RTN","RCC PCPS",52,0 )
	5579	. I $P( BEG,".")'< $P(RCDATE, ".") Q
	5580	"RTN","RCC PCPS",53,0 )
	5581	. D NOW ^%DTC S EN D=%
	5582	"RTN","RCC PCPS",54,0 )
	5583	. I BEG <1 S PDAT= "",BEG=0,P BAL=0
	5584	"RTN","RCC PCPS",55,0 )
	5585	. I BEG S PDAT=BE G,BEG=9999 999.999999 -BEG,PBAL= 0 D PBAL^P RCAGU(DEB, .BEG,.PBA
	5586	L) ;get pr ev bal
	5587	"RTN","RCC PCPS",56,0 )
	5588	. D EN^ PRCAGT(DEB ,BEG,.END)
	5589	"RTN","RCC PCPS",57,0 )
	5590	. S TBA L=0 D TBAL ^PRCAGT(DE B,.TBAL) ; get trans bal
	5591	"RTN","RCC PCPS",58,0 )
	5592	. S BBA L=0 D BBAL ^PRCAGU(DE B,.BBAL) ; get bill b al
	5593	"RTN","RCC PCPS",59,0 )
	5594	. ; ent ire accoun t has been referred to CS - PR CA4.5301
	5595	"RTN","RCC PCPS",60,0 )
	5596	. I CSB B,CSBB'<BB AL Q
	5597	"RTN","RCC PCPS",61,0 )
	5598	. S X=$ $PRE^PRCAG U(DEB) S P END=$P(X,U ,2),X=+X I X,BBAL D REF^PRCAGD (DEB,X,$G
	5599	(REP)) Q
	5600	"RTN","RCC PCPS",62,0 )
	5601	. I BBA L=0,PEND,- PEND=PBAL+ TBAL Q
	5602	"RTN","RCC PCPS",63,0 )
	5603	. I BBA L'=(PBAL+T BAL) D EN^ PRCAGD(DEB ,BBAL,TBAL ,PBAL,BEG, $G(REP)) Q
	5604	"RTN","RCC PCPS",64,0 )
	5605	. I BBA L'>0,'$D(^ TMP("PRCAG T",$J,DEB) ) Q
	5606	"RTN","RCC PCPS",65,0 )
	5607	. I BBA L=0,$G(SIT E("ZERO")) Q
	5608	"RTN","RCC PCPS",66,0 )
	5609	. I BBA L<0,BBAL>- .99 Q
	5610	"RTN","RCC PCPS",67,0 )
	5611	. I BBA L'<0,'$D(^ XTMP("PRCA GU",$J,DEB )),'COMM Q ;third l etter prin ted,not c
	5612	omment
	5613	"RTN","RCC PCPS",68,0 )
	5614	. S TBA L=TBAL+PBA L
	5615	"RTN","RCC PCPS",69,0 )
	5616	. ;adju st amounts to be fil ed in 349. 2 for CS b ills - PRC A4.5301
	5617	"RTN","RCC PCPS",70,0 )
	5618	. S TBA L=TBAL-CSB B ; reduce the total bill bala nce by CS balance
	5619	"RTN","RCC PCPS",71,0 )
	5620	. S CSP REV=CSBB-( CSTCH+CSTP C) ; compu te the CS previous b alance as the diffe
	5621	rence betw een the bi ll balance and the t ransaction balance
	5622	"RTN","RCC PCPS",72,0 )
	5623	. S PBA L=PBAL-CSP REV ; redu ce the pre vious bala nce by the CS previo us balanc
	5624	e
	5625	"RTN","RCC PCPS",73,0 )
	5626	. S TBA L("CH")=TB AL("CH")-C STCH ; red uce total charges by CS charge s
	5627	"RTN","RCC PCPS",74,0 )
	5628	. S TBA L("PC")=TB AL("PC")-C STPC ; red uce total credits by CS credit s
	5629	"RTN","RCC PCPS",75,0 )
	5630	. ;
	5631	"RTN","RCC PCPS",76,0 )
	5632	. I '$D (^RCPS(349 .2,0)) S ^ (0)="AR CB SS STATEME NTS^349.2I ^"
	5633	"RTN","RCC PCPS",77,0 )
	5634	. S DIC ="^RCPS(34 9.2,",X=DE B,DA=.01,D IC(0)="" D FILE^DICN
	5635	"RTN","RCC PCPS",78,0 )
	5636	. S PSI EN=+Y
	5637	"RTN","RCC PCPS",79,0 )
	5638	. S ^RC PS(349.2,P SIEN,0)=DE B_"^"_$$SS N^RCFN01(D EB)_"^"
	5639	"RTN","RCC PCPS",80,0 )
	5640	. S ADD R=$$DADD^R CAMADD(DEB ,1) ;get p atient's a ddress, co nfidential if appli
	5641	cable
	5642	"RTN","RCC PCPS",81,0 )
	5643	. S ARF LAG="N" N X
	5644	"RTN","RCC PCPS",82,0 )
	5645	. S X=$ P($G(^RCD( 340,DEB,1) ),U,1,6) I ($P(X,U)' =""),($P(X ,U,4)'="") ,($P(X,U,
	5646	5)'=""),(( $P(X,U,6)' ="")) S AR FLAG="Y"
	5647	"RTN","RCC PCPS",83,0 )
	5648	. S ^RC PS(349.2,P SIEN,1)=$P (ADDR,"^", 1,6)
	5649	"RTN","RCC PCPS",84,0 )
	5650	. S ST= $P(ADDR,"^ ",5)
	5651	"RTN","RCC PCPS",85,0 )
	5652	. S ^RC PS(349.2,P SIEN,7)=$P (^RCD(340, DEB,0),U,7 ) ;large p rint
	5653	"RTN","RCC PCPS",86,0 )
	5654	. ; PRC A4.5313 - Add four new eleme nts for CB SS
	5655	"RTN","RCC PCPS",87,0 )
	5656	. S $P( ^RCPS(349. 2,PSIEN,8) ,U)=$P($$G ETICN^MPIF 001(RCDFN) ,"V")
	5657	"RTN","RCC PCPS",88,0 )
	5658	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,2)=$P($ $GETICN^MP IF001(RCDF N),"V",2)
	5659	"RTN","RCC PCPS",89,0 )
	5660	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,3)=ARFL AG
	5661	"RTN","RCC PCPS",90,0 )
	5662	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,4)=""
	5663	"RTN","RCC PCPS",91,0 )
	5664	. N FLB PD1 S FLBP D1=$$FLBPD 1 I FLBPD1 S $P(^RCP S(349.2,PS IEN,8),U,4 )=$P(^PRC
	5665	A(430,FLBP D1,0),U,10 )
	5666	"RTN","RCC PCPS",92,0 )
	5667	. I $G( ST)'="" S ST=$O(^DIC (5,"C",ST, 0))
	5668	"RTN","RCC PCPS",93,0 )
	5669	. I $G( ST)>90,'$P ($G(^DIC(5 ,ST,0)),"^ ",6) S FC= $P($G(^DIC (5,ST,0)), "^")
	5670	"RTN","RCC PCPS",94,0 )
	5671	. S $P( ^RCPS(349. 2,PSIEN,1) ,"^",7)=$G (FC) S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1
	5672	),"^",5)=" FX"
	5673	"RTN","RCC PCPS",95,0 )
	5674	. S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1) ,"^",6)=$P (ADDR,"^", 8)
	5675	"RTN","RCC PCPS",96,0 )
	5676	. D NOW ^%DTC S $P (^RCPS(349 .2,PSIEN,0 ),"^",10)= %
	5677	"RTN","RCC PCPS",97,0 )
	5678	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",3)=$$ NAM^RCFN01 (DEB)
	5679	"RTN","RCC PCPS",98,0 )
	5680	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",4,7)= $S(TBAL'>0 :0,1:TBAL) _"^"_PBAL_ "^"_TBAL(
	5681	"CH")_"^"_ TBAL("PC") ,$P(^(0)," ^",8)=PBAL +TBAL("CH" )+TBAL("PC ")+TBAL("R F")
	5682	"RTN","RCC PCPS",99,0 )
	5683	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",13,17 )=BBAL("PB ")_"^"_BBA L("INT")_" ^"_BBAL("
	5684	ADM")_"^"_ BBAL("MF") _"^"_BBAL( "CT")
	5685	"RTN","RCC PCPS",100, 0)
	5686	. ;
	5687	"RTN","RCC PCPS",101, 0)
	5688	. N RCB ILLDA,RCDA TA1,RCDEBT DA,RCDESC, RCPSDA,RCT OTAL,RCTRA NDA,RCTRDA TE,VALUE,
	5689	RCCOM1,RCC OM2,RCCOM3
	5690	"RTN","RCC PCPS",102, 0)
	5691	. S RCD EBTDA=DEB
	5692	"RTN","RCC PCPS",103, 0)
	5693	. I '$D (^RCPS(349 .2,PSIEN,2 ,0)) S ^(0 )="^349.21 DA^^"
	5694	"RTN","RCC PCPS",104, 0)
	5695	. ;
	5696	"RTN","RCC PCPS",105, 0)
	5697	. S RCC OM1=$E($TR ($G(SITE(" COM1")),"~ \|^",""),1, 80),(RCCOM 2,RCCOM3)= ""
	5698	"RTN","RCC PCPS",106, 0)
	5699	. ; Add second co mment line for the G MT-reduced status
	5700	"RTN","RCC PCPS",107, 0)
	5701	. I $$G MT^PRCAGST (RCDEBTDA) S RCCOM2= "REDUCTION OF INPATI ENT COPAYM ENT DUE T
	5702	O GEOGRAPH IC MEANS T EST STATUS "
	5703	"RTN","RCC PCPS",108, 0)
	5704	. I TBA L'>0 S RCC OM3=" THI S IS NOT A BILL"
	5705	"RTN","RCC PCPS",109, 0)
	5706	. I RCC OM1'="",RC COM2'="" S $E(RCCOM1 ,80)=" " ; Make sure GMT messag e will be
	5707	printed o n separate line.
	5708	"RTN","RCC PCPS",110, 0)
	5709	. S ^RC PS(349.2,P SIEN,3)=RC COM1_RCCOM 2_RCCOM3
	5710	"RTN","RCC PCPS",111, 0)
	5711	. ;
	5712	"RTN","RCC PCPS",112, 0)
	5713	. S RCP SDA=0 ; th is variabl e used to set the de scription on the PS segment
	5714	"RTN","RCC PCPS",113, 0)
	5715	. S RCT RDATE=0 F S RCTRDAT E=$O(^TMP( "PRCAGT",$ J,RCDEBTDA ,RCTRDATE) ) Q:'RCTR
	5716	DATE S RC BILLDA=0 F S RCBILL DA=$O(^TMP ("PRCAGT", $J,RCDEBTD A,RCTRDATE ,RCBILLDA
	5717	)) Q:'RCBI LLDA D
	5718	"RTN","RCC PCPS",114, 0)
	5719	. . ; skip CS b ills/trans actions - PRCA4.53 01
	5720	"RTN","RCC PCPS",115, 0)
	5721	. . Q :$D(^PRCA( 430,"TCSP" ,RCBILLDA) )
	5722	"RTN","RCC PCPS",116, 0)
	5723	. . I $P($G(^RC PS(349.2,P SIEN,0))," ^",8)<0 S PC(75)=75
	5724	"RTN","RCC PCPS",117, 0)
	5725	. . I $P($G(^PR CA(430,RCB ILLDA,6)), "^",2)]"", ($P($G(^PR CA(430,RCB ILLDA,7))
	5726	,"^")>0) S PC(1)="01 "
	5727	"RTN","RCC PCPS",118, 0)
	5728	. . S CAT=$P($G (^PRCA(430 ,RCBILLDA, 0)),"^",2)
	5729	"RTN","RCC PCPS",119, 0)
	5730	. . S PC=$P($G( ^PRCA(430. 2,CAT,0)), "^",14)
	5731	"RTN","RCC PCPS",120, 0)
	5732	. . F X=1:1:100 I $P(PC," ,",X)'="" S PCC=$P(P C,",",X),P C(+PCC)=PC C Q:PCC="
	5733	"
	5734	"RTN","RCC PCPS",121, 0)
	5735	. . S PC="",X=0 F S X=$O (PC(X)) Q: X="" I $G (PC(X))'=" " S PC=PC_ PC(X)
	5736	"RTN","RCC PCPS",122, 0)
	5737	. . S $P(^RCPS( 349.2,PSIE N,4),"^")= PC
	5738	"RTN","RCC PCPS",123, 0)
	5739	. . ;
	5740	"RTN","RCC PCPS",124, 0)
	5741	. . I $D(^TMP(" PRCAGT",$J ,RCDEBTDA, RCTRDATE,R CBILLDA,0) ) S AMT=+^ (0) I AMT
	5742	D
	5743	"RTN","RCC PCPS",125, 0)
	5744	. . . ; get the descri ption for the bill
	5745	"RTN","RCC PCPS",126, 0)
	5746	. . . K RCDES C D BILLDE SC^RCCPCPS 1(RCBILLDA )
	5747	"RTN","RCC PCPS",127, 0)
	5748	. . . ;
	5749	"RTN","RCC PCPS",128, 0)
	5750	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	5751	"RTN","RCC PCPS",129, 0)
	5752	. . . S RCPSD A=RCPSDA+1
	5753	"RTN","RCC PCPS",130, 0)
	5754	. . . S $P(^R CPS(349.2, PSIEN,2,RC PSDA,0),"^ ",1,4)=$P( RCTRDATE," .")_"^"_$
	5755	G(RCDESC(1 ))_"^"_$G( AMT)_"^"_$ P(^PRCA(43 0,RCBILLDA ,0),"^")
	5756	"RTN","RCC PCPS",131, 0)
	5757	. . . F X=2:1 Q:$G(RCDE SC(X))="" S RCPSDA= RCPSDA+1,^ RCPS(349.2 ,PSIEN,2,
	5758	RCPSDA,0)= "^"_RCDESC (X)_"^^"
	5759	"RTN","RCC PCPS",132, 0)
	5760	. . ;
	5761	"RTN","RCC PCPS",133, 0)
	5762	. . S RCTRANDA= 0 F S RCT RANDA=$O(^ TMP("PRCAG T",$J,RCDE BTDA,RCTRD ATE,RCBIL
	5763	LDA,RCTRAN DA)) D:'RC TRANDA NO Q:'RCTRAND A D
	5764	"RTN","RCC PCPS",134, 0)
	5765	. . . ; get the descri ption for the transa ction
	5766	"RTN","RCC PCPS",135, 0)
	5767	. . . K RCDES C D TRANDE SC^RCCPCPS 1(RCTRANDA ),RCDESC
	5768	"RTN","RCC PCPS",136, 0)
	5769	. . . ; if i t is an in terest/adm in charge, summarize it below
	5770	"RTN","RCC PCPS",137, 0)
	5771	. . . I $G(RC DESC(1))[" INTEREST" Q
	5772	"RTN","RCC PCPS",138, 0)
	5773	. . . ; get the value of the tra nsaction f or the sta tement
	5774	"RTN","RCC PCPS",139, 0)
	5775	. . . S VALUE =$$TRANVAL U^RCDPBTLM (RCTRANDA)
	5776	"RTN","RCC PCPS",140, 0)
	5777	. . . S VALUE =$P(VALUE, "^",2)+$P( VALUE,"^", 3)+$P(VALU E,"^",4)+$ P(VALUE,"
	5778	^",5)+$P(V ALUE,"^",6 )
	5779	"RTN","RCC PCPS",141, 0)
	5780	. . . ; if i t is a sus pended (47 ) or unsus pended (46 ) transact ion, show
	5781	value
	5782	"RTN","RCC PCPS",142, 0)
	5783	. . . ; make suspended charges a ppear as n egative
	5784	"RTN","RCC PCPS",143, 0)
	5785	. . . S RCDAT A1=$G(^PRC A(433,RCTR ANDA,1))
	5786	"RTN","RCC PCPS",144, 0)
	5787	. . . I $P(RC DATA1,"^", 2)=47!($P( RCDATA1,"^ ",2)=46) S VALUE=$P( RCDATA1,"
	5788	^",5) I $P (RCDATA1," ^",2)=47 S VALUE=-VA LUE
	5789	"RTN","RCC PCPS",145, 0)
	5790	. . . ; if i t is an am ended bill , show val ue
	5791	"RTN","RCC PCPS",146, 0)
	5792	. . . I $P(RC DATA1,"^", 2)=33 S VA LUE=$P(RCD ATA1,"^",5 )
	5793	"RTN","RCC PCPS",147, 0)
	5794	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	5795	"RTN","RCC PCPS",148, 0)
	5796	. . . S RCPSD A=RCPSDA+1
	5797	"RTN","RCC PCPS",149, 0)
	5798	. . . S $P(^R CPS(349.2, PSIEN,2,RC PSDA,0),"^ ",1,5)=$P( RCTRDATE," .")_"^"_$
	5799	G(RCDESC(1 ))_"^"_VAL UE_"^"_$P( ^PRCA(430, RCBILLDA,0 ),"^")
	5800	"RTN","RCC PCPS",150, 0)
	5801	. . . F X=2:1 Q:$G(RCDE SC(X))="" S RCPSDA= RCPSDA+1,^ RCPS(349.2 ,PSIEN,2,
	5802	RCPSDA,0)= "^"_RCDESC (X)_"^^"
	5803	"RTN","RCC PCPS",151, 0)
	5804	. . . ;
	5805	"RTN","RCC PCPS",152, 0)
	5806	. . . ; for comment tr ansaction ... not su re what th is is for ?
	5807	"RTN","RCC PCPS",153, 0)
	5808	. . . I $P(RC DATA1,"^", 2)=45,$P($ G(^PRCA(43 3,RCTRANDA ,5)),"^",2 )["your w
	5809	aiver righ ts" S ^RCP S(349.2,PS IEN,4)="01 50"
	5810	"RTN","RCC PCPS",154, 0)
	5811	. ;
	5812	"RTN","RCC PCPS",155, 0)
	5813	. ; if interest, admin, or other, ad d them her e
	5814	"RTN","RCC PCPS",156, 0)
	5815	. S X=$ G(RCTOTAL( "INT"))+$G (RCTOTAL(" ADM"))+$G( RCTOTAL("O TH"))
	5816	"RTN","RCC PCPS",157, 0)
	5817	. I X>0 D
	5818	"RTN","RCC PCPS",158, 0)
	5819	. . S RCDESC="I NTEREST/AD M. CHARGE (Int:"_$J( $G(RCTOTAL ("INT")),1 ,2)_" Adm
	5820	:"_$J($G(R CTOTAL("AD M")),1,2)_ " Other:"_ $J($G(RCTO TAL("OTH") ),1,2)_")"
	5821	"RTN","RCC PCPS",159, 0)
	5822	. . S RCPSDA=RC PSDA+1
	5823	"RTN","RCC PCPS",160, 0)
	5824	. . S ^RCPS(349 .2,PSIEN,2 ,RCPSDA,0) ="^"_RCDES C_"^"_$J(X ,1,2)
	5825	"RTN","RCC PCPS",161, 0)
	5826	. . S ^RCPS(349 .2,PSIEN,2 ,0)="^349. 21DA^"_RCP SDA_"^"_RC PSDA
	5827	"RTN","RCC PCPS",162, 0)
	5828	. ;
	5829	"RTN","RCC PCPS",163, 0)
	5830	. ; PRC A4.5313 - Set stat ement date into cros s-referenc e
	5831	"RTN","RCC PCPS",164, 0)
	5832	. S $P( ^RCPS(349. 2,PSIEN,0) ,U,19)=SDT
	5833	"RTN","RCC PCPS",165, 0)
	5834	. ;
	5835	"RTN","RCC PCPS",166, 0)
	5836	. ; se t 0th node
	5837	"RTN","RCC PCPS",167, 0)
	5838	. I RCP SDA S ^RCP S(349.2,PS IEN,2,0)=" ^349.21DA^ "_RCPSDA_" ^"_RCPSDA
	5839	"RTN","RCC PCPS",168, 0)
	5840	. ;
	5841	"RTN","RCC PCPS",169, 0)
	5842	. ; PRC A4.5313 - Set Cros s-Referenc es for thi s Debtor
	5843	"RTN","RCC PCPS",170, 0)
	5844	. S DA= PSIEN,DIK= "^RCPS(349 .2," D IX1 ^DIK
	5845	"RTN","RCC PCPS",171, 0)
	5846	. ;
	5847	"RTN","RCC PCPS",172, 0)
	5848	. ; PRC A4.5313 - Remove d ata for ea ch debtor
	5849	"RTN","RCC PCPS",173, 0)
	5850	. K ^XT MP("PRCAGU ",$J,DEB)
	5851	"RTN","RCC PCPS",174, 0)
	5852	. ;
	5853	"RTN","RCC PCPS",175, 0)
	5854	. I RCP SDA'<287 S ^XTMP("RC CPC",0)=DT ,(^XTMP("R CCPC",RCDE BTDA),^XTM P("RCCPC1
	5855	",PSIEN))= "" Q
	5856	"RTN","RCC PCPS",176, 0)
	5857	. D NO
	5858	"RTN","RCC PCPS",177, 0)
	5859	;
	5860	"RTN","RCC PCPS",178, 0)
	5861	S PSIEN=0 S PSIEN=$ O(^RCPS(34 9.2,"STDT" ,SDT,PSIEN )) Q:PSIEN ="" S $P( ^RCPS(349
	5862	.2,PSIEN,0 ),"^",18)= 1
	5863	"RTN","RCC PCPS",179, 0)
	5864	;
	5865	"RTN","RCC PCPS",180, 0)
	5866	; PRCA4. 5313 - Se nd ICN Err or email i f necessar y
	5867	"RTN","RCC PCPS",181, 0)
	5868	I $D(^TMP ("ICNERROR ",$J)) D I CNERR^RCCP CPS1 K ^TM P("ICNERRO R",$J)
	5869	"RTN","RCC PCPS",182, 0)
	5870	;
	5871	"RTN","RCC PCPS",183, 0)
	5872	K COMM,TR ,TRNIEN
	5873	"RTN","RCC PCPS",184, 0)
	5874	;
	5875	"RTN","RCC PCPS",185, 0)
	5876	OSTM ;Proc ess old st atements
	5877	"RTN","RCC PCPS",186, 0)
	5878	S DIK="^R CPS(349.2, ",DA=0 F S DA=$O(^X TMP("RCCPC 1",DA)) Q: 'DA D ^DI K
	5879	"RTN","RCC PCPS",187, 0)
	5880	K DA,^XTM P("RCCPC1" )
	5881	"RTN","RCC PCPS",188, 0)
	5882	;
	5883	"RTN","RCC PCPS",189, 0)
	5884	STATMNT ;P rint patie nt stateme nts
	5885	"RTN","RCC PCPS",190, 0)
	5886	N IOP,ZTI O,ZTSAVE,Z TRTN,ZTDES C,ZTASK,%Z IS,ZTDTH,P RCADEV,POP
	5887	"RTN","RCC PCPS",191, 0)
	5888	S (IOP,PR CADEV)=$P( $G(^RC(342 ,1,0)),"^" ,8)
	5889	"RTN","RCC PCPS",192, 0)
	5890	I IOP]"" D
	5891	"RTN","RCC PCPS",193, 0)
	5892	.S ZTRTN= "STM^RCCPC STM",ZTDTH =$H,ZTDESC ="Print ol d AR State ments"
	5893	"RTN","RCC PCPS",194, 0)
	5894	.S %ZIS=" N0" D ^%ZI S Q:POP
	5895	"RTN","RCC PCPS",195, 0)
	5896	.S ZTSAVE ("PRCADEV" )="" D ^%Z TLOAD,^%ZI SC
	5897	"RTN","RCC PCPS",196, 0)
	5898	; PRCA4. 5313 - Un lock prior to exitin g
	5899	"RTN","RCC PCPS",197, 0)
	5900	L -^RCPS( 349.2):DIL OCKTM
	5901	"RTN","RCC PCPS",198, 0)
	5902	Q
	5903	"RTN","RCC PCPS",199, 0)
	5904	;
	5905	"RTN","RCC PCPS",200, 0)
	5906	NO ;If the re is no a ctivity
	5907	"RTN","RCC PCPS",201, 0)
	5908	I $G(^RCP S(349.2,PS IEN,4))["0 150" D
	5909	"RTN","RCC PCPS",202, 0)
	5910	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^NOTICE: Y ou now hav e delinque nt charges . Please^
	5911	^"
	5912	"RTN","RCC PCPS",203, 0)
	5913	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^review En forcement of Involun tary Colle ctions^^"
	5914	"RTN","RCC PCPS",204, 0)
	5915	.S ^RCPS( 349.2,PSIE N,2,3,0)=" ^on revers e.^^"
	5916	"RTN","RCC PCPS",205, 0)
	5917	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 3^3"
	5918	"RTN","RCC PCPS",206, 0)
	5919	I $G(^RCP S(349.2,PS IEN,2,1,0) )="" D
	5920	"RTN","RCC PCPS",207, 0)
	5921	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^No Activi ty in the Last 30 Da ys!^^"
	5922	"RTN","RCC PCPS",208, 0)
	5923	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^Please re fer to pre vious stat ement of r ights.^^"
	5924	"RTN","RCC PCPS",209, 0)
	5925	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 2^2"
	5926	"RTN","RCC PCPS",210, 0)
	5927	.I $G(^RC PS(349.2,P SIEN,4))=" " S ^(4)=" 90"
	5928	"RTN","RCC PCPS",211, 0)
	5929	Q
	5930	"RTN","RCC PCPS",212, 0)
	5931	BUILD ;Thi s is the e ntry point from the BUILD CCPC file opti on
	5932	"RTN","RCC PCPS",213, 0)
	5933	N TDT,QDT ,ZTDESC,ZT ASK,ZTSK,Z DTDTH,ZTIO ,ZTRTN,CNC L,%H,%DT,D IR,DTOUT
	5934	"RTN","RCC PCPS",214, 0)
	5935	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5936	"RTN","RCC PCPS",215, 0)
	5937	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmi
	5938	tted. Try again lat er." Q
	5939	"RTN","RCC PCPS",216, 0)
	5940	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	5941	"RTN","RCC PCPS",217, 0)
	5942	S %DT="AE XP"
	5943	"RTN","RCC PCPS",218, 0)
	5944	S %DT("A" )="Enter t he Patient Statement date for this build : "
	5945	"RTN","RCC PCPS",219, 0)
	5946	; PRCA4. 5313 - Un lock prior to quitti ng
	5947	"RTN","RCC PCPS",220, 0)
	5948	D ^%DT I (X="^")!($ D(DTOUT))! (Y=-1) L - ^RCPS(349. 2):DILOCKT M Q
	5949	"RTN","RCC PCPS",221, 0)
	5950	S SDT=Y
	5951	"RTN","RCC PCPS",222, 0)
	5952	; PRCA4. 5313 - Ch eck for sp ecific dat es and unl ock prior to quittin g
	5953	"RTN","RCC PCPS",223, 0)
	5954	I ",1,2,4 ,6,7,8,10, 12,14,15,1 7,19,21,22 ,24,26,"'[ (","_+$E(S DT,6,7)_", ") D K S
	5955	DT Q
	5956	"RTN","RCC PCPS",224, 0)
	5957	. W !!,"I NVALID STA TEMENT DAT E",!
	5958	"RTN","RCC PCPS",225, 0)
	5959	. L -^RCP S(349.2):D ILOCKTM
	5960	"RTN","RCC PCPS",226, 0)
	5961	. S DIR(0 )="E",DIR( "A")=" Pre ss ENTER t o Continue " D ^DIR
	5962	"RTN","RCC PCPS",227, 0)
	5963	S TDT=$O( ^RCPS(349. 2,"STDT",S DT,0)) I T DT D
	5964	"RTN","RCC PCPS",228, 0)
	5965	.S TDT=$T R($$SLH^RC FN01(SDT), "/","")
	5966	"RTN","RCC PCPS",229, 0)
	5967	.W *7,!!, "The Patie nt Stateme nts for ", $E(TDT,1,2 )_"/"_$E(T DT,3,4)_"/ "_$E(TDT,
	5968	5,8)
	5969	"RTN","RCC PCPS",230, 0)
	5970	.I $D(^RC T(349,"SDT ",+$E(SDT, 6,7))) D
	5971	"RTN","RCC PCPS",231, 0)
	5972	..S TDT=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",+ $E(SDT,6,7 ),0)),0)," ^",10)
	5973	"RTN","RCC PCPS",232, 0)
	5974	..S TDT=$ TR($$SLH^R CFN01(TDT) ,"/","")
	5975	"RTN","RCC PCPS",233, 0)
	5976	..W " wer e transmit ted on ",$ E(TDT,1,2) _"/"_$E(TD T,3,4)_"/" _$E(TDT,5, 8)_"."
	5977	"RTN","RCC PCPS",234, 0)
	5978	.E W " d o not have a transmi ssion date !"
	5979	"RTN","RCC PCPS",235, 0)
	5980	.W !!,">> PLEASE CO NTACT CUST OMER SUPPO RT BEFORE PROCEEDING <<",!!
	5981	"RTN","RCC PCPS",236, 0)
	5982	.K DIRUT, DIOUT S DI R(0)="E",D IR("A")=" Press ENTE R to Conti nue with B uild or ^
	5983	to Exit" D ^DIR
	5984	"RTN","RCC PCPS",237, 0)
	5985	; PRCA4. 5313 - Un lock prior to jobbin g off
	5986	"RTN","RCC PCPS",238, 0)
	5987	L -^RCPS( 349.2):DIL OCKTM
	5988	"RTN","RCC PCPS",239, 0)
	5989	I $D(DIRU T) K SDT Q
	5990	"RTN","RCC PCPS",240, 0)
	5991	TIME S ZTI O="",ZTRTN ="EN1^RCCP CPS",ZTDES C="Build C BSS Statem ent File"
	5992	"RTN","RCC PCPS",241, 0)
	5993	S ZTDTH=" ",ZTSAVE(" SDT")=SDT D ^%ZTLOAD Q:$G(ZTSK )=""
	5994	"RTN","RCC PCPS",242, 0)
	5995	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	5996	"RTN","RCC PCPS",243, 0)
	5997	; PRCA5. 4313 - Al low run an y time
	5998	"RTN","RCC PCPS",244, 0)
	5999	;I (QDT>D T_"."_0800 )&(QDT<(DT _"."_1801) ) D G TIM E
	6000	"RTN","RCC PCPS",245, 0)
	6001	;.W !!,*7 ,"You Can Not Queue this Job B etween 8:0 0am and 6: 00pm.",!
	6002	"RTN","RCC PCPS",246, 0)
	6003	;.D KILL^ %ZTLOAD
	6004	"RTN","RCC PCPS",247, 0)
	6005	W !,"Queu ed for Bui lding."
	6006	"RTN","RCC PCPS",248, 0)
	6007	; PRCA4. 5313 - Un lock prior to quitti ng
	6008	"RTN","RCC PCPS",249, 0)
	6009	L -^RCPS( 349.2):DIL OCKTM
	6010	"RTN","RCC PCPS",250, 0)
	6011	Q
	6012	"RTN","RCC PCPS",251, 0)
	6013	;
	6014	"RTN","RCC PCPS",252, 0)
	6015	RCDESC ;Re move "IN P ART" & "IN FULL" fro m the the bill descr iption
	6016	"RTN","RCC PCPS",253, 0)
	6017	QUIT:$G(R CDESC(1))= ""
	6018	"RTN","RCC PCPS",254, 0)
	6019	S RCINFUL L=" (IN FU LL)"
	6020	"RTN","RCC PCPS",255, 0)
	6021	S RCINPAR T=" (IN PA RT)"
	6022	"RTN","RCC PCPS",256, 0)
	6023	I RCDESC( 1)[RCINFUL L S RCDESC (1)=$P(RCD ESC(1),RCI NFULL)_$P( RCDESC(1), RCINFULL,
	6024	2)
	6025	"RTN","RCC PCPS",257, 0)
	6026	I RCDESC( 1)[RCINPAR T S RCDESC (1)=$P(RCD ESC(1),RCI NPART)_$P( RCDESC(1), RCINPART,
	6027	2)
	6028	"RTN","RCC PCPS",258, 0)
	6029	Q
	6030	"RTN","RCC PCPS",259, 0)
	6031	FLBPD1() ; PRCA4.5 313 - Retu rn last bi ll prep da te
	6032	"RTN","RCC PCPS",260, 0)
	6033	N X1,X2 S X1="" I ' $D(^PRCA(4 30,"ATD",R CDFN)) Q X 1
	6034	"RTN","RCC PCPS",261, 0)
	6035	S X2=$O(^ PRCA(430," ATD",RCDFN ,X1),-1)
	6036	"RTN","RCC PCPS",262, 0)
	6037	S X1=$O(^ PRCA(430," ATD",RCDFN ,X2,X1),-1 )
	6038	"RTN","RCC PCPS",263, 0)
	6039	Q X1
	6040	"RTN","RCC PCPS1")
	6041	0^11^B6483 3684^B3737 0113
	6042	"RTN","RCC PCPS1",1,0 )
	6043	RCCPCPS1 ; WISC/RFJ-b uild descr iption for patient s tatement ; 08 Aug 200 1
	6044	"RTN","RCC PCPS1",2,0 )
	6045	;;4.5;Acc ounts Rece ivable;3 4,48,104,1 70,176,192 ,265,313 ;Mar 20, 1 995;Build
	6046	113
	6047	"RTN","RCC PCPS1",3,0 )
	6048	;;Per VHA Directive 2004-038, this rout ine should not be mo dified.
	6049	"RTN","RCC PCPS1",4,0 )
	6050	Q
	6051	"RTN","RCC PCPS1",5,0 )
	6052	;
	6053	"RTN","RCC PCPS1",6,0 )
	6054	;
	6055	"RTN","RCC PCPS1",7,0 )
	6056	TRANDESC(R CTRANDA,RC WIDTH) ; build the descriptio n array fo r a transa ction
	6057	"RTN","RCC PCPS1",8,0 )
	6058	;
	6059	"RTN","RCC PCPS1",9,0 )
	6060	; initia lize
	6061	"RTN","RCC PCPS1",10, 0)
	6062	N DESCRIP T,RCBILLDA ,RCCATEG,R CCATTXT,RC DATA0,RCDA TA1,RCDATA 3,RCLINE,T RANTYPE,X
	6063	"RTN","RCC PCPS1",11, 0)
	6064	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	6065	"RTN","RCC PCPS1",12, 0)
	6066	K RCDESC
	6067	"RTN","RCC PCPS1",13, 0)
	6068	S RCLINE= 1,RCDESC(1 )=""
	6069	"RTN","RCC PCPS1",14, 0)
	6070	;
	6071	"RTN","RCC PCPS1",15, 0)
	6072	S RCBILLD A=+$P($G(^ PRCA(433,R CTRANDA,0) ),"^",2) I 'RCBILLDA Q
	6073	"RTN","RCC PCPS1",16, 0)
	6074	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	6075	"RTN","RCC PCPS1",17, 0)
	6076	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	6077	"RTN","RCC PCPS1",18, 0)
	6078	S RCDATA1 =^PRCA(433 ,RCTRANDA, 1)
	6079	"RTN","RCC PCPS1",19, 0)
	6080	S TRANTYP E=$P(RCDAT A1,"^",2)
	6081	"RTN","RCC PCPS1",20, 0)
	6082	;
	6083	"RTN","RCC PCPS1",21, 0)
	6084	; build the first line descr iption
	6085	"RTN","RCC PCPS1",22, 0)
	6086	; if tra nsaction t ype is an increase o r decrease , set desc ription
	6087	"RTN","RCC PCPS1",23, 0)
	6088	I TRANTYP E=1!(TRANT YPE=35) D
	6089	"RTN","RCC PCPS1",24, 0)
	6090	. ; if c means t est, set d escription to catego ry for c m eans test
	6091	"RTN","RCC PCPS1",25, 0)
	6092	. I RCC ATEG=18 S DESCRIPT=$ S($P(RCDAT A0,"^",16) :$P(^PRCA( 430.2,$P(R CDATA0,"^
	6093	",16),0)," ^"),1:RCCA TTXT) Q
	6094	"RTN","RCC PCPS1",26, 0)
	6095	. ; ot herwise, s et to cate gory name
	6096	"RTN","RCC PCPS1",27, 0)
	6097	. S DES CRIPT=RCCA TTXT
	6098	"RTN","RCC PCPS1",28, 0)
	6099	;
	6100	"RTN","RCC PCPS1",29, 0)
	6101	; if the bill cate gory is a rx-copay a nd it is a n increase adjustmen t
	6102	"RTN","RCC PCPS1",30, 0)
	6103	; then s et the des cription t o copay
	6104	"RTN","RCC PCPS1",31, 0)
	6105	I RCCATEG =22!(RCCAT EG=23),TRA NTYPE=1 S DESCRIPT=" COPAY"
	6106	"RTN","RCC PCPS1",32, 0)
	6107	;
	6108	"RTN","RCC PCPS1",33, 0)
	6109	; if the bill cate gory is ad ult day he alth care, remove he alth
	6110	"RTN","RCC PCPS1",34, 0)
	6111	I RCCATEG =33 S DESC RIPT="ADUL T DAY CARE "
	6112	"RTN","RCC PCPS1",35, 0)
	6113	;
	6114	"RTN","RCC PCPS1",36, 0)
	6115	; if the bill cate gory is re spite or g eriatric e val,
	6116	"RTN","RCC PCPS1",37, 0)
	6117	; take t he 2nd pie ce removin g institut ional
	6118	"RTN","RCC PCPS1",38, 0)
	6119	I RCCATEG =35!(RCCAT EG=36)!(RC CATEG=37)! (RCCATEG=3 8) S DESCR IPT=$P(RCC ATTXT,"-"
	6120	)_$S(RCCAT EG=35!(RCC ATEG=37):" IN",1:" O UT")_"PATI ENT"
	6121	"RTN","RCC PCPS1",39, 0)
	6122	;
	6123	"RTN","RCC PCPS1",40, 0)
	6124	; if it is a comme nt transac tion
	6125	"RTN","RCC PCPS1",41, 0)
	6126	I TRANTYP E=45 S DES CRIPT="COM MENT: "_$P ($G(^PRCA( 433,RCTRAN DA,5)),"^" ,2)
	6127	"RTN","RCC PCPS1",42, 0)
	6128	;
	6129	"RTN","RCC PCPS1",43, 0)
	6130	; prepay ment bill (1=increas e, 35=decr ease, othe rwise refu nd)
	6131	"RTN","RCC PCPS1",44, 0)
	6132	I RCCATEG =26 S DESC RIPT=$S(TR ANTYPE=1:" OVERPAYMEN T CREDIT", TRANTYPE=3 5:"OVERPA
	6133	YMENT CRED IT DECREAS E",1:"OVER PAYMENT RE FUND")
	6134	"RTN","RCC PCPS1",45, 0)
	6135	;
	6136	"RTN","RCC PCPS1",46, 0)
	6137	; if the first lin e descript ion not se t (like pa yments), s et it
	6138	"RTN","RCC PCPS1",47, 0)
	6139	; to the type of t ransaction
	6140	"RTN","RCC PCPS1",48, 0)
	6141	I $G(DESC RIPT)="" S DESCRIPT= $P($G(^PRC A(430.3,+$ P(RCDATA1, "^",2),0)) ,"^")
	6142	"RTN","RCC PCPS1",49, 0)
	6143	;
	6144	"RTN","RCC PCPS1",50, 0)
	6145	; if the transacti on date is different from the process da te,
	6146	"RTN","RCC PCPS1",51, 0)
	6147	; show i t with the descripti on
	6148	"RTN","RCC PCPS1",52, 0)
	6149	I $P(RCDA TA1,"^"),$ P($P(RCDAT A1,"^"),". ")'=$P($P( RCDATA1,"^ ",9),".") S DESCRIP
	6150	T=DESCRIPT _" ("_$$D ATE($P($P( RCDATA1,"^ "),"."))_" )"
	6151	"RTN","RCC PCPS1",53, 0)
	6152	;
	6153	"RTN","RCC PCPS1",54, 0)
	6154	; set th e first de scription line
	6155	"RTN","RCC PCPS1",55, 0)
	6156	D SETDESC (DESCRIPT)
	6157	"RTN","RCC PCPS1",56, 0)
	6158	;
	6159	"RTN","RCC PCPS1",57, 0)
	6160	; if it is a payme nt transac tion, show amount pa id interes t, admin, other
	6161	"RTN","RCC PCPS1",58, 0)
	6162	I TRANTYP E=2!(TRANT YPE=34) D
	6163	"RTN","RCC PCPS1",59, 0)
	6164	. S RCD ATA3=$G(^P RCA(433,RC TRANDA,3))
	6165	"RTN","RCC PCPS1",60, 0)
	6166	. ; if not inter est, admin , or other , quit
	6167	"RTN","RCC PCPS1",61, 0)
	6168	. I '$P (RCDATA3," ^",2),'$P( RCDATA3,"^ ",3),'$P(R CDATA3,"^" ,4),'$P(RC DATA3,"^"
	6169	,5) Q
	6170	"RTN","RCC PCPS1",62, 0)
	6171	. ;
	6172	"RTN","RCC PCPS1",63, 0)
	6173	. S DES CRIPT=" ( Int:"_$J(+ $P(RCDATA3 ,"^",2),1, 2)_" Adm: "_$J(+$P(R CDATA3,"^
	6174	",3),1,2)
	6175	"RTN","RCC PCPS1",64, 0)
	6176	. ; ca lculate ot her
	6177	"RTN","RCC PCPS1",65, 0)
	6178	. S X=$ P(RCDATA1, "^",5)-$P( RCDATA3,"^ ")-$P(RCDA TA3,"^",2) -$P(RCDATA 3,"^",3)
	6179	"RTN","RCC PCPS1",66, 0)
	6180	. S DES CRIPT=DESC RIPT_$S(X: " Other:"_ $J(X,1,2)_ ")",1:")")
	6181	"RTN","RCC PCPS1",67, 0)
	6182	. D SET DESC(DESCR IPT)
	6183	"RTN","RCC PCPS1",68, 0)
	6184	;
	6185	"RTN","RCC PCPS1",69, 0)
	6186	; if it is a admin cost or i nterest ch arge, tota l the amou nts
	6187	"RTN","RCC PCPS1",70, 0)
	6188	I TRANTYP E=13!(TRAN TYPE=12) D Q
	6189	"RTN","RCC PCPS1",71, 0)
	6190	. S X=$ G(^PRCA(43 3,RCTRANDA ,2)) I X=" " Q
	6191	"RTN","RCC PCPS1",72, 0)
	6192	. S RCT OTAL("INT" )=$G(RCTOT AL("INT")) +$P(X,"^", 7)
	6193	"RTN","RCC PCPS1",73, 0)
	6194	. S RCT OTAL("ADM" )=$G(RCTOT AL("ADM")) +$P(X,"^", 8)
	6195	"RTN","RCC PCPS1",74, 0)
	6196	. S RCT OTAL("OTH" )=$G(RCTOT AL("OTH")) +($P(RCDAT A1,"^",5)- $P(X,"^",7 )-$P(X,"^
	6197	",8))
	6198	"RTN","RCC PCPS1",75, 0)
	6199	;
	6200	"RTN","RCC PCPS1",76, 0)
	6201	; if not an increa se adjustm ent, quit
	6202	"RTN","RCC PCPS1",77, 0)
	6203	I TRANTYP E'=1 Q
	6204	"RTN","RCC PCPS1",78, 0)
	6205	;
	6206	"RTN","RCC PCPS1",79, 0)
	6207	; increa se to c me ans test, ltc or rx- copay, get data from ib
	6208	"RTN","RCC PCPS1",80, 0)
	6209	I RCCATEG =18!(RCCAT EG=22)!(RC CATEG=23)! ((RCCATEG> 32)&(RCCAT EG<40)) D
	6210	"RTN","RCC PCPS1",81, 0)
	6211	. S X=" IBRFN1" X ^%ZOSF("TE ST") I '$T Q
	6212	"RTN","RCC PCPS1",82, 0)
	6213	. K ^TM P("IBRFN1" ,$J)
	6214	"RTN","RCC PCPS1",83, 0)
	6215	. D STM T^IBRFN1(R CTRANDA)
	6216	"RTN","RCC PCPS1",84, 0)
	6217	. D IBD ATA
	6218	"RTN","RCC PCPS1",85, 0)
	6219	Q
	6220	"RTN","RCC PCPS1",86, 0)
	6221	;
	6222	"RTN","RCC PCPS1",87, 0)
	6223	;
	6224	"RTN","RCC PCPS1",88, 0)
	6225	; Return s RCDESC(1 ..n) array of Bill D escription
	6226	"RTN","RCC PCPS1",89, 0)
	6227	BILLDESC(R CBILLDA,RC WIDTH) ;
	6228	"RTN","RCC PCPS1",90, 0)
	6229	; initia lize
	6230	"RTN","RCC PCPS1",91, 0)
	6231	N DESCRIP T,RCCATEG, RCCATTXT,R CDATA0,RCL INE,X
	6232	"RTN","RCC PCPS1",92, 0)
	6233	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	6234	"RTN","RCC PCPS1",93, 0)
	6235	K RCDESC
	6236	"RTN","RCC PCPS1",94, 0)
	6237	S RCLINE= 1,RCDESC(1 )=""
	6238	"RTN","RCC PCPS1",95, 0)
	6239	;
	6240	"RTN","RCC PCPS1",96, 0)
	6241	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	6242	"RTN","RCC PCPS1",97, 0)
	6243	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	6244	"RTN","RCC PCPS1",98, 0)
	6245	;
	6246	"RTN","RCC PCPS1",99, 0)
	6247	; if cat egory=c me ans test, set the de scription and quit
	6248	"RTN","RCC PCPS1",100 ,0)
	6249	I RCCATEG =18 S DESC RIPT=$S($P (RCDATA0," ^",16):$P( ^PRCA(430. 2,$P(RCDAT A0,"^",16
	6250	),0),"^"), 1:RCCATTXT ) D SETDES C(DESCRIPT ) Q
	6251	"RTN","RCC PCPS1",101 ,0)
	6252	;
	6253	"RTN","RCC PCPS1",102 ,0)
	6254	; set th e category descripti on
	6255	"RTN","RCC PCPS1",103 ,0)
	6256	D SETDESC (RCCATTXT)
	6257	"RTN","RCC PCPS1",104 ,0)
	6258	;
	6259	"RTN","RCC PCPS1",105 ,0)
	6260	; if cat egory not champva su bsitence a nd not tri care patie nt, quit
	6261	"RTN","RCC PCPS1",106 ,0)
	6262	I RCCATEG '=27,RCCAT EG'=31 Q
	6263	"RTN","RCC PCPS1",107 ,0)
	6264	;
	6265	"RTN","RCC PCPS1",108 ,0)
	6266	; build descriptio n for cham pva subsis tence and tricare pa tient bill s
	6267	"RTN","RCC PCPS1",109 ,0)
	6268	; get da ta from ib
	6269	"RTN","RCC PCPS1",110 ,0)
	6270	S X="IBRF N1" X ^%ZO SF("TEST") I '$T Q
	6271	"RTN","RCC PCPS1",111 ,0)
	6272	K ^TMP("I BRFN1",$J)
	6273	"RTN","RCC PCPS1",112 ,0)
	6274	D STMTB^I BRFN1($P(R CDATA0,"^" ))
	6275	"RTN","RCC PCPS1",113 ,0)
	6276	D IBDATA
	6277	"RTN","RCC PCPS1",114 ,0)
	6278	Q
	6279	"RTN","RCC PCPS1",115 ,0)
	6280	;
	6281	"RTN","RCC PCPS1",116 ,0)
	6282	;
	6283	"RTN","RCC PCPS1",117 ,0)
	6284	IBDATA ; get data f rom IB for descripti on
	6285	"RTN","RCC PCPS1",118 ,0)
	6286	N IBDATA, IBJ
	6287	"RTN","RCC PCPS1",119 ,0)
	6288	;
	6289	"RTN","RCC PCPS1",120 ,0)
	6290	; show I B data
	6291	"RTN","RCC PCPS1",121 ,0)
	6292	S IBJ=0 F S IBJ=$O (^TMP("IBR FN1",$J,IB J)) Q:'IBJ S IBDATA =^TMP("IBR FN1",$J,I
	6293	BJ) D
	6294	"RTN","RCC PCPS1",122 ,0)
	6295	. ;
	6296	"RTN","RCC PCPS1",123 ,0)
	6297	. ; if no drug o r bill dat e returned from IB, then it is outpatien t
	6298	"RTN","RCC PCPS1",124 ,0)
	6299	. I $P( IBDATA,"^" ,3)="" D:$ P(IBDATA," ^",2) SETD ESC("VISIT DATE: "_$ $DATE($P(
	6300	IBDATA,"^" ,2))) Q
	6301	"RTN","RCC PCPS1",125 ,0)
	6302	. ;
	6303	"RTN","RCC PCPS1",126 ,0)
	6304	. ; if no drug q uantity re turned fro m ib, then it is inp atient
	6305	"RTN","RCC PCPS1",127 ,0)
	6306	. I '$P (IBDATA,"^ ",6) D Q
	6307	"RTN","RCC PCPS1",128 ,0)
	6308	. . I $P(IBDATA ,"^",2) D SETDESC(" ADMISSION DATE: "_$ $DATE($P(I BDATA,"^"
	6309	,2)))
	6310	"RTN","RCC PCPS1",129 ,0)
	6311	. . I $P(IBDATA ,"^",3) D SETDESC(" BEGINNING DATE OF B ILLING CYC LE: "_$$D
	6312	ATE($P(IBD ATA,"^",3) ))
	6313	"RTN","RCC PCPS1",130 ,0)
	6314	. . I $P(IBDATA ,"^",4) D SETDESC(" ENDING DA TE OF BILL ING CYCLE: "_$$DATE
	6315	($P(IBDATA ,"^",4)))
	6316	"RTN","RCC PCPS1",131 ,0)
	6317	. . I $P(IBDATA ,"^",5) D SETDESC(" DISCHARGE DATE: "_$ $DATE($P(I BDATA,"^"
	6318	,5)))
	6319	"RTN","RCC PCPS1",132 ,0)
	6320	. ;
	6321	"RTN","RCC PCPS1",133 ,0)
	6322	. ; ph armacy
	6323	"RTN","RCC PCPS1",134 ,0)
	6324	. D:$P( IBDATA,"^" ,2) SETDES C("RX:"_$P (IBDATA,"^ ",2))
	6325	"RTN","RCC PCPS1",135 ,0)
	6326	. D:$P( IBDATA,"^" ,7) SETDES C("FD:"_$$ DATE($P(IB DATA,"^",7 )))
	6327	"RTN","RCC PCPS1",136 ,0)
	6328	. ;
	6329	"RTN","RCC PCPS1",137 ,0)
	6330	. ; if not patie nt stateme nt detail, quit
	6331	"RTN","RCC PCPS1",138 ,0)
	6332	. I $$D ET^RCFN01( $P(RCDATA0 ,"^",9))'= 2 Q
	6333	"RTN","RCC PCPS1",139 ,0)
	6334	. ;
	6335	"RTN","RCC PCPS1",140 ,0)
	6336	. ; re turn pharm acy detail
	6337	"RTN","RCC PCPS1",141 ,0)
	6338	. I $P( IBDATA,"^" ,3)'="" D SETDESC(" DRUG:"_$TR ($P(IBDATA ,"^",3),"\| ~"))
	6339	"RTN","RCC PCPS1",142 ,0)
	6340	. I $P( IBDATA,"^" ,4) D SETD ESC(" DAYS :"_$P(IBDA TA,"^",4))
	6341	"RTN","RCC PCPS1",143 ,0)
	6342	. I $P( IBDATA,"^" ,6) D SETD ESC(" QTY: "_$P(IBDAT A,"^",6))
	6343	"RTN","RCC PCPS1",144 ,0)
	6344	. I $P( IBDATA,"^" ,5)'="" D SETDESC(" PHY:"_$P(I BDATA,"^", 5))
	6345	"RTN","RCC PCPS1",145 ,0)
	6346	. I $P( IBDATA,"^" ,8) D SETD ESC(" CHG: $"_$J($P(I BDATA,"^", 8),0,2))
	6347	"RTN","RCC PCPS1",146 ,0)
	6348	;
	6349	"RTN","RCC PCPS1",147 ,0)
	6350	K ^TMP("I BRFN1",$J)
	6351	"RTN","RCC PCPS1",148 ,0)
	6352	Q
	6353	"RTN","RCC PCPS1",149 ,0)
	6354	;
	6355	"RTN","RCC PCPS1",150 ,0)
	6356	;
	6357	"RTN","RCC PCPS1",151 ,0)
	6358	; Add lin e to the d escription , not long er than RC WIDTH
	6359	"RTN","RCC PCPS1",152 ,0)
	6360	; Input: RCLINE,RCW IDTH
	6361	"RTN","RCC PCPS1",153 ,0)
	6362	; Output: RCDESC
	6363	"RTN","RCC PCPS1",154 ,0)
	6364	SETDESC(DE SCRIPT) N LENGTH
	6365	"RTN","RCC PCPS1",155 ,0)
	6366	; calcul ate the le ngth of th e descript ion
	6367	"RTN","RCC PCPS1",156 ,0)
	6368	S LENGTH= $L(RCDESC( RCLINE))+$ L(DESCRIPT )
	6369	"RTN","RCC PCPS1",157 ,0)
	6370	I RCDESC( RCLINE)'=" " S LENGTH =LENGTH+1
	6371	"RTN","RCC PCPS1",158 ,0)
	6372	;
	6373	"RTN","RCC PCPS1",159 ,0)
	6374	; the de scription line canno t go over RCWIDTH ch aracters
	6375	"RTN","RCC PCPS1",160 ,0)
	6376	I LENGTH< RCWIDTH S RCDESC(RCL INE)=RCDES C(RCLINE)_ $S(RCDESC( RCLINE)="" :"",1:" "
	6377	)_DESCRIPT Q
	6378	"RTN","RCC PCPS1",161 ,0)
	6379	;
	6380	"RTN","RCC PCPS1",162 ,0)
	6381	; Descrip tion line to add is over RCWID TH
	6382	"RTN","RCC PCPS1",163 ,0)
	6383	; The giv en string will be sp litted _on ly_ if the limit is more than 44 charac
	6384	ters.
	6385	"RTN","RCC PCPS1",164 ,0)
	6386	I $L(DESC RIPT)>RCWI DTH D Q
	6387	"RTN","RCC PCPS1",165 ,0)
	6388	. I RCD ESC(RCLINE )'="" S RC LINE=RCLIN E+1
	6389	"RTN","RCC PCPS1",166 ,0)
	6390	. S RCD ESC(RCLINE )=$E(DESCR IPT,1,RCWI DTH)
	6391	"RTN","RCC PCPS1",167 ,0)
	6392	. S RCL INE=RCLINE +1
	6393	"RTN","RCC PCPS1",168 ,0)
	6394	. S RCD ESC(RCLINE )=$E(DESCR IPT,RCWIDT H+1,2*RCWI DTH)
	6395	"RTN","RCC PCPS1",169 ,0)
	6396	;
	6397	"RTN","RCC PCPS1",170 ,0)
	6398	; over R CWIDTH cha racters, s tart new l ine
	6399	"RTN","RCC PCPS1",171 ,0)
	6400	I RCDESC( RCLINE)'=" " S RCLINE =RCLINE+1
	6401	"RTN","RCC PCPS1",172 ,0)
	6402	S RCDESC( RCLINE)=DE SCRIPT
	6403	"RTN","RCC PCPS1",173 ,0)
	6404	Q
	6405	"RTN","RCC PCPS1",174 ,0)
	6406	;
	6407	"RTN","RCC PCPS1",175 ,0)
	6408	DATE(FMDT) ; format date mm/d d/yyyy
	6409	"RTN","RCC PCPS1",176 ,0)
	6410	I 'FMDT Q ""
	6411	"RTN","RCC PCPS1",177 ,0)
	6412	N X,Y,%DT S %DT="TX ",X=FMDT D ^%DT Q:Y< 0 ""
	6413	"RTN","RCC PCPS1",178 ,0)
	6414	Q $E(FMDT ,4,5)_"/"_ $E(FMDT,6, 7)_"/"_(17 00+$E(FMDT ,1,3))
	6415	"RTN","RCC PCPS1",179 ,0)
	6416	;
	6417	"RTN","RCC PCPS1",180 ,0)
	6418	KILL(SDT) ; PRCA4 .5313 - k ill data p rior to re creating f or this da y of mont
	6419	h
	6420	"RTN","RCC PCPS1",181 ,0)
	6421	;
	6422	"RTN","RCC PCPS1",182 ,0)
	6423	; Set dat e back one month
	6424	"RTN","RCC PCPS1",183 ,0)
	6425	N IEN,X,R CT,DA,DIK
	6426	"RTN","RCC PCPS1",184 ,0)
	6427	;
	6428	"RTN","RCC PCPS1",185 ,0)
	6429	S IEN=""
	6430	"RTN","RCC PCPS1",186 ,0)
	6431	F S IEN= $O(^RCPS(3 49.2,"STDT ",SDT,IEN) ) Q:IEN="" S DA=IEN ,DIK="^RCP S(349.2,"
	6432	D ^DIK
	6433	"RTN","RCC PCPS1",187 ,0)
	6434	;
	6435	"RTN","RCC PCPS1",188 ,0)
	6436	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T D
	6437	"RTN","RCC PCPS1",189 ,0)
	6438	. S ACK=" " F S ACK =$O(^RCT(3 49.1,RCT,4 ,"STDT4",S DT,ACK)) Q :ACK="" D
	6439	"RTN","RCC PCPS1",190 ,0)
	6440	. . S IEN =0 F S IE N=$O(^RCT( 349.1,RCT, 4,"STDT4", SDT,ACK,IE N)) Q:IEN= "" S DA=
	6441	IEN,DIK="^ RCT(349.1, "_RCT_",4, " D ^DIK K ^RCT(349. 1,RCT,4,"S TDT4",SDT, ACK,IEN)
	6442	"RTN","RCC PCPS1",191 ,0)
	6443	. S IEN=0 F S IEN= $O(^RCT(34 9.1,RCT,5, "STDT5",SD T,IEN)) Q: IEN="" S DA=IEN,DI
	6444	K="^RCT(34 9.1,"_RCT_ ",5," D ^D IK K ^RCT( 349.1,RCT, 5,"STDT5", SDT,IEN)
	6445	"RTN","RCC PCPS1",192 ,0)
	6446	;
	6447	"RTN","RCC PCPS1",193 ,0)
	6448	K ^XTMP(" RCCPC")
	6449	"RTN","RCC PCPS1",194 ,0)
	6450	;
	6451	"RTN","RCC PCPS1",195 ,0)
	6452	Q
	6453	"RTN","RCC PCPS1",196 ,0)
	6454	;
	6455	"RTN","RCC PCPS1",197 ,0)
	6456	MONTHAGO(S DT) ; PRC A4.5313 - Return d ate one mo nth prior to entered date
	6457	"RTN","RCC PCPS1",198 ,0)
	6458	; New OLD DT in call ing routin e
	6459	"RTN","RCC PCPS1",199 ,0)
	6460	S OLDDT=S DT-100
	6461	"RTN","RCC PCPS1",200 ,0)
	6462	I $E(SDT, 4,5)="01" S OLDDT=($ E(SDT,1,3) -1)_12_$E( SDT,6,7)
	6463	"RTN","RCC PCPS1",201 ,0)
	6464	Q OLDDT
	6465	"RTN","RCC PCPS1",202 ,0)
	6466	;
	6467	"RTN","RCC PCPS1",203 ,0)
	6468	ICNERR ; PRCA4.5 313 - Send email to RCCPC STAT EMENTS Mai l Group wi th all mi
	6469	ssing ICNs
	6470	"RTN","RCC PCPS1",204 ,0)
	6471	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ,XMY, DFN,CNT,I
	6472	"RTN","RCC PCPS1",205 ,0)
	6473	;
	6474	"RTN","RCC PCPS1",206 ,0)
	6475	; Create Message at MSG level of tempor ary storag e
	6476	"RTN","RCC PCPS1",207 ,0)
	6477	S CNT=1,^ TMP("ICNER ROR",$J,"M SG",CNT)=" The Patien t Statemen ts for the se patien
	6478	ts were no t sent to CBSS due t o a"
	6479	"RTN","RCC PCPS1",208 ,0)
	6480	S CNT=2,^ TMP("ICNER ROR",$J,"M SG",CNT)=" missing IC N."
	6481	"RTN","RCC PCPS1",209 ,0)
	6482	S CNT=3,^ TMP("ICNER ROR",$J,"M SG",CNT)=" NAME SSN
	6483	"
	6484	"RTN","RCC PCPS1",210 ,0)
	6485	S CNT=4,^ TMP("ICNER ROR",$J,"M SG",CNT)=" ========== ========== ========== =========
	6486	======="
	6487	"RTN","RCC PCPS1",211 ,0)
	6488	S DFN="" F S DFN=$ O(^TMP("IC NERROR",$J ,DFN)) Q:D FN="" Q:D FN="MSG" D
	6489	"RTN","RCC PCPS1",212 ,0)
	6490	. N DPTDA TA,NAME
	6491	"RTN","RCC PCPS1",213 ,0)
	6492	. S DPTDA TA=$G(^DPT (DFN,0))
	6493	"RTN","RCC PCPS1",214 ,0)
	6494	. I DPTDA TA="" Q
	6495	"RTN","RCC PCPS1",215 ,0)
	6496	. S NAME= $P(DPTDATA ,U)
	6497	"RTN","RCC PCPS1",216 ,0)
	6498	. F I=$L( NAME):1:35 S NAME=NA ME_" "
	6499	"RTN","RCC PCPS1",217 ,0)
	6500	. S CNT=C NT+1
	6501	"RTN","RCC PCPS1",218 ,0)
	6502	. S ^TMP( "ICNERROR" ,$J,"MSG", CNT)=NAME_ $P(DPTDATA ,U,9)
	6503	"RTN","RCC PCPS1",219 ,0)
	6504	;
	6505	"RTN","RCC PCPS1",220 ,0)
	6506	S XMDUZ=D UZ
	6507	"RTN","RCC PCPS1",221 ,0)
	6508	S XMTO(DU Z)=""
	6509	"RTN","RCC PCPS1",222 ,0)
	6510	S XMTO("G .RCCPC STA TEMENTS")= ""
	6511	"RTN","RCC PCPS1",223 ,0)
	6512	S XMSUBJ= "PATIENTS WITH MISSI NG ICNS"
	6513	"RTN","RCC PCPS1",224 ,0)
	6514	S XMBODY= "^TMP(""IC NERROR"",$ J,""MSG"") "
	6515	"RTN","RCC PCPS1",225 ,0)
	6516	S XMINSTR ("FLAGS")= "X"
	6517	"RTN","RCC PCPS1",226 ,0)
	6518	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	6519	"RTN","RCC PCPS1",227 ,0)
	6520	Q
	6521	"RTN","RCC PCSE")
	6522	0^14^B1349 2869^B5810 439
	6523	"RTN","RCC PCSE",1,0)
	6524	RCCPCSE ;W ASH-ISC@AL TOONA,PA/L DB - CCPC Statements Errors;5/ 30/96 10: 20 AM ;10
	6525	/16/96 8: 42 AM
	6526	"RTN","RCC PCSE",2,0)
	6527	V ;;4.5;Ac counts Rec eivable; 34,313;M ar 20, 199 5;Build 11 3
	6528	"RTN","RCC PCSE",3,0)
	6529	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	6530	"RTN","RCC PCSE",4,0)
	6531	;
	6532	"RTN","RCC PCSE",5,0)
	6533	K ^TMP($J )
	6534	"RTN","RCC PCSE",6,0)
	6535	N ADD,DIR ,DIRUT,ERR ,ERROR,HDR ,LINE,LN,P G,POP,PT,X ,X1,Y,%ZIS ,Z,ZTRTN,Z TDESC,%,%
	6536	Y,%DT,ZTSA VE
	6537	"RTN","RCC PCSE",7,0)
	6538	I '$O(^RC PS(349.2," AD","E",0) ) W !,"THE RE ARE NO CBSS PATIE NT STATEME NT ERRORS
	6539	" Q
	6540	"RTN","RCC PCSE",8,0)
	6541	E W !,"C BSS PATIEN T STATEMEN T ERROR RE PORT"
	6542	"RTN","RCC PCSE",9,0)
	6543	N IEN,%D, DTOUT,SDT, SDAT,TMPQ, ALL,DTPT
	6544	"RTN","RCC PCSE",10,0 )
	6545	S (TMPQ,A LL)=0
	6546	"RTN","RCC PCSE",11,0 )
	6547	S IEN="" F S IEN=$ O(^RCPS(34 9.2,"AD"," E",IEN)) Q :IEN="" I $G(^RCPS( 349.2,IEN
	6548	,5))'="" D
	6549	"RTN","RCC PCSE",12,0 )
	6550	. S SDT=$ P(^RCPS(34 9.2,IEN,0) ,U,19)
	6551	"RTN","RCC PCSE",13,0 )
	6552	. S DTPT( SDT,IEN)=" "
	6553	"RTN","RCC PCSE",14,0 )
	6554	. S DTPT( SDT)=$G(DT PT(SDT))+1
	6555	"RTN","RCC PCSE",15,0 )
	6556	; PRCA4. 5313 - As k about al l dates or specific
	6557	"RTN","RCC PCSE",16,0 )
	6558	W !,"Do y ou want to print err ors for al l dates av ailable"
	6559	"RTN","RCC PCSE",17,0 )
	6560	S %=1 D Y N^DICN
	6561	"RTN","RCC PCSE",18,0 )
	6562	I %=1 S A LL=1 D PRI NT Q
	6563	"RTN","RCC PCSE",19,0 )
	6564	I %Y="^" Q
	6565	"RTN","RCC PCSE",20,0 )
	6566	; PRCA4. 5313 - Ad d date pro mpts
	6567	"RTN","RCC PCSE",21,0 )
	6568	W !,"The following dates have errors to print:"
	6569	"RTN","RCC PCSE",22,0 )
	6570	S SDT="" F S SDT=$ O(DTPT(SDT )) Q:SDT= "" W !,$$ DATE^RCCPC PS1(SDT)
	6571	"RTN","RCC PCSE",23,0 )
	6572	S %DT="AE XP"
	6573	"RTN","RCC PCSE",24,0 )
	6574	S %DT("A" )="Enter P atient Sta tement dat e: "
	6575	"RTN","RCC PCSE",25,0 )
	6576	D ^%DT Q: (X="^")!($ D(DTOUT))! (Y=-1)
	6577	"RTN","RCC PCSE",26,0 )
	6578	S SDT=Y
	6579	"RTN","RCC PCSE",27,0 )
	6580	I '$D(DTP T(SDT)) W !,"There a re no erro r files fo r that dat e." Q
	6581	"RTN","RCC PCSE",28,0 )
	6582	D PRINT
	6583	"RTN","RCC PCSE",29,0 )
	6584	Q
	6585	"RTN","RCC PCSE",30,0 )
	6586	PRINT ; P RCA4.531 3 Determin e print de vice then enter Sort
	6587	"RTN","RCC PCSE",31,0 )
	6588	D HOME^%Z IS S %ZIS= "QN" D ^%Z IS Q:POP
	6589	"RTN","RCC PCSE",32,0 )
	6590	I $D(IO(" Q")) D Q
	6591	"RTN","RCC PCSE",33,0 )
	6592	.S ZTRTN= "SORT^RCCP CSE",ZTDES C="CBSS PA TIENT STAT EMENT ERRO R REPORT"
	6593	"RTN","RCC PCSE",34,0 )
	6594	. S TMPQ= 1,(ZTSAVE( "DTPT("),Z TSAVE("SDT "),ZTSAVE( "ALL"),ZTS AVE("TMPQ" ))=""
	6595	"RTN","RCC PCSE",35,0 )
	6596	.D ^%ZTLO AD
	6597	"RTN","RCC PCSE",36,0 )
	6598	SORT ; PR CA4.5313 - Rewritt en to prin t by date
	6599	"RTN","RCC PCSE",37,0 )
	6600	S HDR="CB SS PATIENT STATEMENT ERROR REP ORT",LINE= "",$P(LINE ,"=",79)=" ",PG=1
	6601	"RTN","RCC PCSE",38,0 )
	6602	I 'ALL D SORT1,PRNT Q
	6603	"RTN","RCC PCSE",39,0 )
	6604	I ALL S S DT=""
	6605	"RTN","RCC PCSE",40,0 )
	6606	F S SDT= $O(DTPT(SD T)) Q:SDT= "" D SORT 1
	6607	"RTN","RCC PCSE",41,0 )
	6608	D PRNT
	6609	"RTN","RCC PCSE",42,0 )
	6610	; PRCA4. 5313 - Re move TMP s torage
	6611	"RTN","RCC PCSE",43,0 )
	6612	K ^TMP($J )
	6613	"RTN","RCC PCSE",44,0 )
	6614	Q
	6615	"RTN","RCC PCSE",45,0 )
	6616	SORT1 ;PR CA4.5313 Print a d ay of erro rs
	6617	"RTN","RCC PCSE",46,0 )
	6618	N IEN
	6619	"RTN","RCC PCSE",47,0 )
	6620	S IEN="" F S IEN=$ O(DTPT(SDT ,IEN)) Q:I EN="" D
	6621	"RTN","RCC PCSE",48,0 )
	6622	.S ERR=$G (^RCPS(349 .2,IEN,5))
	6623	"RTN","RCC PCSE",49,0 )
	6624	.S ^TMP($ J,"ERR",SD T,IEN)=$P( ^RCPS(349. 2,IEN,0)," ^",3)_"^"_ $P(^(0),"^ ",2)
	6625	"RTN","RCC PCSE",50,0 )
	6626	.S ADD=$G (^RCPS(349 .2,IEN,1))
	6627	"RTN","RCC PCSE",51,0 )
	6628	.F X=1:1: 6 S ADD(X) =$P(ADD,"^ ",X),^TMP( $J,"ERR",S DT,IEN,1+X )=ADD(X)
	6629	"RTN","RCC PCSE",52,0 )
	6630	.F X=1:5 S X1=X+4,E RROR=$E(ER R,X,X1) Q: ERROR="" D
	6631	"RTN","RCC PCSE",53,0 )
	6632	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=ERROR
	6633	"RTN","RCC PCSE",54,0 )
	6634	..S ERROR =$O(^RCPSE (349.7,"B" ,$E(ERROR, 1,5),""))
	6635	"RTN","RCC PCSE",55,0 )
	6636	..S ERROR =$P($G(^RC PSE(349.7, +ERROR,0)) ,"^",4)
	6637	"RTN","RCC PCSE",56,0 )
	6638	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=^TMP($J ,"ERR",SDT ,IEN,X+10) _"^"_ERROR
	6639	"RTN","RCC PCSE",57,0 )
	6640	;
	6641	"RTN","RCC PCSE",58,0 )
	6642	K ADD
	6643	"RTN","RCC PCSE",59,0 )
	6644	Q
	6645	"RTN","RCC PCSE",60,0 )
	6646	PRNT ; PR CA4.5313 - Print b ased upon statement date
	6647	"RTN","RCC PCSE",61,0 )
	6648	K DIRUT
	6649	"RTN","RCC PCSE",62,0 )
	6650	S (SDT,IE N)=""
	6651	"RTN","RCC PCSE",63,0 )
	6652	F S SDT= $O(^TMP($J ,"ERR",SDT )) Q:SDT=" " D Q:$D (DIRUT)
	6653	"RTN","RCC PCSE",64,0 )
	6654	. W @IOF, ?25,HDR,?7 5,PG,!,LIN E S PG=PG+ 1
	6655	"RTN","RCC PCSE",65,0 )
	6656	. W !,?20 ,"Patient Statement Date: "_$$ DATE^RCCPC PS1(SDT),! ,LINE
	6657	"RTN","RCC PCSE",66,0 )
	6658	. F S IE N=$O(^TMP( $J,"ERR",S DT,IEN)) Q :IEN="" D PRNT1 Q:$ D(DIRUT)
	6659	"RTN","RCC PCSE",67,0 )
	6660	. I 'TMPQ S DIR(0)= "E" D ^DIR Q:$D(DIRU T)
	6661	"RTN","RCC PCSE",68,0 )
	6662	Q
	6663	"RTN","RCC PCSE",69,0 )
	6664	PRNT1 ; P RCA4.531 3 - Print based upon statement date
	6665	"RTN","RCC PCSE",70,0 )
	6666	I ($Y+12) >IOSL D
	6667	"RTN","RCC PCSE",71,0 )
	6668	.I 'TMPQ S DIR(0)=" E" D ^DIR Q:$D(DIRUT )
	6669	"RTN","RCC PCSE",72,0 )
	6670	.W @IOF,? 25,HDR,?75 ,PG S PG=P G+1
	6671	"RTN","RCC PCSE",73,0 )
	6672	Q:$D(DIRU T)
	6673	"RTN","RCC PCSE",74,0 )
	6674	W !!,$E($ P(^TMP($J, "ERR",SDT, IEN),"^"), 1,25),?37, "ERROR COD ES",!,$P(^ (IEN),"^"
	6675	,2),?30,$E (LINE,1,48 )
	6676	"RTN","RCC PCSE",75,0 )
	6677	F X=2:1:4 S:$G(^TMP ($J,"ERR", SDT,IEN,X) )]"" ADD(X )=^(X)
	6678	"RTN","RCC PCSE",76,0 )
	6679	S ADD(5)= $G(^TMP($J ,"ERR",SDT ,IEN,5))_" , "_$G(^(6 ))_" "_$G( ^(7))
	6680	"RTN","RCC PCSE",77,0 )
	6681	S X=7 F S X=$O(^TM P($J,"ERR" ,SDT,IEN,X )) Q:'X S ERR(X-1)= ^(X)
	6682	"RTN","RCC PCSE",78,0 )
	6683	S (Z,Y)=0 F D Q:Y =""&(Z="")
	6684	"RTN","RCC PCSE",79,0 )
	6685	.W !
	6686	"RTN","RCC PCSE",80,0 )
	6687	.I Z'="" S Z=$O(ADD (Z)) I Z'= "",(ADD(Z) ]"") W ADD (Z)
	6688	"RTN","RCC PCSE",81,0 )
	6689	.I Y'="" S Y=$O(ERR (Y)) I Y'= "" W ?30,$ P(ERR(Y)," ^"),?40,$P (ERR(Y),"^ ",2)
	6690	"RTN","RCC PCSE",82,0 )
	6691	W !,LINE
	6692	"RTN","RCC PCSE",83,0 )
	6693	Q
	6694	"RTN","RCC PCSV")
	6695	0^9^B11821 725^B51994 90
	6696	"RTN","RCC PCSV",1,0)
	6697	RCCPCSV ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 11
	6698	:36 AM
	6699	"RTN","RCC PCSV",2,0)
	6700	V ;;4.5;Ac counts Rec eivable; 34,70,87,3 13;Mar 2 0, 1995;Bu ild 113
	6701	"RTN","RCC PCSV",3,0)
	6702	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	6703	"RTN","RCC PCSV",4,0)
	6704	;
	6705	"RTN","RCC PCSV",5,0)
	6706	EN ;INPUT FROM MESSA GE
	6707	"RTN","RCC PCSV",6,0)
	6708	RREC ;READ INCOMING MESSAGE
	6709	"RTN","RCC PCSV",7,0)
	6710	N DAT,DEB ,END,ERR,E RROR,EVN,K EY,LABEL,L N,MSG,P,RC MSG,RCTR,R CX,RCX1,RE ,SBAL,STO
	6711	T,TR,TR0,T R1,TXT
	6712	"RTN","RCC PCSV",8,0)
	6713	N SDT,NOE RR,X,Y,DA
	6714	"RTN","RCC PCSV",9,0)
	6715	K ^TMP($J )
	6716	"RTN","RCC PCSV",10,0 )
	6717	S (LN,MSG ,RCX,RE)=0
	6718	"RTN","RCC PCSV",11,0 )
	6719	S TXT=0 F X XMREC Q:XMER<0!( XMRG="") S TXT=TXT+ 1,^TMP($J, "MSG",TXT) =XMRG
	6720	"RTN","RCC PCSV",12,0 )
	6721	S (DA(1), NOERR)=""
	6722	"RTN","RCC PCSV",13,0 )
	6723	S TXT=1 F S TXT=$O (^TMP($J," MSG",TXT)) Q:'TXT D
	6724	"RTN","RCC PCSV",14,0 )
	6725	.S:^TMP($ J,"MSG",TX T)?1"PA^". E DA(1)=4 S:^TMP($J, "MSG",TXT) ?1"IS".E D A(1)=3
	6726	"RTN","RCC PCSV",15,0 )
	6727	. ; PRCA* 4.5*313 - Set Statem ent date f rom PA or IS records
	6728	"RTN","RCC PCSV",16,0 )
	6729	. I "PAIS "[$E(^TMP( $J,"MSG",T XT),1,2) S X=$P(^TMP ($J,"MSG", TXT),"^",7 ) D ^%DT
	6730	S SDT=Y
	6731	"RTN","RCC PCSV",17,0 )
	6732	. ; PRCA* 4.5*313 - If the dat e and sequ ence numbe r have alr eady been processed
	6733	quit afte r setting an error
	6734	"RTN","RCC PCSV",18,0 )
	6735	. I "PAIS "[$P(^TMP( $J,"MSG",T XT),U) I ( $D(^RCT(34 9.1,DA(1), 4,"STDT4", SDT,$P(^T
	6736	MP($J,"MSG ",TXT),U,2 )))) D Q
	6737	"RTN","RCC PCSV",19,0 )
	6738	. . S ERR ="Duplicat e file was received for Patien t Statemen t Date: "_ $P(^TMP($
	6739	J,"MSG",TX T),U,7) D ERRMSG
	6740	"RTN","RCC PCSV",20,0 )
	6741	. . S ERR ="Last Mes sage Ackno wledgement Number: " _$P(^TMP($ J,"MSG",TX T),U,2) D
	6742	ERRMSG
	6743	"RTN","RCC PCSV",21,0 )
	6744	. . S SDT =$P(^TMP($ J,"MSG",TX T),U,7)
	6745	"RTN","RCC PCSV",22,0 )
	6746	. ; PRCA* 4.5*313 - If IT is r eceived it always pr ocesses
	6747	"RTN","RCC PCSV",23,0 )
	6748	. I $P(^T MP($J,"MSG ",TXT),U)= "IT" S SDT =$P(^TMP($ J,"MSG",TX T),"^",6), NOERR=1 Q
	6749	"RTN","RCC PCSV",24,0 )
	6750	.I $G(XMZ )=""!('DA( 1))!($D(ER R)) Q
	6751	"RTN","RCC PCSV",25,0 )
	6752	.S RCX=RC X+1
	6753	"RTN","RCC PCSV",26,0 )
	6754	. I "PAIS ADID"[$E(^ TMP($J,"MS G",TXT),1, 2) D
	6755	"RTN","RCC PCSV",27,0 )
	6756	. . ; PRC A4.5313 - Add Stat ement Date to 349.1, five leve l for PA, IS, AD, a
	6757	nd ID reco rds
	6758	"RTN","RCC PCSV",28,0 )
	6759	. . N DIN UM,DIC,X
	6760	"RTN","RCC PCSV",29,0 )
	6761	. . S DIN UM=+$G(XMZ )_RCX
	6762	"RTN","RCC PCSV",30,0 )
	6763	. . S DIC ="^RCT(349 .1,DA(1),5 ,"
	6764	"RTN","RCC PCSV",31,0 )
	6765	. . S X=$ P(^TMP($J, "MSG",TXT) ,"^",2)
	6766	"RTN","RCC PCSV",32,0 )
	6767	. . S DIC (0)="L"
	6768	"RTN","RCC PCSV",33,0 )
	6769	. . S DIC ("DR")=".0 2////"_$P( ^TMP($J,"M SG",TXT)," ^",3)_";.0 3////"_$G( XMZ)_";.0
	6770	4////"_SDT
	6771	"RTN","RCC PCSV",34,0 )
	6772	. . D FIL E^DICN
	6773	"RTN","RCC PCSV",35,0 )
	6774	. ; PRCA* 4.5*313 - If process ing has oc curred
	6775	"RTN","RCC PCSV",36,0 )
	6776	. S NOERR =1
	6777	"RTN","RCC PCSV",37,0 )
	6778	;
	6779	"RTN","RCC PCSV",38,0 )
	6780	K DA(1)
	6781	"RTN","RCC PCSV",39,0 )
	6782	I NOERR D SEG,KILL^ XM
	6783	"RTN","RCC PCSV",40,0 )
	6784	I $O(^TMP ($J,"ERR", 0)) D
	6785	"RTN","RCC PCSV",41,0 )
	6786	. ; PRCA* 4.5*313 - Change CCP C to CBSS and add da te
	6787	"RTN","RCC PCSV",42,0 )
	6788	.S XMSUB= "CBSS ERRO R MESSAGE TO STATION FOR "_SDT
	6789	"RTN","RCC PCSV",43,0 )
	6790	.S XMDUZ= "AR PACKAG E"
	6791	"RTN","RCC PCSV",44,0 )
	6792	.S XMTEXT ="^TMP($J, "_"""ERR"" ,"
	6793	"RTN","RCC PCSV",45,0 )
	6794	.I $O(^XM B(3.8,"B", "RCCPC STA TEMENTS",0 )) S XMY(" G.RCCPC ST ATEMENTS") =""
	6795	"RTN","RCC PCSV",46,0 )
	6796	.D ^XMD
	6797	"RTN","RCC PCSV",47,0 )
	6798	.K ^TMP($ J)
	6799	"RTN","RCC PCSV",48,0 )
	6800	. ; PRCA* 4.5*313 - Change to send SDT f or resend
	6801	"RTN","RCC PCSV",49,0 )
	6802	.D:$G(RE) ="R"&($G(S DT)'="") E N^RCCPCML( SDT)
	6803	"RTN","RCC PCSV",50,0 )
	6804	E S XMZ= XQMSG,XMSE R="S."_XQS OP D REMSB MSG^XMA1C
	6805	"RTN","RCC PCSV",51,0 )
	6806	Q
	6807	"RTN","RCC PCSV",52,0 )
	6808	;
	6809	"RTN","RCC PCSV",53,0 )
	6810	SEG S RCMS G=1 S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) D
	6811	"RTN","RCC PCSV",54,0 )
	6812	.S RCTR=^ TMP($J,"MS G",RCMSG)
	6813	"RTN","RCC PCSV",55,0 )
	6814	.S LABEL= $S(($P(RCT R,"^")]"") &($T(@($P( RCTR,"^")) )]""):$P(R CTR,"^"),1 :"ERROR")
	6815	"RTN","RCC PCSV",56,0 )
	6816	.D @(LABE L)
	6817	"RTN","RCC PCSV",57,0 )
	6818	Q
	6819	"RTN","RCC PCSV",58,0 )
	6820	;
	6821	"RTN","RCC PCSV",59,0 )
	6822	ERROR ;SEN D ERROR ME SSAGE TO M AIL GROUP
	6823	"RTN","RCC PCSV",60,0 )
	6824	;
	6825	"RTN","RCC PCSV",61,0 )
	6826	; PRCA4. 5313 - Ch ange CCPC to CBSS
	6827	"RTN","RCC PCSV",62,0 )
	6828	S ERR="CB SS ERROR - CANNOT RE AD MESSAGE FROM CBSS " D ERRMSG
	6829	"RTN","RCC PCSV",63,0 )
	6830	S ERR="An error has occurred in reading a message from the CBSS."
	6831	"RTN","RCC PCSV",64,0 )
	6832	D ERRMSG
	6833	"RTN","RCC PCSV",65,0 )
	6834	S ERR="Pl ease conta ct your IR M for assi stance."
	6835	"RTN","RCC PCSV",66,0 )
	6836	D ERRMSG
	6837	"RTN","RCC PCSV",67,0 )
	6838	S ERR="Th e MESSAGE WAS AS FOL LOWS:"
	6839	"RTN","RCC PCSV",68,0 )
	6840	D ERRMSG
	6841	"RTN","RCC PCSV",69,0 )
	6842	S ERR=^TM P($J,"MSG" ,RCMSG)
	6843	"RTN","RCC PCSV",70,0 )
	6844	D ERRMSG
	6845	"RTN","RCC PCSV",71,0 )
	6846	Q
	6847	"RTN","RCC PCSV",72,0 )
	6848	;
	6849	"RTN","RCC PCSV",73,0 )
	6850	IS ;INVALI D STATEMEN T
	6851	"RTN","RCC PCSV",74,0 )
	6852	D IS^RCCP CSV1
	6853	"RTN","RCC PCSV",75,0 )
	6854	Q
	6855	"RTN","RCC PCSV",76,0 )
	6856	;
	6857	"RTN","RCC PCSV",77,0 )
	6858	PA ;STATEM ENT ACKNOW LEDGEMENT
	6859	"RTN","RCC PCSV",78,0 )
	6860	D PA^RCCP CSV1
	6861	"RTN","RCC PCSV",79,0 )
	6862	Q
	6863	"RTN","RCC PCSV",80,0 )
	6864	;
	6865	"RTN","RCC PCSV",81,0 )
	6866	IT ;INVALI D TRANSMIS SION
	6867	"RTN","RCC PCSV",82,0 )
	6868	D IT^RCCP CSV1
	6869	"RTN","RCC PCSV",83,0 )
	6870	Q
	6871	"RTN","RCC PCSV",84,0 )
	6872	;
	6873	"RTN","RCC PCSV",85,0 )
	6874	ERRMSG ;ER ROR MESSAG E
	6875	"RTN","RCC PCSV",86,0 )
	6876	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	6877	"RTN","RCC PCSV",87,0 )
	6878	Q
	6879	"RTN","RCC PCSV1")
	6880	0^12^B4366 3255^B3201 7096
	6881	"RTN","RCC PCSV1",1,0 )
	6882	RCCPCSV1 ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 2:
	6883	54 PM
	6884	"RTN","RCC PCSV1",2,0 )
	6885	;;4.5;Acc ounts Rece ivable;*3 4,70,76,13 0,153,313 *;Mar 20, 1995;Build 113
	6886	"RTN","RCC PCSV1",3,0 )
	6887	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	6888	"RTN","RCC PCSV1",4,0 )
	6889	;
	6890	"RTN","RCC PCSV1",5,0 )
	6891	IS ;INVALI D STATEMEN T
	6892	"RTN","RCC PCSV1",6,0 )
	6893	; PRCA4. 5313 - Ad d SDT for Patient St atement Da te
	6894	"RTN","RCC PCSV1",7,0 )
	6895	N SDAT,SD T,X,Y,ERR
	6896	"RTN","RCC PCSV1",8,0 )
	6897	S SDAT=$P (RCTR,"^", 7) S (X,SD T)=SDAT D ^%DT S SDA T=Y
	6898	"RTN","RCC PCSV1",9,0 )
	6899	D CHKTRAN (LABEL)
	6900	"RTN","RCC PCSV1",10, 0)
	6901	S ERR="Th e followin g statemen ts did not print due to errors :" D ERRMS G
	6902	"RTN","RCC PCSV1",11, 0)
	6903	S ERR=" " D ERRMSG
	6904	"RTN","RCC PCSV1",12, 0)
	6905	S ERR=" KEY ER ROR" D ERR MSG S ERR= " " D ERRM SG
	6906	"RTN","RCC PCSV1",13, 0)
	6907	D ID
	6908	"RTN","RCC PCSV1",14, 0)
	6909	S ERR="If these err ors are co rrected, t hese state ments will not print until" D
	6910	ERRMSG S ERR="the n ext billin g cycle." D ERRMSG
	6911	"RTN","RCC PCSV1",15, 0)
	6912	Q
	6913	"RTN","RCC PCSV1",16, 0)
	6914	;
	6915	"RTN","RCC PCSV1",17, 0)
	6916	ID ;INVALI D STATEMEN T DETAIL E RROR
	6917	"RTN","RCC PCSV1",18, 0)
	6918	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	6919	"RTN","RCC PCSV1",19, 0)
	6920	. ; PRCA* 4.5*313 - Clean up v ariables
	6921	"RTN","RCC PCSV1",20, 0)
	6922	. N KEY,D EB,ERROR,R CX,RCX1,ER R,LN
	6923	"RTN","RCC PCSV1",21, 0)
	6924	.I $P(^TM P($J,"MSG" ,RCMSG),"^ ")'="ID" S ERR="ERRO R IN READI NG CBSS ER ROR RECOR
	6925	D" D ERRMS G Q
	6926	"RTN","RCC PCSV1",22, 0)
	6927	.S KEY=$P (^TMP($J," MSG",RCMSG ),"^",2),K EY=$TR(KEY ," ",""),K EY=$E(KEY, $F(KEY,$$
	6928	SITE^RCMSI TE),999)
	6929	"RTN","RCC PCSV1",23, 0)
	6930	.I KEY']" " D KEYERR Q
	6931	"RTN","RCC PCSV1",24, 0)
	6932	.S DEB=$O (^RCPS(349 .2,"AKEY", KEY,0)) I 'DEB D KEY ERR Q
	6933	"RTN","RCC PCSV1",25, 0)
	6934	.S ERROR= $P(^TMP($J ,"MSG",RCM SG),"^",3) ,^RCPS(349 .2,+DEB,5) =ERROR
	6935	"RTN","RCC PCSV1",26, 0)
	6936	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERR(0)=$E( ERROR,RCX, RCX1) Q:ER R(0)="" D
	6937	"RTN","RCC PCSV1",27, 0)
	6938	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERR(0)," "))
	6939	"RTN","RCC PCSV1",28, 0)
	6940	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RR(0)
	6941	"RTN","RCC PCSV1",29, 0)
	6942	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 )
	6943	"RTN","RCC PCSV1",30, 0)
	6944	..S ERR=K EY_" "_ERR (0)_" "_ER R
	6945	"RTN","RCC PCSV1",31, 0)
	6946	..D ERRMS G
	6947	"RTN","RCC PCSV1",32, 0)
	6948	..S ERR=" " D ERRMS G
	6949	"RTN","RCC PCSV1",33, 0)
	6950	.S ^RCPS( 349.2,+DEB ,5)=$P(^TM P($J,"MSG" ,RCMSG),"^ ",3)
	6951	"RTN","RCC PCSV1",34, 0)
	6952	.S ^RCPS( 349.2,"AD" ,"E",+DEB) =""
	6953	"RTN","RCC PCSV1",35, 0)
	6954	Q
	6955	"RTN","RCC PCSV1",36, 0)
	6956	;
	6957	"RTN","RCC PCSV1",37, 0)
	6958	;
	6959	"RTN","RCC PCSV1",38, 0)
	6960	KEYERR ;SE ND MESSAGE TO MAIL G ROUP INDIC ATING NO K EY
	6961	"RTN","RCC PCSV1",39, 0)
	6962	S ERR="CB SS ERROR M ESSAGE - N O AR KEY I D FOR CBSS KEY: "_KE Y D ERRMSG
	6963	"RTN","RCC PCSV1",40, 0)
	6964	S ERR="Th is patient record is corrupted . Please c ontact IRM ." D ERRMS G
	6965	"RTN","RCC PCSV1",41, 0)
	6966	S ERR=" " D ERRMSG
	6967	"RTN","RCC PCSV1",42, 0)
	6968	Q
	6969	"RTN","RCC PCSV1",43, 0)
	6970	;
	6971	"RTN","RCC PCSV1",44, 0)
	6972	PA ;STATEM ENT ACKNOW LEDGEMENT
	6973	"RTN","RCC PCSV1",45, 0)
	6974	N STDT,SS TDT,SDAT,S DT,IEN,DEB ,X,Y,STOT, SEQ,KEY,EN D,SBAL,EVN ,DA,DIK
	6975	"RTN","RCC PCSV1",46, 0)
	6976	Q:$P(RCTR ,"^")'="PA "
	6977	"RTN","RCC PCSV1",47, 0)
	6978	; D CHKTR AN(LABEL)
	6979	"RTN","RCC PCSV1",48, 0)
	6980	S (X,SDT) =$P(RCTR," ^",7) D ^% DT S SDAT= Y
	6981	"RTN","RCC PCSV1",49, 0)
	6982	D CHKTRAN (LABEL)
	6983	"RTN","RCC PCSV1",50, 0)
	6984	S STOT=+$ P(RCTR,"^" ,6)
	6985	"RTN","RCC PCSV1",51, 0)
	6986	S SEQ=+$P (RCTR,"^", 3)
	6987	"RTN","RCC PCSV1",52, 0)
	6988	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	6989	"RTN","RCC PCSV1",53, 0)
	6990	. N P
	6991	"RTN","RCC PCSV1",54, 0)
	6992	.S RCTR=^ TMP($J,"MS G",RCMSG)
	6993	"RTN","RCC PCSV1",55, 0)
	6994	.Q:$P(RCT R,"^")'="A D"
	6995	"RTN","RCC PCSV1",56, 0)
	6996	.S KEY=$P (RCTR,"^", 2),KEY=$TR (KEY," "," "),KEY=$E( KEY,$F(KEY ,$$SITE^RC MSITE),99
	6997	9)
	6998	"RTN","RCC PCSV1",57, 0)
	6999	.I KEY']" " D KEYERR Q
	7000	"RTN","RCC PCSV1",58, 0)
	7001	.;PRCA4. 5313 - Fi nd Debtor using IEN from 349.2
	7002	"RTN","RCC PCSV1",59, 0)
	7003	.S IEN=$O (^RCPS(349 .2,"AKEY", KEY,0))
	7004	"RTN","RCC PCSV1",60, 0)
	7005	.I '$G(IE N) D KEYER R Q
	7006	"RTN","RCC PCSV1",61, 0)
	7007	.S DEB=$P (^RCPS(349 .2,IEN,0), U)
	7008	"RTN","RCC PCSV1",62, 0)
	7009	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	7010	"RTN","RCC PCSV1",63, 0)
	7011	.I IEN S END=$P(^RC PS(349.2,+ IEN,0),"^" ,10)
	7012	"RTN","RCC PCSV1",64, 0)
	7013	.S:'$G(EN D) END=$O( ^RCPS(349. 2,"STDT",S DAT,0)),EN D=$P($G(^( +END,0))," ^",10)
	7014	"RTN","RCC PCSV1",65, 0)
	7015	.F P=13:1 :17 S SBAL (P)=$P(^RC PS(349.2,+ IEN,0),"^" ,P)
	7016	"RTN","RCC PCSV1",66, 0)
	7017	.;update patient st atement da te in 341 to end pro cess time
	7018	"RTN","RCC PCSV1",67, 0)
	7019	.D OPEN^R CEVDRV1(2, $P(^RCD(34 0,DEB,0),U ),END,DUZ, $$SITE^RCM SITE,.ERR, .EVN,SBAL
	7020	(13)_U_SBA L(14)_U_SB AL(15)_U_S BAL(16)_U_ SBAL(17))
	7021	"RTN","RCC PCSV1",68, 0)
	7022	.I EVN S DR=".07/// /"_END_";. 11////"_1, DA=+EVN,DI E="^RC(341 ," D ^DIE K DIE,DR,
	7023	DA
	7024	"RTN","RCC PCSV1",69, 0)
	7025	. ; PRCA* 4.5*313 - Add cross- reference for File
	7026	"RTN","RCC PCSV1",70, 0)
	7027	.I EVN S $P(^RC(341 ,+EVN,6)," ^")=$G(SDA T) D
	7028	"RTN","RCC PCSV1",71, 0)
	7029	. . S DA= +EVN,DIK=" ^RC(341," D IX1^DIK
	7030	"RTN","RCC PCSV1",72, 0)
	7031	.;update bill file 430 letter fields
	7032	"RTN","RCC PCSV1",73, 0)
	7033	.NEW BN,D A,DIC,DIE, DR,II,LET, NOT,X,Y
	7034	"RTN","RCC PCSV1",74, 0)
	7035	.S DIE="^ PRCA(430," ,NOT=0,BN= 0
	7036	"RTN","RCC PCSV1",75, 0)
	7037	.F S BN= $O(^PRCA(4 30,"AS",DE B,16,BN)) Q:'BN S D A=BN D
	7038	"RTN","RCC PCSV1",76, 0)
	7039	..S LET=$ G(^PRCA(43 0,BN,6))
	7040	"RTN","RCC PCSV1",77, 0)
	7041	..I $P(LE T,"^",21)> END Q
	7042	"RTN","RCC PCSV1",78, 0)
	7043	..S END=$ G(SDAT)
	7044	"RTN","RCC PCSV1",79, 0)
	7045	..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=
	7046	3:63,1:68) _"////^S X ="_END_";6 8.1////^S X="_END D ^DIE Q
	7047	"RTN","RCC PCSV1",80, 0)
	7048	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	7049	"RTN","RCC PCSV1",81, 0)
	7050	.S ^RCPS( 349.2,+IEN ,6)=1
	7051	"RTN","RCC PCSV1",82, 0)
	7052	PAMAIL ;
	7053	"RTN","RCC PCSV1",83, 0)
	7054	N XMSUB,X MY,XMDUZ,X MTEXT,MSG
	7055	"RTN","RCC PCSV1",84, 0)
	7056	; PRCA4. 5313 - Ch ange to CB SS
	7057	"RTN","RCC PCSV1",85, 0)
	7058	S XMSUB=" Patient Ac knowledgme nts receiv ed from CB SS."
	7059	"RTN","RCC PCSV1",86, 0)
	7060	S XMY("G. RCCPC STAT EMENTS")=" ",XMDUZ="A R PACKAGE" ,XMTEXT="M SG("
	7061	"RTN","RCC PCSV1",87, 0)
	7062	; PRCA4. 5313 - Ad d Patient Statement Date and r enumber ot her lines
	7063	"RTN","RCC PCSV1",88, 0)
	7064	S MSG(1)= "For Patie nt Stateme nt Date of "_SDT_"."
	7065	"RTN","RCC PCSV1",89, 0)
	7066	S MSG(2)= "Patient a cknowledgm ent messag e "_$G(XMZ )_" receiv ed."
	7067	"RTN","RCC PCSV1",90, 0)
	7068	S MSG(3)= "This mean s that CBS S has prin ted patien t statemen ts for thi s stateme
	7069	nt period. "
	7070	"RTN","RCC PCSV1",91, 0)
	7071	D ^XMD
	7072	"RTN","RCC PCSV1",92, 0)
	7073	Q
	7074	"RTN","RCC PCSV1",93, 0)
	7075	;
	7076	"RTN","RCC PCSV1",94, 0)
	7077	CHKTRAN(LA BEL) ;Chec k for inco mplete mes sage from CCPC
	7078	"RTN","RCC PCSV1",95, 0)
	7079	; PRCA4. 5313 - Ad d multiple entries b ased upon date to fo ur level
	7080	"RTN","RCC PCSV1",96, 0)
	7081	Q:$G(LABE L)']""
	7082	"RTN","RCC PCSV1",97, 0)
	7083	N PSIEN,D A,DIK,DO,D IC,X
	7084	"RTN","RCC PCSV1",98, 0)
	7085	S LABEL(1 )=+$O(^RCT (349.1,"B" ,LABEL,0))
	7086	"RTN","RCC PCSV1",99, 0)
	7087	; PRCA4. 5313 - Ad d Patient Statement Date to fo ur level
	7088	"RTN","RCC PCSV1",100 ,0)
	7089	I LABEL(1 ),$P(^TMP( $J,"MSG",R CMSG),"^", 2)=$P(^TMP ($J,"MSG", RCMSG),"^" ,3) D
	7090	"RTN","RCC PCSV1",101 ,0)
	7091	. S DIC=" ^RCT(349.1 ,LABEL(1), 4,"
	7092	"RTN","RCC PCSV1",102 ,0)
	7093	. S X=$P( ^TMP($J,"M SG",RCMSG) ,"^",2)
	7094	"RTN","RCC PCSV1",103 ,0)
	7095	. S DA(1) =LABEL(1), DIC(0)="L"
	7096	"RTN","RCC PCSV1",104 ,0)
	7097	. S DIC(" DR")=".02/ ///"_$P(^T MP($J,"MSG ",RCMSG)," ^",3)_";.0 3////"_$G( XMZ)_";.0
	7098	4////"_SDA T
	7099	"RTN","RCC PCSV1",105 ,0)
	7100	. D FILE^ DICN
	7101	"RTN","RCC PCSV1",106 ,0)
	7102	Q
	7103	"RTN","RCC PCSV1",107 ,0)
	7104	;
	7105	"RTN","RCC PCSV1",108 ,0)
	7106	TRANCHK ;C heck for c omplete AC K transmis sion
	7107	"RTN","RCC PCSV1",109 ,0)
	7108	; PRCA4. 5313 - Ch eck for st atement da tes five t o seven da ys in past since bu
	7109	ild and tr ansmit.
	7110	"RTN","RCC PCSV1",110 ,0)
	7111	N X,Y,DAT E,SDT,I,X1 ,X2
	7112	"RTN","RCC PCSV1",111 ,0)
	7113	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
	7114	"RTN","RCC PCSV1",112 ,0)
	7115	Q
	7116	"RTN","RCC PCSV1",113 ,0)
	7117	;
	7118	"RTN","RCC PCSV1",114 ,0)
	7119	TRANCHK1 ; PRCA4.5 313 - Vali date trans mission co mpleteness for date provided.
	7120	"RTN","RCC PCSV1",115 ,0)
	7121	N MSG,RCT ,SEG,SEQ,I EN,XMDUZ,X MSUB,XMTEX T,XMY
	7122	"RTN","RCC PCSV1",116 ,0)
	7123	F RCT=3,4 S IEN=$O( ^RCT(349.1 ,RCT,4,"ST DT4",SDT,0 )) I IEN'= "",$P($G(^ RCT(349.1
	7124	,+RCT,4,IE N,0)),"^") '=$P($G(^R CT(349.1,+ RCT,4,IEN, 0)),"^",2) D
	7125	"RTN","RCC PCSV1",117 ,0)
	7126	.S XMDUZ= "AR PACKAG E"
	7127	"RTN","RCC PCSV1",118 ,0)
	7128	. ; PRCA* 4.5*313 - Change CCP C to CBSS
	7129	"RTN","RCC PCSV1",119 ,0)
	7130	.S XMSUB= "CBSS ACKN OWLEDGMENT TRANSMISS ION(S) INC OMPLETE"
	7131	"RTN","RCC PCSV1",120 ,0)
	7132	.I $O(^XM B(3.8,"B", "RCCPC STA TEMENTS",0 )) S XMY(" G.RCCPC ST ATEMENTS") ="" E S
	7133	XMY(.5)=""
	7134	"RTN","RCC PCSV1",121 ,0)
	7135	.S XMTEXT ="MSG("
	7136	"RTN","RCC PCSV1",122 ,0)
	7137	.S SEG=$S (RCT=3:"IS ",1:"PA")
	7138	"RTN","RCC PCSV1",123 ,0)
	7139	.S SEG(1) =$P(^RCT(3 49.1,+RCT, 4,IEN,0)," ^",2)
	7140	"RTN","RCC PCSV1",124 ,0)
	7141	.; PRCA4 .5313 - A dd line id entifying Patient St atement Da te that er rored
	7142	"RTN","RCC PCSV1",125 ,0)
	7143	.S MSG(2) ="For Pati ent Statem ent Date o f "_DATE_" ."
	7144	"RTN","RCC PCSV1",126 ,0)
	7145	. ; PRCA* 4.5*313 - Change CCP C to CBSS
	7146	"RTN","RCC PCSV1",127 ,0)
	7147	.S MSG(3) ="The last "_SEG_" s egment mes sage recei ved from C BSS was nu mbered "_
	7148	SEG(1)_"."
	7149	"RTN","RCC PCSV1",128 ,0)
	7150	.S MSG(4) ="This was not label ed the fin al message in that s egment typ e transmi
	7151	ssion."
	7152	"RTN","RCC PCSV1",129 ,0)
	7153	.S MSG(5) ="This may cause pat ient state ment infor mation to be missing ."
	7154	"RTN","RCC PCSV1",130 ,0)
	7155	.S MSG(6) ="The last message n umber rece ived was " _$P($G(^RC T(349.1,RC T,4,IEN,0
	7156	)),"^",3)
	7157	"RTN","RCC PCSV1",131 ,0)
	7158	. ; PRCA* 4.5*313 - Change CCP C to CBSS
	7159	"RTN","RCC PCSV1",132 ,0)
	7160	.S MSG(7) ="Please c ontact the CBSS in A ustin."
	7161	"RTN","RCC PCSV1",133 ,0)
	7162	.D ^XMD
	7163	"RTN","RCC PCSV1",134 ,0)
	7164	Q
	7165	"RTN","RCC PCSV1",135 ,0)
	7166	;
	7167	"RTN","RCC PCSV1",136 ,0)
	7168	;
	7169	"RTN","RCC PCSV1",137 ,0)
	7170	IT ;INVALI D TRANSMIS SION
	7171	"RTN","RCC PCSV1",138 ,0)
	7172	; PRCA4. 5313 - Ch ange messa ge from CC PC to CBSS
	7173	"RTN","RCC PCSV1",139 ,0)
	7174	N SDT,ERR ,MSG,RCX,R CX1,ERROR, RE
	7175	"RTN","RCC PCSV1",140 ,0)
	7176	S ERR="Th e CBSS pat ient state ment messa ges were n ot accepte d by CBSS" D ERRMSG
	7177	"RTN","RCC PCSV1",141 ,0)
	7178	; PRCA4. 5313 - Ad d statemen t date to error mess age
	7179	"RTN","RCC PCSV1",142 ,0)
	7180	S SDT=$P( ^TMP($J,"M SG",RCMSG) ,"^",6)
	7181	"RTN","RCC PCSV1",143 ,0)
	7182	S ERR="fo r "_SDT_" due to the following error(s): " D ERRMSG
	7183	"RTN","RCC PCSV1",144 ,0)
	7184	S ERR=" " D ERRMSG
	7185	"RTN","RCC PCSV1",145 ,0)
	7186	S RCMSG=1 F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	7187	"RTN","RCC PCSV1",146 ,0)
	7188	.S MSG=^T MP($J,"MSG ",RCMSG)
	7189	"RTN","RCC PCSV1",147 ,0)
	7190	.S MSG=$P (MSG,"^",8 )
	7191	"RTN","RCC PCSV1",148 ,0)
	7192	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERROR=$E(M SG,RCX,RCX 1) Q:ERROR ="" D
	7193	"RTN","RCC PCSV1",149 ,0)
	7194	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERROR,"" ))
	7195	"RTN","RCC PCSV1",150 ,0)
	7196	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RROR
	7197	"RTN","RCC PCSV1",151 ,0)
	7198	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 ),ERR=ERRO R_" "_ERR
	7199	"RTN","RCC PCSV1",152 ,0)
	7200	..I ERR(1 ) S:$P(^RC PSE(349.7, +ERR(1),0) ,"^",3)="R " RE=1
	7201	"RTN","RCC PCSV1",153 ,0)
	7202	..D ERRMS G
	7203	"RTN","RCC PCSV1",154 ,0)
	7204	S ERR=" " D ERRMSG
	7205	"RTN","RCC PCSV1",155 ,0)
	7206	S ERR="Pl ease conta ct IRM."
	7207	"RTN","RCC PCSV1",156 ,0)
	7208	D ERRMSG
	7209	"RTN","RCC PCSV1",157 ,0)
	7210	Q
	7211	"RTN","RCC PCSV1",158 ,0)
	7212	;
	7213	"RTN","RCC PCSV1",159 ,0)
	7214	ERRMSG ;ER ROR MESSAG E
	7215	"RTN","RCC PCSV1",160 ,0)
	7216	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	7217	"RTN","RCC PCSV1",161 ,0)
	7218	Q
	7219	"RTN","RCC PCT")
	7220	0^15^B2364 1825^B2489 697
	7221	"RTN","RCC PCT",1,0)
	7222	RCCPCT ;WA SH-ISC@ALT OONA,PA/LD B - CCPC P atient Sta tement mes sage total s ;11/7/9
	7223	6 10:53 A M
	7224	"RTN","RCC PCT",2,0)
	7225	;;4.5;Acc ounts Rece ivable;3 4,313;Ma r 20, 1995 ;Build 113
	7226	"RTN","RCC PCT",3,0)
	7227	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	7228	"RTN","RCC PCT",4,0)
	7229	EN ;
	7230	"RTN","RCC PCT",5,0)
	7231	D GO
	7232	"RTN","RCC PCT",6,0)
	7233	K TDT,TDT 1,TDT2,TDT 3,DATE,PTO T,TTOT,L,X ,Y,Y1,Y2,D ,IEN,DTOUT ,POP,Q,%,% DT,%ZIS,%
	7234	Y
	7235	"RTN","RCC PCT",7,0)
	7236	Q
	7237	"RTN","RCC PCT",8,0)
	7238	GO ;
	7239	"RTN","RCC PCT",9,0)
	7240	W @IOF W !,"This re port will print the total Pati ent Statem ents sent to CBSS a
	7241	nd the"
	7242	"RTN","RCC PCT",10,0)
	7243	W !,"tota l acknowle dged as ha ving been printed wi th three d ifferent r eport"
	7244	"RTN","RCC PCT",11,0)
	7245	W !,"form ats availa ble."
	7246	"RTN","RCC PCT",12,0)
	7247	W !!,"The first for mat is jus t a single summary t otal repor t of all S tatement"
	7248	"RTN","RCC PCT",13,0)
	7249	W !,"Date s."
	7250	"RTN","RCC PCT",14,0)
	7251	W !!,"The second fo rmat is al l Statemen t Dates pr inted indi vidually w ith total
	7252	s"
	7253	"RTN","RCC PCT",15,0)
	7254	W !,"and a summary total at t he end."
	7255	"RTN","RCC PCT",16,0)
	7256	W !!,"The third for mat is pri nting the totals for a single Statement Date sele
	7257	cted.",!
	7258	"RTN","RCC PCT",17,0)
	7259	N X K DIR S DIR(0)= "E",DIR("A ")="Press Return to Continue o r ^ to Exi t" D ^DIR
	7260	K DIR I X ="^" Q
	7261	"RTN","RCC PCT",18,0)
	7262	S IEN="" F S IEN=$ O(^RCT(349 ,"SDT",IEN )) Q:IEN=" " S TDT(I EN)=""
	7263	"RTN","RCC PCT",19,0)
	7264	W @IOF W !!,"The fo llowing Pa tient Stat ement Date s are avai lable for the Total
	7265	s Report:" ,!
	7266	"RTN","RCC PCT",20,0)
	7267	S TDT1="" F S TDT1 =$O(TDT(TD T1)) Q:TDT 1="" D
	7268	"RTN","RCC PCT",21,0)
	7269	.S TDT3=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",T DT1,0)),0) ,"^",9) W !,$$DATE^R CCPCPS1(T
	7270	DT3)
	7271	"RTN","RCC PCT",22,0)
	7272	W !!,"Do you want t o print a single tot al for ALL the avail able dates "
	7273	"RTN","RCC PCT",23,0)
	7274	S %=1 D Y N^DICN I % Y="^" Q
	7275	"RTN","RCC PCT",24,0)
	7276	I %=1 D Q
	7277	"RTN","RCC PCT",25,0)
	7278	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	7279	"RTN","RCC PCT",26,0)
	7280	.I $D(IO( "Q")) D Q
	7281	"RTN","RCC PCT",27,0)
	7282	..S Q=1
	7283	"RTN","RCC PCT",28,0)
	7284	..S ZTRTN ="STARTS^R CCPCT",ZTD ESC="CBSS ALL PATIEN T STATEMEN TS TOTAL R EPORT"
	7285	"RTN","RCC PCT",29,0)
	7286	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	7287	"RTN","RCC PCT",30,0)
	7288	..D ^%ZTL OAD
	7289	"RTN","RCC PCT",31,0)
	7290	..K ZTRTN ,ZTDESC,ZT SAVE
	7291	"RTN","RCC PCT",32,0)
	7292	.E D STA RTS Q
	7293	"RTN","RCC PCT",33,0)
	7294	W !!,"Do you want t o print se parate tot als for AL L the avai lable date s"
	7295	"RTN","RCC PCT",34,0)
	7296	S %=1 D Y N^DICN I % Y="^" Q
	7297	"RTN","RCC PCT",35,0)
	7298	I %=1 D Q
	7299	"RTN","RCC PCT",36,0)
	7300	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	7301	"RTN","RCC PCT",37,0)
	7302	.I $D(IO( "Q")) D Q
	7303	"RTN","RCC PCT",38,0)
	7304	..S Q=1
	7305	"RTN","RCC PCT",39,0)
	7306	..S ZTRTN ="START^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	7307	"RTN","RCC PCT",40,0)
	7308	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	7309	"RTN","RCC PCT",41,0)
	7310	..D ^%ZTL OAD
	7311	"RTN","RCC PCT",42,0)
	7312	..K ZTRTN ,ZTDESC,ZT SAVE
	7313	"RTN","RCC PCT",43,0)
	7314	.E D STA RT Q
	7315	"RTN","RCC PCT",44,0)
	7316	W ! S %DT ="AEXP",%D T("A")="En ter a sing le Patient Statement date: "
	7317	"RTN","RCC PCT",45,0)
	7318	D ^%DT Q: (X="^")!($ D(DTOUT))! (Y=-1)
	7319	"RTN","RCC PCT",46,0)
	7320	S Y1=+$E( Y,6,7),Y2= Y
	7321	"RTN","RCC PCT",47,0)
	7322	I '$D(TDT (Y1)) W !, "There are no record s for that date." Q
	7323	"RTN","RCC PCT",48,0)
	7324	D HOME^%Z IS S %ZIS= "AEQ" D ^% ZIS Q:POP
	7325	"RTN","RCC PCT",49,0)
	7326	I $D(IO(" Q")) D Q
	7327	"RTN","RCC PCT",50,0)
	7328	.S Q=1
	7329	"RTN","RCC PCT",51,0)
	7330	.S ZTRTN= "START1^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	7331	"RTN","RCC PCT",52,0)
	7332	.S ZTSAVE ("Q")="",Z TSAVE("Y1" )="",ZTSAV E("Y2")=""
	7333	"RTN","RCC PCT",53,0)
	7334	.D ^%ZTLO AD
	7335	"RTN","RCC PCT",54,0)
	7336	.K ZTRTN, ZTDESC,ZTS AVE
	7337	"RTN","RCC PCT",55,0)
	7338	START1 ;Th is will pr int a summ ary total for a sing le date
	7339	"RTN","RCC PCT",56,0)
	7340	N PTOT,TT OT,X,D
	7341	"RTN","RCC PCT",57,0)
	7342	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
	7343	TTOT=$P(^R CT(349,X,0 ),"^",7)+T TOT
	7344	"RTN","RCC PCT",58,0)
	7345	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,"STD T",Y2,X)) Q:'X I $G (^RCPS(349 .2,X,6))
	7346	S PTOT=PTO T+1
	7347	"RTN","RCC PCT",59,0)
	7348	I IOST?1" C".E W @IO F
	7349	"RTN","RCC PCT",60,0)
	7350	W !,?10," CBSS Messa ge Totals for ",$$DA TE^RCCPCPS 1(Y2),!!
	7351	"RTN","RCC PCT",61,0)
	7352	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	7353	"RTN","RCC PCT",62,0)
	7354	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	7355	"RTN","RCC PCT",63,0)
	7356	W !,"==== ========== ========== ======="
	7357	"RTN","RCC PCT",64,0)
	7358	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	7359	"RTN","RCC PCT",65,0)
	7360	I '$D(Q) S DIR(0)=" E",DIR("A" )=" Press ENTER to C ontinue" D ^DIR K DI R
	7361	"RTN","RCC PCT",66,0)
	7362	Q
	7363	"RTN","RCC PCT",67,0)
	7364	START ;Thi s will pri nt separat e totals f or all ava ilable sta tement dat es
	7365	"RTN","RCC PCT",68,0)
	7366	N PTOT,TT OT,X,X1,DA TE S (TTOT ,PTOT,X,X1 )=0 S DATE =""
	7367	"RTN","RCC PCT",69,0)
	7368	U IO S (T DT1,TDT2)= ""
	7369	"RTN","RCC PCT",70,0)
	7370	I IOST?1" C".E W @IO F
	7371	"RTN","RCC PCT",71,0)
	7372	F S TDT1 =$O(TDT(TD T1)) Q:TDT 1="" D
	7373	"RTN","RCC PCT",72,0)
	7374	.I X="^" Q
	7375	"RTN","RCC PCT",73,0)
	7376	.S TTOT=0
	7377	"RTN","RCC PCT",74,0)
	7378	.F S TDT 2=$O(^RCT( 349,"SDT", TDT1,TDT2) ) Q:TDT2=" " D
	7379	"RTN","RCC PCT",75,0)
	7380	..S Y=$P( ^RCT(349,T DT2,0),"^" ,9)
	7381	"RTN","RCC PCT",76,0)
	7382	..S Y1=+$ E(Y,3,4),D ATE=$$DATE ^RCCPCPS1( Y)
	7383	"RTN","RCC PCT",77,0)
	7384	..S X=Y D ^%DT
	7385	"RTN","RCC PCT",78,0)
	7386	..I $D(^R CT(349,TDT 2,0)) S TT OT=$P(^RCT (349,TDT2, 0),"^",7)+ TTOT
	7387	"RTN","RCC PCT",79,0)
	7388	..S PTOT= 0,X1="" I $D(^RCPS(3 49.2,"STDT ",Y)) F S X1=$O(^RC PS(349.2," STDT",Y,X
	7389	1)) Q:'X1 I $G(^RCP S(349.2,X1 ,6)) S PTO T=PTOT+1
	7390	"RTN","RCC PCT",80,0)
	7391	.W !,?10, "CBSS Mess age Totals for ",DAT E,!!
	7392	"RTN","RCC PCT",81,0)
	7393	.W "Trans mission St atement To tal : ",$ J(TTOT,9)
	7394	"RTN","RCC PCT",82,0)
	7395	.W !,"CBS S Statemen ts Printed Total : " ,$J(PTOT,9 )
	7396	"RTN","RCC PCT",83,0)
	7397	.W !,"=== ========== ========== ========"
	7398	"RTN","RCC PCT",84,0)
	7399	.W !,"Tot al Not Pri nted : " ,$J(TTOT-P TOT,9),!
	7400	"RTN","RCC PCT",85,0)
	7401	.I '$D(Q) I $Y+4>IO SL D
	7402	"RTN","RCC PCT",86,0)
	7403	..K DIR S DIR(0)="E ",DIR("A") ="Press Re turn to Co ntinue or ^ to Exit"
	7404	"RTN","RCC PCT",87,0)
	7405	..D ^DIR K DIR W @I OF
	7406	"RTN","RCC PCT",88,0)
	7407	I X="^" Q
	7408	"RTN","RCC PCT",89,0)
	7409	W !!!," ****** ****** ****** ****** ******** *"
	7410	"RTN","RCC PCT",90,0)
	7411	STARTS ; T his will p rint the s ummary tot al for ALL available statement s
	7412	"RTN","RCC PCT",91,0)
	7413	N DATE,PT OT,TTOT,X, D
	7414	"RTN","RCC PCT",92,0)
	7415	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
	7416	)) Q:X="" I $D(^RCT (349,X,0)) S TTOT=$P (^RCT(349, X,0),"^",7 )+TTOT
	7417	"RTN","RCC PCT",93,0)
	7418	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,X)) Q:'X I $G (^(X,6)) S PTOT=PTOT +1
	7419	"RTN","RCC PCT",94,0)
	7420	W !!,?10, "CBSS Mess age Totals for ALL a vailable d ates ",!!
	7421	"RTN","RCC PCT",95,0)
	7422	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	7423	"RTN","RCC PCT",96,0)
	7424	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	7425	"RTN","RCC PCT",97,0)
	7426	W !,"==== ========== ========== ======="
	7427	"RTN","RCC PCT",98,0)
	7428	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	7429	"RTN","RCC PCT",99,0)
	7430	I '$D(Q) S DIR(0)=" E",DIR("A" )=" Press ENTER to C ontinue" D ^DIR K DI R
	7431	"VER")
	7432	8.0^22.2
	7433	"^DD",340, 340,.01,0)
	7434	DEBTOR^RV^ ^0;1^
	7435	"^DD",340, 340,.01,1, 0)
	7436	^.1
	7437	"^DD",340, 340,.01,1, 1,0)
	7438	340^B
	7439	"^DD",340, 340,.01,1, 1,1)
	7440	S ^RCD(340 ,"B",$E(X, 1,30),DA)= ""
	7441	"^DD",340, 340,.01,1, 1,2)
	7442	K ^RCD(340 ,"B",$E(X, 1,30),DA)
	7443	"^DD",340, 340,.01,1, 1,3)
	7444	Needed for look-up o f informat ion by Deb tor
	7445	"^DD",340, 340,.01,1, 1,"%D",0)
	7446	^^2^2^2931 014^^^^
	7447	"^DD",340, 340,.01,1, 1,"%D",1,0 )
	7448	This is th e regular FileMan 'B ' cross-re ference an d is used throughout the
	7449	"^DD",340, 340,.01,1, 1,"%D",2,0 )
	7450	AR package for users to look u p informat ion by deb tor.
	7451	"^DD",340, 340,.01,1, 2,0)
	7452	^^TRIGGER^ 340^.03
	7453	"^DD",340, 340,.01,1, 2,1)
	7454	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=
	7455	$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)
	7456	"^DD",340, 340,.01,1, 2,1.1)
	7457	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),";"),0), U)) S:X X
	7458	=+X
	7459	"^DD",340, 340,.01,1, 2,1.3)
	7460	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:"")
	7461	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
	7462	"^DD",340, 340,.01,1, 2,1.4)
	7463	S DIH=$S($ D(^RCD(340 ,DIV(0),0) ):^(0),1:" "),DIV=X S $P(^(0),U ,3)=DIV,DI H=340,DIG
	7464	=.03 D ^DI CR:$O(^DD( DIH,DIG,1, 0))>0
	7465	"^DD",340, 340,.01,1, 2,2)
	7466	Q
	7467	"^DD",340, 340,.01,1, 2,3)
	7468	Needed for assigning statement days for patients
	7469	"^DD",340, 340,.01,1, 2,"%D",0)
	7470	^.101^2^2^ 3160502^^^
	7471	"^DD",340, 340,.01,1, 2,"%D",1,0 )
	7472	This cross -reference sets the statement day for ne w patients as determ ined
	7473	"^DD",340, 340,.01,1, 2,"%D",2,0 )
	7474	by the fir st two let ters of th e patient' s last nam e.
	7475	"^DD",340, 340,.01,1, 2,"CREATE CONDITION" )
	7476	STATEMENT DAY=""&(IN TERNAL(DEB TOR)[";DPT (")
	7477	"^DD",340, 340,.01,1, 2,"CREATE VALUE")
	7478	S X=$$ACSE T^RCCPCFN1 ($P(^DPT($ P($P(^RCD( 340,D0,0) ,U),";"),0 ),U) S:X X =+X
	7479	"^DD",340, 340,.01,1, 2,"DELETE VALUE")
	7480	NO EFFECT
	7481	"^DD",340, 340,.01,1, 2,"DT")
	7482	2961010
	7483	"^DD",340, 340,.01,1, 2,"FIELD")
	7484	STATEMENT DAY
	7485	"^DD",340, 340,.01,1, 3,0)
	7486	340^AB^MUM PS
	7487	"^DD",340, 340,.01,1, 3,1)
	7488	S ^RCD(340 ,"AB",$P(X ,";",2),DA )=""
	7489	"^DD",340, 340,.01,1, 3,2)
	7490	K ^RCD(340 ,"AB",$P(X ,";",2),DA )
	7491	"^DD",340, 340,.01,1, 3,3)
	7492	Needed to cross-refe rence debt or file by 'type' of debtor
	7493	"^DD",340, 340,.01,1, 3,"%D",0)
	7494	^^5^5^2931 014^^^^
	7495	"^DD",340, 340,.01,1, 3,"%D",1,0 )
	7496	This cross -reference allows ra pid look-u p of debto rs in the debtor fil e
	7497	"^DD",340, 340,.01,1, 3,"%D",2,0 )
	7498	by the 'ty pe' of deb tor. Ther e are five types of debtors (P atient,
	7499	"^DD",340, 340,.01,1, 3,"%D",3,0 )
	7500	Insurance Company, I nstitution , Vendor, and Person ). This a llows
	7501	"^DD",340, 340,.01,1, 3,"%D",4,0 )
	7502	the AR sof tware to s can the fi le for onl y a specif ic type of debtor
	7503	"^DD",340, 340,.01,1, 3,"%D",5,0 )
	7504	rather tha n having t o look at each entry .
	7505	"^DD",340, 340,.01,1, 3,"DT")
	7506	2930526
	7507	"^DD",340, 340,.01,1. 1)
	7508	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),"";""),0 ),U) S:X
	7509	X=+X
	7510	"^DD",340, 340,.01,3)
	7511	Enter Debt or Informa tion
	7512	"^DD",340, 340,.01,7. 5)
	7513	S:$D(PRCAB T) DIC("V" )="I +Y(0) ="_$P("440 !(+Y(0)=4) ^440!(+Y(0 )=4)^440!( +Y(0)=200
	7514	)",U,PRCAB T) S:$D(PR CAT) DIC(" V")="I +Y( 0)="_$S("C P"[PRCAT:2 ,"FV"[PRCA T:440,"T"
	7515	[PRCAT:36, "N"[PRCAT: 4,"O"[PRCA T:200,1:"2 00!(+Y(0)= 440)")
	7516	"^DD",340, 340,.01,21 ,0)
	7517	^^5^5^2970 219^^^^
	7518	"^DD",340, 340,.01,21 ,1,0)
	7519	This field contains the debtor to which this accou nt belongs to. An
	7520	"^DD",340, 340,.01,21 ,2,0)
	7521	account ca n belong t o an insur ance compa ny, vendor , institut ion, perso n,
	7522	"^DD",340, 340,.01,21 ,3,0)
	7523	or patient . Account s can be s et up for Medical Ca re Cost Re covery cha rges
	7524	"^DD",340, 340,.01,21 ,4,0)
	7525	and also f or non-ben efit debts , such as: Employee bills, Ex- employee b ills,
	7526	"^DD",340, 340,.01,21 ,5,0)
	7527	and Vendor bills.
	7528	"^DD",340, 340,.01,"D T")
	7529	3160428
	7530	"^DD",340, 340,.01,"V ",0)
	7531	^.12P^5^5
	7532	"^DD",340, 340,.01,"V ",1,0)
	7533	2^PATIENT^ 1^P^n^n
	7534	"^DD",340, 340,.01,"V ",1,1)
	7535
	7536	"^DD",340, 340,.01,"V ",1,2)
	7537
	7538	"^DD",340, 340,.01,"V ",2,0)
	7539	200^OTHER (PERSON)^2 ^O^n^y
	7540	"^DD",340, 340,.01,"V ",3,0)
	7541	36^3RD PAR TY^4^I^n^n
	7542	"^DD",340, 340,.01,"V ",4,0)
	7543	4^INSTITUT ION^5^N^n^ n
	7544	"^DD",340, 340,.01,"V ",5,0)
	7545	440^VENDOR ^3^V^n^n
	7546	"^DD",340, 340,.03,0)
	7547	STATEMENT DAY^NJ2,0^ ^0;3^K:+X' =X!(X>28)! (X<1)!(X?. E1"."1N.N) X
	7548	"^DD",340, 340,.03,1, 0)
	7549	^.1
	7550	"^DD",340, 340,.03,1, 1,0)
	7551	340^AC
	7552	"^DD",340, 340,.03,1, 1,1)
	7553	S ^RCD(340 ,"AC",$E(X ,1,30),DA) =""
	7554	"^DD",340, 340,.03,1, 1,2)
	7555	K ^RCD(340 ,"AC",$E(X ,1,30),DA)
	7556	"^DD",340, 340,.03,1, 1,3)
	7557	Needed for printing of patient statement s and foll ow-up lett ers
	7558	"^DD",340, 340,.03,1, 1,"%D",0)
	7559	^^4^4^2931 014^^^^
	7560	"^DD",340, 340,.03,1, 1,"%D",1,0 )
	7561	This cross -reference is used t o print pa tient stat ements and Vendor, P erson,
	7562	"^DD",340, 340,.03,1, 1,"%D",2,0 )
	7563	and Instit ution foll ow-up lett ers. Sinc e these ty pe of debt ors get no tified
	7564	"^DD",340, 340,.03,1, 1,"%D",3,0 )
	7565	based on t heir state ment day, this cross -reference allows ra pid look-u p
	7566	"^DD",340, 340,.03,1, 1,"%D",4,0 )
	7567	of which d ebtor is d ue a notif ication on a particu lar day.
	7568	"^DD",340, 340,.03,1, 1,"DT")
	7569	2930309
	7570	"^DD",340, 340,.03,3)
	7571	Type a Num ber betwee n 1 and 28 , 0 Decima l Digits
	7572	"^DD",340, 340,.03,5, 1,0)
	7573	340^.01^2
	7574	"^DD",340, 340,.03,21 ,0)
	7575	^^19^19^31 60428^
	7576	"^DD",340, 340,.03,21 ,1,0)
	7577	A statemen t day is a ssigned to all types of debtor s, except insurance
	7578	"^DD",340, 340,.03,21 ,2,0)
	7579	companies. A statem ent day is the day t hat a stat ement is g enerated o r a
	7580	"^DD",340, 340,.03,21 ,3,0)
	7581	follow-up letter is generated for non-be nefit debt s. Except for
	7582	"^DD",340, 340,.03,21 ,4,0)
	7583	Patient St atements w hich are g enerated t wo days pr ior to thi s day.
	7584	"^DD",340, 340,.03,21 ,5,0)
	7585	The AR pac kage will hold 'noti fications' from bein g sent unt il the
	7586	"^DD",340, 340,.03,21 ,6,0)
	7587	debtor's ' statement day' arriv es. This allows all activity since the
	7588	"^DD",340, 340,.03,21 ,7,0)
	7589	previous s tatement t o print an d update t he debtor on the acc ount
	7590	"^DD",340, 340,.03,21 ,8,0)
	7591	activity.
	7592	"^DD",340, 340,.03,21 ,9,0)
	7593
	7594	"^DD",340, 340,.03,21 ,10,0)
	7595	Patient st atement da ys never c hange, but Instituti on, Person , and Vend or
	7596	"^DD",340, 340,.03,21 ,11,0)
	7597	statement days are c hanged by the AR sof tware. Wh en these t ype debtor s
	7598	"^DD",340, 340,.03,21 ,12,0)
	7599	have a new active bi ll, the da te the new active bi ll is crea ted become s
	7600	"^DD",340, 340,.03,21 ,13,0)
	7601	their 'sta tement day '. This s tatement d ay remains in effect until no
	7602	"^DD",340, 340,.03,21 ,14,0)
	7603	active bil ls exist f or the deb tor, at wh ich time t he stateme nt day
	7604	"^DD",340, 340,.03,21 ,15,0)
	7605	is 'delete d'.
	7606	"^DD",340, 340,.03,21 ,16,0)
	7607
	7608	"^DD",340, 340,.03,21 ,17,0)
	7609	Insurance companies are notifi ed based o n a bill-s pecific da te.
	7610	"^DD",340, 340,.03,21 ,18,0)
	7611	Since insu rance comp anies have much more activity, they are notified
	7612	"^DD",340, 340,.03,21 ,19,0)
	7613	on a const ant basis depending on each in dividual b ill 'due-d ate'.
	7614	"^DD",340, 340,.03,"D T")
	7615	3160428
	7616	"^DD",340, 340,7.06,0 )
	7617	CURRENT CB S DEBT AMO UNT^NJ9,2^ ^7;6^S:X[" $" X=$P(X, "$",2) K:X '?."-".N.1 ".".2N!(X
	7618	>999999)!( X<-999999) X
	7619	"^DD",340, 340,7.06,3 )
	7620	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	7621	"^DD",340, 340,7.06,2 1,0)
	7622	^^7^7^3160 401^
	7623	"^DD",340, 340,7.06,2 1,1,0)
	7624	This field stores th e debt amo unt curren tly
	7625	"^DD",340, 340,7.06,2 1,2,0)
	7626	updated to the Conso lidated Bi lling Stat ement Syst em
	7627	"^DD",340, 340,7.06,2 1,3,0)
	7628	CBSS. Thi s field is used to c ompare the current
	7629	"^DD",340, 340,7.06,2 1,4,0)
	7630	amount at the CBSS w ith the am ount curre ntly
	7631	"^DD",340, 340,7.06,2 1,5,0)
	7632	available for receiv ing paymen t. For in creases
	7633	"^DD",340, 340,7.06,2 1,6,0)
	7634	or decreas es, the de bt amount is forward ed to
	7635	"^DD",340, 340,7.06,2 1,7,0)
	7636	CBSS.
	7637	"^DD",340, 340,7.06," DT")
	7638	3160401
	7639	"^DD",341, 341,6.01,0 )
	7640	CCPC STATE MENT DATE^ D^^6;1^S % DT="EX" D ^%DT S X=Y K:X<1 X
	7641	"^DD",341, 341,6.01,1 ,0)
	7642	^.1
	7643	"^DD",341, 341,6.01,1 ,1,0)
	7644	341^STDT
	7645	"^DD",341, 341,6.01,1 ,1,1)
	7646	S ^RC(341, "STDT",$E( X,1,30),DA )=""
	7647	"^DD",341, 341,6.01,1 ,1,2)
	7648	K ^RC(341, "STDT",$E( X,1,30),DA )
	7649	"^DD",341, 341,6.01,1 ,1,"%D",0)
	7650	^.101^2^2^ 3160809^^
	7651	"^DD",341, 341,6.01,1 ,1,"%D",1, 0)
	7652	This cross reference is used t o sort and print eve nts by the ir Patient
	7653	"^DD",341, 341,6.01,1 ,1,"%D",2, 0)
	7654	Statement date.
	7655	"^DD",341, 341,6.01,1 ,1,"DT")
	7656	3160803
	7657	"^DD",341, 341,6.01,3 )
	7658	Enter date of Patien t Statemen t.
	7659	"^DD",341, 341,6.01,2 1,0)
	7660	^^1^1^3160 921^
	7661	"^DD",341, 341,6.01,2 1,1,0)
	7662	This is th e date of the Patien t Statemen t from CBS S.
	7663	"^DD",341, 341,6.01," DT")
	7664	3160921
	7665	"^DD",349, 349,.09,0)
	7666	STATEMENT DATE^D^^0; 9^S %DT="E X" D ^%DT S X=Y K:X< 1 X
	7667	"^DD",349, 349,.09,3)
	7668	Enter the statement date.
	7669	"^DD",349, 349,.09,21 ,0)
	7670	^^1^1^3161 019^
	7671	"^DD",349, 349,.09,21 ,1,0)
	7672	This is th e patient statement date.
	7673	"^DD",349, 349,.09,"D T")
	7674	3161103
	7675	"^DD",349. 1,349.1,0)
	7676	FIELD^^40^ 14
	7677	"^DD",349. 1,349.1,0, "DDA")
	7678	N
	7679	"^DD",349. 1,349.1,0, "DT")
	7680	3161103
	7681	"^DD",349. 1,349.1,0, "IX","B",3 49.1,.01)
	7682
	7683	"^DD",349. 1,349.1,0, "NM","AR T RANSMISSIO N TYPE")
	7684
	7685	"^DD",349. 1,349.1,0, "PT",349.9 ,.01)
	7686
	7687	"^DD",349. 1,349.1,0, "VRPK")
	7688	PRCA
	7689	"^DD",349. 1,349.1,.0 1,0)
	7690	CODE^RF^^0 ;1^K:$L(X) >10!($L(X) <2)!'(X'?1 P.E) X
	7691	"^DD",349. 1,349.1,.0 1,1,0)
	7692	^.1
	7693	"^DD",349. 1,349.1,.0 1,1,1,0)
	7694	349.1^B
	7695	"^DD",349. 1,349.1,.0 1,1,1,1)
	7696	S ^RCT(349 .1,"B",$E( X,1,30),DA )=""
	7697	"^DD",349. 1,349.1,.0 1,1,1,2)
	7698	K ^RCT(349 .1,"B",$E( X,1,30),DA )
	7699	"^DD",349. 1,349.1,.0 1,3)
	7700	Answer mus t be 2-10 characters in length .
	7701	"^DD",349. 1,349.1,.0 1,21,0)
	7702	^.001^1^1^ 3040601^^^
	7703	"^DD",349. 1,349.1,.0 1,21,1,0)
	7704	This field will hold the uniqu e codes fo r the tran smission t ypes.
	7705	"^DD",349. 1,349.1,.0 1,23,0)
	7706	^^1^1^3040 601^
	7707	"^DD",349. 1,349.1,.0 1,23,1,0)
	7708
	7709	"^DD",349. 1,349.1,.0 1,"DT")
	7710	2960216
	7711	"^DD",349. 1,349.1,.0 2,0)
	7712	EXPANDED N AME^F^^0;2 ^K:$L(X)>3 0!($L(X)<3 ) X
	7713	"^DD",349. 1,349.1,.0 2,3)
	7714	Answer mus t be 3-30 characters in length .
	7715	"^DD",349. 1,349.1,.0 2,21,0)
	7716	^^1^1^2960 216^^
	7717	"^DD",349. 1,349.1,.0 2,21,1,0)
	7718	This is th e expanded name of t he transmi ssion type .
	7719	"^DD",349. 1,349.1,.0 2,"DT")
	7720	2960216
	7721	"^DD",349. 1,349.1,.0 3,0)
	7722	ACTIVE^S^0 :NO;1:YES; ^0;3^Q
	7723	"^DD",349. 1,349.1,.0 3,21,0)
	7724	^^1^1^2960 216^
	7725	"^DD",349. 1,349.1,.0 3,21,1,0)
	7726	This field will indi cate if th e transmis sion type is being u sed.
	7727	"^DD",349. 1,349.1,.0 3,"DT")
	7728	2960216
	7729	"^DD",349. 1,349.1,.0 4,0)
	7730	PURGE FREQ UENCY^NJ4, 0^^0;4^K:+ X'=X!(X>36 50)!(X<30) !(X?.E1"." 1N.N) X
	7731	"^DD",349. 1,349.1,.0 4,3)
	7732	Type a Num ber betwee n 30 and 3 650, 0 Dec imal Digit s
	7733	"^DD",349. 1,349.1,.0 4,21,0)
	7734	^^2^2^2960 216^^
	7735	"^DD",349. 1,349.1,.0 4,21,1,0)
	7736	This field indicates if and wh en a purge of the en tries will take
	7737	"^DD",349. 1,349.1,.0 4,21,2,0)
	7738	place.
	7739	"^DD",349. 1,349.1,.0 4,23,0)
	7740	^^2^2^2960 216^
	7741	"^DD",349. 1,349.1,.0 4,23,1,0)
	7742	Number of days that transmissi on records are on-li ne before
	7743	"^DD",349. 1,349.1,.0 4,23,2,0)
	7744	purging oc curs.
	7745	"^DD",349. 1,349.1,.0 4,"DT")
	7746	2960216
	7747	"^DD",349. 1,349.1,1, 0)
	7748	LOCAL ADDR ESSEE^349. 11P^^1;0
	7749	"^DD",349. 1,349.1,2, 0)
	7750	LOCAL MAIL GROUP^349. 12P^^2;0
	7751	"^DD",349. 1,349.1,31 ,0)
	7752	REMOTE ADD RESSEE^F^^ 3;1^K:$L(X )>30!($L(X )<1)!'(X?. A) X
	7753	"^DD",349. 1,349.1,31 ,3)
	7754	Answer mus t be 1-30 characters in length .
	7755	"^DD",349. 1,349.1,31 ,21,0)
	7756	^^1^1^2960 430^^^
	7757	"^DD",349. 1,349.1,31 ,21,1,0)
	7758	This is th e addresse e name at the remote domain.
	7759	"^DD",349. 1,349.1,31 ,"DT")
	7760	2960430
	7761	"^DD",349. 1,349.1,32 ,0)
	7762	REMOTE DOM AIN^P4.2'^ DIC(4.2,^3 ;2^Q
	7763	"^DD",349. 1,349.1,32 ,1,0)
	7764	^.1
	7765	"^DD",349. 1,349.1,32 ,1,1,0)
	7766	^^TRIGGER^ 349.1^33
	7767	"^DD",349. 1,349.1,32 ,1,1,1)
	7768	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(
	7769	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)
	7770	"^DD",349. 1,349.1,32 ,1,1,1.1)
	7771	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
	7772	)=$S($D(^D IC(4.2,D0, 0)):^(0),1 :"") S X=$ P(Y(101),U ,1) S D0=I (0,0)
	7773	"^DD",349. 1,349.1,32 ,1,1,1.4)
	7774	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1
	7775	,DIG=33 D ^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	7776	"^DD",349. 1,349.1,32 ,1,1,2)
	7777	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(
	7778	Y(1),U,3), X=X S DIU= X K Y S X= "" X ^DD(3 49.1,32,1, 1,2.4)
	7779	"^DD",349. 1,349.1,32 ,1,1,2.4)
	7780	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1
	7781	,DIG=33 D ^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	7782	"^DD",349. 1,349.1,32 ,1,1,"CREA TE VALUE")
	7783	REMOTE DOM AIN:.01
	7784	"^DD",349. 1,349.1,32 ,1,1,"DELE TE VALUE")
	7785	@
	7786	"^DD",349. 1,349.1,32 ,1,1,"FIEL D")
	7787	DOMAIN NAM E
	7788	"^DD",349. 1,349.1,32 ,21,0)
	7789	^.001^2^2^ 3000524^^^
	7790	"^DD",349. 1,349.1,32 ,21,1,0)
	7791	This is th e remote d omain wher e the tran smission r ecord is b eing
	7792	"^DD",349. 1,349.1,32 ,21,2,0)
	7793	sent.
	7794	"^DD",349. 1,349.1,32 ,"DT")
	7795	2960902
	7796	"^DD",349. 1,349.1,33 ,0)
	7797	DOMAIN NAM E^F^^3;3^K :$L(X)>30! ($L(X)<3) X
	7798	"^DD",349. 1,349.1,33 ,3)
	7799	Answer mus t be 3-30 characters in length .
	7800	"^DD",349. 1,349.1,33 ,5,1,0)
	7801	349.1^32^1
	7802	"^DD",349. 1,349.1,33 ,9)
	7803	^
	7804	"^DD",349. 1,349.1,33 ,21,0)
	7805	^^1^1^2960 902^
	7806	"^DD",349. 1,349.1,33 ,21,1,0)
	7807	This is th e name of the DOMAIN from file 4.2 DOMAI N.
	7808	"^DD",349. 1,349.1,33 ,"DT")
	7809	2960902
	7810	"^DD",349. 1,349.1,34 ,0)
	7811	RC MAIL AD DRESS^RFX^ ^3;4^K:$L( X)>30!($L( X)<3) X
	7812	"^DD",349. 1,349.1,34 ,3)
	7813	Answer mus t be 3-30 characters in length .
	7814	"^DD",349. 1,349.1,34 ,4)
	7815	D MAILADD^ RCRCXMS
	7816	"^DD",349. 1,349.1,34 ,21,0)
	7817	^.001^2^2^ 3040429^^^ ^
	7818	"^DD",349. 1,349.1,34 ,21,1,0)
	7819	This field will cont ain the Re gional Cou nsel mail address fo r the
	7820	"^DD",349. 1,349.1,34 ,21,2,0)
	7821	primary si te. It wi ll be the default ma il address .
	7822	"^DD",349. 1,349.1,34 ,23,0)
	7823	^.001^1^1^ 3040429^^^ ^
	7824	"^DD",349. 1,349.1,34 ,23,1,0)
	7825
	7826	"^DD",349. 1,349.1,34 ,"DT")
	7827	3040407
	7828	"^DD",349. 1,349.1,35 ,0)
	7829	RC DEATH N OTIFICATIO N ADDRESS^ RF^^3;5^K: $L(X)>40!( $L(X)<2) X
	7830	"^DD",349. 1,349.1,35 ,3)
	7831	Answer mus t be 2-40 characters in length .
	7832	"^DD",349. 1,349.1,35 ,4)
	7833	D DEATHADD ^RCRCXMS
	7834	"^DD",349. 1,349.1,35 ,21,0)
	7835	^.001^3^3^ 3040429^^^ ^
	7836	"^DD",349. 1,349.1,35 ,21,1,0)
	7837	This field contains the Region al Counsel mail addr ess for de ath
	7838	"^DD",349. 1,349.1,35 ,21,2,0)
	7839	notificati ons for th e primary site. Thi s will be the defaul t for deat h
	7840	"^DD",349. 1,349.1,35 ,21,3,0)
	7841	notificati ons.
	7842	"^DD",349. 1,349.1,35 ,23,0)
	7843	^.001^1^1^ 3040429^^^ ^
	7844	"^DD",349. 1,349.1,35 ,23,1,0)
	7845
	7846	"^DD",349. 1,349.1,35 ,"DT")
	7847	3040428
	7848	"^DD",349. 1,349.1,40 ,0)
	7849	MESSAGE AC KNOWLEDGEM ENT^349.14 1A^^4;0
	7850	"^DD",349. 1,349.1,40 ,21,0)
	7851	^^5^5^3160 429^
	7852	"^DD",349. 1,349.1,40 ,21,1,0)
	7853	Message Ac knowledgem ents conta in the top level of data for m essages
	7854	"^DD",349. 1,349.1,40 ,21,2,0)
	7855	received f rom Austin .
	7856	"^DD",349. 1,349.1,40 ,21,3,0)
	7857
	7858	"^DD",349. 1,349.1,40 ,21,4,0)
	7859	The IEN fo r the mult iple Messa ge Acknowl edgements is set in the code t o
	7860	"^DD",349. 1,349.1,40 ,21,5,0)
	7861	the day of the month for the P atient Sta tement.
	7862	"^DD",349. 1,349.1,51 ,0)
	7863	ACK MESSAG ES^349.151 A^^5;0
	7864	"^DD",349. 1,349.1,51 ,21,0)
	7865	^^1^1^3161 006^
	7866	"^DD",349. 1,349.1,51 ,21,1,0)
	7867	Acknowledg ement Mess ages recei ved from e xternal so urces.
	7868	"^DD",349. 1,349.1,61 ,0)
	7869	DIVISION O F CARE^349 .161PA^^6; 0
	7870	"^DD",349. 1,349.1,61 ,21,0)
	7871	^.001^4^4^ 3040517^^^ ^
	7872	"^DD",349. 1,349.1,61 ,21,1,0)
	7873	This field is a mult iple that allows div isions to be entered if their
	7874	"^DD",349. 1,349.1,61 ,21,2,0)
	7875	Regional C ounsel mai l addresse s and deat h notifica tion addre sses are
	7876	"^DD",349. 1,349.1,61 ,21,3,0)
	7877	different from the p rimary add resses.
	7878	"^DD",349. 1,349.1,61 ,21,4,0)
	7879
	7880	"^DD",349. 1,349.1,61 ,23,0)
	7881	^.001^1^1^ 3040517^^^ ^
	7882	"^DD",349. 1,349.1,61 ,23,1,0)
	7883
	7884	"^DD",349. 1,349.1,61 ,"DT")
	7885	3040514
	7886	"^DD",349. 1,349.11,0 )
	7887	LOCAL ADDR ESSEE SUB- FIELD^^.01 ^1
	7888	"^DD",349. 1,349.11,0 ,"DT")
	7889	2960216
	7890	"^DD",349. 1,349.11,0 ,"IX","B", 349.11,.01 )
	7891
	7892	"^DD",349. 1,349.11,0 ,"NM","LOC AL ADDRESS EE")
	7893
	7894	"^DD",349. 1,349.11,0 ,"UP")
	7895	349.1
	7896	"^DD",349. 1,349.11,. 01,0)
	7897	LOCAL ADDR ESSEE^MP20 0'^VA(200, ^0;1^Q
	7898	"^DD",349. 1,349.11,. 01,1,0)
	7899	^.1
	7900	"^DD",349. 1,349.11,. 01,1,1,0)
	7901	349.11^B
	7902	"^DD",349. 1,349.11,. 01,1,1,1)
	7903	S ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)= ""
	7904	"^DD",349. 1,349.11,. 01,1,1,2)
	7905	K ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)
	7906	"^DD",349. 1,349.11,. 01,21,0)
	7907	^^2^2^2960 216^
	7908	"^DD",349. 1,349.11,. 01,21,1,0)
	7909	The local users who wish to be recepient s of the t ransmissio n messages
	7910	"^DD",349. 1,349.11,. 01,21,2,0)
	7911	will named in this f ield.
	7912	"^DD",349. 1,349.11,. 01,"DT")
	7913	2960216
	7914	"^DD",349. 1,349.12,0 )
	7915	LOCAL MAIL GROUP SUB- FIELD^^.01 ^1
	7916	"^DD",349. 1,349.12,0 ,"DT")
	7917	2960216
	7918	"^DD",349. 1,349.12,0 ,"IX","B", 349.12,.01 )
	7919
	7920	"^DD",349. 1,349.12,0 ,"NM","LOC AL MAILGRO UP")
	7921
	7922	"^DD",349. 1,349.12,0 ,"UP")
	7923	349.1
	7924	"^DD",349. 1,349.12,. 01,0)
	7925	LOCAL MAIL GROUP^MP3. 8'^XMB(3.8 ,^0;1^Q
	7926	"^DD",349. 1,349.12,. 01,1,0)
	7927	^.1
	7928	"^DD",349. 1,349.12,. 01,1,1,0)
	7929	349.12^B
	7930	"^DD",349. 1,349.12,. 01,1,1,1)
	7931	S ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)= ""
	7932	"^DD",349. 1,349.12,. 01,1,1,2)
	7933	K ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)
	7934	"^DD",349. 1,349.12,. 01,21,0)
	7935	^^2^2^2960 216^
	7936	"^DD",349. 1,349.12,. 01,21,1,0)
	7937	This field is used t o define a ny mailgro ups which should rec eive the
	7938	"^DD",349. 1,349.12,. 01,21,2,0)
	7939	transmissi on message s.
	7940	"^DD",349. 1,349.12,. 01,"DT")
	7941	2960216
	7942	"^DD",349. 1,349.141, 0)
	7943	MESSAGE AC KNOWLEDGEM ENT SUB-FI ELD^^.04^4
	7944	"^DD",349. 1,349.141, 0,"DT")
	7945	3160425
	7946	"^DD",349. 1,349.141, 0,"NM","ME SSAGE ACKN OWLEDGEMEN T")
	7947
	7948	"^DD",349. 1,349.141, 0,"UP")
	7949	349.1
	7950	"^DD",349. 1,349.141, .01,0)
	7951	LAST MESSA GE ACK^NJ3 ,0X^^0;1^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	7952	"^DD",349. 1,349.141, .01,1,0)
	7953	^.1^^0
	7954	"^DD",349. 1,349.141, .01,3)
	7955	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	7956	"^DD",349. 1,349.141, .01,21,0)
	7957	^^1^1^3160 425^
	7958	"^DD",349. 1,349.141, .01,21,1,0 )
	7959	Number of last messa ge type se nt from CB SS.
	7960	"^DD",349. 1,349.141, .01,"DT")
	7961	3161007
	7962	"^DD",349. 1,349.141, .02,0)
	7963	FINAL MESS AGE ACK^NJ 3,0^^0;2^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	7964	"^DD",349. 1,349.141, .02,3)
	7965	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	7966	"^DD",349. 1,349.141, .02,21,0)
	7967	^^1^1^3160 425^
	7968	"^DD",349. 1,349.141, .02,21,1,0 )
	7969	Final mess age number of this t ype from C BSS.
	7970	"^DD",349. 1,349.141, .02,"DT")
	7971	3160425
	7972	"^DD",349. 1,349.141, .03,0)
	7973	LAST MESSA GE NUMBER^ NJ8,0^^0;3 ^K:+X'=X!( X>99999999 )!(X<1)!(X ?.E1"."1.N ) X
	7974	"^DD",349. 1,349.141, .03,3)
	7975	Type a num ber betwee n 1 and 99 999999, 0 decimal di gits.
	7976	"^DD",349. 1,349.141, .03,21,0)
	7977	^^2^2^3160 425^
	7978	"^DD",349. 1,349.141, .03,21,1,0 )
	7979	This is th e last mes sage numbe r of this type for t he last tr ansmission
	7980	"^DD",349. 1,349.141, .03,21,2,0 )
	7981	from CBSS.
	7982	"^DD",349. 1,349.141, .03,"DT")
	7983	3160425
	7984	"^DD",349. 1,349.141, .04,0)
	7985	PATIENT ST ATEMENT DA TE^DX^^0;4 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	7986	"^DD",349. 1,349.141, .04,1,0)
	7987	^.1^^0
	7988	"^DD",349. 1,349.141, .04,3)
	7989	Enter date of Patien t Statemen t.
	7990	"^DD",349. 1,349.141, .04,21,0)
	7991	^^1^1^3161 025^
	7992	"^DD",349. 1,349.141, .04,21,1,0 )
	7993	This is th e Patient Statement Date.
	7994	"^DD",349. 1,349.141, .04,"DT")
	7995	3161025
	7996	"^DD",349. 1,349.151, 0)
	7997	ACK MESSAG ES SUB-FIE LD^^.04^4
	7998	"^DD",349. 1,349.151, 0,"DT")
	7999	3161103
	8000	"^DD",349. 1,349.151, 0,"NM","AC K MESSAGES ")
	8001
	8002	"^DD",349. 1,349.151, 0,"UP")
	8003	349.1
	8004	"^DD",349. 1,349.151, .01,0)
	8005	ACK MESSAG ES^F^^0;1^ K:$L(X)>80 !($L(X)<3) X
	8006	"^DD",349. 1,349.151, .01,1,0)
	8007	^.1^^0
	8008	"^DD",349. 1,349.151, .01,3)
	8009	Answer mus t be 3-80 characters in length .
	8010	"^DD",349. 1,349.151, .01,21,0)
	8011	^^1^1^2970 106^^
	8012	"^DD",349. 1,349.151, .01,21,1,0 )
	8013	This multi ple will s tore the A cknowlegme nt message s from Aus tin.
	8014	"^DD",349. 1,349.151, .01,"DT")
	8015	3161005
	8016	"^DD",349. 1,349.151, .02,0)
	8017	ACCOUNT/SE G ID^F^^0; 2^K:$L(X)> 25!($L(X)< 3) X
	8018	"^DD",349. 1,349.151, .02,3)
	8019	Answer mus t be 3-25 characters in length .
	8020	"^DD",349. 1,349.151, .02,21,0)
	8021	^^1^1^2961 114^
	8022	"^DD",349. 1,349.151, .02,21,1,0 )
	8023	This field stores th e account id for the record.
	8024	"^DD",349. 1,349.151, .02,"DT")
	8025	2961205
	8026	"^DD",349. 1,349.151, .03,0)
	8027	ACCOUNT/SE G INFO^F^^ 0;3^K:$L(X )>40!($L(X )<3) X
	8028	"^DD",349. 1,349.151, .03,3)
	8029	Answer mus t be 3-40 characters in length .
	8030	"^DD",349. 1,349.151, .03,21,0)
	8031	^^1^1^2961 114^
	8032	"^DD",349. 1,349.151, .03,21,1,0 )
	8033	This field will stor e the deta iled infor mation abo ut the rec ord if any .
	8034	"^DD",349. 1,349.151, .03,"DT")
	8035	2961205
	8036	"^DD",349. 1,349.151, .04,0)
	8037	PATIENT ST ATEMENT DA TE^D^^0;4^ S %DT="EX" D ^%DT S X=Y K:X<1 X
	8038	"^DD",349. 1,349.151, .04,3)
	8039	Enter date of Patien t Statemen t.
	8040	"^DD",349. 1,349.151, .04,21,0)
	8041	^^1^1^3161 006^
	8042	"^DD",349. 1,349.151, .04,21,1,0 )
	8043	The Patien t Statemen t date for Acknowled gement Mes sages.
	8044	"^DD",349. 1,349.151, .04,"DT")
	8045	3161103
	8046	"^DD",349. 1,349.161, 0)
	8047	DIVISION O F CARE SUB -FIELD^^.0 4^4
	8048	"^DD",349. 1,349.161, 0,"DT")
	8049	3040429
	8050	"^DD",349. 1,349.161, 0,"IX","B" ,349.161,. 01)
	8051
	8052	"^DD",349. 1,349.161, 0,"NM","DI VISION OF CARE")
	8053
	8054	"^DD",349. 1,349.161, 0,"UP")
	8055	349.1
	8056	"^DD",349. 1,349.161, .01,0)
	8057	DIVISION O F CARE^P40 .8'^DG(40. 8,^0;1^Q
	8058	"^DD",349. 1,349.161, .01,1,0)
	8059	^.1
	8060	"^DD",349. 1,349.161, .01,1,1,0)
	8061	349.161^B
	8062	"^DD",349. 1,349.161, .01,1,1,1)
	8063	S ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)= ""
	8064	"^DD",349. 1,349.161, .01,1,1,2)
	8065	K ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)
	8066	"^DD",349. 1,349.161, .01,21,0)
	8067	^.001^1^1^ 3040517^^^ ^
	8068	"^DD",349. 1,349.161, .01,21,1,0 )
	8069	Enter divi sions of c are where bill charg es origina te for thi s site.
	8070	"^DD",349. 1,349.161, .01,"DT")
	8071	3000524
	8072	"^DD",349. 1,349.161, .02,0)
	8073	REMOTE DOM AIN^P4.2'^ DIC(4.2,^0 ;2^Q
	8074	"^DD",349. 1,349.161, .02,3)
	8075
	8076	"^DD",349. 1,349.161, .02,21,0)
	8077	^.001^1^1^ 3000524^^
	8078	"^DD",349. 1,349.161, .02,21,1,0 )
	8079	This is th e Remote D omain addr ess where transmissi ons will b e sent for this div
	8080	ision.
	8081	"^DD",349. 1,349.161, .02,"DT")
	8082	3000524
	8083	"^DD",349. 1,349.161, .03,0)
	8084	RC MAIL AD DRESS^F^^0 ;3^K:$L(X) >30!($L(X) <3) X
	8085	"^DD",349. 1,349.161, .03,3)
	8086	Answer mus t be 3-30 characters in length .
	8087	"^DD",349. 1,349.161, .03,4)
	8088	D MAILADD^ RCRCXMS
	8089	"^DD",349. 1,349.161, .03,21,0)
	8090	^.001^4^4^ 3040429^^
	8091	"^DD",349. 1,349.161, .03,21,1,0 )
	8092	This field will cont ain the na me of the Regional C ounsel mai l address
	8093	"^DD",349. 1,349.161, .03,21,2,0 )
	8094	that trans actions fr om the ass ociated Di vision of Care will be sent.
	8095	"^DD",349. 1,349.161, .03,21,3,0 )
	8096	This field s address will be di fferent fr om the pri mary divis ion's
	8097	"^DD",349. 1,349.161, .03,21,4,0 )
	8098	RC mail ad dress.
	8099	"^DD",349. 1,349.161, .03,23,0)
	8100	^^1^1^3040 429^
	8101	"^DD",349. 1,349.161, .03,23,1,0 )
	8102
	8103	"^DD",349. 1,349.161, .03,"DT")
	8104	3040325
	8105	"^DD",349. 1,349.161, .04,0)
	8106	RC DEATH N OTIFICATIO N ADDRESS^ F^^0;4^K:$ L(X)>40!($ L(X)<3) X
	8107	"^DD",349. 1,349.161, .04,3)
	8108	Answer mus t be 3-40 characters in length .
	8109	"^DD",349. 1,349.161, .04,4)
	8110	D DEATHADD ^RCRCXMS
	8111	"^DD",349. 1,349.161, .04,21,0)
	8112	^.001^4^4^ 3040429^^^
	8113	"^DD",349. 1,349.161, .04,21,1,0 )
	8114	This field will cont ain the na me of the RC death n otificatio ns address
	8115	"^DD",349. 1,349.161, .04,21,2,0 )
	8116	that death notices f rom the as sociated D ivision of Care will be sent.
	8117	"^DD",349. 1,349.161, .04,21,3,0 )
	8118	This field s address will be di fferent fr om the pri mary divis ion's
	8119	"^DD",349. 1,349.161, .04,21,4,0 )
	8120	RC death n otificatio n address.
	8121	"^DD",349. 1,349.161, .04,23,0)
	8122	^.001^1^1^ 3040429^^
	8123	"^DD",349. 1,349.161, .04,23,1,0 )
	8124
	8125	"^DD",349. 1,349.161, .04,"DT")
	8126	3040429
	8127	"^DD",349. 2,349.2,.0 1,0)
	8128	PATIENT^RP 340'X^RCD( 340,^0;1^Q
	8129	"^DD",349. 2,349.2,.0 1,1,0)
	8130	^.1^^0
	8131	"^DD",349. 2,349.2,.0 1,3)
	8132	Enter the Debtor Num ber for th e Patient Statement.
	8133	"^DD",349. 2,349.2,.0 1,21,0)
	8134	^^2^2^3161 011^^
	8135	"^DD",349. 2,349.2,.0 1,21,1,0)
	8136	This is th e Debtor n umber to r eceive the Patient S tatement a ssociated
	8137	"^DD",349. 2,349.2,.0 1,21,2,0)
	8138	with the s pecific Pa tient.
	8139	"^DD",349. 2,349.2,.0 1,"DT")
	8140	3161011
	8141	"^DD",349. 2,349.2,.0 2,0)
	8142	SSN^RFXO^^ 0;2^K:$L(X )>10!($L(X )<9) X S X =$$SSN^RCF N01(+DA)
	8143	"^DD",349. 2,349.2,.0 2,1,0)
	8144	^.1
	8145	"^DD",349. 2,349.2,.0 2,1,1,0)
	8146	349.2^AKEY 1^MUMPS
	8147	"^DD",349. 2,349.2,.0 2,1,1,1)
	8148	I $P(^RCPS (349.2,+DA ,0),"^",3) ]"" S ^RCP S(349.2,"A KEY",$E(X, 1,9)_$TR($ E($P($P(^
	8149	RCPS(349.2 ,+DA,0),"^ ",3),","), 1,5)," "," "),DA)=""
	8150	"^DD",349. 2,349.2,.0 2,1,1,2)
	8151	K ^RCPS(34 9.2,"AKEY" ,$E(X,1,9) _$TR($E($P ($P(^RCPS( 349.2,+DA, 0),"^",3), ","),1,5)
	8152	," ",""))
	8153	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,0)
	8154	^.101^1^1^ 3160427^^
	8155	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,1,0)
	8156	This cross -reference is used t o key the statements for CBSS.
	8157	"^DD",349. 2,349.2,.0 2,1,1,"DT" )
	8158	2960924
	8159	"^DD",349. 2,349.2,.0 2,2)
	8160	S Y(0)=Y S Y=Y
	8161	"^DD",349. 2,349.2,.0 2,2.1)
	8162	S Y=Y
	8163	"^DD",349. 2,349.2,.0 2,3)
	8164	Answer mus t be 9-10 characters in length .
	8165	"^DD",349. 2,349.2,.0 2,21,0)
	8166	^^1^1^2960 418^^
	8167	"^DD",349. 2,349.2,.0 2,21,1,0)
	8168	This is th e SSN for the patien t.
	8169	"^DD",349. 2,349.2,.0 2,"DT")
	8170	2960924
	8171	"^DD",349. 2,349.2,.0 3,0)
	8172	PATIENT NA ME^RFX^^0; 3^K:$L(X)> 44!($L(X)< 3) X S X=$ $NAM^RCFN0 1(+DA)
	8173	"^DD",349. 2,349.2,.0 3,1,0)
	8174	^.1
	8175	"^DD",349. 2,349.2,.0 3,1,1,0)
	8176	349.2^AKEY 2^MUMPS
	8177	"^DD",349. 2,349.2,.0 3,1,1,1)
	8178	I $$KEY^RC CPCFN(+DA) ]"" S ^RCP S(349.2,"A KEY",$$KEY ^RCCPCFN(+ DA),DA)=""
	8179	"^DD",349. 2,349.2,.0 3,1,1,2)
	8180	I $P(^RCPS (349.2,+DA ,0),"^",2) >1 K ^RCPS (349.2,"AK EY",$E($P( ^RCPS(349. 2,+DA,0),
	8181	"^",2),1,9 )_$TR($E($ P(X,","),1 ,5)," ","" ))
	8182	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,0)
	8183	^^1^1^3160 427^
	8184	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,1,0)
	8185	This cross -reference is used t o key the statements for CBSS.
	8186	"^DD",349. 2,349.2,.0 3,1,1,"DT" )
	8187	2960924
	8188	"^DD",349. 2,349.2,.0 3,3)
	8189	Answer mus t be 3-44 characters in length .
	8190	"^DD",349. 2,349.2,.0 3,21,0)
	8191	^^1^1^2960 418^^^^
	8192	"^DD",349. 2,349.2,.0 3,21,1,0)
	8193	This is th e patient name as it appears o n the stat ement.
	8194	"^DD",349. 2,349.2,.0 3,"DT")
	8195	2960924
	8196	"^DD",349. 2,349.2,.1 2,0)
	8197	INVALID ST ATEMENT ER ROR^P349.7 '^RCPSE(34 9.7,^0;12^ Q
	8198	"^DD",349. 2,349.2,.1 2,3)
	8199	Enter the error code for the r ecord that was not a ccepted by CBSS.
	8200	"^DD",349. 2,349.2,.1 2,21,0)
	8201	^^1^1^3160 427^
	8202	"^DD",349. 2,349.2,.1 2,21,1,0)
	8203	This is th e error co de for the record th at was not accepted by CBSS.
	8204	"^DD",349. 2,349.2,.1 2,"DT")
	8205	3160909
	8206	"^DD",349. 2,349.2,.1 8,0)
	8207	CBSS FILE BUILT^S^0: NOT BUILT; 1:BUILT;^0 ;18^Q
	8208	"^DD",349. 2,349.2,.1 8,3)
	8209	Enter a '1 ' when the CBSS PATI ENT STATEM ENTS file is complet e.
	8210	"^DD",349. 2,349.2,.1 8,21,0)
	8211	^^2^2^3160 909^^
	8212	"^DD",349. 2,349.2,.1 8,21,1,0)
	8213	This field will stor e a marker that the CBSS PATIE NT STATEME NTS file
	8214	"^DD",349. 2,349.2,.1 8,21,2,0)
	8215	(349.2) is a complet e file for that stat ement day.
	8216	"^DD",349. 2,349.2,.1 8,"DT")
	8217	3160921
	8218	"^DD",349. 2,349.2,.1 9,0)
	8219	PATIENT ST ATEMENT DA TE^D^^0;19 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	8220	"^DD",349. 2,349.2,.1 9,3)
	8221	Enter the date of th e Patient Statement.
	8222	"^DD",349. 2,349.2,.1 9,21,0)
	8223	^^2^2^3161 019^
	8224	"^DD",349. 2,349.2,.1 9,21,1,0)
	8225	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	8226	"^DD",349. 2,349.2,.1 9,21,2,0)
	8227	standardly two days after the statement is transmi tted
	8228	"^DD",349. 2,349.2,.1 9,"DT")
	8229	3161103
	8230	"^DD",349. 2,349.2,51 ,0)
	8231	ERROR CODE (S)^F^^5;1 ^K:$L(X)>3 0!($L(X)<5 ) X
	8232	"^DD",349. 2,349.2,51 ,1,0)
	8233	^.1^^0
	8234	"^DD",349. 2,349.2,51 ,3)
	8235	Answer mus t be 5-30 characters in length .
	8236	"^DD",349. 2,349.2,51 ,21,0)
	8237	^^2^2^3161 007^
	8238	"^DD",349. 2,349.2,51 ,21,1,0)
	8239	These are the error codes sent back by C BSS when a statement cannot be
	8240	"^DD",349. 2,349.2,51 ,21,2,0)
	8241	printed.
	8242	"^DD",349. 2,349.2,51 ,"DT")
	8243	3161007
	8244	"^DD",349. 2,349.2,61 ,0)
	8245	CBSS PRINT ED^S^1:Y;0 :N;^6;1^Q
	8246	"^DD",349. 2,349.2,61 ,3)
	8247	Enter whet her the pa tient stat ement for this patie nt printed at the CB SS.
	8248	"^DD",349. 2,349.2,61 ,21,0)
	8249	^^2^2^3160 909^^
	8250	"^DD",349. 2,349.2,61 ,21,1,0)
	8251	This field indicates whether t he patient statement for this patient pr inted
	8252	"^DD",349. 2,349.2,61 ,21,2,0)
	8253	at the CCP C or not.
	8254	"^DD",349. 2,349.2,61 ,"DT")
	8255	3160921
	8256	"^DD",349. 2,349.2,81 ,0)
	8257	INTEGRATIO N CONTROL NUMBER^NJ1 2,0^^8;1^K :+X'=X!(X> 9999999999 99)!(X<0)! (X?.E1"."
	8258	1.N) X
	8259	"^DD",349. 2,349.2,81 ,3)
	8260	Enter the ICN, a num ber betwee n 0 and 99 9999999999 with no d ecimal dig its.
	8261	"^DD",349. 2,349.2,81 ,21,0)
	8262	^^2^2^3160 909^
	8263	"^DD",349. 2,349.2,81 ,21,1,0)
	8264	Machine to machine i dentifier for a pati ent. This field can only be
	8265	"^DD",349. 2,349.2,81 ,21,2,0)
	8266	edited by CIRN.
	8267	"^DD",349. 2,349.2,81 ,"DT")
	8268	3160921
	8269	"^DD",349. 2,349.2,82 ,0)
	8270	ICN CHECKS UM^F^^8;2^ K:$L(X)>6! ($L(X)<6) X
	8271	"^DD",349. 2,349.2,82 ,3)
	8272	Answer mus t be 6 cha racters in length.
	8273	"^DD",349. 2,349.2,82 ,21,0)
	8274	^^2^2^3160 428^
	8275	"^DD",349. 2,349.2,82 ,21,1,0)
	8276	This check sum is the calculate d checksum for the I ntegration Control
	8277	"^DD",349. 2,349.2,82 ,21,2,0)
	8278	Number. I t verifies the integ rity of th e ICN.
	8279	"^DD",349. 2,349.2,82 ,"DT")
	8280	3160428
	8281	"^DD",349. 2,349.2,83 ,0)
	8282	AR FLAG^S^ T:TRUE;F:F ALSE;^8;3^ Q
	8283	"^DD",349. 2,349.2,83 ,3)
	8284	Enter T fo r 'TRUE' o r F for 'F alse', for whether t he patient address w as obtain
	8285	ed from AR storage.
	8286	"^DD",349. 2,349.2,83 ,21,0)
	8287	^^2^2^3160 428^
	8288	"^DD",349. 2,349.2,83 ,21,1,0)
	8289	This is a set of cod e, indicat ing whethe r or not t he address was taken
	8290	"^DD",349. 2,349.2,83 ,21,2,0)
	8291	from the A R DEBTOR ( #340).
	8292	"^DD",349. 2,349.2,83 ,"DT")
	8293	3160921
	8294	"^DD",349. 2,349.2,84 ,0)
	8295	DATE OF LA TEST BILL^ DX^^8;4^S %DT="EX" D ^%DT S X= Y K:X<1 X
	8296	"^DD",349. 2,349.2,84 ,3)
	8297	Enter the date on wh ich the la test bill was establ ished.
	8298	"^DD",349. 2,349.2,84 ,21,0)
	8299	^^1^1^3160 428^^
	8300	"^DD",349. 2,349.2,84 ,21,1,0)
	8301	The date t he latest bill was p repared. Time is no t allowed.
	8302	"^DD",349. 2,349.2,84 ,"DT")
	8303	3160921
	8304	"^DD",349. 5,349.5,0)
	8305	FIELD^^1^7
	8306	"^DD",349. 5,349.5,0, "DT")
	8307	3170224
	8308	"^DD",349. 5,349.5,0, "IX","B",3 49.5,.01)
	8309
	8310	"^DD",349. 5,349.5,0, "NM","AR A NNUAL PAYM ENT STATEM ENT")
	8311
	8312	"^DD",349. 5,349.5,.0 1,0)
	8313	PS SEGMENT NUMBER^RN J4,0^^0;1^ K:+X'=X!(X >9999)!(X< 1)!(X?.E1" ."1.N) X
	8314	"^DD",349. 5,349.5,.0 1,1,0)
	8315	^.1
	8316	"^DD",349. 5,349.5,.0 1,1,1,0)
	8317	349.5^B
	8318	"^DD",349. 5,349.5,.0 1,1,1,1)
	8319	S ^RCAP(34 9.5,"B",$E (X,1,30),D A)=""
	8320	"^DD",349. 5,349.5,.0 1,1,1,2)
	8321	K ^RCAP(34 9.5,"B",$E (X,1,30),D A)
	8322	"^DD",349. 5,349.5,.0 1,3)
	8323	Enter the PS Segment Number (a number be tween 1 an d 9999).
	8324	"^DD",349. 5,349.5,.0 1,21,0)
	8325	^^1^1^3170 223^
	8326	"^DD",349. 5,349.5,.0 1,21,1,0)
	8327	This is th e Segment Number for the "PS" Record Ide ntifier.
	8328	"^DD",349. 5,349.5,.0 1,"DT")
	8329	3170224
	8330	"^DD",349. 5,349.5,.0 2,0)
	8331	YEAR^NJ3,0 ^^0;2^K:+X '=X!(X>400 )!(X<300)! (X?.E1"."1 .N) X
	8332	"^DD",349. 5,349.5,.0 2,3)
	8333	Enter the Year for t his segmen t in Inter nal FileMa n Format ( a number b etween 30
	8334	0 and 400) .
	8335	"^DD",349. 5,349.5,.0 2,21,0)
	8336	^^1^1^3170 223^
	8337	"^DD",349. 5,349.5,.0 2,21,1,0)
	8338	This is th e Annual P ayment Fil e Year to be process ed.
	8339	"^DD",349. 5,349.5,.0 2,"DT")
	8340	3170224
	8341	"^DD",349. 5,349.5,.0 3,0)
	8342	DATE/TIME BUILD STAR TED^D^^0;3 ^S %DT="ES TXR" D ^%D T S X=Y K: 31701 >X X
	8343	"^DD",349. 5,349.5,.0 3,3)
	8344	Enter the Date and T ime Build Started.
	8345	"^DD",349. 5,349.5,.0 3,21,0)
	8346	^^1^1^3170 223^
	8347	"^DD",349. 5,349.5,.0 3,21,1,0)
	8348	This is th e Date and Time that the Build for this file start ed.
	8349	"^DD",349. 5,349.5,.0 3,"DT")
	8350	3170224
	8351	"^DD",349. 5,349.5,.0 4,0)
	8352	DATE/TIME BUILD ENDE D^D^^0;4^S %DT="ESTX R" D ^%DT S X=Y K:31 701 >X X
	8353	"^DD",349. 5,349.5,.0 4,3)
	8354	Enter the Date and T ime Build Ended.
	8355	"^DD",349. 5,349.5,.0 4,21,0)
	8356	^^1^1^3170 223^
	8357	"^DD",349. 5,349.5,.0 4,21,1,0)
	8358	This is th e Date and Time that the Build for this file ended .
	8359	"^DD",349. 5,349.5,.0 4,"DT")
	8360	3170224
	8361	"^DD",349. 5,349.5,.0 5,0)
	8362	DATE/TIME TRANSMIT S TARTED^D^^ 0;5^S %DT= "ESTXR" D ^%DT S X=Y K:31701 >X X
	8363	"^DD",349. 5,349.5,.0 5,3)
	8364	Enter the Date and T ime Transm it Started .
	8365	"^DD",349. 5,349.5,.0 5,21,0)
	8366	^^1^1^3170 223^
	8367	"^DD",349. 5,349.5,.0 5,21,1,0)
	8368	This is th e Date and Time that the Trans mit for th is file st arted.
	8369	"^DD",349. 5,349.5,.0 5,"DT")
	8370	3170224
	8371	"^DD",349. 5,349.5,.0 6,0)
	8372	DATE/TIME TRANSMIT E NDED^D^^0; 6^S %DT="E STXR" D ^% DT S X=Y K :31701 >X X
	8373	"^DD",349. 5,349.5,.0 6,3)
	8374	Enter Date /Time Tran smit Ended .
	8375	"^DD",349. 5,349.5,.0 6,21,0)
	8376	^^1^1^3170 223^
	8377	"^DD",349. 5,349.5,.0 6,21,1,0)
	8378	This is th e Date and Time that the Trans mit for th is file en ded.
	8379	"^DD",349. 5,349.5,.0 6,"DT")
	8380	3170224
	8381	"^DD",349. 5,349.5,1, 0)
	8382	STATEMENT FILE LINES ^349.51^^1 ;0
	8383	"^DD",349. 5,349.5,1, 21,0)
	8384	^^1^1^3170 224^^
	8385	"^DD",349. 5,349.5,1, 21,1,0)
	8386	This is th e multiple for the A nnual Paym ent Statem ent file l ines.
	8387	"^DD",349. 5,349.51,0 )
	8388	STATEMENT FILE LINES SUB-FIELD ^^.01^1
	8389	"^DD",349. 5,349.51,0 ,"DT")
	8390	3170224
	8391	"^DD",349. 5,349.51,0 ,"NM","STA TEMENT FIL E LINES")
	8392
	8393	"^DD",349. 5,349.51,0 ,"UP")
	8394	349.5
	8395	"^DD",349. 5,349.51,. 01,0)
	8396	STATEMENT FILE LINES ^MFJ342^^0 ;1^K:$L(X) >342!($L(X )<1) X
	8397	"^DD",349. 5,349.51,. 01,1,0)
	8398	^.1^^0
	8399	"^DD",349. 5,349.51,. 01,3)
	8400	Enter File Lines for Annual Pa yment Stat ement (1 t o 342 char acters).
	8401	"^DD",349. 5,349.51,. 01,21,0)
	8402	^^1^1^3170 224^
	8403	"^DD",349. 5,349.51,. 01,21,1,0)
	8404	These are the File L ines for A nnual Paym ent Statem ent.
	8405	"^DD",349. 5,349.51,. 01,"DT")
	8406	3170224
	8407	"^DIC",349 .1,349.1,0 )
	8408	AR TRANSMI SSION TYPE ^349.1
	8409	"^DIC",349 .1,349.1,0 ,"GL")
	8410	^RCT(349.1 ,
	8411	"^DIC",349 .1,349.1," %D",0)
	8412	^1.001^2^2 ^3160422^^ ^^
	8413	"^DIC",349 .1,349.1," %D",1,0)
	8414	This file stores the transmiss ion types used in fi le 349
	8415	"^DIC",349 .1,349.1," %D",2,0)
	8416	AR TRANSMI SSION RECO RDS.
	8417	"^DIC",349 .1,"B","AR TRANSMISS ION TYPE", 349.1)
	8418
	8419	"^DIC",349 .5,349.5,0 )
	8420	AR ANNUAL PAYMENT ST ATEMENT^34 9.5
	8421	"^DIC",349 .5,349.5,0 ,"GL")
	8422	^RCAP(349. 5,
	8423	"^DIC",349 .5,349.5," %",0)
	8424	^1.005^^
	8425	"^DIC",349 .5,349.5," %D",0)
	8426	^^3^3^3170 223^
	8427	"^DIC",349 .5,349.5," %D",1,0)
	8428	This file will hold all of the previous year's pat ient payme nt data fo r
	8429	"^DIC",349 .5,349.5," %D",2,0)
	8430	that calen dar year a nd persist for only one year t o then be deleted an d
	8431	"^DIC",349 .5,349.5," %D",3,0)
	8432	replaced a t the begi nning of t he next ca lendar yea r.
	8433	"^DIC",349 .5,"B","AR ANNUAL PA YMENT STAT EMENT",349 .5)
	8434
	8435	"BLD",1011 1,6)
	8436	4^
	8437	$END KID P RCA4.531 3