4. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 2/28/2017 9:33:44 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

4.1 Files compared

#	Location	File	Last Modified
1	PSE_v22_PRCA4.5307.zip\PSE_v22_PRCA4.5307\PSE Patch PRCA_45_307 v22 CIF submission.zip	PRCA_45_307 v22 Patch.docx	Wed Feb 8 22:21:50 2017 UTC
2	PSE_v22_PRCA4.5307.zip\PSE_v22_PRCA4.5307\PSE Patch PRCA_45_307 v22 CIF submission.zip	PRCA_45_307 v22 Patch.docx	Tue Feb 28 04:16:28 2017 UTC

4.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	2	9108
Changed	1	6
Inserted	0	0
Removed	0	0

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

4.4 Active regular expressions

No regular expressions were active.

4.5 Comparison detail

	1	========== ========== ========== ========== ========== ========== ========== =======
	2	Run Date: JAN 23, 20 17 Designa tion: PRCA 4.5307
	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)PRCA4. 5233<<= m ust be ins talled BEF ORE `PRCA* 4.5*307'
	8	(v)PRCA4. 5237<<= m ust be ins talled BEF ORE `PRCA* 4.5*307'
	9	(v)PRCA4. 5276<<= m ust be ins talled BEF ORE `PRCA* 4.5*307'
	10	(v)PRCA4. 5301<<= m ust be ins talled BEF ORE `PRCA* 4.5*307'
	11	(v)PRCA4. 5309<<= m ust be ins talled BEF ORE `PRCA* 4.5*307'
	12
	13	Subject: P atient Sta tement Enh ancement P hase One
	14
	15	Category:
	16	- Routin e
	17	- Enhanc ement (Man datory)
	18	- Data D ictionary
	19
	20	Descriptio n:
	21	========== ==
	22
	23	******* ****** ****** ****** ****** ****** ****** ******
	24	This patch supp orts chang es to the Veterans H ealth Info rmation
	25	Syste m and Tech nology Arc hitecture (VistA) fo r the Pati ent Statem ent
	26	Enhan cements Pr oject (PSE ).
	27
	28	It is imperativ e that the se patches be instal led no lat er than th e
	29	compl iance date . Your und erstanding and suppo rt is appr eciated.
	30	******* ****** ****** ****** ****** ****** ****** ******
	31
	32	The Chief Business Office (CB O) request ed modific ations to the VistA
	33	Accounts Receivable (AR) pack age to rem edy defici encies ide ntified wi th
	34	patient s tatements. The main goals of t his projec t includes the
	35	remediati on and enh ancement o f the AR a pplication software to correct
	36	these dis crepancies . Addition ally this project wi ll perform the initi al
	37	developme nt of the VistA AR e nhancement s to creat e a single , consolid ated
	38	patient s tatement, self-servi ce options for payme nt, and ot her modifi cations.
	39
	40	This patc h modifies the Accou nt Receiva ble (AR) v 4.5 applic ation as
	41	described below:
	42
	43	1. Patien t Statemen t Auto-Cor rection Pr ogram
	44	The A R applicat ion execut es an Auto -Correctio n program that detec ts
	45	and r emediates the follow ing 3 type s of state ment discr epancies:
	46
	47	1. Tr ansaction amounts mi ssing in t he AR TRAN SACTION fi le (#433).
	48	2. Du plicate tr ansactions in the AR TRANSACTI ON file (# 433).
	49	3. In complete s tatus erro rs in the AR TRANSAC TION file (#433).
	50
	51	The P atient Sta tement Aut o-Correcti on Program is schedu led as par t of
	52	the A R nightly background job.
	53
	54	The P atient Sta tement Aut o-Correcti on Program can be ru n on deman d
	55	and w ill be an option in the Accoun t Manageme nt menu.
	56
	57	The P atient Sta tement Aut o-Correcti on Program runs as a
	58	post- initializa tion progr am at the time of in stallation .
	59
	60	OI&T should als o schedule the PRCA AUTOCRCT P GM QUEUED option to run
	61	every Wednesday at 1:00 A M local ti me, before the CCPC job.
	62
	63	2. Auto-C orrect Pat ient Discr epancy Rep ort
	64	The A uto-Correc t Patient Discrepanc y Report l ists the d iscrepancy
	65	detai ls that we re remedia ted by the Patient S tatement
	66	Auto- Correction Program.
	67
	68	The A uto-Correc t Patient Discrepanc y Report d isplays th e bill num ber,
	69	the d ebtor, the last four digits of the SSN, the transa ction numb er,
	70	the c orrection date, and the reason for the a uto-correc tion.
	71
	72	The A uto-Correc t Patient Discrepanc y Report p rovides fo ur sort
	73	optio ns.
	74	1 B ill Number
	75	2 D ebtor Name
	76	3 A uto-Correc t Date
	77	4 T ransaction Number
	78
	79	Each entry in t he Auto-Co rrect Pati ent Discre pancy Repo rt will ha ve
	80	one o f the four Auto-Corr ect Reason s.
	81	1 I NCOMPLETE FLAG ERROR
	82	2 D UPLICATE T RANSACTION
	83	3 N ULL TRANSA CTION AMOU NT
	84	4 N OT FIXABLE
	85
	86	Trans actions li sted as NO T FIXABLE will need to be manu ally revie wed
	87	to de termine th e appropri ate course of action and then they shoul d be
	88	corre cted manua lly.
	89
	90	3. Root C ause of St atement Di screpancie s
	91	Chang es prevent Null Tran sactions w hen Commen t field is left blan k by
	92	user and a time out occurs .
	93
	94	Chang es process ing of Tie r Rate tra nsactions in VistA t o stop
	95	dupli cates bein g filed.
	96
	97
	98	Patch Com ponents:
	99	--------- --------
	100
	101	Files & F ields Asso ciated:
	102
	103	The follo wing is a list of fi les includ ed in this patch:
	104
	105	File Name (Number) Field N ame (Numbe r) New/M odified/De leted
	106	--------- --------- ------- ---------- -- ----- ---------- -----
	107	AR TRANSA CTION AUTO-CO RRECTION NEW
	108	FILE (#43 3) DATE (# 94)
	109
	110	AUTO-CO RRECTION T RANS. NEW
	111	AMOUNT (#95)
	112
	113	AUTO-CO RRECTION T YPE NEW
	114	OF ERRO R (#96)
	115
	116	AUTO-CO RRECTION T ICKET NEW
	117	FLAG (# 97)
	118
	119	Forms Ass ociated:
	120
	121	Form Name File # New/M odified/De leted
	122	--------- ------ ----- ---------- -----
	123	N/A
	124
	125
	126	Mail Grou ps Associa ted:
	127
	128	Mail Grou p Name New/M odified/De leted
	129	--------- ------ ----- ---------- -----
	130	PRCACPS NEW
	131
	132
	133	Options A ssociated:
	134
	135	Option Na me Type New/M odified/De leted
	136	--------- -- -------- --- ----- ---------- -----
	137	PRCA ACCO UNT MANAGE MENT MENU MODIFIED
	138	PRCA AUTO CRCT PGM RUN ROUT INE NEW
	139	PRCA AUTO CRCT RPT RUN ROUT INE NEW
	140
	141
	142	Protocols Associate d:
	143
	144	Protocol Name New /Modified/ Deleted
	145	--------- ---- --- ---------- -------
	146	N/A
	147
	148
	149	Security Keys Assoc iated:
	150
	151
	152	Security Key Name New/M odified/De leted
	153	--------- -------- ----- ---------- -----
	154	PRCA AUTO CRCT PGM NEW
	155
	156
	157	Templates Associate d:
	158
	159	Template Name Type File Na me (Number ) New/M odified/De leted
	160	--------- ---- ----- ------- ---------- -- ----- ---------- -----
	161	PRCA RE-E STABLISH INPUT AR TRAN SACTION FI LE MODIFIED
	162	WRITE-OF F
	163
	164	Remote Pr ocedure: New/M odified/De leted
	165	--------- -------- ----- ---------- -----
	166	N/A
	167
	168	Additiona l Informat ion:
	169	N/A
	170
	171	New Servi ce Request (NSRs):
	172	--------- ---------- --------
	173	N/A
	174
	175	Patient S afety Issu es (PSIs):
	176	--------- ---------- ----------
	177	N/A
	178
	179	Defect Tr acking Sys tem Ticket (s) & Over view:
	180	--------- ---------- ---------- ---------- -----
	181	N/A
	182
	183	Test Site s:
	184	--------- --
	185	TBD
	186
	187
	188	Software and Docume ntation Re trieval In structions :
	189	--------- ---------- ---------- ---------- ---------- -
	190	Software being rele ased as a host file and/or doc umentation describin g
	191	the new f unctionali ty introdu ced by thi s patch ar e availabl e.
	192
	193	The prefe rred metho d is to re trieve fil es from do wnload.vis ta.med.va. gov.
	194	This tran smits the files from the first available server. S ites may a lso
	195	elect to retrieve f iles direc tly from a specific server.
	196
	197	Sites may retrieve the softwa re and/or documentat ion direct ly using S ecure
	198	File Tran sfer Proto col (SFTP) from the ANONYMOUS. SOFTWARE d irectory a t the
	199	following OI Field Offices:
	200
	201	Albany: DNS
	202	Hines: DNS
	203	Salt Lake City: DNS
	204
	205	Documenta tion can a lso be fou nd on the VA Softwar e Document ation Libr ary at:
	206	http://ww w4.va.gov/ vdl/
	207
	208
	209	Title File Name SFTP Mode
	210	--------- ---------- ---------- ---------- ---------- ---------- ---------- -----
	211	Patient S tatement E nhancement s User Man ual prca_ 4_5_p307_u m.pdf (bin ary)
	212	Patient S tatement E nhancement s Release prca_ 4_5_p307_r n.pdf (bin ary)
	213	Notes / Installati on Guide
	214	Accounts Receivable Technical Manual / prca_ 4_5_p307_t m.pdf (bin ary)
	215	Security Guide
	216
	217
	218	Patch Ins tallation:
	219
	220
	221	Pre/Post Installati on Overvie w:
	222	--------- ---------- ---------- --
	223
	224	The post- install ro utine for patch PRCA 4.5307 w ill, for 1 7 specific
	225	Station I D's listed at the bo ttom of th is documen t, update the
	226	SITE STAT EMENT DAY field (#.1 1) in AR S ITE PARAME TER file ( #342).
	227
	228	The post- install ro utine for patch PRCA 4.5307 w ill queue the
	229	Patient S tatement A uto-Correc tion Progr am to reme diate stat ement
	230	discrepan cies.
	231
	232	The post install ro utine PRCA 307P may b e deleted from the s ystem if t he
	233	post-inst all proces s has comp leted.
	234
	235	Pre-Insta llation In structions :
	236	--------- ---------- ---------- -
	237	This patc h may be i nstalled w ith users on the sys tem althou gh it is
	238	recommend ed that it be instal led during non-peak hours to m inimize
	239	potential disruptio n to users . This pat ch should take less than 20
	240	minutes t o install.
	241
	242	The follo wing optio ns may be marked as 'out of or der':
	243
	244	Stat ement Disc repancy Li sting [ PRCA DISC LIST]
	245	Chec k Patient Account Ba lance [ PRCA ACCOU NT CHECK]
	246
	247	Installat ion Instru ctions:
	248	--------- ---------- -------
	249	This patc h modifies the Accou nt Receiva ble (AR) v 4.5 applic ation
	250	to prepar e for a si ngle, cons olidated p atient sta tement.
	251
	252	1. Cho ose the Pa ckMan mess age contai ning this patch.
	253
	254	2. Cho ose the IN STALL/CHEC K MESSAGE PackMan op tion.
	255
	256	3. Fro m the Kern el Install ation and Distributi on System Menu, sele ct
	257	the Installat ion Menu. From this menu, you may elect to use the
	258	fol lowing opt ions. When prompted for the IN STALL NAME enter the
	259	pat ch PRCA4. 5307.
	260
	261	a. Backup a T ransport G lobal - Th is option will creat e a backup
	262	message of any routi nes export ed with th is patch. It will no t
	263	backup any other cha nges such as DDs or templates.
	264
	265	b. Compare Tr ansport Gl obal to Cu rrent Syst em - This option wil l
	266	allow you to view al l changes that will be made wh en this
	267	patch is i nstalled. It compare s all comp onents of this patch
	268	routines, DDs, templ ates, etc.
	269
	270	c. Verify Che cksums in Transport Global - T his option will allo w
	271	you to ens ure the in tegrity of the routi nes that a re in the
	272	transport global.
	273
	274	4. Fro m the Inst allation M enu, selec t the Inst all Packag e(s)
	275	opt ion and ch oose the p atch to in stall.
	276
	277	5. Whe n prompted 'Want KID S to Rebui ld Menu Tr ees Upon C ompletion
	278	of Install? Y ES//' repl y 'YES' un less your system reb uilds menu
	279	tre es nightly using Tas kMan. Answ ering Yes during nor mal busine ss
	280	hou rs could a ffect user s on the s ystem and installati on times w ill
	281	inc rease.
	282
	283	6. Whe n Prompted "Enter th e Coordina tor for Ma il Group ' PRCACPS':" ,
	284	re spond with the name: Kendrick, Tammy S.
	285
	286	7. Whe n Prompted "Want KID S to INHIB IT LOGONs during the install?
	287	NO //", respo nd NO.
	288
	289	8. Whe n Prompted "Want to DISABLE Sc heduled Op tions, Men u Options, and
	290	Pr otocols? N O//", resp ond YES.
	291
	292	a . When Pro mpted "Ent er options you wish to mark as 'Out Of
	293	Order':" , enter th e followin g options:
	294
	295	State ment Discr epancy Lis ting [P RCA DISC L IST]
	296	Check Patient A ccount Bal ance [P RCA ACCOUN T CHECK]
	297
	298	b . When Pro mpted "Ent er protoco ls you wis h to mark as 'Out
	299	Of Order ':", Press <ENTER>.
	300
	301	9. Whe n prompted "Delay In stall (Min utes): (0 -60): 0//" enter an
	302	app ropriate n umber of m inutes to delay the installati on in
	303	ord er to give users eno ugh time t o exit the disabled options
	304	bef ore the in stallation starts.
	305
	306	10. Whe n prompted "Device: Home//" re spond with the corre ct device.
	307
	308	Post-Inst allation I nstruction s
	309	--------- ---------- ---------- -
	310	The Auto- Correction program m ay take up to 20 min utes to ru n.
	311
	312	Updated i n this pat ch during the post i nstall pro cess, for only 17
	313	specific Station ID 's listed below, wil l be an up date to th e SITE
	314	STATEMENT DAY field (#.11) in AR SITE P ARAMETER f ile (#342) . Only Pat ient
	315	Debtors f or the fol lowing Sta tion ID's will have their STAT EMENT DAY
	316	changed t o a new da te in the month. Thi s change f or these 1 7 Station ID's
	317	will allo w a window of time a t the end of the mon th to inst all the
	318	follow-on PSE patch PRCA4.5 313 nation ally.
	319
	320	STATION # STATION NAME DATE
	321	--------- ---------- ---------- -----
	322	438 SIOUX F ALLS,SD 21
	323	501 ALBUQUE RQUE,NM 21
	324	504 AMARILL O,TX 21
	325	542 COATESV ILLE,PA 21
	326	562 ERIE,PA 21
	327	568 FORT ME ADE,SD 21
	328	649 PRESCOT T,AZ 21
	329	656 ST. CLO UD,MN 21
	330	688 WASHING TON,DC 21
	331	756 EL PASO ,TX 21
	332	565 FAYETTE VILLE,NC 22
	333	621 MOUNTAI N HOME,TN 22
	334	658 SALEM,V A 22
	335	664 SAN DIE GO,CA 22
	336	671 SAN ANT ONIO,TX 22
	337	689 WEST HA VEN,CT 22
	338	740 TX VALL EY CSTL,TX 22
	339
	340	During th e post-ins tall proce ss you may see liste d in the l og one of the
	341	following messages:
	342
	343	>>> STATI ON ID XXX MATCH FOUN D!
	344	>>> THE P ATIENT STA TEMENT TRA NSMISSION DATE WILL BE UPDATED
	345	Note: XX X will equ al your ST ATION NUMB ER
	346
	347	>>> WARNI NG! STATIO N ID NOT F OUND!
	348	>>> THE P ATIENT STA TEMENT TRA NSMISSION DATE WILL NOT BE UPD ATED
	349
	350
	351	The post- install ro utine for patch PRCA 4.5307 w ill queue the
	352	Patient S tatement A uto-Correc tion Progr am to reme diate stat ement
	353	discrepan cies.
	354
	355	The insta llation lo g will dis play:
	356	>>>POST-I NSTALL CON SOLIDATED PATIENT ST ATEMENT AU TO-CORRECT ION
	357	>>>PROGRA M HAS BEEN QUEUED
	358
	359	If there is an erro r, the ins tallation log will d isplay:
	360	>>>ERROR: POST-INST ALL CONSOL IDATED PAT IENT STATE MENT AUTO- CORRECTION
	361	>>>PROGRA M COULD NO T BE QUEUE D
	362
	363
	364	The post install ro utine PRCA 307P may b e deleted from the s ystem if t he
	365	post-inst all proces s has comp leted.
	366	========= ========== ========== ========== ========== ========== ========== ===
	367
	368	Routine In formation:
	369	========== ==========
	370	The second line of e ach of the se routine s now look s like:
	371	;;4.5;Acc ounts Rece ivable;[ Patch List ];Mar 20 , 1995;Bui ld 79
	372
	373	The checks ums below are new ch ecksums, a nd
	374	can be ch ecked with CHECK1^XT SUMBLD.
	375
	376	Routine Na me: PRCA30 7P
	377	Before : n/ a After: B6358634 307
	378	Routine Na me: PRCAAC R
	379	Before : n/ a After: B97009305 307
	380	Routine Na me: PRCAAC R1
	381	Before : n/ a After: B104478523 307
	382	Routine Na me: PRCACP S
	383	Before : n/ a After: B261993502 307
	384	Routine Na me: PRCACP SA
	385	Before : n/ a After: B27923295 307
	386	Routine Na me: PRCASE R1
	387	Before : B1674148 1 After: B18562527 48,104 ,165,233,3 01,307
	388	Routine Na me: RCCPCB J
	389	Before : B628849 1 After: B7509278 34,76, 130,153,16 6,195,217, 237,307
	390	Routine Na me: RCDPBT LM
	391	Before : B4947614 0 After: B55886735 **114,14 8,153,168, 169,198,24 7,
	392	271,276 ,307**
	393	Routine Na me: RCWROF F
	394	Before : B3846896 0 After: B40151788 168,20 4,309,301, 307
	395
	396	Routine li st of prec eding patc hes: 237, 276, 301
	397
	398	========== ========== ========== ========== ========== ========== ========== =======
	399	User Infor mation:
	400	Entered By : DERDER IAN,JOHN A Date E ntered : DEC 15, 20 14
	401	Completed By: Date C ompleted:
	402	Released B y : Date R eleased :
	403	========== ========== ========== ========== ========== ========== ========== =======
	404
	405
	406	Packman Ma il Message :
	407	========== ========== =
	408
	409	$END TXT
	410	$KID PRCA* 4.5*307
	411	INSTALL NAME
	412	PRCA4.53 07
	413	"BLD",1015 3,0)
	414	PRCA4.53 07^ACCOUNT S RECEIVAB LE^0^31701 23^y
	415	"BLD",1015 3,1,0)
	416	^^1^1^3151 102^^
	417	"BLD",1015 3,1,1,0)
	418	Consolidat ed Patient Statement
	419	"BLD",1015 3,4,0)
	420	^9.64PA^43 3^1
	421	"BLD",1015 3,4,433,0)
	422	433
	423	"BLD",1015 3,4,433,2, 0)
	424	^9.641^433 ^1
	425	"BLD",1015 3,4,433,2, 433,0)
	426	AR TRANSAC TION (Fil e-top leve l)
	427	"BLD",1015 3,4,433,2, 433,1,0)
	428	^9.6411^97 ^4
	429	"BLD",1015 3,4,433,2, 433,1,94,0 )
	430	AUTO-CORRE CTION DATE
	431	"BLD",1015 3,4,433,2, 433,1,95,0 )
	432	AUTO-CORRE CTION TRAN S. AMOUNT
	433	"BLD",1015 3,4,433,2, 433,1,96,0 )
	434	AUTO-CORRE CTION TYPE OF ERROR
	435	"BLD",1015 3,4,433,2, 433,1,97,0 )
	436	AUTO-CORRE CTION TICK ET FLAG
	437	"BLD",1015 3,4,433,22 2)
	438	y^n^p^^^^n ^^n
	439	"BLD",1015 3,4,433,22 4)
	440
	441	"BLD",1015 3,4,"APDD" ,433,433)
	442
	443	"BLD",1015 3,4,"APDD" ,433,433,9 4)
	444
	445	"BLD",1015 3,4,"APDD" ,433,433,9 5)
	446
	447	"BLD",1015 3,4,"APDD" ,433,433,9 6)
	448
	449	"BLD",1015 3,4,"APDD" ,433,433,9 7)
	450
	451	"BLD",1015 3,4,"B",43 3,433)
	452
	453	"BLD",1015 3,6)
	454	20^
	455	"BLD",1015 3,6.3)
	456	79
	457	"BLD",1015 3,"ABPKG")
	458	n
	459	"BLD",1015 3,"INID")
	460	^n
	461	"BLD",1015 3,"INIT")
	462	EN^PRCA307 P
	463	"BLD",1015 3,"KRN",0)
	464	^9.67PA^77 9.2^20
	465	"BLD",1015 3,"KRN",.4 ,0)
	466	.4
	467	"BLD",1015 3,"KRN",.4 ,"NM",0)
	468	^9.68A^^0
	469	"BLD",1015 3,"KRN",.4 01,0)
	470	.401
	471	"BLD",1015 3,"KRN",.4 01,"NM",0)
	472	^9.68A^^
	473	"BLD",1015 3,"KRN",.4 02,0)
	474	.402
	475	"BLD",1015 3,"KRN",.4 02,"NM",0)
	476	^9.68A^1^1
	477	"BLD",1015 3,"KRN",.4 02,"NM",1, 0)
	478	PRCA RE-ES TABLISH WR ITE-OFF FILE #433 ^433^0
	479	"BLD",1015 3,"KRN",.4 02,"NM","B ","PRCA RE -ESTABLISH WRITE-OFF FILE # 433",1)
	480
	481	"BLD",1015 3,"KRN",.4 03,0)
	482	.403
	483	"BLD",1015 3,"KRN",.4 03,"NM",0)
	484	^9.68A^^
	485	"BLD",1015 3,"KRN",.5 ,0)
	486	.5
	487	"BLD",1015 3,"KRN",.8 4,0)
	488	.84
	489	"BLD",1015 3,"KRN",3. 6,0)
	490	3.6
	491	"BLD",1015 3,"KRN",3. 8,0)
	492	3.8
	493	"BLD",1015 3,"KRN",3. 8,"NM",0)
	494	^9.68A^1^1
	495	"BLD",1015 3,"KRN",3. 8,"NM",1,0 )
	496	PRCACPS^^0
	497	"BLD",1015 3,"KRN",3. 8,"NM","B" ,"PRCACPS" ,1)
	498
	499	"BLD",1015 3,"KRN",9. 2,0)
	500	9.2
	501	"BLD",1015 3,"KRN",9. 8,0)
	502	9.8
	503	"BLD",1015 3,"KRN",9. 8,"NM",0)
	504	^9.68A^10^ 9
	505	"BLD",1015 3,"KRN",9. 8,"NM",1,0 )
	506	PRCACPS^^0 ^B26199350 2
	507	"BLD",1015 3,"KRN",9. 8,"NM",2,0 )
	508	PRCA307P^^ 0^B6358634
	509	"BLD",1015 3,"KRN",9. 8,"NM",3,0 )
	510	PRCASER1^^ 0^B1856252 7
	511	"BLD",1015 3,"KRN",9. 8,"NM",4,0 )
	512	RCWROFF^^0 ^B40151788
	513	"BLD",1015 3,"KRN",9. 8,"NM",5,0 )
	514	RCCPCBJ^^0 ^B7509278
	515	"BLD",1015 3,"KRN",9. 8,"NM",7,0 )
	516	PRCAACR^^0 ^B97009305
	517	"BLD",1015 3,"KRN",9. 8,"NM",8,0 )
	518	PRCAACR1^^ 0^B1044785 23
	519	"BLD",1015 3,"KRN",9. 8,"NM",9,0 )
	520	RCDPBTLM^^ 0^B5588673 5
	521	"BLD",1015 3,"KRN",9. 8,"NM",10, 0)
	522	PRCACPSA^^ 0^B2792329 5
	523	"BLD",1015 3,"KRN",9. 8,"NM","B" ,"PRCA307P ",2)
	524
	525	"BLD",1015 3,"KRN",9. 8,"NM","B" ,"PRCAACR" ,7)
	526
	527	"BLD",1015 3,"KRN",9. 8,"NM","B" ,"PRCAACR1 ",8)
	528
	529	"BLD",1015 3,"KRN",9. 8,"NM","B" ,"PRCACPS" ,1)
	530
	531	"BLD",1015 3,"KRN",9. 8,"NM","B" ,"PRCACPSA ",10)
	532
	533	"BLD",1015 3,"KRN",9. 8,"NM","B" ,"PRCASER1 ",3)
	534
	535	"BLD",1015 3,"KRN",9. 8,"NM","B" ,"RCCPCBJ" ,5)
	536
	537	"BLD",1015 3,"KRN",9. 8,"NM","B" ,"RCDPBTLM ",9)
	538
	539	"BLD",1015 3,"KRN",9. 8,"NM","B" ,"RCWROFF" ,4)
	540
	541	"BLD",1015 3,"KRN",19 ,0)
	542	19
	543	"BLD",1015 3,"KRN",19 ,"NM",0)
	544	^9.68A^4^4
	545	"BLD",1015 3,"KRN",19 ,"NM",1,0)
	546	PRCA AUTOC RCT PGM^^0
	547	"BLD",1015 3,"KRN",19 ,"NM",2,0)
	548	PRCA AUTOC RCT RPT^^0
	549	"BLD",1015 3,"KRN",19 ,"NM",3,0)
	550	PRCA ACCOU NT MANAGEM ENT^^2
	551	"BLD",1015 3,"KRN",19 ,"NM",4,0)
	552	PRCA AUTOC RCT PGM QU EUED^^0
	553	"BLD",1015 3,"KRN",19 ,"NM","B", "PRCA ACCO UNT MANAGE MENT",3)
	554
	555	"BLD",1015 3,"KRN",19 ,"NM","B", "PRCA AUTO CRCT PGM", 1)
	556
	557	"BLD",1015 3,"KRN",19 ,"NM","B", "PRCA AUTO CRCT PGM Q UEUED",4)
	558
	559	"BLD",1015 3,"KRN",19 ,"NM","B", "PRCA AUTO CRCT RPT", 2)
	560
	561	"BLD",1015 3,"KRN",19 .1,0)
	562	19.1
	563	"BLD",1015 3,"KRN",19 .1,"NM",0)
	564	^9.68A^1^1
	565	"BLD",1015 3,"KRN",19 .1,"NM",1, 0)
	566	PRCA AUTOC RCT PGM^^0
	567	"BLD",1015 3,"KRN",19 .1,"NM","B ","PRCA AU TOCRCT PGM ",1)
	568
	569	"BLD",1015 3,"KRN",10 1,0)
	570	101
	571	"BLD",1015 3,"KRN",40 9.61,0)
	572	409.61
	573	"BLD",1015 3,"KRN",77 1,0)
	574	771
	575	"BLD",1015 3,"KRN",77 9.2,0)
	576	779.2
	577	"BLD",1015 3,"KRN",87 0,0)
	578	870
	579	"BLD",1015 3,"KRN",89 89.51,0)
	580	8989.51
	581	"BLD",1015 3,"KRN",89 89.52,0)
	582	8989.52
	583	"BLD",1015 3,"KRN",89 94,0)
	584	8994
	585	"BLD",1015 3,"KRN","B ",.4,.4)
	586
	587	"BLD",1015 3,"KRN","B ",.401,.40 1)
	588
	589	"BLD",1015 3,"KRN","B ",.402,.40 2)
	590
	591	"BLD",1015 3,"KRN","B ",.403,.40 3)
	592
	593	"BLD",1015 3,"KRN","B ",.5,.5)
	594
	595	"BLD",1015 3,"KRN","B ",.84,.84)
	596
	597	"BLD",1015 3,"KRN","B ",3.6,3.6)
	598
	599	"BLD",1015 3,"KRN","B ",3.8,3.8)
	600
	601	"BLD",1015 3,"KRN","B ",9.2,9.2)
	602
	603	"BLD",1015 3,"KRN","B ",9.8,9.8)
	604
	605	"BLD",1015 3,"KRN","B ",19,19)
	606
	607	"BLD",1015 3,"KRN","B ",19.1,19. 1)
	608
	609	"BLD",1015 3,"KRN","B ",101,101)
	610
	611	"BLD",1015 3,"KRN","B ",409.61,4 09.61)
	612
	613	"BLD",1015 3,"KRN","B ",771,771)
	614
	615	"BLD",1015 3,"KRN","B ",779.2,77 9.2)
	616
	617	"BLD",1015 3,"KRN","B ",870,870)
	618
	619	"BLD",1015 3,"KRN","B ",8989.51, 8989.51)
	620
	621	"BLD",1015 3,"KRN","B ",8989.52, 8989.52)
	622
	623	"BLD",1015 3,"KRN","B ",8994,899 4)
	624
	625	"BLD",1015 3,"QDEF")
	626	^^^^^^^^YE S
	627	"BLD",1015 3,"QUES",0 )
	628	^9.62^^
	629	"BLD",1015 3,"REQB",0 )
	630	^9.611^8^5
	631	"BLD",1015 3,"REQB",3 ,0)
	632	PRCA4.52 37^1
	633	"BLD",1015 3,"REQB",4 ,0)
	634	PRCA4.52 33^1
	635	"BLD",1015 3,"REQB",6 ,0)
	636	PRCA4.53 09^1
	637	"BLD",1015 3,"REQB",7 ,0)
	638	PRCA4.52 76^1
	639	"BLD",1015 3,"REQB",8 ,0)
	640	PRCA4.53 01^1
	641	"BLD",1015 3,"REQB"," B","PRCA4 .5233",4)
	642
	643	"BLD",1015 3,"REQB"," B","PRCA4 .5237",3)
	644
	645	"BLD",1015 3,"REQB"," B","PRCA4 .5276",7)
	646
	647	"BLD",1015 3,"REQB"," B","PRCA4 .5301",8)
	648
	649	"BLD",1015 3,"REQB"," B","PRCA4 .5309",6)
	650
	651	"FIA",433)
	652	AR TRANSAC TION
	653	"FIA",433, 0)
	654	^PRCA(433,
	655	"FIA",433, 0,0)
	656	433NI
	657	"FIA",433, 0,1)
	658	y^n^p^^^^n ^^n
	659	"FIA",433, 0,10)
	660
	661	"FIA",433, 0,11)
	662
	663	"FIA",433, 0,"RLRO")
	664
	665	"FIA",433, 0,"VR")
	666	4.5^PRCA
	667	"FIA",433, 433)
	668	1
	669	"FIA",433, 433,94)
	670
	671	"FIA",433, 433,95)
	672
	673	"FIA",433, 433,96)
	674
	675	"FIA",433, 433,97)
	676
	677	"INIT")
	678	EN^PRCA307 P
	679	"IX",433,4 33,"TACD", 0)
	680	433^TACD^T he date th at this tr ansaction was correc ted by the Auto-Corr ection Pr
	681	ogram.^R^^ F^IR^I^433 ^^^^^LS
	682	"IX",433,4 33,"TACD", .1,0)
	683	^^2^2^3160 920^
	684	"IX",433,4 33,"TACD", .1,1,0)
	685	The is the date that the Patie nt Stateme nt Auto-Co rrection P rogram
	686	"IX",433,4 33,"TACD", .1,2,0)
	687	corrected the statem ent discre pancy for this trans action.
	688	"IX",433,4 33,"TACD", 1)
	689	S ^PRCA(43 3,"TACD",$ E(X,1,7),D A)=""
	690	"IX",433,4 33,"TACD", 2)
	691	K ^PRCA(43 3,"TACD",$ E(X,1,7),D A)
	692	"IX",433,4 33,"TACD", 2.5)
	693	K ^PRCA(43 3,"TACD")
	694	"IX",433,4 33,"TACD", 11.1,0)
	695	^.114IA^1^ 1
	696	"IX",433,4 33,"TACD", 11.1,1,0)
	697	1^F^433^94 ^7^1^F
	698	"IX",433,4 33,"TACD", "NOREINDEX ")
	699	1
	700	"KRN",.402 ,830,-1)
	701	0^1
	702	"KRN",.402 ,830,0)
	703	PRCA RE-ES TABLISH WR ITE-OFF^31 60222.1339 ^^433^^^31 70112
	704	"KRN",.402 ,830,"DR", 1,433)
	705	.03////^S X=PRCABN;6 ////^S X=$ S($D(PRCA( "SEG")):PR CA("SEG"), 1:"");12// //^S X=PR
	706	CATYPE;11/ ///^S X=DT ;15////^S X=$S($D(PR CATAMT):PR CATAMT,1:0 );81////^S X=$S($D(
	707	PRCAPB):+P RCAPB,1:0) ;82////^S X=$S($D(PR CAPB):$P(P RCAPB,"^", 2),1:0);
	708	"KRN",.402 ,830,"DR", 1,433,1)
	709	83////^S X =$S($D(PRC APB):$P(PR CAPB,"^",3 ),1:0);84/ ///^S X=$S ($D(PRCAPB ):$P(PRCA
	710	PB,"^",4), 1:0);85/// /^S X=$S($ D(PRCAPB): $P(PRCAPB, "^",5),1:0 );42////^S X=DUZ;41
	711	;
	712	"KRN",3.8, 327,-1)
	713	0^1
	714	"KRN",3.8, 327,0)
	715	PRCACPS^PU ^^^^^
	716	"KRN",3.8, 327,2,0)
	717	^3.801^2^2 ^3160406^^ ^
	718	"KRN",3.8, 327,2,1,0)
	719	This mail group will receive a notificat ion when t he Consoli dated
	720	"KRN",3.8, 327,2,2,0)
	721	Patient St atement Au to-Correct ion progra m has comp leted.
	722	"KRN",3.8, 327,3)
	723
	724	"KRN",19,3 126,-1)
	725	2^3
	726	"KRN",19,3 126,0)
	727	PRCA ACCOU NT MANAGEM ENT^Accoun t Manageme nt^^M^1^^^ ^^^^53
	728	"KRN",19,3 126,10,0)
	729	^19.01PI^1 7^17
	730	"KRN",19,3 126,10,16, 0)
	731	11664^^4
	732	"KRN",19,3 126,10,16, "^")
	733	PRCA AUTOC RCT PGM
	734	"KRN",19,3 126,10,17, 0)
	735	11665^^3
	736	"KRN",19,3 126,10,17, "^")
	737	PRCA AUTOC RCT RPT
	738	"KRN",19,3 126,"U")
	739	ACCOUNT MA NAGEMENT
	740	"KRN",19,1 1664,-1)
	741	0^1
	742	"KRN",19,1 1664,0)
	743	PRCA AUTOC RCT PGM^Pa tient Stat ement Auto -Correctio n Program^ ^R^^PRCA A UTOCRCT P
	744	GM^^^^^^
	745	"KRN",19,1 1664,1,0)
	746	^19.06^2^2 ^3160304^^
	747	"KRN",19,1 1664,1,1,0 )
	748	This optio n runs the Auto-Corr ection pro gram for P atient Sta tement
	749	"KRN",19,1 1664,1,2,0 )
	750	discrepanc ies.
	751	"KRN",19,1 1664,25)
	752	BEGIN^PRCA CPS
	753	"KRN",19,1 1664,"U")
	754	PATIENT ST ATEMENT AU TO-CORRECT
	755	"KRN",19,1 1665,-1)
	756	0^2
	757	"KRN",19,1 1665,0)
	758	PRCA AUTOC RCT RPT^Au to-Correct Patient D iscrepancy Report^^R ^^^^^^^^
	759	"KRN",19,1 1665,1,0)
	760	^19.06^3^3 ^3161012^^ ^^
	761	"KRN",19,1 1665,1,1,0 )
	762	This optio n runs the Auto-Corr ection Pat ient Discr epancy Rep ort
	763	"KRN",19,1 1665,1,2,0 )
	764	for correc tions made by the Pa tient Stat ement Auto -Correctio n
	765	"KRN",19,1 1665,1,3,0 )
	766	Program.
	767	"KRN",19,1 1665,25)
	768	PSACRT^PRC AACR
	769	"KRN",19,1 1665,"U")
	770	AUTO-CORRE CT PATIENT DISCREPAN
	771	"KRN",19,1 1666,-1)
	772	0^4
	773	"KRN",19,1 1666,0)
	774	PRCA AUTOC RCT PGM QU EUED^Patie nt Stateme nt Auto-Co rrection P rogram Que ued^^R^^P
	775	RCA AUTOCR CT PGM^^^^ ^^
	776	"KRN",19,1 1666,1,0)
	777	^^2^2^3161 017^
	778	"KRN",19,1 1666,1,1,0 )
	779	This optio n supports the entry point for the Queue ing of the
	780	"KRN",19,1 1666,1,2,0 )
	781	Auto-Corre ction prog ram for Pa tient Stat ement disc repancies.
	782	"KRN",19,1 1666,25)
	783	START^PRCA CPS
	784	"KRN",19,1 1666,"U")
	785	PATIENT ST ATEMENT AU TO-CORRECT
	786	"KRN",19.1 ,602,-1)
	787	0^1
	788	"KRN",19.1 ,602,0)
	789	PRCA AUTOC RCT PGM
	790	"KRN",19.1 ,602,1,0)
	791	^19.11^3^3 ^3160418^^ ^
	792	"KRN",19.1 ,602,1,1,0 )
	793	This is a key for th e AR optio n 'PRCA AU TOCRCT PGM '.
	794	"KRN",19.1 ,602,1,2,0 )
	795	The 'PRCA AUTOCRCT P GM' option runs the Consolidat ed
	796	"KRN",19.1 ,602,1,3,0 )
	797	Patient St atement Au to-Correct ion progra m.
	798	"MBREQ")
	799	0
	800	"ORD",3,19 .1)
	801	19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1
	802	"ORD",3,19 .1,0)
	803	SECURITY K EY
	804	"ORD",7,.4 02)
	805	.402;7;;;E DEOUT^DIFR OMSO(.402, DA,"",XPDA );FPRE^DIF ROMSI(.402 ,"",XPDA); EPRE^DIFR
	806	OMSI(.402, DA,$E("N", $G(XPDNEW) ),XPDA,"", OLDA);;EPO ST^DIFROMS I(.402,DA, "",XPDA);
	807	DEL^DIFROM SK(.402,"" ,%)
	808	"ORD",7,.4 02,0)
	809	INPUT TEMP LATE
	810	"ORD",11,3 .8)
	811	3.8;11;;;M AILG^XPDTA 1;MAILGF1^ XPDIA1;MAI LGE1^XPDIA 1;MAILGF2^ XPDIA1;;MA ILGDEL^XP
	812	DIA1(%)
	813	"ORD",11,3 .8,0)
	814	MAIL GROUP
	815	"ORD",18,1 9)
	816	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	817	"ORD",18,1 9,0)
	818	OPTION
	819	"PKG",53,- 1)
	820	1^1
	821	"PKG",53,0 )
	822	ACCOUNTS R ECEIVABLE^ PRCA^FMS
	823	"PKG",53,2 0,0)
	824	^9.402P^1^ 1
	825	"PKG",53,2 0,1,0)
	826	2^^PRCAMRG
	827	"PKG",53,2 0,1,1)
	828
	829	"PKG",53,2 0,"B",2,1)
	830
	831	"PKG",53,2 2,0)
	832	^9.49I^1^1
	833	"PKG",53,2 2,1,0)
	834	4.5^305111 9^2960627
	835	"PKG",53,2 2,1,"PAH", 1,0)
	836	307^317012 3^87
	837	"PKG",53,2 2,1,"PAH", 1,1,0)
	838	^^1^1^3170 123
	839	"PKG",53,2 2,1,"PAH", 1,1,1,0)
	840	Consolidat ed Patient Statement
	841	"QUES","XP F1",0)
	842	Y
	843	"QUES","XP F1","??")
	844	^D REP^XPD H
	845	"QUES","XP F1","A")
	846	Shall I wr ite over y our \|FLAG\| File
	847	"QUES","XP F1","B")
	848	YES
	849	"QUES","XP F1","M")
	850	D XPF1^XPD IQ
	851	"QUES","XP F2",0)
	852	Y
	853	"QUES","XP F2","??")
	854	^D DTA^XPD H
	855	"QUES","XP F2","A")
	856	Want my da ta \|FLAG\| yours
	857	"QUES","XP F2","B")
	858	YES
	859	"QUES","XP F2","M")
	860	D XPF2^XPD IQ
	861	"QUES","XP I1",0)
	862	YO
	863	"QUES","XP I1","??")
	864	^D INHIBIT ^XPDH
	865	"QUES","XP I1","A")
	866	Want KIDS to INHIBIT LOGONs du ring the i nstall
	867	"QUES","XP I1","B")
	868	NO
	869	"QUES","XP I1","M")
	870	D XPI1^XPD IQ
	871	"QUES","XP M1",0)
	872	PO^VA(200, :EM
	873	"QUES","XP M1","??")
	874	^D MG^XPDH
	875	"QUES","XP M1","A")
	876	Enter the Coordinato r for Mail Group '\|F LAG\|'
	877	"QUES","XP M1","B")
	878
	879	"QUES","XP M1","M")
	880	D XPM1^XPD IQ
	881	"QUES","XP O1",0)
	882	Y
	883	"QUES","XP O1","??")
	884	^D MENU^XP DH
	885	"QUES","XP O1","A")
	886	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	887	"QUES","XP O1","B")
	888	YES
	889	"QUES","XP O1","M")
	890	D XPO1^XPD IQ
	891	"QUES","XP Z1",0)
	892	Y
	893	"QUES","XP Z1","??")
	894	^D OPT^XPD H
	895	"QUES","XP Z1","A")
	896	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	897	"QUES","XP Z1","B")
	898	NO
	899	"QUES","XP Z1","M")
	900	D XPZ1^XPD IQ
	901	"QUES","XP Z2",0)
	902	Y
	903	"QUES","XP Z2","??")
	904	^D RTN^XPD H
	905	"QUES","XP Z2","A")
	906	Want to MO VE routine s to other CPUs
	907	"QUES","XP Z2","B")
	908	NO
	909	"QUES","XP Z2","M")
	910	D XPZ2^XPD IQ
	911	"RTN")
	912	9
	913	"RTN","PRC A307P")
	914	0^2^B63586 34^n/a
	915	"RTN","PRC A307P",1,0 )
	916	PRCA307P ; ALB/BDB - PATCH PRCA 4.5307 P OST-INSTAL L ROUTINE ; 11/2/15 4:15pm
	917	"RTN","PRC A307P",2,0 )
	918	;;4.5;Acc ounts Rece ivable;3 07;Mar 2 0, 1995;Bu ild 79
	919	"RTN","PRC A307P",3,0 )
	920	;;Per VA Directive 6402, this routine s hould not be modifie d.
	921	"RTN","PRC A307P",4,0 )
	922	; This ro utine will update a specific l ist of Sta tion ID's
	923	"RTN","PRC A307P",5,0 )
	924	; and que ues the Pa tient Stat ement Auto -Correctio n Program
	925	"RTN","PRC A307P",6,0 )
	926	;
	927	"RTN","PRC A307P",7,0 )
	928	Q
	929	"RTN","PRC A307P",8,0 )
	930	EN ;Entry point for PRCA4.53 07 post-in stall
	931	"RTN","PRC A307P",9,0 )
	932	N SDAY,SI TE,T
	933	"RTN","PRC A307P",10, 0)
	934	S SITE=$$ SITE^RCMSI TE
	935	"RTN","PRC A307P",11, 0)
	936	I SITE=0 D
	937	"RTN","PRC A307P",12, 0)
	938	.D MES^XP DUTL(" ")
	939	"RTN","PRC A307P",13, 0)
	940	.D BMES^X PDUTL(">>> WARNING! STATION ID NOT FOUND !")
	941	"RTN","PRC A307P",14, 0)
	942	.D MES^XP DUTL(">>> THE PATIEN T STATEMEN T TRANSMIS SION DATE WILL NOT B E UPDATED
	943	")
	944	"RTN","PRC A307P",15, 0)
	945	.D MES^XP DUTL(" ")
	946	"RTN","PRC A307P",16, 0)
	947	I SITE'=0 ,$T(@SITE) D
	948	"RTN","PRC A307P",17, 0)
	949	.D MES^XP DUTL(" ")
	950	"RTN","PRC A307P",18, 0)
	951	.D BMES^X PDUTL(">>> STATION I D "_SITE_" MATCH FOU ND!")
	952	"RTN","PRC A307P",19, 0)
	953	.D MES^XP DUTL(">>> THE PATIEN T STATEMEN T TRANSMIS SION DATE WILL BE UP DATED")
	954	"RTN","PRC A307P",20, 0)
	955	.D MES^XP DUTL(" ")
	956	"RTN","PRC A307P",21, 0)
	957	.;set pat ient state ment day t o site sta tement day
	958	"RTN","PRC A307P",22, 0)
	959	.S T=$T(@ SITE),SDAY =+$P(T,";; ",2)
	960	"RTN","PRC A307P",23, 0)
	961	.S $P(^RC (342,1,0), "^",11)=SD AY
	962	"RTN","PRC A307P",24, 0)
	963	.S DEB=0 F S DEB=$ O(^RCD(340 ,"AB","DPT (",DEB)) Q :'DEB I $ D(^RCD(340 ,+DEB,0))
	964	D
	965	"RTN","PRC A307P",25, 0)
	966	..S STDT= $P($G(^RCD (340,+DEB, 0)),"^",3) Q:'STDT
	967	"RTN","PRC A307P",26, 0)
	968	..S SSTDT =$P($G(^RC (342,1,0)) ,"^",11)
	969	"RTN","PRC A307P",27, 0)
	970	..Q:(SSTD T=STDT)
	971	"RTN","PRC A307P",28, 0)
	972	..K ^RCD( 340,"AC",S TDT,+DEB)
	973	"RTN","PRC A307P",29, 0)
	974	..S $P(^R CD(340,+DE B,0),"^",3 )=SSTDT
	975	"RTN","PRC A307P",30, 0)
	976	..S ^RCD( 340,"AC",S STDT,DEB)= ""
	977	"RTN","PRC A307P",31, 0)
	978	K SDAY,SI TE,DEB,STD T,SSTDT,T
	979	"RTN","PRC A307P",32, 0)
	980	;
	981	"RTN","PRC A307P",33, 0)
	982	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	983	"RTN","PRC A307P",34, 0)
	984	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	985	"RTN","PRC A307P",35, 0)
	986	S ZTRTN=" START^PRCA CPS",ZTDTH =$H,ZTIO=" "
	987	"RTN","PRC A307P",36, 0)
	988	D ^%ZTLOA D
	989	"RTN","PRC A307P",37, 0)
	990	I $G(ZTSK ) D Q
	991	"RTN","PRC A307P",38, 0)
	992	.D BMES^X PDUTL(">>> POST-INSTA LL CONSOLI DATED PATI ENT STATEM ENT AUTO-C ORRECTION
	993	")
	994	"RTN","PRC A307P",39, 0)
	995	.D MES^XP DUTL(">>>P ROGRAM HAS BEEN QUEU ED IN TASK "_ZTSK)
	996	"RTN","PRC A307P",40, 0)
	997	I '$G(ZTS K) D Q
	998	"RTN","PRC A307P",41, 0)
	999	.D BMES^X PDUTL(">>> ERROR: POS T-INSTALL CONSOLIDAT ED PATIENT STATEMENT AUTO-COR
	1000	RECTION")
	1001	"RTN","PRC A307P",42, 0)
	1002	.D MES^XP DUTL(">>>P ROGRAM COU LD NOT BE QUEUED")
	1003	"RTN","PRC A307P",43, 0)
	1004	;
	1005	"RTN","PRC A307P",44, 0)
	1006	;Stations that will have mont hly statem ent build date chang ed
	1007	"RTN","PRC A307P",45, 0)
	1008	438 ;;21^S IOUX FALLS ,SD
	1009	"RTN","PRC A307P",46, 0)
	1010	501 ;;21^A LBUQUERQUE ,NM
	1011	"RTN","PRC A307P",47, 0)
	1012	504 ;;21^A MARILLO,TX
	1013	"RTN","PRC A307P",48, 0)
	1014	542 ;;21^C OATESVILLE ,PA
	1015	"RTN","PRC A307P",49, 0)
	1016	562 ;;21^E RIE,PA
	1017	"RTN","PRC A307P",50, 0)
	1018	568 ;;21^F ORT MEADE, SD
	1019	"RTN","PRC A307P",51, 0)
	1020	649 ;;21^P RESCOTT,AZ
	1021	"RTN","PRC A307P",52, 0)
	1022	656 ;;21^S T. CLOUD,M N
	1023	"RTN","PRC A307P",53, 0)
	1024	688 ;;21^W ASHINGTON, DC
	1025	"RTN","PRC A307P",54, 0)
	1026	756 ;;21^E L PASO,TX
	1027	"RTN","PRC A307P",55, 0)
	1028	565 ;;22^F AYETTEVILL E,NC
	1029	"RTN","PRC A307P",56, 0)
	1030	621 ;;22^M OUNTAIN HO ME,TN
	1031	"RTN","PRC A307P",57, 0)
	1032	658 ;;22^S ALEM,VA
	1033	"RTN","PRC A307P",58, 0)
	1034	664 ;;22^S AN DIEGO,C A
	1035	"RTN","PRC A307P",59, 0)
	1036	671 ;;22^S AN ANTONIO ,TX
	1037	"RTN","PRC A307P",60, 0)
	1038	689 ;;22^W EST HAVEN, CT
	1039	"RTN","PRC A307P",61, 0)
	1040	740 ;;22^T EXAS VALLE Y COASTAL, TX
	1041	"RTN","PRC AACR")
	1042	0^7^B97009 305^n/a
	1043	"RTN","PRC AACR",1,0)
	1044	PRCAACR ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION REPOR T ;09/21/1 5 3:34 PM
	1045	"RTN","PRC AACR",2,0)
	1046	;;4.5;Acc ounts Rece ivable;3 07;Mar 2 0, 1995;Bu ild 79
	1047	"RTN","PRC AACR",3,0)
	1048	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1049	"RTN","PRC AACR",4,0)
	1050	;
	1051	"RTN","PRC AACR",5,0)
	1052	Q
	1053	"RTN","PRC AACR",6,0)
	1054	;
	1055	"RTN","PRC AACR",7,0)
	1056	PSACRT ; r eport, pri nts sorted individua l transact ions that have been auto-corr
	1057	ected
	1058	"RTN","PRC AACR",8,0)
	1059	N DIC,PAG E,BY,DHD,F ILENUM,FLD S,FR,L,TO, PRCABDT,PR CAEDT,PRCA SORT
	1060	"RTN","PRC AACR",9,0)
	1061	W !
	1062	"RTN","PRC AACR",10,0 )
	1063	PSDATE ;
	1064	"RTN","PRC AACR",11,0 )
	1065	; Determi ne if Auto Correct p rocess is currently running
	1066	"RTN","PRC AACR",12,0 )
	1067	N PRCASTR T,QUIT,X,X 1,X2,Y
	1068	"RTN","PRC AACR",13,0 )
	1069	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= ""
	1070	"RTN","PRC AACR",14,0 )
	1071	; QUIT if Auto Corr ect proces s is curre ntly runni ng
	1072	"RTN","PRC AACR",15,0 )
	1073	I PRCASTR T'="" D Q :QUIT
	1074	"RTN","PRC AACR",16,0 )
	1075	.S Y=$P(P RCASTRT,U, 2)
	1076	"RTN","PRC AACR",17,0 )
	1077	.D DD^%DT
	1078	"RTN","PRC AACR",18,0 )
	1079	.S PRCAST RT=Y
	1080	"RTN","PRC AACR",19,0 )
	1081	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram is cur rently run ning."
	1082	"RTN","PRC AACR",20,0 )
	1083	.W !,"It was starte d at ",PRC ASTRT," an d can take up to 1 h our to com plete."
	1084	"RTN","PRC AACR",21,0 )
	1085	.W !!,"If you choos e to conti nue with t his report , it may n ot reflect all of t
	1086	he"
	1087	"RTN","PRC AACR",22,0 )
	1088	.W !,"cha nges from this lates t run of t he Patient Statement Auto-Corr ection Pr
	1089	ogram."
	1090	"RTN","PRC AACR",23,0 )
	1091	.W !
	1092	"RTN","PRC AACR",24,0 )
	1093	.S DIR(0) ="Y",DIR(" A")="Do yo u want to continue", DIR("B")=" NO"
	1094	"RTN","PRC AACR",25,0 )
	1095	.D ^DIR
	1096	"RTN","PRC AACR",26,0 )
	1097	.W !
	1098	"RTN","PRC AACR",27,0 )
	1099	.; Quit i f ^, ^^, T imeout or No
	1100	"RTN","PRC AACR",28,0 )
	1101	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	1102	"RTN","PRC AACR",29,0 )
	1103	.; Send M ailMan mes sage to PR CACPS mail group if Yes
	1104	"RTN","PRC AACR",30,0 )
	1105	.I Y=1 D PRCAMAIL^P RCACPS(PRC ASTRT)
	1106	"RTN","PRC AACR",31,0 )
	1107	.K DTOUT, DUOUT,DIRO UT
	1108	"RTN","PRC AACR",32,0 )
	1109	;
	1110	"RTN","PRC AACR",33,0 )
	1111	N DIROUT, DIS,DTOUT, DUOUT
	1112	"RTN","PRC AACR",34,0 )
	1113	S DIR("A" )="Date Ra nge: FROM: ",DIR("B" )="T-7"
	1114	"RTN","PRC AACR",35,0 )
	1115	S DIR("?" )="The def ault date is T-7. F uture date s may not be entered ."
	1116	"RTN","PRC AACR",36,0 )
	1117	S DIR(0)= "DO" D ^DI R
	1118	"RTN","PRC AACR",37,0 )
	1119	S:Y'="" P RCABDT=Y
	1120	"RTN","PRC AACR",38,0 )
	1121	I $D(DIRU T)&'Y K DI RUT Q
	1122	"RTN","PRC AACR",39,0 )
	1123	I PRCABDT >DT G PSDA TE
	1124	"RTN","PRC AACR",40,0 )
	1125	W "(",Y(0 ),")"
	1126	"RTN","PRC AACR",41,0 )
	1127	K DIR,X,Y
	1128	"RTN","PRC AACR",42,0 )
	1129	S DIR(0)= "DO"
	1130	"RTN","PRC AACR",43,0 )
	1131	S DIR("A" )="Date Ra nge: TO: ",DIR("B" )="T"
	1132	"RTN","PRC AACR",44,0 )
	1133	S DIR("?" )="The def ault date is T, but any date m ay be ente red."
	1134	"RTN","PRC AACR",45,0 )
	1135	D ^DIR S: Y="" Y=DT
	1136	"RTN","PRC AACR",46,0 )
	1137	I $D(DIRU T)&'Y K DI RUT Q
	1138	"RTN","PRC AACR",47,0 )
	1139	W "(",Y(0 ),")"
	1140	"RTN","PRC AACR",48,0 )
	1141	S PRCAEDT =Y
	1142	"RTN","PRC AACR",49,0 )
	1143	I PRCABDT >PRCAEDT G PSDATE
	1144	"RTN","PRC AACR",50,0 )
	1145	K DIR
	1146	"RTN","PRC AACR",51,0 )
	1147	S DIR(0)= "S^1:Bill Number;2:D ebtor Name ;3:Auto-Co rrect Date ;4:Transac tion Numb
	1148	er",DIR("A ")="Sort b y"
	1149	"RTN","PRC AACR",52,0 )
	1150	D ^DIR K DIR
	1151	"RTN","PRC AACR",53,0 )
	1152	S PRCASOR T=Y
	1153	"RTN","PRC AACR",54,0 )
	1154	Q:$D(DTOU T)!($D(DUO UT))!($D(D IROUT))
	1155	"RTN","PRC AACR",55,0 )
	1156	;
	1157	"RTN","PRC AACR",56,0 )
	1158	; Prompt for device
	1159	"RTN","PRC AACR",57,0 )
	1160	W !
	1161	"RTN","PRC AACR",58,0 )
	1162	N ZTRTN,Z TDESC,ZTSA VE
	1163	"RTN","PRC AACR",59,0 )
	1164	S %ZIS="Q "
	1165	"RTN","PRC AACR",60,0 )
	1166	D ^%ZIS Q :POP
	1167	"RTN","PRC AACR",61,0 )
	1168	I $D(IO(" Q")) D Q
	1169	"RTN","PRC AACR",62,0 )
	1170	.I $G(IOS T)["P-MES" S ZTRTN=" PRT^PRCAAC R1"
	1171	"RTN","PRC AACR",63,0 )
	1172	.I $G(IOS T)'["P-MES " S ZTRTN= "PRT^PRCAA CR"
	1173	"RTN","PRC AACR",64,0 )
	1174	.S ZTSAVE ("PRCABDT" )="",ZTSAV E("PRCAEDT ")="",ZTSA VE("PRCASO RT")=""
	1175	"RTN","PRC AACR",65,0 )
	1176	.D ^%ZTLO AD
	1177	"RTN","PRC AACR",66,0 )
	1178	.D ^%ZISC
	1179	"RTN","PRC AACR",67,0 )
	1180	.K IO("Q" ),POP
	1181	"RTN","PRC AACR",68,0 )
	1182	;
	1183	"RTN","PRC AACR",69,0 )
	1184	;Print Re port if no t QUEUED
	1185	"RTN","PRC AACR",70,0 )
	1186	PRT ;
	1187	"RTN","PRC AACR",71,0 )
	1188	; If not queued and output se nt to P-ME S
	1189	"RTN","PRC AACR",72,0 )
	1190	I $G(IOST )["P-MES" D PRT^PRCA ACR1 Q
	1191	"RTN","PRC AACR",73,0 )
	1192	;If not q ueued and output not sent to P -MES
	1193	"RTN","PRC AACR",74,0 )
	1194	U IO
	1195	"RTN","PRC AACR",75,0 )
	1196	K ^TMP("P RCAACR",$J )
	1197	"RTN","PRC AACR",76,0 )
	1198	S PAGE=0
	1199	"RTN","PRC AACR",77,0 )
	1200	S DASH="" ,$P(DASH," -",79)=""
	1201	"RTN","PRC AACR",78,0 )
	1202	S DIS(0)= "I $D(^PRC A(433,""TA CD"",PRCAT SRT,D0))", L=0
	1203	"RTN","PRC AACR",79,0 )
	1204	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AACTF,PRC
	1205	ATNTF
	1206	"RTN","PRC AACR",80,0 )
	1207	S PRCATSR T=PRCABDT- .00001
	1208	"RTN","PRC AACR",81,0 )
	1209	; Loop th rough the specified date range
	1210	"RTN","PRC AACR",82,0 )
	1211	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	1212	D
	1213	"RTN","PRC AACR",83,0 )
	1214	.S PRCATN =""
	1215	"RTN","PRC AACR",84,0 )
	1216	.; Loop t hrough the transacti ons for th e current date
	1217	"RTN","PRC AACR",85,0 )
	1218	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	1219	"RTN","PRC AACR",86,0 )
	1220	..; Load associated data fiel ds for rep ort
	1221	"RTN","PRC AACR",87,0 )
	1222	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	1223	"RTN","PRC AACR",88,0 )
	1224	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	1225	"RTN","PRC AACR",89,0 )
	1226	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	1227	"RTN","PRC AACR",90,0 )
	1228	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	1229	"RTN","PRC AACR",91,0 )
	1230	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	1231	"RTN","PRC AACR",92,0 )
	1232	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	1233	"RTN","PRC AACR",93,0 )
	1234	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	1235	"RTN","PRC AACR",94,0 )
	1236	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	1237	"RTN","PRC AACR",95,0 )
	1238	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	1239	"RTN","PRC AACR",96,0 )
	1240	..S PRCAA CR=$E(PRCA ACR,1,14)
	1241	"RTN","PRC AACR",97,0 )
	1242	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	1243	"RTN","PRC AACR",98,0 )
	1244	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	1245	"RTN","PRC AACR",99,0 )
	1246	..I PRCAA CTF="YES" S PRCATNTF =""
	1247	"RTN","PRC AACR",100, 0)
	1248	..;
	1249	"RTN","PRC AACR",101, 0)
	1250	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1251	"RTN","PRC AACR",102, 0)
	1252	..I PRCAS ORT=1 D Q
	1253	"RTN","PRC AACR",103, 0)
	1254	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	1255	ATNTF_U_PR CAACD_U_PR CAACR
	1256	"RTN","PRC AACR",104, 0)
	1257	..;
	1258	"RTN","PRC AACR",105, 0)
	1259	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	1260	"RTN","PRC AACR",106, 0)
	1261	..I PRCAS ORT=2 D Q
	1262	"RTN","PRC AACR",107, 0)
	1263	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	1264	ATNTF_U_PR CAACD_U_PR CAACR
	1265	"RTN","PRC AACR",108, 0)
	1266	..;
	1267	"RTN","PRC AACR",109, 0)
	1268	..; Store in ^TMP s orted by A uto-Correc t Date, De btor, Bill Number an d Transac
	1269	tion #
	1270	"RTN","PRC AACR",110, 0)
	1271	..I PRCAS ORT=3 D Q
	1272	"RTN","PRC AACR",111, 0)
	1273	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	1274	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	1275	"RTN","PRC AACR",112, 0)
	1276	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1277	"RTN","PRC AACR",113, 0)
	1278	..;
	1279	"RTN","PRC AACR",114, 0)
	1280	..; Store in ^TMP s orted by T ransaction , Debtor a nd #Bill N umber
	1281	"RTN","PRC AACR",115, 0)
	1282	..I PRCAS ORT=4 D Q
	1283	"RTN","PRC AACR",116, 0)
	1284	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	1285	CASSN_U_PR CAACD_U_PR CAACR
	1286	"RTN","PRC AACR",117, 0)
	1287	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1288	"RTN","PRC AACR",118, 0)
	1289	;
	1290	"RTN","PRC AACR",119, 0)
	1291	; Display Auto-Corr ect data s orted by B ill Number
	1292	"RTN","PRC AACR",120, 0)
	1293	N QUIT ; QUIT befor e end of r eport
	1294	"RTN","PRC AACR",121, 0)
	1295	S QUIT=""
	1296	"RTN","PRC AACR",122, 0)
	1297	I PRCASOR T=1 D
	1298	"RTN","PRC AACR",123, 0)
	1299	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	1300	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1301	"RTN","PRC AACR",124, 0)
	1302	.; Displa y Bill Num ber header
	1303	"RTN","PRC AACR",125, 0)
	1304	.D PSACRT P1
	1305	"RTN","PRC AACR",126, 0)
	1306	.S PRCABN =""
	1307	"RTN","PRC AACR",127, 0)
	1308	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D Q: QUIT
	1309	"RTN","PRC AACR",128, 0)
	1310	..S PRCAD TR=""
	1311	"RTN","PRC AACR",129, 0)
	1312	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1313	"RTN","PRC AACR",130, 0)
	1314	...S PRCA TN=""
	1315	"RTN","PRC AACR",131, 0)
	1316	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D Q:QU
	1317	IT
	1318	"RTN","PRC AACR",132, 0)
	1319	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	1320	"RTN","PRC AACR",133, 0)
	1321	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1322	"RTN","PRC AACR",134, 0)
	1323	....W !,$ J($P(PRCAD ATA,U,1),1 1),?13,$E( $P(PRCADAT A,U,2),1,1 8),?33,$E( $P(PRCADA
	1324	TA,U,3),6, 9),?39,$J( $P(PRCADAT A,U,4),9), ?50,$P(PRC ADATA,U,5) ,?64,$P(PR CADATA,U,
	1325	6)
	1326	"RTN","PRC AACR",135, 0)
	1327	....I $Y> (IOSL-3) D
	1328	"RTN","PRC AACR",136, 0)
	1329	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1330	"RTN","PRC AACR",137, 0)
	1331	......D P RTC
	1332	"RTN","PRC AACR",138, 0)
	1333	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1334	"RTN","PRC AACR",139, 0)
	1335	.....D PS ACRTP1
	1336	"RTN","PRC AACR",140, 0)
	1337	;
	1338	"RTN","PRC AACR",141, 0)
	1339	; Display Auto-Corr ect data s orted Debt or
	1340	"RTN","PRC AACR",142, 0)
	1341	I PRCASOR T=2 D
	1342	"RTN","PRC AACR",143, 0)
	1343	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	1344	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1345	"RTN","PRC AACR",144, 0)
	1346	.; Displa y Debtor h eader
	1347	"RTN","PRC AACR",145, 0)
	1348	.D PSACRT P2
	1349	"RTN","PRC AACR",146, 0)
	1350	.S PRCADT R=""
	1351	"RTN","PRC AACR",147, 0)
	1352	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D Q:QUIT
	1353	"RTN","PRC AACR",148, 0)
	1354	..S PRCAB N=""
	1355	"RTN","PRC AACR",149, 0)
	1356	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D Q:Q UIT
	1357	"RTN","PRC AACR",150, 0)
	1358	...S PRCA TN=""
	1359	"RTN","PRC AACR",151, 0)
	1360	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D Q:QU
	1361	IT
	1362	"RTN","PRC AACR",152, 0)
	1363	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	1364	"RTN","PRC AACR",153, 0)
	1365	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1366	"RTN","PRC AACR",154, 0)
	1367	....W !,$ E($P(PRCAD ATA,U,1),1 ,18),?20,$ J($P(PRCAD ATA,U,2),1 1),?33,$E( $P(PRCADA
	1368	TA,U,3),6, 9),?39,$J( $P(PRCADAT A,U,4),9), ?50,$P(PRC ADATA,U,5) ,?64,$P(PR CADATA,U,
	1369	6)
	1370	"RTN","PRC AACR",155, 0)
	1371	....I $Y> (IOSL-3) D
	1372	"RTN","PRC AACR",156, 0)
	1373	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1374	"RTN","PRC AACR",157, 0)
	1375	......D P RTC
	1376	"RTN","PRC AACR",158, 0)
	1377	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1378	"RTN","PRC AACR",159, 0)
	1379	.....D PS ACRTP2
	1380	"RTN","PRC AACR",160, 0)
	1381	;
	1382	"RTN","PRC AACR",161, 0)
	1383	; Display Auto-Corr ect data s orted AUTO -C DATE
	1384	"RTN","PRC AACR",162, 0)
	1385	I PRCASOR T=3 D
	1386	"RTN","PRC AACR",163, 0)
	1387	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	1388	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	1389	"RTN","PRC AACR",164, 0)
	1390	.; Displa y AUTO-C D ATE header
	1391	"RTN","PRC AACR",165, 0)
	1392	.D PSACRT P3
	1393	"RTN","PRC AACR",166, 0)
	1394	.S PRCAAC D=""
	1395	"RTN","PRC AACR",167, 0)
	1396	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D Q:QUIT
	1397	"RTN","PRC AACR",168, 0)
	1398	..S PRCAD TR=""
	1399	"RTN","PRC AACR",169, 0)
	1400	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	1401	"RTN","PRC AACR",170, 0)
	1402	...S PRCA BN=""
	1403	"RTN","PRC AACR",171, 0)
	1404	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:Q
	1405	UIT
	1406	"RTN","PRC AACR",172, 0)
	1407	....S PRC ATN=""
	1408	"RTN","PRC AACR",173, 0)
	1409	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	1410	D Q:QUI T
	1411	"RTN","PRC AACR",174, 0)
	1412	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	1413	"RTN","PRC AACR",175, 0)
	1414	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	1415	"RTN","PRC AACR",176, 0)
	1416	.....W !, $P(PRCADAT A,U,1),?14 ,$E($P(PRC ADATA,U,2) ,1,18),?34 ,$J($P(PRC ADATA,U,3
	1417	),11),?47, $E($P(PRCA DATA,U,4), 6,9),?53,$ J($P(PRCAD ATA,U,5),9 ),?64,$P(P RCADATA,U
	1418	,6)
	1419	"RTN","PRC AACR",177, 0)
	1420	.....I $Y >(IOSL-3) D
	1421	"RTN","PRC AACR",178, 0)
	1422	......I $ E(IOST,1,2 )="C-" D Q:QUIT
	1423	"RTN","PRC AACR",179, 0)
	1424	.......D PRTC
	1425	"RTN","PRC AACR",180, 0)
	1426	.......I $D(DIRUT)! ($D(DTOUT) ) S QUIT=1
	1427	"RTN","PRC AACR",181, 0)
	1428	......D P SACRTP3
	1429	"RTN","PRC AACR",182, 0)
	1430	;
	1431	"RTN","PRC AACR",183, 0)
	1432	; Display Auto-Corr ect data s orted Tran saction Nu mber
	1433	"RTN","PRC AACR",184, 0)
	1434	I PRCASOR T=4 D
	1435	"RTN","PRC AACR",185, 0)
	1436	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	1437	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	1438	"RTN","PRC AACR",186, 0)
	1439	.; Displa y AUTO-C D ATE header
	1440	"RTN","PRC AACR",187, 0)
	1441	.D PSACRT P4
	1442	"RTN","PRC AACR",188, 0)
	1443	.S PRCATN =""
	1444	"RTN","PRC AACR",189, 0)
	1445	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D Q: QUIT
	1446	"RTN","PRC AACR",190, 0)
	1447	..S PRCAD TR=""
	1448	"RTN","PRC AACR",191, 0)
	1449	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1450	"RTN","PRC AACR",192, 0)
	1451	...S PRCA BN=""
	1452	"RTN","PRC AACR",193, 0)
	1453	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D Q:QU
	1454	IT
	1455	"RTN","PRC AACR",194, 0)
	1456	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	1457	"RTN","PRC AACR",195, 0)
	1458	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1459	"RTN","PRC AACR",196, 0)
	1460	....W !,$ J($P(PRCAD ATA,U,1),9 ),?11,$E($ P(PRCADATA ,U,2),1,18 ),?31,$J($ P(PRCADAT
	1461	A,U,3),11) ,?44,$E($P (PRCADATA, U,4),6,9), ?50,$P(PRC ADATA,U,5) ,?64,$P(PR CADATA,U,
	1462	6)
	1463	"RTN","PRC AACR",197, 0)
	1464	....I $Y> (IOSL-3) D
	1465	"RTN","PRC AACR",198, 0)
	1466	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1467	"RTN","PRC AACR",199, 0)
	1468	......D P RTC
	1469	"RTN","PRC AACR",200, 0)
	1470	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1471	"RTN","PRC AACR",201, 0)
	1472	.....D PS ACRTP4
	1473	"RTN","PRC AACR",202, 0)
	1474	D ^%ZISC
	1475	"RTN","PRC AACR",203, 0)
	1476	I $E(IOST ,1,2)="C-" ,'$D(DUOUT ),('$D(DTO UT)) W ! S DIR(0)="E " D ^DIR
	1477	"RTN","PRC AACR",204, 0)
	1478	K X,Y,DAS H,D0
	1479	"RTN","PRC AACR",205, 0)
	1480	Q
	1481	"RTN","PRC AACR",206, 0)
	1482	;
	1483	"RTN","PRC AACR",207, 0)
	1484	PRTC ; Pre ss Return To Continu e
	1485	"RTN","PRC AACR",208, 0)
	1486	S DIR(0)= "E" D ^DIR
	1487	"RTN","PRC AACR",209, 0)
	1488	Q
	1489	"RTN","PRC AACR",210, 0)
	1490	;
	1491	"RTN","PRC AACR",211, 0)
	1492	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	1493	"RTN","PRC AACR",212, 0)
	1494	W @IOF
	1495	"RTN","PRC AACR",213, 0)
	1496	S PAGE=PA GE+1
	1497	"RTN","PRC AACR",214, 0)
	1498	W "PAGE " _PAGE,?8," BILLS THAT HAVE BEEN AUTO-CORR ECTED (SOR TED BY BIL L #)",?66
	1499	,$$UPPER^V ALM1($$FMT E^XLFDT(DT ))
	1500	"RTN","PRC AACR",215, 0)
	1501	W !,DASH, !
	1502	"RTN","PRC AACR",216, 0)
	1503	W !,"BILL NO.",?13, "DEBTOR",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	1504	UTO-C REAS ON"
	1505	"RTN","PRC AACR",217, 0)
	1506	W !,"---- -------",? 13,"------ ---------- --",?33,"- ---",?39," ---------" ,?50,"---
	1507	---------" ,?64,"---- ---------- "
	1508	"RTN","PRC AACR",218, 0)
	1509	Q
	1510	"RTN","PRC AACR",219, 0)
	1511	;
	1512	"RTN","PRC AACR",220, 0)
	1513	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	1514	"RTN","PRC AACR",221, 0)
	1515	W @IOF
	1516	"RTN","PRC AACR",222, 0)
	1517	S PAGE=PA GE+1
	1518	"RTN","PRC AACR",223, 0)
	1519	W "PAGE " _PAGE,?8," BILLS THAT HAVE BEEN AUTO-CORR ECTED (SOR TED BY DEB TOR)",?66
	1520	,$$UPPER^V ALM1($$FMT E^XLFDT(DT ))
	1521	"RTN","PRC AACR",224, 0)
	1522	W !,DASH, !
	1523	"RTN","PRC AACR",225, 0)
	1524	W !,"DEBT OR",?20,"B ILL NO.",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	1525	UTO-C REAS ON"
	1526	"RTN","PRC AACR",226, 0)
	1527	W !,"---- ---------- ----",?20, "--------- --",?33,"- ---",?39," ---------" ,?50,"---
	1528	---------" ,?64,"---- ---------- "
	1529	"RTN","PRC AACR",227, 0)
	1530	Q
	1531	"RTN","PRC AACR",228, 0)
	1532	;
	1533	"RTN","PRC AACR",229, 0)
	1534	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	1535	"RTN","PRC AACR",230, 0)
	1536	W @IOF
	1537	"RTN","PRC AACR",231, 0)
	1538	S PAGE=PA GE+1
	1539	"RTN","PRC AACR",232, 0)
	1540	W "PAGE " _PAGE,?8," BILLS THAT HAVE BEEN AUTO-CORR ECTED (SOR TED BY AUT O-C DT)",
	1541	?66,$$UPPE R^VALM1($$ FMTE^XLFDT (DT))
	1542	"RTN","PRC AACR",233, 0)
	1543	W !,DASH, !
	1544	"RTN","PRC AACR",234, 0)
	1545	W !,"AUTO -C DATE",? 14,"DEBTOR ",?34,"BIL L NO.",?47 ,"SSN",?53 ,"TRANS NU M",?64,"A
	1546	UTO-C REAS ON"
	1547	"RTN","PRC AACR",235, 0)
	1548	W !,"---- --------", ?14,"----- ---------- ---",?34," ---------- -",?47,"-- --",?53,"
	1549	---------" ,?64,"---- ---------- "
	1550	"RTN","PRC AACR",236, 0)
	1551	Q
	1552	"RTN","PRC AACR",237, 0)
	1553	;
	1554	"RTN","PRC AACR",238, 0)
	1555	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	1556	"RTN","PRC AACR",239, 0)
	1557	W @IOF
	1558	"RTN","PRC AACR",240, 0)
	1559	S PAGE=PA GE+1
	1560	"RTN","PRC AACR",241, 0)
	1561	W "PAGE " _PAGE,?8," BILLS THAT HAVE BEEN AUTO-CORR ECTED (SOR TED BY TRA NS NUM)",
	1562	?66,$$UPPE R^VALM1($$ FMTE^XLFDT (DT))
	1563	"RTN","PRC AACR",242, 0)
	1564	W !,DASH, !
	1565	"RTN","PRC AACR",243, 0)
	1566	W !,"TRAN S NUM",?11 ,"DEBTOR", ?31,"BILL NO.",?44," SSN",?50," AUTO-C DAT E",?64,"A
	1567	UTO-C REAS ON"
	1568	"RTN","PRC AACR",244, 0)
	1569	W !,"---- -----",?11 ,"-------- ---------- ",?31,"--- --------", ?44,"----" ,?50,"---
	1570	---------" ,?64,"---- ---------- "
	1571	"RTN","PRC AACR",245, 0)
	1572	Q
	1573	"RTN","PRC AACR",246, 0)
	1574	;
	1575	"RTN","PRC AACR",247, 0)
	1576	EXIT ;
	1577	"RTN","PRC AACR",248, 0)
	1578	Q
	1579	"RTN","PRC AACR1")
	1580	0^8^B10447 8523^n/a
	1581	"RTN","PRC AACR1",1,0 )
	1582	PRCAACR1 ; ALBANY/BDB -PATIENT S TATEMENTS AUTO-CORRE CTION REPO RT ;09/21/ 15 3:34 P
	1583	M
	1584	"RTN","PRC AACR1",2,0 )
	1585	;;4.5;Acc ounts Rece ivable;3 07;Mar 2 0, 1995;Bu ild 79
	1586	"RTN","PRC AACR1",3,0 )
	1587	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1588	"RTN","PRC AACR1",4,0 )
	1589	;
	1590	"RTN","PRC AACR1",5,0 )
	1591	Q
	1592	"RTN","PRC AACR1",6,0 )
	1593	;Print Re port when Queued to P-MES
	1594	"RTN","PRC AACR1",7,0 )
	1595	PRT ;
	1596	"RTN","PRC AACR1",8,0 )
	1597	U IO
	1598	"RTN","PRC AACR1",9,0 )
	1599	; build a rray of tr ansaction auto-corre cted
	1600	"RTN","PRC AACR1",10, 0)
	1601	K ^TMP("P RCAACR1",$ J)
	1602	"RTN","PRC AACR1",11, 0)
	1603	N DASH,PA GE
	1604	"RTN","PRC AACR1",12, 0)
	1605	S PAGE=0
	1606	"RTN","PRC AACR1",13, 0)
	1607	S DASH="" ,$P(DASH," -",79)=""
	1608	"RTN","PRC AACR1",14, 0)
	1609	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AIEN,PRCA
	1610	ACTF,PRCAT NTF,PRCATE MP
	1611	"RTN","PRC AACR1",15, 0)
	1612	S PRCATSR T=PRCABDT- .00001,PRC AIEN=0
	1613	"RTN","PRC AACR1",16, 0)
	1614	; Loop th rough the specified date range
	1615	"RTN","PRC AACR1",17, 0)
	1616	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	1617	D
	1618	"RTN","PRC AACR1",18, 0)
	1619	.S PRCATN =""
	1620	"RTN","PRC AACR1",19, 0)
	1621	.; Loop t hrough the transacti ons for th e current date
	1622	"RTN","PRC AACR1",20, 0)
	1623	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	1624	"RTN","PRC AACR1",21, 0)
	1625	..; Load associated data fiel ds for rep ort
	1626	"RTN","PRC AACR1",22, 0)
	1627	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	1628	"RTN","PRC AACR1",23, 0)
	1629	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	1630	"RTN","PRC AACR1",24, 0)
	1631	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	1632	"RTN","PRC AACR1",25, 0)
	1633	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	1634	"RTN","PRC AACR1",26, 0)
	1635	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	1636	"RTN","PRC AACR1",27, 0)
	1637	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	1638	"RTN","PRC AACR1",28, 0)
	1639	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	1640	"RTN","PRC AACR1",29, 0)
	1641	..S PRCAS SN=$E(PRCA SSN,6,9)
	1642	"RTN","PRC AACR1",30, 0)
	1643	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	1644	"RTN","PRC AACR1",31, 0)
	1645	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	1646	"RTN","PRC AACR1",32, 0)
	1647	..S PRCAA CR=$E(PRCA ACR,1,14)
	1648	"RTN","PRC AACR1",33, 0)
	1649	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	1650	"RTN","PRC AACR1",34, 0)
	1651	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	1652	"RTN","PRC AACR1",35, 0)
	1653	..I PRCAA CTF="YES" S PRCATNTF =""
	1654	"RTN","PRC AACR1",36, 0)
	1655	..;
	1656	"RTN","PRC AACR1",37, 0)
	1657	..; Stor e in ^TMP sorted by Bill Numbe r, Debtor and Transa ction #
	1658	"RTN","PRC AACR1",38, 0)
	1659	..I PRCAS ORT=1 D Q
	1660	"RTN","PRC AACR1",39, 0)
	1661	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	1662	ATNTF_U_PR CAACD_U_PR CAACR
	1663	"RTN","PRC AACR1",40, 0)
	1664	..;
	1665	"RTN","PRC AACR1",41, 0)
	1666	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	1667	"RTN","PRC AACR1",42, 0)
	1668	..I PRCAS ORT=2 D Q
	1669	"RTN","PRC AACR1",43, 0)
	1670	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	1671	ATNTF_U_PR CAACD_U_PR CAACR
	1672	"RTN","PRC AACR1",44, 0)
	1673	..;
	1674	"RTN","PRC AACR1",45, 0)
	1675	..; Store in ^TMP s orted by A uto-Correc t Date, De btor, Bill Number an d Transac
	1676	tion #
	1677	"RTN","PRC AACR1",46, 0)
	1678	..I PRCAS ORT=3 D Q
	1679	"RTN","PRC AACR1",47, 0)
	1680	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	1681	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	1682	"RTN","PRC AACR1",48, 0)
	1683	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1684	"RTN","PRC AACR1",49, 0)
	1685	..;
	1686	"RTN","PRC AACR1",50, 0)
	1687	..; Store in ^TMP s orted by T ransaction , Debtor a nd #Bill N umber
	1688	"RTN","PRC AACR1",51, 0)
	1689	..I PRCAS ORT=4 D Q
	1690	"RTN","PRC AACR1",52, 0)
	1691	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	1692	CASSN_U_PR CAACD_U_PR CAACR
	1693	"RTN","PRC AACR1",53, 0)
	1694	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1695	"RTN","PRC AACR1",54, 0)
	1696	..Q
	1697	"RTN","PRC AACR1",55, 0)
	1698	; Display Auto-Corr ect data s orted by B ill Number
	1699	"RTN","PRC AACR1",56, 0)
	1700	I PRCASOR T=1 D
	1701	"RTN","PRC AACR1",57, 0)
	1702	.; Print Header
	1703	"RTN","PRC AACR1",58, 0)
	1704	.D PSACRT P1
	1705	"RTN","PRC AACR1",59, 0)
	1706	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	1707	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1708	"RTN","PRC AACR1",60, 0)
	1709	.S PRCABN =""
	1710	"RTN","PRC AACR1",61, 0)
	1711	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D
	1712	"RTN","PRC AACR1",62, 0)
	1713	..S PRCAD TR=""
	1714	"RTN","PRC AACR1",63, 0)
	1715	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D
	1716	"RTN","PRC AACR1",64, 0)
	1717	...S PRCA TN=""
	1718	"RTN","PRC AACR1",65, 0)
	1719	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D
	1720	"RTN","PRC AACR1",66, 0)
	1721	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	1722	"RTN","PRC AACR1",67, 0)
	1723	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1724	"RTN","PRC AACR1",68, 0)
	1725	....S PRC AIEN=PRCAI EN+1
	1726	"RTN","PRC AACR1",69, 0)
	1727	....; Add Bill Numb er
	1728	"RTN","PRC AACR1",70, 0)
	1729	....S PRC ATEMP=$J($ P(PRCADATA ,U,1),11), $E(PRCATEM P,13)=" "
	1730	"RTN","PRC AACR1",71, 0)
	1731	....; Add 18 chars of Debtor' s name
	1732	"RTN","PRC AACR1",72, 0)
	1733	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,33)=" "
	1734	"RTN","PRC AACR1",73, 0)
	1735	....; Add SSN
	1736	"RTN","PRC AACR1",74, 0)
	1737	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	1738	"RTN","PRC AACR1",75, 0)
	1739	....; Add Transacti on Number
	1740	"RTN","PRC AACR1",76, 0)
	1741	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	1742	"RTN","PRC AACR1",77, 0)
	1743	....; Add Auto-Corr ect Date
	1744	"RTN","PRC AACR1",78, 0)
	1745	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	1746	"RTN","PRC AACR1",79, 0)
	1747	....; Add Auto-Corr ect Reason
	1748	"RTN","PRC AACR1",80, 0)
	1749	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	1750	"RTN","PRC AACR1",81, 0)
	1751	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	1752	"RTN","PRC AACR1",82, 0)
	1753	....Q
	1754	"RTN","PRC AACR1",83, 0)
	1755	;
	1756	"RTN","PRC AACR1",84, 0)
	1757	; Store i n ^TMP sor ted by Deb tor, Bill Number and Transacti on #
	1758	"RTN","PRC AACR1",85, 0)
	1759	I PRCASOR T=2 D
	1760	"RTN","PRC AACR1",86, 0)
	1761	.; Print Header
	1762	"RTN","PRC AACR1",87, 0)
	1763	.D PSACRT P2
	1764	"RTN","PRC AACR1",88, 0)
	1765	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	1766	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1767	"RTN","PRC AACR1",89, 0)
	1768	.S PRCADT R=""
	1769	"RTN","PRC AACR1",90, 0)
	1770	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D
	1771	"RTN","PRC AACR1",91, 0)
	1772	..S PRCAB N=""
	1773	"RTN","PRC AACR1",92, 0)
	1774	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D
	1775	"RTN","PRC AACR1",93, 0)
	1776	...S PRCA TN=""
	1777	"RTN","PRC AACR1",94, 0)
	1778	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D
	1779	"RTN","PRC AACR1",95, 0)
	1780	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	1781	"RTN","PRC AACR1",96, 0)
	1782	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1783	"RTN","PRC AACR1",97, 0)
	1784	....S PRC AIEN=PRCAI EN+1
	1785	"RTN","PRC AACR1",98, 0)
	1786	....; Add 18 chars of Debtor' s name
	1787	"RTN","PRC AACR1",99, 0)
	1788	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,18 ),$E(PRCAT EMP,20)=" "
	1789	"RTN","PRC AACR1",100 ,0)
	1790	....; Add Bill Numb er
	1791	"RTN","PRC AACR1",101 ,0)
	1792	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,2),11),$ E(PRCATEMP ,33)=" "
	1793	"RTN","PRC AACR1",102 ,0)
	1794	....; Add SSN
	1795	"RTN","PRC AACR1",103 ,0)
	1796	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	1797	"RTN","PRC AACR1",104 ,0)
	1798	....; Add Transacti on Number
	1799	"RTN","PRC AACR1",105 ,0)
	1800	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	1801	"RTN","PRC AACR1",106 ,0)
	1802	....; Add Auto-Corr ect Date
	1803	"RTN","PRC AACR1",107 ,0)
	1804	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	1805	"RTN","PRC AACR1",108 ,0)
	1806	....; Add Auto-Corr ect Reason
	1807	"RTN","PRC AACR1",109 ,0)
	1808	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	1809	"RTN","PRC AACR1",110 ,0)
	1810	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	1811	"RTN","PRC AACR1",111 ,0)
	1812	....Q
	1813	"RTN","PRC AACR1",112 ,0)
	1814	;
	1815	"RTN","PRC AACR1",113 ,0)
	1816	; Store i n ^TMP sor ted by Aut o-Correct Date, Debt or, Bill N umber and Transacti
	1817	on #
	1818	"RTN","PRC AACR1",114 ,0)
	1819	I PRCASOR T=3 D
	1820	"RTN","PRC AACR1",115 ,0)
	1821	.; Print Header
	1822	"RTN","PRC AACR1",116 ,0)
	1823	.D PSACRT P3
	1824	"RTN","PRC AACR1",117 ,0)
	1825	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	1826	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	1827	"RTN","PRC AACR1",118 ,0)
	1828	.S PRCAAC D=""
	1829	"RTN","PRC AACR1",119 ,0)
	1830	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D
	1831	"RTN","PRC AACR1",120 ,0)
	1832	..S PRCAD TR=""
	1833	"RTN","PRC AACR1",121 ,0)
	1834	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D
	1835	"RTN","PRC AACR1",122 ,0)
	1836	...S PRCA BN=""
	1837	"RTN","PRC AACR1",123 ,0)
	1838	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	1839	"RTN","PRC AACR1",124 ,0)
	1840	....S PRC ATN=""
	1841	"RTN","PRC AACR1",125 ,0)
	1842	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	1843	D
	1844	"RTN","PRC AACR1",126 ,0)
	1845	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	1846	"RTN","PRC AACR1",127 ,0)
	1847	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	1848	"RTN","PRC AACR1",128 ,0)
	1849	.....S PR CAIEN=PRCA IEN+1
	1850	"RTN","PRC AACR1",129 ,0)
	1851	.....; Ad d Auto-Cor rect Date
	1852	"RTN","PRC AACR1",130 ,0)
	1853	.....S PR CATEMP=$P( PRCADATA,U ,1),$E(PRC ATEMP,14)= " "
	1854	"RTN","PRC AACR1",131 ,0)
	1855	.....; Ad d 18 chars of Debtor 's name
	1856	"RTN","PRC AACR1",132 ,0)
	1857	.....S PR CATEMP=PRC ATEMP_$E($ P(PRCADATA ,U,2),1,18 ),$E(PRCAT EMP,34)=" "
	1858	"RTN","PRC AACR1",133 ,0)
	1859	.....; Ad d Bill Num ber
	1860	"RTN","PRC AACR1",134 ,0)
	1861	.....S PR CATEMP=PRC ATEMP_$J($ P(PRCADATA ,U,3),11), $E(PRCATEM P,47)=" "
	1862	"RTN","PRC AACR1",135 ,0)
	1863	.....; Ad d SSN
	1864	"RTN","PRC AACR1",136 ,0)
	1865	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 4),$E(PRCA TEMP,53)=" "
	1866	"RTN","PRC AACR1",137 ,0)
	1867	.....; Ad d Transact ion Number
	1868	"RTN","PRC AACR1",138 ,0)
	1869	.....S PR CATEMP=PRC ATEMP_$J($ P(PRCADATA ,U,5),9),$ E(PRCATEMP ,64)=" "
	1870	"RTN","PRC AACR1",139 ,0)
	1871	.....; Ad d Auto-Cor rect Reaso n
	1872	"RTN","PRC AACR1",140 ,0)
	1873	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 6)
	1874	"RTN","PRC AACR1",141 ,0)
	1875	.....S ^T MP("PRCAAC R1",$J,PRC AIEN)=PRCA TEMP
	1876	"RTN","PRC AACR1",142 ,0)
	1877	.....Q
	1878	"RTN","PRC AACR1",143 ,0)
	1879	;
	1880	"RTN","PRC AACR1",144 ,0)
	1881	; Store i n ^TMP sor ted by Tra nsaction, Debtor and #Bill Num ber
	1882	"RTN","PRC AACR1",145 ,0)
	1883	I PRCASOR T=4 D
	1884	"RTN","PRC AACR1",146 ,0)
	1885	.; Print Header
	1886	"RTN","PRC AACR1",147 ,0)
	1887	.D PSACRT P4
	1888	"RTN","PRC AACR1",148 ,0)
	1889	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	1890	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	1891	"RTN","PRC AACR1",149 ,0)
	1892	.S PRCATN =""
	1893	"RTN","PRC AACR1",150 ,0)
	1894	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D
	1895	"RTN","PRC AACR1",151 ,0)
	1896	..S PRCAD TR=""
	1897	"RTN","PRC AACR1",152 ,0)
	1898	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D
	1899	"RTN","PRC AACR1",153 ,0)
	1900	...S PRCA BN=""
	1901	"RTN","PRC AACR1",154 ,0)
	1902	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D
	1903	"RTN","PRC AACR1",155 ,0)
	1904	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	1905	"RTN","PRC AACR1",156 ,0)
	1906	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1907	"RTN","PRC AACR1",157 ,0)
	1908	....S PRC AIEN=PRCAI EN+1
	1909	"RTN","PRC AACR1",158 ,0)
	1910	....; Add Transacti on Number
	1911	"RTN","PRC AACR1",159 ,0)
	1912	....S PRC ATEMP=$J($ P(PRCADATA ,U,1),9),$ E(PRCATEMP ,11)=" "
	1913	"RTN","PRC AACR1",160 ,0)
	1914	....; Add 18 chars of Debtor' s name
	1915	"RTN","PRC AACR1",161 ,0)
	1916	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,31)=" "
	1917	"RTN","PRC AACR1",162 ,0)
	1918	....; Add Bill Numb er
	1919	"RTN","PRC AACR1",163 ,0)
	1920	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,3),11),$ E(PRCATEMP ,44)=" "
	1921	"RTN","PRC AACR1",164 ,0)
	1922	....; Add SSN
	1923	"RTN","PRC AACR1",165 ,0)
	1924	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,4 ),$E(PRCAT EMP,50)=" "
	1925	"RTN","PRC AACR1",166 ,0)
	1926	....; Add Auto-Corr ect Date
	1927	"RTN","PRC AACR1",167 ,0)
	1928	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	1929	"RTN","PRC AACR1",168 ,0)
	1930	....; Add Auto-Corr ect Reason
	1931	"RTN","PRC AACR1",169 ,0)
	1932	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	1933	"RTN","PRC AACR1",170 ,0)
	1934	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	1935	"RTN","PRC AACR1",171 ,0)
	1936	....Q
	1937	"RTN","PRC AACR1",172 ,0)
	1938	;
	1939	"RTN","PRC AACR1",173 ,0)
	1940	; Send Ma ilMan mess age with N o Forward
	1941	"RTN","PRC AACR1",174 ,0)
	1942	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ
	1943	"RTN","PRC AACR1",175 ,0)
	1944	S XMTO(DU Z)=""
	1945	"RTN","PRC AACR1",176 ,0)
	1946	S XMSUBJ= "BILLS THA T HAVE BEE N AUTO-COR RECTED"
	1947	"RTN","PRC AACR1",177 ,0)
	1948	S XMBODY= "^TMP(""PR CAACR1"",$ J)"
	1949	"RTN","PRC AACR1",178 ,0)
	1950	S XMINSTR ("FLAGS")= "X"
	1951	"RTN","PRC AACR1",179 ,0)
	1952	S XMDUZ=D UZ
	1953	"RTN","PRC AACR1",180 ,0)
	1954	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	1955	"RTN","PRC AACR1",181 ,0)
	1956	D HOME^%Z IS
	1957	"RTN","PRC AACR1",182 ,0)
	1958	K IO("Q") ,POP
	1959	"RTN","PRC AACR1",183 ,0)
	1960	K ^TMP("P RCAACR",$J )
	1961	"RTN","PRC AACR1",184 ,0)
	1962	K ^TMP("P RCAACR1",$ J)
	1963	"RTN","PRC AACR1",185 ,0)
	1964	K PRCABDT ,PRCAEDT,P RCASORT
	1965	"RTN","PRC AACR1",186 ,0)
	1966	Q
	1967	"RTN","PRC AACR1",187 ,0)
	1968	;
	1969	"RTN","PRC AACR1",188 ,0)
	1970	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	1971	"RTN","PRC AACR1",189 ,0)
	1972	S PAGE=PA GE+1
	1973	"RTN","PRC AACR1",190 ,0)
	1974	S PRCAIEN =PRCAIEN+1
	1975	"RTN","PRC AACR1",191 ,0)
	1976	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	1977	"RTN","PRC AACR1",192 ,0)
	1978	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,8)= ""
	1979	"RTN","PRC AACR1",193 ,0)
	1980	S PRCADAT A=PRCADATA _"BILLS TH AT HAVE BE EN AUTO-CO RRECTED (S ORTED BY B ILL #)"
	1981	"RTN","PRC AACR1",194 ,0)
	1982	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	1983	"RTN","PRC AACR1",195 ,0)
	1984	S PRCAIEN =PRCAIEN+1
	1985	"RTN","PRC AACR1",196 ,0)
	1986	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	1987	"RTN","PRC AACR1",197 ,0)
	1988	S PRCAIEN =PRCAIEN+1
	1989	"RTN","PRC AACR1",198 ,0)
	1990	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	1991	"RTN","PRC AACR1",199 ,0)
	1992	S PRCAIEN =PRCAIEN+1
	1993	"RTN","PRC AACR1",200 ,0)
	1994	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	1995	"RTN","PRC AACR1",201 ,0)
	1996	S PRCADAT A="BILL NO . DEBT OR SSN TRANS NU M AUTO-C DATE AU
	1997	TO-C REASO N"
	1998	"RTN","PRC AACR1",202 ,0)
	1999	S PRCAIEN =PRCAIEN+1
	2000	"RTN","PRC AACR1",203 ,0)
	2001	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2002	"RTN","PRC AACR1",204 ,0)
	2003	S PRCADAT A="------- ---- ---- ---------- ---- ---- -------- - ------- ----- --
	2004	---------- --"
	2005	"RTN","PRC AACR1",205 ,0)
	2006	S PRCAIEN =PRCAIEN+1
	2007	"RTN","PRC AACR1",206 ,0)
	2008	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2009	"RTN","PRC AACR1",207 ,0)
	2010	Q
	2011	"RTN","PRC AACR1",208 ,0)
	2012	;
	2013	"RTN","PRC AACR1",209 ,0)
	2014	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2015	"RTN","PRC AACR1",210 ,0)
	2016	S PAGE=PA GE+1
	2017	"RTN","PRC AACR1",211 ,0)
	2018	S PRCAIEN =PRCAIEN+1
	2019	"RTN","PRC AACR1",212 ,0)
	2020	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2021	"RTN","PRC AACR1",213 ,0)
	2022	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,8)= ""
	2023	"RTN","PRC AACR1",214 ,0)
	2024	S PRCADAT A=PRCADATA _"BILLS TH AT HAVE BE EN AUTO-CO RRECTED (S ORTED BY D EBTOR)"
	2025	"RTN","PRC AACR1",215 ,0)
	2026	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2027	"RTN","PRC AACR1",216 ,0)
	2028	S PRCAIEN =PRCAIEN+1
	2029	"RTN","PRC AACR1",217 ,0)
	2030	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2031	"RTN","PRC AACR1",218 ,0)
	2032	S PRCAIEN =PRCAIEN+1
	2033	"RTN","PRC AACR1",219 ,0)
	2034	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2035	"RTN","PRC AACR1",220 ,0)
	2036	S PRCAIEN =PRCAIEN+1
	2037	"RTN","PRC AACR1",221 ,0)
	2038	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2039	"RTN","PRC AACR1",222 ,0)
	2040	S PRCADAT A="DEBTOR BILL NO . SSN TRANS NU M AUTO-C DATE AU
	2041	TO-C REASO N"
	2042	"RTN","PRC AACR1",223 ,0)
	2043	S PRCAIEN =PRCAIEN+1
	2044	"RTN","PRC AACR1",224 ,0)
	2045	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2046	"RTN","PRC AACR1",225 ,0)
	2047	S PRCADAT A="------- ---------- - ------- ---- ---- -------- - ------- ----- --
	2048	---------- --"
	2049	"RTN","PRC AACR1",226 ,0)
	2050	S PRCAIEN =PRCAIEN+1
	2051	"RTN","PRC AACR1",227 ,0)
	2052	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2053	"RTN","PRC AACR1",228 ,0)
	2054	Q
	2055	"RTN","PRC AACR1",229 ,0)
	2056	;
	2057	"RTN","PRC AACR1",230 ,0)
	2058	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2059	"RTN","PRC AACR1",231 ,0)
	2060	S PAGE=PA GE+1
	2061	"RTN","PRC AACR1",232 ,0)
	2062	S PRCAIEN =PRCAIEN+1
	2063	"RTN","PRC AACR1",233 ,0)
	2064	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2065	"RTN","PRC AACR1",234 ,0)
	2066	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,8)= ""
	2067	"RTN","PRC AACR1",235 ,0)
	2068	S PRCADAT A=PRCADATA _"BILLS TH AT HAVE BE EN AUTO-CO RRECTED (S ORTED BY A UTO-C DT)
	2069	"
	2070	"RTN","PRC AACR1",236 ,0)
	2071	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2072	"RTN","PRC AACR1",237 ,0)
	2073	S PRCAIEN =PRCAIEN+1
	2074	"RTN","PRC AACR1",238 ,0)
	2075	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2076	"RTN","PRC AACR1",239 ,0)
	2077	S PRCAIEN =PRCAIEN+1
	2078	"RTN","PRC AACR1",240 ,0)
	2079	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2080	"RTN","PRC AACR1",241 ,0)
	2081	S PRCAIEN =PRCAIEN+1
	2082	"RTN","PRC AACR1",242 ,0)
	2083	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2084	"RTN","PRC AACR1",243 ,0)
	2085	S PRCADAT A="AUTO-C DATE DEB TOR BIL L NO. SSN TRAN S NUM AU
	2086	TO-C REASO N"
	2087	"RTN","PRC AACR1",244 ,0)
	2088	S PRCAIEN =PRCAIEN+1
	2089	"RTN","PRC AACR1",245 ,0)
	2090	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2091	"RTN","PRC AACR1",246 ,0)
	2092	S PRCADAT A="------- ----- --- ---------- ----- --- -------- ---- ---- ----- --
	2093	---------- --"
	2094	"RTN","PRC AACR1",247 ,0)
	2095	S PRCAIEN =PRCAIEN+1
	2096	"RTN","PRC AACR1",248 ,0)
	2097	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2098	"RTN","PRC AACR1",249 ,0)
	2099	Q
	2100	"RTN","PRC AACR1",250 ,0)
	2101	;
	2102	"RTN","PRC AACR1",251 ,0)
	2103	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2104	"RTN","PRC AACR1",252 ,0)
	2105	S PAGE=PA GE+1
	2106	"RTN","PRC AACR1",253 ,0)
	2107	S PRCAIEN =PRCAIEN+1
	2108	"RTN","PRC AACR1",254 ,0)
	2109	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2110	"RTN","PRC AACR1",255 ,0)
	2111	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,8)= ""
	2112	"RTN","PRC AACR1",256 ,0)
	2113	S PRCADAT A=PRCADATA _"BILLS TH AT HAVE BE EN AUTO-CO RRECTED (S ORTED BY T RANS NUM)
	2114	"
	2115	"RTN","PRC AACR1",257 ,0)
	2116	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2117	"RTN","PRC AACR1",258 ,0)
	2118	S PRCAIEN =PRCAIEN+1
	2119	"RTN","PRC AACR1",259 ,0)
	2120	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2121	"RTN","PRC AACR1",260 ,0)
	2122	S PRCAIEN =PRCAIEN+1
	2123	"RTN","PRC AACR1",261 ,0)
	2124	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2125	"RTN","PRC AACR1",262 ,0)
	2126	S PRCAIEN =PRCAIEN+1
	2127	"RTN","PRC AACR1",263 ,0)
	2128	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2129	"RTN","PRC AACR1",264 ,0)
	2130	S PRCADAT A="TRANS N UM DEBTOR BILL N O. SSN AUTO-C DATE AU
	2131	TO-C REASO N"
	2132	"RTN","PRC AACR1",265 ,0)
	2133	S PRCAIEN =PRCAIEN+1
	2134	"RTN","PRC AACR1",266 ,0)
	2135	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2136	"RTN","PRC AACR1",267 ,0)
	2137	S PRCADAT A="------- -- ------ ---------- -- ------ ----- --- - ------- ----- --
	2138	---------- --"
	2139	"RTN","PRC AACR1",268 ,0)
	2140	S PRCAIEN =PRCAIEN+1
	2141	"RTN","PRC AACR1",269 ,0)
	2142	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2143	"RTN","PRC AACR1",270 ,0)
	2144	Q
	2145	"RTN","PRC AACR1",271 ,0)
	2146	;
	2147	"RTN","PRC AACR1",272 ,0)
	2148	EXIT ;
	2149	"RTN","PRC AACR1",273 ,0)
	2150	Q
	2151	"RTN","PRC ACPS")
	2152	0^1^B26199 3502^n/a
	2153	"RTN","PRC ACPS",1,0)
	2154	PRCACPS ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION ;09/2 1/15 3:34 PM
	2155	"RTN","PRC ACPS",2,0)
	2156	;;4.5;Acc ounts Rece ivable;3 07;Mar 2 0, 1995;Bu ild 79
	2157	"RTN","PRC ACPS",3,0)
	2158	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2159	"RTN","PRC ACPS",4,0)
	2160	;
	2161	"RTN","PRC ACPS",5,0)
	2162	Q
	2163	"RTN","PRC ACPS",6,0)
	2164	;
	2165	"RTN","PRC ACPS",7,0)
	2166	BEGIN ; En try point for manual run
	2167	"RTN","PRC ACPS",8,0)
	2168	; Determi ne if Auto Correct p rocess is currently running
	2169	"RTN","PRC ACPS",9,0)
	2170	N DIR,PRC ASTRT,QUIT ,X,X1,X2,Y
	2171	"RTN","PRC ACPS",10,0 )
	2172	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= 0
	2173	"RTN","PRC ACPS",11,0 )
	2174	; Notify user if Au to Correct process i s currentl y running
	2175	"RTN","PRC ACPS",12,0 )
	2176	I PRCASTR T'="" D Q :QUIT
	2177	"RTN","PRC ACPS",13,0 )
	2178	.S Y=$P(P RCASTRT,U, 2)
	2179	"RTN","PRC ACPS",14,0 )
	2180	.D DD^%DT
	2181	"RTN","PRC ACPS",15,0 )
	2182	.S PRCAST RT=Y
	2183	"RTN","PRC ACPS",16,0 )
	2184	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram was pr eviously s tarted on
	2185	"
	2186	"RTN","PRC ACPS",17,0 )
	2187	.W !,PRCA STRT," and has not y et success fully comp leted."
	2188	"RTN","PRC ACPS",18,0 )
	2189	.W !!,"Th e job can take up to 1 hour to complete when sched uled to ru n outside
	2190	"
	2191	"RTN","PRC ACPS",19,0 )
	2192	.W !,"of normal bus iness hour s and long er if run during nor mal busine ss hours"
	2193	"RTN","PRC ACPS",20,0 )
	2194	.W !,"whe n the load on the sy stem is gr eater."
	2195	"RTN","PRC ACPS",21,0 )
	2196	.W !!
	2197	"RTN","PRC ACPS",22,0 )
	2198	.W !,"If it has bee n more tha n an hour since the Patient St atement Au to-Correc
	2199	tion"
	2200	"RTN","PRC ACPS",23,0 )
	2201	.W !,"Pro gram was s tarted and the confi rmation e- mail with subject: C PS"
	2202	"RTN","PRC ACPS",24,0 )
	2203	.W !,"AUT O-CORRECTI ON COMPLET E has not been sent to the PRC ACPS mail group, yo
	2204	u can"
	2205	"RTN","PRC ACPS",25,0 )
	2206	.W !,"run the Patie nt Stateme nt Auto-Co rrection P rogram aga in."
	2207	"RTN","PRC ACPS",26,0 )
	2208	.W !
	2209	"RTN","PRC ACPS",27,0 )
	2210	.S DIR("A ")="Do you want to r un the Pat ient State ment Auto- Correction Program
	2211	again"
	2212	"RTN","PRC ACPS",28,0 )
	2213	.S DIR(0) ="Y",DIR(" B")="NO"
	2214	"RTN","PRC ACPS",29,0 )
	2215	.D ^DIR
	2216	"RTN","PRC ACPS",30,0 )
	2217	.W !
	2218	"RTN","PRC ACPS",31,0 )
	2219	.; Quit i f ^, ^^, T imeout or No
	2220	"RTN","PRC ACPS",32,0 )
	2221	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	2222	"RTN","PRC ACPS",33,0 )
	2223	.K DTOUT, DUOUT,DIRO UT
	2224	"RTN","PRC ACPS",34,0 )
	2225	.Q
	2226	"RTN","PRC ACPS",35,0 )
	2227	;
	2228	"RTN","PRC ACPS",36,0 )
	2229	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	2230	"RTN","PRC ACPS",37,0 )
	2231	W !,"Queu e the pati ent statem ent discre pancies au to-correct ion progra m to run:
	2232	"
	2233	"RTN","PRC ACPS",38,0 )
	2234	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	2235	"RTN","PRC ACPS",39,0 )
	2236	S ZTRTN=" START^PRCA CPS",ZTIO= ""
	2237	"RTN","PRC ACPS",40,0 )
	2238	D ^%ZTLOA D
	2239	"RTN","PRC ACPS",41,0 )
	2240	Q
	2241	"RTN","PRC ACPS",42,0 )
	2242	;
	2243	"RTN","PRC ACPS",43,0 )
	2244	START ; En try point for Schedu led backgr ound job
	2245	"RTN","PRC ACPS",44,0 )
	2246	N DEBTOR, DEBTOR0,DE BTOR1,PRCA STRT,REFRE V,X,Y
	2247	"RTN","PRC ACPS",45,0 )
	2248	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0))
	2249	"RTN","PRC ACPS",46,0 )
	2250	; If a pr evious job still run ning send e-mail war ning to PR CACPS mail group
	2251	"RTN","PRC ACPS",47,0 )
	2252	I PRCASTR T'="" D
	2253	"RTN","PRC ACPS",48,0 )
	2254	.S Y=$P(P RCASTRT,U, 2)
	2255	"RTN","PRC ACPS",49,0 )
	2256	.; Conver t date to external f ormat
	2257	"RTN","PRC ACPS",50,0 )
	2258	.D DD^%DT
	2259	"RTN","PRC ACPS",51,0 )
	2260	.S PRCAST RT=Y
	2261	"RTN","PRC ACPS",52,0 )
	2262	.; Send m ail to PRC ACPS mail group noti ng previou s run didn 't complet e
	2263	"RTN","PRC ACPS",53,0 )
	2264	.D PRCAMA IL(PRCASTR T)
	2265	"RTN","PRC ACPS",54,0 )
	2266	.Q
	2267	"RTN","PRC ACPS",55,0 )
	2268	; Get cur rent date/ time
	2269	"RTN","PRC ACPS",56,0 )
	2270	D NOW^%DT C
	2271	"RTN","PRC ACPS",57,0 )
	2272	S (PRCAST RT,X1)=%,X 2=8
	2273	"RTN","PRC ACPS",58,0 )
	2274	D C^%DTC
	2275	"RTN","PRC ACPS",59,0 )
	2276	S ^XTMP(" PRCACPS",0 )=X_U_PRCA STRT_U_"Pa tient Stat ement Auto -Correctio n Program
	2277	"
	2278	"RTN","PRC ACPS",60,0 )
	2279	; Loop th rough C x- ref in 430 . This fie ld points to the Deb tor File, which in
	2280	turn is a
	2281	"RTN","PRC ACPS",61,0 )
	2282	; variabl e pointer to other f iles.
	2283	"RTN","PRC ACPS",62,0 )
	2284	S DEBTOR= 0
	2285	"RTN","PRC ACPS",63,0 )
	2286	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	2287	"RTN","PRC ACPS",64,0 )
	2288	.; Perfor m the same in/out of balance c heck as th e CHECK PA TIENT ACCO UNT BALAN
	2289	CE option
	2290	"RTN","PRC ACPS",65,0 )
	2291	.; Quit t o next deb tor if acc ount is in balance
	2292	"RTN","PRC ACPS",66,0 )
	2293	.I '$$EN^ PRCAMRKC(D EBTOR) Q
	2294	"RTN","PRC ACPS",67,0 )
	2295	.S BALDIF F=0
	2296	"RTN","PRC ACPS",68,0 )
	2297	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) )
	2298	"RTN","PRC ACPS",69,0 )
	2299	.; QUIT i f it doesn 't point t o the PATI ENT (^DPT) file
	2300	"RTN","PRC ACPS",70,0 )
	2301	.Q:$P(DEB TOR0,"^")' ["DPT("
	2302	"RTN","PRC ACPS",71,0 )
	2303	.Q:$P(DEB TOR1,"^",9 )=1 ; qui t if debto r address marked unk nown
	2304	"RTN","PRC ACPS",72,0 )
	2305	.; Skip t his Debtor is they a t least 1 Bill in #4 30 with a status of REFUND RE
	2306	VIEW (#44)
	2307	"RTN","PRC ACPS",73,0 )
	2308	.Q:$$REFR EV(DEBTOR)
	2309	"RTN","PRC ACPS",74,0 )
	2310	.; Get pr evious bal ance and d ate of las t transact ion from t he AR EVEN T file (#
	2311	341)
	2312	"RTN","PRC ACPS",75,0 )
	2313	.D ENTER( DEBTOR)
	2314	"RTN","PRC ACPS",76,0 )
	2315	.; Perfor m checks/u pdates bas ed on File #430
	2316	"RTN","PRC ACPS",77,0 )
	2317	.D START1
	2318	"RTN","PRC ACPS",78,0 )
	2319	.; QUIT i f in balan ce
	2320	"RTN","PRC ACPS",79,0 )
	2321	.; *** Re moved so a ll out of balance ac counts to enter STAR T2
	2322	"RTN","PRC ACPS",80,0 )
	2323	.;I BALDI FF=0 K BAL DIFF,^TMP( "PRCAGTPS" ,$J),^TMP( "PRCABILL" ,$J) Q
	2324	"RTN","PRC ACPS",81,0 )
	2325	.; Review Data in ^ TMP and up date #433 as needed
	2326	"RTN","PRC ACPS",82,0 )
	2327	.D START2
	2328	"RTN","PRC ACPS",83,0 )
	2329	.; If the account i s still ou t of balan ce after f ixing ever ything it can
	2330	"RTN","PRC ACPS",84,0 )
	2331	.; call U PDTLTR to mark the l ast transa ction for the accoun t as NOT F IXABLE
	2332	"RTN","PRC ACPS",85,0 )
	2333	.I $$EN^P RCAMRKC(DE BTOR) D UP DTLTR^PRCA CPSA(0)
	2334	"RTN","PRC ACPS",86,0 )
	2335	.; clean up temp in fo and pro cess next debtor
	2336	"RTN","PRC ACPS",87,0 )
	2337	.K BALDIF F,^TMP("PR CAGTPS",$J ),^TMP("PR CABILL",$J )
	2338	"RTN","PRC ACPS",88,0 )
	2339	; Send ma ilman mess age to the PRCACPS m ail group at end of processing
	2340	"RTN","PRC ACPS",89,0 )
	2341	D USRMSG
	2342	"RTN","PRC ACPS",90,0 )
	2343	Q
	2344	"RTN","PRC ACPS",91,0 )
	2345	;
	2346	"RTN","PRC ACPS",92,0 )
	2347	REFREV(DEB TOR) ;
	2348	"RTN","PRC ACPS",93,0 )
	2349	; Check i f any Bill for this Debtor has a status of REFUND REVIEW (#4 4)
	2350	"RTN","PRC ACPS",94,0 )
	2351	N BN,QUIT
	2352	"RTN","PRC ACPS",95,0 )
	2353	S BN="",Q UIT=0
	2354	"RTN","PRC ACPS",96,0 )
	2355	F S BN=$ O(^PRCA(43 0,"C",DEBT OR,BN)) Q: 'BN D Q: QUIT
	2356	"RTN","PRC ACPS",97,0 )
	2357	.; Check CURRENT ST ATUS (#8) for status of REFUND REVIEW (# 44)
	2358	"RTN","PRC ACPS",98,0 )
	2359	.I $P($G( ^PRCA(430, BN,0)),U,8 )=44 S QUI T=1
	2360	"RTN","PRC ACPS",99,0 )
	2361	Q QUIT
	2362	"RTN","PRC ACPS",100, 0)
	2363	;
	2364	"RTN","PRC ACPS",101, 0)
	2365	ENTER(DEBT OR) ;
	2366	"RTN","PRC ACPS",102, 0)
	2367	S (PBAL,B BAL,TBAL)= 0 K ^TMP(" PRCAGTPS", $J)
	2368	"RTN","PRC ACPS",103, 0)
	2369	; Get las t type of event for debtor by calling $$ LST^RCFN01 . Referenc es files
	2370	#340 and # 341.1
	2371	"RTN","PRC ACPS",104, 0)
	2372	S DAT=$$L ST^RCFN01( DEBTOR,2) I DAT<1 S DAT=0
	2373	"RTN","PRC ACPS",105, 0)
	2374	; PBAL^PR CAGU gets previous b alance and date of l ast transa ction from the AR E
	2375	VENT file (#341)
	2376	"RTN","PRC ACPS",106, 0)
	2377	I DAT S D AT=9999999 .999999-DA T D PBAL^P RCAGU(DEBT OR,.DAT,.P BAL)
	2378	"RTN","PRC ACPS",107, 0)
	2379	D EN(DEBT OR,DAT)
	2380	"RTN","PRC ACPS",108, 0)
	2381	K BBAL,TB AL,DAT
	2382	"RTN","PRC ACPS",109, 0)
	2383	Q
	2384	"RTN","PRC ACPS",110, 0)
	2385	;
	2386	"RTN","PRC ACPS",111, 0)
	2387	EN(DEBTOR, BEG,END,TT Y) ;
	2388	"RTN","PRC ACPS",112, 0)
	2389	NEW Y
	2390	"RTN","PRC ACPS",113, 0)
	2391	; If Begi nning date is not de fined, set it to 0 t o start at beginning
	2392	"RTN","PRC ACPS",114, 0)
	2393	; If End date is no t defined, set it to today's d ate
	2394	"RTN","PRC ACPS",115, 0)
	2395	S:$G(BEG) ="" BEG=0 I $G(END)= "" D NOW^% DTC S END= % K %
	2396	"RTN","PRC ACPS",116, 0)
	2397	S TTY=$G( TTY) I TTY ="" D F430
	2398	"RTN","PRC ACPS",117, 0)
	2399	D F433
	2400	"RTN","PRC ACPS",118, 0)
	2401	Q Q
	2402	"RTN","PRC ACPS",119, 0)
	2403	F430 ; Che cks for AC COUNTS REC EIVABLE fi le (#430) for bills with (#3) ORIGINAL
	2404	AMOUNT has a value,
	2405	"RTN","PRC ACPS",120, 0)
	2406	; set thi s into the ^TMP glob al with _" ^0"
	2407	"RTN","PRC ACPS",121, 0)
	2408	NEW DAT,B N
	2409	"RTN","PRC ACPS",122, 0)
	2410	S DAT=BEG F S DAT= $O(^PRCA(4 30,"ATD",D EBTOR,DAT) ) Q:('DAT) !(DAT>END) S BN=0
	2411	F S BN=$O (^PRCA(430 ,"ATD",DEB TOR,DAT,BN )) Q:'BN D
	2412	"RTN","PRC ACPS",123, 0)
	2413	.; Add th e original amount if it is wit hin date r ange based on the da te of the
	2414	last stat ement
	2415	"RTN","PRC ACPS",124, 0)
	2416	.I $P(^PR CA(430,BN, 0),U,3) S ^TMP("PRCA GTPS",$J,D EBTOR,BN,0 )=$P(^PRCA (430,BN,0
	2417	),"^",3)_" ^0"
	2418	"RTN","PRC ACPS",125, 0)
	2419	Q
	2420	"RTN","PRC ACPS",126, 0)
	2421	F433 ;
	2422	"RTN","PRC ACPS",127, 0)
	2423	NEW DAT,T N
	2424	"RTN","PRC ACPS",128, 0)
	2425	; Loop th rough the Dates and Bills
	2426	"RTN","PRC ACPS",129, 0)
	2427	F DAT=BEG :0 S DAT=$ O(^PRCA(43 3,"ATD",DE BTOR,DAT)) Q:('DAT)! (DAT>END) F TN=0:0
	2428	S TN=$O(^ PRCA(433," ATD",DEBTO R,DAT,TN)) Q:'TN D
	2429	"RTN","PRC ACPS",130, 0)
	2430	.S TCMPLT ="",TMBSNC ="",TRDMRD ="",COMM=0
	2431	"RTN","PRC ACPS",131, 0)
	2432	.S TN0=$G (^PRCA(433 ,TN,0)) Q: TN0=""
	2433	"RTN","PRC ACPS",132, 0)
	2434	.S TN1=$G (^PRCA(433 ,TN,1))
	2435	"RTN","PRC ACPS",133, 0)
	2436	.S TN3=$G (^PRCA(433 ,TN,3))
	2437	"RTN","PRC ACPS",134, 0)
	2438	.I $P(TN1 ,U,2)="" Q ;MISSING TRANS TYP E
	2439	"RTN","PRC ACPS",135, 0)
	2440	.I $P(TN0 ,U,10)=1 S TCMPLT=1
	2441	"RTN","PRC ACPS",136, 0)
	2442	.I $P(TN1 ,U,2)=45 S COMM=1 G F433A
	2443	"RTN","PRC ACPS",137, 0)
	2444	.I $G(TTY )'="" Q:TT Y'=$P(TN1, U,2)
	2445	"RTN","PRC ACPS",138, 0)
	2446	.; Quit i f Transact ion Type i s blank or one of th e followin g:
	2447	"RTN","PRC ACPS",139, 0)
	2448	.; 3:REFE R TO RC, 4 :REFER TO DOJ, 5:REE STABLISH T O RC/DOJ, 6:RETURNED BY RC/DO
	2449	J
	2450	"RTN","PRC ACPS",140, 0)
	2451	.; 7:CASH COLLECTIO N BY RC/DO J, 24:MARS HAL/COURT COST, 25:R EPAYMENT P LAN, 30:D
	2452	EBIT VOUCH ER (SF 551 5)
	2453	"RTN","PRC ACPS",141, 0)
	2454	.I TTY="" ,",3,4,5,6 ,7,24,25,3 0,"[(","_$ P(TN1,U,2) _",") Q
	2455	"RTN","PRC ACPS",142, 0)
	2456	.; QUIT i f BILL NUM BER (#.03) = blank OR TRANSACTI ON STATUS (#4) '= CO MPLETE
	2457	"RTN","PRC ACPS",143, 0)
	2458	.I ($P(TN 0,U,2)="") !($P(TN0,U ,4)'=2) Q
	2459	"RTN","PRC ACPS",144, 0)
	2460	.; IF PRC AHIST="THI ST" AND TR ANSACTION TYPE (#12) = COMMENT (#45) cal l F433A t
	2461	o Set the data into ^TMP("PRCA GTPS",$J,D EBTOR
	2462	"RTN","PRC ACPS",145, 0)
	2463	.I $G(PRC AHIST)="TH IST",$P(TN 1,U,2)=45 G F433A
	2464	"RTN","PRC ACPS",146, 0)
	2465	.; IF TRA NSACTION T YPE (#12) '= to 46 UNSUSPENDE D AND TRAN SACTION TY PE (#12)'
	2466	= to 47 C HARGE SUSP ENDED
	2467	"RTN","PRC ACPS",147, 0)
	2468	.I $P(TN1 ,"^",2)'=4 6,$P(TN1," ^",2)'=47 D I TN1=" " Q
	2469	"RTN","PRC ACPS",148, 0)
	2470	..N RCTRA NDA,RCSTOP ,TRANTYPE
	2471	"RTN","PRC ACPS",149, 0)
	2472	..S RCSTO P=0
	2473	"RTN","PRC ACPS",150, 0)
	2474	..; Loop BACKWARDS through th e BILL NUM BER "C" x- ref
	2475	"RTN","PRC ACPS",151, 0)
	2476	..S RCTRA NDA=TN
	2477	"RTN","PRC ACPS",152, 0)
	2478	..F S RC TRANDA=$O( ^PRCA(433, "C",+$P(TN 0,"^",2),R CTRANDA),- 1) Q:'RCTR ANDA D
	2479	I RCSTOP Q
	2480	"RTN","PRC ACPS",153, 0)
	2481	...; QUIT if TRANSA CTION STAT US (#4) '= COMPLETE
	2482	"RTN","PRC ACPS",154, 0)
	2483	...I $P($ G(^PRCA(43 3,RCTRANDA ,0)),"^",4 )'=2 Q
	2484	"RTN","PRC ACPS",155, 0)
	2485	...; Load Transacti on Type
	2486	"RTN","PRC ACPS",156, 0)
	2487	...S TRAN TYPE=$P($G (^PRCA(433 ,RCTRANDA, 1)),"^",2)
	2488	"RTN","PRC ACPS",157, 0)
	2489	...; IF T RANSACTION TYPE (#12 ) = 46 UNS USPENDED s et stop & Quit
	2490	"RTN","PRC ACPS",158, 0)
	2491	...I TRAN TYPE=46 S RCSTOP=1 Q
	2492	"RTN","PRC ACPS",159, 0)
	2493	...; IF T RANSACTION TYPE (#12 ) = 47 CHA RGE SUSPEN DED set st op & Quit
	2494	"RTN","PRC ACPS",160, 0)
	2495	...I TRAN TYPE=47 S RCSTOP=1,T N1="" Q
	2496	"RTN","PRC ACPS",161, 0)
	2497	F433A .
	2498	"RTN","PRC ACPS",162, 0)
	2499	.; The da ta in the ^TMP is as follows:
	2500	"RTN","PRC ACPS",163, 0)
	2501	.; Data =
	2502	"RTN","PRC ACPS",164, 0)
	2503	.; 1. TRA NS. AMOUNT (#15) $ P(TN1,U,5)
	2504	"RTN","PRC ACPS",165, 0)
	2505	.; 2. TRA NSACTION T YPE (#12) $ P(TN1,U,2)
	2506	"RTN","PRC ACPS",166, 0)
	2507	.; 3. PRI N.COLLECTE D (#31) $ P(TN3,U,1)
	2508	"RTN","PRC ACPS",167, 0)
	2509	.; 4. INT EREST COLL ECTED (#32 ) $ P(TN3,U,2)
	2510	"RTN","PRC ACPS",168, 0)
	2511	.; 5. ADM IN.COLLECT ED (#33) $ P(TN3,U,3)
	2512	"RTN","PRC ACPS",169, 0)
	2513	.; 6. MAR SHAL FEE C OLLECTED ( #34) $ P(TN3,U,4)
	2514	"RTN","PRC ACPS",170, 0)
	2515	.; 7. COU RT COST CO LLECTED (# 35) $ P(TN3,U,5)
	2516	"RTN","PRC ACPS",171, 0)
	2517	.; 8. TOT AL OF #3 - #7 $ P(TN3,U,1) +$P(TN3,U, 2)+$P(TN3, U,3)+$P(T
	2518	N3,U,4)+$P (TN3,U,5)
	2519	"RTN","PRC ACPS",172, 0)
	2520	.; 9. TCM PLT ( #10) INCOM PLETE TRAN SACTION FL AG
	2521	"RTN","PRC ACPS",173, 0)
	2522	.;10. TRD MRD - Does n't appear to be use d
	2523	"RTN","PRC ACPS",174, 0)
	2524	.;11. TMB SNC - Does n't appear to be use d
	2525	"RTN","PRC ACPS",175, 0)
	2526	.;12. Dup licate fla g for use in START2 1=duplicat e, 0=not a duplicate . Set in
	2527	BILLQUIT^P RCACPSA
	2528	"RTN","PRC ACPS",176, 0)
	2529	.;
	2530	"RTN","PRC ACPS",177, 0)
	2531	.N PRCATE MP
	2532	"RTN","PRC ACPS",178, 0)
	2533	.S PRCATE MP=$P(TN1, U,5)_U_$P( TN1,U,2)_U _$P(TN3,U, 1)_U_$P(TN 3,U,2)_U_$ P(TN3,U,3
	2534	)_U_$P(TN3 ,U,4)_U_$P (TN3,U,5)
	2535	"RTN","PRC ACPS",179, 0)
	2536	.S PRCATE MP=PRCATEM P_U_($P(TN 3,U,1)+$P( TN3,U,2)+$ P(TN3,U,3) +$P(TN3,U, 4)+$P(TN3
	2537	,U,5))
	2538	"RTN","PRC ACPS",180, 0)
	2539	.S PRCATE MP=PRCATEM P_U_TCMPLT
	2540	"RTN","PRC ACPS",181, 0)
	2541	.S PRCATE MP=PRCATEM P_U_TRDMRD
	2542	"RTN","PRC ACPS",182, 0)
	2543	.S PRCATE MP=PRCATEM P_U_TMBSNC
	2544	"RTN","PRC ACPS",183, 0)
	2545	.S ^TMP(" PRCAGTPS", $J,DEBTOR, $P(TN0,U,2 ),TN)=PRCA TEMP
	2546	"RTN","PRC ACPS",184, 0)
	2547	.K TN0,TN 1,TN3,TCMP LT,TRDMRD, TMBSNC,COM M
	2548	"RTN","PRC ACPS",185, 0)
	2549	K PRCAHIS T
	2550	"RTN","PRC ACPS",186, 0)
	2551	Q
	2552	"RTN","PRC ACPS",187, 0)
	2553	;
	2554	"RTN","PRC ACPS",188, 0)
	2555	START1 ;
	2556	"RTN","PRC ACPS",189, 0)
	2557	;
	2558	"RTN","PRC ACPS",190, 0)
	2559	S BILL=""
	2560	"RTN","PRC ACPS",191, 0)
	2561	S CBALTOT =0 ; Will be the tot al of all CURRENT BA LANCE fiel d (#11) fo r the acc
	2562	ount
	2563	"RTN","PRC ACPS",192, 0)
	2564	; ACCOUNT S RECEIVAB LE (#430) The C cros s-referenc e allows u ser look-u p of bill
	2565	s belongin g to a spe cific debt or.
	2566	"RTN","PRC ACPS",193, 0)
	2567	; Loop th rough bill s
	2568	"RTN","PRC ACPS",194, 0)
	2569	; ^TMP("P RCABILL",$ J,DEBTOR,B ILL)= Sum of CURRENT BALANCE f ield (#11) for the
	2570	Bill
	2571	"RTN","PRC ACPS",195, 0)
	2572	; ^Sum of TRANS. AMOUNT (#1 5) for all transact
	2573	ions for t he Bill
	2574	"RTN","PRC ACPS",196, 0)
	2575	; ^Stop Flag if t he Bill ha s more tha n one err
	2576	or
	2577	"RTN","PRC ACPS",197, 0)
	2578	K ^TMP("P RCABILL",$ J)
	2579	"RTN","PRC ACPS",198, 0)
	2580	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	2581	"RTN","PRC ACPS",199, 0)
	2582	.; BILLTO T is the C URRENT BAL ANCE field (#11) for each Bill for the D ebtor
	2583	"RTN","PRC ACPS",200, 0)
	2584	.N BILLTO T
	2585	"RTN","PRC ACPS",201, 0)
	2586	.S BN0=$G (^PRCA(430 ,BILL,0))
	2587	"RTN","PRC ACPS",202, 0)
	2588	.; QUIT: CURRENT ST ATUS (#8) '= ACTIVE
	2589	"RTN","PRC ACPS",203, 0)
	2590	.; I $P(B N0,U,8)'=1 6 Q based on call o n 11/28/16 process a ll bill wi th a stat
	2591	us other t han Refund Review
	2592	"RTN","PRC ACPS",204, 0)
	2593	.; Skip a ll Debtors with 1 or more Bill s with a s tatus of R EFEUND REV IEW (#44)
	2594	. This ch eck is don e in
	2595	"RTN","PRC ACPS",205, 0)
	2596	.; REFREV above.
	2597	"RTN","PRC ACPS",206, 0)
	2598	.; Sum up CURRENT B ALANCE (#1 1) for eac h ACTIVE B ill
	2599	"RTN","PRC ACPS",207, 0)
	2600	.; Set in CBALTOT f or BALDIFF and in PR CABILL for BILLDIFF in Start2
	2601	"RTN","PRC ACPS",208, 0)
	2602	.; S CBAL TOT=CBALTO T+$$GET1^D IQ(430,BIL L,11)
	2603	"RTN","PRC ACPS",209, 0)
	2604	.S BILLTO T=$$GET1^D IQ(430,BIL L,11) ; Ge t CURRENT BALANCE (# 11) which is comput
	2605	ed: #71+#7 2+#73+#74+ #75
	2606	"RTN","PRC ACPS",210, 0)
	2607	.S ^TMP(" PRCABILL", $J,DEBTOR, BILL)=+BIL LTOT
	2608	"RTN","PRC ACPS",211, 0)
	2609	.S CBALTO T=CBALTOT+ BILLTOT
	2610	"RTN","PRC ACPS",212, 0)
	2611	N BILL,I, TN,TRANSTO T,TNVAL,TT YPE,TNTOT
	2612	"RTN","PRC ACPS",213, 0)
	2613	S TN="",( BILL,TRANS TOT,TTYPE, TNVAL)=0
	2614	"RTN","PRC ACPS",214, 0)
	2615	; Loop th rough Bill s
	2616	"RTN","PRC ACPS",215, 0)
	2617	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	2618	"RTN","PRC ACPS",216, 0)
	2619	.; Call B ILLQUIT to determine if this b ill has mu ltiple iss ues
	2620	"RTN","PRC ACPS",217, 0)
	2621	.I $$BILL QUIT^PRCAC PSA(DEBTOR ,BILL) Q
	2622	"RTN","PRC ACPS",218, 0)
	2623	.; Initia lize TNTOT for Trans action Tot al for thi s bill
	2624	"RTN","PRC ACPS",219, 0)
	2625	.I $G(TNT OT(BILL))= "" S TNTOT (BILL)=0
	2626	"RTN","PRC ACPS",220, 0)
	2627	.; Loop t hrough Tra nsactions
	2628	"RTN","PRC ACPS",221, 0)
	2629	.S TN=0 F S TN=$O( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN)) Q:TN ="" D
	2630	"RTN","PRC ACPS",222, 0)
	2631	..; IF Tr ansaction # = 0 Add TRANS. AMO UNT (#15) to the Tra nsaction T otal
	2632	"RTN","PRC ACPS",223, 0)
	2633	..; I TN= 0 S TRANST OT=TRANSTO T+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN) Q
	2634	"RTN","PRC ACPS",224, 0)
	2635	..; S TNV AL = (#15) TRANS. AM OUNT from #433
	2636	"RTN","PRC ACPS",225, 0)
	2637	..S TNVAL =+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)
	2638	"RTN","PRC ACPS",226, 0)
	2639	..; S TTY PE = (#12) TRANSACTI ON TYPE fr om #433
	2640	"RTN","PRC ACPS",227, 0)
	2641	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	2642	"RTN","PRC ACPS",228, 0)
	2643	..; IF IN COMPLETE T RANSACTION FLAG is s et, set Tr ansaction amount = 0
	2644	"RTN","PRC ACPS",229, 0)
	2645	..S TCMPL T=+$P(^TMP ("PRCAGTPS ",$J,DEBTO R,BILL,TN) ,U,9)
	2646	"RTN","PRC ACPS",230, 0)
	2647	..I TCMPL T S TNVAL= 0
	2648	"RTN","PRC ACPS",231, 0)
	2649	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	2650	"RTN","PRC ACPS",232, 0)
	2651	..I TMBSN C S TNVAL= 0
	2652	"RTN","PRC ACPS",233, 0)
	2653	..; Set T NVAL =0 if one of th e followin g Transact ion Types:
	2654	"RTN","PRC ACPS",234, 0)
	2655	..; 3:REF ER TO RC, 4:REFER TO DOJ, 5:RE ESTABLISH TO RC/DOJ, 6:RETURNE D BY RC/D
	2656	OJ
	2657	"RTN","PRC ACPS",235, 0)
	2658	..; 25:RE PAYMENT PL AN, 32:RET URNED FOR AMENDMENT, 33:AMENDE D BILL
	2659	"RTN","PRC ACPS",236, 0)
	2660	..I (TTYP E=3)!(TTYP E=4)!(TTYP E=5)!(TTYP E=6)!(TTYP E=32)!(TTY PE=25)!(TT YPE=33) S
	2661	TNVAL=0
	2662	"RTN","PRC ACPS",237, 0)
	2663	..; Set T NVAL to ne gative val ue if one of the Tra nsaction T ypes:
	2664	"RTN","PRC ACPS",238, 0)
	2665	..; 2:PAY MENT (IN P ART), 8:TE RM.BY FIS. OFFICER, 9 :TERM.BY C OMPROMISE, 10:WAIVE
	2666	D IN FULL
	2667	"RTN","PRC ACPS",239, 0)
	2668	..; 11:WA IVED IN PA RT, 14:EXE MPT INT/AD M. COST, 2 9:TERM.BY RC/DOJ, 34 :PAYMENT
	2669	(IN FULL)
	2670	"RTN","PRC ACPS",240, 0)
	2671	..; 35:DE CREASE ADJ USTMENT, 4 1:REFUNDED , 47:CHARG E SUSPENDE D
	2672	"RTN","PRC ACPS",241, 0)
	2673	..I TTYPE =2!(TTYPE= 8)!(TTYPE= 9)!(TTYPE= 10)!(TTYPE =11)!(TTYP E=14)!(TTY PE=29)!(T
	2674	TYPE=34)!( TTYPE=35)! (TTYPE=41) !(TTYPE=47 ) S TNVAL= -TNVAL
	2675	"RTN","PRC ACPS",242, 0)
	2676	..; Updat e Transact ion Total
	2677	"RTN","PRC ACPS",243, 0)
	2678	..S TRANS TOT=TRANST OT+TNVAL
	2679	"RTN","PRC ACPS",244, 0)
	2680	..; Updat e Transact ion Total for this B ill
	2681	"RTN","PRC ACPS",245, 0)
	2682	..S TNTOT (BILL)=TNT OT(BILL)+T NVAL
	2683	"RTN","PRC ACPS",246, 0)
	2684	.; Update PRCABILL with Trans action Tot al for thi s Bill
	2685	"RTN","PRC ACPS",247, 0)
	2686	.S $P(^TM P("PRCABIL L",$J,DEBT OR,BILL),U ,2)=TNTOT( BILL)
	2687	"RTN","PRC ACPS",248, 0)
	2688	; Set Bal ance Diffe rence = Su m up CURRE NT BALANCE (#8) for each ACTIV E Bill -
	2689	Transactio n Total fo r all bill s - PBAL f rom AR EVE NT file (# 341)
	2690	"RTN","PRC ACPS",249, 0)
	2691	S BALDIFF =CBALTOT-T RANSTOT-PB AL
	2692	"RTN","PRC ACPS",250, 0)
	2693	K CBALTOT ,TRANSTOT, PBAL,TCMPL T,BILL,BN0
	2694	"RTN","PRC ACPS",251, 0)
	2695	Q
	2696	"RTN","PRC ACPS",252, 0)
	2697	;
	2698	"RTN","PRC ACPS",253, 0)
	2699	START2 ;
	2700	"RTN","PRC ACPS",254, 0)
	2701	N I,ATNLA ST,BILL,BI LLCNT,BILL CNTR,BILLN UM,FLAGGED ,TN,TN9,TR ANSTOT,TNV AL,TTYPE,
	2702	TCPLT,STOP ,TRANCRNT, TRANPREV,T NLAST
	2703	"RTN","PRC ACPS",255, 0)
	2704	S (BILL,B ILLCNTR,FL AGGED)=0,A TNLAST=""
	2705	"RTN","PRC ACPS",256, 0)
	2706	; ATNLAST = The las t number f or the acc ount
	2707	"RTN","PRC ACPS",257, 0)
	2708	; FLAGGED = Account level fla g noting i f audit da ta was mar ked for th is accoun
	2709	t
	2710	"RTN","PRC ACPS",258, 0)
	2711	; PRCAFIX (X) = Hold s the tota l of the n umber of t ransaction s for a bi ll that m
	2712	atch to ch eck criter ia X
	2713	"RTN","PRC ACPS",259, 0)
	2714	; Determi ne the num ber of bil l for this account
	2715	"RTN","PRC ACPS",260, 0)
	2716	S (BILLCN T,BILLCNTR )=0,BILLNU M=""
	2717	"RTN","PRC ACPS",261, 0)
	2718	; Determi ne the num ber of bil ls for thi s account
	2719	"RTN","PRC ACPS",262, 0)
	2720	F S BILL NUM=$O(^TM P("PRCAGTP S",$J,DEBT OR,BILLNUM )) Q:'BILL NUM S BIL LCNT=BILL
	2721	CNT+1
	2722	"RTN","PRC ACPS",263, 0)
	2723	; Loop th rough Bill s
	2724	"RTN","PRC ACPS",264, 0)
	2725	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	2726	"RTN","PRC ACPS",265, 0)
	2727	.S BILLCN TR=BILLCNT R+1
	2728	"RTN","PRC ACPS",266, 0)
	2729	.; QUIT i f STOP fla g is set f or this Bi ll
	2730	"RTN","PRC ACPS",267, 0)
	2731	.I $P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,3)=1 S FLAGGED= FLAGGED+1 Q
	2732	"RTN","PRC ACPS",268, 0)
	2733	.; New an d set Bill Balance D ifference
	2734	"RTN","PRC ACPS",269, 0)
	2735	.N BILLDI FF
	2736	"RTN","PRC ACPS",270, 0)
	2737	.; ***** The follow ing 2 form ulas will need to be re-evalua ted once t he VA sup
	2738	plies us t he necessa ry details *****
	2739	"RTN","PRC ACPS",271, 0)
	2740	.; If the Original Bill Amoun t is not n ull use th is formula
	2741	"RTN","PRC ACPS",272, 0)
	2742	.I +$G(^T MP("PRCAGT PS",$J,DEB TOR,BILL,0 )) D
	2743	"RTN","PRC ACPS",273, 0)
	2744	..S BILLD IFF=$P($G( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,0)),U,1)- $P($G(^TMP ("PRCABIL
	2745	L",$J,DEBT OR,BILL)), U,1)+$P($G (^TMP("PRC ABILL",$J, DEBTOR,BIL L)),U,2)
	2746	"RTN","PRC ACPS",274, 0)
	2747	.; If the Original Amount is null use t his formul a
	2748	"RTN","PRC ACPS",275, 0)
	2749	.I '+$G(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, 0)) D
	2750	"RTN","PRC ACPS",276, 0)
	2751	..S BILLD IFF=$P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,1)-$P ($G(^TMP(" PRCABILL"
	2752	,$J,DEBTOR ,BILL)),U, 2)
	2753	"RTN","PRC ACPS",277, 0)
	2754	.; Quit i f Bill Bal ance Diffe rence is z ero
	2755	"RTN","PRC ACPS",278, 0)
	2756	.I 'BILLD IFF Q
	2757	"RTN","PRC ACPS",279, 0)
	2758	.; PRCAFI X(X) = Hol ds the tot al of the number of transactio ns for a b ill that
	2759	match to c heck crite ria X
	2760	"RTN","PRC ACPS",280, 0)
	2761	.; PRCATT TF = Total Transacti on Types t o Fix
	2762	"RTN","PRC ACPS",281, 0)
	2763	.N PRCATT TF,PRCAFIX
	2764	"RTN","PRC ACPS",282, 0)
	2765	.S (PRCAT TTF,TRANST OT,TTYPE,T NVAL)=0
	2766	"RTN","PRC ACPS",283, 0)
	2767	.S (TN,TN LAST)=""
	2768	"RTN","PRC ACPS",284, 0)
	2769	.; Initia lize type of fix cou nts
	2770	"RTN","PRC ACPS",285, 0)
	2771	.F I=1:1: 4 S PRCAFI X(I)=""
	2772	"RTN","PRC ACPS",286, 0)
	2773	.;
	2774	"RTN","PRC ACPS",287, 0)
	2775	.F S TN= $O(^TMP("P RCAGTPS",$ J,DEBTOR,B ILL,TN)) Q :TN="" D
	2776	"RTN","PRC ACPS",288, 0)
	2777	..; Save first tran saction nu mber
	2778	"RTN","PRC ACPS",289, 0)
	2779	..S (ATNL AST,TNLAST )=TN
	2780	"RTN","PRC ACPS",290, 0)
	2781	..; IF Tr ansaction number = 0 update Tr ansaction Total with (#15) TRA NS. AMOUN
	2782	T from #43 3
	2783	"RTN","PRC ACPS",291, 0)
	2784	..I TN=0 S TRANSTOT =TRANSTOT+ ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN) Q
	2785	"RTN","PRC ACPS",292, 0)
	2786	..; Set T NVAL = (#1 5) TRANS. AMOUNT fro m #433
	2787	"RTN","PRC ACPS",293, 0)
	2788	..S TNVAL =$P(^TMP(" PRCAGTPS", $J,DEBTOR, BILL,TN),U ,1)
	2789	"RTN","PRC ACPS",294, 0)
	2790	..; Set T TYPE = (#1 2) TRANSAC TION TYPE from #433
	2791	"RTN","PRC ACPS",295, 0)
	2792	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	2793	"RTN","PRC ACPS",296, 0)
	2794	..; Set T CPLT = (#1 0) INCOMPL ETE TRANSA CTION FLAG
	2795	"RTN","PRC ACPS",297, 0)
	2796	..S TCPLT =+$P($G(^P RCA(433,TN ,0)),U,10)
	2797	"RTN","PRC ACPS",298, 0)
	2798	..; I thi nk this wi ll always be blank
	2799	"RTN","PRC ACPS",299, 0)
	2800	..S TRDMR D=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,10)
	2801	"RTN","PRC ACPS",300, 0)
	2802	..; I thi nk this wi ll always be blank
	2803	"RTN","PRC ACPS",301, 0)
	2804	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	2805	"RTN","PRC ACPS",302, 0)
	2806	..; Quit it this tr ansaction was previo usly used to correct an out of balance
	2807	scenario
	2808	"RTN","PRC ACPS",303, 0)
	2809	..S TN9=$ G(^PRCA(43 3,TN,9))
	2810	"RTN","PRC ACPS",304, 0)
	2811	..Q:$P(TN 9,U,4)'=""
	2812	"RTN","PRC ACPS",305, 0)
	2813	..;
	2814	"RTN","PRC ACPS",306, 0)
	2815	..; *** T he Null tr ansaction check will be implem ented in P RCA4.531 3 ***
	2816	"RTN","PRC ACPS",307, 0)
	2817	..; Check #1 - Tran saction wi th missing $ amount & Transact ion Type ' = Comment
	2818	(#45)
	2819	"RTN","PRC ACPS",308, 0)
	2820	..;I TNVA L="",(TTYP E'=45) D Q
	2821	"RTN","PRC ACPS",309, 0)
	2822	..;.S PRC AFIX(1)=$G (PRCAFIX(1 ))+1,IENCR RT=TN
	2823	"RTN","PRC ACPS",310, 0)
	2824	..;.S PRC AFIX(1,TN) =""
	2825	"RTN","PRC ACPS",311, 0)
	2826	..;
	2827	"RTN","PRC ACPS",312, 0)
	2828	..; Check #2 - Tran saction ma rked as In complete w ith +$ amo unt matchi ng off by
	2829	amount
	2830	"RTN","PRC ACPS",313, 0)
	2831	..I TNVAL =BILLDIFF I TCPLT D Q
	2832	"RTN","PRC ACPS",314, 0)
	2833	...Q:(TTY PE=45)
	2834	"RTN","PRC ACPS",315, 0)
	2835	...I TRDM RD Q
	2836	"RTN","PRC ACPS",316, 0)
	2837	...S PRCA FIX(2)=$G( PRCAFIX(2) )+1,IENCRR T=TN
	2838	"RTN","PRC ACPS",317, 0)
	2839	...S PRCA FIX(2,TN)= ""
	2840	"RTN","PRC ACPS",318, 0)
	2841	..;
	2842	"RTN","PRC ACPS",319, 0)
	2843	..; Check #3 - Tran saction ma rked as In complete w ith -$ amo unt matchi ng off by
	2844	amount
	2845	"RTN","PRC ACPS",320, 0)
	2846	..I -TNVA L=BILLDIFF I TCPLT D Q
	2847	"RTN","PRC ACPS",321, 0)
	2848	...Q:(TTY PE=45)
	2849	"RTN","PRC ACPS",322, 0)
	2850	...S PRCA FIX(3)=$G( PRCAFIX(3) )+1,IENCRR T=TN
	2851	"RTN","PRC ACPS",323, 0)
	2852	...S PRCA FIX(3,TN)= ""
	2853	"RTN","PRC ACPS",324, 0)
	2854	..;
	2855	"RTN","PRC ACPS",325, 0)
	2856	..; Check #4 - Dupl icate Tran saction
	2857	"RTN","PRC ACPS",326, 0)
	2858	..I TTYPE '=45,($P(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, TN),U,12)= 1) D
	2859	"RTN","PRC ACPS",327, 0)
	2860	...S PRCA FIX(4)=$G( PRCAFIX(4) )+1,IENCRR T=TN
	2861	"RTN","PRC ACPS",328, 0)
	2862	...S PRCA FIX(4,TN)= ""
	2863	"RTN","PRC ACPS",329, 0)
	2864	.;
	2865	"RTN","PRC ACPS",330, 0)
	2866	.; Quit i f there we re no tran sactions f or this bi ll
	2867	"RTN","PRC ACPS",331, 0)
	2868	.I $G(IEN CRRT)=""!( $G(TNLAST) ="") Q
	2869	"RTN","PRC ACPS",332, 0)
	2870	.; If we are on the last Bill and there were no t ransaction s for the entire ac
	2871	count Quit
	2872	"RTN","PRC ACPS",333, 0)
	2873	.I BILLCN TR=BILLCNT ,ATNLAST=" " Q
	2874	"RTN","PRC ACPS",334, 0)
	2875	.;
	2876	"RTN","PRC ACPS",335, 0)
	2877	.F I=1:1: 4 D
	2878	"RTN","PRC ACPS",336, 0)
	2879	..S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	2880	"RTN","PRC ACPS",337, 0)
	2881	.; if you get to he re the bil l was out of balance and if it shows not hing to f
	2882	ix, set la st transac tion
	2883	"RTN","PRC ACPS",338, 0)
	2884	.; for th is Bill to NOT FIXAB LE
	2885	"RTN","PRC ACPS",339, 0)
	2886	.I PRCATT TF=0 D UPD TLTR^PRCAC PSA($G(TNL AST)) S FL AGGED=1 Q
	2887	"RTN","PRC ACPS",340, 0)
	2888	.; Update this bill
	2889	"RTN","PRC ACPS",341, 0)
	2890	.D FIXBIL L(.FLAGGED )
	2891	"RTN","PRC ACPS",342, 0)
	2892	Q:FLAGGED
	2893	"RTN","PRC ACPS",343, 0)
	2894	; The acc ount was o ut of bala nce but no thing was found on a ny bill th at could
	2895	be fixed.
	2896	"RTN","PRC ACPS",344, 0)
	2897	; Mark th e last tra nsaction f or the las t bill for this acco unt as not fixable.
	2898	"RTN","PRC ACPS",345, 0)
	2899	I 'FLAGGE D D UPDTLT R^PRCACPSA ($G(ATNLAS T))
	2900	"RTN","PRC ACPS",346, 0)
	2901	Q
	2902	"RTN","PRC ACPS",347, 0)
	2903	;
	2904	"RTN","PRC ACPS",348, 0)
	2905	FIXBILL(FL AGGED) ;Up date a sin gle bill u sing PRCAF IX array
	2906	"RTN","PRC ACPS",349, 0)
	2907	; Make up date deter mination b ased on ch ecks 1 - 4 .
	2908	"RTN","PRC ACPS",350, 0)
	2909	; Sum up check tota ls
	2910	"RTN","PRC ACPS",351, 0)
	2911	;F I=1:1: 4 D
	2912	"RTN","PRC ACPS",352, 0)
	2913	;.S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	2914	"RTN","PRC ACPS",353, 0)
	2915	; Get cur rent date/ time
	2916	"RTN","PRC ACPS",354, 0)
	2917	N PRCADAT E
	2918	"RTN","PRC ACPS",355, 0)
	2919	D NOW^%DT C
	2920	"RTN","PRC ACPS",356, 0)
	2921	S PRCADAT E=X
	2922	"RTN","PRC ACPS",357, 0)
	2923	; Otherwi se there i s only 1 b ad transac tion so up date as ne eded
	2924	"RTN","PRC ACPS",358, 0)
	2925	; Lock Re cord
	2926	"RTN","PRC ACPS",359, 0)
	2927	L +^PRCA( 433,IENCRR T,9):DILOC KTM
	2928	"RTN","PRC ACPS",360, 0)
	2929	; If lock not obtai ned, updat e number o f transact ions that couldn't b e fixed
	2930	"RTN","PRC ACPS",361, 0)
	2931	Q:'$T
	2932	"RTN","PRC ACPS",362, 0)
	2933	; Set FDA array for the neces sary field s based on the type of fix ide ntified
	2934	"RTN","PRC ACPS",363, 0)
	2935	N PRCAFDA
	2936	"RTN","PRC ACPS",364, 0)
	2937	; *** The Null tran saction ch eck will b e implemen ted in PRC A4.5313 ***
	2938	"RTN","PRC ACPS",365, 0)
	2939	; Check # 1 - Transa ction with missing $ amount
	2940	"RTN","PRC ACPS",366, 0)
	2941	;I PRCAFI X(1) D
	2942	"RTN","PRC ACPS",367, 0)
	2943	;.S PRCAF DA(433,IEN CRRT_",",1 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	2944	"RTN","PRC ACPS",368, 0)
	2945	;.S PRCAF DA(433,IEN CRRT_",",9 4)=PRCADAT E
	2946	"RTN","PRC ACPS",369, 0)
	2947	;.S PRCAF DA(433,IEN CRRT_",",9 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	2948	"RTN","PRC ACPS",370, 0)
	2949	;.S PRCAF DA(433,IEN CRRT_",",9 6)="N" ; N ULL TRANSA CTION AMOU NT
	2950	"RTN","PRC ACPS",371, 0)
	2951	; Check # 2 - Transa ction mark ed as Inco mplete wit h +$ amoun t matching off by a
	2952	mount
	2953	"RTN","PRC ACPS",372, 0)
	2954	; Check # 3 - Transa ction mark ed as Inco mplete wit h -$ amoun t matching off by a
	2955	mount
	2956	"RTN","PRC ACPS",373, 0)
	2957	I PRCAFIX (2)!(PRCAF IX(3)) D
	2958	"RTN","PRC ACPS",374, 0)
	2959	.S PRCAFD A(433,IENC RRT_",",10 )=""
	2960	"RTN","PRC ACPS",375, 0)
	2961	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	2962	"RTN","PRC ACPS",376, 0)
	2963	.S PRCAFD A(433,IENC RRT_",",96 )="I" ; IN COMPLETE F LAG ERROR
	2964	"RTN","PRC ACPS",377, 0)
	2965	; Check # 4 - Duplic ate Transa ction
	2966	"RTN","PRC ACPS",378, 0)
	2967	I PRCAFIX (4) D
	2968	"RTN","PRC ACPS",379, 0)
	2969	.; Null o ut audit f ields on o riginal tr ansaction
	2970	"RTN","PRC ACPS",380, 0)
	2971	.S PRCAFD A(433,IENC RRT-1_",", 94)=""
	2972	"RTN","PRC ACPS",381, 0)
	2973	.S PRCAFD A(433,IENC RRT-1_",", 95)=""
	2974	"RTN","PRC ACPS",382, 0)
	2975	.S PRCAFD A(433,IENC RRT-1_",", 96)=""
	2976	"RTN","PRC ACPS",383, 0)
	2977	.L +^PRCA (433,IENCR RT-1,9):DI LOCKTM
	2978	"RTN","PRC ACPS",384, 0)
	2979	.Q:'$T
	2980	"RTN","PRC ACPS",385, 0)
	2981	.D FILE^D IE(,"PRCAF DA")
	2982	"RTN","PRC ACPS",386, 0)
	2983	.L -^PRCA (433,IENCR RT-1,9)
	2984	"RTN","PRC ACPS",387, 0)
	2985	.; Set th e fields f or the dup licate tra nsaction
	2986	"RTN","PRC ACPS",388, 0)
	2987	.S PRCAFD A(433,IENC RRT_",",10 )=1 ; INCO MPLETE TRA NSACTION
	2988	"RTN","PRC ACPS",389, 0)
	2989	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	2990	"RTN","PRC ACPS",390, 0)
	2991	.S PRCAFD A(433,IENC RRT_",",95 )=$S(BILLD IFF>0:BILL DIFF,1:-BI LLDIFF)
	2992	"RTN","PRC ACPS",391, 0)
	2993	.S PRCAFD A(433,IENC RRT_",",96 )="D" ; DU PLICATE TR ANSACTION
	2994	"RTN","PRC ACPS",392, 0)
	2995	; Update Transactio n
	2996	"RTN","PRC ACPS",393, 0)
	2997	D FILE^DI E(,"PRCAFD A")
	2998	"RTN","PRC ACPS",394, 0)
	2999	S FLAGGED =1
	3000	"RTN","PRC ACPS",395, 0)
	3001	; Unlock file
	3002	"RTN","PRC ACPS",396, 0)
	3003	L -^PRCA( 433,IENCRR T,9)
	3004	"RTN","PRC ACPS",397, 0)
	3005	K TMBSNC, IENCRRT
	3006	"RTN","PRC ACPS",398, 0)
	3007	Q
	3008	"RTN","PRC ACPS",399, 0)
	3009	;
	3010	"RTN","PRC ACPS",400, 0)
	3011	DIQOUTCS(D IQOUT) ;Re turn check sum for a processed DIQOUT arr ay.
	3012	"RTN","PRC ACPS",401, 0)
	3013	N CS,DATA ,FIELD,FNU M,IENS,IND ,SFN,STRIN G,TARGET,T EXT,WP
	3014	"RTN","PRC ACPS",402, 0)
	3015	S FNUM=$O (DIQOUT("" ))
	3016	"RTN","PRC ACPS",403, 0)
	3017	S (CS,FNU M)=0
	3018	"RTN","PRC ACPS",404, 0)
	3019	F S FNUM =$O(DIQOUT (FNUM)) Q: FNUM="" D
	3020	"RTN","PRC ACPS",405, 0)
	3021	.S IENS=" "
	3022	"RTN","PRC ACPS",406, 0)
	3023	.F S IEN S=$O(DIQOU T(FNUM,IEN S)) Q:IENS ="" D
	3024	"RTN","PRC ACPS",407, 0)
	3025	..S FIELD =0
	3026	"RTN","PRC ACPS",408, 0)
	3027	..F S FI ELD=$O(DIQ OUT(FNUM,I ENS,FIELD) ) Q:FIELD= "" D
	3028	"RTN","PRC ACPS",409, 0)
	3029	...S DATA =DIQOUT(FN UM,IENS,FI ELD)
	3030	"RTN","PRC ACPS",410, 0)
	3031	...S TEXT =FNUM_$L(I ENS,",")_F IELD_DATA
	3032	"RTN","PRC ACPS",411, 0)
	3033	...S CS=$ $CRC32^XLF CRC(TEXT,C S)
	3034	"RTN","PRC ACPS",412, 0)
	3035	Q CS
	3036	"RTN","PRC ACPS",413, 0)
	3037	;
	3038	"RTN","PRC ACPS",414, 0)
	3039	USRMSG ;se nds mailma n message to the PRC ACPS mail group
	3040	"RTN","PRC ACPS",415, 0)
	3041	N XMY,XMD UZ,XMSUB,X MTEXT,X
	3042	"RTN","PRC ACPS",416, 0)
	3043	S XMDUZ=" AR PACKAGE "
	3044	"RTN","PRC ACPS",417, 0)
	3045	S XMY("G. PRCACPS")= ""
	3046	"RTN","PRC ACPS",418, 0)
	3047	S XMSUB=" CPS AUTO-C ORRECTION COMPLETE " _$E(DT,4,5 )_"/"_$E(D T,6,7)_"/" _$E(DT,2,
	3048	3)
	3049	"RTN","PRC ACPS",419, 0)
	3050	S X(1)="C onsolidate d Patient Statement Auto-Corre ction"
	3051	"RTN","PRC ACPS",420, 0)
	3052	S X(2)="P rogram com pleted on "_$$FMTE^X LFDT($$NOW ^XLFDT()," 5P")
	3053	"RTN","PRC ACPS",421, 0)
	3054	S XMTEXT= "X("
	3055	"RTN","PRC ACPS",422, 0)
	3056	D ^XMD
	3057	"RTN","PRC ACPS",423, 0)
	3058	; Remove ^XTMP node
	3059	"RTN","PRC ACPS",424, 0)
	3060	K ^XTMP(" PRCACPS",0 )
	3061	"RTN","PRC ACPS",425, 0)
	3062	Q
	3063	"RTN","PRC ACPS",426, 0)
	3064	;
	3065	"RTN","PRC ACPS",427, 0)
	3066	PRCAMAIL(P RCASTRT) ;
	3067	"RTN","PRC ACPS",428, 0)
	3068	; Send e- mail notif ication to the PRCAC PS mail gr oup if the Auto-Corr ect was m
	3069	anually ru n
	3070	"RTN","PRC ACPS",429, 0)
	3071	; when it showed to be curren tly runnin g or possi ble errore d out on a previous
	3072	attempt.
	3073	"RTN","PRC ACPS",430, 0)
	3074	;
	3075	"RTN","PRC ACPS",431, 0)
	3076	; PRCASTA RT = Exter nal format of date/t ime (i.e. OCT 12, 20 16@09:39:5 8) that t
	3077	he
	3078	"RTN","PRC ACPS",432, 0)
	3079	; Auto-Co rrect prog ram was la st started .
	3080	"RTN","PRC ACPS",433, 0)
	3081	N XMY,XMD UZ,XMSUB,X MTEXT,X
	3082	"RTN","PRC ACPS",434, 0)
	3083	S XMDUZ=" AR PACKAGE "
	3084	"RTN","PRC ACPS",435, 0)
	3085	S XMY("G. PRCACPS")= ""
	3086	"RTN","PRC ACPS",436, 0)
	3087	S XMSUB=" CPS AUTO-C ORRECTION FAILURE "_ $E(DT,4,5) _"/"_$E(DT ,6,7)_"/"_ $E(DT,2,3
	3088	)
	3089	"RTN","PRC ACPS",437, 0)
	3090	S X(1)="T he Patient Statement Auto-Corr ection Pro gram was s tarted on: "
	3091	"RTN","PRC ACPS",438, 0)
	3092	S X(2)=PR CASTRT_" a nd may not have comp leted norm ally."
	3093	"RTN","PRC ACPS",439, 0)
	3094	S X(3)=""
	3095	"RTN","PRC ACPS",440, 0)
	3096	S X(4)="P lease have OI&T chec k the erro r trap for any error s related to routin
	3097	e"
	3098	"RTN","PRC ACPS",441, 0)
	3099	S X(5)="P RCACPS on this date. "
	3100	"RTN","PRC ACPS",442, 0)
	3101	S XMTEXT= "X("
	3102	"RTN","PRC ACPS",443, 0)
	3103	D ^XMD
	3104	"RTN","PRC ACPS",444, 0)
	3105	Q
	3106	"RTN","PRC ACPSA")
	3107	0^10^B2792 3295^n/a
	3108	"RTN","PRC ACPSA",1,0 )
	3109	PRCACPSA ; ALBANY/MGD -PATIENT S TATEMENTS AUTO-CORRE CTION ;09/ 21/15 3:34 PM
	3110	"RTN","PRC ACPSA",2,0 )
	3111	;;4.5;Acc ounts Rece ivable;3 07;Mar 2 0, 1995;Bu ild 79
	3112	"RTN","PRC ACPSA",3,0 )
	3113	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3114	"RTN","PRC ACPSA",4,0 )
	3115	;
	3116	"RTN","PRC ACPSA",5,0 )
	3117	Q
	3118	"RTN","PRC ACPSA",6,0 )
	3119	;
	3120	"RTN","PRC ACPSA",7,0 )
	3121	BILLQUIT(D EBTOR,BILL ) ;
	3122	"RTN","PRC ACPSA",8,0 )
	3123	; check n ews and in itializati ons
	3124	"RTN","PRC ACPSA",9,0 )
	3125	N FILENUM ,IENCRRT,I ENPREV,PRC ABFIX,PRCA BST,PRCAFD A,PRCACUR, PRCACUR1,P RCAPRV,PR
	3126	CAPRV1,TN, TNLAST,TRN SCRRT,TRNS PREV,X
	3127	"RTN","PRC ACPSA",10, 0)
	3128	S TNLAST= ""
	3129	"RTN","PRC ACPSA",11, 0)
	3130	S PRCABFI X=0
	3131	"RTN","PRC ACPSA",12, 0)
	3132	S TN=0
	3133	"RTN","PRC ACPSA",13, 0)
	3134	F S TN=$ O(^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)) Q: 'TN D
	3135	"RTN","PRC ACPSA",14, 0)
	3136	.; Load 0 and 1 nod es
	3137	"RTN","PRC ACPSA",15, 0)
	3138	.S PRCACU R=$G(^PRCA (433,TN,0) )
	3139	"RTN","PRC ACPSA",16, 0)
	3140	.S PRCACU R1=$G(^PRC A(433,TN,1 ))
	3141	"RTN","PRC ACPSA",17, 0)
	3142	.; Quit i f this Tra nsaction i s a COMMEN T
	3143	"RTN","PRC ACPSA",18, 0)
	3144	.I $P(PRC ACUR1,U,2) =45 Q
	3145	"RTN","PRC ACPSA",19, 0)
	3146	.; Quit i f this tra nsaction w as updated earlier a s part of an previou s fix
	3147	"RTN","PRC ACPSA",20, 0)
	3148	.I $P($G( ^PRCA(433, TN,9)),U,4 ) Q
	3149	"RTN","PRC ACPSA",21, 0)
	3150	.S TNLAST =TN
	3151	"RTN","PRC ACPSA",22, 0)
	3152	.; Check if Transac tion is ma rked as IN COMPLETE
	3153	"RTN","PRC ACPSA",23, 0)
	3154	.I $P(PRC ACUR,U,10) =1 S PRCAB FIX=PRCABF IX+1,PRCAB FIX("I")=$ G(PRCABFIX ("I"))+1
	3155	"RTN","PRC ACPSA",24, 0)
	3156	.; *** Th e Null tra nsaction c heck will be impleme nted in PR CA4.5313 ***
	3157	"RTN","PRC ACPSA",25, 0)
	3158	.; Check if zero do llar amoun t
	3159	"RTN","PRC ACPSA",26, 0)
	3160	.;I $P(PR CACUR1,U,5 )="" S PRC ABFIX=PRCA BFIX+1,PRC ABFIX("N") =$G(PRCABF IX("N"))+
	3161	1
	3162	"RTN","PRC ACPSA",27, 0)
	3163	.S PRCAPR V=$G(^PRCA (433,TN-1, 0))
	3164	"RTN","PRC ACPSA",28, 0)
	3165	.S PRCAPR V1=$G(^PRC A(433,TN-1 ,1))
	3166	"RTN","PRC ACPSA",29, 0)
	3167	.; Perfor m quick hi gh level d uplicate c heck
	3168	"RTN","PRC ACPSA",30, 0)
	3169	.I $P(PRC ACUR,U,2)' =$P(PRCAPR V,U,2) Q ; QUIT if (#.03) BIL L NUMBER d on't matc
	3170	h
	3171	"RTN","PRC ACPSA",31, 0)
	3172	.I $P(PRC ACUR,U,9)' =$P(PRCAPR V,U,9) Q ; QUIT if (#42) PROC ESSED BY d on't matc
	3173	h
	3174	"RTN","PRC ACPSA",32, 0)
	3175	.I $P(PRC ACUR1,U,1) '=$P(PRCAP RV1,U,1) Q ; QUIT i f (#11) TR ANSACTION DATE don'
	3176	t match
	3177	"RTN","PRC ACPSA",33, 0)
	3178	.I $P(PRC ACUR1,U,5) '=$P(PRCAP RV1,U,5) Q ; QUIT i f (#15) TR ANS. AMOUN T don't m
	3179	atch
	3180	"RTN","PRC ACPSA",34, 0)
	3181	.; Perfor m detailed duplicate check
	3182	"RTN","PRC ACPSA",35, 0)
	3183	.S IENPRE V=TN-1,IEN CRRT=TN,FI LENUM=433
	3184	"RTN","PRC ACPSA",36, 0)
	3185	.K TRNSPR EV S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENP REV,"**"," N","TRNSPR EV","MSG"
	3186	)
	3187	"RTN","PRC ACPSA",37, 0)
	3188	.K TRNSCR RT S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENC RRT,"**"," N","TRNSCR RT","MSG"
	3189	)
	3190	"RTN","PRC ACPSA",38, 0)
	3191	.S TRNSCR RT(433,TN_ ",",.01)=T RNSPREV(43 3,(TN-1)_" ,",.01)
	3192	"RTN","PRC ACPSA",39, 0)
	3193	.I $D(TRN SPREV(433, (TN-1)_"," ,41)) S TR NSCRRT(433 ,TN_",",41 )=$G(TRNSP REV(433,(
	3194	TN-1)_",", 41))
	3195	"RTN","PRC ACPSA",40, 0)
	3196	.I $$DIQO UTCS^PRCAC PS(.TRNSPR EV)'=$$DIQ OUTCS^PRCA CPS(.TRNSC RRT) Q
	3197	"RTN","PRC ACPSA",41, 0)
	3198	.; Set du plicate fl ag which w ill be use d in START 2
	3199	"RTN","PRC ACPSA",42, 0)
	3200	.S $P(^TM P("PRCAGTP S",$J,DEBT OR,BILL,TN ),U,12)=1
	3201	"RTN","PRC ACPSA",43, 0)
	3202	.; we hav e a duplic ate so upd ate counte r
	3203	"RTN","PRC ACPSA",44, 0)
	3204	.S PRCABF IX=PRCABFI X+1,PRCABF IX("D")=$G (PRCABFIX( "D"))+1
	3205	"RTN","PRC ACPSA",45, 0)
	3206	; Get Bil l Status f or checks
	3207	"RTN","PRC ACPSA",46, 0)
	3208	S PRCABST =$P($G(^PR CA(430,BIL L,0)),U,8)
	3209	"RTN","PRC ACPSA",47, 0)
	3210	;
	3211	"RTN","PRC ACPSA",48, 0)
	3212	; 3rd pie ce of ^TMP ("PRCABILL ",$J,DEBTO R,BILL) is stop/go f lag for th is bill.
	3213	"RTN","PRC ACPSA",49, 0)
	3214	; Set bel ow and uti lized in S TART2^PRCA CPS
	3215	"RTN","PRC ACPSA",50, 0)
	3216	;
	3217	"RTN","PRC ACPSA",51, 0)
	3218	; Check f or Duplica te needs t o include Bill Statu s of ACTIV E (#16), O PEN (#42)
	3219	or CANCEL LATION (#3 9)
	3220	"RTN","PRC ACPSA",52, 0)
	3221	; If ther e was only 1 problem and that problem wa s a Duplic ate and th e Bill St
	3222	atus is AC TIVE or OP EN
	3223	"RTN","PRC ACPSA",53, 0)
	3224	; or CANC ELLATION Q uit and le t it get s et in CHEC K2
	3225	"RTN","PRC ACPSA",54, 0)
	3226	I PRCABFI X=1,$G(PRC ABFIX("D") )=1,(PRCAB ST=16!(PRC ABST=42)!( PRCABST=39 )) S $P(^
	3227	TMP("PRCAB ILL",$J,DE BTOR,BILL) ,U,3)=0 Q 0
	3228	"RTN","PRC ACPSA",55, 0)
	3229	; If a si ngle probl em on a Bi ll in a st atus other than Acti ve or Open mark las
	3230	t transact ion as NOT FIXABLE
	3231	"RTN","PRC ACPSA",56, 0)
	3232	I PRCABFI X=1,PRCABS T'=16&(PRC ABST'=42) D UPDTLTR( $G(TNLAST) )
	3233	"RTN","PRC ACPSA",57, 0)
	3234	; If a si ngle probl em on a Bi ll in a st atus of Ac tive or Op en will be further
	3235	checked in START2
	3236	"RTN","PRC ACPSA",58, 0)
	3237	I PRCABFI X=1,(PRCAB ST=16!(PRC ABST=42)) S PRCABFIX =0
	3238	"RTN","PRC ACPSA",59, 0)
	3239	; If mult iple probl ems set au dit fields for last transactio n for the Bill
	3240	"RTN","PRC ACPSA",60, 0)
	3241	I PRCABFI X>1 D UPDT LTR($G(TNL AST)) S PR CABFIX=1
	3242	"RTN","PRC ACPSA",61, 0)
	3243	; Update Bill level stop flag
	3244	"RTN","PRC ACPSA",62, 0)
	3245	S $P(^TMP ("PRCABILL ",$J,DEBTO R,BILL),U, 3)=PRCABFI X
	3246	"RTN","PRC ACPSA",63, 0)
	3247	Q PRCABFI X
	3248	"RTN","PRC ACPSA",64, 0)
	3249	;
	3250	"RTN","PRC ACPSA",65, 0)
	3251	UPDTLTR(TN LAST) ;
	3252	"RTN","PRC ACPSA",66, 0)
	3253	; Initial ize variab les
	3254	"RTN","PRC ACPSA",67, 0)
	3255	N PRCABIL L,PRCABILX ,PRCADTR,P RCATN,PRCA UPDT
	3256	"RTN","PRC ACPSA",68, 0)
	3257	; Initial ize PRCAUP DT to 0 (i .e. No). This flag is set to 1 when an transacti
	3258	on was upd ated with the audit data
	3259	"RTN","PRC ACPSA",69, 0)
	3260	S PRCAUPD T=0
	3261	"RTN","PRC ACPSA",70, 0)
	3262	; If TNLA ST was und efined or null or so mething ot her than a positive number, s
	3263	et TNLAST= 0
	3264	"RTN","PRC ACPSA",71, 0)
	3265	; If TNLA ST was a p ositive nu mber, leav e it as is
	3266	"RTN","PRC ACPSA",72, 0)
	3267	S TNLAST= +$G(TNLAST ,0)
	3268	"RTN","PRC ACPSA",73, 0)
	3269	; If the IEN was a decimal nu mber, stri p off the decimal am ount
	3270	"RTN","PRC ACPSA",74, 0)
	3271	S TNLAST= $P(TNLAST, ".",1)
	3272	"RTN","PRC ACPSA",75, 0)
	3273	; Init ch ecks for a positive IEN and no correspon ding trans action
	3274	"RTN","PRC ACPSA",76, 0)
	3275	I +TNLAST >0,'$D(^PR CA(433,TNL AST,0)) S TNLAST=0
	3276	"RTN","PRC ACPSA",77, 0)
	3277	; Init ch ecks for a positive IEN and th is Transac tion exist s
	3278	"RTN","PRC ACPSA",78, 0)
	3279	I +TNLAST >0,$D(^PRC A(433,TNLA ST,0)) D Q:PRCAUPDT
	3280	"RTN","PRC ACPSA",79, 0)
	3281	.; If thi s transact ion hasn't been prev iously use d to flag an account , use it
	3282	"RTN","PRC ACPSA",80, 0)
	3283	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="" S PRCAUPDT= 1 D UPDTSE T(TNLAST) Q
	3284	"RTN","PRC ACPSA",81, 0)
	3285	.; If thi s transact ion was pr eviously u sed to ide ntify a NO T FIXABLE issue
	3286	"RTN","PRC ACPSA",82, 0)
	3287	.; update it again to have to day's date
	3288	"RTN","PRC ACPSA",83, 0)
	3289	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="X" S PRCAUPDT =1 D UPDTS ET(TNLAST) Q
	3290	"RTN","PRC ACPSA",84, 0)
	3291	.; If thi s Transact ion was pr eviously u sed to fix an issue other than NOT FIXA
	3292	BLE,
	3293	"RTN","PRC ACPSA",85, 0)
	3294	.; reset to 0 to ma ke it find another t ransaction
	3295	"RTN","PRC ACPSA",86, 0)
	3296	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)'="", ($P($G(^PR CA(433,TNL AST,9)),U, 6)'="X")
	3297	S TNLAST=0
	3298	"RTN","PRC ACPSA",87, 0)
	3299	.Q
	3300	"RTN","PRC ACPSA",88, 0)
	3301	; If you get to her e, TNLAST was either sent in w ith a posi tive value that cou
	3302	ldn't be u sed
	3303	"RTN","PRC ACPSA",89, 0)
	3304	; OR TNLA ST was sen t in as a null or 0. Either wa y, try to find anoth er accept
	3305	able trans action to mark
	3306	"RTN","PRC ACPSA",90, 0)
	3307	; There i s a possib ility that no transa ction can be found t o mark, in which ca
	3308	se, just q uit
	3309	"RTN","PRC ACPSA",91, 0)
	3310	I +TNLAST <1 D Q:+T NLAST<1
	3311	"RTN","PRC ACPSA",92, 0)
	3312	.S PRCABI LX=""
	3313	"RTN","PRC ACPSA",93, 0)
	3314	.F S PRC ABILX=$O(^ TMP("PRCAG TPS",$J,DE BTOR,PRCAB ILX),-1) Q :'PRCABILX D Q:TN
	3315	LAST
	3316	"RTN","PRC ACPSA",94, 0)
	3317	..S PRCAT N=""
	3318	"RTN","PRC ACPSA",95, 0)
	3319	..F S PR CATN=$O(^T MP("PRCAGT PS",$J,DEB TOR,PRCABI LX,PRCATN) ,-1) Q:'PR CATN D
	3320	Q:TNLAST
	3321	"RTN","PRC ACPSA",96, 0)
	3322	...; Quit if this t ransaction from ^TMP doesn't e xist in ^P RCA(433
	3323	"RTN","PRC ACPSA",97, 0)
	3324	...I '$D( ^PRCA(433, PRCATN,0)) Q
	3325	"RTN","PRC ACPSA",98, 0)
	3326	...; If t his transa ction hasn 't been ma rked for a nything, u se it
	3327	"RTN","PRC ACPSA",99, 0)
	3328	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)="" S TNLAST= PRCATN Q
	3329	"RTN","PRC ACPSA",100 ,0)
	3330	...; Chec k if this transactio n was prev iously fla gged as so me fix oth er than N
	3331	OT FIXABLE
	3332	"RTN","PRC ACPSA",101 ,0)
	3333	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)'=" X" Q
	3334	"RTN","PRC ACPSA",102 ,0)
	3335	...; If t his transc tion was p reviously marked as NOT FIXABL E, mark it again wi
	3336	th today's date
	3337	"RTN","PRC ACPSA",103 ,0)
	3338	...S TNLA ST=PRCATN
	3339	"RTN","PRC ACPSA",104 ,0)
	3340	; QUIT If no accept able trans action cou ld be foun d
	3341	"RTN","PRC ACPSA",105 ,0)
	3342	Q:+TNLAST <1
	3343	"RTN","PRC ACPSA",106 ,0)
	3344	; QUIT if this tran saction do esn't exis t for some reason
	3345	"RTN","PRC ACPSA",107 ,0)
	3346	Q:'$D(^PR CA(433,TNL AST,0))
	3347	"RTN","PRC ACPSA",108 ,0)
	3348	; Call UP DTSET to u pdate the transactio n that was identifie d
	3349	"RTN","PRC ACPSA",109 ,0)
	3350	D UPDTSET (TNLAST)
	3351	"RTN","PRC ACPSA",110 ,0)
	3352	Q
	3353	"RTN","PRC ACPSA",111 ,0)
	3354	;
	3355	"RTN","PRC ACPSA",112 ,0)
	3356	UPDTSET(TN LAST) ; On ce transac tion has b een identi fied, set the necess ary audit
	3357	fields
	3358	"RTN","PRC ACPSA",113 ,0)
	3359	; Identif y Bill for this Tran saction
	3360	"RTN","PRC ACPSA",114 ,0)
	3361	S PRCABIL L=$P($G(^P RCA(433,TN LAST,0)),U ,2)
	3362	"RTN","PRC ACPSA",115 ,0)
	3363	; Quit if bill can' t be ident ified
	3364	"RTN","PRC ACPSA",116 ,0)
	3365	Q:PRCABIL L=""
	3366	"RTN","PRC ACPSA",117 ,0)
	3367	; Use Bil l to ident ify Debtor
	3368	"RTN","PRC ACPSA",118 ,0)
	3369	S PRCADTR =$P($G(^PR CA(430,PRC ABILL,0)), U,9)
	3370	"RTN","PRC ACPSA",119 ,0)
	3371	; Quit if Debtor ca n't be def ined
	3372	"RTN","PRC ACPSA",120 ,0)
	3373	Q:PRCADTR =""
	3374	"RTN","PRC ACPSA",121 ,0)
	3375	; Quit if the stop flag for t his bill w as previou sly set in $$BILLQUI T^PRCACPS
	3376	A
	3377	"RTN","PRC ACPSA",122 ,0)
	3378	I $P($G(^ TMP("PRCAB ILL",$J,PR CADTR,PRCA BILL)),U,3 ) Q
	3379	"RTN","PRC ACPSA",123 ,0)
	3380	; Get cur rent date
	3381	"RTN","PRC ACPSA",124 ,0)
	3382	D NOW^%DT C
	3383	"RTN","PRC ACPSA",125 ,0)
	3384	N PRCADAT E
	3385	"RTN","PRC ACPSA",126 ,0)
	3386	S PRCADAT E=X
	3387	"RTN","PRC ACPSA",127 ,0)
	3388	; Set up Audit Fiel d Array
	3389	"RTN","PRC ACPSA",128 ,0)
	3390	S PRCAFDA (433,TNLAS T_",",94)= PRCADATE
	3391	"RTN","PRC ACPSA",129 ,0)
	3392	S PRCAFDA (433,TNLAS T_",",96)= "X" ; NOT FIXABLE
	3393	"RTN","PRC ACPSA",130 ,0)
	3394	S PRCAFDA (433,TNLAS T_",",97)= 1
	3395	"RTN","PRC ACPSA",131 ,0)
	3396	L +^PRCA( 433,TNLAST ,9):DILOCK TM
	3397	"RTN","PRC ACPSA",132 ,0)
	3398	; QUIT if lock not obtainable
	3399	"RTN","PRC ACPSA",133 ,0)
	3400	Q:'$T
	3401	"RTN","PRC ACPSA",134 ,0)
	3402	; Update record
	3403	"RTN","PRC ACPSA",135 ,0)
	3404	D FILE^DI E(,"PRCAFD A")
	3405	"RTN","PRC ACPSA",136 ,0)
	3406	; Unlock file
	3407	"RTN","PRC ACPSA",137 ,0)
	3408	L -^PRCA( 433,TNLAST ,9)
	3409	"RTN","PRC ACPSA",138 ,0)
	3410	Q
	3411	"RTN","PRC ASER1")
	3412	0^3^B18562 527^B16741 481
	3413	"RTN","PRC ASER1",1,0 )
	3414	PRCASER1 ; WASH-ISC@A LTOONA,PA/ RGY-Accept transacti on from bi lling engi ne ;9/8/9
	3415	3 2:21 PM
	3416	"RTN","PRC ASER1",2,0 )
	3417	V ;;4.5;Ac counts Rec eivable; 48,104,165 ,233,301,3 07;Mar 2 0, 1995;Bu ild 79
	3418	"RTN","PRC ASER1",3,0 )
	3419	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3420	"RTN","PRC ASER1",4,0 )
	3421	NEW AMT,A MT1,PRCAER R,PRCABN,P RCADJ,X1,X MDUZ,XMSUB ,XMTEXT,XM Y,DEBT
	3422	"RTN","PRC ASER1",5,0 )
	3423	I '$D(X) S PRCAERR= "-1^PRCA02 0" G Q
	3424	"RTN","PRC ASER1",6,0 )
	3425	I $O(^PRC A(430.3,"A C",+X,0))' ?1N.N,$P($ G(^PRCA(43 0.3,+X,0)) ,"^",3)'=2 1 S PRCAE
	3426	RR="-1^PRC A021" G Q
	3427	"RTN","PRC ASER1",7,0 )
	3428	I +X'=21, $P($G(^PRC A(430.3,+X ,0)),"^",3 )'=21 S PR CAERR="-1^ PRCA022" G Q
	3429	"RTN","PRC ASER1",8,0 )
	3430	I $P(X,"^ ",2)'?.N.1 ".".2N S P RCAERR="-1 ^PRCA023" G Q
	3431	"RTN","PRC ASER1",9,0 )
	3432	I $P(X,"^ ",2)'>0 S PRCAERR="- 1^PRCA017" G Q
	3433	"RTN","PRC ASER1",10, 0)
	3434	I $P(X,"^ ",3)="" S PRCAERR="- 1^PRCA006" G Q
	3435	"RTN","PRC ASER1",11, 0)
	3436	S PRCABN= $O(^PRCA(4 30,"B",$P( X,"^",3),0 )) I $G(^P RCA(430,+P RCABN,0))= "" S PRCA
	3437	ERR="-1^PR CA007" G Q
	3438	"RTN","PRC ASER1",12, 0)
	3439	I '$D(^VA (200,+$P(X ,"^",4),0) ) S PRCAER R="-1^PRCA 013" G Q
	3440	"RTN","PRC ASER1",13, 0)
	3441	I $P(X,"^ ",5)'?7N S PRCAERR=" -1^PRCA024 " G Q
	3442	"RTN","PRC ASER1",14, 0)
	3443	S (AMT1,A MT)=$P(X," ^",2)
	3444	"RTN","PRC ASER1",15, 0)
	3445	D DEC(PRC ABN,.AMT,$ P(X,"^",4) ,$P(X,U,6) ,$P(X,U,5) )
	3446	"RTN","PRC ASER1",16, 0)
	3447	S XMDUZ=" AR Package ",XMTEXT=" X1(",DEBT= $P($G(^PRC A(430,PRCA BN,0)),"^" ,9),DEBT=
	3448	$E($$NAM^R CFN01(DEBT ),1)_" ("_ $E($$SSN^R CFN01(DEBT ),6,9)_")"
	3449	"RTN","PRC ASER1",17, 0)
	3450	I AMT'=AM T1 S X1(1) ="A decrea se adjustm ent for bi ll/Pt name (SSN) #"_ $P(X,"^",
	3451	3)_"/"_DEB T_" has be en",XMSUB= "Automatic Adj: "_$P (X,"^",3)
	3452	"RTN","PRC ASER1",18, 0)
	3453	I AMT=AMT 1 S X1(1)= "**** NOTI CE: A decr ease adjus tment for bill/Pt na me (SSN)
	3454	#"_$P(X,U, 3)_"/"_DEB T,XMSUB="M anual Adj: "_$P(X,U, 3),X1(3)=" "
	3455	"RTN","PRC ASER1",19, 0)
	3456	S Y=DT X ^DD("DD") S X1(2)=$S (AMT'=AMT1 :"automati cally",1:" needs to b e manuall
	3457	y")_" appl ied in the amount of $"_$J($S( AMT1=AMT:A MT1,1:AMT1 -AMT),0,2) _" on "_Y
	3458	_"."
	3459	"RTN","PRC ASER1",20, 0)
	3460	I AMT,AMT '=AMT1 S X 1(3)="Plea se review bill for p roper appl ication of the unap
	3461	plied amou nt of $"_$ J(AMT,0,2) _"."
	3462	"RTN","PRC ASER1",21, 0)
	3463	S X1(4)=" ",X1(5)=" Data sent from Servi ce"
	3464	"RTN","PRC ASER1",22, 0)
	3465	S X1(6)=" Am ount: $"_$ J(AMT1,0,2 )
	3466	"RTN","PRC ASER1",23, 0)
	3467	S Y=$P(X, U,5) X ^DD ("DD") S X 1(7)=" Date : "_Y
	3468	"RTN","PRC ASER1",24, 0)
	3469	S X1(8)=" Re ason: "_$S ($P(X,"^", 6)]"":$P(X ,"^",6),1: "N/A")
	3470	"RTN","PRC ASER1",25, 0)
	3471	S X1(9)=" Adjustmen t by: "_$P ($G(^VA(20 0,+$P(X,"^ ",4),0))," ^")
	3472	"RTN","PRC ASER1",26, 0)
	3473	S AMT=0 F X=1:1:5 S AMT=AMT+$ P($G(^PRCA (430,PRCAB N,7)),U,X)
	3474	"RTN","PRC ASER1",27, 0)
	3475	S AMT1=AM T-+$G(^PRC A(430,PRCA BN,7))
	3476	"RTN","PRC ASER1",28, 0)
	3477	S X=$P(^P RCA(430.3, +$P($G(^PR CA(430,PRC ABN,0)),U, 8),0),U,1)
	3478	"RTN","PRC ASER1",29, 0)
	3479	S X1(10)= " ",X1(12) =" ",X1(13 )="Bill st atus is "_ $S(XMSUB[" Auto":"now ",1:"")_
	3480	X_" with a balance o f $"_$J(AM T,0,2)_"." ,X1(14)=" "
	3481	"RTN","PRC ASER1",30, 0)
	3482	I AMT1>0 S X1(15)=" WARNING There is outstandi ng adminis trative ch arges of
	3483	$"_$J(AMT1 ,0,2)_".", X1(16)=" An adjustm ent of adm inistrativ e charges
	3484	MAY need to be done ."
	3485	"RTN","PRC ASER1",31, 0)
	3486	S XMY("G. PRCA ADJUS TMENT TRAN S")=""
	3487	"RTN","PRC ASER1",32, 0)
	3488	D ^XMD
	3489	"RTN","PRC ASER1",33, 0)
	3490	Q S Y=$S($ D(PRCAERR) :PRCAERR,1 :0) Q
	3491	"RTN","PRC ASER1",34, 0)
	3492	;
	3493	"RTN","PRC ASER1",35, 0)
	3494	DEC(PRCABN ,AMT,APR,R EA,BDT,PRC AEN) ;Auto decrease from servi ce Bill#,T ran amt,p
	3495	erson,reas on,Tran da te
	3496	"RTN","PRC ASER1",36, 0)
	3497	NEW BAL,D A,DIC,DIE, DR,ERR,PRC A,PRCAA2,P RCAMT,PRCA SV,X,Y,PRC ADUP ; PRC A4.5307
	3498	- New PRC ADUP then initialize next line
	3499	"RTN","PRC ASER1",37, 0)
	3500	S PRCADUP =0
	3501	"RTN","PRC ASER1",38, 0)
	3502	; PRCA4. 5307 - If reason is TIER RATE check for duplicate
	3503	"RTN","PRC ASER1",39, 0)
	3504	I REA["TI ER RATE" D DUPCHK
	3505	"RTN","PRC ASER1",40, 0)
	3506	S PRCAEN= "",BAL=+$G (^PRCA(430 ,PRCABN,7) ) I 'BAL Q
	3507	"RTN","PRC ASER1",41, 0)
	3508	I $P(^PRC A(430,PRCA BN,0),U,8) '=$O(^PRCA (430.3,"AC ",102,"")) ,$P(^PRCA( 430,PRCAB
	3509	N,0),U,8)' =$O(^PRCA( 430.3,"AC" ,112,"")) Q
	3510	"RTN","PRC ASER1",42, 0)
	3511	I $P(^PRC A(430,PRCA BN,0),U,2) =$O(^PRCA( 430.2,"AC" ,33,0)) Q
	3512	"RTN","PRC ASER1",43, 0)
	3513	S BAL=$S( AMT>BAL:BA L,1:AMT)
	3514	"RTN","PRC ASER1",44, 0)
	3515	S PRCA("A DJ")=$O(^P RCA(430.3, "AC",21,0) ),PRCASV(" FY")=$$FY^ RCFN01(DT) _U_BAL,PR
	3516	CASV("APR" )=APR,PRCA SV("BDT")= $S($G(BDT) >0:BDT,1:D T)
	3517	"RTN","PRC ASER1",45, 0)
	3518	D SETTR^P RCAUTL,PAT TR^PRCAUTL S DIE="^P RCA(433,", DR="[PRCA FY ADJ2 BA TCH]",DA=
	3519	PRCAEN D ^ DIE
	3520	"RTN","PRC ASER1",46, 0)
	3521	S PRCAA2= $P(^PRCA(4 33,PRCAEN, 4,0),U,3) D UPFY^PRC ADJ,TRANUP ^PRCAUTL
	3522	"RTN","PRC ASER1",47, 0)
	3523	I ("^30^3 1^")[("^"_ $P($G(^PRC A(430,PRCA BN,0)),"^" ,2)_"^") D EN^PRCAFB DM(PRCABN
	3524	,BAL,PRCA( "ADJ"),$G( PRCADJ("BD T")),PRCAE N,.ERR)
	3525	"RTN","PRC ASER1",48, 0)
	3526	D UPPRIN^ PRCADJ
	3527	"RTN","PRC ASER1",49, 0)
	3528	I "AutoAU TO"'[$E(RE A,1,4) S R EA="Auto D ec.: "_REA
	3529	"RTN","PRC ASER1",50, 0)
	3530	S DA=PRCA EN,DIE="^P RCA(433,", DR="41///" _REA D ^DI E
	3531	"RTN","PRC ASER1",51, 0)
	3532	; PRCA4. 5307 - Ma rk Incompl ete Transa ction if d uplicate, blocking f rom Patie
	3533	nt Stateme nt
	3534	"RTN","PRC ASER1",52, 0)
	3535	I PRCADUP S DR="10/ ///1" D ^D IE
	3536	"RTN","PRC ASER1",53, 0)
	3537	S AMT=AMT -+$P($G(^P RCA(433,PR CAEN,1)),U ,5)
	3538	"RTN","PRC ASER1",54, 0)
	3539	I PRCAEN, $D(^PRCA(4 30,"TCSP", PRCABN)) D DECADJ^RC TCSPU(PRCA BN,PRCAEN) ;prca*4.
	3540	5*301 add cs decreas e adjustme nt 5B
	3541	"RTN","PRC ASER1",55, 0)
	3542	Q
	3543	"RTN","PRC ASER1",56, 0)
	3544	;
	3545	"RTN","PRC ASER1",57, 0)
	3546	DUPCHK ;PR CA4.5307 - Check f or duplica te (lower/ higher) se t PRCADUP if true
	3547	"RTN","PRC ASER1",58, 0)
	3548	N PRCATX, PRCAII,PRC ATRN
	3549	"RTN","PRC ASER1",59, 0)
	3550	S PRCATX= $P(^PRCA(4 33,0),U,3)
	3551	"RTN","PRC ASER1",60, 0)
	3552	F PRCAII= PRCATX-20: 1:PRCATX D Q:PRCADU P
	3553	"RTN","PRC ASER1",61, 0)
	3554	. S PRCAT RN=$G(^PRC A(433,PRCA II,1)) I $ P(PRCATRN, U,5)'=AMT Q
	3555	"RTN","PRC ASER1",62, 0)
	3556	. I $P($G (^PRCA(433 ,PRCAII,0) ),U,2)'=PR CABN Q
	3557	"RTN","PRC ASER1",63, 0)
	3558	. I $P($G (^PRCA(433 ,PRCAII,0) ),U,9)'=AP R Q
	3559	"RTN","PRC ASER1",64, 0)
	3560	. I $P(PR CATRN,U)'= BDT Q
	3561	"RTN","PRC ASER1",65, 0)
	3562	. S PRCAD UP=PRCAII
	3563	"RTN","PRC ASER1",66, 0)
	3564	Q
	3565	"RTN","RCC PCBJ")
	3566	0^5^B75092 78^B628849 1
	3567	"RTN","RCC PCBJ",1,0)
	3568	RCCPCBJ ;W ASH-ISC@AL TOONA,PA/N YB-Backgro und Driver for CCPC ;1/7/97 9 :42 AM
	3569	"RTN","RCC PCBJ",2,0)
	3570	;;4.5;Acc ounts Rece ivable;3 4,76,130,1 53,166,195 ,217,237,3 07;Mar 2 0, 1995;B
	3571	uild 79
	3572	"RTN","RCC PCBJ",3,0)
	3573	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	3574	"RTN","RCC PCBJ",4,0)
	3575	EN ;Starts the backg round job for CCPC 5 days befo re stateme nt day
	3576	"RTN","RCC PCBJ",5,0)
	3577	N X,X1,X2 ,X3,ZTRTN, ZTIO,ZTDTH ,ZTSK,ZTDE SC
	3578	"RTN","RCC PCBJ",6,0)
	3579	D ACK
	3580	"RTN","RCC PCBJ",7,0)
	3581	I $$DOW^X LFDT(DT,1) =3 D ;run the cbs a uto-correc tion progr am on wedn esdays
	3582	"RTN","RCC PCBJ",8,0)
	3583	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	3584	"RTN","RCC PCBJ",9,0)
	3585	.S ZTIO=" ",ZTRTN="S TART^PRCAC PS"
	3586	"RTN","RCC PCBJ",10,0 )
	3587	.S ZTDESC ="PATIENT STATEMENTS AUTO-CORR ECTION PRO GRAM",ZTDT H=$H
	3588	"RTN","RCC PCBJ",11,0 )
	3589	.D ^%ZTLO AD
	3590	"RTN","RCC PCBJ",12,0 )
	3591	;
	3592	"RTN","RCC PCBJ",13,0 )
	3593	S X1=$$ST D^RCCPCFN, X2=-2 D C^ %DTC
	3594	"RTN","RCC PCBJ",14,0 )
	3595	;10-proce ss end tim e/18-ccpc file built
	3596	"RTN","RCC PCBJ",15,0 )
	3597	I X=DT D Q
	3598	"RTN","RCC PCBJ",16,0 )
	3599	. S X3=$O (^RCPS(349 .2,0)) Q:' X3
	3600	"RTN","RCC PCBJ",17,0 )
	3601	. Q:'$P($ P($G(^RCPS (349.2,X3, 0)),"^",10 ),".")
	3602	"RTN","RCC PCBJ",18,0 )
	3603	. Q:'$P($ G(^RCPS(34 9.2,X3,0)) ,"^",18)
	3604	"RTN","RCC PCBJ",19,0 )
	3605	. D EN^RC CPCML
	3606	"RTN","RCC PCBJ",20,0 )
	3607	;quit if date creat ed is yest erday's da te
	3608	"RTN","RCC PCBJ",21,0 )
	3609	S X1=$$ST D^RCCPCFN, X2=-1 D C^ %DTC
	3610	"RTN","RCC PCBJ",22,0 )
	3611	I X=DT D Q
	3612	"RTN","RCC PCBJ",23,0 )
	3613	. S X3=+$ O(^RCT(349 ,0))
	3614	"RTN","RCC PCBJ",24,0 )
	3615	. S X3=$P ($P($G(^RC T(349,X3,0 )),"^",11) ,".")
	3616	"RTN","RCC PCBJ",25,0 )
	3617	. S X1=DT ,X2=-1 D C ^%DTC
	3618	"RTN","RCC PCBJ",26,0 )
	3619	. I X=X3 Q
	3620	"RTN","RCC PCBJ",27,0 )
	3621	. D EN^RC CPCML
	3622	"RTN","RCC PCBJ",28,0 )
	3623	;
	3624	"RTN","RCC PCBJ",29,0 )
	3625	S X1=$$ST D^RCCPCFN, X2=-3 D C^ %DTC
	3626	"RTN","RCC PCBJ",30,0 )
	3627	I X'=DT Q
	3628	"RTN","RCC PCBJ",31,0 )
	3629	I DT'<$P( $G(^RC(342 ,1,30)),"^ ",1)&(DT'> $P($G(^RC( 342,1,30)) ,"^",2)) D ^RCEXINA
	3630	D
	3631	"RTN","RCC PCBJ",32,0 )
	3632	S ZTIO="" ,ZTRTN="OP EN^RCCPCBJ ",ZTDESC=" CCPC PATIE NT STATEME NT"
	3633	"RTN","RCC PCBJ",33,0 )
	3634	S ZTDTH=$ H D ^%ZTLO AD
	3635	"RTN","RCC PCBJ",34,0 )
	3636	Q
	3637	"RTN","RCC PCBJ",35,0 )
	3638	OPEN ;Upda te Open st atus bills to Active or Cancel lation sta tus
	3639	"RTN","RCC PCBJ",36,0 )
	3640	N DATE,DA Y,BN,DEBTO R,DA,DIE,D R,P,AMT
	3641	"RTN","RCC PCBJ",37,0 )
	3642	N ZTSAVE, ZTRTN,ZTDE SC,ZTASK,% ZIS,ZTDTH
	3643	"RTN","RCC PCBJ",38,0 )
	3644	S DATE=$$ STD^RCCPCF N,DAY=+$$S TDY^RCCPCF N,DEBTOR=0 F S DEBT OR=$O(^RCD (340,"AC"
	3645	,DAY,DEBTO R)) Q:'DEB TOR D
	3646	"RTN","RCC PCBJ",39,0 )
	3647	.S BN= 0 F S BN= $O(^PRCA(4 30,"AS",DE BTOR,$O(^P RCA(430.3, "AC",112,0 )),BN)) Q
	3648	:'BN D
	3649	"RTN","RCC PCBJ",40,0 )
	3650	..S AMT=0 F P =1:1:5 S A MT=$P($G(^ PRCA(430,+ BN,7)),"^" ,P)+AMT
	3651	"RTN","RCC PCBJ",41,0 )
	3652	..I $P($G(^PR CA(430,+BN ,0)),"^",2 )=$O(^PRCA (430.2,"AC ",33,0)),A MT Q
	3653	"RTN","RCC PCBJ",42,0 )
	3654	..S DIE="^PRC A(430,",DA =+BN,DR="8 ////^S X=" _$S(AMT:$O (^PRCA(430 .3,"AC",1
	3655	02,0)),1:$ O(^PRCA(43 0.3,"AC",1 11,0))) D ^DIE K DA, DIE,DR
	3656	"RTN","RCC PCBJ",43,0 )
	3657	..Q
	3658	"RTN","RCC PCBJ",44,0 )
	3659	.Q
	3660	"RTN","RCC PCBJ",45,0 )
	3661	;
	3662	"RTN","RCC PCBJ",46,0 )
	3663	; update patient a ccounts wi th interes t and admi n
	3664	"RTN","RCC PCBJ",47,0 )
	3665	N RCLASDA T
	3666	"RTN","RCC PCBJ",48,0 )
	3667	S RCLASDA T=DATE
	3668	"RTN","RCC PCBJ",49,0 )
	3669	I DT>3010 101 D FIRS TPTY^RCBEC HGS
	3670	"RTN","RCC PCBJ",50,0 )
	3671	D ^RCCPCP S
	3672	"RTN","RCC PCBJ",51,0 )
	3673	D REFUND
	3674	"RTN","RCC PCBJ",52,0 )
	3675	Q
	3676	"RTN","RCC PCBJ",53,0 )
	3677	;
	3678	"RTN","RCC PCBJ",54,0 )
	3679	;
	3680	"RTN","RCC PCBJ",55,0 )
	3681	REFUND ;Up date Open status PRE PAYMENT bi lls to REF UND REVIEW
	3682	"RTN","RCC PCBJ",56,0 )
	3683	S DEBTOR= 0,DAY=+$$S TDY^RCCPCF N
	3684	"RTN","RCC PCBJ",57,0 )
	3685	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	3686	"RTN","RCC PCBJ",58,0 )
	3687	.S BN= 0 F S BN= $O(^PRCA(4 30,"AS",DE BTOR,$O(^P RCA(430.3, "AC",112,0 )),BN)) Q
	3688	:'BN D
	3689	"RTN","RCC PCBJ",59,0 )
	3690	..I $P($G(^PR CA(430,+BN ,0)),"^",2 )=$O(^PRCA (430.2,"AC ",33,0)) S X=$$EN^P
	3691	RCARFU(+BN )
	3692	"RTN","RCC PCBJ",60,0 )
	3693	..Q
	3694	"RTN","RCC PCBJ",61,0 )
	3695	.Q
	3696	"RTN","RCC PCBJ",62,0 )
	3697	Q
	3698	"RTN","RCC PCBJ",63,0 )
	3699	;
	3700	"RTN","RCC PCBJ",64,0 )
	3701	ACK ;CHECK FOR ACKNO WLEDGEMENT S
	3702	"RTN","RCC PCBJ",65,0 )
	3703	N DEB,MSG ,NO,RCX,X, X1,X2
	3704	"RTN","RCC PCBJ",66,0 )
	3705	S X1=$$ST D^RCCPCFN, X2=DT D ^% DTC I X>3 D
	3706	"RTN","RCC PCBJ",67,0 )
	3707	.D TRANCH K^RCCPCSV1
	3708	"RTN","RCC PCBJ",68,0 )
	3709	Q
	3710	"RTN","RCD PBTLM")
	3711	0^9^B55886 735^B49476 140
	3712	"RTN","RCD PBTLM",1,0 )
	3713	RCDPBTLM ; WISC/RFJ - bill tran sactions L ist Manage r top rout ine ;1 Jun 99
	3714	"RTN","RCD PBTLM",2,0 )
	3715	;;4.5;Acc ounts Rece ivable;1 14,148,153 ,168,169,1 98,247,271 ,276,307 ;Mar 20,
	3716	1995;Build 79
	3717	"RTN","RCD PBTLM",3,0 )
	3718	;;Per VHA Directive 2004-038, this rout ine should not be mo dified.
	3719	"RTN","RCD PBTLM",4,0 )
	3720	;
	3721	"RTN","RCD PBTLM",5,0 )
	3722	; Referen ce to $$RE C^IBRFN su pported by DBIA 2031
	3723	"RTN","RCD PBTLM",6,0 )
	3724	;
	3725	"RTN","RCD PBTLM",7,0 )
	3726	; called from menu option (1 9)
	3727	"RTN","RCD PBTLM",8,0 )
	3728	;
	3729	"RTN","RCD PBTLM",9,0 )
	3730	N RCBILLD A,RCDPFXIT
	3731	"RTN","RCD PBTLM",10, 0)
	3732	;
	3733	"RTN","RCD PBTLM",11, 0)
	3734	F D Q:' RCBILLDA
	3735	"RTN","RCD PBTLM",12, 0)
	3736	. W !! S RCBILLDA =$$SELBILL
	3737	"RTN","RCD PBTLM",13, 0)
	3738	. I RCB ILLDA<1 S RCBILLDA=0 Q
	3739	"RTN","RCD PBTLM",14, 0)
	3740	. D EN^ VALM("RCDP TRANSACTI ONS LIST")
	3741	"RTN","RCD PBTLM",15, 0)
	3742	. ; fa st exit
	3743	"RTN","RCD PBTLM",16, 0)
	3744	. I $G( RCDPFXIT) S RCBILLDA =0
	3745	"RTN","RCD PBTLM",17, 0)
	3746	Q
	3747	"RTN","RCD PBTLM",18, 0)
	3748	;
	3749	"RTN","RCD PBTLM",19, 0)
	3750	;
	3751	"RTN","RCD PBTLM",20, 0)
	3752	INIT ; in itializati on for lis t manager list
	3753	"RTN","RCD PBTLM",21, 0)
	3754	; requir es rcbilld a
	3755	"RTN","RCD PBTLM",22, 0)
	3756	N ADMIN,D ATE,RCLINE ,RCLIST,RC TOTAL,RCTR AN,RCTRAND A
	3757	"RTN","RCD PBTLM",23, 0)
	3758	K ^TMP("R CDPBTLM",$ J),^TMP("V ALM VIDEO" ,$J)
	3759	"RTN","RCD PBTLM",24, 0)
	3760	;
	3761	"RTN","RCD PBTLM",25, 0)
	3762	; fast e xit
	3763	"RTN","RCD PBTLM",26, 0)
	3764	I $G(RCDP FXIT) S VA LMQUIT=1 Q
	3765	"RTN","RCD PBTLM",27, 0)
	3766	;
	3767	"RTN","RCD PBTLM",28, 0)
	3768	; set th e List Man ager line number
	3769	"RTN","RCD PBTLM",29, 0)
	3770	S RCLINE= 0
	3771	"RTN","RCD PBTLM",30, 0)
	3772	; set th e List Man ager trans action num ber
	3773	"RTN","RCD PBTLM",31, 0)
	3774	S RCTRAN= 0
	3775	"RTN","RCD PBTLM",32, 0)
	3776	;
	3777	"RTN","RCD PBTLM",33, 0)
	3778	; get tr ansactions and balan ce for bil l
	3779	"RTN","RCD PBTLM",34, 0)
	3780	S RCTOTAL =$$GETTRAN S(RCBILLDA )
	3781	"RTN","RCD PBTLM",35, 0)
	3782	;
	3783	"RTN","RCD PBTLM",36, 0)
	3784	S DATE="" F S DATE =$O(RCLIST (DATE)) Q: 'DATE D
	3785	"RTN","RCD PBTLM",37, 0)
	3786	. S RCT RANDA="" F S RCTRAN DA=$O(RCLI ST(DATE,RC TRANDA)) Q :RCTRANDA= "" D
	3787	"RTN","RCD PBTLM",38, 0)
	3788	. . S RCLINE=RC LINE+1
	3789	"RTN","RCD PBTLM",39, 0)
	3790	. . ;
	3791	"RTN","RCD PBTLM",40, 0)
	3792	. . ; create a n index ar ray for tr ansaction lookup in list
	3793	"RTN","RCD PBTLM",41, 0)
	3794	. . I RCTRANDA D
	3795	"RTN","RCD PBTLM",42, 0)
	3796	. . . S RCTRA N=RCTRAN+1
	3797	"RTN","RCD PBTLM",43, 0)
	3798	. . . S ^TMP( "RCDPBTLM" ,$J,"IDX", RCTRAN,RCT RAN)=RCTRA NDA
	3799	"RTN","RCD PBTLM",44, 0)
	3800	. . . D SET^R CDPAPLI(RC TRAN,RCLIN E,1,80,0,I ORVON,IORV OFF)
	3801	"RTN","RCD PBTLM",45, 0)
	3802	. . ;
	3803	"RTN","RCD PBTLM",46, 0)
	3804	. . D SET^RCDPA PLI($S(RCT RANDA:RCTR ANDA,1:" " ),RCLINE,4 ,80)
	3805	"RTN","RCD PBTLM",47, 0)
	3806	. . D SET^RCDPA PLI($E(DAT E,4,5)_"/" _$E(DATE,6 ,7)_"/"_$E (DATE,2,3) ,RCLINE,1
	3807	3,21)
	3808	"RTN","RCD PBTLM",48, 0)
	3809	. . D SET^RCDPA PLI($TR($P (RCLIST(DA TE,RCTRAND A),"^"),"A BCDEFGHIJK LMNOPQRST
	3810	UVWXYZ","a bcdefghijk lmnopqrstu vwxyz"),RC LINE,25,50 )
	3811	"RTN","RCD PBTLM",49, 0)
	3812	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),"^",2),9 ,2),RCLINE ,53,62)
	3813	"RTN","RCD PBTLM",50, 0)
	3814	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),"^",3),9 ,2),RCLINE ,62,71)
	3815	"RTN","RCD PBTLM",51, 0)
	3816	. . ; add mars hal fee an d court co st to crea te admin d ollars
	3817	"RTN","RCD PBTLM",52, 0)
	3818	. . S ADMIN=$P( RCLIST(DAT E,RCTRANDA ),"^",4)+$ P(RCLIST(D ATE,RCTRAN DA),"^",5
	3819	)+$P(RCLIS T(DATE,RCT RANDA),"^" ,6)
	3820	"RTN","RCD PBTLM",53, 0)
	3821	. . D SET^RCDPA PLI($J(ADM IN,9,2),RC LINE,71,80 )
	3822	"RTN","RCD PBTLM",54, 0)
	3823	;
	3824	"RTN","RCD PBTLM",55, 0)
	3825	; show t otals
	3826	"RTN","RCD PBTLM",56, 0)
	3827	S RCLINE= RCLINE+1
	3828	"RTN","RCD PBTLM",57, 0)
	3829	D SET^RCD PAPLI(" - --------
	3830	-------- - -------",R CLINE,1,80 )
	3831	"RTN","RCD PBTLM",58, 0)
	3832	S RCLINE= RCLINE+1
	3833	"RTN","RCD PBTLM",59, 0)
	3834	D SET^RCD PAPLI(" TOTAL BALA NCE FOR BI LL",RCLINE ,1,80)
	3835	"RTN","RCD PBTLM",60, 0)
	3836	D SET^RCD PAPLI($J($ P(RCTOTAL, "^",1),9,2 ),RCLINE,5 3,62)
	3837	"RTN","RCD PBTLM",61, 0)
	3838	D SET^RCD PAPLI($J($ P(RCTOTAL, "^",2),9,2 ),RCLINE,6 2,71)
	3839	"RTN","RCD PBTLM",62, 0)
	3840	D SET^RCD PAPLI($J($ P(RCTOTAL, "^",3)+$P( RCTOTAL,"^ ",4)+$P(RC TOTAL,"^", 5),9,2),R
	3841	CLINE,71,8 0)
	3842	"RTN","RCD PBTLM",63, 0)
	3843	;
	3844	"RTN","RCD PBTLM",64, 0)
	3845	; compar e totals t o what is stored in the file
	3846	"RTN","RCD PBTLM",65, 0)
	3847	N RCDATA7 ,RCFOUT
	3848	"RTN","RCD PBTLM",66, 0)
	3849	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
	3850	"RTN","RCD PBTLM",67, 0)
	3851	; for a write-off bill, the balance sh ould equal all zeros , for
	3852	"RTN","RCD PBTLM",68, 0)
	3853	; these bills, nod e 7 is the write-off amount, s o for the out of
	3854	"RTN","RCD PBTLM",69, 0)
	3855	; balanc e check to work, nod e 7 needs to be adju sted to al l zeros
	3856	"RTN","RCD PBTLM",70, 0)
	3857	I $P(^PRC A(430,RCBI LLDA,0),"^ ",8)=23 S RCDATA7="0 ^0^0^0^0"
	3858	"RTN","RCD PBTLM",71, 0)
	3859	I +$P(RCD ATA7,"^",1 )'=+$P(RCT OTAL,"^",1 ) S RCFOUT =1
	3860	"RTN","RCD PBTLM",72, 0)
	3861	I +$P(RCD ATA7,"^",2 )'=+$P(RCT OTAL,"^",2 ) S RCFOUT =1
	3862	"RTN","RCD PBTLM",73, 0)
	3863	I ($P(RCD ATA7,"^",3 )+$P(RCDAT A7,"^",4)+ $P(RCDATA7 ,"^",5))'= +$P(RCTOTA L,"^",3)
	3864	S RCFOUT=1
	3865	"RTN","RCD PBTLM",74, 0)
	3866	I $G(RCFO UT) D
	3867	"RTN","RCD PBTLM",75, 0)
	3868	. S RCL INE=RCLINE +1
	3869	"RTN","RCD PBTLM",76, 0)
	3870	. D SET ^RCDPAPLI( " ",RCLINE ,1,80)
	3871	"RTN","RCD PBTLM",77, 0)
	3872	. S RCL INE=RCLINE +1
	3873	"RTN","RCD PBTLM",78, 0)
	3874	. D SET ^RCDPAPLI( " STORED BALANCE FO R BILL ( INCORRECT )",RCLI NE,1,80)
	3875	"RTN","RCD PBTLM",79, 0)
	3876	. D SET ^RCDPAPLI( $J($P(RCDA TA7,"^",1) ,9,2),RCLI NE,53,62)
	3877	"RTN","RCD PBTLM",80, 0)
	3878	. D SET ^RCDPAPLI( $J($P(RCDA TA7,"^",2) ,9,2),RCLI NE,62,71)
	3879	"RTN","RCD PBTLM",81, 0)
	3880	. D SET ^RCDPAPLI( $J($P(RCDA TA7,"^",3) +$P(RCDATA 7,"^",4)+$ P(RCDATA7, "^",5),9,
	3881	2),RCLINE, 71,80)
	3882	"RTN","RCD PBTLM",82, 0)
	3883	;
	3884	"RTN","RCD PBTLM",83, 0)
	3885	; set va lmcnt to n umber of l ines in th e list
	3886	"RTN","RCD PBTLM",84, 0)
	3887	S VALMCNT =RCLINE
	3888	"RTN","RCD PBTLM",85, 0)
	3889	D HDR
	3890	"RTN","RCD PBTLM",86, 0)
	3891	Q
	3892	"RTN","RCD PBTLM",87, 0)
	3893	;
	3894	"RTN","RCD PBTLM",88, 0)
	3895	;
	3896	"RTN","RCD PBTLM",89, 0)
	3897	HDR ; hea der code f or list ma nager disp lay
	3898	"RTN","RCD PBTLM",90, 0)
	3899	; requir es rcbilld a
	3900	"RTN","RCD PBTLM",91, 0)
	3901	N %,DATA, RCDEBTDA,R CDPDATA
	3902	"RTN","RCD PBTLM",92, 0)
	3903	;
	3904	"RTN","RCD PBTLM",93, 0)
	3905	D DIQ430^ RCDPBPLM(R CBILLDA,". 01;8;")
	3906	"RTN","RCD PBTLM",94, 0)
	3907	;
	3908	"RTN","RCD PBTLM",95, 0)
	3909	S RCDEBTD A=$P(^PRCA (430,RCBIL LDA,0),"^" ,9)
	3910	"RTN","RCD PBTLM",96, 0)
	3911	S DATA=$$ ACCNTHDR^R CDPAPLM(RC DEBTDA)
	3912	"RTN","RCD PBTLM",97, 0)
	3913	;
	3914	"RTN","RCD PBTLM",98, 0)
	3915	S %="",$P (%," ",80) =""
	3916	"RTN","RCD PBTLM",99, 0)
	3917	; PRCA4. 5276 - ge t EEOB ind icator for 1st/3rd p arty payme nt and att ach to bi
	3918	ll when ap plicable
	3919	"RTN","RCD PBTLM",100 ,0)
	3920	S PRCOUT= $$COMP3^PR CAAPR(RCBI LLDA)
	3921	"RTN","RCD PBTLM",101 ,0)
	3922	I PRCOUT' ="%" S PRC OUT=$$IBEE OBCK^PRCAA PR1(RCBILL DA)
	3923	"RTN","RCD PBTLM",102 ,0)
	3924	S VALMHDR (1)=$E("Bi ll #: "_$G (PRCOUT)_$ G(RCDPDATA (430,RCBIL LDA,.01,"E "))_%,1,2
	3925	5)_"Accoun t: "_$P(DA TA,"^")_$P (DATA,"^", 2)
	3926	"RTN","RCD PBTLM",103 ,0)
	3927	S VALMHDR (2)=$E("St atus: "_$G (RCDPDATA( 430,RCBILL DA,8,"E")) _%,1,25)_$ E(" Add
	3928	r: "_$P(DA TA,"^",4)_ ", "_$P(DA TA,"^",7)_ ", "_$P(DA TA,"^",8)_ " "_$P(DA TA,"^",9)
	3929	_%,1,55)
	3930	"RTN","RCD PBTLM",104 ,0)
	3931	; PRCA4. 5276 - sh ow caption for user
	3932	"RTN","RCD PBTLM",105 ,0)
	3933	S VALMSG= "\|% EEOB \| Enter ?? for more a ctions \|" ; PRCA4.5 276
	3934	"RTN","RCD PBTLM",106 ,0)
	3935	Q
	3936	"RTN","RCD PBTLM",107 ,0)
	3937	S VALMHDR (3)=" "_I ORVON_$E(" Bill Balan ce: "_$J($ P(RCTOTAL, "^")+$P(RC TOTAL,"^"
	3938	,2)+$P(RCT OTAL,"^",3 )+$P(RCTOT AL,"^",4)+ $P(RCTOTAL ,"^",5),0, 2)_%,1,23) _IORVOFF_
	3939	" Phone: "_$P(DATA, "^",10)
	3940	"RTN","RCD PBTLM",108 ,0)
	3941	Q
	3942	"RTN","RCD PBTLM",109 ,0)
	3943	;
	3944	"RTN","RCD PBTLM",110 ,0)
	3945	;
	3946	"RTN","RCD PBTLM",111 ,0)
	3947	EXIT ; ex it list ma nager opti on and cle an up
	3948	"RTN","RCD PBTLM",112 ,0)
	3949	K ^TMP("R CDPBTLM",$ J),^TMP("R CDPBTLMX", $J)
	3950	"RTN","RCD PBTLM",113 ,0)
	3951	Q
	3952	"RTN","RCD PBTLM",114 ,0)
	3953	;
	3954	"RTN","RCD PBTLM",115 ,0)
	3955	;
	3956	"RTN","RCD PBTLM",116 ,0)
	3957	SELBILL() ; select a bill
	3958	"RTN","RCD PBTLM",117 ,0)
	3959	; return s -1 for t imeout or ^, 0 for n o selectio n, or ien of bill
	3960	"RTN","RCD PBTLM",118 ,0)
	3961	N %,%Y,C, DIC,DTOUT, DUOUT,RCBE FLUP,X,Y
	3962	"RTN","RCD PBTLM",119 ,0)
	3963	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	3964	"RTN","RCD PBTLM",120 ,0)
	3965	N RCY,DIR ,DIRUT
	3966	"RTN","RCD PBTLM",121 ,0)
	3967	; allow u ser to get the recor d using bi ll# or ECM E#
	3968	"RTN","RCD PBTLM",122 ,0)
	3969	S DIR("A" )="Select (B)ILL or (E)CME#: "
	3970	"RTN","RCD PBTLM",123 ,0)
	3971	S DIR(0)= "SA^B:BILL NUMBER;E: ECME#"
	3972	"RTN","RCD PBTLM",124 ,0)
	3973	S DIR("B" )="B"
	3974	"RTN","RCD PBTLM",125 ,0)
	3975	D ^DIR K DIR I $D(D IRUT) Q 0
	3976	"RTN","RCD PBTLM",126 ,0)
	3977	S RCY=Y
	3978	"RTN","RCD PBTLM",127 ,0)
	3979	I RCY="E" Q $$SELEC ME
	3980	"RTN","RCD PBTLM",128 ,0)
	3981	S DIC="^P RCA(430,", DIC(0)="QE AM",DIC("A ")="Select BILL: "
	3982	"RTN","RCD PBTLM",129 ,0)
	3983	S DIC("W" )="D DICW^ RCBEUBI1"
	3984	"RTN","RCD PBTLM",130 ,0)
	3985	; specia l lookup o n input
	3986	"RTN","RCD PBTLM",131 ,0)
	3987	S RCBEFLU P=1
	3988	"RTN","RCD PBTLM",132 ,0)
	3989	D ^DIC
	3990	"RTN","RCD PBTLM",133 ,0)
	3991	I Y<0,'$G (DUOUT),'$ G(DTOUT) S Y=0
	3992	"RTN","RCD PBTLM",134 ,0)
	3993	Q +Y
	3994	"RTN","RCD PBTLM",135 ,0)
	3995	;
	3996	"RTN","RCD PBTLM",136 ,0)
	3997	;
	3998	"RTN","RCD PBTLM",137 ,0)
	3999	GETTRANS(B ILLDA) ; original a mount goes first for bill
	4000	"RTN","RCD PBTLM",138 ,0)
	4001	; return s list of transactio ns in
	4002	"RTN","RCD PBTLM",139 ,0)
	4003	; rclist (date,tran da)=tranty pe ^ princ iple ^ int erest ^ ad min
	4004	"RTN","RCD PBTLM",140 ,0)
	4005	; return s principl e balance ^ interest balance ^ admin bal ance
	4006	"RTN","RCD PBTLM",141 ,0)
	4007	; ^ marshall fee balan ce ^ court cost bala nce
	4008	"RTN","RCD PBTLM",142 ,0)
	4009	N %,ADMBA L,AMTDISP, CCBAL,DATA 0,DATA1,DA TA9,DATE,I NTBAL,MFBA L,PRINBAL, RCDPDATA,
	4010	TRANDA,VAL UE
	4011	"RTN","RCD PBTLM",143 ,0)
	4012	;
	4013	"RTN","RCD PBTLM",144 ,0)
	4014	D DIQ430^ RCDPBPLM(B ILLDA,"3;6 0;")
	4015	"RTN","RCD PBTLM",145 ,0)
	4016	;
	4017	"RTN","RCD PBTLM",146 ,0)
	4018	K RCLIST
	4019	"RTN","RCD PBTLM",147 ,0)
	4020	S (ADMBAL ,CCBAL,INT BAL,MFBAL, PRINBAL)=0
	4021	"RTN","RCD PBTLM",148 ,0)
	4022	S PRINBAL =RCDPDATA( 430,BILLDA ,3,"I")
	4023	"RTN","RCD PBTLM",149 ,0)
	4024	; loop t ransaction and add t o list
	4025	"RTN","RCD PBTLM",150 ,0)
	4026	S TRANDA= 0 F S TRA NDA=$O(^PR CA(433,"C" ,BILLDA,TR ANDA)) Q:' TRANDA D
	4027	"RTN","RCD PBTLM",151 ,0)
	4028	. S DATA1 =$G(^PRCA( 433,TRANDA ,1))
	4029	"RTN","RCD PBTLM",152 ,0)
	4030	. S DATE= $P(DATA1," ^",9) I 'D ATE Q
	4031	"RTN","RCD PBTLM",153 ,0)
	4032	. ; Don't include t ransaction s that hav e the INCO MPLETE TRA NSACTION F LAG (#10)
	4033	set to YE S and
	4034	"RTN","RCD PBTLM",154 ,0)
	4035	. ; this transactio n was prev iously use d by the a uto-correc t program to correc
	4036	t an earli er issue. PRCA4.53 07
	4037	"RTN","RCD PBTLM",155 ,0)
	4038	. S DATA0 =$G(^PRCA( 433,TRANDA ,0))
	4039	"RTN","RCD PBTLM",156 ,0)
	4040	. S DATA9 =$G(^PRCA( 433,TRANDA ,9))
	4041	"RTN","RCD PBTLM",157 ,0)
	4042	. ; Check for Incom plete and previously fixed by auto-corre ct
	4043	"RTN","RCD PBTLM",158 ,0)
	4044	. I $P(DA TA0,U,10), ($P(DATA9, U,4)) S VA LUE="" Q
	4045	"RTN","RCD PBTLM",159 ,0)
	4046	. S VALUE =$$TRANVAL U(TRANDA) I VALUE="" Q
	4047	"RTN","RCD PBTLM",160 ,0)
	4048	. S RCLIS T($P(DATE, "."),TRAND A)=$P($G(^ PRCA(430.3 ,+$P(DATA1 ,"^",2),0) ),"^")_VA
	4049	LUE
	4050	"RTN","RCD PBTLM",161 ,0)
	4051	. ;
	4052	"RTN","RCD PBTLM",162 ,0)
	4053	. ; calc ulate bill 's balance
	4054	"RTN","RCD PBTLM",163 ,0)
	4055	. S PRINB AL=PRINBAL +$P(VALUE, "^",2)
	4056	"RTN","RCD PBTLM",164 ,0)
	4057	. S INTBA L=INTBAL+$ P(VALUE,"^ ",3)
	4058	"RTN","RCD PBTLM",165 ,0)
	4059	. S ADMBA L=ADMBAL+$ P(VALUE,"^ ",4)
	4060	"RTN","RCD PBTLM",166 ,0)
	4061	. S MFBAL =MFBAL+$P( VALUE,"^", 5)
	4062	"RTN","RCD PBTLM",167 ,0)
	4063	. S CCBAL =CCBAL+$P( VALUE,"^", 6)
	4064	"RTN","RCD PBTLM",168 ,0)
	4065	;
	4066	"RTN","RCD PBTLM",169 ,0)
	4067	S DATE=$G (RCDPDATA( 430,BILLDA ,60,"I"))
	4068	"RTN","RCD PBTLM",170 ,0)
	4069	; check to make su re activat ion date i s not grea ter than f irst trans action
	4070	"RTN","RCD PBTLM",171 ,0)
	4071	S %=$O(RC LIST(0)) I DATE>% S DATE=%
	4072	"RTN","RCD PBTLM",172 ,0)
	4073	S RCLIST( +$P(DATE," ."),0)="or iginal amo unt^"_RCDP DATA(430,B ILLDA,3,"I ")
	4074	"RTN","RCD PBTLM",173 ,0)
	4075	;
	4076	"RTN","RCD PBTLM",174 ,0)
	4077	Q PRINBAL _"^"_INTBA L_"^"_ADMB AL_"^"_MFB AL_"^"_CCB AL
	4078	"RTN","RCD PBTLM",175 ,0)
	4079	;
	4080	"RTN","RCD PBTLM",176 ,0)
	4081	;
	4082	"RTN","RCD PBTLM",177 ,0)
	4083	TRANVALU(T RANDA) ; return the transacti on value a s displaye d (with + or - sign
	4084	)
	4085	"RTN","RCD PBTLM",178 ,0)
	4086	N TYPE,VA LUE
	4087	"RTN","RCD PBTLM",179 ,0)
	4088	S VALUE=$ $TRANBAL^R CRJRCOT(TR ANDA)
	4089	"RTN","RCD PBTLM",180 ,0)
	4090	; no dol lars on tr ansaction
	4091	"RTN","RCD PBTLM",181 ,0)
	4092	I '$P(VAL UE,"^"),'$ P(VALUE,"^ ",2),'$P(V ALUE,"^",3 ),'$P(VALU E,"^",4),' $P(VALUE,
	4093	"^",5) Q " "
	4094	"RTN","RCD PBTLM",182 ,0)
	4095	; check type for p ayments, e tc, make v alues (-) to subtrac t
	4096	"RTN","RCD PBTLM",183 ,0)
	4097	S TYPE=$P ($G(^PRCA( 433,TRANDA ,1)),"^",2 )
	4098	"RTN","RCD PBTLM",184 ,0)
	4099	I TYPE=2! (TYPE=8)!( TYPE=9)!(T YPE=10)!(T YPE=11)!(T YPE=14)!(T YPE=29)!(T YPE=34)!(
	4100	TYPE=35)!( TYPE=41) D
	4101	"RTN","RCD PBTLM",185 ,0)
	4102	. S $P( VALUE,"^", 1)=-$P(VAL UE,"^",1)
	4103	"RTN","RCD PBTLM",186 ,0)
	4104	. S $P( VALUE,"^", 2)=-$P(VAL UE,"^",2)
	4105	"RTN","RCD PBTLM",187 ,0)
	4106	. S $P( VALUE,"^", 3)=-$P(VAL UE,"^",3)
	4107	"RTN","RCD PBTLM",188 ,0)
	4108	. S $P( VALUE,"^", 4)=-$P(VAL UE,"^",4)
	4109	"RTN","RCD PBTLM",189 ,0)
	4110	. S $P( VALUE,"^", 5)=-$P(VAL UE,"^",5)
	4111	"RTN","RCD PBTLM",190 ,0)
	4112	;
	4113	"RTN","RCD PBTLM",191 ,0)
	4114	; the fo llowing tr ansaction types shou ld not cha nge the bi lls balanc e
	4115	"RTN","RCD PBTLM",192 ,0)
	4116	; return the amoun t displaye d in the d escription and 0 for value
	4117	"RTN","RCD PBTLM",193 ,0)
	4118	; refe r to RC 3, refer to DOJ 4, ree stablish 5 , returned 6 and 32
	4119	"RTN","RCD PBTLM",194 ,0)
	4120	; repa yment plan 25, amend ed 33, sus pended 47, unsuspend ed 46
	4121	"RTN","RCD PBTLM",195 ,0)
	4122	K AMTDISP
	4123	"RTN","RCD PBTLM",196 ,0)
	4124	I TYPE=3! (TYPE=4)!( TYPE=5)!(T YPE=6)!(TY PE=25)!(TY PE=32)!(TY PE=33)!(TY PE=46)!(T
	4125	YPE=47) D
	4126	"RTN","RCD PBTLM",197 ,0)
	4127	. S AMT DISP=" ($" _$J($P(VAL UE,"^")+$P (VALUE,"^" ,2)+$P(VAL UE,"^",3)+ $P(VALUE,
	4128	"^",4)+$P( VALUE,"^", 5),0,2)_") "
	4129	"RTN","RCD PBTLM",198 ,0)
	4130	. S VAL UE=""
	4131	"RTN","RCD PBTLM",199 ,0)
	4132	Q $G(AMTD ISP)_"^"_V ALUE
	4133	"RTN","RCD PBTLM",200 ,0)
	4134	;
	4135	"RTN","RCD PBTLM",201 ,0)
	4136	SELECME() ;
	4137	"RTN","RCD PBTLM",202 ,0)
	4138	; functio n takes th e user inp ut of the ECME # to return a v alid ien o f file 43
	4139	0
	4140	"RTN","RCD PBTLM",203 ,0)
	4141	; if an i nvalid ECM E is evalu ated then the proces s keeps as king the u ser for E
	4142	CME #
	4143	"RTN","RCD PBTLM",204 ,0)
	4144	; until a valid ECM E# is ente red or unt il the use r enters a "^" or nu ll value
	4145	"RTN","RCD PBTLM",205 ,0)
	4146	; output - returns the IEN of the recor d entry in the ACCOU NT RECEIVA BLE file
	4147	(#430) or "??"
	4148	"RTN","RCD PBTLM",206 ,0)
	4149	N RCECME, RCBILL,DIR ,DIRUT,Y
	4150	"RTN","RCD PBTLM",207 ,0)
	4151	S DIR(0)= "FO^1:12^I X'?1.12N W !!,""Can not contai n alpha ch aracters"" K X"
	4152	"RTN","RCD PBTLM",208 ,0)
	4153	S DIR("A" )="Select ECME#"
	4154	"RTN","RCD PBTLM",209 ,0)
	4155	RET D ^DIR I $D(DIRU T) Q 0
	4156	"RTN","RCD PBTLM",210 ,0)
	4157	S RCECME= $S(+Y>0:Y, 1:0)
	4158	"RTN","RCD PBTLM",211 ,0)
	4159	S RCBILL= $$REC^IBRF N(RCECME) ; IA 20 31
	4160	"RTN","RCD PBTLM",212 ,0)
	4161	I RCBILL< 0 W !!,"?? " G RET
	4162	"RTN","RCD PBTLM",213 ,0)
	4163	E W !!,$ P($G(^PRCA (430,+RCBI LL,0)),"^" )," "
	4164	"RTN","RCD PBTLM",214 ,0)
	4165	Q RCBILL
	4166	"RTN","RCD PBTLM",215 ,0)
	4167	;RCDPBTLM
	4168	"RTN","RCW ROFF")
	4169	0^4^B40151 788^B38468 960
	4170	"RTN","RCW ROFF",1,0)
	4171	RCWROFF ;W ISC/RFJ-wr ite off, t erminated ;1 Feb 200 0
	4172	"RTN","RCW ROFF",2,0)
	4173	;;4.5;Acc ounts Rece ivable;1 68,204,309 ,301,307 ;Mar 20, 1 995;Build 79
	4174	"RTN","RCW ROFF",3,0)
	4175	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4176	"RTN","RCW ROFF",4,0)
	4177	Q
	4178	"RTN","RCW ROFF",5,0)
	4179	;
	4180	"RTN","RCW ROFF",6,0)
	4181	;
	4182	"RTN","RCW ROFF",7,0)
	4183	8 ; termi nated by f iscal offi cer (trant ype=8) (me nu option)
	4184	"RTN","RCW ROFF",8,0)
	4185	N RCDRSTR G
	4186	"RTN","RCW ROFF",9,0)
	4187	S RCDRSTR G="11TERMI NATION DAT E;"
	4188	"RTN","RCW ROFF",10,0 )
	4189	S RCDRSTR G=RCDRSTRG _"17;" ;t ermination reason
	4190	"RTN","RCW ROFF",11,0 )
	4191	D MAIN("8 ^Fiscal Of ficer Term ination",R CDRSTRG)
	4192	"RTN","RCW ROFF",12,0 )
	4193	Q
	4194	"RTN","RCW ROFF",13,0 )
	4195	;
	4196	"RTN","RCW ROFF",14,0 )
	4197	;
	4198	"RTN","RCW ROFF",15,0 )
	4199	9 ; termi nated by c ompromise (trantype= 9) (menu o ption)
	4200	"RTN","RCW ROFF",16,0 )
	4201	N RCDRSTR G
	4202	"RTN","RCW ROFF",17,0 )
	4203	S RCDRSTR G="11TERMI NATION DAT E;"
	4204	"RTN","RCW ROFF",18,0 )
	4205	S RCDRSTR G=RCDRSTRG _"17;" ;t ermination reason
	4206	"RTN","RCW ROFF",19,0 )
	4207	D MAIN("9 ^Compromis e Terminat ion",RCDRS TRG)
	4208	"RTN","RCW ROFF",20,0 )
	4209	Q
	4210	"RTN","RCW ROFF",21,0 )
	4211	;
	4212	"RTN","RCW ROFF",22,0 )
	4213	;
	4214	"RTN","RCW ROFF",23,0 )
	4215	A9 ; comp romised by rc/doj (u se trantyp e=9) (menu option)
	4216	"RTN","RCW ROFF",24,0 )
	4217	N RCDRSTR G
	4218	"RTN","RCW ROFF",25,0 )
	4219	S RCDRSTR G="11TERMI NATION DAT E;"
	4220	"RTN","RCW ROFF",26,0 )
	4221	S RCDRSTR G=RCDRSTRG _"17;" ;t ermination reason
	4222	"RTN","RCW ROFF",27,0 )
	4223	D MAIN("9 ^Compromis e Terminat ion by RC/ DOJ",RCDRS TRG)
	4224	"RTN","RCW ROFF",28,0 )
	4225	Q
	4226	"RTN","RCW ROFF",29,0 )
	4227	;
	4228	"RTN","RCW ROFF",30,0 )
	4229	;
	4230	"RTN","RCW ROFF",31,0 )
	4231	10 ; waiv ed in full transacti on (tranty pe=10) (me nu option)
	4232	"RTN","RCW ROFF",32,0 )
	4233	D MAIN("1 0^Waiver", "11WAIVED DATE;")
	4234	"RTN","RCW ROFF",33,0 )
	4235	Q
	4236	"RTN","RCW ROFF",34,0 )
	4237	;
	4238	"RTN","RCW ROFF",35,0 )
	4239	;
	4240	"RTN","RCW ROFF",36,0 )
	4241	A10 ; wai ved by rc/ doj (use t rantype=10 ) (menu op tion)
	4242	"RTN","RCW ROFF",37,0 )
	4243	D MAIN("1 0^RC/DOJ W aiver","11 WAIVED DAT E;")
	4244	"RTN","RCW ROFF",38,0 )
	4245	Q
	4246	"RTN","RCW ROFF",39,0 )
	4247	;
	4248	"RTN","RCW ROFF",40,0 )
	4249	;
	4250	"RTN","RCW ROFF",41,0 )
	4251	29 ; term inated by rc/doj (tr antype=29) (menu opt ion)
	4252	"RTN","RCW ROFF",42,0 )
	4253	N RCDRSTR G
	4254	"RTN","RCW ROFF",43,0 )
	4255	S RCDRSTR G="11TERMI NATION DAT E;"
	4256	"RTN","RCW ROFF",44,0 )
	4257	S RCDRSTR G=RCDRSTRG _"17;" ;t ermination reason
	4258	"RTN","RCW ROFF",45,0 )
	4259	D MAIN("2 9^RC/DOJ T ermination ",RCDRSTRG )
	4260	"RTN","RCW ROFF",46,0 )
	4261	Q
	4262	"RTN","RCW ROFF",47,0 )
	4263	;
	4264	"RTN","RCW ROFF",48,0 )
	4265	;
	4266	"RTN","RCW ROFF",49,0 )
	4267	47 ; susp ended (tra ntype=47) (menu opti on)
	4268	"RTN","RCW ROFF",50,0 )
	4269	N RCDRSTR G
	4270	"RTN","RCW ROFF",51,0 )
	4271	S RCDRSTR G="11SUSPE NDED DATE; "
	4272	"RTN","RCW ROFF",52,0 )
	4273	S RCDRSTR G=RCDRSTRG _"90R;" ; suspension type
	4274	"RTN","RCW ROFF",53,0 )
	4275	S RCDRSTR G=RCDRSTRG _"S RCX=$$ SUSTP^RCWR OFF(X);"
	4276	"RTN","RCW ROFF",54,0 )
	4277	S RCDRSTR G=RCDRSTRG _"5.02//// ^S X=RCX;" ;brief c omment
	4278	"RTN","RCW ROFF",55,0 )
	4279	S RCDRSTR G=RCDRSTRG _"K RCX;"
	4280	"RTN","RCW ROFF",56,0 )
	4281	D MAIN("4 7^Suspensi on",RCDRST RG)
	4282	"RTN","RCW ROFF",57,0 )
	4283	Q
	4284	"RTN","RCW ROFF",58,0 )
	4285	;
	4286	"RTN","RCW ROFF",59,0 )
	4287	SUSTP(X) ; suspensio n types fo r brief co mment in * 309
	4288	"RTN","RCW ROFF",60,0 )
	4289	; input-c ode betwee n 0 to 11
	4290	"RTN","RCW ROFF",61,0 )
	4291	; output- text
	4292	"RTN","RCW ROFF",62,0 )
	4293	N IBX
	4294	"RTN","RCW ROFF",63,0 )
	4295	S IBX=$P( $T(SUSTX+X ),";;",2)
	4296	"RTN","RCW ROFF",64,0 )
	4297	Q IBX
	4298	"RTN","RCW ROFF",65,0 )
	4299	;
	4300	"RTN","RCW ROFF",66,0 )
	4301	SUSTX ;;NO T CO-PAY S USPENSION
	4302	"RTN","RCW ROFF",67,0 )
	4303	;;INITIAL CO-PAY WA IVER
	4304	"RTN","RCW ROFF",68,0 )
	4305	;;APPEAL CO-PAY WAI VER
	4306	"RTN","RCW ROFF",69,0 )
	4307	;;ADMINIS TRATIVE SU SPENSION
	4308	"RTN","RCW ROFF",70,0 )
	4309	;;COMPROM ISE
	4310	"RTN","RCW ROFF",71,0 )
	4311	;;TERMINA TION
	4312	"RTN","RCW ROFF",72,0 )
	4313	;;BANKRUP TCY CHAP 7
	4314	"RTN","RCW ROFF",73,0 )
	4315	;;BANKRUP TCY CHAP 1 3
	4316	"RTN","RCW ROFF",74,0 )
	4317	;;BANKRUP TCY OTHER
	4318	"RTN","RCW ROFF",75,0 )
	4319	;;PROBATE
	4320	"RTN","RCW ROFF",76,0 )
	4321	;;CHOICE
	4322	"RTN","RCW ROFF",77,0 )
	4323	;;DISPUTE
	4324	"RTN","RCW ROFF",78,0 )
	4325	;
	4326	"RTN","RCW ROFF",79,0 )
	4327	;
	4328	"RTN","RCW ROFF",80,0 )
	4329	MAIN(RCTRT YPE,RCDRST RG) ; mai n subrouti ne to proc ess a waiv er, termin ation, su
	4330	spended tr ansaction
	4331	"RTN","RCW ROFF",81,0 )
	4332	; rctrty pe = trans action typ e^descript ion, examp le 10^waiv er
	4333	"RTN","RCW ROFF",82,0 )
	4334	; rcdrst rg = dr st ring used when calli ng die
	4335	"RTN","RCW ROFF",83,0 )
	4336	N BALANCE ,DR,RCBILL DA,RCTRAND A,Y
	4337	"RTN","RCW ROFF",84,0 )
	4338	F D Q:R CBILLDA<1
	4339	"RTN","RCW ROFF",85,0 )
	4340	. K RCT RANDA ;do not leave around in for loop
	4341	"RTN","RCW ROFF",86,0 )
	4342	. ; se lect a bil l
	4343	"RTN","RCW ROFF",87,0 )
	4344	. S RCB ILLDA=$$GE TABILL^RCB EUBIL I RC BILLDA<1 Q
	4345	"RTN","RCW ROFF",88,0 )
	4346	. I $D( ^PRCA(430, "TCSP",RCB ILLDA)) W !,"BILL HA S BEEN REF ERRED TO C ROSS-SERV
	4347	ICING.",!, "NO TRANSA CTIONS ARE ALLOWED." D Q ;pr ca4.5301
	4348	"RTN","RCW ROFF",89,0 )
	4349	. . I +R CTRTYPE=10 !(+RCTRTYP E=47)!(+RC TRTYPE=9)! (+RCTRTYPE =8) W !,"* * THE REC
	4350	ALL PROCES S MUST BE UTILIZED P RIOR TO PE RFORMING T HIS FUNCTI ON *" ; prca4.5*
	4351	301
	4352	"RTN","RCW ROFF",90,0 )
	4353	. ; ch eck to see if bill h as been re ferred to rc/doj (6; 4 = referr al date)
	4354	"RTN","RCW ROFF",91,0 )
	4355	. I $P( RCTRTYPE," ^",2)["RC/ DOJ",$P($G (^PRCA(430 ,RCBILLDA, 6)),"^",4) ="" W !,"
	4356	THIS ACCOU NT IS NOT REFERRED T O RC/DOJ." Q
	4357	"RTN","RCW ROFF",92,0 )
	4358	. ; lo ck the bil l
	4359	"RTN","RCW ROFF",93,0 )
	4360	. L +^P RCA(430,RC BILLDA):5 I '$T W !, "ANOTHER U SER IS CUR RENTLY WOR KING WITH
	4361	THIS BILL ." Q
	4362	"RTN","RCW ROFF",94,0 )
	4363	. D SHO WBILL^RCWR OFF1(RCBIL LDA)
	4364	"RTN","RCW ROFF",95,0 )
	4365	. I '$G (^PRCA(430 ,RCBILLDA, 7)) W !,"T HIS BILL H AS NO PRIN CIPAL BALA NCE." D U
	4366	NLOCK Q
	4367	"RTN","RCW ROFF",96,0 )
	4368	. ; as k to enter transacti on
	4369	"RTN","RCW ROFF",97,0 )
	4370	. S Y=$ $ASKOK($P( RCTRTYPE," ^",2)) I Y '=1 D UNLO CK S:Y<0 R CBILLDA=0 Q
	4371	"RTN","RCW ROFF",98,0 )
	4372	. ; ad d a new tr ansaction to file 43 3
	4373	"RTN","RCW ROFF",99,0 )
	4374	. S RCT RANDA=$$AD D433^RCBEU TRA(RCBILL DA,$P(RCTR TYPE,"^")) I 'RCTRAN DA W !,$P
	4375	(RCTRANDA, "^",2) D U NLOCK Q
	4376	"RTN","RCW ROFF",100, 0)
	4377	. W !," Transact ion number ",RCTRAND A," added ..."
	4378	"RTN","RCW ROFF",101, 0)
	4379	. ;
	4380	"RTN","RCW ROFF",102, 0)
	4381	. ; se t up dr st ring for d ie call P RCA4.530 7 - Move c omment bel ow balanc
	4382	e sets
	4383	"RTN","RCW ROFF",103, 0)
	4384	. S DR= RCDRSTRG ;_"41;" ;comment
	4385	"RTN","RCW ROFF",104, 0)
	4386	. ; bi ll amount moved to t ransaction amount
	4387	"RTN","RCW ROFF",105, 0)
	4388	. S BAL ANCE=$P($G (^PRCA(430 ,RCBILLDA, 7)),"^",1, 5)
	4389	"RTN","RCW ROFF",106, 0)
	4390	. S DR= DR_"15//// "_($P(BALA NCE,"^")+$ P(BALANCE, "^",2)+$P( BALANCE,"^ ",3)+$P(B
	4391	ALANCE,"^" ,4)+$P(BAL ANCE,"^",5 ))_";"
	4392	"RTN","RCW ROFF",107, 0)
	4393	. I $P( BALANCE,"^ ",1) S DR= DR_"81//// "_+$P(BALA NCE,"^",1) _";" ;pr incipal
	4394	"RTN","RCW ROFF",108, 0)
	4395	. I $P( BALANCE,"^ ",2) S DR= DR_"82//// "_+$P(BALA NCE,"^",2) _";" ;in terest
	4396	"RTN","RCW ROFF",109, 0)
	4397	. I $P( BALANCE,"^ ",3) S DR= DR_"83//// "_+$P(BALA NCE,"^",3) _";" ;ad min
	4398	"RTN","RCW ROFF",110, 0)
	4399	. I $P( BALANCE,"^ ",4) S DR= DR_"84//// "_+$P(BALA NCE,"^",4) _";" ;ma rshal fee
	4400	"RTN","RCW ROFF",111, 0)
	4401	. I $P( BALANCE,"^ ",5) S DR= DR_"85//// "_+$P(BALA NCE,"^",5) _";" ;co urt cost
	4402	"RTN","RCW ROFF",112, 0)
	4403	. ;
	4404	"RTN","RCW ROFF",113, 0)
	4405	. ; PRC A4.5307 - Comment save is mo ved below balance se ts
	4406	"RTN","RCW ROFF",114, 0)
	4407	. S DR= DR_"41;"
	4408	"RTN","RCW ROFF",115, 0)
	4409	. ; ed it the fie lds
	4410	"RTN","RCW ROFF",116, 0)
	4411	. S Y=$ $EDIT433^R CBEUTRA(RC TRANDA,DR)
	4412	"RTN","RCW ROFF",117, 0)
	4413	. I 'Y W !,$P(Y," ^",2) D DE L433^RCBEU TRA(RCTRAN DA,"",0),U NLOCK Q
	4414	"RTN","RCW ROFF",118, 0)
	4415	. ; se t the bill and trans action as RC/DOJ
	4416	"RTN","RCW ROFF",119, 0)
	4417	. I $P( RCTRTYPE," ^",2)["RC/ DOJ" D SET RCDOJ^RCBE UBIL(RCBIL LDA,RCTRAN DA,"RC")
	4418	"RTN","RCW ROFF",120, 0)
	4419	. ; ch ange the s tatus of t he bill
	4420	"RTN","RCW ROFF",121, 0)
	4421	. I $P( RCTRTYPE," ^")'=47 D CHGSTAT^RC BEUBIL(RCB ILLDA,23) ;write of f
	4422	"RTN","RCW ROFF",122, 0)
	4423	. I $P( RCTRTYPE," ^")=47 D C HGSTAT^RCB EUBIL(RCBI LLDA,40) ;suspende d
	4424	"RTN","RCW ROFF",123, 0)
	4425	. ; ma rk transac tion as pr ocessed
	4426	"RTN","RCW ROFF",124, 0)
	4427	. D PRO CESS^RCBEU TRA(RCTRAN DA)
	4428	"RTN","RCW ROFF",125, 0)
	4429	. ;
	4430	"RTN","RCW ROFF",126, 0)
	4431	. ; cr eate fms w rite off d ocument, i f not accr ued and no t suspende d (47) tr
	4432	ansaction
	4433	"RTN","RCW ROFF",127, 0)
	4434	. I '$$ ACCK^PRCAA CC(RCBILLD A),$P($G(^ PRCA(433,R CTRANDA,1) ),"^",2)'= 47 D FMSD
	4435	OC(RCTRAND A)
	4436	"RTN","RCW ROFF",128, 0)
	4437	. ;
	4438	"RTN","RCW ROFF",129, 0)
	4439	. W !," * * * * * ",$P(RCT RTYPE,"^", 2)," has b een PROCES SED! * * * * *"
	4440	"RTN","RCW ROFF",130, 0)
	4441	. I '$G (REFMS)&(D T>$$LDATE^ RCRJR(DT)) S Y=$E($$ FPS^RCAMFN 01(DT,1),1 ,5)_"01"
	4442	D DD^%DT W !!," * * * * Tran smission w ill be hel d until "_ Y_" * * * *"
	4443	"RTN","RCW ROFF",131, 0)
	4444	. D UNL OCK
	4445	"RTN","RCW ROFF",132, 0)
	4446	Q
	4447	"RTN","RCW ROFF",133, 0)
	4448	;
	4449	"RTN","RCW ROFF",134, 0)
	4450	;
	4451	"RTN","RCW ROFF",135, 0)
	4452	FMSDOC(RCT RANDA) ; create fms write off document
	4453	"RTN","RCW ROFF",136, 0)
	4454	N Y
	4455	"RTN","RCW ROFF",137, 0)
	4456	W !!,"Cre ating FMS Write-off document . .. "
	4457	"RTN","RCW ROFF",138, 0)
	4458	S Y=$$BUI LDWR^RCXFM SW1(RCTRAN DA)
	4459	"RTN","RCW ROFF",139, 0)
	4460	I Y W $P( Y,"^",2)," created."
	4461	"RTN","RCW ROFF",140, 0)
	4462	E W "ERR OR: ",$P(Y ,"^",2)
	4463	"RTN","RCW ROFF",141, 0)
	4464	Q
	4465	"RTN","RCW ROFF",142, 0)
	4466	;
	4467	"RTN","RCW ROFF",143, 0)
	4468	;
	4469	"RTN","RCW ROFF",144, 0)
	4470	UNLOCK ; unlock bil l and tran saction
	4471	"RTN","RCW ROFF",145, 0)
	4472	L -^PRCA( 430,RCBILL DA)
	4473	"RTN","RCW ROFF",146, 0)
	4474	I $G(RCTR ANDA) L -^ PRCA(433,R CTRANDA)
	4475	"RTN","RCW ROFF",147, 0)
	4476	Q
	4477	"RTN","RCW ROFF",148, 0)
	4478	;
	4479	"RTN","RCW ROFF",149, 0)
	4480	;
	4481	"RTN","RCW ROFF",150, 0)
	4482	ASKOK(TRAN TYPE) ; a sk record transactio n
	4483	"RTN","RCW ROFF",151, 0)
	4484	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	4485	"RTN","RCW ROFF",152, 0)
	4486	S DIR(0)= "YO",DIR(" B")="NO"
	4487	"RTN","RCW ROFF",153, 0)
	4488	S DIR("A" )=" Are y ou sure yo u want to record thi s bill as a "
	4489	"RTN","RCW ROFF",154, 0)
	4490	I $L(TRAN TYPE)<20 S DIR("A")= DIR("A")_T RANTYPE
	4491	"RTN","RCW ROFF",155, 0)
	4492	E S DIR( "A",1)=DIR ("A"),DIR( "A")=" "_ TRANTYPE
	4493	"RTN","RCW ROFF",156, 0)
	4494	W ! D ^DI R
	4495	"RTN","RCW ROFF",157, 0)
	4496	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	4497	"RTN","RCW ROFF",158, 0)
	4498	Q Y
	4499	"VER")
	4500	8.0^22.0
	4501	"^DD",433, 433,94,0)
	4502	AUTO-CORRE CTION DATE ^D^^9;4^S %DT="EX" D ^%DT S X= Y K:Y<1 X
	4503	"^DD",433, 433,94,3)
	4504	Type the d ate that t he stateme nt discrep ancy was c orrected.
	4505	"^DD",433, 433,94,21, 0)
	4506	^^2^2^3160 428^
	4507	"^DD",433, 433,94,21, 1,0)
	4508	The is the date that the auto- correction program c orrected t he
	4509	"^DD",433, 433,94,21, 2,0)
	4510	statement discrepanc y for this transacti on.
	4511	"^DD",433, 433,94,"DT ")
	4512	3160920
	4513	"^DD",433, 433,95,0)
	4514	AUTO-CORRE CTION TRAN S. AMOUNT^ NJ9,2^^9;5 ^S:X["$" X =$P(X,"$", 2) K:X'?." -".N.1"."
	4515	.2N!(X>999 999)!(X<-9 99999) X
	4516	"^DD",433, 433,95,3)
	4517	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	4518	"^DD",433, 433,95,21, 0)
	4519	^.001^1^1^ 3160428^^
	4520	"^DD",433, 433,95,21, 1,0)
	4521	This is th e transact ion amount associate d with the statement discrepan cy.
	4522	"^DD",433, 433,95,"DT ")
	4523	3160428
	4524	"^DD",433, 433,96,0)
	4525	AUTO-CORRE CTION TYPE OF ERROR^ S^I:INCOMP LETE FLAG ERROR;D:DU PLICATE TR ANSACTION
	4526	;N:NULL TR ANSACTION AMOUNT;X:N OT FIXABLE ;^9;6^Q
	4527	"^DD",433, 433,96,3)
	4528	Type the k ind of sta tement dis crepancy e rror that was correc ted.
	4529	"^DD",433, 433,96,21, 0)
	4530	^^5^5^3161 004^
	4531	"^DD",433, 433,96,21, 1,0)
	4532	This field stores th e type of error that was corre cted
	4533	"^DD",433, 433,96,21, 2,0)
	4534	for the st atement di screpancy. The erro rs are thr ee
	4535	"^DD",433, 433,96,21, 3,0)
	4536	types: inc omplete fl ag error, a duplicat e transact ion,
	4537	"^DD",433, 433,96,21, 4,0)
	4538	a null tra nsaction a mount, or not fixabl e for all other
	4539	"^DD",433, 433,96,21, 5,0)
	4540	errors.
	4541	"^DD",433, 433,96,"DT ")
	4542	3161004
	4543	"^DD",433, 433,97,0)
	4544	AUTO-CORRE CTION TICK ET FLAG^S^ 1:YES;0:NO ;^9;7^Q
	4545	"^DD",433, 433,97,3)
	4546	Enter Yes if this tr ansaction will need to be manu ally revie wed and co rrected.
	4547	"^DD",433, 433,97,21, 0)
	4548	^^2^2^3161 027^
	4549	"^DD",433, 433,97,21, 1,0)
	4550	Flag notin g that thi s transact ion will n eed to be manually r eviewed an d
	4551	"^DD",433, 433,97,21, 2,0)
	4552	corrected.
	4553	"^DD",433, 433,97,"DT ")
	4554	3161027
	4555	"BLD",1015 3,6)
	4556	22^
	4557	$END KID P RCA4.530 7