2. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 6/14/2018 1:25:28 PM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

2.1 Files compared

#	Location	File	Last Modified
1	PRCA4.5313 TEST v15.zip	PRCA4.5313 TEST v15.KID	Tue Jun 12 19:31:16 2018 UTC
2	PRCA4.5313 TEST v15.zip	PRCA4.5313 TEST v15.KID	Tue Jun 12 19:40:40 2018 UTC

2.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	5	21570
Changed	4	8
Inserted	0	0
Removed	0	0

2.3 Comparison options

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

2.4 Active regular expressions

No regular expressions were active.

2.5 Comparison detail

	1
	2	Packman Ma il Message :
	3	========== ========== =
	4
	5	$END TXT
	6	$KID PRCA* 4.5*313
	7	INSTALL NAME
	8	PRCA4.53 13
	9	"BLD",1011 1,0)
	10	PRCA4.53 13^ACCOUNT S RECEIVAB LE^0^31803 08^y
	11	"BLD",1011 1,1,0)
	12	^^1^1^3160 811^^^^
	13	"BLD",1011 1,1,1,0)
	14	Consolidat ed Patient Statement
	15	"BLD",1011 1,4,0)
	16	^9.64PA^43 3^7
	17	"BLD",1011 1,4,340,0)
	18	340
	19	"BLD",1011 1,4,340,2, 0)
	20	^9.641^340 ^1
	21	"BLD",1011 1,4,340,2, 340,0)
	22	AR DEBTOR (File-top level)
	23	"BLD",1011 1,4,340,2, 340,1,0)
	24	^9.6411^.0 3^3
	25	"BLD",1011 1,4,340,2, 340,1,.01, 0)
	26	DEBTOR
	27	"BLD",1011 1,4,340,2, 340,1,.03, 0)
	28	STATEMENT DAY
	29	"BLD",1011 1,4,340,2, 340,1,7.06 ,0)
	30	CURRENT CB S DEBT AMO UNT
	31	"BLD",1011 1,4,340,22 2)
	32	y^n^p^^^^n ^^n
	33	"BLD",1011 1,4,340,22 4)
	34
	35	"BLD",1011 1,4,341,0)
	36	341
	37	"BLD",1011 1,4,341,2, 0)
	38	^9.641^341 ^1
	39	"BLD",1011 1,4,341,2, 341,0)
	40	AR EVENT (File-top level)
	41	"BLD",1011 1,4,341,2, 341,1,0)
	42	^9.6411^6. 01^1
	43	"BLD",1011 1,4,341,2, 341,1,6.01 ,0)
	44	CCPC STATE MENT DATE
	45	"BLD",1011 1,4,341,22 2)
	46	y^n^p^^^^n ^^n
	47	"BLD",1011 1,4,341,22 4)
	48
	49	"BLD",1011 1,4,349,0)
	50	349
	51	"BLD",1011 1,4,349,2, 0)
	52	^9.641^349 ^1
	53	"BLD",1011 1,4,349,2, 349,0)
	54	AR TRANSMI SSION RECO RDS (File -top level )
	55	"BLD",1011 1,4,349,2, 349,1,0)
	56	^9.6411^.0 9^1
	57	"BLD",1011 1,4,349,2, 349,1,.09, 0)
	58	STATEMENT DATE
	59	"BLD",1011 1,4,349,22 2)
	60	y^n^p^^^^n ^^n
	61	"BLD",1011 1,4,349,22 4)
	62
	63	"BLD",1011 1,4,349.1, 0)
	64	349.1
	65	"BLD",1011 1,4,349.1, 222)
	66	y^n^f^^^^n ^^n
	67	"BLD",1011 1,4,349.1, 224)
	68
	69	"BLD",1011 1,4,349.2, 0)
	70	349.2
	71	"BLD",1011 1,4,349.2, 2,0)
	72	^9.641^349 .2^1
	73	"BLD",1011 1,4,349.2, 2,349.2,0)
	74	AR CBSS ST ATEMENTS (File-top level)
	75	"BLD",1011 1,4,349.2, 2,349.2,1, 0)
	76	^9.6411^61 ^12
	77	"BLD",1011 1,4,349.2, 2,349.2,1, .01,0)
	78	PATIENT
	79	"BLD",1011 1,4,349.2, 2,349.2,1, .02,0)
	80	SSN
	81	"BLD",1011 1,4,349.2, 2,349.2,1, .03,0)
	82	PATIENT NA ME
	83	"BLD",1011 1,4,349.2, 2,349.2,1, .12,0)
	84	INVALID ST ATEMENT ER ROR
	85	"BLD",1011 1,4,349.2, 2,349.2,1, .18,0)
	86	CBSS FILE BUILT
	87	"BLD",1011 1,4,349.2, 2,349.2,1, .19,0)
	88	PATIENT ST ATEMENT DA TE
	89	"BLD",1011 1,4,349.2, 2,349.2,1, 51,0)
	90	ERROR CODE (S)
	91	"BLD",1011 1,4,349.2, 2,349.2,1, 61,0)
	92	CBSS PRINT ED
	93	"BLD",1011 1,4,349.2, 2,349.2,1, 81,0)
	94	INTEGRATIO N CONTROL NUMBER
	95	"BLD",1011 1,4,349.2, 2,349.2,1, 82,0)
	96	ICN CHECKS UM
	97	"BLD",1011 1,4,349.2, 2,349.2,1, 83,0)
	98	AR FLAG
	99	"BLD",1011 1,4,349.2, 2,349.2,1, 84,0)
	100	DATE OF LA TEST BILL
	101	"BLD",1011 1,4,349.2, 222)
	102	y^n^p^^^^n ^^n
	103	"BLD",1011 1,4,349.2, 224)
	104
	105	"BLD",1011 1,4,349.5, 0)
	106	349.5
	107	"BLD",1011 1,4,349.5, 222)
	108	y^n^f^^^^n ^^n
	109	"BLD",1011 1,4,349.5, 224)
	110
	111	"BLD",1011 1,4,433,0)
	112	433
	113	"BLD",1011 1,4,433,2, 0)
	114	^9.641^433 ^1
	115	"BLD",1011 1,4,433,2, 433,0)
	116	AR TRANSAC TION (Fil e-top leve l)
	117	"BLD",1011 1,4,433,2, 433,1,0)
	118	^9.6411^97 ^4
	119	"BLD",1011 1,4,433,2, 433,1,94,0 )
	120	AUTO-CORRE CTION DATE
	121	"BLD",1011 1,4,433,2, 433,1,95,0 )
	122	AUTO-CORRE CTION TRAN S. AMOUNT
	123	"BLD",1011 1,4,433,2, 433,1,96,0 )
	124	AUTO-CORRE CTION TYPE OF ERROR
	125	"BLD",1011 1,4,433,2, 433,1,97,0 )
	126	AUTO-CORRE CTION TICK ET FLAG
	127	"BLD",1011 1,4,433,22 2)
	128	y^n^p^^^^n ^^n
	129	"BLD",1011 1,4,433,22 4)
	130
	131	"BLD",1011 1,4,"APDD" ,340,340)
	132
	133	"BLD",1011 1,4,"APDD" ,340,340,. 01)
	134
	135	"BLD",1011 1,4,"APDD" ,340,340,. 03)
	136
	137	"BLD",1011 1,4,"APDD" ,340,340,7 .06)
	138
	139	"BLD",1011 1,4,"APDD" ,341,341)
	140
	141	"BLD",1011 1,4,"APDD" ,341,341,6 .01)
	142
	143	"BLD",1011 1,4,"APDD" ,349,349)
	144
	145	"BLD",1011 1,4,"APDD" ,349,349,. 09)
	146
	147	"BLD",1011 1,4,"APDD" ,349.2,349 .2)
	148
	149	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.01)
	150
	151	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.02)
	152
	153	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.03)
	154
	155	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.12)
	156
	157	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.18)
	158
	159	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.19)
	160
	161	"BLD",1011 1,4,"APDD" ,349.2,349 .2,51)
	162
	163	"BLD",1011 1,4,"APDD" ,349.2,349 .2,61)
	164
	165	"BLD",1011 1,4,"APDD" ,349.2,349 .2,81)
	166
	167	"BLD",1011 1,4,"APDD" ,349.2,349 .2,82)
	168
	169	"BLD",1011 1,4,"APDD" ,349.2,349 .2,83)
	170
	171	"BLD",1011 1,4,"APDD" ,349.2,349 .2,84)
	172
	173	"BLD",1011 1,4,"APDD" ,433,433)
	174
	175	"BLD",1011 1,4,"APDD" ,433,433,9 4)
	176
	177	"BLD",1011 1,4,"APDD" ,433,433,9 5)
	178
	179	"BLD",1011 1,4,"APDD" ,433,433,9 6)
	180
	181	"BLD",1011 1,4,"APDD" ,433,433,9 7)
	182
	183	"BLD",1011 1,4,"B",34 0,340)
	184
	185	"BLD",1011 1,4,"B",34 1,341)
	186
	187	"BLD",1011 1,4,"B",34 9,349)
	188
	189	"BLD",1011 1,4,"B",34 9.1,349.1)
	190
	191	"BLD",1011 1,4,"B",34 9.2,349.2)
	192
	193	"BLD",1011 1,4,"B",34 9.5,349.5)
	194
	195	"BLD",1011 1,4,"B",43 3,433)
	196
	197	"BLD",1011 1,6)
	198	2^
	199	"BLD",1011 1,6.3)
	200	131
	201	"BLD",1011 1,"ABPKG")
	202	n
	203	"BLD",1011 1,"INI")
	204	PRE^PRCA31 3P
	205	"BLD",1011 1,"INID")
	206	^y^y
	207	"BLD",1011 1,"INIT")
	208	EN^PRCA313 P
	209	"BLD",1011 1,"KRN",0)
	210	^9.67PA^77 9.2^20
	211	"BLD",1011 1,"KRN",.4 ,0)
	212	.4
	213	"BLD",1011 1,"KRN",.4 ,"NM",0)
	214	^9.68A^^0
	215	"BLD",1011 1,"KRN",.4 01,0)
	216	.401
	217	"BLD",1011 1,"KRN",.4 02,0)
	218	.402
	219	"BLD",1011 1,"KRN",.4 02,"NM",0)
	220	^9.68A^^0
	221	"BLD",1011 1,"KRN",.4 03,0)
	222	.403
	223	"BLD",1011 1,"KRN",.5 ,0)
	224	.5
	225	"BLD",1011 1,"KRN",.8 4,0)
	226	.84
	227	"BLD",1011 1,"KRN",3. 6,0)
	228	3.6
	229	"BLD",1011 1,"KRN",3. 8,0)
	230	3.8
	231	"BLD",1011 1,"KRN",3. 8,"NM",0)
	232	^9.68A^1^1
	233	"BLD",1011 1,"KRN",3. 8,"NM",1,0 )
	234	PRCACPS^^0
	235	"BLD",1011 1,"KRN",3. 8,"NM","B" ,"PRCACPS" ,1)
	236
	237	"BLD",1011 1,"KRN",9. 2,0)
	238	9.2
	239	"BLD",1011 1,"KRN",9. 8,0)
	240	9.8
	241	"BLD",1011 1,"KRN",9. 8,"NM",0)
	242	^9.68A^29^ 22
	243	"BLD",1011 1,"KRN",9. 8,"NM",5,0 )
	244	RCCPCBJ^^0 ^B9440906
	245	"BLD",1011 1,"KRN",9. 8,"NM",7,0 )
	246	RCCPCFN1^^ 0^B7181774
	247	"BLD",1011 1,"KRN",9. 8,"NM",8,0 )
	248	RCCPCML^^0 ^B67061934
	249	"BLD",1011 1,"KRN",9. 8,"NM",9,0 )
	250	RCCPCSV^^0 ^B11825361
	251	"BLD",1011 1,"KRN",9. 8,"NM",10, 0)
	252	RCCPCPS^^0 ^B14320836 9
	253	"BLD",1011 1,"KRN",9. 8,"NM",11, 0)
	254	RCCPCPS1^^ 0^B6544337 8
	255	"BLD",1011 1,"KRN",9. 8,"NM",12, 0)
	256	RCCPCSV1^^ 0^B4331384 1
	257	"BLD",1011 1,"KRN",9. 8,"NM",13, 0)
	258	RCCPCML1^^ 0^B8980051
	259	"BLD",1011 1,"KRN",9. 8,"NM",14, 0)
	260	RCCPCSE^^0 ^B16507603
	261	"BLD",1011 1,"KRN",9. 8,"NM",15, 0)
	262	RCCPCT^^0^ B29330001
	263	"BLD",1011 1,"KRN",9. 8,"NM",17, 0)
	264	PRCAG^^0^B 74256403
	265	"BLD",1011 1,"KRN",9. 8,"NM",18, 0)
	266	PRCA313P^^ 0^B2768173 4
	267	"BLD",1011 1,"KRN",9. 8,"NM",19, 0)
	268	PRCAACR^^0 ^B12733608 1
	269	"BLD",1011 1,"KRN",9. 8,"NM",20, 0)
	270	PRCAACR1^^ 0^B1512714 41
	271	"BLD",1011 1,"KRN",9. 8,"NM",21, 0)
	272	RCCPCAP^^0 ^B43506016
	273	"BLD",1011 1,"KRN",9. 8,"NM",22, 0)
	274	RCCPCAT^^0 ^B52270242
	275	"BLD",1011 1,"KRN",9. 8,"NM",23, 0)
	276	RCCPCAR^^0 ^B47894432
	277	"BLD",1011 1,"KRN",9. 8,"NM",24, 0)
	278	RCBEADJ^^0 ^B10088316 1
	279	"BLD",1011 1,"KRN",9. 8,"NM",26, 0)
	280	RCDPBTLM^^ 0^B5884942 2
	281	"BLD",1011 1,"KRN",9. 8,"NM",27, 0)
	282	PRCACPS^^0 ^B25406671 6
	283	"BLD",1011 1,"KRN",9. 8,"NM",28, 0)
	284	PRCACPS1^^ 0^B1912815 8
	285	"BLD",1011 1,"KRN",9. 8,"NM",29, 0)
	286	PRCACPSA^^ 0^B3327065 3
	287	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCA313P ",18)
	288
	289	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR" ,19)
	290
	291	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR1 ",20)
	292
	293	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPS" ,27)
	294
	295	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPS1 ",28)
	296
	297	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPSA ",29)
	298
	299	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAG",1 7)
	300
	301	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCBEADJ" ,24)
	302
	303	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAP" ,21)
	304
	305	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAR" ,23)
	306
	307	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAT" ,22)
	308
	309	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCBJ" ,5)
	310
	311	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCFN1 ",7)
	312
	313	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML" ,8)
	314
	315	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML1 ",13)
	316
	317	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS" ,10)
	318
	319	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS1 ",11)
	320
	321	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSE" ,14)
	322
	323	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV" ,9)
	324
	325	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV1 ",12)
	326
	327	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCT", 15)
	328
	329	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCDPBTLM ",26)
	330
	331	"BLD",1011 1,"KRN",19 ,0)
	332	19
	333	"BLD",1011 1,"KRN",19 ,"NM",0)
	334	^9.68A^11^ 8
	335	"BLD",1011 1,"KRN",19 ,"NM",4,0)
	336	PRCA CBS N IGHTLY UPD ATE^^0
	337	"BLD",1011 1,"KRN",19 ,"NM",5,0)
	338	PRCAE FOLL OW-UP^^2
	339	"BLD",1011 1,"KRN",19 ,"NM",6,0)
	340	RCCPC APPS BUILD AND TRANS^^0
	341	"BLD",1011 1,"KRN",19 ,"NM",7,0)
	342	RCCPC APPS RETRANS^^ 0
	343	"BLD",1011 1,"KRN",19 ,"NM",8,0)
	344	RCCPC APPS DATA CHEC K^^0
	345	"BLD",1011 1,"KRN",19 ,"NM",9,0)
	346	PRCA ACCOU NT MANAGEM ENT^^2
	347	"BLD",1011 1,"KRN",19 ,"NM",10,0 )
	348	PRCA AUTOC RCT PGM^^0
	349	"BLD",1011 1,"KRN",19 ,"NM",11,0 )
	350	PRCA AUTOC RCT RPT^^0
	351	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA ACCO UNT MANAGE MENT",9)
	352
	353	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA AUTO CRCT PGM", 10)
	354
	355	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA AUTO CRCT RPT", 11)
	356
	357	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA CBS NIGHTLY UP DATE",4)
	358
	359	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCAE FOL LOW-UP",5)
	360
	361	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S BUILD AN D TRANS",6 )
	362
	363	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S DATA CHE CK",8)
	364
	365	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S RETRANS" ,7)
	366
	367	"BLD",1011 1,"KRN",19 .1,0)
	368	19.1
	369	"BLD",1011 1,"KRN",19 .1,"NM",0)
	370	^9.68A^2^2
	371	"BLD",1011 1,"KRN",19 .1,"NM",1, 0)
	372	RCCPC APPS BUILD AND TRANS^^0
	373	"BLD",1011 1,"KRN",19 .1,"NM",2, 0)
	374	PRCA AUTOC RCT PGM^^0
	375	"BLD",1011 1,"KRN",19 .1,"NM","B ","PRCA AU TOCRCT PGM ",2)
	376
	377	"BLD",1011 1,"KRN",19 .1,"NM","B ","RCCPC A PPS BUILD AND TRANS" ,1)
	378
	379	"BLD",1011 1,"KRN",10 1,0)
	380	101
	381	"BLD",1011 1,"KRN",40 9.61,0)
	382	409.61
	383	"BLD",1011 1,"KRN",77 1,0)
	384	771
	385	"BLD",1011 1,"KRN",77 9.2,0)
	386	779.2
	387	"BLD",1011 1,"KRN",87 0,0)
	388	870
	389	"BLD",1011 1,"KRN",89 89.51,0)
	390	8989.51
	391	"BLD",1011 1,"KRN",89 89.52,0)
	392	8989.52
	393	"BLD",1011 1,"KRN",89 94,0)
	394	8994
	395	"BLD",1011 1,"KRN","B ",.4,.4)
	396
	397	"BLD",1011 1,"KRN","B ",.401,.40 1)
	398
	399	"BLD",1011 1,"KRN","B ",.402,.40 2)
	400
	401	"BLD",1011 1,"KRN","B ",.403,.40 3)
	402
	403	"BLD",1011 1,"KRN","B ",.5,.5)
	404
	405	"BLD",1011 1,"KRN","B ",.84,.84)
	406
	407	"BLD",1011 1,"KRN","B ",3.6,3.6)
	408
	409	"BLD",1011 1,"KRN","B ",3.8,3.8)
	410
	411	"BLD",1011 1,"KRN","B ",9.2,9.2)
	412
	413	"BLD",1011 1,"KRN","B ",9.8,9.8)
	414
	415	"BLD",1011 1,"KRN","B ",19,19)
	416
	417	"BLD",1011 1,"KRN","B ",19.1,19. 1)
	418
	419	"BLD",1011 1,"KRN","B ",101,101)
	420
	421	"BLD",1011 1,"KRN","B ",409.61,4 09.61)
	422
	423	"BLD",1011 1,"KRN","B ",771,771)
	424
	425	"BLD",1011 1,"KRN","B ",779.2,77 9.2)
	426
	427	"BLD",1011 1,"KRN","B ",870,870)
	428
	429	"BLD",1011 1,"KRN","B ",8989.51, 8989.51)
	430
	431	"BLD",1011 1,"KRN","B ",8989.52, 8989.52)
	432
	433	"BLD",1011 1,"KRN","B ",8994,899 4)
	434
	435	"BLD",1011 1,"QDEF")
	436	^^^^^^^^YE S^^YES
	437	"BLD",1011 1,"QUES",0 )
	438	^9.62^^
	439	"BLD",1011 1,"REQB",0 )
	440	^9.611^7^7
	441	"BLD",1011 1,"REQB",1 ,0)
	442	PRCA4.53 07^2
	443	"BLD",1011 1,"REQB",2 ,0)
	444	XMDB1.00 ^2
	445	"BLD",1011 1,"REQB",3 ,0)
	446	PRCA4.52 37^2
	447	"BLD",1011 1,"REQB",4 ,0)
	448	PRCA4.52 33^2
	449	"BLD",1011 1,"REQB",5 ,0)
	450	PRCA4.53 09^2
	451	"BLD",1011 1,"REQB",6 ,0)
	452	PRCA4.52 76^2
	453	"BLD",1011 1,"REQB",7 ,0)
	454	PRCA4.53 01^2
	455	"BLD",1011 1,"REQB"," B","PRCA4 .5233",4)
	456
	457	"BLD",1011 1,"REQB"," B","PRCA4 .5237",3)
	458
	459	"BLD",1011 1,"REQB"," B","PRCA4 .5276",6)
	460
	461	"BLD",1011 1,"REQB"," B","PRCA4 .5301",7)
	462
	463	"BLD",1011 1,"REQB"," B","PRCA4 .5307",1)
	464
	465	"BLD",1011 1,"REQB"," B","PRCA4 .5309",5)
	466
	467	"BLD",1011 1,"REQB"," B","XMDB1 .00",2)
	468
	469	"FIA",340)
	470	AR DEBTOR
	471	"FIA",340, 0)
	472	^RCD(340,
	473	"FIA",340, 0,0)
	474	340V
	475	"FIA",340, 0,1)
	476	y^n^p^^^^n ^^n
	477	"FIA",340, 0,10)
	478
	479	"FIA",340, 0,11)
	480
	481	"FIA",340, 0,"RLRO")
	482
	483	"FIA",340, 0,"VR")
	484	4.5^PRCA
	485	"FIA",340, 340)
	486	1
	487	"FIA",340, 340,.01)
	488
	489	"FIA",340, 340,.03)
	490
	491	"FIA",340, 340,7.06)
	492
	493	"FIA",341)
	494	AR EVENT
	495	"FIA",341, 0)
	496	^RC(341,
	497	"FIA",341, 0,0)
	498	341I
	499	"FIA",341, 0,1)
	500	y^n^p^^^^n ^^n
	501	"FIA",341, 0,10)
	502
	503	"FIA",341, 0,11)
	504
	505	"FIA",341, 0,"RLRO")
	506
	507	"FIA",341, 0,"VR")
	508	4.5^PRCA
	509	"FIA",341, 341)
	510	1
	511	"FIA",341, 341,6.01)
	512
	513	"FIA",349)
	514	AR TRANSMI SSION RECO RDS
	515	"FIA",349, 0)
	516	^RCT(349,
	517	"FIA",349, 0,0)
	518	349I
	519	"FIA",349, 0,1)
	520	y^n^p^^^^n ^^n
	521	"FIA",349, 0,10)
	522
	523	"FIA",349, 0,11)
	524
	525	"FIA",349, 0,"RLRO")
	526
	527	"FIA",349, 0,"VR")
	528	4.5^PRCA
	529	"FIA",349, 349)
	530	1
	531	"FIA",349, 349,.09)
	532
	533	"FIA",349. 1)
	534	AR TRANSMI SSION TYPE
	535	"FIA",349. 1,0)
	536	^RCT(349.1 ,
	537	"FIA",349. 1,0,0)
	538	349.1I
	539	"FIA",349. 1,0,1)
	540	y^n^f^^^^n ^^n
	541	"FIA",349. 1,0,10)
	542
	543	"FIA",349. 1,0,11)
	544
	545	"FIA",349. 1,0,"RLRO" )
	546
	547	"FIA",349. 1,0,"VR")
	548	4.5^PRCA
	549	"FIA",349. 1,349.1)
	550	0
	551	"FIA",349. 1,349.11)
	552	0
	553	"FIA",349. 1,349.12)
	554	0
	555	"FIA",349. 1,349.141)
	556	0
	557	"FIA",349. 1,349.151)
	558	0
	559	"FIA",349. 1,349.161)
	560	0
	561	"FIA",349. 2)
	562	AR CBSS ST ATEMENTS
	563	"FIA",349. 2,0)
	564	^RCPS(349. 2,
	565	"FIA",349. 2,0,0)
	566	349.2I
	567	"FIA",349. 2,0,1)
	568	y^n^p^^^^n ^^n
	569	"FIA",349. 2,0,10)
	570
	571	"FIA",349. 2,0,11)
	572
	573	"FIA",349. 2,0,"RLRO" )
	574
	575	"FIA",349. 2,0,"VR")
	576	4.5^PRCA
	577	"FIA",349. 2,349.2)
	578	1
	579	"FIA",349. 2,349.2,.0 1)
	580
	581	"FIA",349. 2,349.2,.0 2)
	582
	583	"FIA",349. 2,349.2,.0 3)
	584
	585	"FIA",349. 2,349.2,.1 2)
	586
	587	"FIA",349. 2,349.2,.1 8)
	588
	589	"FIA",349. 2,349.2,.1 9)
	590
	591	"FIA",349. 2,349.2,51 )
	592
	593	"FIA",349. 2,349.2,61 )
	594
	595	"FIA",349. 2,349.2,81 )
	596
	597	"FIA",349. 2,349.2,82 )
	598
	599	"FIA",349. 2,349.2,83 )
	600
	601	"FIA",349. 2,349.2,84 )
	602
	603	"FIA",349. 5)
	604	AR ANNUAL PAYMENT ST ATEMENT
	605	"FIA",349. 5,0)
	606	^RCAP(349. 5,
	607	"FIA",349. 5,0,0)
	608	349.5
	609	"FIA",349. 5,0,1)
	610	y^n^f^^^^n ^^n
	611	"FIA",349. 5,0,10)
	612
	613	"FIA",349. 5,0,11)
	614
	615	"FIA",349. 5,0,"RLRO" )
	616
	617	"FIA",349. 5,0,"VR")
	618	4.5^PRCA
	619	"FIA",349. 5,349.5)
	620	0
	621	"FIA",349. 5,349.51)
	622	0
	623	"FIA",433)
	624	AR TRANSAC TION
	625	"FIA",433, 0)
	626	^PRCA(433,
	627	"FIA",433, 0,0)
	628	433NI
	629	"FIA",433, 0,1)
	630	y^n^p^^^^n ^^n
	631	"FIA",433, 0,10)
	632
	633	"FIA",433, 0,11)
	634
	635	"FIA",433, 0,"RLRO")
	636
	637	"FIA",433, 0,"VR")
	638	4.5^PRCA
	639	"FIA",433, 433)
	640	1
	641	"FIA",433, 433,94)
	642
	643	"FIA",433, 433,95)
	644
	645	"FIA",433, 433,96)
	646
	647	"FIA",433, 433,97)
	648
	649	"INI")
	650	PRE^PRCA31 3P
	651	"INIT")
	652	EN^PRCA313 P
	653	"IX",349,3 49,"SDT",0 )
	654	349^SDT^Pa tient Stat ement Day of the Mon th^R^^F^IR ^I^349^^^^ ^LS
	655	"IX",349,3 49,"SDT",. 1,0)
	656	^^1^1^3161 007^
	657	"IX",349,3 49,"SDT",. 1,1,0)
	658	This cross -reference is the Pa tient Stat ement Day of the Mon th.
	659	"IX",349,3 49,"SDT",1 )
	660	S ^RCT(349 ,"SDT",$E( X,1,2),DA) =""
	661	"IX",349,3 49,"SDT",2 )
	662	K ^RCT(349 ,"SDT",$E( X,1,2),DA)
	663	"IX",349,3 49,"SDT",2 .5)
	664	K ^RCT(349 ,"SDT")
	665	"IX",349,3 49,"SDT",1 1.1,0)
	666	^.114IA^1^ 1
	667	"IX",349,3 49,"SDT",1 1.1,1,0)
	668	1^F^349^.0 9^2^1^F
	669	"IX",349,3 49,"SDT",1 1.1,1,2)
	670	S X=+$E(X, 6,7)
	671	"IX",349.1 ,349.141," STDT4",0)
	672	349.141^ST DT4^Patien t Statemen t Date and Last Mess age ACK^R^ ^R^IR^I^34 9.141^^^^^ LS
	673	"IX",349.1 ,349.141," STDT4",.1, 0)
	674	^^2^2^3161 007^
	675	"IX",349.1 ,349.141," STDT4",.1, 1,0)
	676	This cross -reference is used t o sort by the Patien t Statemen t Date and the
	677	"IX",349.1 ,349.141," STDT4",.1, 2,0)
	678	Last Messa ge ACK.
	679	"IX",349.1 ,349.141," STDT4",1)
	680	S ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)=" "
	681	"IX",349.1 ,349.141," STDT4",2)
	682	K ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)
	683	"IX",349.1 ,349.141," STDT4",2.5 )
	684	K ^RCT(349 .1,DA(1),4 ,"STDT4")
	685	"IX",349.1 ,349.141," STDT4",11. 1,0)
	686	^.114IA^2^ 2
	687	"IX",349.1 ,349.141," STDT4",11. 1,1,0)
	688	1^F^349.14 1^.04^7^1^ F
	689	"IX",349.1 ,349.141," STDT4",11. 1,1,3)
	690
	691	"IX",349.1 ,349.141," STDT4",11. 1,2,0)
	692	2^F^349.14 1^.01^3^2^ F
	693	"IX",349.1 ,349.141," STDT4",11. 1,2,3)
	694
	695	"IX",349.1 ,349.151," STDT5",0)
	696	349.151^ST DT5^Patien t Statemen t Date Ind ex^R^^F^IR ^I^349.151 ^^^^^LS
	697	"IX",349.1 ,349.151," STDT5",.1, 0)
	698	^^1^1^3161 006^
	699	"IX",349.1 ,349.151," STDT5",.1, 1,0)
	700	This cross -reference is used t o sort by the Patien t Statemen t Date.
	701	"IX",349.1 ,349.151," STDT5",1)
	702	S ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)=""
	703	"IX",349.1 ,349.151," STDT5",2)
	704	K ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)
	705	"IX",349.1 ,349.151," STDT5",2.5 )
	706	K ^RCT(349 .1,DA(1),5 ,"STDT5")
	707	"IX",349.1 ,349.151," STDT5",11. 1,0)
	708	^.114IA^1^ 1
	709	"IX",349.1 ,349.151," STDT5",11. 1,1,0)
	710	1^F^349.15 1^.04^7^1^ F
	711	"IX",349.2 ,349.2,"AD ",0)
	712	349.2^AD^P atient Sta tement Err ors^R^^F^I R^I^349.2^ ^^^^S
	713	"IX",349.2 ,349.2,"AD ",.1,0)
	714	^^2^2^3161 007^
	715	"IX",349.2 ,349.2,"AD ",.1,1,0)
	716	This is th e cross-re ference to find pati ent statem ent errors that are
	717	"IX",349.2 ,349.2,"AD ",.1,2,0)
	718	returned f rom CBSS.
	719	"IX",349.2 ,349.2,"AD ",1)
	720	S ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)=""
	721	"IX",349.2 ,349.2,"AD ",2)
	722	K ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)
	723	"IX",349.2 ,349.2,"AD ",2.5)
	724	K ^RCPS(34 9.2,"AD")
	725	"IX",349.2 ,349.2,"AD ",11.1,0)
	726	^.114IA^1^ 1
	727	"IX",349.2 ,349.2,"AD ",11.1,1,0 )
	728	1^F^349.2^ 51^1^1^F
	729	"IX",349.2 ,349.2,"AD ",11.1,1,1 )
	730
	731	"IX",349.2 ,349.2,"AD ",11.1,1,2 )
	732	S X="E"
	733	"IX",349.2 ,349.2,"ST DT",0)
	734	349.2^STDT ^Patient S tatement D ate^R^^F^I R^I^349.2^ ^^^^LS
	735	"IX",349.2 ,349.2,"ST DT",.1,0)
	736	^^2^2^3161 007^
	737	"IX",349.2 ,349.2,"ST DT",.1,1,0 )
	738	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	739	"IX",349.2 ,349.2,"ST DT",.1,2,0 )
	740	standardly two days after the statement is transmi tted.
	741	"IX",349.2 ,349.2,"ST DT",1)
	742	S ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)=""
	743	"IX",349.2 ,349.2,"ST DT",2)
	744	K ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)
	745	"IX",349.2 ,349.2,"ST DT",2.5)
	746	K ^RCPS(34 9.2,"STDT" )
	747	"IX",349.2 ,349.2,"ST DT",11.1,0 )
	748	^.114IA^1^ 1
	749	"IX",349.2 ,349.2,"ST DT",11.1,1 ,0)
	750	1^F^349.2^ .19^7^1^F
	751	"IX",433,4 33,"TACD", 0)
	752	433^TACD^T he date th at this tr ansaction was correc ted by the Auto-Corr ection
	753	Program.^R ^^F^IR^I^4 33^^^^^LS
	754	"IX",433,4 33,"TACD", .1,0)
	755	^^2^2^3160 920^
	756	"IX",433,4 33,"TACD", .1,1,0)
	757	The is the date that the Patie nt Stateme nt Auto-Co rrection P rogram
	758	"IX",433,4 33,"TACD", .1,2,0)
	759	corrected the statem ent discre pancy for this trans action.
	760	"IX",433,4 33,"TACD", 1)
	761	S ^PRCA(43 3,"TACD",$ E(X,1,7),D A)=""
	762	"IX",433,4 33,"TACD", 2)
	763	K ^PRCA(43 3,"TACD",$ E(X,1,7),D A)
	764	"IX",433,4 33,"TACD", 2.5)
	765	K ^PRCA(43 3,"TACD")
	766	"IX",433,4 33,"TACD", 11.1,0)
	767	^.114IA^1^ 1
	768	"IX",433,4 33,"TACD", 11.1,1,0)
	769	1^F^433^94 ^7^1^F
	770	"IX",433,4 33,"TACD", "NOREINDEX ")
	771	1
	772	"KRN",3.8, 322,-1)
	773	0^1
	774	"KRN",3.8, 322,0)
	775	PRCACPS^PU ^^^^^
	776	"KRN",3.8, 322,2,0)
	777	^3.801^2^2 ^3160406^^ ^
	778	"KRN",3.8, 322,2,1,0)
	779	This mail group will receive a notificat ion when t he Consoli dated
	780	"KRN",3.8, 322,2,2,0)
	781	Patient St atement Au to-Correct ion progra m has comp leted.
	782	"KRN",3.8, 322,3)
	783
	784	"KRN",19,3 026,-1)
	785	2^5
	786	"KRN",19,3 026,0)
	787	PRCAE FOLL OW-UP^Foll ow-up Lett er Menu^^M ^1^^^^^^^5 3
	788	"KRN",19,3 026,10,0)
	789	^19.01IP^1 9^19
	790	"KRN",19,3 026,10,17, 0)
	791	11666^^14
	792	"KRN",19,3 026,10,17, "^")
	793	RCCPC APPS BUILD AND TRANS
	794	"KRN",19,3 026,10,18, 0)
	795	11667^^15
	796	"KRN",19,3 026,10,18, "^")
	797	RCCPC APPS RETRANS
	798	"KRN",19,3 026,10,19, 0)
	799	11668^^16
	800	"KRN",19,3 026,10,19, "^")
	801	RCCPC APPS DATA CHEC K
	802	"KRN",19,3 026,"U")
	803	FOLLOW-UP LETTER MEN U
	804	"KRN",19,3 126,-1)
	805	2^9
	806	"KRN",19,3 126,0)
	807	PRCA ACCOU NT MANAGEM ENT^Accoun t Manageme nt^^M^1^^^ ^^^^53
	808	"KRN",19,3 126,10,0)
	809	^19.01IP^2 1^20
	810	"KRN",19,3 126,10,18, 0)
	811	11669^^2
	812	"KRN",19,3 126,10,18, "^")
	813	PRCA AUTOC RCT PGM
	814	"KRN",19,3 126,10,19, 0)
	815	11670^^1
	816	"KRN",19,3 126,10,19, "^")
	817	PRCA AUTOC RCT RPT
	818	"KRN",19,3 126,10,21, 0)
	819	11657^^3
	820	"KRN",19,3 126,10,21, "^")
	821	PRCA CBS N IGHTLY UPD ATE
	822	"KRN",19,3 126,"U")
	823	ACCOUNT MA NAGEMENT
	824	"KRN",19,1 1657,-1)
	825	0^4
	826	"KRN",19,1 1657,0)
	827	PRCA CBS N IGHTLY UPD ATE^CBS Ni ghtly Acco unt Update Program^^ R^^^^^^^^
	828	"KRN",19,1 1657,1,0)
	829	^^2^2^3160 622^
	830	"KRN",19,1 1657,1,1,0 )
	831	This optio n runs the Consolida ted Billin g System
	832	"KRN",19,1 1657,1,2,0 )
	833	Nightly Ac count Upda te program .
	834	"KRN",19,1 1657,25)
	835	ENTER^PRCA CPS1
	836	"KRN",19,1 1657,"U")
	837	CBS NIGHTL Y ACCOUNT UPDATE PRO
	838	"KRN",19,1 1666,-1)
	839	0^6
	840	"KRN",19,1 1666,0)
	841	RCCPC APPS BUILD AND TRANS^Bui ld and Tra nsmit Annu al Payment File^^A^^ RCCPC APPS BUILD AND
	842	TRANS^^^^^ ^^^1
	843	"KRN",19,1 1666,1,0)
	844	^19.06^3^3 ^3170502^^ ^
	845	"KRN",19,1 1666,1,1,0 )
	846	This optio n will bui ld the Ann ual Paymen t Statemen t file for the previ ous
	847	"KRN",19,1 1666,1,2,0 )
	848	year for e very patie nt who has one or mo re payment s in the p revious ye ar
	849	"KRN",19,1 1666,1,3,0 )
	850	and transm it the fil e to AITC.
	851	"KRN",19,1 1666,20)
	852	D MANBLD^R CCPCAT
	853	"KRN",19,1 1666,"U")
	854	BUILD AND TRANSMIT A NNUAL PAYM
	855	"KRN",19,1 1667,-1)
	856	0^7
	857	"KRN",19,1 1667,0)
	858	RCCPC APPS RETRANS^R etransmit Current An nual Payme nt File^^A ^^RCCPC AP PS BUILD A ND
	859	TRANS^^^^^ ^^^1
	860	"KRN",19,1 1667,1,0)
	861	^19.06^3^3 ^3170502^^ ^^
	862	"KRN",19,1 1667,1,1,0 )
	863	This optio n should o nly to be used when AITC has r equested t he current
	864	"KRN",19,1 1667,1,2,0 )
	865	Annual Pay ment State ment file be retrans mitted. Th is file wi ll include
	866	"KRN",19,1 1667,1,3,0 )
	867	every pati ent who ha s one or m ore paymen ts in the previous y ear.
	868	"KRN",19,1 1667,20)
	869	D RETRANS^ RCCPCAT
	870	"KRN",19,1 1667,"U")
	871	RETRANSMIT CURRENT A NNUAL PAYM
	872	"KRN",19,1 1668,-1)
	873	0^8
	874	"KRN",19,1 1668,0)
	875	RCCPC APPS DATA CHEC K^Annual P ayment Fil e Consiste ncy Check^ ^A^^^^^^^^ ^^1
	876	"KRN",19,1 1668,1,0)
	877	^^5^5^3170 321^
	878	"KRN",19,1 1668,1,1,0 )
	879	AR data is extracted from the VistA site s and is s ent to CBS S who then
	880	"KRN",19,1 1668,1,2,0 )
	881	consolidat es the dat a into the annual pa yment stat ement. The VistA dat a
	882	"KRN",19,1 1668,1,3,0 )
	883	needs to b e validate d prior to its trans mission. T his menu o ption will
	884	"KRN",19,1 1668,1,4,0 )
	885	produce a report det ailing whi ch APPS da ta needs t o be revie wed and
	886	"KRN",19,1 1668,1,5,0 )
	887	updated pr ior to its transmiss ion to CBS S.
	888	"KRN",19,1 1668,20)
	889	D MANBLD^R CCPCAR
	890	"KRN",19,1 1668,"U")
	891	ANNUAL PAY MENT FILE CONSISTENC
	892	"KRN",19,1 1669,-1)
	893	0^10
	894	"KRN",19,1 1669,0)
	895	PRCA AUTOC RCT PGM^Pa tient Stat ement Auto -Correctio n Program^ ^R^^PRCA A UTOCRCT PG M^^^^^^
	896	"KRN",19,1 1669,1,0)
	897	^^2^2^3170 518^
	898	"KRN",19,1 1669,1,1,0 )
	899	This optio n runs the Auto-Corr ection pro gram for P atient Sta tement
	900	"KRN",19,1 1669,1,2,0 )
	901	discrepanc ies.
	902	"KRN",19,1 1669,25)
	903	BEGIN^PRCA CPS
	904	"KRN",19,1 1669,"U")
	905	PATIENT ST ATEMENT AU TO-CORRECT
	906	"KRN",19,1 1670,-1)
	907	0^11
	908	"KRN",19,1 1670,0)
	909	PRCA AUTOC RCT RPT^Au to-Correct Patient D iscrepancy Report^^R ^^^^^^^^
	910	"KRN",19,1 1670,1,0)
	911	^^2^2^3170 518^
	912	"KRN",19,1 1670,1,1,0 )
	913	This optio n runs the Auto-Corr ection Pat ient Discr epancy Rep ort for
	914	"KRN",19,1 1670,1,2,0 )
	915	correction s made by the Patien t Statemen t Auto-Cor rection Pr ogram.
	916	"KRN",19,1 1670,25)
	917	PSACRT^PRC AACR
	918	"KRN",19,1 1670,"U")
	919	AUTO-CORRE CT PATIENT DISCREPAN
	920	"KRN",19.1 ,598,-1)
	921	0^2
	922	"KRN",19.1 ,598,0)
	923	PRCA AUTOC RCT PGM
	924	"KRN",19.1 ,598,1,0)
	925	^19.11^3^3 ^3170515^^ ^^
	926	"KRN",19.1 ,598,1,1,0 )
	927	This is a key for th e AR optio n 'PRCA AU TOCRCT PGM '.
	928	"KRN",19.1 ,598,1,2,0 )
	929	The 'PRCA AUTOCRCT P GM' option runs the Consolidat ed
	930	"KRN",19.1 ,598,1,3,0 )
	931	Patient St atement Au to-Correct ion progra m.
	932	"KRN",19.1 ,600,-1)
	933	0^1
	934	"KRN",19.1 ,600,0)
	935	RCCPC APPS BUILD AND TRANS
	936	"KRN",19.1 ,600,1,0)
	937	^^8^8^3170 502^
	938	"KRN",19.1 ,600,1,1,0 )
	939	This is a key for th e AR menu options 'R CCPC APPS BUILD AND TRANS' and
	940	"KRN",19.1 ,600,1,2,0 )
	941	'RCCPC APP S RETRANS' .
	942	"KRN",19.1 ,600,1,3,0 )
	943
	944	"KRN",19.1 ,600,1,4,0 )
	945	The 'RCCPC APPS BUIL D AND TRAN S' option runs the A nnual Paym ent Statem ent
	946	"KRN",19.1 ,600,1,5,0 )
	947	File Build and Trans mit for th e previous year and sends the data to AI TC.
	948	"KRN",19.1 ,600,1,6,0 )
	949
	950	"KRN",19.1 ,600,1,7,0 )
	951	The 'RCCPC APPS RETR ANS' optio n Re-Trans mits the c urrent Ann ual Paymen t
	952	"KRN",19.1 ,600,1,8,0 )
	953	Statement File data to AITC.
	954	"MBREQ")
	955	0
	956	"ORD",3,19 .1)
	957	19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1
	958	"ORD",3,19 .1,0)
	959	SECURITY K EY
	960	"ORD",11,3 .8)
	961	3.8;11;;;M AILG^XPDTA 1;MAILGF1^ XPDIA1;MAI LGE1^XPDIA 1;MAILGF2^ XPDIA1;;MA ILGDEL^XPD IA1(%)
	962	"ORD",11,3 .8,0)
	963	MAIL GROUP
	964	"ORD",18,1 9)
	965	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	966	"ORD",18,1 9,0)
	967	OPTION
	968	"PKG",53,- 1)
	969	1^1
	970	"PKG",53,0 )
	971	ACCOUNTS R ECEIVABLE^ PRCA^FMS
	972	"PKG",53,2 0,0)
	973	^9.402P^1^ 1
	974	"PKG",53,2 0,1,0)
	975	2^^PRCAMRG
	976	"PKG",53,2 0,1,1)
	977
	978	"PKG",53,2 0,"B",2,1)
	979
	980	"PKG",53,2 2,0)
	981	^9.49I^1^1
	982	"PKG",53,2 2,1,0)
	983	4.5^305111 9^2960627
	984	"PKG",53,2 2,1,"PAH", 1,0)
	985	313^318030 8^81
	986	"PKG",53,2 2,1,"PAH", 1,1,0)
	987	^^1^1^3180 308
	988	"PKG",53,2 2,1,"PAH", 1,1,1,0)
	989	Consolidat ed Patient Statement
	990	"QUES","XP F1",0)
	991	Y
	992	"QUES","XP F1","??")
	993	^D REP^XPD H
	994	"QUES","XP F1","A")
	995	Shall I wr ite over y our \|FLAG\| File
	996	"QUES","XP F1","B")
	997	YES
	998	"QUES","XP F1","M")
	999	D XPF1^XPD IQ
	1000	"QUES","XP F2",0)
	1001	Y
	1002	"QUES","XP F2","??")
	1003	^D DTA^XPD H
	1004	"QUES","XP F2","A")
	1005	Want my da ta \|FLAG\| yours
	1006	"QUES","XP F2","B")
	1007	YES
	1008	"QUES","XP F2","M")
	1009	D XPF2^XPD IQ
	1010	"QUES","XP I1",0)
	1011	YO
	1012	"QUES","XP I1","??")
	1013	^D INHIBIT ^XPDH
	1014	"QUES","XP I1","A")
	1015	Want KIDS to INHIBIT LOGONs du ring the i nstall
	1016	"QUES","XP I1","B")
	1017	NO
	1018	"QUES","XP I1","M")
	1019	D XPI1^XPD IQ
	1020	"QUES","XP M1",0)
	1021	PO^VA(200, :EM
	1022	"QUES","XP M1","??")
	1023	^D MG^XPDH
	1024	"QUES","XP M1","A")
	1025	Enter the Coordinato r for Mail Group '\|F LAG\|'
	1026	"QUES","XP M1","B")
	1027
	1028	"QUES","XP M1","M")
	1029	D XPM1^XPD IQ
	1030	"QUES","XP O1",0)
	1031	Y
	1032	"QUES","XP O1","??")
	1033	^D MENU^XP DH
	1034	"QUES","XP O1","A")
	1035	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	1036	"QUES","XP O1","B")
	1037	YES
	1038	"QUES","XP O1","M")
	1039	D XPO1^XPD IQ
	1040	"QUES","XP Z1",0)
	1041	Y
	1042	"QUES","XP Z1","??")
	1043	^D OPT^XPD H
	1044	"QUES","XP Z1","A")
	1045	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	1046	"QUES","XP Z1","B")
	1047	YES
	1048	"QUES","XP Z1","M")
	1049	D XPZ1^XPD IQ
	1050	"QUES","XP Z2",0)
	1051	Y
	1052	"QUES","XP Z2","??")
	1053	^D RTN^XPD H
	1054	"QUES","XP Z2","A")
	1055	Want to MO VE routine s to other CPUs
	1056	"QUES","XP Z2","B")
	1057	NO
	1058	"QUES","XP Z2","M")
	1059	D XPZ2^XPD IQ
	1060	"RTN")
	1061	22
	1062	"RTN","PRC A313P")
	1063	0^18^B2768 1734^n/a
	1064	"RTN","PRC A313P",1,0 )
	1065	PRCA313P ; ALB/BDB - PATCH PRCA 4.5313 P OST-INSTAL L ROUTINE ; 11/2/15 4:15pm
	1066	"RTN","PRC A313P",2,0 )
	1067	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 131
	1068	"RTN","PRC A313P",3,0 )
	1069	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1070	"RTN","PRC A313P",4,0 )
	1071	; This ro utine queu es the Pat ient State ment Auto- Correction Program
	1072	"RTN","PRC A313P",5,0 )
	1073	;
	1074	"RTN","PRC A313P",6,0 )
	1075	Q
	1076	"RTN","PRC A313P",7,0 )
	1077	EN ;Entry point for PRCA4.53 13 post-in stall
	1078	"RTN","PRC A313P",8,0 )
	1079	;
	1080	"RTN","PRC A313P",9,0 )
	1081	; Queue t he Patient Statement Auto-Corr ection Pro gram
	1082	"RTN","PRC A313P",10, 0)
	1083	D PRCACPS
	1084	"RTN","PRC A313P",11, 0)
	1085	; Delete DD previou s monthly data
	1086	"RTN","PRC A313P",12, 0)
	1087	D CLEANUP
	1088	"RTN","PRC A313P",13, 0)
	1089	; Set Pat ient State ment days
	1090	"RTN","PRC A313P",14, 0)
	1091	D STDT
	1092	"RTN","PRC A313P",15, 0)
	1093	; Set AR Transactio n Types
	1094	"RTN","PRC A313P",16, 0)
	1095	D SET3491
	1096	"RTN","PRC A313P",17, 0)
	1097	;
	1098	"RTN","PRC A313P",18, 0)
	1099	Q
	1100	"RTN","PRC A313P",19, 0)
	1101	;
	1102	"RTN","PRC A313P",20, 0)
	1103	STDT ; En try point for PRCA4 .5313 set of Patien t Statemen t date dep endent upo n the Pati ent Last
	1104	Name
	1105	"RTN","PRC A313P",21, 0)
	1106	D BMES^XP DUTL("Star ting Patie nt Stateme nt Date Re set.")
	1107	"RTN","PRC A313P",22, 0)
	1108	N DEBT,DI E
	1109	"RTN","PRC A313P",23, 0)
	1110	S DIE="^R CD(340,"
	1111	"RTN","PRC A313P",24, 0)
	1112	S DEBT=""
	1113	"RTN","PRC A313P",25, 0)
	1114	F S DEBT =$O(^RCD(3 40,"AB","D PT(",DEBT) ) Q:DEBT=" " D
	1115	"RTN","PRC A313P",26, 0)
	1116	. N PAT,D PT,NAME,DA ,DR
	1117	"RTN","PRC A313P",27, 0)
	1118	. S PAT=$ P($G(^RCD( 340,DEBT,0 )),U)
	1119	"RTN","PRC A313P",28, 0)
	1120	. S DPT=$ P(PAT,";", 1)
	1121	"RTN","PRC A313P",29, 0)
	1122	. S NAME= $P($G(^DPT (DPT,0)),U )
	1123	"RTN","PRC A313P",30, 0)
	1124	. S DA=DE BT
	1125	"RTN","PRC A313P",31, 0)
	1126	. S DR=". 03////"_+$ $ACSET^RCC PCFN1(NAME )
	1127	"RTN","PRC A313P",32, 0)
	1128	. D ^DIE
	1129	"RTN","PRC A313P",33, 0)
	1130	;
	1131	"RTN","PRC A313P",34, 0)
	1132	; Set cro ss-referen ce in AR E vent (341) if Patien t Statemen t date exi sts
	1133	"RTN","PRC A313P",35, 0)
	1134	N DA,DIK
	1135	"RTN","PRC A313P",36, 0)
	1136	S DIK="^R C(341,"
	1137	"RTN","PRC A313P",37, 0)
	1138	S DA="" F S DA=$O( ^RC(341,DA )) Q:DA="" I $G(^RC (341,DA,6) )'="" D IX 1^DIK
	1139	"RTN","PRC A313P",38, 0)
	1140	;
	1141	"RTN","PRC A313P",39, 0)
	1142	D BMES^XP DUTL("Pati ent Statem ent Date R eset Compl ete.")
	1143	"RTN","PRC A313P",40, 0)
	1144	Q
	1145	"RTN","PRC A313P",41, 0)
	1146	;
	1147	"RTN","PRC A313P",42, 0)
	1148	CLEANUP ; PRCA4.5 313
	1149	"RTN","PRC A313P",43, 0)
	1150	; Remove site state ment date
	1151	"RTN","PRC A313P",44, 0)
	1152	D BMES^XP DUTL("Star ting Patie nt Stateme nt Cleanup .")
	1153	"RTN","PRC A313P",45, 0)
	1154	N DA,DR,D IE,X,RCT
	1155	"RTN","PRC A313P",46, 0)
	1156	S DA=1
	1157	"RTN","PRC A313P",47, 0)
	1158	S DR=".11 ///@"
	1159	"RTN","PRC A313P",48, 0)
	1160	S DIE="^R C(342,"
	1161	"RTN","PRC A313P",49, 0)
	1162	D ^DIE
	1163	"RTN","PRC A313P",50, 0)
	1164	;
	1165	"RTN","PRC A313P",51, 0)
	1166	; Remove all monthl y data
	1167	"RTN","PRC A313P",52, 0)
	1168	S DIK="^R CT(349,"
	1169	"RTN","PRC A313P",53, 0)
	1170	S DA=0 F S DA=$O(^ RCT(349,DA )) Q:DA="" D ^DIK
	1171	"RTN","PRC A313P",54, 0)
	1172	S ^RCT(34 9,0)="AR T RANSMISSIO N RECORDS^ 349I^^"
	1173	"RTN","PRC A313P",55, 0)
	1174	S DIK="^R CPS(349.2, "
	1175	"RTN","PRC A313P",56, 0)
	1176	S DA=0 F S DA=$O(^ RCPS(349.2 ,DA)) Q:DA ="" D ^DI K
	1177	"RTN","PRC A313P",57, 0)
	1178	S ^RCPS(3 49.2,0)="A R CBSS STA TEMENTS^34 9.2I^^"
	1179	"RTN","PRC A313P",58, 0)
	1180	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T K ^RCT( 349.1,+RCT ,4),^RCT(3 49.1,+RCT, 5)
	1181	"RTN","PRC A313P",59, 0)
	1182	;
	1183	"RTN","PRC A313P",60, 0)
	1184	D BMES^XP DUTL("Pati ent Statem ent Cleanu p complete .")
	1185	"RTN","PRC A313P",61, 0)
	1186	Q
	1187	"RTN","PRC A313P",62, 0)
	1188	;
	1189	"RTN","PRC A313P",63, 0)
	1190	SET3491 ; PRCA4.5 313
	1191	"RTN","PRC A313P",64, 0)
	1192	; Set val ues for Pr oduction o r Test AR Transmissi on Type
	1193	"RTN","PRC A313P",65, 0)
	1194	N PROD,CC ,CP,CA,IEN ,TT,TTVAL
	1195	"RTN","PRC A313P",66, 0)
	1196	;
	1197	"RTN","PRC A313P",67, 0)
	1198	D BMES^XP DUTL("Star ting AR Tr ansaction Type Updat e.")
	1199	"RTN","PRC A313P",68, 0)
	1200	;
	1201	"RTN","PRC A313P",69, 0)
	1202	; Set whe ther envir onment is Production or Test a nd define expected/n ew values
	1203	"RTN","PRC A313P",70, 0)
	1204	S PROD=$$ PROD^XUPRO D
	1205	"RTN","PRC A313P",71, 0)
	1206	S (CC(1), CP(1),CA(1 ))="XXX"
	1207	"RTN","PRC A313P",72, 0)
	1208	S CC(3)=" Q-"_$S(PRO D:"CBS",1: "CCT")_" URL "
	1209	"RTN","PRC A313P",73, 0)
	1210	S CP(3)=" Q-"_$S(PRO D:"CPP",1: "CPT")_" URL "
	1211	"RTN","PRC A313P",74, 0)
	1212	S CA(3)=" Q-"_$S(PRO D:"CAP",1: "CAT")_" URL "
	1213	"RTN","PRC A313P",75, 0)
	1214	;
	1215	"RTN","PRC A313P",76, 0)
	1216	; Validat e Domains are availa ble. Writ e error if not
	1217	"RTN","PRC A313P",77, 0)
	1218	I '$D(^DI C(4.2,"B", CC(3)))!(' $D(^DIC(4. 2,"B",CP(3 ))))!('$D( ^DIC(4.2," B",CA(3))) ) D Q
	1219	"RTN","PRC A313P",78, 0)
	1220	. N LINE S $P(LINE, "*",79)=""
	1221	"RTN","PRC A313P",79, 0)
	1222	. D BMES^ XPDUTL(LIN E)
	1223	"RTN","PRC A313P",80, 0)
	1224	. D MES^X PDUTL("Dom ains for P RCA4.531 3 have not been full y set up." )
	1225	"RTN","PRC A313P",81, 0)
	1226	. D MES^X PDUTL("Ple ase establ ish Domain s for: ")
	1227	"RTN","PRC A313P",82, 0)
	1228	. D MES^X PDUTL("CCP C PATIENT STATEMENTS , PATIENT STATEMENT UPDATE, an d ANNUAL P AYMENT
	1229	STATEMENTS .")
	1230	"RTN","PRC A313P",83, 0)
	1231	. D BMES^ XPDUTL(LIN E)
	1232	"RTN","PRC A313P",84, 0)
	1233	;
	1234	"RTN","PRC A313P",85, 0)
	1235	; Validat e 'PS', 'P U', and 'P Y' are set for Patie nt Stateme nt, Nightl y Update, and Annual Payment
	1236	Statement
	1237	"RTN","PRC A313P",86, 0)
	1238	F TT="PS" ,"PU","PY" S IEN=$O( ^RCT(349.1 ,"B",TT,0) ) D
	1239	"RTN","PRC A313P",87, 0)
	1240	. N DOMAI N,I
	1241	"RTN","PRC A313P",88, 0)
	1242	. I TT="P S" M DOMAI N=CC
	1243	"RTN","PRC A313P",89, 0)
	1244	. I TT="P U" M DOMAI N=CP
	1245	"RTN","PRC A313P",90, 0)
	1246	. I TT="P Y" M DOMAI N=CA
	1247	"RTN","PRC A313P",91, 0)
	1248	. ; If no IEN creat e new leve l one and three with cross-ref erences
	1249	"RTN","PRC A313P",92, 0)
	1250	. I IEN=" " D SET1(T T,.DOMAIN) Q
	1251	"RTN","PRC A313P",93, 0)
	1252	. ; If no 3 level o r it is no t set to e xpected va lue reset 3 level
	1253	"RTN","PRC A313P",94, 0)
	1254	. I IEN'= "" D
	1255	"RTN","PRC A313P",95, 0)
	1256	. F I=1,3 S TTVAL(I )=$P($G(^R CT(349.1,I EN,3)),U,I )
	1257	"RTN","PRC A313P",96, 0)
	1258	. I DOMAI N(1)_DOMAI N(3)'=TTVA L(1)_TTVAL (3) D SET3 (IEN,.DOMA IN)
	1259	"RTN","PRC A313P",97, 0)
	1260	;
	1261	"RTN","PRC A313P",98, 0)
	1262	D BMES^XP DUTL("AR T ransaction Type Upda te complet e.")
	1263	"RTN","PRC A313P",99, 0)
	1264	;
	1265	"RTN","PRC A313P",100 ,0)
	1266	Q
	1267	"RTN","PRC A313P",101 ,0)
	1268	;
	1269	"RTN","PRC A313P",102 ,0)
	1270	SET1(TT,DO MAIN) ; P RCA4.531 3
	1271	"RTN","PRC A313P",103 ,0)
	1272	; Set bot h the 1 an d 3 level for 349.1
	1273	"RTN","PRC A313P",104 ,0)
	1274	; New and Set Field values fo r DIC(4.2
	1275	"RTN","PRC A313P",105 ,0)
	1276	N TTNAME, ZZ,DIC,Y
	1277	"RTN","PRC A313P",106 ,0)
	1278	I TT="PS" S TTNAME= "CCPC PATI ENT STATEM ENT"
	1279	"RTN","PRC A313P",107 ,0)
	1280	I TT="PU" S TTNAME= "PATIENT S TATEMENT U PDATE"
	1281	"RTN","PRC A313P",108 ,0)
	1282	I TT="PY" S TTNAME= "ANNUAL PA YMENT STAT EMENTS"
	1283	"RTN","PRC A313P",109 ,0)
	1284	;
	1285	"RTN","PRC A313P",110 ,0)
	1286	; Set 1 l evel value s
	1287	"RTN","PRC A313P",111 ,0)
	1288	S DIC="^R CT(349.1," ,DIC(0)="L "
	1289	"RTN","PRC A313P",112 ,0)
	1290	S X=TT
	1291	"RTN","PRC A313P",113 ,0)
	1292	S DIC("DR ")=".02/// "_TTNAME_" ;.03///"_1 _";"
	1293	"RTN","PRC A313P",114 ,0)
	1294	D FILE^DI CN
	1295	"RTN","PRC A313P",115 ,0)
	1296	S IEN=+Y
	1297	"RTN","PRC A313P",116 ,0)
	1298	;
	1299	"RTN","PRC A313P",117 ,0)
	1300	; Set 3 l evel
	1301	"RTN","PRC A313P",118 ,0)
	1302	D SET3(IE N,.DOMAIN)
	1303	"RTN","PRC A313P",119 ,0)
	1304	;
	1305	"RTN","PRC A313P",120 ,0)
	1306	Q
	1307	"RTN","PRC A313P",121 ,0)
	1308	SET3(IEN,D OMAIN) ; PRCA4.53 13
	1309	"RTN","PRC A313P",122 ,0)
	1310	; Set 3 l evel for 3 49.1
	1311	"RTN","PRC A313P",123 ,0)
	1312	S DOMAIN( "IEN")=$O( ^DIC(4.2," B",DOMAIN( 3),0))
	1313	"RTN","PRC A313P",124 ,0)
	1314	S ^RCT(34 9.1,IEN,3) =DOMAIN(1) _U_DOMAIN( "IEN")_U_D OMAIN(3)
	1315	"RTN","PRC A313P",125 ,0)
	1316	; PRCA4. 5313 - Se t Cross-Re ferences f or this IE N
	1317	"RTN","PRC A313P",126 ,0)
	1318	S DA=IEN, DIK="^RCT( 349.1," D IX1^DIK
	1319	"RTN","PRC A313P",127 ,0)
	1320	;
	1321	"RTN","PRC A313P",128 ,0)
	1322	Q
	1323	"RTN","PRC A313P",129 ,0)
	1324	;
	1325	"RTN","PRC A313P",130 ,0)
	1326	PRE ; Pre -install a ctions for the Data Dictionary
	1327	"RTN","PRC A313P",131 ,0)
	1328	;
	1329	"RTN","PRC A313P",132 ,0)
	1330	D BMES^XP DUTL("Star ting Pre-I nstall Cha nges.")
	1331	"RTN","PRC A313P",133 ,0)
	1332	;
	1333	"RTN","PRC A313P",134 ,0)
	1334	N DIK,DA
	1335	"RTN","PRC A313P",135 ,0)
	1336	; Remove DD for 349 .1, elemen ts 41, 42, and 43 - new elemen ts are ent ered durin g regular install
	1337	"RTN","PRC A313P",136 ,0)
	1338	S DIK="^D D(349.1,", DA(1)=349. 1
	1339	"RTN","PRC A313P",137 ,0)
	1340	F DA=41,4 2,43 D ^DI K
	1341	"RTN","PRC A313P",138 ,0)
	1342	;
	1343	"RTN","PRC A313P",139 ,0)
	1344	; Remove DD for 349 , element .09 to cha nge from o ld to new Style Cros s Referenc e.
	1345	"RTN","PRC A313P",140 ,0)
	1346	S DIK="^D D(349,",DA (1)=349
	1347	"RTN","PRC A313P",141 ,0)
	1348	S DA=.09 D ^DIK
	1349	"RTN","PRC A313P",142 ,0)
	1350	;
	1351	"RTN","PRC A313P",143 ,0)
	1352	D BMES^XP DUTL("Pre- Install Ch anges comp lete.")
	1353	"RTN","PRC A313P",144 ,0)
	1354	Q
	1355	"RTN","PRC A313P",145 ,0)
	1356	;
	1357	"RTN","PRC A313P",146 ,0)
	1358	PRCACPS ; Queue the Patient S tatement A uto-Correc tion Progr am
	1359	"RTN","PRC A313P",147 ,0)
	1360	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	1361	"RTN","PRC A313P",148 ,0)
	1362	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	1363	"RTN","PRC A313P",149 ,0)
	1364	S ZTRTN=" START^PRCA CPS",ZTDTH =$H,ZTIO=" "
	1365	"RTN","PRC A313P",150 ,0)
	1366	D ^%ZTLOA D
	1367	"RTN","PRC A313P",151 ,0)
	1368	I $G(ZTSK ) D Q
	1369	"RTN","PRC A313P",152 ,0)
	1370	.D BMES^X PDUTL(">>> POST-INSTA LL CONSOLI DATED PATI ENT STATEM ENT AUTO-C ORRECTION" )
	1371	"RTN","PRC A313P",153 ,0)
	1372	.D MES^XP DUTL(">>>P ROGRAM HAS BEEN QUEU ED IN TASK "_ZTSK)
	1373	"RTN","PRC A313P",154 ,0)
	1374	I '$G(ZTS K) D Q
	1375	"RTN","PRC A313P",155 ,0)
	1376	.D BMES^X PDUTL(">>> ERROR: POS T-INSTALL CONSOLIDAT ED PATIENT STATEMENT AUTO-
	1377	CORRECTION ")
	1378	"RTN","PRC A313P",156 ,0)
	1379	.D MES^XP DUTL(">>>P ROGRAM COU LD NOT BE QUEUED")
	1380	"RTN","PRC A313P",157 ,0)
	1381	Q
	1382	"RTN","PRC AACR")
	1383	0^19^B1273 36081^n/a
	1384	"RTN","PRC AACR",1,0)
	1385	PRCAACR ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION REPOR T ;09/21/1 5 3:34 PM
	1386	"RTN","PRC AACR",2,0)
	1387	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 131
	1388	"RTN","PRC AACR",3,0)
	1389	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1390	"RTN","PRC AACR",4,0)
	1391	;
	1392	"RTN","PRC AACR",5,0)
	1393	Q
	1394	"RTN","PRC AACR",6,0)
	1395	;
	1396	"RTN","PRC AACR",7,0)
	1397	PSACRT ; r eport, pri nts sorted individua l transact ions that have been auto-corre cted
	1398	"RTN","PRC AACR",8,0)
	1399	N DIC,PAG E,BY,DHD,F ILENUM,FLD S,FR,L,TO, PRCABDT,PR CAEDT,PRCA SORT
	1400	"RTN","PRC AACR",9,0)
	1401	W !
	1402	"RTN","PRC AACR",10,0 )
	1403	PSDATE ;
	1404	"RTN","PRC AACR",11,0 )
	1405	; Determi ne if Auto Correct p rocess is currently running
	1406	"RTN","PRC AACR",12,0 )
	1407	N PRCASTR T,QUIT,X,X 1,X2,Y
	1408	"RTN","PRC AACR",13,0 )
	1409	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= ""
	1410	"RTN","PRC AACR",14,0 )
	1411	; QUIT if Auto Corr ect proces s is curre ntly runni ng
	1412	"RTN","PRC AACR",15,0 )
	1413	I PRCASTR T'="" D Q :QUIT
	1414	"RTN","PRC AACR",16,0 )
	1415	.S Y=$P(P RCASTRT,U, 2)
	1416	"RTN","PRC AACR",17,0 )
	1417	.D DD^%DT
	1418	"RTN","PRC AACR",18,0 )
	1419	.S PRCAST RT=Y
	1420	"RTN","PRC AACR",19,0 )
	1421	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram is cur rently run ning."
	1422	"RTN","PRC AACR",20,0 )
	1423	.W !,"It was starte d at ",PRC ASTRT," an d can take up to 1 h our to com plete."
	1424	"RTN","PRC AACR",21,0 )
	1425	.W !!,"If you choos e to conti nue with t his report , it may n ot reflect all of th e"
	1426	"RTN","PRC AACR",22,0 )
	1427	.W !,"cha nges from this lates t run of t he Patient Statement Auto-Corr ection Pro gram."
	1428	"RTN","PRC AACR",23,0 )
	1429	.W !
	1430	"RTN","PRC AACR",24,0 )
	1431	.S DIR(0) ="Y",DIR(" A")="Do yo u want to continue", DIR("B")=" NO"
	1432	"RTN","PRC AACR",25,0 )
	1433	.D ^DIR
	1434	"RTN","PRC AACR",26,0 )
	1435	.W !
	1436	"RTN","PRC AACR",27,0 )
	1437	.; Quit i f ^, ^^, T imeout or No
	1438	"RTN","PRC AACR",28,0 )
	1439	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	1440	"RTN","PRC AACR",29,0 )
	1441	.; Send M ailMan mes sage to PR CACPS mail group if Yes
	1442	"RTN","PRC AACR",30,0 )
	1443	.I Y=1 D PRCAMAIL^P RCACPSA(PR CASTRT)
	1444	"RTN","PRC AACR",31,0 )
	1445	.K DTOUT, DUOUT,DIRO UT
	1446	"RTN","PRC AACR",32,0 )
	1447	;
	1448	"RTN","PRC AACR",33,0 )
	1449	N DIROUT, DIS,DTOUT, DUOUT
	1450	"RTN","PRC AACR",34,0 )
	1451	S DIR("A" )="Date Ra nge: FROM: ",DIR("B" )="T-7"
	1452	"RTN","PRC AACR",35,0 )
	1453	S DIR("?" )="The def ault date is T-7. F uture date s may not be entered ."
	1454	"RTN","PRC AACR",36,0 )
	1455	S DIR(0)= "DO" D ^DI R
	1456	"RTN","PRC AACR",37,0 )
	1457	S:Y'="" P RCABDT=Y
	1458	"RTN","PRC AACR",38,0 )
	1459	I $D(DIRU T)&'Y K DI RUT Q
	1460	"RTN","PRC AACR",39,0 )
	1461	I PRCABDT >DT G PSDA TE
	1462	"RTN","PRC AACR",40,0 )
	1463	W "(",Y(0 ),")"
	1464	"RTN","PRC AACR",41,0 )
	1465	K DIR,X,Y
	1466	"RTN","PRC AACR",42,0 )
	1467	S DIR(0)= "DO"
	1468	"RTN","PRC AACR",43,0 )
	1469	S DIR("A" )="Date Ra nge: TO: ",DIR("B" )="T"
	1470	"RTN","PRC AACR",44,0 )
	1471	S DIR("?" )="The def ault date is T, but any date m ay be ente red."
	1472	"RTN","PRC AACR",45,0 )
	1473	D ^DIR S: Y="" Y=DT
	1474	"RTN","PRC AACR",46,0 )
	1475	I $D(DIRU T)&'Y K DI RUT Q
	1476	"RTN","PRC AACR",47,0 )
	1477	W "(",Y(0 ),")"
	1478	"RTN","PRC AACR",48,0 )
	1479	S PRCAEDT =Y
	1480	"RTN","PRC AACR",49,0 )
	1481	I PRCABDT >PRCAEDT G PSDATE
	1482	"RTN","PRC AACR",50,0 )
	1483	K DIR
	1484	"RTN","PRC AACR",51,0 )
	1485	S DIR(0)= "S^1:Auto- Correct Re ason;2:Deb tor Name;3 :Bill Numb er;4:Trans action Num ber;5:Auto -
	1486	Correct Da te",DIR("A ")="Sort b y"
	1487	"RTN","PRC AACR",52,0 )
	1488	S DIR("B" )=1
	1489	"RTN","PRC AACR",53,0 )
	1490	D ^DIR K DIR
	1491	"RTN","PRC AACR",54,0 )
	1492	S PRCASOR T=Y
	1493	"RTN","PRC AACR",55,0 )
	1494	Q:$D(DTOU T)!($D(DUO UT))!($D(D IROUT))
	1495	"RTN","PRC AACR",56,0 )
	1496	;
	1497	"RTN","PRC AACR",57,0 )
	1498	; Prompt for device
	1499	"RTN","PRC AACR",58,0 )
	1500	W !
	1501	"RTN","PRC AACR",59,0 )
	1502	N ZTRTN,Z TDESC,ZTSA VE,ZTSK
	1503	"RTN","PRC AACR",60,0 )
	1504	K IOP,%ZI S,POP,IO(" Q")
	1505	"RTN","PRC AACR",61,0 )
	1506	S %ZIS="Q "
	1507	"RTN","PRC AACR",62,0 )
	1508	D ^%ZIS Q :POP
	1509	"RTN","PRC AACR",63,0 )
	1510	; If Queu ed
	1511	"RTN","PRC AACR",64,0 )
	1512	I $D(IO(" Q")) D Q
	1513	"RTN","PRC AACR",65,0 )
	1514	.K IO("Q" )
	1515	"RTN","PRC AACR",66,0 )
	1516	.I $G(IOS T)["P-MES" S ZTRTN=" PRT^PRCAAC R1"
	1517	"RTN","PRC AACR",67,0 )
	1518	.I $G(IOS T)'["P-MES " S ZTRTN= "PRT^PRCAA CR"
	1519	"RTN","PRC AACR",68,0 )
	1520	.S ZTSAVE ("PRCABDT" )="",ZTSAV E("PRCAEDT ")="",ZTSA VE("PRCASO RT")=""
	1521	"RTN","PRC AACR",69,0 )
	1522	.D ^%ZTLO AD
	1523	"RTN","PRC AACR",70,0 )
	1524	.D HOME^% ZIS
	1525	"RTN","PRC AACR",71,0 )
	1526	.I $D(ZTS K)[0 W !!? 5,"Report cancelled! "
	1527	"RTN","PRC AACR",72,0 )
	1528	.E W !!? 5,"Report queued!"
	1529	"RTN","PRC AACR",73,0 )
	1530	.K POP
	1531	"RTN","PRC AACR",74,0 )
	1532	;
	1533	"RTN","PRC AACR",75,0 )
	1534	;Print Re port if no t QUEUED
	1535	"RTN","PRC AACR",76,0 )
	1536	PRT ;
	1537	"RTN","PRC AACR",77,0 )
	1538	; If not queued and output se nt to P-ME S
	1539	"RTN","PRC AACR",78,0 )
	1540	I $G(IOST )["P-MES" D PRT^PRCA ACR1 Q
	1541	"RTN","PRC AACR",79,0 )
	1542	;If not q ueued and output not sent to P -MES
	1543	"RTN","PRC AACR",80,0 )
	1544	U IO
	1545	"RTN","PRC AACR",81,0 )
	1546	K ^TMP("P RCAACR",$J )
	1547	"RTN","PRC AACR",82,0 )
	1548	S PAGE=0
	1549	"RTN","PRC AACR",83,0 )
	1550	S DASH="" ,$P(DASH," -",79)=""
	1551	"RTN","PRC AACR",84,0 )
	1552	S DIS(0)= "I $D(^PRC A(433,""TA CD"",PRCAT SRT,D0))", L=0
	1553	"RTN","PRC AACR",85,0 )
	1554	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AACTF,PRCA TNTF
	1555	"RTN","PRC AACR",86,0 )
	1556	S PRCATSR T=PRCABDT- .00001
	1557	"RTN","PRC AACR",87,0 )
	1558	; Loop th rough the specified date range
	1559	"RTN","PRC AACR",88,0 )
	1560	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT) D
	1561	"RTN","PRC AACR",89,0 )
	1562	.S PRCATN =""
	1563	"RTN","PRC AACR",90,0 )
	1564	.; Loop t hrough the transacti ons for th e current date
	1565	"RTN","PRC AACR",91,0 )
	1566	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	1567	"RTN","PRC AACR",92,0 )
	1568	..; Load associated data fiel ds for rep ort
	1569	"RTN","PRC AACR",93,0 )
	1570	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	1571	"RTN","PRC AACR",94,0 )
	1572	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	1573	"RTN","PRC AACR",95,0 )
	1574	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	1575	"RTN","PRC AACR",96,0 )
	1576	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	1577	"RTN","PRC AACR",97,0 )
	1578	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	1579	"RTN","PRC AACR",98,0 )
	1580	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	1581	"RTN","PRC AACR",99,0 )
	1582	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	1583	"RTN","PRC AACR",100, 0)
	1584	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	1585	"RTN","PRC AACR",101, 0)
	1586	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	1587	"RTN","PRC AACR",102, 0)
	1588	..S PRCAA CR=$E(PRCA ACR,1,14)
	1589	"RTN","PRC AACR",103, 0)
	1590	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	1591	"RTN","PRC AACR",104, 0)
	1592	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	1593	"RTN","PRC AACR",105, 0)
	1594	..I PRCAA CTF="YES" S PRCATNTF =""
	1595	"RTN","PRC AACR",106, 0)
	1596	..;
	1597	"RTN","PRC AACR",107, 0)
	1598	..; If an y of the n odes are n ull Quit
	1599	"RTN","PRC AACR",108, 0)
	1600	..I PRCAA CR=""!(PRC ADTR="")!( PRCABN="") !(PRCATN=" ")!(PRCAAC D="") Q
	1601	"RTN","PRC AACR",109, 0)
	1602	..;
	1603	"RTN","PRC AACR",110, 0)
	1604	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number
	1605	"RTN","PRC AACR",111, 0)
	1606	..I PRCAS ORT=1 D Q
	1607	"RTN","PRC AACR",112, 0)
	1608	...S
	1609	^TMP("PRCA ACR",$J,PR CAACR,PRCA DTR,PRCABN )=PRCAACR_ U_PRCADTR_ U_PRCABN_U _PRCATNTF_ U
	1610	_PRCAACD_U _PRCASSN
	1611	"RTN","PRC AACR",113, 0)
	1612	..;
	1613	"RTN","PRC AACR",114, 0)
	1614	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	1615	"RTN","PRC AACR",115, 0)
	1616	..I PRCAS ORT=2 D Q
	1617	"RTN","PRC AACR",116, 0)
	1618	...S
	1619	^TMP("PRCA ACR",$J,PR CADTR,PRCA BN,PRCATN) =PRCADTR_U _PRCABN_U_ PRCASSN_U_ PRCATNTF_U _
	1620	PRCAACD_U_ PRCAACR
	1621	"RTN","PRC AACR",117, 0)
	1622	..;
	1623	"RTN","PRC AACR",118, 0)
	1624	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1625	"RTN","PRC AACR",119, 0)
	1626	..I PRCAS ORT=3 D Q
	1627	"RTN","PRC AACR",120, 0)
	1628	...S
	1629	^TMP("PRCA ACR",$J,PR CABN,PRCAD TR,PRCATN) =PRCABN_U_ PRCADTR_U_ PRCASSN_U_ PRCATNTF_U _
	1630	PRCAACD_U_ PRCAACR
	1631	"RTN","PRC AACR",121, 0)
	1632	..;
	1633	"RTN","PRC AACR",122, 0)
	1634	..; Store in ^TMP s orted by T ransaction , Debtor a nd Bill Nu mber
	1635	"RTN","PRC AACR",123, 0)
	1636	..I PRCAS ORT=4 D Q
	1637	"RTN","PRC AACR",124, 0)
	1638	...S
	1639	^TMP("PRCA ACR",$J,PR CATN,PRCAD TR,PRCABN) =PRCATNTF_ U_PRCADTR_ U_PRCABN_U _PRCASSN_U _
	1640	PRCAACD_U_ PRCAACR
	1641	"RTN","PRC AACR",125, 0)
	1642	..;
	1643	"RTN","PRC AACR",126, 0)
	1644	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number and Trans action Num ber
	1645	"RTN","PRC AACR",127, 0)
	1646	..I PRCAS ORT=5 D Q
	1647	"RTN","PRC AACR",128, 0)
	1648	...S
	1649	^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)=P RCAACD_U_P RCADTR_U_P RCABN_U_PR C
	1650	ASSN_U_PRC ATNTF_U_PR CAACR
	1651	"RTN","PRC AACR",129, 0)
	1652	;
	1653	"RTN","PRC AACR",130, 0)
	1654	;
	1655	"RTN","PRC AACR",131, 0)
	1656	N QUIT ; QUIT befor e end of r eport
	1657	"RTN","PRC AACR",132, 0)
	1658	S QUIT=""
	1659	"RTN","PRC AACR",133, 0)
	1660	; Display Auto-Corr ect data s orted by A uto Correc tion Reaso n
	1661	"RTN","PRC AACR",134, 0)
	1662	I PRCASOR T=1 D
	1663	"RTN","PRC AACR",135, 0)
	1664	.; Data L ayout
	1665	^TMP("PRCA ACR",$J,PR CAACR,PRCA DTR,PRCABN )=PRCAACR_ U_PRCADTR_ U_PRCABN_U _PRCATNTF_ U
	1666	_PRCAACD_U _PRCASSN
	1667	"RTN","PRC AACR",136, 0)
	1668	.; Displa y Auto Cor rection Re ason heade r
	1669	"RTN","PRC AACR",137, 0)
	1670	.N Y
	1671	"RTN","PRC AACR",138, 0)
	1672	.D PSACRT P1
	1673	"RTN","PRC AACR",139, 0)
	1674	.S PRCAAC R=""
	1675	"RTN","PRC AACR",140, 0)
	1676	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D Q:QUIT
	1677	"RTN","PRC AACR",141, 0)
	1678	..S PRCAD TR=""
	1679	"RTN","PRC AACR",142, 0)
	1680	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	1681	"RTN","PRC AACR",143, 0)
	1682	...S PRCA BN=""
	1683	"RTN","PRC AACR",144, 0)
	1684	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:QU IT
	1685	"RTN","PRC AACR",145, 0)
	1686	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	1687	"RTN","PRC AACR",146, 0)
	1688	....S Y=$ P(PRCADATA ,U,5)
	1689	"RTN","PRC AACR",147, 0)
	1690	....D DD^ %DT
	1691	"RTN","PRC AACR",148, 0)
	1692	....S $P( PRCADATA,U ,5)=Y
	1693	"RTN","PRC AACR",149, 0)
	1694	....W
	1695	!,$P(PRCAD ATA,U,1),? 16,$E($P(P RCADATA,U, 2),1,18),? 36,$E($P(P RCADATA,U, 6),6,9),?4 2,$E($P(PR CADA
	1696	TA,U,3),1, 11),?55,$J ($P(PRCADA TA,U,4),9) ,?66,$P(PR CADATA,U,5 )
	1697	"RTN","PRC AACR",150, 0)
	1698	....I $Y> (IOSL-3) D
	1699	"RTN","PRC AACR",151, 0)
	1700	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1701	"RTN","PRC AACR",152, 0)
	1702	......D P RTC
	1703	"RTN","PRC AACR",153, 0)
	1704	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1705	"RTN","PRC AACR",154, 0)
	1706	.....D PS ACRTP1
	1707	"RTN","PRC AACR",155, 0)
	1708	;
	1709	"RTN","PRC AACR",156, 0)
	1710	; Display Auto-Corr ect data s orted by D ebtor
	1711	"RTN","PRC AACR",157, 0)
	1712	I PRCASOR T=2 D
	1713	"RTN","PRC AACR",158, 0)
	1714	.; Data L ayout
	1715	^TMP("PRCA ACR",$J,PR CADTR,PRCA BN,PRCATN) =PRCADTR_U _PRCABN_U_ PRCASSN_U_ PRCATNTF_U _
	1716	PRCAACD_U_ PRCAACR
	1717	"RTN","PRC AACR",159, 0)
	1718	.; Displa y Debtor h eader
	1719	"RTN","PRC AACR",160, 0)
	1720	.D PSACRT P2
	1721	"RTN","PRC AACR",161, 0)
	1722	.S PRCADT R=""
	1723	"RTN","PRC AACR",162, 0)
	1724	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D Q:QUIT
	1725	"RTN","PRC AACR",163, 0)
	1726	..S PRCAB N=""
	1727	"RTN","PRC AACR",164, 0)
	1728	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D Q:Q UIT
	1729	"RTN","PRC AACR",165, 0)
	1730	...S PRCA TN=""
	1731	"RTN","PRC AACR",166, 0)
	1732	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D Q:QUI T
	1733	"RTN","PRC AACR",167, 0)
	1734	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	1735	"RTN","PRC AACR",168, 0)
	1736	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1737	"RTN","PRC AACR",169, 0)
	1738	....W
	1739	!,$E($P(PR CADATA,U,1 ),1,18),?2 0,$P(PRCAD ATA,U,2),? 33,$E($P(P RCADATA,U, 3),6,9),?3 9,$J($P(PR CADA
	1740	TA,U,4),9) ,?50,$P(PR CADATA,U,5 ),?64,$P(P RCADATA,U, 6)
	1741	"RTN","PRC AACR",170, 0)
	1742	....I $Y> (IOSL-3) D
	1743	"RTN","PRC AACR",171, 0)
	1744	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1745	"RTN","PRC AACR",172, 0)
	1746	......D P RTC
	1747	"RTN","PRC AACR",173, 0)
	1748	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1749	"RTN","PRC AACR",174, 0)
	1750	.....D PS ACRTP2
	1751	"RTN","PRC AACR",175, 0)
	1752	;
	1753	"RTN","PRC AACR",176, 0)
	1754	; Display Auto-Corr ect data s orted by A UTO-C DATE
	1755	"RTN","PRC AACR",177, 0)
	1756	I PRCASOR T=3 D
	1757	"RTN","PRC AACR",178, 0)
	1758	.; Data L ayout
	1759	^TMP("PRCA ACR",$J,PR CABN,PRCAD TR,PRCATN) =PRCABN_U_ PRCADTR_U_ PRCASSN_U_ PRCATNTF_U _
	1760	PRCAACD_U_ PRCAACR
	1761	"RTN","PRC AACR",179, 0)
	1762	.; Displa y Bill Num ber header
	1763	"RTN","PRC AACR",180, 0)
	1764	.D PSACRT P3
	1765	"RTN","PRC AACR",181, 0)
	1766	.S PRCABN =""
	1767	"RTN","PRC AACR",182, 0)
	1768	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D Q: QUIT
	1769	"RTN","PRC AACR",183, 0)
	1770	..S PRCAD TR=""
	1771	"RTN","PRC AACR",184, 0)
	1772	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1773	"RTN","PRC AACR",185, 0)
	1774	...S PRCA TN=""
	1775	"RTN","PRC AACR",186, 0)
	1776	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D Q:QUI T
	1777	"RTN","PRC AACR",187, 0)
	1778	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	1779	"RTN","PRC AACR",188, 0)
	1780	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1781	"RTN","PRC AACR",189, 0)
	1782	....W
	1783	!,$P(PRCAD ATA,U,1),? 13,$E($P(P RCADATA,U, 2),1,18),? 33,$E($P(P RCADATA,U, 3),6,9),?3 9,$J($P(PR CADA
	1784	TA,U,4),9) ,?50,$P(PR CADATA,U,5 ),?64,$P(P RCADATA,U, 6)
	1785	"RTN","PRC AACR",190, 0)
	1786	....I $Y> (IOSL-3) D
	1787	"RTN","PRC AACR",191, 0)
	1788	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1789	"RTN","PRC AACR",192, 0)
	1790	......D P RTC
	1791	"RTN","PRC AACR",193, 0)
	1792	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1793	"RTN","PRC AACR",194, 0)
	1794	.....D PS ACRTP3
	1795	"RTN","PRC AACR",195, 0)
	1796	;
	1797	"RTN","PRC AACR",196, 0)
	1798	; Display Auto-Corr ect data s orted by T ransaction Number
	1799	"RTN","PRC AACR",197, 0)
	1800	I PRCASOR T=4 D
	1801	"RTN","PRC AACR",198, 0)
	1802	.; Data L ayout
	1803	^TMP("PRCA ACR",$J,PR CATN,PRCAD TR,PRCABN) =PRCATNTF_ U_PRCADTR_ U_PRCABN_U _PRCASSN_U _
	1804	PRCAACD_U_ PRCAACR
	1805	"RTN","PRC AACR",199, 0)
	1806	.; Displa y AUTO-C D ATE header
	1807	"RTN","PRC AACR",200, 0)
	1808	.D PSACRT P4
	1809	"RTN","PRC AACR",201, 0)
	1810	.S PRCATN =""
	1811	"RTN","PRC AACR",202, 0)
	1812	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D Q: QUIT
	1813	"RTN","PRC AACR",203, 0)
	1814	..S PRCAD TR=""
	1815	"RTN","PRC AACR",204, 0)
	1816	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1817	"RTN","PRC AACR",205, 0)
	1818	...S PRCA BN=""
	1819	"RTN","PRC AACR",206, 0)
	1820	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D Q:QUI T
	1821	"RTN","PRC AACR",207, 0)
	1822	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	1823	"RTN","PRC AACR",208, 0)
	1824	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1825	"RTN","PRC AACR",209, 0)
	1826	....W
	1827	!,$J($P(PR CADATA,U,1 ),9),?11,$ E($P(PRCAD ATA,U,2),1 ,18),?31,$ P(PRCADATA ,U,3),?44, $E($P(PRCA DATA
	1828	,U,4),6,9) ,?50,$P(PR CADATA,U,5 ),?64,$P(P RCADATA,U, 6)
	1829	"RTN","PRC AACR",210, 0)
	1830	....I $Y> (IOSL-3) D
	1831	"RTN","PRC AACR",211, 0)
	1832	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1833	"RTN","PRC AACR",212, 0)
	1834	......D P RTC
	1835	"RTN","PRC AACR",213, 0)
	1836	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1837	"RTN","PRC AACR",214, 0)
	1838	.....D PS ACRTP4
	1839	"RTN","PRC AACR",215, 0)
	1840	;
	1841	"RTN","PRC AACR",216, 0)
	1842	; Display Auto-Corr ect data s orted by A uto-Correc t date
	1843	"RTN","PRC AACR",217, 0)
	1844	I PRCASOR T=5 D
	1845	"RTN","PRC AACR",218, 0)
	1846	.; Data L ayout
	1847	^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)=P RCAACD_U_P RCADTR_U_P RCABN_U_PR C
	1848	ASSN_U_PRC ATNTF_U_PR CAACR
	1849	"RTN","PRC AACR",219, 0)
	1850	.; Displa y AUTO-C D ATE header
	1851	"RTN","PRC AACR",220, 0)
	1852	.D PSACRT P5
	1853	"RTN","PRC AACR",221, 0)
	1854	.S PRCAAC D=""
	1855	"RTN","PRC AACR",222, 0)
	1856	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D Q:QUIT
	1857	"RTN","PRC AACR",223, 0)
	1858	..S PRCAD TR=""
	1859	"RTN","PRC AACR",224, 0)
	1860	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	1861	"RTN","PRC AACR",225, 0)
	1862	...S PRCA BN=""
	1863	"RTN","PRC AACR",226, 0)
	1864	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:QU IT
	1865	"RTN","PRC AACR",227, 0)
	1866	....S PRC ATN=""
	1867	"RTN","PRC AACR",228, 0)
	1868	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN D Q:QUIT
	1869	"RTN","PRC AACR",229, 0)
	1870	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	1871	"RTN","PRC AACR",230, 0)
	1872	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	1873	"RTN","PRC AACR",231, 0)
	1874	.....W
	1875	!,$P(PRCAD ATA,U,1),? 14,$E($P(P RCADATA,U, 2),1,18),? 34,$P(PRCA DATA,U,3), ?47,$E($P( PRCADATA,U ,4),
	1876	6,9),?53,$ J($P(PRCAD ATA,U,5),9 ),?64,$P(P RCADATA,U, 6)
	1877	"RTN","PRC AACR",232, 0)
	1878	.....I $Y >(IOSL-3) D
	1879	"RTN","PRC AACR",233, 0)
	1880	......I $ E(IOST,1,2 )="C-" D Q:QUIT
	1881	"RTN","PRC AACR",234, 0)
	1882	.......D PRTC
	1883	"RTN","PRC AACR",235, 0)
	1884	.......I $D(DIRUT)! ($D(DTOUT) ) S QUIT=1
	1885	"RTN","PRC AACR",236, 0)
	1886	......D P SACRTP5
	1887	"RTN","PRC AACR",237, 0)
	1888	D ^%ZISC
	1889	"RTN","PRC AACR",238, 0)
	1890	I $E(IOST ,1,2)="C-" ,'$D(DUOUT ),('$D(DTO UT)) W ! S DIR(0)="E " D ^DIR
	1891	"RTN","PRC AACR",239, 0)
	1892	K X,Y,DAS H,D0
	1893	"RTN","PRC AACR",240, 0)
	1894	Q
	1895	"RTN","PRC AACR",241, 0)
	1896	;
	1897	"RTN","PRC AACR",242, 0)
	1898	PRTC ; Pre ss Return To Continu e
	1899	"RTN","PRC AACR",243, 0)
	1900	S DIR(0)= "E" D ^DIR
	1901	"RTN","PRC AACR",244, 0)
	1902	Q
	1903	"RTN","PRC AACR",245, 0)
	1904	;
	1905	"RTN","PRC AACR",246, 0)
	1906	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	1907	"RTN","PRC AACR",247, 0)
	1908	W @IOF
	1909	"RTN","PRC AACR",248, 0)
	1910	S PAGE=PA GE+1
	1911	"RTN","PRC AACR",249, 0)
	1912	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION
	1913	REASON)",? 66,$$UPPER ^VALM1($$F MTE^XLFDT( DT))
	1914	"RTN","PRC AACR",250, 0)
	1915	W !,DASH, !
	1916	"RTN","PRC AACR",251, 0)
	1917	W !,"AUTO -C REASON" ,?16,"DEBT OR",?36,"S SN",?42,"B ILL NO.",? 55,"TRANS NUM",?66," AUTO-C DAT E"
	1918	"RTN","PRC AACR",252, 0)
	1919	W !,"---- ---------- ",?16,"--- ---------- -----",?36 ,"----",?4 2,"------- ----",?55, "--------- ",?66,"--- ---------"
	1920	"RTN","PRC AACR",253, 0)
	1921	Q
	1922	"RTN","PRC AACR",254, 0)
	1923	;
	1924	"RTN","PRC AACR",255, 0)
	1925	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	1926	"RTN","PRC AACR",256, 0)
	1927	W @IOF
	1928	"RTN","PRC AACR",257, 0)
	1929	S PAGE=PA GE+1
	1930	"RTN","PRC AACR",258, 0)
	1931	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y
	1932	DEBTOR)",? 66,$$UPPER ^VALM1($$F MTE^XLFDT( DT))
	1933	"RTN","PRC AACR",259, 0)
	1934	W !,DASH, !
	1935	"RTN","PRC AACR",260, 0)
	1936	W !,"DEBT OR",?20,"B ILL NO.",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"AU TO-C REASO N"
	1937	"RTN","PRC AACR",261, 0)
	1938	W !,"---- ---------- ----",?20, "--------- --",?33,"- ---",?39," ---------" ,?50,"---- --------", ?64,"----- ---------"
	1939	"RTN","PRC AACR",262, 0)
	1940	Q
	1941	"RTN","PRC AACR",263, 0)
	1942	;
	1943	"RTN","PRC AACR",264, 0)
	1944	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	1945	"RTN","PRC AACR",265, 0)
	1946	W @IOF
	1947	"RTN","PRC AACR",266, 0)
	1948	S PAGE=PA GE+1
	1949	"RTN","PRC AACR",267, 0)
	1950	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y BILL
	1951	#)",?66,$$ UPPER^VALM 1($$FMTE^X LFDT(DT))
	1952	"RTN","PRC AACR",268, 0)
	1953	W !,DASH, !
	1954	"RTN","PRC AACR",269, 0)
	1955	W !,"BILL NO.",?13, "DEBTOR",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"AU TO-C REASO N"
	1956	"RTN","PRC AACR",270, 0)
	1957	W !,"---- -------",? 13,"------ ---------- --",?33,"- ---",?39," ---------" ,?50,"---- --------", ?64,"----- ---------"
	1958	"RTN","PRC AACR",271, 0)
	1959	Q
	1960	"RTN","PRC AACR",272, 0)
	1961	;
	1962	"RTN","PRC AACR",273, 0)
	1963	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	1964	"RTN","PRC AACR",274, 0)
	1965	W @IOF
	1966	"RTN","PRC AACR",275, 0)
	1967	S PAGE=PA GE+1
	1968	"RTN","PRC AACR",276, 0)
	1969	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y TRANSACT ION
	1970	NUMBER)",? 66,$$UPPER ^VALM1($$F MTE^XLFDT( DT))
	1971	"RTN","PRC AACR",277, 0)
	1972	W !,DASH, !
	1973	"RTN","PRC AACR",278, 0)
	1974	W !,"TRAN S NUM",?11 ,"DEBTOR", ?31,"BILL NO.",?44," SSN",?50," AUTO-C DAT E",?64,"AU TO-C REASO N"
	1975	"RTN","PRC AACR",279, 0)
	1976	W !,"---- -----",?11 ,"-------- ---------- ",?31,"--- --------", ?44,"----" ,?50,"---- --------", ?64,"----- ---------"
	1977	"RTN","PRC AACR",280, 0)
	1978	Q
	1979	"RTN","PRC AACR",281, 0)
	1980	;
	1981	"RTN","PRC AACR",282, 0)
	1982	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	1983	"RTN","PRC AACR",283, 0)
	1984	W @IOF
	1985	"RTN","PRC AACR",284, 0)
	1986	S PAGE=PA GE+1
	1987	"RTN","PRC AACR",285, 0)
	1988	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION
	1989	DATE)",?66 ,$$UPPER^V ALM1($$FMT E^XLFDT(DT ))
	1990	"RTN","PRC AACR",286, 0)
	1991	W !,DASH, !
	1992	"RTN","PRC AACR",287, 0)
	1993	W !,"AUTO -C DATE",? 14,"DEBTOR ",?34,"BIL L NO.",?47 ,"SSN",?53 ,"TRANS NU M",?64,"AU TO-C REASO N"
	1994	"RTN","PRC AACR",288, 0)
	1995	W !,"---- --------", ?14,"----- ---------- ---",?34," ---------- -",?47,"-- --",?53,"- --------", ?64,"----- ---------"
	1996	"RTN","PRC AACR",289, 0)
	1997	Q
	1998	"RTN","PRC AACR",290, 0)
	1999	;
	2000	"RTN","PRC AACR",291, 0)
	2001	EXIT ;
	2002	"RTN","PRC AACR",292, 0)
	2003	Q
	2004	"RTN","PRC AACR1")
	2005	0^20^B1512 71441^n/a
	2006	"RTN","PRC AACR1",1,0 )
	2007	PRCAACR1 ; ALBANY/BDB -PATIENT S TATEMENTS AUTO-CORRE CTION REPO RT ;09/21/ 15 3:34 PM
	2008	"RTN","PRC AACR1",2,0 )
	2009	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 131
	2010	"RTN","PRC AACR1",3,0 )
	2011	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2012	"RTN","PRC AACR1",4,0 )
	2013	;
	2014	"RTN","PRC AACR1",5,0 )
	2015	Q
	2016	"RTN","PRC AACR1",6,0 )
	2017	;Print Re port when Queued to P-MES
	2018	"RTN","PRC AACR1",7,0 )
	2019	PRT ;
	2020	"RTN","PRC AACR1",8,0 )
	2021	U IO
	2022	"RTN","PRC AACR1",9,0 )
	2023	; build a rray of tr ansaction auto-corre cted
	2024	"RTN","PRC AACR1",10, 0)
	2025	K ^TMP("P RCAACR1",$ J)
	2026	"RTN","PRC AACR1",11, 0)
	2027	N DASH,PA GE
	2028	"RTN","PRC AACR1",12, 0)
	2029	S PAGE=0
	2030	"RTN","PRC AACR1",13, 0)
	2031	S DASH="" ,$P(DASH," -",79)=""
	2032	"RTN","PRC AACR1",14, 0)
	2033	N
	2034	PRCATSRT,P RCATN,PRCA ACD,PRCAAC R,PRCABN,P RCADATA,PR CADTR,PRCA SSN,PRCAIE N,PRCAACTF ,PRC
	2035	ATNTF,PRCA TEMP
	2036	"RTN","PRC AACR1",15, 0)
	2037	S PRCATSR T=PRCABDT- .00001,PRC AIEN=0
	2038	"RTN","PRC AACR1",16, 0)
	2039	; Loop th rough the specified date range
	2040	"RTN","PRC AACR1",17, 0)
	2041	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT) D
	2042	"RTN","PRC AACR1",18, 0)
	2043	.S PRCATN =""
	2044	"RTN","PRC AACR1",19, 0)
	2045	.; Loop t hrough the transacti ons for th e current date
	2046	"RTN","PRC AACR1",20, 0)
	2047	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	2048	"RTN","PRC AACR1",21, 0)
	2049	..; Load associated data fiel ds for rep ort
	2050	"RTN","PRC AACR1",22, 0)
	2051	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	2052	"RTN","PRC AACR1",23, 0)
	2053	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	2054	"RTN","PRC AACR1",24, 0)
	2055	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	2056	"RTN","PRC AACR1",25, 0)
	2057	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	2058	"RTN","PRC AACR1",26, 0)
	2059	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	2060	"RTN","PRC AACR1",27, 0)
	2061	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	2062	"RTN","PRC AACR1",28, 0)
	2063	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	2064	"RTN","PRC AACR1",29, 0)
	2065	..S PRCAS SN=$E(PRCA SSN,6,9)
	2066	"RTN","PRC AACR1",30, 0)
	2067	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	2068	"RTN","PRC AACR1",31, 0)
	2069	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	2070	"RTN","PRC AACR1",32, 0)
	2071	..S PRCAA CR=$E(PRCA ACR,1,14)
	2072	"RTN","PRC AACR1",33, 0)
	2073	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	2074	"RTN","PRC AACR1",34, 0)
	2075	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	2076	"RTN","PRC AACR1",35, 0)
	2077	..I PRCAA CTF="YES" S PRCATNTF =""
	2078	"RTN","PRC AACR1",36, 0)
	2079	..;
	2080	"RTN","PRC AACR1",37, 0)
	2081	..; Stor e in ^TMP sorted by Auto-Corre ct Reason, Debtor an d Bill Num ber #
	2082	"RTN","PRC AACR1",38, 0)
	2083	..I PRCAS ORT=1 D Q
	2084	"RTN","PRC AACR1",39, 0)
	2085	...S
	2086	^TMP("PRCA ACR",$J,PR CAACR,PRCA DTR,PRCABN )=PRCAACR_ U_PRCADTR_ U_PRCABN_U _PRCATNTF_ U
	2087	_PRCAACD_U _PRCASSN
	2088	"RTN","PRC AACR1",40, 0)
	2089	..;
	2090	"RTN","PRC AACR1",41, 0)
	2091	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	2092	"RTN","PRC AACR1",42, 0)
	2093	..I PRCAS ORT=2 D Q
	2094	"RTN","PRC AACR1",43, 0)
	2095	...S
	2096	^TMP("PRCA ACR",$J,PR CADTR,PRCA BN,PRCATN) =PRCADTR_U _PRCABN_U_ PRCASSN_U_ PRCATNTF_U _
	2097	PRCAACD_U_ PRCAACR
	2098	"RTN","PRC AACR1",44, 0)
	2099	..;
	2100	"RTN","PRC AACR1",45, 0)
	2101	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	2102	"RTN","PRC AACR1",46, 0)
	2103	..I PRCAS ORT=3 D Q
	2104	"RTN","PRC AACR1",47, 0)
	2105	...S
	2106	^TMP("PRCA ACR",$J,PR CABN,PRCAD TR,PRCATN) =PRCABN_U_ PRCADTR_U_ PRCASSN_U_ PRCATNTF_U _
	2107	PRCAACD_U_ PRCAACR
	2108	"RTN","PRC AACR1",48, 0)
	2109	..;
	2110	"RTN","PRC AACR1",49, 0)
	2111	..; Store in ^TMP s orted by T ransaction , Debtor a nd #Bill N umber
	2112	"RTN","PRC AACR1",50, 0)
	2113	..I PRCAS ORT=4 D Q
	2114	"RTN","PRC AACR1",51, 0)
	2115	...S
	2116	^TMP("PRCA ACR",$J,PR CATN,PRCAD TR,PRCABN) =PRCATNTF_ U_PRCADTR_ U_PRCABN_U _PRCASSN_U _
	2117	PRCAACD_U_ PRCAACR
	2118	"RTN","PRC AACR1",52, 0)
	2119	..;
	2120	"RTN","PRC AACR1",53, 0)
	2121	..; Store in ^TMP s orted by A uto-Correc t Date, De btor, #Bil l Number a nd Transac tion Numbe r
	2122	"RTN","PRC AACR1",54, 0)
	2123	..I PRCAS ORT=5 D Q
	2124	"RTN","PRC AACR1",55, 0)
	2125	...S
	2126	^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)=P RCAACD_U_P RCADTR_U_P RCABN_U_PR C
	2127	ASSN_U_PRC ATNTF_U_PR CAACR
	2128	"RTN","PRC AACR1",56, 0)
	2129	..Q
	2130	"RTN","PRC AACR1",57, 0)
	2131	;
	2132	"RTN","PRC AACR1",58, 0)
	2133	; Display Auto-Corr ect data s orted by B ill Number
	2134	"RTN","PRC AACR1",59, 0)
	2135	I PRCASOR T=1 D
	2136	"RTN","PRC AACR1",60, 0)
	2137	.; Print Header
	2138	"RTN","PRC AACR1",61, 0)
	2139	.D PSACRT P1
	2140	"RTN","PRC AACR1",62, 0)
	2141	.; Data L ayout
	2142	^TMP("PRCA ACR",$J,PR CAACR,PRCA DTR,PRCABN )=PRCAACR_ U_PRCADTR_ U_PRCABN_U _PRCATNTF_ U
	2143	_PRCAACD_U _PRCASSN
	2144	"RTN","PRC AACR1",63, 0)
	2145	.S PRCAAC R=""
	2146	"RTN","PRC AACR1",64, 0)
	2147	.N Y
	2148	"RTN","PRC AACR1",65, 0)
	2149	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D
	2150	"RTN","PRC AACR1",66, 0)
	2151	..S PRCAD TR=""
	2152	"RTN","PRC AACR1",67, 0)
	2153	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D
	2154	"RTN","PRC AACR1",68, 0)
	2155	...S PRCA BN=""
	2156	"RTN","PRC AACR1",69, 0)
	2157	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2158	"RTN","PRC AACR1",70, 0)
	2159	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	2160	"RTN","PRC AACR1",71, 0)
	2161	....S Y=$ P(PRCADATA ,U,5)
	2162	"RTN","PRC AACR1",72, 0)
	2163	....D DD^ %DT
	2164	"RTN","PRC AACR1",73, 0)
	2165	....S $P( PRCADATA,U ,5)=Y
	2166	"RTN","PRC AACR1",74, 0)
	2167	....S PRC AIEN=PRCAI EN+1
	2168	"RTN","PRC AACR1",75, 0)
	2169	....; Add Auto-Corr ect Reason
	2170	"RTN","PRC AACR1",76, 0)
	2171	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,14 ),$E(PRCAT EMP,16)=" "
	2172	"RTN","PRC AACR1",77, 0)
	2173	....; Add 18 chars of Debtor' s name
	2174	"RTN","PRC AACR1",78, 0)
	2175	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,36)=" "
	2176	"RTN","PRC AACR1",79, 0)
	2177	....; Add SSN
	2178	"RTN","PRC AACR1",80, 0)
	2179	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 ),$E(PRCAT EMP,42)=" "
	2180	"RTN","PRC AACR1",81, 0)
	2181	....; Add Bill Numb er
	2182	"RTN","PRC AACR1",82, 0)
	2183	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,55)=" "
	2184	"RTN","PRC AACR1",83, 0)
	2185	....; Add Transacti on Number
	2186	"RTN","PRC AACR1",84, 0)
	2187	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 66)=" "
	2188	"RTN","PRC AACR1",85, 0)
	2189	....; Add Auto-Corr ect Date
	2190	"RTN","PRC AACR1",86, 0)
	2191	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,74)=" "
	2192	"RTN","PRC AACR1",87, 0)
	2193	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2194	"RTN","PRC AACR1",88, 0)
	2195	....Q
	2196	"RTN","PRC AACR1",89, 0)
	2197	;
	2198	"RTN","PRC AACR1",90, 0)
	2199	; Store i n ^TMP sor ted by Deb tor, Bill Number and Transacti on #
	2200	"RTN","PRC AACR1",91, 0)
	2201	I PRCASOR T=2 D
	2202	"RTN","PRC AACR1",92, 0)
	2203	.; Print Header
	2204	"RTN","PRC AACR1",93, 0)
	2205	.D PSACRT P2
	2206	"RTN","PRC AACR1",94, 0)
	2207	.; Data L ayout
	2208	^TMP("PRCA ACR",$J,PR CADTR,PRCA BN,PRCATN) =PRCADTR_U _PRCABN_U_ PRCASSN_U_ PRCATNTF_U _
	2209	PRCAACD_U_ PRCAACR
	2210	"RTN","PRC AACR1",95, 0)
	2211	.S PRCADT R=""
	2212	"RTN","PRC AACR1",96, 0)
	2213	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D
	2214	"RTN","PRC AACR1",97, 0)
	2215	..S PRCAB N=""
	2216	"RTN","PRC AACR1",98, 0)
	2217	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D
	2218	"RTN","PRC AACR1",99, 0)
	2219	...S PRCA TN=""
	2220	"RTN","PRC AACR1",100 ,0)
	2221	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D
	2222	"RTN","PRC AACR1",101 ,0)
	2223	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	2224	"RTN","PRC AACR1",102 ,0)
	2225	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2226	"RTN","PRC AACR1",103 ,0)
	2227	....S PRC AIEN=PRCAI EN+1
	2228	"RTN","PRC AACR1",104 ,0)
	2229	....; Add 18 chars of Debtor' s name
	2230	"RTN","PRC AACR1",105 ,0)
	2231	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,18 ),$E(PRCAT EMP,20)=" "
	2232	"RTN","PRC AACR1",106 ,0)
	2233	....; Add Bill Numb er
	2234	"RTN","PRC AACR1",107 ,0)
	2235	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,2 ),$E(PRCAT EMP,33)=" "
	2236	"RTN","PRC AACR1",108 ,0)
	2237	....; Add SSN
	2238	"RTN","PRC AACR1",109 ,0)
	2239	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2240	"RTN","PRC AACR1",110 ,0)
	2241	....; Add Transacti on Number
	2242	"RTN","PRC AACR1",111 ,0)
	2243	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2244	"RTN","PRC AACR1",112 ,0)
	2245	....; Add Auto-Corr ect Date
	2246	"RTN","PRC AACR1",113 ,0)
	2247	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2248	"RTN","PRC AACR1",114 ,0)
	2249	....; Add Auto-Corr ect Reason
	2250	"RTN","PRC AACR1",115 ,0)
	2251	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2252	"RTN","PRC AACR1",116 ,0)
	2253	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2254	"RTN","PRC AACR1",117 ,0)
	2255	....Q
	2256	"RTN","PRC AACR1",118 ,0)
	2257	;
	2258	"RTN","PRC AACR1",119 ,0)
	2259	; Store i n ^TMP sor ted by Aut o-Correct Date, Debt or, Bill N umber and Transactio n #
	2260	"RTN","PRC AACR1",120 ,0)
	2261	I PRCASOR T=3 D
	2262	"RTN","PRC AACR1",121 ,0)
	2263	.; Print Header
	2264	"RTN","PRC AACR1",122 ,0)
	2265	.D PSACRT P3
	2266	"RTN","PRC AACR1",123 ,0)
	2267	.; Data L ayout
	2268	^TMP("PRCA ACR",$J,PR CABN,PRCAD TR,PRCATN) =PRCABN_U_ PRCADTR_U_ PRCASSN_U_ PRCATNTF_U _
	2269	PRCAACD_U_ PRCAACR
	2270	"RTN","PRC AACR1",124 ,0)
	2271	.S PRCABN =""
	2272	"RTN","PRC AACR1",125 ,0)
	2273	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D
	2274	"RTN","PRC AACR1",126 ,0)
	2275	..S PRCAD TR=""
	2276	"RTN","PRC AACR1",127 ,0)
	2277	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D
	2278	"RTN","PRC AACR1",128 ,0)
	2279	...S PRCA TN=""
	2280	"RTN","PRC AACR1",129 ,0)
	2281	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D
	2282	"RTN","PRC AACR1",130 ,0)
	2283	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	2284	"RTN","PRC AACR1",131 ,0)
	2285	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2286	"RTN","PRC AACR1",132 ,0)
	2287	....S PRC AIEN=PRCAI EN+1
	2288	"RTN","PRC AACR1",133 ,0)
	2289	....; Add Bill Numb er
	2290	"RTN","PRC AACR1",134 ,0)
	2291	....S PRC ATEMP=$P(P RCADATA,U, 1),$E(PRCA TEMP,13)=" "
	2292	"RTN","PRC AACR1",135 ,0)
	2293	....; Add 18 chars of Debtor' s name
	2294	"RTN","PRC AACR1",136 ,0)
	2295	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,33)=" "
	2296	"RTN","PRC AACR1",137 ,0)
	2297	....; Add SSN
	2298	"RTN","PRC AACR1",138 ,0)
	2299	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2300	"RTN","PRC AACR1",139 ,0)
	2301	....; Add Transacti on Number
	2302	"RTN","PRC AACR1",140 ,0)
	2303	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2304	"RTN","PRC AACR1",141 ,0)
	2305	....; Add Auto-Corr ect Date
	2306	"RTN","PRC AACR1",142 ,0)
	2307	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2308	"RTN","PRC AACR1",143 ,0)
	2309	....; Add Auto-Corr ect Reason
	2310	"RTN","PRC AACR1",144 ,0)
	2311	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2312	"RTN","PRC AACR1",145 ,0)
	2313	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2314	"RTN","PRC AACR1",146 ,0)
	2315	....Q
	2316	"RTN","PRC AACR1",147 ,0)
	2317	;
	2318	"RTN","PRC AACR1",148 ,0)
	2319	; Store i n ^TMP sor ted by Tra nsaction, Debtor and #Bill Num ber
	2320	"RTN","PRC AACR1",149 ,0)
	2321	I PRCASOR T=4 D
	2322	"RTN","PRC AACR1",150 ,0)
	2323	.; Print Header
	2324	"RTN","PRC AACR1",151 ,0)
	2325	.D PSACRT P4
	2326	"RTN","PRC AACR1",152 ,0)
	2327	.; Data L ayout
	2328	^TMP("PRCA ACR",$J,PR CATN,PRCAD TR,PRCABN) =PRCATNTF_ U_PRCADTR_ U_PRCABN_U _PRCASSN_U _
	2329	PRCAACD_U_ PRCAACR
	2330	"RTN","PRC AACR1",153 ,0)
	2331	.S PRCATN =""
	2332	"RTN","PRC AACR1",154 ,0)
	2333	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D
	2334	"RTN","PRC AACR1",155 ,0)
	2335	..S PRCAD TR=""
	2336	"RTN","PRC AACR1",156 ,0)
	2337	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D
	2338	"RTN","PRC AACR1",157 ,0)
	2339	...S PRCA BN=""
	2340	"RTN","PRC AACR1",158 ,0)
	2341	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D
	2342	"RTN","PRC AACR1",159 ,0)
	2343	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	2344	"RTN","PRC AACR1",160 ,0)
	2345	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2346	"RTN","PRC AACR1",161 ,0)
	2347	....S PRC AIEN=PRCAI EN+1
	2348	"RTN","PRC AACR1",162 ,0)
	2349	....; Add Transacti on Number
	2350	"RTN","PRC AACR1",163 ,0)
	2351	....S PRC ATEMP=$J($ P(PRCADATA ,U,1),9),$ E(PRCATEMP ,11)=" "
	2352	"RTN","PRC AACR1",164 ,0)
	2353	....; Add 18 chars of Debtor' s name
	2354	"RTN","PRC AACR1",165 ,0)
	2355	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,31)=" "
	2356	"RTN","PRC AACR1",166 ,0)
	2357	....; Add Bill Numb er
	2358	"RTN","PRC AACR1",167 ,0)
	2359	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,44)=" "
	2360	"RTN","PRC AACR1",168 ,0)
	2361	....; Add SSN
	2362	"RTN","PRC AACR1",169 ,0)
	2363	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,4 ),$E(PRCAT EMP,50)=" "
	2364	"RTN","PRC AACR1",170 ,0)
	2365	....; Add Auto-Corr ect Date
	2366	"RTN","PRC AACR1",171 ,0)
	2367	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2368	"RTN","PRC AACR1",172 ,0)
	2369	....; Add Auto-Corr ect Reason
	2370	"RTN","PRC AACR1",173 ,0)
	2371	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2372	"RTN","PRC AACR1",174 ,0)
	2373	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2374	"RTN","PRC AACR1",175 ,0)
	2375	....Q
	2376	"RTN","PRC AACR1",176 ,0)
	2377	;
	2378	"RTN","PRC AACR1",177 ,0)
	2379	; Display Auto-Corr ect data s orted by A uto-Correc t Reason
	2380	"RTN","PRC AACR1",178 ,0)
	2381	I PRCASOR T=5 D
	2382	"RTN","PRC AACR1",179 ,0)
	2383	.; Print Header
	2384	"RTN","PRC AACR1",180 ,0)
	2385	.D PSACRT P5
	2386	"RTN","PRC AACR1",181 ,0)
	2387	.; Data L ayout
	2388	^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)=P RCAACD_U_P RCADTR_U_P RCABN_U_PR C
	2389	ASSN_U_PRC ATNTF_U_PR CAACR
	2390	"RTN","PRC AACR1",182 ,0)
	2391	.S PRCAAC D=""
	2392	"RTN","PRC AACR1",183 ,0)
	2393	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D
	2394	"RTN","PRC AACR1",184 ,0)
	2395	..S PRCAD TR=""
	2396	"RTN","PRC AACR1",185 ,0)
	2397	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D
	2398	"RTN","PRC AACR1",186 ,0)
	2399	...S PRCA BN=""
	2400	"RTN","PRC AACR1",187 ,0)
	2401	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2402	"RTN","PRC AACR1",188 ,0)
	2403	....S PRC ATN=""
	2404	"RTN","PRC AACR1",189 ,0)
	2405	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN D
	2406	"RTN","PRC AACR1",190 ,0)
	2407	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	2408	"RTN","PRC AACR1",191 ,0)
	2409	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	2410	"RTN","PRC AACR1",192 ,0)
	2411	.....S PR CAIEN=PRCA IEN+1
	2412	"RTN","PRC AACR1",193 ,0)
	2413	.....; Ad d Auto-Cor rect Date
	2414	"RTN","PRC AACR1",194 ,0)
	2415	.....S PR CATEMP=$P( PRCADATA,U ,1),$E(PRC ATEMP,14)= " "
	2416	"RTN","PRC AACR1",195 ,0)
	2417	.....; Ad d 18 chars of Debtor 's name
	2418	"RTN","PRC AACR1",196 ,0)
	2419	.....S PR CATEMP=PRC ATEMP_$E($ P(PRCADATA ,U,2),1,18 ),$E(PRCAT EMP,34)=" "
	2420	"RTN","PRC AACR1",197 ,0)
	2421	.....; Ad d Bill Num ber
	2422	"RTN","PRC AACR1",198 ,0)
	2423	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 3),$E(PRCA TEMP,47)=" "
	2424	"RTN","PRC AACR1",199 ,0)
	2425	.....; Ad d SSN
	2426	"RTN","PRC AACR1",200 ,0)
	2427	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 4),$E(PRCA TEMP,53)=" "
	2428	"RTN","PRC AACR1",201 ,0)
	2429	.....; Ad d Transact ion Number
	2430	"RTN","PRC AACR1",202 ,0)
	2431	.....S PR CATEMP=PRC ATEMP_$J($ P(PRCADATA ,U,5),9),$ E(PRCATEMP ,64)=" "
	2432	"RTN","PRC AACR1",203 ,0)
	2433	.....; Ad d Auto-Cor rect Reaso n
	2434	"RTN","PRC AACR1",204 ,0)
	2435	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 6)
	2436	"RTN","PRC AACR1",205 ,0)
	2437	.....S ^T MP("PRCAAC R1",$J,PRC AIEN)=PRCA TEMP
	2438	"RTN","PRC AACR1",206 ,0)
	2439	.....Q
	2440	"RTN","PRC AACR1",207 ,0)
	2441	;
	2442	"RTN","PRC AACR1",208 ,0)
	2443	; Send Ma ilMan mess age with N o Forward
	2444	"RTN","PRC AACR1",209 ,0)
	2445	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ
	2446	"RTN","PRC AACR1",210 ,0)
	2447	I PRCASOR T=1 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N REASON)"
	2448	"RTN","PRC AACR1",211 ,0)
	2449	I PRCASOR T=2 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY DEBT OR)"
	2450	"RTN","PRC AACR1",212 ,0)
	2451	I PRCASOR T=3 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY BILL #)"
	2452	"RTN","PRC AACR1",213 ,0)
	2453	I PRCASOR T=4 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY TRAN SACTION NU MBER)"
	2454	"RTN","PRC AACR1",214 ,0)
	2455	I PRCASOR T=5 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N DATE)"
	2456	"RTN","PRC AACR1",215 ,0)
	2457	S XMTO(DU Z)=""
	2458	"RTN","PRC AACR1",216 ,0)
	2459	S XMBODY= "^TMP(""PR CAACR1"",$ J)"
	2460	"RTN","PRC AACR1",217 ,0)
	2461	S XMINSTR ("FLAGS")= "X"
	2462	"RTN","PRC AACR1",218 ,0)
	2463	S XMDUZ=D UZ
	2464	"RTN","PRC AACR1",219 ,0)
	2465	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	2466	"RTN","PRC AACR1",220 ,0)
	2467	D HOME^%Z IS
	2468	"RTN","PRC AACR1",221 ,0)
	2469	K IO("Q") ,POP
	2470	"RTN","PRC AACR1",222 ,0)
	2471	K ^TMP("P RCAACR",$J )
	2472	"RTN","PRC AACR1",223 ,0)
	2473	K ^TMP("P RCAACR1",$ J)
	2474	"RTN","PRC AACR1",224 ,0)
	2475	K PRCABDT ,PRCAEDT,P RCASORT
	2476	"RTN","PRC AACR1",225 ,0)
	2477	Q
	2478	"RTN","PRC AACR1",226 ,0)
	2479	;
	2480	"RTN","PRC AACR1",227 ,0)
	2481	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	2482	"RTN","PRC AACR1",228 ,0)
	2483	S PAGE=PA GE+1
	2484	"RTN","PRC AACR1",229 ,0)
	2485	S PRCAIEN =PRCAIEN+1
	2486	"RTN","PRC AACR1",230 ,0)
	2487	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2488	"RTN","PRC AACR1",231 ,0)
	2489	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2490	"RTN","PRC AACR1",232 ,0)
	2491	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION REASON)"
	2492	"RTN","PRC AACR1",233 ,0)
	2493	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2494	"RTN","PRC AACR1",234 ,0)
	2495	S PRCAIEN =PRCAIEN+1
	2496	"RTN","PRC AACR1",235 ,0)
	2497	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2498	"RTN","PRC AACR1",236 ,0)
	2499	S PRCAIEN =PRCAIEN+1
	2500	"RTN","PRC AACR1",237 ,0)
	2501	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2502	"RTN","PRC AACR1",238 ,0)
	2503	S PRCAIEN =PRCAIEN+1
	2504	"RTN","PRC AACR1",239 ,0)
	2505	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2506	"RTN","PRC AACR1",240 ,0)
	2507	S PRCADAT A="AUTO-C REASON D EBTOR S SN BILL NO. TR ANS NUM A UTO-C DATE "
	2508	"RTN","PRC AACR1",241 ,0)
	2509	S PRCAIEN =PRCAIEN+1
	2510	"RTN","PRC AACR1",242 ,0)
	2511	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2512	"RTN","PRC AACR1",243 ,0)
	2513	S PRCADAT A="------- ------- - ---------- ------- - --- ----- ------ -- ------- - ---------- -"
	2514	"RTN","PRC AACR1",244 ,0)
	2515	S PRCAIEN =PRCAIEN+1
	2516	"RTN","PRC AACR1",245 ,0)
	2517	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2518	"RTN","PRC AACR1",246 ,0)
	2519	Q
	2520	"RTN","PRC AACR1",247 ,0)
	2521	;
	2522	"RTN","PRC AACR1",248 ,0)
	2523	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2524	"RTN","PRC AACR1",249 ,0)
	2525	S PAGE=PA GE+1
	2526	"RTN","PRC AACR1",250 ,0)
	2527	S PRCAIEN =PRCAIEN+1
	2528	"RTN","PRC AACR1",251 ,0)
	2529	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2530	"RTN","PRC AACR1",252 ,0)
	2531	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2532	"RTN","PRC AACR1",253 ,0)
	2533	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY DEBTOR )"
	2534	"RTN","PRC AACR1",254 ,0)
	2535	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2536	"RTN","PRC AACR1",255 ,0)
	2537	S PRCAIEN =PRCAIEN+1
	2538	"RTN","PRC AACR1",256 ,0)
	2539	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2540	"RTN","PRC AACR1",257 ,0)
	2541	S PRCAIEN =PRCAIEN+1
	2542	"RTN","PRC AACR1",258 ,0)
	2543	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2544	"RTN","PRC AACR1",259 ,0)
	2545	S PRCAIEN =PRCAIEN+1
	2546	"RTN","PRC AACR1",260 ,0)
	2547	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2548	"RTN","PRC AACR1",261 ,0)
	2549	S PRCADAT A="DEBTOR BILL NO . SSN TRANS NU M AUTO-C DATE AUT O-C REASON "
	2550	"RTN","PRC AACR1",262 ,0)
	2551	S PRCAIEN =PRCAIEN+1
	2552	"RTN","PRC AACR1",263 ,0)
	2553	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2554	"RTN","PRC AACR1",264 ,0)
	2555	S PRCADAT A="------- ---------- - ------- ---- ---- -------- - ------- ----- --- ---------- -"
	2556	"RTN","PRC AACR1",265 ,0)
	2557	S PRCAIEN =PRCAIEN+1
	2558	"RTN","PRC AACR1",266 ,0)
	2559	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2560	"RTN","PRC AACR1",267 ,0)
	2561	Q
	2562	"RTN","PRC AACR1",268 ,0)
	2563	;
	2564	"RTN","PRC AACR1",269 ,0)
	2565	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2566	"RTN","PRC AACR1",270 ,0)
	2567	S PAGE=PA GE+1
	2568	"RTN","PRC AACR1",271 ,0)
	2569	S PRCAIEN =PRCAIEN+1
	2570	"RTN","PRC AACR1",272 ,0)
	2571	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2572	"RTN","PRC AACR1",273 ,0)
	2573	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2574	"RTN","PRC AACR1",274 ,0)
	2575	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY BILL # )"
	2576	"RTN","PRC AACR1",275 ,0)
	2577	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2578	"RTN","PRC AACR1",276 ,0)
	2579	S PRCAIEN =PRCAIEN+1
	2580	"RTN","PRC AACR1",277 ,0)
	2581	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2582	"RTN","PRC AACR1",278 ,0)
	2583	S PRCAIEN =PRCAIEN+1
	2584	"RTN","PRC AACR1",279 ,0)
	2585	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2586	"RTN","PRC AACR1",280 ,0)
	2587	S PRCAIEN =PRCAIEN+1
	2588	"RTN","PRC AACR1",281 ,0)
	2589	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2590	"RTN","PRC AACR1",282 ,0)
	2591	S PRCADAT A="BILL NO . DEBT OR SSN TRANS NU M AUTO-C DATE AUT O-C REASON "
	2592	"RTN","PRC AACR1",283 ,0)
	2593	S PRCAIEN =PRCAIEN+1
	2594	"RTN","PRC AACR1",284 ,0)
	2595	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2596	"RTN","PRC AACR1",285 ,0)
	2597	S PRCADAT A="------- ---- ---- ---------- ---- ---- -------- - ------- ----- --- ---------- -"
	2598	"RTN","PRC AACR1",286 ,0)
	2599	S PRCAIEN =PRCAIEN+1
	2600	"RTN","PRC AACR1",287 ,0)
	2601	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2602	"RTN","PRC AACR1",288 ,0)
	2603	Q
	2604	"RTN","PRC AACR1",289 ,0)
	2605	;
	2606	"RTN","PRC AACR1",290 ,0)
	2607	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2608	"RTN","PRC AACR1",291 ,0)
	2609	S PAGE=PA GE+1
	2610	"RTN","PRC AACR1",292 ,0)
	2611	S PRCAIEN =PRCAIEN+1
	2612	"RTN","PRC AACR1",293 ,0)
	2613	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2614	"RTN","PRC AACR1",294 ,0)
	2615	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2616	"RTN","PRC AACR1",295 ,0)
	2617	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY TRANSA CTION NUMB ER)"
	2618	"RTN","PRC AACR1",296 ,0)
	2619	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2620	"RTN","PRC AACR1",297 ,0)
	2621	S PRCAIEN =PRCAIEN+1
	2622	"RTN","PRC AACR1",298 ,0)
	2623	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2624	"RTN","PRC AACR1",299 ,0)
	2625	S PRCAIEN =PRCAIEN+1
	2626	"RTN","PRC AACR1",300 ,0)
	2627	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2628	"RTN","PRC AACR1",301 ,0)
	2629	S PRCAIEN =PRCAIEN+1
	2630	"RTN","PRC AACR1",302 ,0)
	2631	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2632	"RTN","PRC AACR1",303 ,0)
	2633	S PRCADAT A="TRANS N UM DEBTOR BILL N O. SSN AUTO-C DATE AUT O-C REASON "
	2634	"RTN","PRC AACR1",304 ,0)
	2635	S PRCAIEN =PRCAIEN+1
	2636	"RTN","PRC AACR1",305 ,0)
	2637	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2638	"RTN","PRC AACR1",306 ,0)
	2639	S PRCADAT A="------- -- ------ ---------- -- ------ ----- --- - ------- ----- --- ---------- -"
	2640	"RTN","PRC AACR1",307 ,0)
	2641	S PRCAIEN =PRCAIEN+1
	2642	"RTN","PRC AACR1",308 ,0)
	2643	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2644	"RTN","PRC AACR1",309 ,0)
	2645	Q
	2646	"RTN","PRC AACR1",310 ,0)
	2647	;
	2648	"RTN","PRC AACR1",311 ,0)
	2649	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	2650	"RTN","PRC AACR1",312 ,0)
	2651	S PAGE=PA GE+1
	2652	"RTN","PRC AACR1",313 ,0)
	2653	S PRCAIEN =PRCAIEN+1
	2654	"RTN","PRC AACR1",314 ,0)
	2655	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2656	"RTN","PRC AACR1",315 ,0)
	2657	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2658	"RTN","PRC AACR1",316 ,0)
	2659	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION DATE)"
	2660	"RTN","PRC AACR1",317 ,0)
	2661	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2662	"RTN","PRC AACR1",318 ,0)
	2663	S PRCAIEN =PRCAIEN+1
	2664	"RTN","PRC AACR1",319 ,0)
	2665	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2666	"RTN","PRC AACR1",320 ,0)
	2667	S PRCAIEN =PRCAIEN+1
	2668	"RTN","PRC AACR1",321 ,0)
	2669	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2670	"RTN","PRC AACR1",322 ,0)
	2671	S PRCAIEN =PRCAIEN+1
	2672	"RTN","PRC AACR1",323 ,0)
	2673	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2674	"RTN","PRC AACR1",324 ,0)
	2675	S PRCADAT A="AUTO-C DATE DEB TOR BIL L NO. SSN TRAN S NUM AUT O-C REASON "
	2676	"RTN","PRC AACR1",325 ,0)
	2677	S PRCAIEN =PRCAIEN+1
	2678	"RTN","PRC AACR1",326 ,0)
	2679	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2680	"RTN","PRC AACR1",327 ,0)
	2681	S PRCADAT A="------- ----- --- ---------- ----- --- -------- ---- ---- ----- --- ---------- -"
	2682	"RTN","PRC AACR1",328 ,0)
	2683	S PRCAIEN =PRCAIEN+1
	2684	"RTN","PRC AACR1",329 ,0)
	2685	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2686	"RTN","PRC AACR1",330 ,0)
	2687	Q
	2688	"RTN","PRC AACR1",331 ,0)
	2689	;
	2690	"RTN","PRC AACR1",332 ,0)
	2691	EXIT ;
	2692	"RTN","PRC AACR1",333 ,0)
	2693	Q
	2694	"RTN","PRC ACPS")
	2695	0^27^B2540 66716^n/a
	2696	"RTN","PRC ACPS",1,0)
	2697	PRCACPS ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION ;09/2 1/15 3:34 PM
	2698	"RTN","PRC ACPS",2,0)
	2699	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 131
	2700	"RTN","PRC ACPS",3,0)
	2701	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2702	"RTN","PRC ACPS",4,0)
	2703	;
	2704	"RTN","PRC ACPS",5,0)
	2705	Q
	2706	"RTN","PRC ACPS",6,0)
	2707	;
	2708	"RTN","PRC ACPS",7,0)
	2709	BEGIN ; En try point for manual run
	2710	"RTN","PRC ACPS",8,0)
	2711	; Determi ne if Auto Correct p rocess is currently running
	2712	"RTN","PRC ACPS",9,0)
	2713	N DIR,PRC ASTRT,QUIT ,X,X1,X2,Y
	2714	"RTN","PRC ACPS",10,0 )
	2715	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= 0
	2716	"RTN","PRC ACPS",11,0 )
	2717	; Notify user if Au to Correct process i s currentl y running
	2718	"RTN","PRC ACPS",12,0 )
	2719	I PRCASTR T'="" D Q :QUIT
	2720	"RTN","PRC ACPS",13,0 )
	2721	.S Y=$P(P RCASTRT,U, 2)
	2722	"RTN","PRC ACPS",14,0 )
	2723	.D DD^%DT
	2724	"RTN","PRC ACPS",15,0 )
	2725	.S PRCAST RT=Y
	2726	"RTN","PRC ACPS",16,0 )
	2727	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram was pr eviously s tarted on"
	2728	"RTN","PRC ACPS",17,0 )
	2729	.W !,PRCA STRT," and has not y et success fully comp leted."
	2730	"RTN","PRC ACPS",18,0 )
	2731	.W !!,"Th e job can take up to 1 hour to complete when sched uled to ru n outside"
	2732	"RTN","PRC ACPS",19,0 )
	2733	.W !,"of normal bus iness hour s and long er if run during nor mal busine ss hours"
	2734	"RTN","PRC ACPS",20,0 )
	2735	.W !,"whe n the load on the sy stem is gr eater."
	2736	"RTN","PRC ACPS",21,0 )
	2737	.W !!
	2738	"RTN","PRC ACPS",22,0 )
	2739	.W !,"If it has bee n more tha n an hour since the Patient St atement Au to-Correct ion"
	2740	"RTN","PRC ACPS",23,0 )
	2741	.W !,"Pro gram was s tarted and the confi rmation e- mail with subject: C PS"
	2742	"RTN","PRC ACPS",24,0 )
	2743	.W !,"AUT O-CORRECTI ON COMPLET E has not been sent to the PRC ACPS mail group, you can"
	2744	"RTN","PRC ACPS",25,0 )
	2745	.W !,"run the Patie nt Stateme nt Auto-Co rrection P rogram aga in."
	2746	"RTN","PRC ACPS",26,0 )
	2747	.W !
	2748	"RTN","PRC ACPS",27,0 )
	2749	.S DIR("A ")="Do you want to r un the Pat ient State ment Auto- Correction Program a gain"
	2750	"RTN","PRC ACPS",28,0 )
	2751	.S DIR(0) ="Y",DIR(" B")="NO"
	2752	"RTN","PRC ACPS",29,0 )
	2753	.D ^DIR
	2754	"RTN","PRC ACPS",30,0 )
	2755	.W !
	2756	"RTN","PRC ACPS",31,0 )
	2757	.; Quit i f ^, ^^, T imeout or No
	2758	"RTN","PRC ACPS",32,0 )
	2759	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	2760	"RTN","PRC ACPS",33,0 )
	2761	.K DTOUT, DUOUT,DIRO UT
	2762	"RTN","PRC ACPS",34,0 )
	2763	.Q
	2764	"RTN","PRC ACPS",35,0 )
	2765	;
	2766	"RTN","PRC ACPS",36,0 )
	2767	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	2768	"RTN","PRC ACPS",37,0 )
	2769	W !,"Queu e the pati ent statem ent discre pancies au to-correct ion progra m to run:"
	2770	"RTN","PRC ACPS",38,0 )
	2771	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	2772	"RTN","PRC ACPS",39,0 )
	2773	S ZTRTN=" START^PRCA CPS",ZTIO= ""
	2774	"RTN","PRC ACPS",40,0 )
	2775	D ^%ZTLOA D
	2776	"RTN","PRC ACPS",41,0 )
	2777	Q
	2778	"RTN","PRC ACPS",42,0 )
	2779	;
	2780	"RTN","PRC ACPS",43,0 )
	2781	START ; En try point for Schedu led backgr ound job
	2782	"RTN","PRC ACPS",44,0 )
	2783	N DEBTOR, DEBTOR0,DE BTOR1,PRCA STRT,REFRE V,X,Y
	2784	"RTN","PRC ACPS",45,0 )
	2785	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0))
	2786	"RTN","PRC ACPS",46,0 )
	2787	; If a pr evious job still run ning send e-mail war ning to PR CACPS mail group
	2788	"RTN","PRC ACPS",47,0 )
	2789	I PRCASTR T'="" D
	2790	"RTN","PRC ACPS",48,0 )
	2791	.S Y=$P(P RCASTRT,U, 2)
	2792	"RTN","PRC ACPS",49,0 )
	2793	.; Conver t date to external f ormat
	2794	"RTN","PRC ACPS",50,0 )
	2795	.D DD^%DT
	2796	"RTN","PRC ACPS",51,0 )
	2797	.S PRCAST RT=Y
	2798	"RTN","PRC ACPS",52,0 )
	2799	.; Send m ail to PRC ACPS mail group noti ng previou s run didn 't complet e
	2800	"RTN","PRC ACPS",53,0 )
	2801	.D PRCAMA IL^PRCACPS A(PRCASTRT )
	2802	"RTN","PRC ACPS",54,0 )
	2803	.Q
	2804	"RTN","PRC ACPS",55,0 )
	2805	; Get cur rent date/ time
	2806	"RTN","PRC ACPS",56,0 )
	2807	D NOW^%DT C
	2808	"RTN","PRC ACPS",57,0 )
	2809	S (PRCAST RT,X1)=%,X 2=8
	2810	"RTN","PRC ACPS",58,0 )
	2811	D C^%DTC
	2812	"RTN","PRC ACPS",59,0 )
	2813	S ^XTMP(" PRCACPS",0 )=X_U_PRCA STRT_U_"Pa tient Stat ement Auto -Correctio n Program"
	2814	"RTN","PRC ACPS",60,0 )
	2815	; Loop th rough C x- ref in 430 . This fie ld points to the Deb tor File, which in t urn is a
	2816	"RTN","PRC ACPS",61,0 )
	2817	; variabl e pointer to other f iles.
	2818	"RTN","PRC ACPS",62,0 )
	2819	S DEBTOR= 0
	2820	"RTN","PRC ACPS",63,0 )
	2821	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	2822	"RTN","PRC ACPS",64,0 )
	2823	.; Perfor m the same in/out of balance c heck as th e CHECK PA TIENT ACCO UNT BALANC E option
	2824	"RTN","PRC ACPS",65,0 )
	2825	.; Quit t o next deb tor if acc ount is in balance
	2826	"RTN","PRC ACPS",66,0 )
	2827	.I '$$EN^ PRCAMRKC(D EBTOR) Q
	2828	"RTN","PRC ACPS",67,0 )
	2829	.S BALDIF F=0
	2830	"RTN","PRC ACPS",68,0 )
	2831	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) )
	2832	"RTN","PRC ACPS",69,0 )
	2833	.; QUIT i f it doesn 't point t o the PATI ENT (^DPT) file
	2834	"RTN","PRC ACPS",70,0 )
	2835	.Q:$P(DEB TOR0,"^")' ["DPT("
	2836	"RTN","PRC ACPS",71,0 )
	2837	.Q:$P(DEB TOR1,"^",9 )=1 ; qui t if debto r address marked unk nown
	2838	"RTN","PRC ACPS",72,0 )
	2839	.; Skip t his Debtor is they a t least 1 Bill in #4 30 with a status of REFUND REV IEW (#44)
	2840	"RTN","PRC ACPS",73,0 )
	2841	.Q:$$REFR EV(DEBTOR)
	2842	"RTN","PRC ACPS",74,0 )
	2843	.; Get pr evious bal ance and d ate of las t transact ion from t he AR EVEN T file (#3 41)
	2844	"RTN","PRC ACPS",75,0 )
	2845	.D ENTER( DEBTOR)
	2846	"RTN","PRC ACPS",76,0 )
	2847	.; Perfor m checks/u pdates bas ed on File #430
	2848	"RTN","PRC ACPS",77,0 )
	2849	.D START1
	2850	"RTN","PRC ACPS",78,0 )
	2851	.; QUIT i f in balan ce
	2852	"RTN","PRC ACPS",79,0 )
	2853	.; *** Re moved so a ll out of balance ac counts to enter STAR T2
	2854	"RTN","PRC ACPS",80,0 )
	2855	.;I BALDI FF=0 K BAL DIFF,^TMP( "PRCAGTPS" ,$J),^TMP( "PRCABILL" ,$J) Q
	2856	"RTN","PRC ACPS",81,0 )
	2857	.; Review Data in ^ TMP and up date #433 as needed
	2858	"RTN","PRC ACPS",82,0 )
	2859	.D START2
	2860	"RTN","PRC ACPS",83,0 )
	2861	.; If the account i s still ou t of balan ce after f ixing ever ything it can
	2862	"RTN","PRC ACPS",84,0 )
	2863	.; call U PDTLTR to mark the l ast transa ction for the accoun t as NOT F IXABLE
	2864	"RTN","PRC ACPS",85,0 )
	2865	.I $$EN^P RCAMRKC(DE BTOR) D UP DTLTR^PRCA CPSA(0)
	2866	"RTN","PRC ACPS",86,0 )
	2867	.; clean up temp in fo and pro cess next debtor
	2868	"RTN","PRC ACPS",87,0 )
	2869	.K BALDIF F,^TMP("PR CAGTPS",$J ),^TMP("PR CABILL",$J )
	2870	"RTN","PRC ACPS",88,0 )
	2871	; Send ma ilman mess age to the PRCACPS m ail group at end of processing
	2872	"RTN","PRC ACPS",89,0 )
	2873	D USRMSG
	2874	"RTN","PRC ACPS",90,0 )
	2875	Q
	2876	"RTN","PRC ACPS",91,0 )
	2877	;
	2878	"RTN","PRC ACPS",92,0 )
	2879	REFREV(DEB TOR) ;
	2880	"RTN","PRC ACPS",93,0 )
	2881	; Check i f any Bill for this Debtor has a status of REFUND REVIEW (#4 4)
	2882	"RTN","PRC ACPS",94,0 )
	2883	N BN,QUIT
	2884	"RTN","PRC ACPS",95,0 )
	2885	S BN="",Q UIT=0
	2886	"RTN","PRC ACPS",96,0 )
	2887	F S BN=$ O(^PRCA(43 0,"C",DEBT OR,BN)) Q: 'BN D Q: QUIT
	2888	"RTN","PRC ACPS",97,0 )
	2889	.; Check CURRENT ST ATUS (#8) for status of REFUND REVIEW (# 44)
	2890	"RTN","PRC ACPS",98,0 )
	2891	.I $P($G( ^PRCA(430, BN,0)),U,8 )=44 S QUI T=1
	2892	"RTN","PRC ACPS",99,0 )
	2893	Q QUIT
	2894	"RTN","PRC ACPS",100, 0)
	2895	;
	2896	"RTN","PRC ACPS",101, 0)
	2897	ENTER(DEBT OR) ;
	2898	"RTN","PRC ACPS",102, 0)
	2899	S (PBAL,B BAL,TBAL)= 0 K ^TMP(" PRCAGTPS", $J)
	2900	"RTN","PRC ACPS",103, 0)
	2901	; Get las t type of event for debtor by calling $$ LST^RCFN01 . Referenc es files # 340 and #3 41.1
	2902	"RTN","PRC ACPS",104, 0)
	2903	S DAT=$$L ST^RCFN01( DEBTOR,2) I DAT<1 S DAT=0
	2904	"RTN","PRC ACPS",105, 0)
	2905	; PBAL^PR CAGU gets previous b alance and date of l ast transa ction from the AR EV ENT file ( #341)
	2906	"RTN","PRC ACPS",106, 0)
	2907	I DAT S D AT=9999999 .999999-DA T D PBAL^P RCAGU(DEBT OR,.DAT,.P BAL)
	2908	"RTN","PRC ACPS",107, 0)
	2909	D EN(DEBT OR,DAT)
	2910	"RTN","PRC ACPS",108, 0)
	2911	K BBAL,TB AL,DAT
	2912	"RTN","PRC ACPS",109, 0)
	2913	Q
	2914	"RTN","PRC ACPS",110, 0)
	2915	;
	2916	"RTN","PRC ACPS",111, 0)
	2917	EN(DEBTOR, BEG,END,TT Y) ;
	2918	"RTN","PRC ACPS",112, 0)
	2919	NEW Y
	2920	"RTN","PRC ACPS",113, 0)
	2921	; If Begi nning date is not de fined, set it to 0 t o start at beginning
	2922	"RTN","PRC ACPS",114, 0)
	2923	; If End date is no t defined, set it to today's d ate
	2924	"RTN","PRC ACPS",115, 0)
	2925	S:$G(BEG) ="" BEG=0 I $G(END)= "" D NOW^% DTC S END= % K %
	2926	"RTN","PRC ACPS",116, 0)
	2927	S TTY=$G( TTY) I TTY ="" D F430
	2928	"RTN","PRC ACPS",117, 0)
	2929	D F433
	2930	"RTN","PRC ACPS",118, 0)
	2931	Q Q
	2932	"RTN","PRC ACPS",119, 0)
	2933	F430 ; Che cks for AC COUNTS REC EIVABLE fi le (#430) for bills with (#3) ORIGINAL A MOUNT has a value,
	2934	"RTN","PRC ACPS",120, 0)
	2935	; set thi s into the ^TMP glob al with _" ^0"
	2936	"RTN","PRC ACPS",121, 0)
	2937	NEW DAT,B N
	2938	"RTN","PRC ACPS",122, 0)
	2939	S DAT=BEG F S DAT= $O(^PRCA(4 30,"ATD",D EBTOR,DAT) ) Q:('DAT) !(DAT>END) S BN=0 F S
	2940	BN=$O(^PRC A(430,"ATD ",DEBTOR,D AT,BN)) Q: 'BN D
	2941	"RTN","PRC ACPS",123, 0)
	2942	.; Add th e original amount if it is wit hin date r ange based on the da te of the last state ment
	2943	"RTN","PRC ACPS",124, 0)
	2944	.I $P(^PR CA(430,BN, 0),U,3) S ^TMP("PRCA GTPS",$J,D EBTOR,BN,0 )=$P(^PRCA (430,BN,0) ,"^",3)_"^ 0"
	2945	"RTN","PRC ACPS",125, 0)
	2946	Q
	2947	"RTN","PRC ACPS",126, 0)
	2948	F433 ;
	2949	"RTN","PRC ACPS",127, 0)
	2950	NEW DAT,T N
	2951	"RTN","PRC ACPS",128, 0)
	2952	; Loop th rough the Dates and Bills
	2953	"RTN","PRC ACPS",129, 0)
	2954	F DAT=BEG :0 S DAT=$ O(^PRCA(43 3,"ATD",DE BTOR,DAT)) Q:('DAT)! (DAT>END) F TN=0:0 S
	2955	TN=$O(^PRC A(433,"ATD ",DEBTOR,D AT,TN)) Q: 'TN D
	2956	"RTN","PRC ACPS",130, 0)
	2957	.S TCMPLT ="",TMBSNC ="",TRDMRD ="",COMM=0
	2958	"RTN","PRC ACPS",131, 0)
	2959	.S TN0=$G (^PRCA(433 ,TN,0)) Q: TN0=""
	2960	"RTN","PRC ACPS",132, 0)
	2961	.S TN1=$G (^PRCA(433 ,TN,1))
	2962	"RTN","PRC ACPS",133, 0)
	2963	.S TN3=$G (^PRCA(433 ,TN,3))
	2964	"RTN","PRC ACPS",134, 0)
	2965	.I $P(TN1 ,U,2)="" Q ;MISSING TRANS TYP E
	2966	"RTN","PRC ACPS",135, 0)
	2967	.; PRCA4 .5313 - S kip proces sing twin transactio ns for Pre payments
	2968	"RTN","PRC ACPS",136, 0)
	2969	.I $P(TN0 ,U,10),$P( $G(^PRCA(4 33,TN,5)), U,1)'="" N HIT,TWIN D I HIT Q
	2970	"RTN","PRC ACPS",137, 0)
	2971	..S HIT=0
	2972	"RTN","PRC ACPS",138, 0)
	2973	..S TWIN= $P(^PRCA(4 33,TN,5),U ,1)
	2974	"RTN","PRC ACPS",139, 0)
	2975	..I '$D(^ PRCA(433,T WIN,0)) Q
	2976	"RTN","PRC ACPS",140, 0)
	2977	..S HIT=1
	2978	"RTN","PRC ACPS",141, 0)
	2979	..S TWIN( 2)=$P(^PRC A(433,TWIN ,0),U,2)
	2980	"RTN","PRC ACPS",142, 0)
	2981	..K ^TMP( "PRCAGTPS" ,$J,DEBTOR ,TWIN(2),T WIN)
	2982	"RTN","PRC ACPS",143, 0)
	2983	.;
	2984	"RTN","PRC ACPS",144, 0)
	2985	.I $P(TN0 ,U,10)=1 S TCMPLT=1
	2986	"RTN","PRC ACPS",145, 0)
	2987	.I $P(TN1 ,U,2)=45 S COMM=1 G F433A
	2988	"RTN","PRC ACPS",146, 0)
	2989	.I $G(TTY )'="" Q:TT Y'=$P(TN1, U,2)
	2990	"RTN","PRC ACPS",147, 0)
	2991	.; Quit i f Transact ion Type i s blank or one of th e followin g:
	2992	"RTN","PRC ACPS",148, 0)
	2993	.; 3:REFE R TO RC, 4 :REFER TO DOJ, 5:REE STABLISH T O RC/DOJ, 6:RETURNED BY RC/DOJ
	2994	"RTN","PRC ACPS",149, 0)
	2995	.; 7:CASH COLLECTIO N BY RC/DO J, 24:MARS HAL/COURT COST, 25:R EPAYMENT P LAN, 30:DE BIT
	2996	VOUCHER (S F 5515)
	2997	"RTN","PRC ACPS",150, 0)
	2998	.I TTY="" ,",3,4,5,6 ,7,24,25,3 0,"[(","_$ P(TN1,U,2) _",") Q
	2999	"RTN","PRC ACPS",151, 0)
	3000	.; QUIT i f BILL NUM BER (#.03) = blank OR TRANSACTI ON STATUS (#4) '= CO MPLETE
	3001	"RTN","PRC ACPS",152, 0)
	3002	.I ($P(TN 0,U,2)="") !($P(TN0,U ,4)'=2) Q
	3003	"RTN","PRC ACPS",153, 0)
	3004	.; IF PRC AHIST="THI ST" AND TR ANSACTION TYPE (#12) = COMMENT (#45) cal l F433A to Set the d ata into
	3005	^TMP("PRCA GTPS",$J,D EBTOR
	3006	"RTN","PRC ACPS",154, 0)
	3007	.I $G(PRC AHIST)="TH IST",$P(TN 1,U,2)=45 G F433A
	3008	"RTN","PRC ACPS",155, 0)
	3009	.; IF TRA NSACTION T YPE (#12) '= to 46 UNSUSPENDE D AND TRAN SACTION TY PE (#12)'= to 47 CH ARGE
	3010	SUSPENDED
	3011	"RTN","PRC ACPS",156, 0)
	3012	.I $P(TN1 ,"^",2)'=4 6,$P(TN1," ^",2)'=47 D I TN1=" " Q
	3013	"RTN","PRC ACPS",157, 0)
	3014	..N RCTRA NDA,RCSTOP ,TRANTYPE
	3015	"RTN","PRC ACPS",158, 0)
	3016	..S RCSTO P=0
	3017	"RTN","PRC ACPS",159, 0)
	3018	..; Loop BACKWARDS through th e BILL NUM BER "C" x- ref
	3019	"RTN","PRC ACPS",160, 0)
	3020	..S RCTRA NDA=TN
	3021	"RTN","PRC ACPS",161, 0)
	3022	..F S RC TRANDA=$O( ^PRCA(433, "C",+$P(TN 0,"^",2),R CTRANDA),- 1) Q:'RCTR ANDA D I RCSTOP Q
	3023	"RTN","PRC ACPS",162, 0)
	3024	...; QUIT if TRANSA CTION STAT US (#4) '= COMPLETE
	3025	"RTN","PRC ACPS",163, 0)
	3026	...I $P($ G(^PRCA(43 3,RCTRANDA ,0)),"^",4 )'=2 Q
	3027	"RTN","PRC ACPS",164, 0)
	3028	...; Load Transacti on Type
	3029	"RTN","PRC ACPS",165, 0)
	3030	...S TRAN TYPE=$P($G (^PRCA(433 ,RCTRANDA, 1)),"^",2)
	3031	"RTN","PRC ACPS",166, 0)
	3032	...; IF T RANSACTION TYPE (#12 ) = 46 UNS USPENDED s et stop & Quit
	3033	"RTN","PRC ACPS",167, 0)
	3034	...I TRAN TYPE=46 S RCSTOP=1 Q
	3035	"RTN","PRC ACPS",168, 0)
	3036	...; IF T RANSACTION TYPE (#12 ) = 47 CHA RGE SUSPEN DED set st op & Quit
	3037	"RTN","PRC ACPS",169, 0)
	3038	...I TRAN TYPE=47 S RCSTOP=1,T N1="" Q
	3039	"RTN","PRC ACPS",170, 0)
	3040	F433A .
	3041	"RTN","PRC ACPS",171, 0)
	3042	.; The da ta in the ^TMP is as follows:
	3043	"RTN","PRC ACPS",172, 0)
	3044	.; Data =
	3045	"RTN","PRC ACPS",173, 0)
	3046	.; 1. TRA NS. AMOUNT (#15) $ P(TN1,U,5)
	3047	"RTN","PRC ACPS",174, 0)
	3048	.; 2. TRA NSACTION T YPE (#12) $ P(TN1,U,2)
	3049	"RTN","PRC ACPS",175, 0)
	3050	.; 3. PRI N.COLLECTE D (#31) $ P(TN3,U,1)
	3051	"RTN","PRC ACPS",176, 0)
	3052	.; 4. INT EREST COLL ECTED (#32 ) $ P(TN3,U,2)
	3053	"RTN","PRC ACPS",177, 0)
	3054	.; 5. ADM IN.COLLECT ED (#33) $ P(TN3,U,3)
	3055	"RTN","PRC ACPS",178, 0)
	3056	.; 6. MAR SHAL FEE C OLLECTED ( #34) $ P(TN3,U,4)
	3057	"RTN","PRC ACPS",179, 0)
	3058	.; 7. COU RT COST CO LLECTED (# 35) $ P(TN3,U,5)
	3059	"RTN","PRC ACPS",180, 0)
	3060	.; 8. TOT AL OF #3 - #7 $ P(TN3,U,1) +$P(TN3,U, 2)+$P(TN3, U,3)+$P(TN 3,U,4)+$P( TN3,U,5)
	3061	"RTN","PRC ACPS",181, 0)
	3062	.; 9. TCM PLT ( #10) INCOM PLETE TRAN SACTION FL AG
	3063	"RTN","PRC ACPS",182, 0)
	3064	.;10. TRD MRD - Does n't appear to be use d
	3065	"RTN","PRC ACPS",183, 0)
	3066	.;11. TMB SNC - Does n't appear to be use d
	3067	"RTN","PRC ACPS",184, 0)
	3068	.;12. Dup licate fla g for use in START2 1=duplicat e, 0=not a duplicate . Set in B ILLQUIT^PR CACPSA
	3069	"RTN","PRC ACPS",185, 0)
	3070	.;
	3071	"RTN","PRC ACPS",186, 0)
	3072	.N PRCATE MP
	3073	"RTN","PRC ACPS",187, 0)
	3074	.S
	3075	PRCATEMP=$ P(TN1,U,5) _U_$P(TN1, U,2)_U_$P( TN3,U,1)_U _$P(TN3,U, 2)_U_$P(TN 3,U,3)_U_$ P(TN3,U,4
	3076	)_U_$P(TN3 ,U,5)
	3077	"RTN","PRC ACPS",188, 0)
	3078	.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, U,5))
	3079	"RTN","PRC ACPS",189, 0)
	3080	.S PRCATE MP=PRCATEM P_U_TCMPLT
	3081	"RTN","PRC ACPS",190, 0)
	3082	.S PRCATE MP=PRCATEM P_U_TRDMRD
	3083	"RTN","PRC ACPS",191, 0)
	3084	.S PRCATE MP=PRCATEM P_U_TMBSNC
	3085	"RTN","PRC ACPS",192, 0)
	3086	.S ^TMP(" PRCAGTPS", $J,DEBTOR, $P(TN0,U,2 ),TN)=PRCA TEMP
	3087	"RTN","PRC ACPS",193, 0)
	3088	.K TN0,TN 1,TN3,TCMP LT,TRDMRD, TMBSNC,COM M
	3089	"RTN","PRC ACPS",194, 0)
	3090	K PRCAHIS T
	3091	"RTN","PRC ACPS",195, 0)
	3092	Q
	3093	"RTN","PRC ACPS",196, 0)
	3094	;
	3095	"RTN","PRC ACPS",197, 0)
	3096	START1 ;
	3097	"RTN","PRC ACPS",198, 0)
	3098	;
	3099	"RTN","PRC ACPS",199, 0)
	3100	S BILL=""
	3101	"RTN","PRC ACPS",200, 0)
	3102	S CBALTOT =0 ; Will be the tot al of all CURRENT BA LANCE fiel d (#11) fo r the acco unt
	3103	"RTN","PRC ACPS",201, 0)
	3104	; ACCOUNT S RECEIVAB LE (#430) The C cros s-referenc e allows u ser look-u p of bills belonging to a
	3105	specific d ebtor.
	3106	"RTN","PRC ACPS",202, 0)
	3107	; Loop th rough bill s
	3108	"RTN","PRC ACPS",203, 0)
	3109	; ^TMP("P RCABILL",$ J,DEBTOR,B ILL)= Sum of CURRENT BALANCE f ield (#11) for the B ill
	3110	"RTN","PRC ACPS",204, 0)
	3111	; ^Sum of TRANS. AMOUNT (#1 5) for all transacti ons for th e Bill
	3112	"RTN","PRC ACPS",205, 0)
	3113	; ^Stop Flag if t he Bill ha s more tha n one erro r
	3114	"RTN","PRC ACPS",206, 0)
	3115	K ^TMP("P RCABILL",$ J)
	3116	"RTN","PRC ACPS",207, 0)
	3117	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	3118	"RTN","PRC ACPS",208, 0)
	3119	.; BILLTO T is the C URRENT BAL ANCE field (#11) for each Bill for the D ebtor
	3120	"RTN","PRC ACPS",209, 0)
	3121	.N BILLTO T
	3122	"RTN","PRC ACPS",210, 0)
	3123	.S BN0=$G (^PRCA(430 ,BILL,0))
	3124	"RTN","PRC ACPS",211, 0)
	3125	.; QUIT: CURRENT ST ATUS (#8) '= ACTIVE
	3126	"RTN","PRC ACPS",212, 0)
	3127	.; I $P(B N0,U,8)'=1 6 Q based on call o n 11/28/16 process a ll bill wi th a statu s other th an Refund Review
	3128	"RTN","PRC ACPS",213, 0)
	3129	.; Skip a ll Debtors with 1 or more Bill s with a s tatus of R EFEUND REV IEW (#44). This che ck is done in
	3130	"RTN","PRC ACPS",214, 0)
	3131	.; REFREV above.
	3132	"RTN","PRC ACPS",215, 0)
	3133	.; Sum up CURRENT B ALANCE (#1 1) for eac h ACTIVE B ill
	3134	"RTN","PRC ACPS",216, 0)
	3135	.; Set in CBALTOT f or BALDIFF and in PR CABILL for BILLDIFF in Start2
	3136	"RTN","PRC ACPS",217, 0)
	3137	.; S CBAL TOT=CBALTO T+$$GET1^D IQ(430,BIL L,11)
	3138	"RTN","PRC ACPS",218, 0)
	3139	.S BILLTO T=$$GET1^D IQ(430,BIL L,11) ; Ge t CURRENT BALANCE (# 11) which is compute d:
	3140	#71+#72+#7 3+#74+#75
	3141	"RTN","PRC ACPS",219, 0)
	3142	.S ^TMP(" PRCABILL", $J,DEBTOR, BILL)=+BIL LTOT
	3143	"RTN","PRC ACPS",220, 0)
	3144	.S CBALTO T=CBALTOT+ BILLTOT
	3145	"RTN","PRC ACPS",221, 0)
	3146	N BILL,I, TN,TRANSTO T,TNVAL,TT YPE,TNTOT
	3147	"RTN","PRC ACPS",222, 0)
	3148	S TN="",( BILL,TRANS TOT,TTYPE, TNVAL)=0
	3149	"RTN","PRC ACPS",223, 0)
	3150	; Loop th rough Bill s
	3151	"RTN","PRC ACPS",224, 0)
	3152	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	3153	"RTN","PRC ACPS",225, 0)
	3154	.; Call B ILLQUIT to determine if this b ill has mu ltiple iss ues
	3155	"RTN","PRC ACPS",226, 0)
	3156	.I $$BILL QUIT^PRCAC PSA(DEBTOR ,BILL) Q
	3157	"RTN","PRC ACPS",227, 0)
	3158	.; Initia lize TNTOT for Trans action Tot al for thi s bill
	3159	"RTN","PRC ACPS",228, 0)
	3160	.I $G(TNT OT(BILL))= "" S TNTOT (BILL)=0
	3161	"RTN","PRC ACPS",229, 0)
	3162	.; Loop t hrough Tra nsactions
	3163	"RTN","PRC ACPS",230, 0)
	3164	.S TN=0 F S TN=$O( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN)) Q:TN ="" D
	3165	"RTN","PRC ACPS",231, 0)
	3166	..; IF Tr ansaction # = 0 Add TRANS. AMO UNT (#15) to the Tra nsaction T otal
	3167	"RTN","PRC ACPS",232, 0)
	3168	..; I TN= 0 S TRANST OT=TRANSTO T+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN) Q
	3169	"RTN","PRC ACPS",233, 0)
	3170	..; S TNV AL = (#15) TRANS. AM OUNT from #433
	3171	"RTN","PRC ACPS",234, 0)
	3172	..S TNVAL =+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)
	3173	"RTN","PRC ACPS",235, 0)
	3174	..; S TTY PE = (#12) TRANSACTI ON TYPE fr om #433
	3175	"RTN","PRC ACPS",236, 0)
	3176	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	3177	"RTN","PRC ACPS",237, 0)
	3178	..; IF IN COMPLETE T RANSACTION FLAG is s et, set Tr ansaction amount = 0
	3179	"RTN","PRC ACPS",238, 0)
	3180	..S TCMPL T=+$P(^TMP ("PRCAGTPS ",$J,DEBTO R,BILL,TN) ,U,9)
	3181	"RTN","PRC ACPS",239, 0)
	3182	..I TCMPL T S TNVAL= 0
	3183	"RTN","PRC ACPS",240, 0)
	3184	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	3185	"RTN","PRC ACPS",241, 0)
	3186	..I TMBSN C S TNVAL= 0
	3187	"RTN","PRC ACPS",242, 0)
	3188	..; Set T NVAL =0 if one of th e followin g Transact ion Types:
	3189	"RTN","PRC ACPS",243, 0)
	3190	..; 3:REF ER TO RC, 4:REFER TO DOJ, 5:RE ESTABLISH TO RC/DOJ, 6:RETURNE D BY RC/DO J
	3191	"RTN","PRC ACPS",244, 0)
	3192	..; 25:RE PAYMENT PL AN, 32:RET URNED FOR AMENDMENT, 33:AMENDE D BILL
	3193	"RTN","PRC ACPS",245, 0)
	3194	..I (TTYP E=3)!(TTYP E=4)!(TTYP E=5)!(TTYP E=6)!(TTYP E=32)!(TTY PE=25)!(TT YPE=33) S TNVAL=0
	3195	"RTN","PRC ACPS",246, 0)
	3196	..; Set T NVAL to ne gative val ue if one of the Tra nsaction T ypes:
	3197	"RTN","PRC ACPS",247, 0)
	3198	..; 2:PAY MENT (IN P ART), 8:TE RM.BY FIS. OFFICER, 9 :TERM.BY C OMPROMISE, 10:WAIVED IN FULL
	3199	"RTN","PRC ACPS",248, 0)
	3200	..; 11:WA IVED IN PA RT, 14:EXE MPT INT/AD M. COST, 2 9:TERM.BY RC/DOJ, 34 :PAYMENT ( IN FULL)
	3201	"RTN","PRC ACPS",249, 0)
	3202	..; 35:DE CREASE ADJ USTMENT, 4 1:REFUNDED , 47:CHARG E SUSPENDE D
	3203	"RTN","PRC ACPS",250, 0)
	3204	..I
	3205	TTYPE=2!(T TYPE=8)!(T TYPE=9)!(T TYPE=10)!( TTYPE=11)! (TTYPE=14) !(TTYPE=29 )!(TTYPE=3 4)!(TTYPE= 35)!(
	3206	TTYPE=41)! (TTYPE=47) S TNVAL=- TNVAL
	3207	"RTN","PRC ACPS",251, 0)
	3208	..; Updat e Transact ion Total
	3209	"RTN","PRC ACPS",252, 0)
	3210	..S TRANS TOT=TRANST OT+TNVAL
	3211	"RTN","PRC ACPS",253, 0)
	3212	..; Updat e Transact ion Total for this B ill
	3213	"RTN","PRC ACPS",254, 0)
	3214	..S TNTOT (BILL)=TNT OT(BILL)+T NVAL
	3215	"RTN","PRC ACPS",255, 0)
	3216	.; Update PRCABILL with Trans action Tot al for thi s Bill
	3217	"RTN","PRC ACPS",256, 0)
	3218	.S $P(^TM P("PRCABIL L",$J,DEBT OR,BILL),U ,2)=TNTOT( BILL)
	3219	"RTN","PRC ACPS",257, 0)
	3220	; Set Bal ance Diffe rence = Su m up CURRE NT BALANCE (#8) for each ACTIV E Bill - T ransaction Total for all
	3221	bills - PB AL from AR EVENT fil e (#341)
	3222	"RTN","PRC ACPS",258, 0)
	3223	S BALDIFF =CBALTOT-T RANSTOT-PB AL
	3224	"RTN","PRC ACPS",259, 0)
	3225	K CBALTOT ,TRANSTOT, PBAL,TCMPL T,BILL,BN0
	3226	"RTN","PRC ACPS",260, 0)
	3227	Q
	3228	"RTN","PRC ACPS",261, 0)
	3229	;
	3230	"RTN","PRC ACPS",262, 0)
	3231	START2 ;
	3232	"RTN","PRC ACPS",263, 0)
	3233	N
	3234	I,ATNLAST, BILL,BILLC NT,BILLCNT R,BILLNUM, FLAGGED,TN ,TN9,TRANS TOT,TNVAL, TTYPE,TCPL T,STOP,TRA
	3235	NCRNT,TRAN PREV,TNLAS T
	3236	"RTN","PRC ACPS",264, 0)
	3237	S (BILL,B ILLCNTR,FL AGGED)=0,A TNLAST=""
	3238	"RTN","PRC ACPS",265, 0)
	3239	; ATNLAST = The las t number f or the acc ount
	3240	"RTN","PRC ACPS",266, 0)
	3241	; FLAGGED = Account level fla g noting i f audit da ta was mar ked for th is account
	3242	"RTN","PRC ACPS",267, 0)
	3243	; PRCAFIX (X) = Hold s the tota l of the n umber of t ransaction s for a bi ll that ma tch to che ck criteri a X
	3244	"RTN","PRC ACPS",268, 0)
	3245	; Determi ne the num ber of bil l for this account
	3246	"RTN","PRC ACPS",269, 0)
	3247	S (BILLCN T,BILLCNTR )=0,BILLNU M=""
	3248	"RTN","PRC ACPS",270, 0)
	3249	; Determi ne the num ber of bil ls for thi s account
	3250	"RTN","PRC ACPS",271, 0)
	3251	F S BILL NUM=$O(^TM P("PRCAGTP S",$J,DEBT OR,BILLNUM )) Q:'BILL NUM S BIL LCNT=BILLC NT+1
	3252	"RTN","PRC ACPS",272, 0)
	3253	; Loop th rough Bill s
	3254	"RTN","PRC ACPS",273, 0)
	3255	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	3256	"RTN","PRC ACPS",274, 0)
	3257	.S BILLCN TR=BILLCNT R+1
	3258	"RTN","PRC ACPS",275, 0)
	3259	.; QUIT i f STOP fla g is set f or this Bi ll
	3260	"RTN","PRC ACPS",276, 0)
	3261	.I $P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,3)=1 S FLAGGED= FLAGGED+1 Q
	3262	"RTN","PRC ACPS",277, 0)
	3263	.; New an d set Bill Balance D ifference
	3264	"RTN","PRC ACPS",278, 0)
	3265	.N BILLDI FF
	3266	"RTN","PRC ACPS",279, 0)
	3267	.; ***** The follow ing 2 form ulas will need to be re-evalua ted once t he VA supp lies us th e necessar y
	3268	details *
	3269	"RTN","PRC ACPS",280, 0)
	3270	.; If the Original Bill Amoun t is not n ull use th is formula
	3271	"RTN","PRC ACPS",281, 0)
	3272	.I +$G(^T MP("PRCAGT PS",$J,DEB TOR,BILL,0 )) D
	3273	"RTN","PRC ACPS",282, 0)
	3274	..S BILLD IFF=$P($G( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,0)),U,1)-
	3275	$P($G(^TMP ("PRCABILL ",$J,DEBTO R,BILL)),U ,1)+$P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,2)
	3276	"RTN","PRC ACPS",283, 0)
	3277	.; If the Original Amount is null use t his formul a
	3278	"RTN","PRC ACPS",284, 0)
	3279	.I '+$G(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, 0)) D
	3280	"RTN","PRC ACPS",285, 0)
	3281	..S BILLD IFF=$P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,1)-
	3282	$P($G(^TMP ("PRCABILL ",$J,DEBTO R,BILL)),U ,2)
	3283	"RTN","PRC ACPS",286, 0)
	3284	.; Quit i f Bill Bal ance Diffe rence is z ero
	3285	"RTN","PRC ACPS",287, 0)
	3286	.I 'BILLD IFF Q
	3287	"RTN","PRC ACPS",288, 0)
	3288	.; PRCAFI X(X) = Hol ds the tot al of the number of transactio ns for a b ill that m atch to ch eck criter ia X
	3289	"RTN","PRC ACPS",289, 0)
	3290	.; PRCATT TF = Total Transacti on Types t o Fix
	3291	"RTN","PRC ACPS",290, 0)
	3292	.N PRCATT TF,PRCAFIX
	3293	"RTN","PRC ACPS",291, 0)
	3294	.S (PRCAT TTF,TRANST OT,TTYPE,T NVAL)=0
	3295	"RTN","PRC ACPS",292, 0)
	3296	.S (TN,TN LAST)=""
	3297	"RTN","PRC ACPS",293, 0)
	3298	.; Initia lize type of fix cou nts
	3299	"RTN","PRC ACPS",294, 0)
	3300	.F I=1:1: 4 S PRCAFI X(I)=""
	3301	"RTN","PRC ACPS",295, 0)
	3302	.;
	3303	"RTN","PRC ACPS",296, 0)
	3304	.F S TN= $O(^TMP("P RCAGTPS",$ J,DEBTOR,B ILL,TN)) Q :TN="" D
	3305	"RTN","PRC ACPS",297, 0)
	3306	..; Save first tran saction nu mber
	3307	"RTN","PRC ACPS",298, 0)
	3308	..S (ATNL AST,TNLAST )=TN
	3309	"RTN","PRC ACPS",299, 0)
	3310	..; IF Tr ansaction number = 0 update Tr ansaction Total with (#15) TRA NS. AMOUNT from #433
	3311	"RTN","PRC ACPS",300, 0)
	3312	..I TN=0 S TRANSTOT =TRANSTOT+ ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN) Q
	3313	"RTN","PRC ACPS",301, 0)
	3314	..; Set T NVAL = (#1 5) TRANS. AMOUNT fro m #433
	3315	"RTN","PRC ACPS",302, 0)
	3316	..S TNVAL =$P(^TMP(" PRCAGTPS", $J,DEBTOR, BILL,TN),U ,1)
	3317	"RTN","PRC ACPS",303, 0)
	3318	..; Set T TYPE = (#1 2) TRANSAC TION TYPE from #433
	3319	"RTN","PRC ACPS",304, 0)
	3320	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	3321	"RTN","PRC ACPS",305, 0)
	3322	..; Set T CPLT = (#1 0) INCOMPL ETE TRANSA CTION FLAG
	3323	"RTN","PRC ACPS",306, 0)
	3324	..S TCPLT =+$P($G(^P RCA(433,TN ,0)),U,10)
	3325	"RTN","PRC ACPS",307, 0)
	3326	..; I thi nk this wi ll always be blank
	3327	"RTN","PRC ACPS",308, 0)
	3328	..S TRDMR D=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,10)
	3329	"RTN","PRC ACPS",309, 0)
	3330	..; I thi nk this wi ll always be blank
	3331	"RTN","PRC ACPS",310, 0)
	3332	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	3333	"RTN","PRC ACPS",311, 0)
	3334	..; Quit it this tr ansaction was previo usly used to correct an out of balance s cenario
	3335	"RTN","PRC ACPS",312, 0)
	3336	..S TN9=$ G(^PRCA(43 3,TN,9))
	3337	"RTN","PRC ACPS",313, 0)
	3338	..Q:$P(TN 9,U,4)'=""
	3339	"RTN","PRC ACPS",314, 0)
	3340	..;
	3341	"RTN","PRC ACPS",315, 0)
	3342	..; Check #1 - Tran saction wi th missing $ amount & Transact ion Type ' = Comment (#45)
	3343	"RTN","PRC ACPS",316, 0)
	3344	..;I TNVA L="",(TTYP E'=45) D Q
	3345	"RTN","PRC ACPS",317, 0)
	3346	..;.S PRC AFIX(1)=$G (PRCAFIX(1 ))+1,IENCR RT=TN
	3347	"RTN","PRC ACPS",318, 0)
	3348	..;.S PRC AFIX(1,TN) =""
	3349	"RTN","PRC ACPS",319, 0)
	3350	..;
	3351	"RTN","PRC ACPS",320, 0)
	3352	..; Check #2 - Tran saction ma rked as In complete w ith +$ amo unt matchi ng off by amount
	3353	"RTN","PRC ACPS",321, 0)
	3354	..I TNVAL =BILLDIFF I TCPLT D Q
	3355	"RTN","PRC ACPS",322, 0)
	3356	...Q:(TTY PE=45)
	3357	"RTN","PRC ACPS",323, 0)
	3358	...I TRDM RD Q
	3359	"RTN","PRC ACPS",324, 0)
	3360	...S PRCA FIX(2)=$G( PRCAFIX(2) )+1,IENCRR T=TN
	3361	"RTN","PRC ACPS",325, 0)
	3362	...S PRCA FIX(2,TN)= ""
	3363	"RTN","PRC ACPS",326, 0)
	3364	..;
	3365	"RTN","PRC ACPS",327, 0)
	3366	..; Check #3 - Tran saction ma rked as In complete w ith -$ amo unt matchi ng off by amount
	3367	"RTN","PRC ACPS",328, 0)
	3368	..I -TNVA L=BILLDIFF I TCPLT D Q
	3369	"RTN","PRC ACPS",329, 0)
	3370	...Q:(TTY PE=45)
	3371	"RTN","PRC ACPS",330, 0)
	3372	...S PRCA FIX(3)=$G( PRCAFIX(3) )+1,IENCRR T=TN
	3373	"RTN","PRC ACPS",331, 0)
	3374	...S PRCA FIX(3,TN)= ""
	3375	"RTN","PRC ACPS",332, 0)
	3376	..;
	3377	"RTN","PRC ACPS",333, 0)
	3378	..; Check #4 - Dupl icate Tran saction
	3379	"RTN","PRC ACPS",334, 0)
	3380	..I TTYPE '=45,($P(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, TN),U,12)= 1) D
	3381	"RTN","PRC ACPS",335, 0)
	3382	...S PRCA FIX(4)=$G( PRCAFIX(4) )+1,IENCRR T=TN
	3383	"RTN","PRC ACPS",336, 0)
	3384	...S PRCA FIX(4,TN)= ""
	3385	"RTN","PRC ACPS",337, 0)
	3386	.;
	3387	"RTN","PRC ACPS",338, 0)
	3388	.; Quit i f there we re no tran sactions f or this bi ll
	3389	"RTN","PRC ACPS",339, 0)
	3390	.I $G(IEN CRRT)=""!( $G(TNLAST) ="") Q
	3391	"RTN","PRC ACPS",340, 0)
	3392	.; If we are on the last Bill and there were no t ransaction s for the entire acc ount Quit
	3393	"RTN","PRC ACPS",341, 0)
	3394	.I BILLCN TR=BILLCNT ,ATNLAST=" " Q
	3395	"RTN","PRC ACPS",342, 0)
	3396	.;
	3397	"RTN","PRC ACPS",343, 0)
	3398	.F I=1:1: 4 D
	3399	"RTN","PRC ACPS",344, 0)
	3400	..S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	3401	"RTN","PRC ACPS",345, 0)
	3402	.; if you get to he re the bil l was out of balance and if it shows not hing to fi x, set las t transact ion
	3403	"RTN","PRC ACPS",346, 0)
	3404	.; for th is Bill to NOT FIXAB LE
	3405	"RTN","PRC ACPS",347, 0)
	3406	.I PRCATT TF=0 D UPD TLTR^PRCAC PSA($G(TNL AST)) S FL AGGED=1 Q
	3407	"RTN","PRC ACPS",348, 0)
	3408	.; Update this bill
	3409	"RTN","PRC ACPS",349, 0)
	3410	.D FIXBIL L(.FLAGGED )
	3411	"RTN","PRC ACPS",350, 0)
	3412	Q:FLAGGED
	3413	"RTN","PRC ACPS",351, 0)
	3414	; The acc ount was o ut of bala nce but no thing was found on a ny bill th at could b e fixed.
	3415	"RTN","PRC ACPS",352, 0)
	3416	; Mark th e last tra nsaction f or the las t bill for this acco unt as not fixable.
	3417	"RTN","PRC ACPS",353, 0)
	3418	I 'FLAGGE D D UPDTLT R^PRCACPSA ($G(ATNLAS T))
	3419	"RTN","PRC ACPS",354, 0)
	3420	Q
	3421	"RTN","PRC ACPS",355, 0)
	3422	;
	3423	"RTN","PRC ACPS",356, 0)
	3424	FIXBILL(FL AGGED) ;Up date a sin gle bill u sing PRCAF IX array
	3425	"RTN","PRC ACPS",357, 0)
	3426	; Make up date deter mination b ased on ch ecks 1 - 4 .
	3427	"RTN","PRC ACPS",358, 0)
	3428	; Sum up check tota ls
	3429	"RTN","PRC ACPS",359, 0)
	3430	;F I=1:1: 4 D
	3431	"RTN","PRC ACPS",360, 0)
	3432	;.S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	3433	"RTN","PRC ACPS",361, 0)
	3434	; Get cur rent date/ time
	3435	"RTN","PRC ACPS",362, 0)
	3436	N PRCADAT E
	3437	"RTN","PRC ACPS",363, 0)
	3438	D NOW^%DT C
	3439	"RTN","PRC ACPS",364, 0)
	3440	S PRCADAT E=X
	3441	"RTN","PRC ACPS",365, 0)
	3442	; Otherwi se there i s only 1 b ad transac tion so up date as ne eded
	3443	"RTN","PRC ACPS",366, 0)
	3444	; Lock Re cord
	3445	"RTN","PRC ACPS",367, 0)
	3446	L +^PRCA( 433,IENCRR T,9):DILOC KTM
	3447	"RTN","PRC ACPS",368, 0)
	3448	; If lock not obtai ned, updat e number o f transact ions that couldn't b e fixed
	3449	"RTN","PRC ACPS",369, 0)
	3450	Q:'$T
	3451	"RTN","PRC ACPS",370, 0)
	3452	; Set FDA array for the neces sary field s based on the type of fix ide ntified
	3453	"RTN","PRC ACPS",371, 0)
	3454	N PRCAFDA
	3455	"RTN","PRC ACPS",372, 0)
	3456	;I PRCAFI X(1) D
	3457	"RTN","PRC ACPS",373, 0)
	3458	;.S PRCAF DA(433,IEN CRRT_",",1 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	3459	"RTN","PRC ACPS",374, 0)
	3460	;.S PRCAF DA(433,IEN CRRT_",",9 4)=PRCADAT E
	3461	"RTN","PRC ACPS",375, 0)
	3462	;.S PRCAF DA(433,IEN CRRT_",",9 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	3463	"RTN","PRC ACPS",376, 0)
	3464	;.S PRCAF DA(433,IEN CRRT_",",9 6)="N" ; N ULL TRANSA CTION AMOU NT
	3465	"RTN","PRC ACPS",377, 0)
	3466	; Check # 2 - Transa ction mark ed as Inco mplete wit h +$ amoun t matching off by am ount
	3467	"RTN","PRC ACPS",378, 0)
	3468	; Check # 3 - Transa ction mark ed as Inco mplete wit h -$ amoun t matching off by am ount
	3469	"RTN","PRC ACPS",379, 0)
	3470	I PRCAFIX (2)!(PRCAF IX(3)) D
	3471	"RTN","PRC ACPS",380, 0)
	3472	.S PRCAFD A(433,IENC RRT_",",10 )=""
	3473	"RTN","PRC ACPS",381, 0)
	3474	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	3475	"RTN","PRC ACPS",382, 0)
	3476	.S PRCAFD A(433,IENC RRT_",",96 )="I" ; IN COMPLETE F LAG ERROR
	3477	"RTN","PRC ACPS",383, 0)
	3478	; Check # 4 - Duplic ate Transa ction
	3479	"RTN","PRC ACPS",384, 0)
	3480	I PRCAFIX (4) D
	3481	"RTN","PRC ACPS",385, 0)
	3482	.; Null o ut audit f ields on o riginal tr ansaction
	3483	"RTN","PRC ACPS",386, 0)
	3484	.S PRCAFD A(433,IENC RRT-1_",", 94)=""
	3485	"RTN","PRC ACPS",387, 0)
	3486	.S PRCAFD A(433,IENC RRT-1_",", 95)=""
	3487	"RTN","PRC ACPS",388, 0)
	3488	.S PRCAFD A(433,IENC RRT-1_",", 96)=""
	3489	"RTN","PRC ACPS",389, 0)
	3490	.L +^PRCA (433,IENCR RT-1,9):DI LOCKTM
	3491	"RTN","PRC ACPS",390, 0)
	3492	.Q:'$T
	3493	"RTN","PRC ACPS",391, 0)
	3494	.D FILE^D IE(,"PRCAF DA")
	3495	"RTN","PRC ACPS",392, 0)
	3496	.L -^PRCA (433,IENCR RT-1,9)
	3497	"RTN","PRC ACPS",393, 0)
	3498	.; Set th e fields f or the dup licate tra nsaction
	3499	"RTN","PRC ACPS",394, 0)
	3500	.S PRCAFD A(433,IENC RRT_",",10 )=1 ; INCO MPLETE TRA NSACTION
	3501	"RTN","PRC ACPS",395, 0)
	3502	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	3503	"RTN","PRC ACPS",396, 0)
	3504	.S PRCAFD A(433,IENC RRT_",",95 )=$S(BILLD IFF>0:BILL DIFF,1:-BI LLDIFF)
	3505	"RTN","PRC ACPS",397, 0)
	3506	.S PRCAFD A(433,IENC RRT_",",96 )="D" ; DU PLICATE TR ANSACTION
	3507	"RTN","PRC ACPS",398, 0)
	3508	; Update Transactio n
	3509	"RTN","PRC ACPS",399, 0)
	3510	D FILE^DI E(,"PRCAFD A")
	3511	"RTN","PRC ACPS",400, 0)
	3512	S FLAGGED =1
	3513	"RTN","PRC ACPS",401, 0)
	3514	; Unlock file
	3515	"RTN","PRC ACPS",402, 0)
	3516	L -^PRCA( 433,IENCRR T,9)
	3517	"RTN","PRC ACPS",403, 0)
	3518	K TMBSNC, IENCRRT
	3519	"RTN","PRC ACPS",404, 0)
	3520	Q
	3521	"RTN","PRC ACPS",405, 0)
	3522	;
	3523	"RTN","PRC ACPS",406, 0)
	3524	DIQOUTCS(D IQOUT) ;Re turn check sum for a processed DIQOUT arr ay.
	3525	"RTN","PRC ACPS",407, 0)
	3526	N CS,DATA ,FIELD,FNU M,IENS,IND ,SFN,STRIN G,TARGET,T EXT,WP
	3527	"RTN","PRC ACPS",408, 0)
	3528	S FNUM=$O (DIQOUT("" ))
	3529	"RTN","PRC ACPS",409, 0)
	3530	S (CS,FNU M)=0
	3531	"RTN","PRC ACPS",410, 0)
	3532	F S FNUM =$O(DIQOUT (FNUM)) Q: FNUM="" D
	3533	"RTN","PRC ACPS",411, 0)
	3534	.S IENS=" "
	3535	"RTN","PRC ACPS",412, 0)
	3536	.F S IEN S=$O(DIQOU T(FNUM,IEN S)) Q:IENS ="" D
	3537	"RTN","PRC ACPS",413, 0)
	3538	..S FIELD =0
	3539	"RTN","PRC ACPS",414, 0)
	3540	..F S FI ELD=$O(DIQ OUT(FNUM,I ENS,FIELD) ) Q:FIELD= "" D
	3541	"RTN","PRC ACPS",415, 0)
	3542	...S DATA =DIQOUT(FN UM,IENS,FI ELD)
	3543	"RTN","PRC ACPS",416, 0)
	3544	...S TEXT =FNUM_$L(I ENS,",")_F IELD_DATA
	3545	"RTN","PRC ACPS",417, 0)
	3546	...S CS=$ $CRC32^XLF CRC(TEXT,C S)
	3547	"RTN","PRC ACPS",418, 0)
	3548	Q CS
	3549	"RTN","PRC ACPS",419, 0)
	3550	;
	3551	"RTN","PRC ACPS",420, 0)
	3552	USRMSG ;se nds mailma n message to the PRC ACPS mail group
	3553	"RTN","PRC ACPS",421, 0)
	3554	N XMY,XMD UZ,XMSUB,X MTEXT,X
	3555	"RTN","PRC ACPS",422, 0)
	3556	S XMDUZ=" AR PACKAGE "
	3557	"RTN","PRC ACPS",423, 0)
	3558	S XMY("G. PRCACPS")= ""
	3559	"RTN","PRC ACPS",424, 0)
	3560	S XMSUB=" CPS AUTO-C ORRECTION COMPLETE " _$E(DT,4,5 )_"/"_$E(D T,6,7)_"/" _$E(DT,2,3 )
	3561	"RTN","PRC ACPS",425, 0)
	3562	S X(1)="C onsolidate d Patient Statement Auto-Corre ction"
	3563	"RTN","PRC ACPS",426, 0)
	3564	S X(2)="P rogram com pleted on "_$$FMTE^X LFDT($$NOW ^XLFDT()," 5P")
	3565	"RTN","PRC ACPS",427, 0)
	3566	S XMTEXT= "X("
	3567	"RTN","PRC ACPS",428, 0)
	3568	D ^XMD
	3569	"RTN","PRC ACPS",429, 0)
	3570	; Remove ^XTMP node
	3571	"RTN","PRC ACPS",430, 0)
	3572	K ^XTMP(" PRCACPS",0 )
	3573	"RTN","PRC ACPS",431, 0)
	3574	Q
	3575	"RTN","PRC ACPS1")
	3576	0^28^B1912 8158^n/a
	3577	"RTN","PRC ACPS1",1,0 )
	3578	PRCACPS1 ; ALBANY/BDB -PATIENT S TATEMENTS UPDATE ;03 /25/16 3:3 4 PM
	3579	"RTN","PRC ACPS1",2,0 )
	3580	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 131
	3581	"RTN","PRC ACPS1",3,0 )
	3582	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3583	"RTN","PRC ACPS1",4,0 )
	3584	;
	3585	"RTN","PRC ACPS1",5,0 )
	3586	Q
	3587	"RTN","PRC ACPS1",6,0 )
	3588	;
	3589	"RTN","PRC ACPS1",7,0 )
	3590	ENTER ;cal led by the cbs night ly account update pr ogram opti on
	3591	"RTN","PRC ACPS1",8,0 )
	3592	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K,ZTSAVE,R CFULL
	3593	"RTN","PRC ACPS1",9,0 )
	3594	S RCFULL= 1 ;run the full debt or list
	3595	"RTN","PRC ACPS1",10, 0)
	3596	W !,"Queu e the pati ent statem ent update program t o run:"
	3597	"RTN","PRC ACPS1",11, 0)
	3598	S ZTDESC= "Consolida ted Billin g Statemen t Update"
	3599	"RTN","PRC ACPS1",12, 0)
	3600	S ZTRTN=" DEBTOR^PRC ACPS1",ZTI O="",ZTSAV E("RCFULL" )=""
	3601	"RTN","PRC ACPS1",13, 0)
	3602	D ^%ZTLOA D
	3603	"RTN","PRC ACPS1",14, 0)
	3604	Q
	3605	"RTN","PRC ACPS1",15, 0)
	3606	;
	3607	"RTN","PRC ACPS1",16, 0)
	3608	DEBTOR ;ca lled by rc cpcbj
	3609	"RTN","PRC ACPS1",17, 0)
	3610	N DEBTOR, X,DEBTOR0, DEBTOR1,DE BTOR7,CBSS TOT,BALDT
	3611	"RTN","PRC ACPS1",18, 0)
	3612	K ^XTMP(" RCCBSS",$J )
	3613	"RTN","PRC ACPS1",19, 0)
	3614	S ^XTMP(" RCCBSS",$J ,0)=$$FMAD D^XLFDT(DT ,3)_"^"_DT
	3615	"RTN","PRC ACPS1",20, 0)
	3616	S DEBTOR= 0
	3617	"RTN","PRC ACPS1",21, 0)
	3618	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	3619	"RTN","PRC ACPS1",22, 0)
	3620	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) ),DEBTOR7= $G(^(7)),B ALDT=""
	3621	"RTN","PRC ACPS1",23, 0)
	3622	.Q:$P(DEB TOR0,"^")' ["DPT("
	3623	"RTN","PRC ACPS1",24, 0)
	3624	.I +$$GET ICN^MPIF00 1(+DEBTOR0 )<0 Q ;qu it if no i cn
	3625	"RTN","PRC ACPS1",25, 0)
	3626	.S BALDT= $$BILLS(DE BTOR) Q:$P (BALDT,U,2 )=9999999
	3627	"RTN","PRC ACPS1",26, 0)
	3628	.D RECPD
	3629	"RTN","PRC ACPS1",27, 0)
	3630	D COMPILE
	3631	"RTN","PRC ACPS1",28, 0)
	3632	K ^XTMP(" RCCBSS",$J )
	3633	"RTN","PRC ACPS1",29, 0)
	3634	Q
	3635	"RTN","PRC ACPS1",30, 0)
	3636	;
	3637	"RTN","PRC ACPS1",31, 0)
	3638	RECPD(BILL ) ;add a n ew account update
	3639	"RTN","PRC ACPS1",32, 0)
	3640	N REC,RCD FN
	3641	"RTN","PRC ACPS1",33, 0)
	3642	S RCDFN=+ DEBTOR0
	3643	"RTN","PRC ACPS1",34, 0)
	3644	S REC="PD ^"_$$GETIC N^MPIF001( RCDFN)_"^"
	3645	"RTN","PRC ACPS1",35, 0)
	3646	S
	3647	REC=REC_$$ SITE^RCMSI TE_$$UP^XL FSTR($S(($ $SSN^RCFN0 1(DEBTOR)] "")&($$NAM ^RCFN01(DE BTOR)]
	3648	""):$TR($E ($$SSN^RCF N01(DEBTOR ),1,9)_$E( $P($$NAM^R CFN01(DEBT OR),","),1 ,5)," ","" ),1:""))_" ^"
	3649	"RTN","PRC ACPS1",36, 0)
	3650	S REC=REC _RCDFN_"^"
	3651	"RTN","PRC ACPS1",37, 0)
	3652	S BALDT=$ $BILLS(DEB TOR)
	3653	"RTN","PRC ACPS1",38, 0)
	3654	S CBSSTOT =+$P(DEBTO R7,U,6)
	3655	"RTN","PRC ACPS1",39, 0)
	3656	I '$G(RCF ULL) Q:CBS STOT=+BALD T
	3657	"RTN","PRC ACPS1",40, 0)
	3658	S $P(^RCD (340,DEBTO R,7),U,6)= +BALDT
	3659	"RTN","PRC ACPS1",41, 0)
	3660	S REC=REC _$$HEX(+BA LDT)_"^"_$ P(BALDT,U, 2)_"^\|"
	3661	"RTN","PRC ACPS1",42, 0)
	3662	S ^XTMP(" RCCBSS",$J ,DEBTOR)=R EC
	3663	"RTN","PRC ACPS1",43, 0)
	3664	Q
	3665	"RTN","PRC ACPS1",44, 0)
	3666	;
	3667	"RTN","PRC ACPS1",45, 0)
	3668	BILLS(DEBT OR) ;get o ldest bill date
	3669	"RTN","PRC ACPS1",46, 0)
	3670	N BALTOT, BILL,BN0,P RPDT,OLDDT
	3671	"RTN","PRC ACPS1",47, 0)
	3672	S BILL=""
	3673	"RTN","PRC ACPS1",48, 0)
	3674	S BALTOT= 0,OLDDT=99 99999
	3675	"RTN","PRC ACPS1",49, 0)
	3676	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	3677	"RTN","PRC ACPS1",50, 0)
	3678	.Q:$D(^PR CA(430,"TC SP",BILL)) ;cs chec k
	3679	"RTN","PRC ACPS1",51, 0)
	3680	.S BN0=$G (^PRCA(430 ,BILL,0))
	3681	"RTN","PRC ACPS1",52, 0)
	3682	.I $P(BN0 ,U,8)'=16 Q ;not ac tive
	3683	"RTN","PRC ACPS1",53, 0)
	3684	.S BALTOT =BALTOT+$$ GET1^DIQ(4 30,BILL,11 )
	3685	"RTN","PRC ACPS1",54, 0)
	3686	.S PRPDT= $P(^PRCA(4 30,BILL,0) ,U,10) I + PRPDT,OLDD T>PRPDT S OLDDT=PRPD T
	3687	"RTN","PRC ACPS1",55, 0)
	3688	Q BALTOT_ U_$S(OLDDT '=9999999: $$DTMDY(OL DDT),1:"")
	3689	"RTN","PRC ACPS1",56, 0)
	3690	;
	3691	"RTN","PRC ACPS1",57, 0)
	3692	COMPILE ;
	3693	"RTN","PRC ACPS1",58, 0)
	3694	N RCMSG,D CNTR,REC,R ECC,AMOUNT ,RCNTR,ACT ION,SEQ,SE QTOT
	3695	"RTN","PRC ACPS1",59, 0)
	3696	S DCNTR=0 ,REC=1,REC C=0,AMOUNT =0,SEQ=1,S EQTOT=0
	3697	"RTN","PRC ACPS1",60, 0)
	3698	F S DCNT R=$O(^XTMP ("RCCBSS", $J,DCNTR)) S:+DCNTR' >0 SEQTOT= SEQ Q:+DCN TR'>0 D
	3699	"RTN","PRC ACPS1",61, 0)
	3700	.I REC>45 0 D
	3701	"RTN","PRC ACPS1",62, 0)
	3702	..S ^XTMP ("RCCBSS", $J,"BUILD" ,SEQ,REC)= ^XTMP("RCC BSS",$J,"B UILD",SEQ, REC)_"~"
	3703	"RTN","PRC ACPS1",63, 0)
	3704	..D HEADE R
	3705	"RTN","PRC ACPS1",64, 0)
	3706	..D AITCM SG
	3707	"RTN","PRC ACPS1",65, 0)
	3708	..S REC=0 ,SEQ=SEQ+1
	3709	"RTN","PRC ACPS1",66, 0)
	3710	..Q
	3711	"RTN","PRC ACPS1",67, 0)
	3712	.S REC=RE C+1
	3713	"RTN","PRC ACPS1",68, 0)
	3714	.S ^XTMP( "RCCBSS",$ J,"BUILD", SEQ,REC)=^ XTMP("RCCB SS",$J,DCN TR)
	3715	"RTN","PRC ACPS1",69, 0)
	3716	.Q
	3717	"RTN","PRC ACPS1",70, 0)
	3718	Q:'$D(^XT MP("RCCBSS ",$J,"BUIL D",SEQ))
	3719	"RTN","PRC ACPS1",71, 0)
	3720	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,REC)=^X TMP("RCCBS S",$J,"BUI LD",SEQ,RE C)_"~"
	3721	"RTN","PRC ACPS1",72, 0)
	3722	D HEADER
	3723	"RTN","PRC ACPS1",73, 0)
	3724	D AITCMSG
	3725	"RTN","PRC ACPS1",74, 0)
	3726	Q
	3727	"RTN","PRC ACPS1",75, 0)
	3728	;
	3729	"RTN","PRC ACPS1",76, 0)
	3730	AITCMSG ;
	3731	"RTN","PRC ACPS1",77, 0)
	3732	N XMY,XMD UZ,XMSUB,X MTEXT
	3733	"RTN","PRC ACPS1",78, 0)
	3734	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3735	"RTN","PRC ACPS1",79, 0)
	3736	S XMDUZ=" AR PACKAGE "
	3737	"RTN","PRC ACPS1",80, 0)
	3738	;S XMY("X XX@Q-CPT URL ")=""
	3739	"RTN","PRC ACPS1",81, 0)
	3740	S X=$O(^R CT(349.1," B","PU",0) )
	3741	"RTN","PRC ACPS1",82, 0)
	3742	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S
	3743	X=$P($G(^R CT(349.1,+ X,3)),"^") _"@"_$P($G (^RCT(349. 1,+X,3))," ^",3) S:$P (X,"@",2)] "" XMY(X)= ""
	3744	"RTN","PRC ACPS1",83, 0)
	3745	S XMY("G. PRCACPS")= ""
	3746	"RTN","PRC ACPS1",84, 0)
	3747	S XMSUB=S ITE_"/CBSS TRANSMISS ION/BATCH# : "_SEQ
	3748	"RTN","PRC ACPS1",85, 0)
	3749	S XMTEXT= "^XTMP(""R CCBSS"","_ $J_",""BUI LD"","_SEQ _","
	3750	"RTN","PRC ACPS1",86, 0)
	3751	D ^XMD
	3752	"RTN","PRC ACPS1",87, 0)
	3753	K ^XTMP(" RCCBSS",$J ,"BUILD",S EQ)
	3754	"RTN","PRC ACPS1",88, 0)
	3755	Q
	3756	"RTN","PRC ACPS1",89, 0)
	3757	;
	3758	"RTN","PRC ACPS1",90, 0)
	3759	HEADER ;
	3760	"RTN","PRC ACPS1",91, 0)
	3761	;incremen t batch se quence num ber, build new heade r
	3762	"RTN","PRC ACPS1",92, 0)
	3763	N RCMSG,S ITE
	3764	"RTN","PRC ACPS1",93, 0)
	3765	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3766	"RTN","PRC ACPS1",94, 0)
	3767	S RCMSG=" PU"_"^"_SE Q_"^"_SEQT OT_"^"_(RE C-1)_"^"_S ITE_"^"_$$ DTMDY(DT)_ "^\|"
	3768	"RTN","PRC ACPS1",95, 0)
	3769	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,1)=RCMS G
	3770	"RTN","PRC ACPS1",96, 0)
	3771	Q
	3772	"RTN","PRC ACPS1",97, 0)
	3773	;
	3774	"RTN","PRC ACPS1",98, 0)
	3775	HEX(AMT) ; sets up am ount forma tted as 99 9999999V99 S w/no lea ding blank s and trai ling sign
	3776	"RTN","PRC ACPS1",99, 0)
	3777	I $G(AMT) '?.1"-".N. 1".".N S A MT="" G Q
	3778	"RTN","PRC ACPS1",100 ,0)
	3779	S AMT=$TR ($J(AMT,9, 2)," ","")
	3780	"RTN","PRC ACPS1",101 ,0)
	3781	I $E(AMT) ="-" S AMT =$E(AMT,2, 99)_$E(AMT ,1)
	3782	"RTN","PRC ACPS1",102 ,0)
	3783	E S AMT= AMT_"+"
	3784	"RTN","PRC ACPS1",103 ,0)
	3785	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	3786	"RTN","PRC ACPS1",104 ,0)
	3787	Q Q AMT
	3788	"RTN","PRC ACPS1",105 ,0)
	3789	;
	3790	"RTN","PRC ACPS1",106 ,0)
	3791	DTMDY(DAT) ;Changes date from fm to mmdd yyyy forma t
	3792	"RTN","PRC ACPS1",107 ,0)
	3793	N YR
	3794	"RTN","PRC ACPS1",108 ,0)
	3795	I '$G(DAT ) G QDAT
	3796	"RTN","PRC ACPS1",109 ,0)
	3797	S YR=$E(( $E(DAT,1,3 )+1700),1, 2)
	3798	"RTN","PRC ACPS1",110 ,0)
	3799	Q $E(DAT, 4,5)_$E(DA T,6,7)_$G( YR)_$E(DAT ,2,3)
	3800	"RTN","PRC ACPS1",111 ,0)
	3801	QDAT Q ""
	3802	"RTN","PRC ACPS1",112 ,0)
	3803	;
	3804	"RTN","PRC ACPS1",113 ,0)
	3805	BLANK(X) ; returns 'x ' blank sp aces
	3806	"RTN","PRC ACPS1",114 ,0)
	3807	N BLANK
	3808	"RTN","PRC ACPS1",115 ,0)
	3809	S BLANK=" ",$P(BLANK ," ",X+1)= ""
	3810	"RTN","PRC ACPS1",116 ,0)
	3811	Q BLANK
	3812	"RTN","PRC ACPS1",117 ,0)
	3813	;
	3814	"RTN","PRC ACPS1",118 ,0)
	3815	RJZF(X,Y) ;right jus tify zero fill width Y
	3816	"RTN","PRC ACPS1",119 ,0)
	3817	S X=$E("0 0000000000 0",1,Y-$L( X))_X
	3818	"RTN","PRC ACPS1",120 ,0)
	3819	Q X
	3820	"RTN","PRC ACPS1",121 ,0)
	3821	;
	3822	"RTN","PRC ACPS1",122 ,0)
	3823	LJSF(X,Y) ;left just ified spac e filled
	3824	"RTN","PRC ACPS1",123 ,0)
	3825	S X=$E(X, 1,Y)
	3826	"RTN","PRC ACPS1",124 ,0)
	3827	S X=X_$$B LANK(Y-$L( X))
	3828	"RTN","PRC ACPS1",125 ,0)
	3829	Q X
	3830	"RTN","PRC ACPS1",126 ,0)
	3831	;
	3832	"RTN","PRC ACPS1",127 ,0)
	3833	JD() ; ret urns today 's Julian date YDOY
	3834	"RTN","PRC ACPS1",128 ,0)
	3835	N XMDDD,X MNOW,XMDT
	3836	"RTN","PRC ACPS1",129 ,0)
	3837	S XMNOW=$ $NOW^XLFDT
	3838	"RTN","PRC ACPS1",130 ,0)
	3839	S XMDT=$E (XMNOW,1,7 )
	3840	"RTN","PRC ACPS1",131 ,0)
	3841	S XMDDD=$ $RJ^XLFSTR ($$FMDIFF^ XLFDT(XMDT ,$E(XMDT,1 ,3)_"0101" ,1)+1,3,"0 ")
	3842	"RTN","PRC ACPS1",132 ,0)
	3843	Q $E(DT,3 )_XMDDD
	3844	"RTN","PRC ACPS1",133 ,0)
	3845	;
	3846	"RTN","PRC ACPS1",134 ,0)
	3847	AMOUNT(X) ;changes a mount to z ero filled , right ju stified
	3848	"RTN","PRC ACPS1",135 ,0)
	3849	S:X<0 X=- X
	3850	"RTN","PRC ACPS1",136 ,0)
	3851	S X=$TR($ J(X,0,2)," .")
	3852	"RTN","PRC ACPS1",137 ,0)
	3853	S X=$E("0 0000000000 0",1,14-$L (X))_X
	3854	"RTN","PRC ACPS1",138 ,0)
	3855	Q X
	3856	"RTN","PRC ACPS1",139 ,0)
	3857	;
	3858	"RTN","PRC ACPSA")
	3859	0^29^B3327 0653^n/a
	3860	"RTN","PRC ACPSA",1,0 )
	3861	PRCACPSA ; ALBANY/MGD -PATIENT S TATEMENTS AUTO-CORRE CTION ;09/ 21/15 3:34 PM
	3862	"RTN","PRC ACPSA",2,0 )
	3863	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 131
	3864	"RTN","PRC ACPSA",3,0 )
	3865	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3866	"RTN","PRC ACPSA",4,0 )
	3867	;
	3868	"RTN","PRC ACPSA",5,0 )
	3869	Q
	3870	"RTN","PRC ACPSA",6,0 )
	3871	;
	3872	"RTN","PRC ACPSA",7,0 )
	3873	BILLQUIT(D EBTOR,BILL ) ;
	3874	"RTN","PRC ACPSA",8,0 )
	3875	; check n ews and in itializati ons
	3876	"RTN","PRC ACPSA",9,0 )
	3877	N
	3878	FILENUM,IE NCRRT,IENP REV,PRCABF IX,PRCABST ,PRCAFDA,P RCACUR,PRC ACUR1,PRCA PRV,PRCAPR V1,TN,
	3879	TNLAST,TRN SCRRT,TRNS PREV,X
	3880	"RTN","PRC ACPSA",10, 0)
	3881	S TNLAST= ""
	3882	"RTN","PRC ACPSA",11, 0)
	3883	S PRCABFI X=0
	3884	"RTN","PRC ACPSA",12, 0)
	3885	S TN=0
	3886	"RTN","PRC ACPSA",13, 0)
	3887	F S TN=$ O(^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)) Q: 'TN D
	3888	"RTN","PRC ACPSA",14, 0)
	3889	.; Load 0 and 1 nod es
	3890	"RTN","PRC ACPSA",15, 0)
	3891	.S PRCACU R=$G(^PRCA (433,TN,0) )
	3892	"RTN","PRC ACPSA",16, 0)
	3893	.S PRCACU R1=$G(^PRC A(433,TN,1 ))
	3894	"RTN","PRC ACPSA",17, 0)
	3895	.; Quit i f this Tra nsaction i s a COMMEN T
	3896	"RTN","PRC ACPSA",18, 0)
	3897	.I $P(PRC ACUR1,U,2) =45 Q
	3898	"RTN","PRC ACPSA",19, 0)
	3899	.; Quit i f this tra nsaction w as updated earlier a s part of an previou s fix
	3900	"RTN","PRC ACPSA",20, 0)
	3901	.I $P($G( ^PRCA(433, TN,9)),U,4 ) Q
	3902	"RTN","PRC ACPSA",21, 0)
	3903	.S TNLAST =TN
	3904	"RTN","PRC ACPSA",22, 0)
	3905	.; Check if Transac tion is ma rked as IN COMPLETE
	3906	"RTN","PRC ACPSA",23, 0)
	3907	.I $P(PRC ACUR,U,10) =1 S PRCAB FIX=PRCABF IX+1,PRCAB FIX("I")=$ G(PRCABFIX ("I"))+1
	3908	"RTN","PRC ACPSA",24, 0)
	3909	.; Check if zero do llar amoun t
	3910	"RTN","PRC ACPSA",25, 0)
	3911	.;I $P(PR CACUR1,U,5 )="" S PRC ABFIX=PRCA BFIX+1,PRC ABFIX("N") =$G(PRCABF IX("N"))+1
	3912	"RTN","PRC ACPSA",26, 0)
	3913	.S PRCAPR V=$G(^PRCA (433,TN-1, 0))
	3914	"RTN","PRC ACPSA",27, 0)
	3915	.S PRCAPR V1=$G(^PRC A(433,TN-1 ,1))
	3916	"RTN","PRC ACPSA",28, 0)
	3917	.; Perfor m quick hi gh level d uplicate c heck
	3918	"RTN","PRC ACPSA",29, 0)
	3919	.I $P(PRC ACUR,U,2)' =$P(PRCAPR V,U,2) Q ; QUIT if (#.03) BIL L NUMBER d on't match
	3920	"RTN","PRC ACPSA",30, 0)
	3921	.I $P(PRC ACUR,U,9)' =$P(PRCAPR V,U,9) Q ; QUIT if (#42) PROC ESSED BY d on't match
	3922	"RTN","PRC ACPSA",31, 0)
	3923	.I $P(PRC ACUR1,U,1) '=$P(PRCAP RV1,U,1) Q ; QUIT i f (#11) TR ANSACTION DATE don't match
	3924	"RTN","PRC ACPSA",32, 0)
	3925	.I $P(PRC ACUR1,U,5) '=$P(PRCAP RV1,U,5) Q ; QUIT i f (#15) TR ANS. AMOUN T don't ma tch
	3926	"RTN","PRC ACPSA",33, 0)
	3927	.; Perfor m detailed duplicate check
	3928	"RTN","PRC ACPSA",34, 0)
	3929	.S IENPRE V=TN-1,IEN CRRT=TN,FI LENUM=433
	3930	"RTN","PRC ACPSA",35, 0)
	3931	.K TRNSPR EV S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENP REV,"**"," N","TRNSPR EV","MSG")
	3932	"RTN","PRC ACPSA",36, 0)
	3933	.K TRNSCR RT S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENC RRT,"**"," N","TRNSCR RT","MSG")
	3934	"RTN","PRC ACPSA",37, 0)
	3935	.S TRNSCR RT(433,TN_ ",",.01)=T RNSPREV(43 3,(TN-1)_" ,",.01)
	3936	"RTN","PRC ACPSA",38, 0)
	3937	.I $D(TRN SPREV(433, (TN-1)_"," ,41)) S TR NSCRRT(433 ,TN_",",41 )=$G(TRNSP REV(433,(T N-1)_",",4 1))
	3938	"RTN","PRC ACPSA",39, 0)
	3939	.I $$DIQO UTCS^PRCAC PS(.TRNSPR EV)'=$$DIQ OUTCS^PRCA CPS(.TRNSC RRT) Q
	3940	"RTN","PRC ACPSA",40, 0)
	3941	.; Set du plicate fl ag which w ill be use d in START 2
	3942	"RTN","PRC ACPSA",41, 0)
	3943	.S $P(^TM P("PRCAGTP S",$J,DEBT OR,BILL,TN ),U,12)=1
	3944	"RTN","PRC ACPSA",42, 0)
	3945	.; we hav e a duplic ate so upd ate counte r
	3946	"RTN","PRC ACPSA",43, 0)
	3947	.S PRCABF IX=PRCABFI X+1,PRCABF IX("D")=$G (PRCABFIX( "D"))+1
	3948	"RTN","PRC ACPSA",44, 0)
	3949	; Get Bil l Status f or checks
	3950	"RTN","PRC ACPSA",45, 0)
	3951	S PRCABST =$P($G(^PR CA(430,BIL L,0)),U,8)
	3952	"RTN","PRC ACPSA",46, 0)
	3953	;
	3954	"RTN","PRC ACPSA",47, 0)
	3955	; 3rd pie ce of ^TMP ("PRCABILL ",$J,DEBTO R,BILL) is stop/go f lag for th is bill.
	3956	"RTN","PRC ACPSA",48, 0)
	3957	; Set bel ow and uti lized in S TART2^PRCA CPS
	3958	"RTN","PRC ACPSA",49, 0)
	3959	;
	3960	"RTN","PRC ACPSA",50, 0)
	3961	; Check f or Duplica te needs t o include Bill Statu s of ACTIV E (#16), O PEN (#42) or CANCELL ATION (#39 )
	3962	"RTN","PRC ACPSA",51, 0)
	3963	; If ther e was only 1 problem and that problem wa s a Duplic ate and th e Bill Sta tus is ACT IVE or OPE N
	3964	"RTN","PRC ACPSA",52, 0)
	3965	; or CANC ELLATION Q uit and le t it get s et in CHEC K2
	3966	"RTN","PRC ACPSA",53, 0)
	3967	I PRCABFI X=1,$G(PRC ABFIX("D") )=1,(PRCAB ST=16!(PRC ABST=42)!( PRCABST=39 )) S
	3968	$P(^TMP("P RCABILL",$ J,DEBTOR,B ILL),U,3)= 0 Q 0
	3969	"RTN","PRC ACPSA",54, 0)
	3970	; If a si ngle probl em on a Bi ll in a st atus other than Acti ve or Open mark last transacti on as NOT FIXABLE
	3971	"RTN","PRC ACPSA",55, 0)
	3972	I PRCABFI X=1,PRCABS T'=16&(PRC ABST'=42) D UPDTLTR( $G(TNLAST) )
	3973	"RTN","PRC ACPSA",56, 0)
	3974	; If a si ngle probl em on a Bi ll in a st atus of Ac tive or Op en will be further c hecked in START2
	3975	"RTN","PRC ACPSA",57, 0)
	3976	I PRCABFI X=1,(PRCAB ST=16!(PRC ABST=42)) S PRCABFIX =0
	3977	"RTN","PRC ACPSA",58, 0)
	3978	; If mult iple probl ems set au dit fields for last transactio n for the Bill
	3979	"RTN","PRC ACPSA",59, 0)
	3980	I PRCABFI X>1 D UPDT LTR($G(TNL AST)) S PR CABFIX=1
	3981	"RTN","PRC ACPSA",60, 0)
	3982	; Update Bill level stop flag
	3983	"RTN","PRC ACPSA",61, 0)
	3984	S $P(^TMP ("PRCABILL ",$J,DEBTO R,BILL),U, 3)=PRCABFI X
	3985	"RTN","PRC ACPSA",62, 0)
	3986	Q PRCABFI X
	3987	"RTN","PRC ACPSA",63, 0)
	3988	;
	3989	"RTN","PRC ACPSA",64, 0)
	3990	UPDTLTR(TN LAST) ;
	3991	"RTN","PRC ACPSA",65, 0)
	3992	; Initial ize variab les
	3993	"RTN","PRC ACPSA",66, 0)
	3994	N PRCABIL L,PRCABILX ,PRCADTR,P RCATN,PRCA UPDT
	3995	"RTN","PRC ACPSA",67, 0)
	3996	; Initial ize PRCAUP DT to 0 (i .e. No). This flag is set to 1 when an transactio n was upda ted with t he audit
	3997	data
	3998	"RTN","PRC ACPSA",68, 0)
	3999	S PRCAUPD T=0
	4000	"RTN","PRC ACPSA",69, 0)
	4001	; If TNLA ST was und efined or null or so mething ot her than a positive number, se t TNLAST=0
	4002	"RTN","PRC ACPSA",70, 0)
	4003	; If TNLA ST was a p ositive nu mber, leav e it as is
	4004	"RTN","PRC ACPSA",71, 0)
	4005	S TNLAST= +$G(TNLAST ,0)
	4006	"RTN","PRC ACPSA",72, 0)
	4007	; If the IEN was a decimal nu mber, stri p off the decimal am ount
	4008	"RTN","PRC ACPSA",73, 0)
	4009	S TNLAST= $P(TNLAST, ".",1)
	4010	"RTN","PRC ACPSA",74, 0)
	4011	; Init ch ecks for a positive IEN and no correspon ding trans action
	4012	"RTN","PRC ACPSA",75, 0)
	4013	I +TNLAST >0,'$D(^PR CA(433,TNL AST,0)) S TNLAST=0
	4014	"RTN","PRC ACPSA",76, 0)
	4015	; Init ch ecks for a positive IEN and th is Transac tion exist s
	4016	"RTN","PRC ACPSA",77, 0)
	4017	I +TNLAST >0,$D(^PRC A(433,TNLA ST,0)) D Q:PRCAUPDT
	4018	"RTN","PRC ACPSA",78, 0)
	4019	.; If thi s transact ion hasn't been prev iously use d to flag an account , use it
	4020	"RTN","PRC ACPSA",79, 0)
	4021	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="" S PRCAUPDT= 1 D UPDTSE T(TNLAST) Q
	4022	"RTN","PRC ACPSA",80, 0)
	4023	.; If thi s transact ion was pr eviously u sed to ide ntify a NO T FIXABLE issue
	4024	"RTN","PRC ACPSA",81, 0)
	4025	.; update it again to have to day's date
	4026	"RTN","PRC ACPSA",82, 0)
	4027	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="X" S PRCAUPDT =1 D UPDTS ET(TNLAST) Q
	4028	"RTN","PRC ACPSA",83, 0)
	4029	.; If thi s Transact ion was pr eviously u sed to fix an issue other than NOT FIXAB LE,
	4030	"RTN","PRC ACPSA",84, 0)
	4031	.; reset to 0 to ma ke it find another t ransaction
	4032	"RTN","PRC ACPSA",85, 0)
	4033	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)'="", ($P($G(^PR CA(433,TNL AST,9)),U, 6)'="X") S TNLAST=0
	4034	"RTN","PRC ACPSA",86, 0)
	4035	.Q
	4036	"RTN","PRC ACPSA",87, 0)
	4037	; If you get to her e, TNLAST was either sent in w ith a posi tive value that coul dn't be us ed
	4038	"RTN","PRC ACPSA",88, 0)
	4039	; OR TNLA ST was sen t in as a null or 0. Either wa y, try to find anoth er accepta ble transa ction to m ark
	4040	"RTN","PRC ACPSA",89, 0)
	4041	; There i s a possib ility that no transa ction can be found t o mark, in which cas e, just qu it
	4042	"RTN","PRC ACPSA",90, 0)
	4043	I +TNLAST <1 D Q:+T NLAST<1
	4044	"RTN","PRC ACPSA",91, 0)
	4045	.S PRCABI LX=""
	4046	"RTN","PRC ACPSA",92, 0)
	4047	.F S PRC ABILX=$O(^ TMP("PRCAG TPS",$J,DE BTOR,PRCAB ILX),-1) Q :'PRCABILX D Q:TNL AST
	4048	"RTN","PRC ACPSA",93, 0)
	4049	..S PRCAT N=""
	4050	"RTN","PRC ACPSA",94, 0)
	4051	..F S PR CATN=$O(^T MP("PRCAGT PS",$J,DEB TOR,PRCABI LX,PRCATN) ,-1) Q:'PR CATN D Q :TNLAST
	4052	"RTN","PRC ACPSA",95, 0)
	4053	...; Quit if this t ransaction from ^TMP doesn't e xist in ^P RCA(433
	4054	"RTN","PRC ACPSA",96, 0)
	4055	...I '$D( ^PRCA(433, PRCATN,0)) Q
	4056	"RTN","PRC ACPSA",97, 0)
	4057	...; If t his transa ction hasn 't been ma rked for a nything, u se it
	4058	"RTN","PRC ACPSA",98, 0)
	4059	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)="" S TNLAST= PRCATN Q
	4060	"RTN","PRC ACPSA",99, 0)
	4061	...; Chec k if this transactio n was prev iously fla gged as so me fix oth er than NO T FIXABLE
	4062	"RTN","PRC ACPSA",100 ,0)
	4063	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)'=" X" Q
	4064	"RTN","PRC ACPSA",101 ,0)
	4065	...; If t his transc tion was p reviously marked as NOT FIXABL E, mark it again wit h today's date
	4066	"RTN","PRC ACPSA",102 ,0)
	4067	...S TNLA ST=PRCATN
	4068	"RTN","PRC ACPSA",103 ,0)
	4069	; QUIT If no accept able trans action cou ld be foun d
	4070	"RTN","PRC ACPSA",104 ,0)
	4071	Q:+TNLAST <1
	4072	"RTN","PRC ACPSA",105 ,0)
	4073	; QUIT if this tran saction do esn't exis t for some reason
	4074	"RTN","PRC ACPSA",106 ,0)
	4075	Q:'$D(^PR CA(433,TNL AST,0))
	4076	"RTN","PRC ACPSA",107 ,0)
	4077	; Call UP DTSET to u pdate the transactio n that was identifie d
	4078	"RTN","PRC ACPSA",108 ,0)
	4079	D UPDTSET (TNLAST)
	4080	"RTN","PRC ACPSA",109 ,0)
	4081	Q
	4082	"RTN","PRC ACPSA",110 ,0)
	4083	;
	4084	"RTN","PRC ACPSA",111 ,0)
	4085	UPDTSET(TN LAST) ; On ce transac tion has b een identi fied, set the necess ary audit fields
	4086	"RTN","PRC ACPSA",112 ,0)
	4087	; Identif y Bill for this Tran saction
	4088	"RTN","PRC ACPSA",113 ,0)
	4089	S PRCABIL L=$P($G(^P RCA(433,TN LAST,0)),U ,2)
	4090	"RTN","PRC ACPSA",114 ,0)
	4091	; Quit if bill can' t be ident ified
	4092	"RTN","PRC ACPSA",115 ,0)
	4093	Q:PRCABIL L=""
	4094	"RTN","PRC ACPSA",116 ,0)
	4095	; Use Bil l to ident ify Debtor
	4096	"RTN","PRC ACPSA",117 ,0)
	4097	S PRCADTR =$P($G(^PR CA(430,PRC ABILL,0)), U,9)
	4098	"RTN","PRC ACPSA",118 ,0)
	4099	; Quit if Debtor ca n't be def ined
	4100	"RTN","PRC ACPSA",119 ,0)
	4101	Q:PRCADTR =""
	4102	"RTN","PRC ACPSA",120 ,0)
	4103	; Quit if the stop flag for t his bill w as previou sly set in $$BILLQUI T^PRCACPSA
	4104	"RTN","PRC ACPSA",121 ,0)
	4105	I $P($G(^ TMP("PRCAB ILL",$J,PR CADTR,PRCA BILL)),U,3 ) Q
	4106	"RTN","PRC ACPSA",122 ,0)
	4107	; Get cur rent date
	4108	"RTN","PRC ACPSA",123 ,0)
	4109	D NOW^%DT C
	4110	"RTN","PRC ACPSA",124 ,0)
	4111	N PRCADAT E
	4112	"RTN","PRC ACPSA",125 ,0)
	4113	S PRCADAT E=X
	4114	"RTN","PRC ACPSA",126 ,0)
	4115	; Set up Audit Fiel d Array
	4116	"RTN","PRC ACPSA",127 ,0)
	4117	S PRCAFDA (433,TNLAS T_",",94)= PRCADATE
	4118	"RTN","PRC ACPSA",128 ,0)
	4119	S PRCAFDA (433,TNLAS T_",",96)= "X" ; NOT FIXABLE
	4120	"RTN","PRC ACPSA",129 ,0)
	4121	S PRCAFDA (433,TNLAS T_",",97)= 1
	4122	"RTN","PRC ACPSA",130 ,0)
	4123	L +^PRCA( 433,TNLAST ,9):DILOCK TM
	4124	"RTN","PRC ACPSA",131 ,0)
	4125	; QUIT if lock not obtainable
	4126	"RTN","PRC ACPSA",132 ,0)
	4127	Q:'$T
	4128	"RTN","PRC ACPSA",133 ,0)
	4129	; Update record
	4130	"RTN","PRC ACPSA",134 ,0)
	4131	D FILE^DI E(,"PRCAFD A")
	4132	"RTN","PRC ACPSA",135 ,0)
	4133	; Unlock file
	4134	"RTN","PRC ACPSA",136 ,0)
	4135	L -^PRCA( 433,TNLAST ,9)
	4136	"RTN","PRC ACPSA",137 ,0)
	4137	Q
	4138	"RTN","PRC ACPSA",138 ,0)
	4139	;
	4140	"RTN","PRC ACPSA",139 ,0)
	4141	PRCAMAIL(P RCASTRT) ;
	4142	"RTN","PRC ACPSA",140 ,0)
	4143	; Send e- mail notif ication to the PRCAC PS mail gr oup if the Auto-Corr ect was ma nually run
	4144	"RTN","PRC ACPSA",141 ,0)
	4145	; when it showed to be curren tly runnin g or possi ble errore d out on a previous attempt.
	4146	"RTN","PRC ACPSA",142 ,0)
	4147	;
	4148	"RTN","PRC ACPSA",143 ,0)
	4149	; PRCASTA RT = Exter nal format of date/t ime (i.e. OCT 12, 20 16@09:39:5 8) that th e
	4150	"RTN","PRC ACPSA",144 ,0)
	4151	; Auto-Co rrect prog ram was la st started .
	4152	"RTN","PRC ACPSA",145 ,0)
	4153	N XMY,XMD UZ,XMSUB,X MTEXT,X
	4154	"RTN","PRC ACPSA",146 ,0)
	4155	S XMDUZ=" AR PACKAGE "
	4156	"RTN","PRC ACPSA",147 ,0)
	4157	S XMY("G. PRCACPS")= ""
	4158	"RTN","PRC ACPSA",148 ,0)
	4159	S XMSUB=" CPS AUTO-C ORRECTION FAILURE "_ $E(DT,4,5) _"/"_$E(DT ,6,7)_"/"_ $E(DT,2,3)
	4160	"RTN","PRC ACPSA",149 ,0)
	4161	S X(1)="T he Patient Statement Auto-Corr ection Pro gram was s tarted on: "
	4162	"RTN","PRC ACPSA",150 ,0)
	4163	S X(2)=PR CASTRT_" a nd may not have comp leted norm ally."
	4164	"RTN","PRC ACPSA",151 ,0)
	4165	S X(3)=""
	4166	"RTN","PRC ACPSA",152 ,0)
	4167	S X(4)="P lease have OI&T chec k the erro r trap for any error s related to routine "
	4168	"RTN","PRC ACPSA",153 ,0)
	4169	S X(5)="P RCACPS on this date. "
	4170	"RTN","PRC ACPSA",154 ,0)
	4171	S XMTEXT= "X("
	4172	"RTN","PRC ACPSA",155 ,0)
	4173	D ^XMD
	4174	"RTN","PRC ACPSA",156 ,0)
	4175	Q
	4176	"RTN","PRC AG")
	4177	0^17^B7425 6403^B2201 6512
	4178	"RTN","PRC AG",1,0)
	4179	PRCAG ;WAS H-ISC@ALTO ONA,PA/CMS -Reprint S tatement/L etter Opti on Entries ;8/23/93 2:42 PM
	4180	"RTN","PRC AG",2,0)
	4181	V ;;4.5;Ac counts Rec eivable; 149,165,19 8,313;Ma r 20, 1995 ;Build 131
	4182	"RTN","PRC AG",3,0)
	4183	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	4184	"RTN","PRC AG",4,0)
	4185	REP ;ENTRY FROM REPR INT PAT ST ATEMENT
	4186	"RTN","PRC AG",5,0)
	4187	NEW BEG,E ND,DAT,DAT E,DEB,DIC, HDAT,IOP,S ITE,TYP,X, Y,ZTDESC,Z TRTN,ZTSAV E,SDT,%ZIS ,POP,ZTIO
	4188	"RTN","PRC AG",6,0)
	4189	W !!
	4190	"RTN","PRC AG",7,0)
	4191	ADT ; PRC A4.5313 - Build an d print a list of av ailable da tes for Pa tient Stat ements wit hin the la st
	4192	month
	4193	"RTN","PRC AG",8,0)
	4194	W !,"Thes e dates in the previ ous month contain Pa tient Stat ements: "
	4195	"RTN","PRC AG",9,0)
	4196	S DAT="" F S DAT=$ O(^RCPS(34 9.2,"STDT" ,DAT)) Q:D AT="" I $ D(^RC(341, "STDT",DAT )) W
	4197	!,$$DATE^R CCPCPS1(DA T)
	4198	"RTN","PRC AG",10,0)
	4199	W !!
	4200	"RTN","PRC AG",11,0)
	4201	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4202	"RTN","PRC AG",12,0)
	4203	S DIR(0)= "DAO^^K:'$ D(^RC(341, ""STDT"",Y )) X"
	4204	"RTN","PRC AG",13,0)
	4205	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	4206	"RTN","PRC AG",14,0)
	4207	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	4208	"RTN","PRC AG",15,0)
	4209	D ^DIR
	4210	"RTN","PRC AG",16,0)
	4211	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4212	"RTN","PRC AG",17,0)
	4213	S SDT=Y
	4214	"RTN","PRC AG",18,0)
	4215	W !!,"NOT E: The ran ge is in p rint order not alpha betic!",!
	4216	"RTN","PRC AG",19,0)
	4217	S X=""
	4218	"RTN","PRC AG",20,0)
	4219	S BEG=$O( ^RC(341,"S TDT",SDT," "))
	4220	"RTN","PRC AG",21,0)
	4221	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4222	"RTN","PRC AG",22,0)
	4223	S DIR(0)= "YAO"
	4224	"RTN","PRC AG",23,0)
	4225	S DIR("B" )="N"
	4226	"RTN","PRC AG",24,0)
	4227	S DIR("A" )="Do you want to St art with a Specific Patient? "
	4228	"RTN","PRC AG",25,0)
	4229	D ^DIR
	4230	"RTN","PRC AG",26,0)
	4231	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4232	"RTN","PRC AG",27,0)
	4233	I Y=0 S X =""
	4234	"RTN","PRC AG",28,0)
	4235	I Y=1 S X =$$SELNAME (SDT)
	4236	"RTN","PRC AG",29,0)
	4237	I X=-1 Q
	4238	"RTN","PRC AG",30,0)
	4239	I X'="" S BEG=X
	4240	"RTN","PRC AG",31,0)
	4241	; PRCA4. 5313 - Us e statemen t date cro ss-referen ce to prov ide a pati ent list
	4242	"RTN","PRC AG",32,0)
	4243	S X=""
	4244	"RTN","PRC AG",33,0)
	4245	S END=$O( ^RC(341,"S TDT",SDT," "),-1)
	4246	"RTN","PRC AG",34,0)
	4247	W !,"Endi ng Patient Bill must be printe d after th e Starting Patient B ill.",!
	4248	"RTN","PRC AG",35,0)
	4249	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4250	"RTN","PRC AG",36,0)
	4251	S DIR(0)= "YAO"
	4252	"RTN","PRC AG",37,0)
	4253	S DIR("B" )="N"
	4254	"RTN","PRC AG",38,0)
	4255	S DIR("A" )="Do you want to En d with a S pecific Pa tient? "
	4256	"RTN","PRC AG",39,0)
	4257	D ^DIR
	4258	"RTN","PRC AG",40,0)
	4259	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4260	"RTN","PRC AG",41,0)
	4261	I Y=0 S X =""
	4262	"RTN","PRC AG",42,0)
	4263	I Y=1 S X =$$SELNAME (SDT)
	4264	"RTN","PRC AG",43,0)
	4265	I X=-1 Q
	4266	"RTN","PRC AG",44,0)
	4267	I X'="" S END=X
	4268	"RTN","PRC AG",45,0)
	4269	I END>0,E ND<BEG W * 7,!,"Endin g bill is before sta rting bill !" D
	4270	Q:$D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) G ADT
	4271	"RTN","PRC AG",46,0)
	4272	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4273	"RTN","PRC AG",47,0)
	4274	. S DIR(0 )="E"
	4275	"RTN","PRC AG",48,0)
	4276	. D ^DIR
	4277	"RTN","PRC AG",49,0)
	4278	S HDAT=99 99999-SDT
	4279	"RTN","PRC AG",50,0)
	4280	REPD W !! S %ZIS="QN ",IOP="Q", %ZIS("B")= $P($G(^RC( 342,1,0)), U,8) D ^%Z IS G:POP R EPQ
	4281	"RTN","PRC AG",51,0)
	4282	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REP D
	4283	"RTN","PRC AG",52,0)
	4284	S ZTRTN=" REP^PRCAGS ",ZTDESC=" Reprint AR Patient
	4285	Statements ",ZTSAVE(" BEG")="",Z TSAVE("END ")="",ZTSA VE("HDAT") ="" D ^%ZT LOAD
	4286	"RTN","PRC AG",53,0)
	4287	REPQ ; PRC A4.5313 - Kill TMP ($J Lists prior to q uit
	4288	"RTN","PRC AG",54,0)
	4289	D ^%ZISC
	4290	"RTN","PRC AG",55,0)
	4291	K ^TMP($J ,"LISTNAME "),^TMP($J ,"LISTCNT" )
	4292	"RTN","PRC AG",56,0)
	4293	Q
	4294	"RTN","PRC AG",57,0)
	4295	UB ;ENTRY FROM REPRI NT UB BILL S
	4296	"RTN","PRC AG",58,0)
	4297	S ETY="UB " ;set eve nt type to UB and us e REB sub- routine
	4298	"RTN","PRC AG",59,0)
	4299	REB ;ENTRY FROM REPR INT FOLLOW -UP LETTER S
	4300	"RTN","PRC AG",60,0)
	4301	NEW BEG,E ND,DAT,DAT E,DEB,DIC, IOP,SITE,T YP,X,Y,ZTD ESC,ZTRTN, ZTSAVE,%DT ,DA,DIR,DT OUT
	4302	"RTN","PRC AG",61,0)
	4303	D SITE^PR CAGU
	4304	"RTN","PRC AG",62,0)
	4305	S:'$D(ETY ) ETY="FL"
	4306	"RTN","PRC AG",63,0)
	4307	REBDT S %D T="AEXP",% DT(0)="-NO W",%DT("A" )="Enter a Date to R eprint: " D ^%DT G:Y <1 REBQ
	4308	"RTN","PRC AG",64,0)
	4309	S Y=$P(Y, ".")
	4310	"RTN","PRC AG",65,0)
	4311	I $P($O(^ RC(341,"C" ,Y)),".")' =Y W !!,*7 ,"No notif ications s ent on tha t date",! G REBDT
	4312	"RTN","PRC AG",66,0)
	4313	S DAT=999 9999-Y
	4314	"RTN","PRC AG",67,0)
	4315	W !!,"Pre ss return at the 'Bi ll:' promp ts to repr int all ", ETY," Lett ers",!,"fo r the date selected or select a
	4316	start and/ or end poi nt."
	4317	"RTN","PRC AG",68,0)
	4318	W !,"Do n ot select bills that print on the Patien t Statemen t."
	4319	"RTN","PRC AG",69,0)
	4320	W !,"NOTE : The rang e is in pr int order not alphab etic!",!
	4321	"RTN","PRC AG",70,0)
	4322	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	4323	"RTN","PRC AG",71,0)
	4324	S DIC="^P RCA(430,", DIC(0)="AE MNQ",DIC(" A")="Start from Bill : ",DIC("S ")="I
	4325	"",18,25,5 ,24,1,2,3, 4,23,22,"" '[("",""_$ P(^(0),U,2 )_"","")" D ^DIC I ( $D(DTOUT)) !(X["^") G REBQ
	4326	"RTN","PRC AG",72,0)
	4327	S BEG=0,Y =+Y
	4328	"RTN","PRC AG",73,0)
	4329	I Y>0 S B EG=-1,DEB= +$P($G(^PR CA(430,Y,0 )),U,9),TY P=+$O(^RC( 341.1,"AC" ,$S(ETY="U B":9,1:10) ,0)) F
	4330	DATE=DAT-. 0001:0 S D ATE=$O(^RC (341,"AD", DEB,TYP,DA TE)) Q:$P( DATE,".")' =DAT D
	4331	"RTN","PRC AG",74,0)
	4332	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y S BEG=DA,D EB=0
	4333	Q
	4334	"RTN","PRC AG",75,0)
	4335	.Q
	4336	"RTN","PRC AG",76,0)
	4337	I BEG=0 S BEG=$O(^R C(341,"C", +$O(^RC(34 1,"C",9999 999-DAT)), 0)) S:'BEG BEG=-1
	4338	"RTN","PRC AG",77,0)
	4339	I BEG<0 W *7,!," So rry, not f ound!" G R EBDT
	4340	"RTN","PRC AG",78,0)
	4341	S DIC("A" )="End aft er Bill: " D ^DIC I ($D(DTOUT) )!(X["^") G REBQ
	4342	"RTN","PRC AG",79,0)
	4343	S END="*" ,Y=+Y
	4344	"RTN","PRC AG",80,0)
	4345	I Y>0 S E ND=-1,DEB= +$P($G(^PR CA(430,Y,0 )),U,9),TY P=+$O(^RC( 341.1,"AC" ,$S(ETY="U B":9,1:10) ,0)) F
	4346	DATE=DAT-. 0001:0 S D ATE=$O(^RC (341,"AD", DEB,TYP,DA TE)) Q:$P( DATE,".")' =DAT D
	4347	"RTN","PRC AG",81,0)
	4348	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y S END=DA,D EB=0
	4349	Q
	4350	"RTN","PRC AG",82,0)
	4351	.Q
	4352	"RTN","PRC AG",83,0)
	4353	I END<0 W *7,!," So rry, not f ound!" G R EBDT
	4354	"RTN","PRC AG",84,0)
	4355	I END'="* ",END<BEG W *7,!,"En ding bill is before starting b ill!" G RE BDT
	4356	"RTN","PRC AG",85,0)
	4357	W !!
	4358	"RTN","PRC AG",86,0)
	4359	REBD I ETY ="UB" S ZT IO="" G RE BD1
	4360	"RTN","PRC AG",87,0)
	4361	S %ZIS("B ")=$P($G(^ RC(342,1,0 )),U,8),%Z IS="QN",IO P="Q" D ^% ZIS G:POP REBQ
	4362	"RTN","PRC AG",88,0)
	4363	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REB D
	4364	"RTN","PRC AG",89,0)
	4365	REBD1 S
	4366	ZTRTN="BIL L^PRCAGS", ZTSAVE("BE G")="",ZTS AVE("END") ="",ZTSAVE ("DAT")="" ,ZTSAVE("S ITE")="",Z TSA
	4367	VE("ETY")= ""
	4368	"RTN","PRC AG",90,0)
	4369	S ZTDESC= $S(ETY="UB ":"AR Repr int UB Let ters",1:"R eprint AR Follow-up Letters") D ^%ZTLOAD
	4370	"RTN","PRC AG",91,0)
	4371	REBQ K ETY D ^%ZISC Q
	4372	"RTN","PRC AG",92,0)
	4373	PRDT ;ENTR Y FROM PRI NT STATEME NT/LETTER BY DATE OP TION
	4374	"RTN","PRC AG",93,0)
	4375	D PRDT^PR CAGP
	4376	"RTN","PRC AG",94,0)
	4377	Q
	4378	"RTN","PRC AG",95,0)
	4379	SELNAME(SD T) ; PRCA ^4.5^313 - Create a list and t hen select a patient name
	4380	"RTN","PRC AG",96,0)
	4381	; There a re three v alues to R eturn from this tag
	4382	"RTN","PRC AG",97,0)
	4383	; IEN -- Number from list of Selecte d Patient
	4384	"RTN","PRC AG",98,0)
	4385	; Null -- No Pati ent Select ed from li st - used to begin o r end Sele ction list
	4386	"RTN","PRC AG",99,0)
	4387	; -1 -- Quit pr ocessing f rom called tag
	4388	"RTN","PRC AG",100,0)
	4389	N IEN,CNT ,NAME
	4390	"RTN","PRC AG",101,0)
	4391	W !,"Plea se wait wh ile we bui ld the pat ient list. ",!
	4392	"RTN","PRC AG",102,0)
	4393	K ^TMP($J ,"LISTNAME ")
	4394	"RTN","PRC AG",103,0)
	4395	S (IEN,CN T)=0
	4396	"RTN","PRC AG",104,0)
	4397	F S IEN= $O(^RC(341 ,"STDT",SD T,IEN)) Q: IEN="" D
	4398	"RTN","PRC AG",105,0)
	4399	. N PAT,N AME
	4400	"RTN","PRC AG",106,0)
	4401	. S PAT=$ P(^RCD(340 ,$P(^RC(34 1,IEN,0)," ^",5),0)," ;")
	4402	"RTN","PRC AG",107,0)
	4403	. S NAME= $P(^DPT(PA T,0),U)
	4404	"RTN","PRC AG",108,0)
	4405	. S ^TMP( $J,"LISTNA ME",NAME)= IEN
	4406	"RTN","PRC AG",109,0)
	4407	; Quit th e listing if no name s to displ ay
	4408	"RTN","PRC AG",110,0)
	4409	I '$D(^TM P($J,"LIST NAME")) D Q -1
	4410	"RTN","PRC AG",111,0)
	4411	. W !,"Th ere are no names to display fo r this dat e."
	4412	"RTN","PRC AG",112,0)
	4413	. S DIR(0 )="E" D ^D IR
	4414	"RTN","PRC AG",113,0)
	4415	S NAME=$$ ENTNAM
	4416	"RTN","PRC AG",114,0)
	4417	I NAME="^ " Q -1
	4418	"RTN","PRC AG",115,0)
	4419	I NAME="" Q NAME
	4420	"RTN","PRC AG",116,0)
	4421	I $G(NAME )'="",$D(^ TMP($J,"LI STNAME",NA ME)) S IEN =^(NAME) Q IEN
	4422	"RTN","PRC AG",117,0)
	4423	W !!,"Pat ient Name is not an exact matc h."
	4424	"RTN","PRC AG",118,0)
	4425	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4426	"RTN","PRC AG",119,0)
	4427	S DIR(0)= "YAO"
	4428	"RTN","PRC AG",120,0)
	4429	S DIR("B" )="N"
	4430	"RTN","PRC AG",121,0)
	4431	S DIR("A" )="Would y ou like to search Pa tient Name s for "_$$ DATE^RCCPC PS1(SDT)_" ? "
	4432	"RTN","PRC AG",122,0)
	4433	D ^DIR
	4434	"RTN","PRC AG",123,0)
	4435	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	4436	"RTN","PRC AG",124,0)
	4437	I Y=0 N Q UIT D I Q UIT'=0 Q Q UIT
	4438	"RTN","PRC AG",125,0)
	4439	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	4440	"RTN","PRC AG",126,0)
	4441	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4442	"RTN","PRC AG",127,0)
	4443	. S DIR(0 )="YAO"
	4444	"RTN","PRC AG",128,0)
	4445	. S DIR(" B")="Y"
	4446	"RTN","PRC AG",129,0)
	4447	. S DIR(" A")="Is th is correct ? "
	4448	"RTN","PRC AG",130,0)
	4449	. D ^DIR
	4450	"RTN","PRC AG",131,0)
	4451	. S QUIT= Y
	4452	"RTN","PRC AG",132,0)
	4453	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4454	"RTN","PRC AG",133,0)
	4455	. I QUIT= 1 S QUIT=" "
	4456	"RTN","PRC AG",134,0)
	4457	; Select Name - If Zero (0) i s returned keep tryi ng
	4458	"RTN","PRC AG",135,0)
	4459	F S IEN= $$SELNM1(N AME) I IEN '=0 Q
	4460	"RTN","PRC AG",136,0)
	4461	Q IEN
	4462	"RTN","PRC AG",137,0)
	4463	SELNM1(NM) ; Select name
	4464	"RTN","PRC AG",138,0)
	4465	N DIRUT,X CNT,DIR,CN T
	4466	"RTN","PRC AG",139,0)
	4467	K ^TMP($J ,"LISTCNT" )
	4468	"RTN","PRC AG",140,0)
	4469	S CNT=0,N AME=""
	4470	"RTN","PRC AG",141,0)
	4471	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I $D(D IRUT) Q
	4472	"RTN","PRC AG",142,0)
	4473	. ; Add n ame to lis t only if first part of name m atches ent ered name
	4474	"RTN","PRC AG",143,0)
	4475	. I $E(NA ME,1,$L(NM ))'=NM Q
	4476	"RTN","PRC AG",144,0)
	4477	. I CNT=0 W @IOF,"N umber",?10 ,"Patient Name"
	4478	"RTN","PRC AG",145,0)
	4479	. S CNT=C NT+1
	4480	"RTN","PRC AG",146,0)
	4481	. S ^TMP( $J,"LISTCN T",CNT,NAM E)=^TMP($J ,"LISTNAME ",NAME)
	4482	"RTN","PRC AG",147,0)
	4483	. W !,CNT ,?10,NAME
	4484	"RTN","PRC AG",148,0)
	4485	. I ($Y+3 )>IOSL D Q:$D(DIRUT )
	4486	"RTN","PRC AG",149,0)
	4487	. . S DIR (0)="E" D ^DIR
	4488	"RTN","PRC AG",150,0)
	4489	. . I X=" ^" Q
	4490	"RTN","PRC AG",151,0)
	4491	. . W @IO F,"Number" ,?10,"Pati ent Name"
	4492	"RTN","PRC AG",152,0)
	4493	; If no n ames match ed entered name Quit to menu
	4494	"RTN","PRC AG",153,0)
	4495	I CNT=0 D Q QUIT
	4496	"RTN","PRC AG",154,0)
	4497	. W @IOF, "No Matche s to Patie nt Name en tered were found.",!
	4498	"RTN","PRC AG",155,0)
	4499	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4500	"RTN","PRC AG",156,0)
	4501	. S DIR(0 )="E"
	4502	"RTN","PRC AG",157,0)
	4503	. D ^DIR
	4504	"RTN","PRC AG",158,0)
	4505	. S QUIT= 0
	4506	"RTN","PRC AG",159,0)
	4507	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4508	"RTN","PRC AG",160,0)
	4509	W !,"Plea se enter n umber of s elected Pa tient Name : " R XCNT :DTIME
	4510	"RTN","PRC AG",161,0)
	4511	I XCNT="^ " Q -1
	4512	"RTN","PRC AG",162,0)
	4513	; If a va lue entere d is not i n LISTCNT, write err or and all ow retry i f requeste d
	4514	"RTN","PRC AG",163,0)
	4515	I XCNT'=" ",'$D(^TMP ($J,"LISTC NT",XCNT)) N QUIT D Q QUIT
	4516	"RTN","PRC AG",164,0)
	4517	. W !,"Va lue entere d not a li sted numbe r.",!
	4518	"RTN","PRC AG",165,0)
	4519	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4520	"RTN","PRC AG",166,0)
	4521	. S DIR(0 )="E"
	4522	"RTN","PRC AG",167,0)
	4523	. D ^DIR
	4524	"RTN","PRC AG",168,0)
	4525	. S QUIT= 0
	4526	"RTN","PRC AG",169,0)
	4527	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4528	"RTN","PRC AG",170,0)
	4529	I XCNT="" N QUIT D Q QUIT
	4530	"RTN","PRC AG",171,0)
	4531	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	4532	"RTN","PRC AG",172,0)
	4533	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4534	"RTN","PRC AG",173,0)
	4535	. S DIR(0 )="YAO"
	4536	"RTN","PRC AG",174,0)
	4537	. S DIR(" B")="Y"
	4538	"RTN","PRC AG",175,0)
	4539	. S DIR(" A")="No Pa tient Sele cted. "
	4540	"RTN","PRC AG",176,0)
	4541	. S DIR(" A",1)="Is this corre ct? "
	4542	"RTN","PRC AG",177,0)
	4543	. D ^DIR
	4544	"RTN","PRC AG",178,0)
	4545	. S QUIT= Y
	4546	"RTN","PRC AG",179,0)
	4547	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4548	"RTN","PRC AG",180,0)
	4549	. I QUIT= 1 S QUIT=" "
	4550	"RTN","PRC AG",181,0)
	4551	S CNT=XCN T
	4552	"RTN","PRC AG",182,0)
	4553	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4554	"RTN","PRC AG",183,0)
	4555	S DIR(0)= "YAO"
	4556	"RTN","PRC AG",184,0)
	4557	S DIR("B" )="Y"
	4558	"RTN","PRC AG",185,0)
	4559	S DIR("A" )="...OK? "
	4560	"RTN","PRC AG",186,0)
	4561	S DIR("A" ,1)=""
	4562	"RTN","PRC AG",187,0)
	4563	S DIR("A" ,2)=$O(^TM P($J,"LIST CNT",CNT,0 ))
	4564	"RTN","PRC AG",188,0)
	4565	D ^DIR
	4566	"RTN","PRC AG",189,0)
	4567	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	4568	"RTN","PRC AG",190,0)
	4569	; If user answered No, then t ry again
	4570	"RTN","PRC AG",191,0)
	4571	I Y=0 Q Y
	4572	"RTN","PRC AG",192,0)
	4573	S NAME=$O (^TMP($J," LISTCNT",C NT,0))
	4574	"RTN","PRC AG",193,0)
	4575	Q ^TMP($J ,"LISTCNT" ,CNT,NAME)
	4576	"RTN","PRC AG",194,0)
	4577	;
	4578	"RTN","PRC AG",195,0)
	4579	ENTNAM() ; Enter na me and pri nt list of names if requested
	4580	"RTN","PRC AG",196,0)
	4581	;
	4582	"RTN","PRC AG",197,0)
	4583	N HIT,X
	4584	"RTN","PRC AG",198,0)
	4585	S HIT=0
	4586	"RTN","PRC AG",199,0)
	4587	F D I H IT Q
	4588	"RTN","PRC AG",200,0)
	4589	. W !,"Pl ease enter all or pa rt of Pati ent Name: " R NAME:D TIME
	4590	"RTN","PRC AG",201,0)
	4591	. I NAME' ["?" S HIT =1 Q
	4592	"RTN","PRC AG",202,0)
	4593	. I NAME= "?" D LIST NAME(1)
	4594	"RTN","PRC AG",203,0)
	4595	. I NAME= "??" D LIS TNAME(2)
	4596	"RTN","PRC AG",204,0)
	4597	. ; If th e user ent ers a care t in LISTN AME quit a nd return a caret in NAME to Q uit applic ation
	4598	"RTN","PRC AG",205,0)
	4599	. I X="^" S NAME=X, HIT=1
	4600	"RTN","PRC AG",206,0)
	4601	Q NAME
	4602	"RTN","PRC AG",207,0)
	4603	;
	4604	"RTN","PRC AG",208,0)
	4605	LISTNAME(H EADER) ; Display li st of name
	4606	"RTN","PRC AG",209,0)
	4607	;
	4608	"RTN","PRC AG",210,0)
	4609	N NAME,CN T,DIR,DTOU T,DUOUT,DI RUT,DIROUT
	4610	"RTN","PRC AG",211,0)
	4611	S NAME="" ,CNT=0
	4612	"RTN","PRC AG",212,0)
	4613	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I
	4614	$D(DTOUT)! $D(DUOUT)! $D(DIRUT)! $D(DIROUT) Q
	4615	"RTN","PRC AG",213,0)
	4616	. I CNT=0 ,HEADER=1 W @IOF,"Pa tient Name "
	4617	"RTN","PRC AG",214,0)
	4618	. I CNT=0 ,HEADER=2 D I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	4619	"RTN","PRC AG",215,0)
	4620	. . W @IO F,"The use r can ente r all or p art of a n ame or '?' for the"
	4621	"RTN","PRC AG",216,0)
	4622	. . W !," list of na mes availa ble for th e selected date."
	4623	"RTN","PRC AG",217,0)
	4624	. . S DIR (0)="E" D ^DIR
	4625	"RTN","PRC AG",218,0)
	4626	. . I $D( DTOUT)!$D( DUOUT)!$D( DIRUT)!$D( DIROUT) Q
	4627	"RTN","PRC AG",219,0)
	4628	. . W !!, "Patient N ame"
	4629	"RTN","PRC AG",220,0)
	4630	. S CNT=C NT+1
	4631	"RTN","PRC AG",221,0)
	4632	. W !,NAM E
	4633	"RTN","PRC AG",222,0)
	4634	. I ($Y+3 )>IOSL D I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	4635	"RTN","PRC AG",223,0)
	4636	. . S DIR (0)="E" D ^DIR
	4637	"RTN","PRC AG",224,0)
	4638	. . I $D( DTOUT)!$D( DUOUT)!$D( DIRUT)!$D( DIROUT) S X="" Q
	4639	"RTN","PRC AG",225,0)
	4640	. . W @IO F,"Patient Name"
	4641	"RTN","PRC AG",226,0)
	4642	Q
	4643	"RTN","RCB EADJ")
	4644	0^24^B1008 83161^B771 25147
	4645	"RTN","RCB EADJ",1,0)
	4646	RCBEADJ ;W ISC/RFJ-ad justment ; Jun 06, 20 14@19:11:1 9
	4647	"RTN","RCB EADJ",2,0)
	4648	;;4.5;Acc ounts Rece ivable;1 69,172,204 ,173,208,2 33,298,301 ,315,313 ;Mar 20, 1 995;Build 131
	4649	"RTN","RCB EADJ",3,0)
	4650	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4651	"RTN","RCB EADJ",4,0)
	4652	Q
	4653	"RTN","RCB EADJ",5,0)
	4654	;
	4655	"RTN","RCB EADJ",6,0)
	4656	;
	4657	"RTN","RCB EADJ",7,0)
	4658	DECREASE ; menu opt ion: creat e a decrea se adjustm ent
	4659	"RTN","RCB EADJ",8,0)
	4660	D ADJUST( "DECREASE" )
	4661	"RTN","RCB EADJ",9,0)
	4662	Q
	4663	"RTN","RCB EADJ",10,0 )
	4664	;
	4665	"RTN","RCB EADJ",11,0 )
	4666	;
	4667	"RTN","RCB EADJ",12,0 )
	4668	INCREASE ; menu opt ion: creat e an incre ase adjust ment
	4669	"RTN","RCB EADJ",13,0 )
	4670	D ADJUST( "INCREASE" )
	4671	"RTN","RCB EADJ",14,0 )
	4672	Q
	4673	"RTN","RCB EADJ",15,0 )
	4674	;
	4675	"RTN","RCB EADJ",16,0 )
	4676	ADJUST(RCB ETYPE,RCED I) ; crea te an adju stment
	4677	"RTN","RCB EADJ",17,0 )
	4678	; rcbety pe = INCRE ASE for in crease or DECREASE f or decreas e
	4679	"RTN","RCB EADJ",18,0 )
	4680	; rcedi = the ien of the bil l selected via the E DI Worklis t;ien of
	4681	"RTN","RCB EADJ",19,0 )
	4682	; XX the ER A entry or null/unde fined if b ill should be select ed
	4683	"RTN","RCB EADJ",20,0 )
	4684	I '$G(GOT BILL) N RC BILLDA ;P RCA4.531 5 If enter ing from w orklist
	4685	"RTN","RCB EADJ",21,0 )
	4686	F D Q:R CBILLDA<0! $G(RCEDI)! $G(GOTBILL )
	4687	"RTN","RCB EADJ",22,0 )
	4688	. K RCT RANDA,RCLI ST,RCTRREV
	4689	"RTN","RCB EADJ",23,0 )
	4690	. ;
	4691	"RTN","RCB EADJ",24,0 )
	4692	. ; se lect a bil l
	4693	"RTN","RCB EADJ",25,0 )
	4694	. I '$G (GOTBILL) S RCBILLDA =$S('$G(RC EDI):$$GET ABILL^RCBE UBIL,1:+RC EDI) ;PRC A4.5315
	4695	"RTN","RCB EADJ",26,0 )
	4696	. I RCB ILLDA<1 Q
	4697	"RTN","RCB EADJ",27,0 )
	4698	. I $D( ^PRCA(430, "TCSP",RCB ILLDA)),(R CBETYPE="I NCREASE") D ;PRCA4 .5315/DRF
	4699	"RTN","RCB EADJ",28,0 )
	4700	.. S R CTRREV=$$A SKREV()
	4701	"RTN","RCB EADJ",29,0 )
	4702	.. W !
	4703	"RTN","RCB EADJ",30,0 )
	4704	. I $D( ^PRCA(430, "TCSP",RCB ILLDA)),(R CBETYPE="D ECREASE") S %=$$ASKC M Q:(%'=1) ;
	4705	prca4.53 01 & *315
	4706	"RTN","RCB EADJ",31,0 )
	4707	. ;
	4708	"RTN","RCB EADJ",32,0 )
	4709	. ; ad just the b ill
	4710	"RTN","RCB EADJ",33,0 )
	4711	. D ADJ BILL(RCBET YPE,RCBILL DA,$P($G(R CEDI),";", 2))
	4712	"RTN","RCB EADJ",34,0 )
	4713	Q
	4714	"RTN","RCB EADJ",35,0 )
	4715	;
	4716	"RTN","RCB EADJ",36,0 )
	4717	ADJBILL(RC BETYPE,RCB ILLDA,RCED IWL) ; ad just a bil l
	4718	"RTN","RCB EADJ",37,0 )
	4719	; RCEDIWL = ien of ERA entry if called from workl ist
	4720	"RTN","RCB EADJ",38,0 )
	4721	N RCAMOUN T,RCBALANC ,RCDATA7,R CLIST,RCON TADJ,RCTRA NDA,TOTALC AL,TOTALST O,I,X,Y
	4722	"RTN","RCB EADJ",39,0 )
	4723	; lock t he bill
	4724	"RTN","RCB EADJ",40,0 )
	4725	L +^PRCA( 430,RCBILL DA):5 E W !,"ANOTHE R USER IS CURRENTLY WORKING WI TH THIS BI LL." Q
	4726	"RTN","RCB EADJ",41,0 )
	4727	;
	4728	"RTN","RCB EADJ",42,0 )
	4729	; show d ata for th e bill
	4730	"RTN","RCB EADJ",43,0 )
	4731	D SHOWBIL L^RCWROFF1 (RCBILLDA)
	4732	"RTN","RCB EADJ",44,0 )
	4733	;
	4734	"RTN","RCB EADJ",45,0 )
	4735	; check the balanc e of the b ill
	4736	"RTN","RCB EADJ",46,0 )
	4737	W !!,"Che cking the bill's bal ance ..."
	4738	"RTN","RCB EADJ",47,0 )
	4739	S RCBALAN C=$$OUTOFB AL^RCBDBBA L(RCBILLDA )
	4740	"RTN","RCB EADJ",48,0 )
	4741	I RCBALAN C="" W " I N Balance! "
	4742	"RTN","RCB EADJ",49,0 )
	4743	;
	4744	"RTN","RCB EADJ",50,0 )
	4745	; out of balance, ask to fix it
	4746	"RTN","RCB EADJ",51,0 )
	4747	I RCBALAN C'="" D I RCBILLDA< 1 D UNLOCK Q
	4748	"RTN","RCB EADJ",52,0 )
	4749	. S
	4750	TOTALCAL=$ P(RCBALANC ,"^")+$P(R CBALANC,"^ ",2)+$P(RC BALANC,"^" ,3)+$P(RCB ALANC,"^", 4)+$P(RCB
	4751	ALANC,"^", 5)
	4752	"RTN","RCB EADJ",53,0 )
	4753	. S RCD ATA7=$G(^P RCA(430,RC BILLDA,7))
	4754	"RTN","RCB EADJ",54,0 )
	4755	. S
	4756	TOTALSTO=$ P(RCDATA7, "^")+$P(RC DATA7,"^", 2)+$P(RCDA TA7,"^",3) +$P(RCDATA 7,"^",4)+$ P(RCDATA7,
	4757	"^",5)
	4758	"RTN","RCB EADJ",55,0 )
	4759	. W " O UT of Bala nce!"
	4760	"RTN","RCB EADJ",56,0 )
	4761	. W !!, " B ALANCE:",$ J("Calcula ted",12),$ J("Stored" ,12)
	4762	"RTN","RCB EADJ",57,0 )
	4763	. W !," -- ----- ",$J ("-------- ----",12), $J("------ ------",12 )
	4764	"RTN","RCB EADJ",58,0 )
	4765	. W !," Pr incipal Ba lance:",$J ($P(RCBALA NC,"^",1), 12,2),$J($ P(RCDATA7, "^",1),12, 2)
	4766	"RTN","RCB EADJ",59,0 )
	4767	. I +$P (RCBALANC, "^",1)'=+$ P(RCDATA7, "^",1) W " <<-- OUT OF BALANC E"
	4768	"RTN","RCB EADJ",60,0 )
	4769	. W !," I nterest Ba lance:",$J ($P(RCBALA NC,"^",2), 12,2),$J($ P(RCDATA7, "^",2),12, 2)
	4770	"RTN","RCB EADJ",61,0 )
	4771	. I +$P (RCBALANC, "^",2)'=+$ P(RCDATA7, "^",2) W " <<-- OUT OF BALANC E"
	4772	"RTN","RCB EADJ",62,0 )
	4773	. W !," Admin Ba lance:",$J ($P(RCBALA NC,"^",3), 12,2),$J($ P(RCDATA7, "^",3),12, 2)
	4774	"RTN","RCB EADJ",63,0 )
	4775	. I +$P (RCBALANC, "^",3)'=+$ P(RCDATA7, "^",3) W " <<-- OUT OF BALANC E"
	4776	"RTN","RCB EADJ",64,0 )
	4777	. W !," MF Ba lance:",$J ($P(RCBALA NC,"^",4), 12,2),$J($ P(RCDATA7, "^",4),12, 2)
	4778	"RTN","RCB EADJ",65,0 )
	4779	. I +$P (RCBALANC, "^",4)'=+$ P(RCDATA7, "^",4) W " <<-- OUT OF BALANC E"
	4780	"RTN","RCB EADJ",66,0 )
	4781	. W !," CC Ba lance:",$J ($P(RCBALA NC,"^",5), 12,2),$J($ P(RCDATA7, "^",5),12, 2)
	4782	"RTN","RCB EADJ",67,0 )
	4783	. I +$P (RCBALANC, "^",5)'=+$ P(RCDATA7, "^",5) W " <<-- OUT OF BALANC E"
	4784	"RTN","RCB EADJ",68,0 )
	4785	. W !," -- ----- ",$J ("-------- -----",12) ,$J("----- --------", 12)
	4786	"RTN","RCB EADJ",69,0 )
	4787	. W !," TOTAL:",$J (TOTALCAL, 12,2),$J(T OTALSTO,12 ,2)
	4788	"RTN","RCB EADJ",70,0 )
	4789	. I +TO TALCAL'=+T OTALSTO W " <<-- OU T OF BALAN CE"
	4790	"RTN","RCB EADJ",71,0 )
	4791	. ;
	4792	"RTN","RCB EADJ",72,0 )
	4793	. ; as k to fix t he balance s
	4794	"RTN","RCB EADJ",73,0 )
	4795	. S Y=$ $ASKFIX I Y'=1 W !," NOTE: Yo u must fix the Balan ce Discrep ancy befor e processi ng an
	4796	adjustment !" S RCBIL LDA=0 Q
	4797	"RTN","RCB EADJ",74,0 )
	4798	. ;
	4799	"RTN","RCB EADJ",75,0 )
	4800	. ; fi x it
	4801	"RTN","RCB EADJ",76,0 )
	4802	. S $P( RCDATA7,"^ ",1)=+$P(R CBALANC,"^ ",1) ; pri ncipal
	4803	"RTN","RCB EADJ",77,0 )
	4804	. S $P( RCDATA7,"^ ",2)=+$P(R CBALANC,"^ ",2) ; int erest
	4805	"RTN","RCB EADJ",78,0 )
	4806	. S $P( RCDATA7,"^ ",3)=+$P(R CBALANC,"^ ",3) ; adm in
	4807	"RTN","RCB EADJ",79,0 )
	4808	. S $P( RCDATA7,"^ ",4)=+$P(R CBALANC,"^ ",4) ; mar shal fee
	4809	"RTN","RCB EADJ",80,0 )
	4810	. S $P( RCDATA7,"^ ",5)=+$P(R CBALANC,"^ ",5) ; cou rt cost
	4811	"RTN","RCB EADJ",81,0 )
	4812	. S $P( ^PRCA(430, RCBILLDA,7 ),"^",1,5) =$P(RCDATA 7,"^",1,5)
	4813	"RTN","RCB EADJ",82,0 )
	4814	. ;
	4815	"RTN","RCB EADJ",83,0 )
	4816	. W !," Balance Discrepanc y FIXED!"
	4817	"RTN","RCB EADJ",84,0 )
	4818	;
	4819	"RTN","RCB EADJ",85,0 )
	4820	; if the principal balance i s zero, do not allow it to be adjusted
	4821	"RTN","RCB EADJ",86,0 )
	4822	; ask to close/can cel it
	4823	"RTN","RCB EADJ",87,0 )
	4824	I RCBETYP E="DECREAS E",'$G(^PR CA(430,RCB ILLDA,7)) W !!,"Note : This bil l has NO P RINCIPAL B ALANCE
	4825	to decreas e !" D INT ADMIN(RCBI LLDA),UNLO CK Q
	4826	"RTN","RCB EADJ",88,0 )
	4827	;
	4828	"RTN","RCB EADJ",89,0 )
	4829	; If entr y is from EDI Lockbo x worklist , display total adju stments in ERA
	4830	"RTN","RCB EADJ",90,0 )
	4831	N AP D
	4832	"RTN","RCB EADJ",91,0 )
	4833	.N BILL,E OB,ERA,SEQ S ERA="", AP=0
	4834	"RTN","RCB EADJ",92,0 )
	4835	.F S ERA =$O(^RCY(3 44.4,"AP", 1,ERA)) Q: 'ERA D Q :AP
	4836	"RTN","RCB EADJ",93,0 )
	4837	..S SEQ=0
	4838	"RTN","RCB EADJ",94,0 )
	4839	..F S SE Q=$O(^RCY( 344.4,"AP" ,1,ERA,SEQ )) Q:'SEQ D Q:AP
	4840	"RTN","RCB EADJ",95,0 )
	4841	...S EOB= $P($G(^RCY (344.4,ERA ,1,SEQ,0)) ,U,2) Q:'E OB
	4842	"RTN","RCB EADJ",96,0 )
	4843	...S:$P($ G(^IBM(361 .1,EOB,0)) ,U)=RCBILL DA AP=1 ;I A #4051
	4844	"RTN","RCB EADJ",97,0 )
	4845	;
	4846	"RTN","RCB EADJ",98,0 )
	4847	; Ask to enter tra nsaction e ven though it is mar ked for au topost PRC A4.5298
	4848	"RTN","RCB EADJ",99,0 )
	4849	I RCBETYP E="DECREAS E",AP S Y= $$ASKAUPO( ) I Y'=1 W !,"Exitin g bill adj ustment." D UNLOCK Q
	4850	"RTN","RCB EADJ",100, 0)
	4851	;
	4852	"RTN","RCB EADJ",101, 0)
	4853	; ask to enter adj ustment am ount
	4854	"RTN","RCB EADJ",102, 0)
	4855	S RCAMOUN T=$$AMOUNT (RCBILLDA, RCBETYPE)
	4856	"RTN","RCB EADJ",103, 0)
	4857	I RCAMOUN T<0 D UNLO CK Q
	4858	"RTN","RCB EADJ",104, 0)
	4859	;
	4860	"RTN","RCB EADJ",105, 0)
	4861	; if dec rease, mak e negative
	4862	"RTN","RCB EADJ",106, 0)
	4863	I RCBETYP E="DECREAS E" S RCAMO UNT=-RCAMO UNT
	4864	"RTN","RCB EADJ",107, 0)
	4865	;
	4866	"RTN","RCB EADJ",108, 0)
	4867	; ask if it is a c ontract ad justment ( 45,46,47 a dded PRCA* 4.5*315)/D RF)
	4868	"RTN","RCB EADJ",109, 0)
	4869	I
	4870	RCBETYPE=" DECREASE", "^9^28^29^ 30^32^45^4 6^47^"[("^ "_$P($G(^P RCA(430,RC BILLDA,0)) ,"^",2)_"^ "
	4871	) S RCONTA DJ=$$ASKCO NT I RCONT ADJ<0 D UN LOCK Q
	4872	"RTN","RCB EADJ",110, 0)
	4873	;
	4874	"RTN","RCB EADJ",111, 0)
	4875	; show w hat the ne w transact ion will l ook like
	4876	"RTN","RCB EADJ",112, 0)
	4877	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
	4878	"RTN","RCB EADJ",113, 0)
	4879	W !!,"If you proces s the tran saction, t he bill wi ll look li ke:"
	4880	"RTN","RCB EADJ",114, 0)
	4881	W !,"Curr ent Princi pal Balanc e: ",$J($P (RCDATA7," ^"),11,2)
	4882	"RTN","RCB EADJ",115, 0)
	4883	W !," NE W ",RCBETY PE," Adjus tment: ",$ J(RCAMOUNT ,11,2)
	4884	"RTN","RCB EADJ",116, 0)
	4885	W !," ------- ----"
	4886	"RTN","RCB EADJ",117, 0)
	4887	W !," NEW Princi pal Balanc e: ",$J($P (RCDATA7," ^")+RCAMOU NT,11,2)
	4888	"RTN","RCB EADJ",118, 0)
	4889	;
	4890	"RTN","RCB EADJ",119, 0)
	4891	; ask to enter tra nsaction
	4892	"RTN","RCB EADJ",120, 0)
	4893	S Y=$$ASK OK(RCBETYP E) I Y'=1 D UNLOCK Q
	4894	"RTN","RCB EADJ",121, 0)
	4895	;
	4896	"RTN","RCB EADJ",122, 0)
	4897	ADDADJ ; add adjust ment
	4898	"RTN","RCB EADJ",123, 0)
	4899	S RCTRAND A=$$INCDEC ^RCBEUTR1( RCBILLDA,R CAMOUNT,"" ,"","",$G( RCONTADJ))
	4900	"RTN","RCB EADJ",124, 0)
	4901	I 'RCTRAN DA W !," * W A R N I N G: A djustment NOT Proces sed! *" D UNLOCK Q
	4902	"RTN","RCB EADJ",125, 0)
	4903	I RCTRAND A W !," A djustment Transactio n: ",RCTRA NDA," has been added ."
	4904	"RTN","RCB EADJ",126, 0)
	4905	I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D
	4906	DECADJ^RCT CSPU(RCBIL LDA,RCTRAN DA) ;prca* 4.5*301 ad d cs decre ase adjust ment
	4907	"RTN","RCB EADJ",127, 0)
	4908	I RCTRAND A,$G(RCTRR EV)=0 S PR CABN=RCBIL LDA D CSIT RN^RCTCSPD 5
	4909	"RTN","RCB EADJ",128, 0)
	4910	I RCTRAND A,$G(RCTRR EV)=0,'$G( RCEDIWL),( RCBETYPE=" INCREASE") ,$D(^PRCA( 430,"TCSP" ,RCBILLDA) )
	4911	S PRCABN=R CBILLDA D INCADJ^RCT CSPU(RCBIL LDA,RCTRAN DA) ;PRCA* 4.5*315/DR F add cs i ncrease
	4912	adjustment
	4913	"RTN","RCB EADJ",129, 0)
	4914	I $G(RCTR REV)=1 S P RCABN=RCBI LLDA D CSI TRY^RCTCSP D5
	4915	"RTN","RCB EADJ",130, 0)
	4916	I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD^ %DT W !!," *
	4917	* * * Tran smission w ill be hel d until "_ Y_" * * * *"
	4918	"RTN","RCB EADJ",131, 0)
	4919	;
	4920	"RTN","RCB EADJ",132, 0)
	4921	; ask to enter a c omment
	4922	"RTN","RCB EADJ",133, 0)
	4923	W !!,"Ent er a comme nt for the ",RCBETYP E," Adjust ment:"
	4924	"RTN","RCB EADJ",134, 0)
	4925	S Y=$$EDI T433^RCBEU TRA(RCTRAN DA,"41;")
	4926	"RTN","RCB EADJ",135, 0)
	4927	;
	4928	"RTN","RCB EADJ",136, 0)
	4929	; ask to exempt in terest and admin cha rges
	4930	"RTN","RCB EADJ",137, 0)
	4931	I RCBETYP E="DECREAS E" D INTAD MIN(RCBILL DA)
	4932	"RTN","RCB EADJ",138, 0)
	4933	;
	4934	"RTN","RCB EADJ",139, 0)
	4935	; notifi cation of subsequent payer bul letin
	4936	"RTN","RCB EADJ",140, 0)
	4937	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7)),X=0
	4938	"RTN","RCB EADJ",141, 0)
	4939	F I=1:1:5 S X=X+$P( RCDATA7,"^ ",I)
	4940	"RTN","RCB EADJ",142, 0)
	4941	I RCDATA7 '="",'X D
	4942	"RTN","RCB EADJ",143, 0)
	4943	. N PRC ABN,PRCAEN ,PRCAMT
	4944	"RTN","RCB EADJ",144, 0)
	4945	. S PRC ABN=RCBILL DA,PRCAEN= RCTRANDA,P RCAMT=+$P( $G(^PRCA(4 33,RCTRAND A,1)),"^", 5)
	4946	"RTN","RCB EADJ",145, 0)
	4947	. D EOB ^PRCADJ
	4948	"RTN","RCB EADJ",146, 0)
	4949	;
	4950	"RTN","RCB EADJ",147, 0)
	4951	; unlock and ask t he next bi ll to adju st
	4952	"RTN","RCB EADJ",148, 0)
	4953	D UNLOCK
	4954	"RTN","RCB EADJ",149, 0)
	4955	Q
	4956	"RTN","RCB EADJ",150, 0)
	4957	;
	4958	"RTN","RCB EADJ",151, 0)
	4959	;
	4960	"RTN","RCB EADJ",152, 0)
	4961	UNLOCK ; unlock bil l and tran saction
	4962	"RTN","RCB EADJ",153, 0)
	4963	L -^PRCA( 430,RCBILL DA)
	4964	"RTN","RCB EADJ",154, 0)
	4965	I $G(RCTR ANDA) L -^ PRCA(433,R CTRANDA)
	4966	"RTN","RCB EADJ",155, 0)
	4967	Q
	4968	"RTN","RCB EADJ",156, 0)
	4969	;
	4970	"RTN","RCB EADJ",157, 0)
	4971	;
	4972	"RTN","RCB EADJ",158, 0)
	4973	INTADMIN(R CBILLDA) ; ask and adjust the interest and admin
	4974	"RTN","RCB EADJ",159, 0)
	4975	N RCAMOUN T,RCTRANDA ,Y
	4976	"RTN","RCB EADJ",160, 0)
	4977	;
	4978	"RTN","RCB EADJ",161, 0)
	4979	; check to see if there is i nterest an d admin ch arges
	4980	"RTN","RCB EADJ",162, 0)
	4981	S RCAMOUN T=$G(^PRCA (430,RCBIL LDA,7))
	4982	"RTN","RCB EADJ",163, 0)
	4983	I '$P(RCA MOUNT,"^", 2),'$P(RCA MOUNT,"^", 3),'$P(RCA MOUNT,"^", 4),'$P(RCA MOUNT,"^", 5) Q
	4984	"RTN","RCB EADJ",164, 0)
	4985	;
	4986	"RTN","RCB EADJ",165, 0)
	4987	; only a sk if ther e is no pr incipal
	4988	"RTN","RCB EADJ",166, 0)
	4989	I RCAMOUN T Q
	4990	"RTN","RCB EADJ",167, 0)
	4991	;
	4992	"RTN","RCB EADJ",168, 0)
	4993	W !!,"You have the option to automatica lly EXEMPT the inter est"
	4994	"RTN","RCB EADJ",169, 0)
	4995	W !,"and administra tive charg es. This will close the bill. "
	4996	"RTN","RCB EADJ",170, 0)
	4997	S Y=$$ASK EXEMP I Y' =1 Q
	4998	"RTN","RCB EADJ",171, 0)
	4999	;
	5000	"RTN","RCB EADJ",172, 0)
	5001	W !!,"Cre ating an E XEMPT tran saction .. ."
	5002	"RTN","RCB EADJ",173, 0)
	5003	S
	5004	RCTRANDA=$ $EXEMPT^RC BEUTR2(RCB ILLDA,$P(R CAMOUNT,"^ ",2)_"^"_$ P(RCAMOUNT ,"^",3)_"^ ^"_$P
	5005	(RCAMOUNT, "^",4)_"^" _$P(RCAMOU NT,"^",5))
	5006	"RTN","RCB EADJ",174, 0)
	5007	I 'RCTRAN DA W !," * W A R N I N G: E XEMPTION N OT Process ed! *" Q
	5008	"RTN","RCB EADJ",175, 0)
	5009	I RCTRAND A W !," Exempt Tra nsaction: ",RCTRANDA ," has bee n added."
	5010	"RTN","RCB EADJ",176, 0)
	5011	INTC35B ;C heck if CS 5B entry n eeded for exempt tra nsaction
	5012	"RTN","RCB EADJ",177, 0)
	5013	I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D
	5014	DECADJ^RCT CSPU(RCBIL LDA,RCTRAN DA) ;prca* 4.5*301 ad d cs exemp t
	5015	"RTN","RCB EADJ",178, 0)
	5016	I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD^ %DT W !!," *
	5017	* * * Tran smission w ill be hel d until "_ Y_" * * * *"
	5018	"RTN","RCB EADJ",179, 0)
	5019	;
	5020	"RTN","RCB EADJ",180, 0)
	5021	W !," Cu rrent Bill Status: " ,$P($G(^PR CA(430.3,+ $P($G(^PRC A(430,RCBI LLDA,0))," ^",8),0)), "^")
	5022	"RTN","RCB EADJ",181, 0)
	5023	Q
	5024	"RTN","RCB EADJ",182, 0)
	5025	;
	5026	"RTN","RCB EADJ",183, 0)
	5027	ASKOK(RCBE TYPE) ; a sk record decrease o r increase transacti on
	5028	"RTN","RCB EADJ",184, 0)
	5029	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5030	"RTN","RCB EADJ",185, 0)
	5031	S DIR(0)= "YO",DIR(" B")="YES"
	5032	"RTN","RCB EADJ",186, 0)
	5033	S DIR("A" )="Are you sure you want to en ter this " _RCBETYPE_ " adjustme nt "
	5034	"RTN","RCB EADJ",187, 0)
	5035	W ! D ^DI R
	5036	"RTN","RCB EADJ",188, 0)
	5037	I $G(DTOU T)!($G(DUO UT)) S Y=- 1 I $G(GOT BILL) S RC DPGQ=1 ; account profile li stman quit flag *31 5
	5038	"RTN","RCB EADJ",189, 0)
	5039	Q Y
	5040	"RTN","RCB EADJ",190, 0)
	5041	;
	5042	"RTN","RCB EADJ",191, 0)
	5043	ASKAUPO() ; ask rec ord even t hough mark ed for aut o post PRC A4.5298
	5044	"RTN","RCB EADJ",192, 0)
	5045	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5046	"RTN","RCB EADJ",193, 0)
	5047	S DIR(0)= "YOA",DIR( "B")="NO"
	5048	"RTN","RCB EADJ",194, 0)
	5049	S DIR("A" )="Marked for Auto-P ost. Are y ou sure? ( Y/N) "
	5050	"RTN","RCB EADJ",195, 0)
	5051	W ! D ^DI R
	5052	"RTN","RCB EADJ",196, 0)
	5053	I $G(DTOU T)!($G(DUO UT)) S Y=- 1 I $G(GOT BILL) S RC DPGQ=1 ; account profile li stman quit flag *31 5
	5054	"RTN","RCB EADJ",197, 0)
	5055	Q Y
	5056	"RTN","RCB EADJ",198, 0)
	5057	;
	5058	"RTN","RCB EADJ",199, 0)
	5059	ASKFIX() ; ask to f ix bill's balance
	5060	"RTN","RCB EADJ",200, 0)
	5061	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5062	"RTN","RCB EADJ",201, 0)
	5063	S DIR(0)= "YO",DIR(" B")="NO"
	5064	"RTN","RCB EADJ",202, 0)
	5065	S DIR("A" )=" Do yo u want to FIX the ba lance disc repancy "
	5066	"RTN","RCB EADJ",203, 0)
	5067	W ! D ^DI R
	5068	"RTN","RCB EADJ",204, 0)
	5069	I $G(DTOU T)!($G(DUO UT)) S Y=- 1 I $G(GOT BILL) S RC DPGQ=1 ; account profile li stman quit flag *31 5
	5070	"RTN","RCB EADJ",205, 0)
	5071	Q Y
	5072	"RTN","RCB EADJ",206, 0)
	5073	;
	5074	"RTN","RCB EADJ",207, 0)
	5075	;
	5076	"RTN","RCB EADJ",208, 0)
	5077	ASKEXEMP() ; ask to record an exempt tr ansaction
	5078	"RTN","RCB EADJ",209, 0)
	5079	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5080	"RTN","RCB EADJ",210, 0)
	5081	S DIR(0)= "YO",DIR(" B")="NO"
	5082	"RTN","RCB EADJ",211, 0)
	5083	S DIR("A" )=" Would you like to EXEMPT the intere st and adm in charges "
	5084	"RTN","RCB EADJ",212, 0)
	5085	D ^DIR
	5086	"RTN","RCB EADJ",213, 0)
	5087	I $G(DTOU T)!($G(DUO UT)) S Y=- 1 I $G(GOT BILL) S RC DPGQ=1 ; account profile li stman quit flag *31 5
	5088	"RTN","RCB EADJ",214, 0)
	5089	Q Y
	5090	"RTN","RCB EADJ",215, 0)
	5091	;
	5092	"RTN","RCB EADJ",216, 0)
	5093	;
	5094	"RTN","RCB EADJ",217, 0)
	5095	ASKCONT() ; ask if contract a djustment
	5096	"RTN","RCB EADJ",218, 0)
	5097	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5098	"RTN","RCB EADJ",219, 0)
	5099	S DIR(0)= "YO",DIR(" B")="YES"
	5100	"RTN","RCB EADJ",220, 0)
	5101	S DIR("A" )=" Is th is a CONTR ACT adjust ment "
	5102	"RTN","RCB EADJ",221, 0)
	5103	W ! D ^DI R
	5104	"RTN","RCB EADJ",222, 0)
	5105	I $G(DTOU T)!($G(DUO UT)) S Y=- 1 I $G(GOT BILL) S RC DPGQ=1 ; account profile li stman quit flag *31 5
	5106	"RTN","RCB EADJ",223, 0)
	5107	Q Y
	5108	"RTN","RCB EADJ",224, 0)
	5109	;
	5110	"RTN","RCB EADJ",225, 0)
	5111	;
	5112	"RTN","RCB EADJ",226, 0)
	5113	ASKREV() ; Ask if Tr easury rev ersal *315 /DRF
	5114	"RTN","RCB EADJ",227, 0)
	5115	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5116	"RTN","RCB EADJ",228, 0)
	5117	S DIR(0)= "YO",DIR(" B")="NO"
	5118	"RTN","RCB EADJ",229, 0)
	5119	S DIR("A" )=" Is th is a TREAS URY revers al "
	5120	"RTN","RCB EADJ",230, 0)
	5121	W ! D ^DI R
	5122	"RTN","RCB EADJ",231, 0)
	5123	I $G(DTOU T)!($G(DUO UT)) S Y=- 1 I $G(GOT BILL) S RC DPGQ=1 ; account profile li stman quit flag *31 5
	5124	"RTN","RCB EADJ",232, 0)
	5125	Q Y
	5126	"RTN","RCB EADJ",233, 0)
	5127	;
	5128	"RTN","RCB EADJ",234, 0)
	5129	;
	5130	"RTN","RCB EADJ",235, 0)
	5131	ADJNUM(RCB ILLDA) ; get next a djustment number for a bill
	5132	"RTN","RCB EADJ",236, 0)
	5133	N %,ADJUS T,DATA1,RC TRANDA
	5134	"RTN","RCB EADJ",237, 0)
	5135	S RCTRAND A=0
	5136	"RTN","RCB EADJ",238, 0)
	5137	F S RCTR ANDA=$O(^P RCA(433,"C ",RCBILLDA ,RCTRANDA) ) Q:'RCTRA NDA S
	5138	DATA1=$G(^ PRCA(433,R CTRANDA,1) ) I $P(DAT A1,"^",4), $P(DATA1," ^",2)=1!($ P(DATA1,"^ ",2)=35) S
	5139	ADJUST=$P( DATA1,"^", 4)+1
	5140	"RTN","RCB EADJ",239, 0)
	5141	Q ADJUST
	5142	"RTN","RCB EADJ",240, 0)
	5143	;
	5144	"RTN","RCB EADJ",241, 0)
	5145	;
	5146	"RTN","RCB EADJ",242, 0)
	5147	AMOUNT(RCB ILLDA,RCBE TYPE) ; e nter the a djustment amount for a bill
	5148	"RTN","RCB EADJ",243, 0)
	5149	N DIR,DIR UT,DTOUT,D UOUT,PRINB AL,X,Y
	5150	"RTN","RCB EADJ",244, 0)
	5151	S PRINBAL =+$P($G(^P RCA(430,RC BILLDA,7)) ,"^")
	5152	"RTN","RCB EADJ",245, 0)
	5153	I RCBETYP E="INCREAS E" S PRINB AL=9999999 .99
	5154	"RTN","RCB EADJ",246, 0)
	5155	W !!,"Ent er the ",R CBETYPE," Adjustment AMOUNT, f rom .01 to ",$J(PRIN BAL,0,2)," ."
	5156	"RTN","RCB EADJ",247, 0)
	5157	S DIR(0)= "NAO^.01:" _PRINBAL_" :2"
	5158	"RTN","RCB EADJ",248, 0)
	5159	S DIR("A" )=" "_RCB ETYPE_" PR INCIPAL BA LANCE BY: "
	5160	"RTN","RCB EADJ",249, 0)
	5161	D ^DIR
	5162	"RTN","RCB EADJ",250, 0)
	5163	I $G(DTOU T)!($G(DUO UT)) S Y=- 1 I $G(GOT BILL) S RC DPGQ=1 ; account profile li stman quit flag *31 5
	5164	"RTN","RCB EADJ",251, 0)
	5165	Q $S(Y'=" ":Y,1:-1)
	5166	"RTN","RCB EADJ",252, 0)
	5167	;
	5168	"RTN","RCB EADJ",253, 0)
	5169	ASKCM() ; ask if th e action i s being pe rformed du e to the c laims matc hing proce ss *315
	5170	"RTN","RCB EADJ",254, 0)
	5171	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5172	"RTN","RCB EADJ",255, 0)
	5173	S DIR(0)= "YO",DIR(" B")="NO"
	5174	"RTN","RCB EADJ",256, 0)
	5175	S DIR("A" )="Is this action be ing perfor med due to the CLAIM S MATCHING process "
	5176	"RTN","RCB EADJ",257, 0)
	5177	D ^DIR
	5178	"RTN","RCB EADJ",258, 0)
	5179	I $G(DTOU T)!($G(DUO UT)) S Y=- 1 I $G(GOT BILL) S RC DPGQ=1 ; account profile li stman quit flag *31 5
	5180	"RTN","RCB EADJ",259, 0)
	5181	Q Y
	5182	"RTN","RCB EADJ",260, 0)
	5183	;
	5184	"RTN","RCC PCAP")
	5185	0^21^B4350 6016^n/a
	5186	"RTN","RCC PCAP",1,0)
	5187	RCCPCAP ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT B UILD ; 2/3 /2016 11:3 0 am
	5188	"RTN","RCC PCAP",2,0)
	5189	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 131
	5190	"RTN","RCC PCAP",3,0)
	5191	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5192	"RTN","RCC PCAP",4,0)
	5193	EN(YEAR,SO URCE,DTTIM E) ; Bui ld the pay ment state ments for Year enter ed
	5194	"RTN","RCC PCAP",5,0)
	5195	; Year is the first three num bers of th e Internal Date form at and mus t be earli er than cu rrent Year
	5196	"RTN","RCC PCAP",6,0)
	5197	; Source will be us ed to dete rmine whet her to sch edule or i mmediately start Tra nsmit afte r Build
	5198	"RTN","RCC PCAP",7,0)
	5199	; DTTIME is the Tra nsmit date and time in Interna l time fro m Build an d Transmit menu opti on
	5200	"RTN","RCC PCAP",8,0)
	5201	;
	5202	"RTN","RCC PCAP",9,0)
	5203	; Initial ize Incomi ng Variabl es - YEAR will be to Year befo re Current
	5204	"RTN","RCC PCAP",10,0 )
	5205	; Source will be to "B"ackgro und, and D TTIME to i ts current value, in cluding NU LL
	5206	"RTN","RCC PCAP",11,0 )
	5207	I $G(YEAR )="" S YEA R=$E(DT,1, 3)-1
	5208	"RTN","RCC PCAP",12,0 )
	5209	I $G(SOUR CE)="" S S OURCE="B"
	5210	"RTN","RCC PCAP",13,0 )
	5211	S DTTIME= $G(DTTIME)
	5212	"RTN","RCC PCAP",14,0 )
	5213	;
	5214	"RTN","RCC PCAP",15,0 )
	5215	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5216	"RTN","RCC PCAP",16,0 )
	5217	L +^RCAP( 349.5):DIL OCKTM I '$ T D Q
	5218	"RTN","RCC PCAP",17,0 )
	5219	. S YEAR= 20_$E(YEAR ,2,3)
	5220	"RTN","RCC PCAP",18,0 )
	5221	. S ^TMP( $J,"MSG",1 ,0)="The B uild and T ransmit of the Annua l Payment File for " _YEAR_" ha s not
	5222	completed. "
	5223	"RTN","RCC PCAP",19,0 )
	5224	. D ERRMA IL^RCCPCAT
	5225	"RTN","RCC PCAP",20,0 )
	5226	;
	5227	"RTN","RCC PCAP",21,0 )
	5228	N %,%I,%H ,STARTDT,E NDDT,LINE, PSSEG,PSCN TR,EXIT,DE BTOR,END,N EXT,SIZE
	5229	"RTN","RCC PCAP",22,0 )
	5230	;
	5231	"RTN","RCC PCAP",23,0 )
	5232	; Remove previous e ntries fro m file pri or to buil ding new f ile
	5233	"RTN","RCC PCAP",24,0 )
	5234	K ^RCAP(3 49.5)
	5235	"RTN","RCC PCAP",25,0 )
	5236	S ^RCAP(3 49.5,0)="A R ANNUAL P AYMENT STA TEMENT^349 .5^^"
	5237	"RTN","RCC PCAP",26,0 )
	5238	;
	5239	"RTN","RCC PCAP",27,0 )
	5240	; Set Sta rt and End Dates
	5241	"RTN","RCC PCAP",28,0 )
	5242	S STARTDT =YEAR_"010 0"
	5243	"RTN","RCC PCAP",29,0 )
	5244	S ENDDT=Y EAR_1232
	5245	"RTN","RCC PCAP",30,0 )
	5246	S (DEBTOR ,END)=""
	5247	"RTN","RCC PCAP",31,0 )
	5248	F PSCNTR= 1:1 Q:END D
	5249	"RTN","RCC PCAP",32,0 )
	5250	. S (NEXT ,SIZE,LINE )=0
	5251	"RTN","RCC PCAP",33,0 )
	5252	. D SETPS (PSCNTR,YE AR)
	5253	"RTN","RCC PCAP",34,0 )
	5254	. N LASTP D
	5255	"RTN","RCC PCAP",35,0 )
	5256	. F S DE BTOR=$O(^P RCA(433,"A TD",DEBTOR )) Q:DEBTO R="" D I NEXT Q
	5257	"RTN","RCC PCAP",36,0 )
	5258	.. N SSN
	5259	"RTN","RCC PCAP",37,0 )
	5260	.. ; Quit if the de btor is no t a patien t
	5261	"RTN","RCC PCAP",38,0 )
	5262	.. I '$D( ^RCD(340," AB","DPT(" ,DEBTOR)) Q
	5263	"RTN","RCC PCAP",39,0 )
	5264	.. ; Quit if a test patient S SN contain s a "P" or is Null
	5265	"RTN","RCC PCAP",40,0 )
	5266	.. S SSN= $$SSN^RCFN 01(DEBTOR)
	5267	"RTN","RCC PCAP",41,0 )
	5268	.. I SSN[ "P"!(SSN=- 1) Q
	5269	"RTN","RCC PCAP",42,0 )
	5270	.. N PHSE T,PHCNTR,P HSEG,DATE, LTBDT
	5271	"RTN","RCC PCAP",43,0 )
	5272	.. S (PHS ET,PHCNTR, LTBDT)=0
	5273	"RTN","RCC PCAP",44,0 )
	5274	.. S DATE =STARTDT
	5275	"RTN","RCC PCAP",45,0 )
	5276	.. F S D ATE=$O(^PR CA(433,"AT D",DEBTOR, DATE)) Q:D ATE="" Q: DATE>ENDDT D
	5277	"RTN","RCC PCAP",46,0 )
	5278	... ; Rec heck and Q uit if the date is n ot within the Year
	5279	"RTN","RCC PCAP",47,0 )
	5280	... I DAT E<STARTDT! (DATE>ENDD T) Q
	5281	"RTN","RCC PCAP",48,0 )
	5282	... ; Set Final Dat e for this Debtor to determine final tra nsaction
	5283	"RTN","RCC PCAP",49,0 )
	5284	... N TRA NS
	5285	"RTN","RCC PCAP",50,0 )
	5286	... S TRA NS=""
	5287	"RTN","RCC PCAP",51,0 )
	5288	... F S TRANS=$O(^ PRCA(433," ATD",DEBTO R,DATE,TRA NS)) Q:TRA NS="" D
	5289	"RTN","RCC PCAP",52,0 )
	5290	.... ; Qu it if the Transactio n Type is not Paymen t in Part( 2) or Paym ent in Ful l(34)
	5291	"RTN","RCC PCAP",53,0 )
	5292	.... I $P (^PRCA(433 ,TRANS,1), U,2)'=2&($ P(^PRCA(43 3,TRANS,1) ,U,2)'=34) Q
	5293	"RTN","RCC PCAP",54,0 )
	5294	.... ; Se t PH Recor d if first time for this Debto r
	5295	"RTN","RCC PCAP",55,0 )
	5296	.... I 'P HSET D SET PH(DEBTOR, SSN,PSCNTR ) S PHSET= 1
	5297	"RTN","RCC PCAP",56,0 )
	5298	.... ; Se t PD Recor d for each Payment T ransaction
	5299	"RTN","RCC PCAP",57,0 )
	5300	.... D SE TPD(DEBTOR ,DATE,TRAN S,PSCNTR)
	5301	"RTN","RCC PCAP",58,0 )
	5302	.. ;
	5303	"RTN","RCC PCAP",59,0 )
	5304	.. ; Afte r completi ng each De btor, if t he Size is over 25K, set Next to create a new PS R ecord,
	5305	"RTN","RCC PCAP",60,0 )
	5306	.. ; set Message De limiter at the end o f the PD r ecord, and set End D ate and Ti me
	5307	"RTN","RCC PCAP",61,0 )
	5308	.. I SIZE >25000 D
	5309	"RTN","RCC PCAP",62,0 )
	5310	... S ^RC AP(349.5,P SCNTR,1,LA STPD,0)=^R CAP(349.5, PSCNTR,1,L ASTPD,0)_" ~"
	5311	"RTN","RCC PCAP",63,0 )
	5312	... S NEX T=1
	5313	"RTN","RCC PCAP",64,0 )
	5314	... D NOW ^%DTC
	5315	"RTN","RCC PCAP",65,0 )
	5316	... S $P( ^RCAP(349. 5,PSCNTR,0 ),U,4)=%
	5317	"RTN","RCC PCAP",66,0 )
	5318	.. ;
	5319	"RTN","RCC PCAP",67,0 )
	5320	.. ; If t he last De btor in AT D has proc essed set End to sto p processi ng, if Til de not fin al
	5321	"RTN","RCC PCAP",68,0 )
	5322	.. ; char acter, set Tilde to Last PD re cord, and set End Da te and tim e
	5323	"RTN","RCC PCAP",69,0 )
	5324	. I DEBTO R="" D
	5325	"RTN","RCC PCAP",70,0 )
	5326	.. S END= 1
	5327	"RTN","RCC PCAP",71,0 )
	5328	.. I $G(L ASTPD)="" Q
	5329	"RTN","RCC PCAP",72,0 )
	5330	.. I $E(^ RCAP(349.5 ,PSCNTR,1, LASTPD,0), $L(^RCAP(3 49.5,PSCNT R,1,LASTPD ,0)))'="~" S
	5331	^RCAP(349. 5,PSCNTR,1 ,LASTPD,0) =^RCAP(349 .5,PSCNTR, 1,LASTPD,0 )_"~"
	5332	"RTN","RCC PCAP",73,0 )
	5333	.. D NOW^ %DTC
	5334	"RTN","RCC PCAP",74,0 )
	5335	.. S $P(^ RCAP(349.5 ,PSCNTR,0) ,U,4)=%
	5336	"RTN","RCC PCAP",75,0 )
	5337	;
	5338	"RTN","RCC PCAP",76,0 )
	5339	; PRCA4. 5313 - Un lock prior to transm ission
	5340	"RTN","RCC PCAP",77,0 )
	5341	L -^RCAP( 349.5):DIL OCKTM
	5342	"RTN","RCC PCAP",78,0 )
	5343	;
	5344	"RTN","RCC PCAP",79,0 )
	5345	; If the Source is Background (B) deter mine the d ate and ti me from th e schedule based upo n site cod e
	5346	"RTN","RCC PCAP",80,0 )
	5347	I SOURCE= "B" S DTTI ME=$$SCHED ^RCCPCAT($ $SITE^RCMS ITE)
	5348	"RTN","RCC PCAP",81,0 )
	5349	D EN^RCCP CAT(DTTIME )
	5350	"RTN","RCC PCAP",82,0 )
	5351	;
	5352	"RTN","RCC PCAP",83,0 )
	5353	Q
	5354	"RTN","RCC PCAP",84,0 )
	5355	;
	5356	"RTN","RCC PCAP",85,0 )
	5357	SETPS(PSCN TR,YEAR) ; Get and Set Data f or PS Reco rd into 34 9.5
	5358	"RTN","RCC PCAP",86,0 )
	5359	; Set Yea r and Buil d Start Da te and Tim e
	5360	"RTN","RCC PCAP",87,0 )
	5361	N PS,DR,D A,DIE,DIC, X,PRCAFDA
	5362	"RTN","RCC PCAP",88,0 )
	5363	S DIC="^R CAP(349.5, ",X=PSCNTR ,DA=.01,DI C(0)="" D FILE^DICN
	5364	"RTN","RCC PCAP",89,0 )
	5365	D NOW^%DT C
	5366	"RTN","RCC PCAP",90,0 )
	5367	S $P(^RCA P(349.5,PS CNTR,0),U, 2,3)=YEAR_ U_%
	5368	"RTN","RCC PCAP",91,0 )
	5369	; Increme nt Line nu mber
	5370	"RTN","RCC PCAP",92,0 )
	5371	S LINE=LI NE+1
	5372	"RTN","RCC PCAP",93,0 )
	5373	; Set PSS EG for thi s Segment to PS Coun ter
	5374	"RTN","RCC PCAP",94,0 )
	5375	S PSSEG(P SCNTR)=PSC NTR
	5376	"RTN","RCC PCAP",95,0 )
	5377	; Pieces 3 and 6 wi ll be upda ted during the creat ion of oth er PS and PH segment s
	5378	"RTN","RCC PCAP",96,0 )
	5379	S
	5380	PS="PS"_U_ PSCNTR_U_P SCNTR_U_$$ SITE^RCMSI TE_U_$$FP^ RCCPCFN_U_ 0_U_20_$E( YEAR,2,3)_ U_$$
	5381	DAT^RCCPCF N(DT)_U_"} "
	5382	"RTN","RCC PCAP",97,0 )
	5383	; Update File
	5384	"RTN","RCC PCAP",98,0 )
	5385	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P S
	5386	"RTN","RCC PCAP",99,0 )
	5387	D UPDATE^ DIE("","PR CAFDA","LI NE")
	5388	"RTN","RCC PCAP",100, 0)
	5389	; Add len gth to SIZ E
	5390	"RTN","RCC PCAP",101, 0)
	5391	S SIZE=SI ZE+$L(PS)
	5392	"RTN","RCC PCAP",102, 0)
	5393	; Update all previo us PS Segm ents piece 3 with cu rrent coun ter
	5394	"RTN","RCC PCAP",103, 0)
	5395	N I
	5396	"RTN","RCC PCAP",104, 0)
	5397	S I=0
	5398	"RTN","RCC PCAP",105, 0)
	5399	F S I=$O (PSSEG(I)) Q:I=PSCNT R S $P(^R CAP(349.5, I,1,1,0),U ,3)=PSCNTR
	5400	"RTN","RCC PCAP",106, 0)
	5401	;
	5402	"RTN","RCC PCAP",107, 0)
	5403	Q
	5404	"RTN","RCC PCAP",108, 0)
	5405	;
	5406	"RTN","RCC PCAP",109, 0)
	5407	SETPH(DEBT OR,SSN,PSC NTR) ; Ge t and Set Data for P H Record i nto 349.5
	5408	"RTN","RCC PCAP",110, 0)
	5409	N PH,SITE ,PATNAME,A DDRESS,I,A RFLAG,ARAD DR,COUNTRY ,DFN,ICN,D R,DA,DIE,P OSTCODE,PR CAFDA
	5410	"RTN","RCC PCAP",111, 0)
	5411	; Increme nt Line nu mber
	5412	"RTN","RCC PCAP",112, 0)
	5413	S LINE=LI NE+1
	5414	"RTN","RCC PCAP",113, 0)
	5415	; Increme nt PH Coun ter
	5416	"RTN","RCC PCAP",114, 0)
	5417	S PHCNTR= PHCNTR+1
	5418	"RTN","RCC PCAP",115, 0)
	5419	; Set PHS EG for thi s Segment to Line
	5420	"RTN","RCC PCAP",116, 0)
	5421	S PHSEG(P HCNTR)=LIN E
	5422	"RTN","RCC PCAP",117, 0)
	5423	; Get DFN and ICN f or Debtor and Patien t - If the ICN retur ns a -1 in the first piece
	5424	"RTN","RCC PCAP",118, 0)
	5425	; send a Null value as the IC N
	5426	"RTN","RCC PCAP",119, 0)
	5427	S DFN=+$P ($G(^RCD(3 40,DEBTOR, 0)),U)
	5428	"RTN","RCC PCAP",120, 0)
	5429	S ICN=$$G ETICN^MPIF 001(DFN)
	5430	"RTN","RCC PCAP",121, 0)
	5431	S ICN=$S( +ICN'=-1:I CN,1:"")
	5432	"RTN","RCC PCAP",122, 0)
	5433	; Get Acc ount Numbe r -- Sit e code and SSN
	5434	"RTN","RCC PCAP",123, 0)
	5435	S SITE=$$ SITE^RCMSI TE
	5436	"RTN","RCC PCAP",124, 0)
	5437	S PH="PH" _U_SITE_SS N
	5438	"RTN","RCC PCAP",125, 0)
	5439	; Get Pat ient Name
	5440	"RTN","RCC PCAP",126, 0)
	5441	S PATNAME =$$NAM^RCF N01(DEBTOR )
	5442	"RTN","RCC PCAP",127, 0)
	5443	S PH=PH_$ E($P(PATNA ME,","),1, 5)_U_$E($P (PATNAME," ,"),1,20)_ U_$E($P($P (PATNAME," ,",2),"
	5444	"),1,10)_U _$E($P(PAT NAME," ",2 ),1,10)
	5445	"RTN","RCC PCAP",128, 0)
	5446	; If Coun try is not '1' get C ountry Nam e and Post al Code
	5447	"RTN","RCC PCAP",129, 0)
	5448	S COUNTRY =$P($G(^DP T(+$P(^RCD (340,DEBTO R,0),U),.1 1)),U,10)
	5449	"RTN","RCC PCAP",130, 0)
	5450	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	5451	"RTN","RCC PCAP",131, 0)
	5452	; Get Add ress and A RFLAG
	5453	"RTN","RCC PCAP",132, 0)
	5454	S ADDRESS =$P($$DADD ^RCAMADD(D EBTOR,1),U ,1,6)
	5455	"RTN","RCC PCAP",133, 0)
	5456	F I=1:1:4 S $P(ADDR ESS,U,I)=$ E($P(ADDRE SS,U,I),1, 40)
	5457	"RTN","RCC PCAP",134, 0)
	5458	; If the Country is Null the State and Zip Code w ill be use d
	5459	"RTN","RCC PCAP",135, 0)
	5460	; If the Country is Not Null, the State will be F X and the
	5461	"RTN","RCC PCAP",136, 0)
	5462	; Zip Cod e will be Null
	5463	"RTN","RCC PCAP",137, 0)
	5464	S $P(ADDR ESS,U,5)=$ S(COUNTRY= "":$E($P(A DDRESS,U,5 ),1,2),1:" FX")
	5465	"RTN","RCC PCAP",138, 0)
	5466	S $P(ADDR ESS,U,6)=$ S(COUNTRY= "":$E($P(A DDRESS,U,6 ),1,9),1:" ")
	5467	"RTN","RCC PCAP",139, 0)
	5468	S PH=PH_U _ADDRESS
	5469	"RTN","RCC PCAP",140, 0)
	5470	S ARFLAG= "N"
	5471	"RTN","RCC PCAP",141, 0)
	5472	S ARADDR= $P($G(^RCD (340,DEBTO R,1)),U,1, 6)
	5473	"RTN","RCC PCAP",142, 0)
	5474	I ($P(ARA DDR,U)'="" ),($P(ARAD DR,U,4)'=" "),($P(ARA DDR,U,5)'= ""),(($P(A RADDR,U,6) '="")) S
	5475	ARFLAG="Y"
	5476	"RTN","RCC PCAP",143, 0)
	5477	S PH=PH_U _$E(COUNTR Y,1,11)
	5478	"RTN","RCC PCAP",144, 0)
	5479	; Set DFN and ICN f or Debtor and Patien t with Nul l space fo r Total Am ount Recei ved
	5480	"RTN","RCC PCAP",145, 0)
	5481	S PH=PH_U _U_SITE_$$ RJ^XLFSTR( $TR(DFN,". ",""),13,0 )_U_ICN
	5482	"RTN","RCC PCAP",146, 0)
	5483	; Set ARF LAG from a bove
	5484	"RTN","RCC PCAP",147, 0)
	5485	S PH=PH_U _ARFLAG
	5486	"RTN","RCC PCAP",148, 0)
	5487	; Set Nul l spaces f or Last Bi ll Prepare d Date for Debtor an d Number o f PD Segme nts
	5488	"RTN","RCC PCAP",149, 0)
	5489	; and the n Record D elimiter
	5490	"RTN","RCC PCAP",150, 0)
	5491	S PH=PH_U _U_U_"}"
	5492	"RTN","RCC PCAP",151, 0)
	5493	; Update file
	5494	"RTN","RCC PCAP",152, 0)
	5495	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P H
	5496	"RTN","RCC PCAP",153, 0)
	5497	D UPDATE^ DIE("","PR CAFDA","LI NE")
	5498	"RTN","RCC PCAP",154, 0)
	5499	; Add len gth to SIZ E
	5500	"RTN","RCC PCAP",155, 0)
	5501	S SIZE=SI ZE+$L(PH)
	5502	"RTN","RCC PCAP",156, 0)
	5503	; Increme nt PS segm ent piece 6 with ano ther PH re cord
	5504	"RTN","RCC PCAP",157, 0)
	5505	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,1,0),U ,6)=$P(^RC AP(349.5,P SSEG(PSCNT R),1,1,0), U,6)+1
	5506	"RTN","RCC PCAP",158, 0)
	5507	Q
	5508	"RTN","RCC PCAP",159, 0)
	5509	;
	5510	"RTN","RCC PCAP",160, 0)
	5511	SETPD(DEBT OR,DATE,TR ANS,PSCNTR ) ; Get a nd Set Dat a for PD R ecord into 349.5
	5512	"RTN","RCC PCAP",161, 0)
	5513	N DR,DA,D IE,PD,AMT, PHTOT,BILL ,CURBDT,PR CAFDA
	5514	"RTN","RCC PCAP",162, 0)
	5515	; Get Tra nsaction A mount - Qu it if Amou nt is zero or null
	5516	"RTN","RCC PCAP",163, 0)
	5517	S AMT=$P( $G(^PRCA(4 33,TRANS,1 )),U,5)
	5518	"RTN","RCC PCAP",164, 0)
	5519	I 'AMT Q
	5520	"RTN","RCC PCAP",165, 0)
	5521	; Format Amount
	5522	"RTN","RCC PCAP",166, 0)
	5523	S AMT=$TR ($J(AMT,9, 2)," ","")
	5524	"RTN","RCC PCAP",167, 0)
	5525	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	5526	"RTN","RCC PCAP",168, 0)
	5527	;
	5528	"RTN","RCC PCAP",169, 0)
	5529	S LINE=LI NE+1
	5530	"RTN","RCC PCAP",170, 0)
	5531	S LASTPD= LINE
	5532	"RTN","RCC PCAP",171, 0)
	5533	; Format and Set Da te Entered , Amount, and Delimi ter
	5534	"RTN","RCC PCAP",172, 0)
	5535	S PD="PD" _U_$$DAT^R CCPCFN(DAT E)_U_AMT_U _"}"
	5536	"RTN","RCC PCAP",173, 0)
	5537	;
	5538	"RTN","RCC PCAP",174, 0)
	5539	; Add len gth to SIZ E
	5540	"RTN","RCC PCAP",175, 0)
	5541	S SIZE=SI ZE+$L(PD)
	5542	"RTN","RCC PCAP",176, 0)
	5543	;
	5544	"RTN","RCC PCAP",177, 0)
	5545	; Update file
	5546	"RTN","RCC PCAP",178, 0)
	5547	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P D
	5548	"RTN","RCC PCAP",179, 0)
	5549	D UPDATE^ DIE("","PR CAFDA","LI NE")
	5550	"RTN","RCC PCAP",180, 0)
	5551	;
	5552	"RTN","RCC PCAP",181, 0)
	5553	; Get cur rent PH To tal, add A mount, the n reset to PH Segmen t
	5554	"RTN","RCC PCAP",182, 0)
	5555	S PHTOT=$ P(^RCAP(34 9.5,PSSEG( PSCNTR),1, PHSEG(PHCN TR),0),U,1 3)
	5556	"RTN","RCC PCAP",183, 0)
	5557	S PHTOT=P HTOT+AMT
	5558	"RTN","RCC PCAP",184, 0)
	5559	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,PHSEG( PHCNTR),0) ,U,13)=PHT OT
	5560	"RTN","RCC PCAP",185, 0)
	5561	;
	5562	"RTN","RCC PCAP",186, 0)
	5563	; Determi ne the Cur rent Bill Date and i f greater than LTBDT , Latest B ill Date,
	5564	"RTN","RCC PCAP",187, 0)
	5565	; set to PH Segment and LTBDT
	5566	"RTN","RCC PCAP",188, 0)
	5567	S BILL=$P ($G(^PRCA( 433,TRANS, 0)),U,2)
	5568	"RTN","RCC PCAP",189, 0)
	5569	S CURBDT= $P($G(^PRC A(430,BILL ,0)),U,10)
	5570	"RTN","RCC PCAP",190, 0)
	5571	I CURBDT> LTBDT S
	5572	$P(^RCAP(3 49.5,PSSEG (PSCNTR),1 ,PHSEG(PHC NTR),0),U, 17)=$$DAT^ RCCPCFN(CU RBDT),LTBD T=CURBDT
	5573	"RTN","RCC PCAP",191, 0)
	5574	;
	5575	"RTN","RCC PCAP",192, 0)
	5576	; Increme nt PH segm ent piece 18 with an other PD r ecord
	5577	"RTN","RCC PCAP",193, 0)
	5578	S
	5579	$P(^RCAP(3 49.5,PSSEG (PSCNTR),1 ,PHSEG(PHC NTR),0),U, 18)=$P(^RC AP(349.5,P SSEG(PSCNT R),1,PHSEG (
	5580	PHCNTR),0) ,U,18)+1
	5581	"RTN","RCC PCAP",194, 0)
	5582	Q
	5583	"RTN","RCC PCAP",195, 0)
	5584	;
	5585	"RTN","RCC PCAR")
	5586	0^23^B4789 4432^n/a
	5587	"RTN","RCC PCAR",1,0)
	5588	RCCPCAR ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT R EPORT ; 2/ 3/2016 11: 30 am
	5589	"RTN","RCC PCAR",2,0)
	5590	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 131
	5591	"RTN","RCC PCAR",3,0)
	5592	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5593	"RTN","RCC PCAR",4,0)
	5594	EN(YEAR) ; Report errors for the payme nt stateme nts for Ye ar entered
	5595	"RTN","RCC PCAR",5,0)
	5596	; Year is the first three num bers of th e Internal Date form at
	5597	"RTN","RCC PCAR",6,0)
	5598	;
	5599	"RTN","RCC PCAR",7,0)
	5600	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5601	"RTN","RCC PCAR",8,0)
	5602	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	5603	"RTN","RCC PCAR",9,0)
	5604	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	5605	"RTN","RCC PCAR",10,0 )
	5606	. W !,"Tr y again la ter."
	5607	"RTN","RCC PCAR",11,0 )
	5608	;
	5609	"RTN","RCC PCAR",12,0 )
	5610	K ^TMP($J ,"MSG")
	5611	"RTN","RCC PCAR",13,0 )
	5612	N STARTDT ,ENDDT,LIN E,DEBTOR,P ATSSN
	5613	"RTN","RCC PCAR",14,0 )
	5614	;
	5615	"RTN","RCC PCAR",15,0 )
	5616	; Initial ize YEAR t o current year if Nu ll
	5617	"RTN","RCC PCAR",16,0 )
	5618	I $G(YEAR )="" S YEA R=$E(DT,1, 3)
	5619	"RTN","RCC PCAR",17,0 )
	5620	;
	5621	"RTN","RCC PCAR",18,0 )
	5622	; Set Sta rt and End Dates
	5623	"RTN","RCC PCAR",19,0 )
	5624	S STARTDT =YEAR_"010 0"
	5625	"RTN","RCC PCAR",20,0 )
	5626	S ENDDT=Y EAR_1232
	5627	"RTN","RCC PCAR",21,0 )
	5628	S LINE=0
	5629	"RTN","RCC PCAR",22,0 )
	5630	S DEBTOR= ""
	5631	"RTN","RCC PCAR",23,0 )
	5632	F S DEBT OR=$O(^PRC A(433,"ATD ",DEBTOR)) Q:DEBTOR= "" D
	5633	"RTN","RCC PCAR",24,0 )
	5634	. ; Quit if the deb tor is not a patient
	5635	"RTN","RCC PCAR",25,0 )
	5636	. I '$D(^ RCD(340,"A B","DPT(", DEBTOR)) Q
	5637	"RTN","RCC PCAR",26,0 )
	5638	. N DATE, PATERROR,P HSET
	5639	"RTN","RCC PCAR",27,0 )
	5640	. S (PHSE T,PATERROR )=0
	5641	"RTN","RCC PCAR",28,0 )
	5642	. S DATE= STARTDT
	5643	"RTN","RCC PCAR",29,0 )
	5644	. F S DA TE=$O(^PRC A(433,"ATD ",DEBTOR,D ATE)) Q:DA TE="" Q:D ATE>ENDDT D
	5645	"RTN","RCC PCAR",30,0 )
	5646	.. ; Rech eck and Qu it if the date is no t within t he Year
	5647	"RTN","RCC PCAR",31,0 )
	5648	.. I DATE <STARTDT!( DATE>ENDDT ) Q
	5649	"RTN","RCC PCAR",32,0 )
	5650	.. ; Set Final Date for this Debtor to determine final tran saction
	5651	"RTN","RCC PCAR",33,0 )
	5652	.. N TRAN S
	5653	"RTN","RCC PCAR",34,0 )
	5654	.. S TRAN S=""
	5655	"RTN","RCC PCAR",35,0 )
	5656	.. F S T RANS=$O(^P RCA(433,"A TD",DEBTOR ,DATE,TRAN S)) Q:TRAN S="" D
	5657	"RTN","RCC PCAR",36,0 )
	5658	... ; Qui t if the T ransaction Type is n ot Payment in Part(2 ) or Payme nt in Full (34)
	5659	"RTN","RCC PCAR",37,0 )
	5660	... I $P( ^PRCA(433, TRANS,1),U ,2)'=2&($P (^PRCA(433 ,TRANS,1), U,2)'=34) Q
	5661	"RTN","RCC PCAR",38,0 )
	5662	... ; Che ck PH Reco rd if firs t time for this Debt or
	5663	"RTN","RCC PCAR",39,0 )
	5664	... I 'PH SET D CHEC KPH(DEBTOR ) S PHSET= 1
	5665	"RTN","RCC PCAR",40,0 )
	5666	... ; Che ck PD Reco rd for eac h Payment Transactio n
	5667	"RTN","RCC PCAR",41,0 )
	5668	... D CHE CKPD(DEBTO R,DATE,TRA NS)
	5669	"RTN","RCC PCAR",42,0 )
	5670	;
	5671	"RTN","RCC PCAR",43,0 )
	5672	; If ther e are any errors Sen d MailMan Message wi th Errors in ^TMP($J ,"MSG")
	5673	"RTN","RCC PCAR",44,0 )
	5674	I $D(^TMP ($J,"MSG") ) D TRANSM IT
	5675	"RTN","RCC PCAR",45,0 )
	5676	; If ther e are no e rrors Send MailMan M essage wit h No Error s Line
	5677	"RTN","RCC PCAR",46,0 )
	5678	I '$D(^TM P($J,"MSG" )) D
	5679	"RTN","RCC PCAR",47,0 )
	5680	. S ^TMP( $J,"MSG",1 ,0)="No an nual patie nt payment data inco nsistencie s found."
	5681	"RTN","RCC PCAR",48,0 )
	5682	. D TRANS MIT
	5683	"RTN","RCC PCAR",49,0 )
	5684	;
	5685	"RTN","RCC PCAR",50,0 )
	5686	K ^TMP($J ,"MSG")
	5687	"RTN","RCC PCAR",51,0 )
	5688	; PRCA4. 5313 - Un lock follo wing trans mission
	5689	"RTN","RCC PCAR",52,0 )
	5690	L -^TMP($ J,"MSG"):D ILOCKTM
	5691	"RTN","RCC PCAR",53,0 )
	5692	Q
	5693	"RTN","RCC PCAR",54,0 )
	5694	;
	5695	"RTN","RCC PCAR",55,0 )
	5696	CHECKPH(DE BTOR) ; C heck Data for PH Rec ord
	5697	"RTN","RCC PCAR",56,0 )
	5698	N SSN,PAT NAME,I,ARA DDR,ADDRER ,DFN,ICN,B ILLDATE,CO UNTRY,ST
	5699	"RTN","RCC PCAR",57,0 )
	5700	;
	5701	"RTN","RCC PCAR",58,0 )
	5702	; Get and Check DFN for Debto r. If DFN is Null o r does not start wit h a number
	5703	"RTN","RCC PCAR",59,0 )
	5704	; write E rror with Debtor Num ber and th en Quit, a s other da ta is depe ndent upon DFN
	5705	"RTN","RCC PCAR",60,0 )
	5706	S DFN=+$P (^RCD(340, DEBTOR,0), U)
	5707	"RTN","RCC PCAR",61,0 )
	5708	I 'DFN D SETERROR(" Debtor Num ber: "_DEB TOR,"Missi ng DFN") Q
	5709	"RTN","RCC PCAR",62,0 )
	5710	;
	5711	"RTN","RCC PCAR",63,0 )
	5712	; Get Pat ient Name and SSN
	5713	"RTN","RCC PCAR",64,0 )
	5714	S PATNAME =$$NAM^RCF N01(DEBTOR )
	5715	"RTN","RCC PCAR",65,0 )
	5716	S SSN=$$S SN^RCFN01( DEBTOR)
	5717	"RTN","RCC PCAR",66,0 )
	5718	S PATSSN= PATNAME_" LAST-4: " _$E(SSN,6, 9)
	5719	"RTN","RCC PCAR",67,0 )
	5720	;
	5721	"RTN","RCC PCAR",68,0 )
	5722	; Get and Check DFN and ICN f or Debtor and Patien t
	5723	"RTN","RCC PCAR",69,0 )
	5724	I $L(DFN) >8 D SETER ROR(PATSSN ,"Invalid DFN")
	5725	"RTN","RCC PCAR",70,0 )
	5726	S ICN=$$G ETICN^MPIF 001(DFN)
	5727	"RTN","RCC PCAR",71,0 )
	5728	I +ICN=-1 !($L(ICN)> 17) D SETE RROR(PATSS N,"Missing or Invali d ICN")
	5729	"RTN","RCC PCAR",72,0 )
	5730	;
	5731	"RTN","RCC PCAR",73,0 )
	5732	; Check P atient Nam e and SSN
	5733	"RTN","RCC PCAR",74,0 )
	5734	I SSN=""! (SSN'?9N) D SETERROR (PATSSN,"M issing or Invalid SS N")
	5735	"RTN","RCC PCAR",75,0 )
	5736	I $P(PATN AME,",")=" " D SETERR OR(PATSSN, "Missing o r Invalid Last Name" )
	5737	"RTN","RCC PCAR",76,0 )
	5738	I $P($P(P ATNAME,"," ,2)," ")=" " D SETERR OR(PATSSN, "Missing o r Invalid First Name ")
	5739	"RTN","RCC PCAR",77,0 )
	5740	;
	5741	"RTN","RCC PCAR",78,0 )
	5742	; Get and Check Add ress
	5743	"RTN","RCC PCAR",79,0 )
	5744	S ARADDR= $P($$DADD^ RCAMADD(DE BTOR,1),U, 1,6)
	5745	"RTN","RCC PCAR",80,0 )
	5746	F I=1,4 I $P(ARADDR ,U,I)=""!( $L($P(ARAD DR,U,I))>4 0!('$L($TR ($P(ARADDR ,U,I)," ", "")))) D
	5747	"RTN","RCC PCAR",81,0 )
	5748	. S ADDRE R(I)=$S(I= 1:"Address Line 1",I =4:"City")
	5749	"RTN","RCC PCAR",82,0 )
	5750	. D SETER ROR(PATSSN ,"Missing or Invalid "_ADDRER( I))
	5751	"RTN","RCC PCAR",83,0 )
	5752	N ADDRER
	5753	"RTN","RCC PCAR",84,0 )
	5754	F I=2,3 I $L($P(ARA DDR,U,I))> 40 D
	5755	"RTN","RCC PCAR",85,0 )
	5756	. S ADDRE R(I)=$S(I= 2:"Address Line 2",I =3:"Addres s Line 3")
	5757	"RTN","RCC PCAR",86,0 )
	5758	. D SETER ROR(PATSSN ,"Invalid "_ADDRER(I ))
	5759	"RTN","RCC PCAR",87,0 )
	5760	;
	5761	"RTN","RCC PCAR",88,0 )
	5762	; If the Zip Code i s Null fro m DADD^RCM ADD set Pi ece 6 of A RADDR to P iece 6 of .11
	5763	"RTN","RCC PCAR",89,0 )
	5764	I $P(ARAD DR,U,6)="" S $P(ARAD DR,U,6)=$P ($G(^DPT(D FN,.11)),U ,6)
	5765	"RTN","RCC PCAR",90,0 )
	5766	;
	5767	"RTN","RCC PCAR",91,0 )
	5768	; If Coun try is not '1' get C ountry Nam e for use in validat ing the St ate and Zi p Code
	5769	"RTN","RCC PCAR",92,0 )
	5770	S COUNTRY =$P($G(^DP T(DFN,.11) ),U,10)
	5771	"RTN","RCC PCAR",93,0 )
	5772	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	5773	"RTN","RCC PCAR",94,0 )
	5774	; State h as three E rror condi tions
	5775	"RTN","RCC PCAR",95,0 )
	5776	; If the State is N ot Null an d is not 2 character s
	5777	"RTN","RCC PCAR",96,0 )
	5778	; If the State is N ot Null an d is not a Valid US State
	5779	"RTN","RCC PCAR",97,0 )
	5780	; If the State is N ot Null an d the Coun try is Not Null
	5781	"RTN","RCC PCAR",98,0 )
	5782	; If the State is N ull and th e Country is Null
	5783	"RTN","RCC PCAR",99,0 )
	5784	I $P(ARAD DR,U,5)'=" ",$L($P(AR ADDR,U,5)) '=2 D SETE RROR(PATSS N,"Missing or Invali d State")
	5785	"RTN","RCC PCAR",100, 0)
	5786	S ST=""
	5787	"RTN","RCC PCAR",101, 0)
	5788	I $P(ARAD DR,U,5)'=" " S ST=$O( ^DIC(5,"C" ,$P(ARADDR ,U,5),""))
	5789	"RTN","RCC PCAR",102, 0)
	5790	I $P(ARAD DR,U,5)'=" ",ST="" D SETERROR(P ATSSN,"Mis sing or In valid Stat e")
	5791	"RTN","RCC PCAR",103, 0)
	5792	I $P(ARAD DR,U,5)'=" ",ST'="",$ P(^DIC(5,S T,0),U,6)' =1 D SETER ROR(PATSSN ,"Missing or Invalid State")
	5793	"RTN","RCC PCAR",104, 0)
	5794	I $P(ARAD DR,U,5)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid State" )
	5795	"RTN","RCC PCAR",105, 0)
	5796	I $P(ARAD DR,U,5)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d State")
	5797	"RTN","RCC PCAR",106, 0)
	5798	; Zip Cod e has thre e Error co nditions
	5799	"RTN","RCC PCAR",107, 0)
	5800	; If the Zip Code i s Not Null and is no t 5 to 9 N umerics
	5801	"RTN","RCC PCAR",108, 0)
	5802	; If the Zip Code i s Not Null and the C ountry is Not Null
	5803	"RTN","RCC PCAR",109, 0)
	5804	; If the Zip Code i s Null and the Count ry is Null
	5805	"RTN","RCC PCAR",110, 0)
	5806	I $P(ARAD DR,U,6)'=" "&($P(ARAD DR,U,6)'?5 .9N) D SET ERROR(PATS SN,"Missin g or Inval id Zip Cod e")
	5807	"RTN","RCC PCAR",111, 0)
	5808	I $P(ARAD DR,U,6)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid Zip Co de")
	5809	"RTN","RCC PCAR",112, 0)
	5810	I $P(ARAD DR,U,6)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d Zip Code ")
	5811	"RTN","RCC PCAR",113, 0)
	5812	Q
	5813	"RTN","RCC PCAR",114, 0)
	5814	;
	5815	"RTN","RCC PCAR",115, 0)
	5816	CHECKPD(DE BTOR,DATE, TRANS) ; Get and Se t Data for PD Record into 349. 5
	5817	"RTN","RCC PCAR",116, 0)
	5818	N AMT
	5819	"RTN","RCC PCAR",117, 0)
	5820	; Get and Check Tra nsaction A mount
	5821	"RTN","RCC PCAR",118, 0)
	5822	S AMT=$P( ^PRCA(433, TRANS,1),U ,5)
	5823	"RTN","RCC PCAR",119, 0)
	5824	; Format Amount
	5825	"RTN","RCC PCAR",120, 0)
	5826	S AMT=$TR ($J(AMT,9, 2)," ","")
	5827	"RTN","RCC PCAR",121, 0)
	5828	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	5829	"RTN","RCC PCAR",122, 0)
	5830	I 'AMT!($ L(AMT)>10) D SETERRO R(PATSSN," Amount in Transactio n "_TRANS_ " Invalid" )
	5831	"RTN","RCC PCAR",123, 0)
	5832	;
	5833	"RTN","RCC PCAR",124, 0)
	5834	; Get and Check Tra nsaction D ate
	5835	"RTN","RCC PCAR",125, 0)
	5836	I $P(DATE ,".")'?7N. N D SETERR OR(PATSSN, "Date for Transactio n "_TRANS_ " Invalid" )
	5837	"RTN","RCC PCAR",126, 0)
	5838	Q
	5839	"RTN","RCC PCAR",127, 0)
	5840	;
	5841	"RTN","RCC PCAR",128, 0)
	5842	SETERROR(P ATSSN,ERRO R) ; Set the error into TMP($ J,"MSG",LI NE,0) for transmissi on
	5843	"RTN","RCC PCAR",129, 0)
	5844	; If the first time thru for this patie nt set the Name and SSN in mes sage
	5845	"RTN","RCC PCAR",130, 0)
	5846	; with a blank line above the Patient D ata for sp acing
	5847	"RTN","RCC PCAR",131, 0)
	5848	I 'PATERR OR D
	5849	"RTN","RCC PCAR",132, 0)
	5850	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=" "
	5851	"RTN","RCC PCAR",133, 0)
	5852	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=P ATSSN
	5853	"RTN","RCC PCAR",134, 0)
	5854	. S PATER ROR=1
	5855	"RTN","RCC PCAR",135, 0)
	5856	; Write E rror to ne xt line wi th a doubl e space in front
	5857	"RTN","RCC PCAR",136, 0)
	5858	S LINE=LI NE+1 S ^TM P($J,"MSG" ,LINE,0)=" "_ERROR
	5859	"RTN","RCC PCAR",137, 0)
	5860	Q
	5861	"RTN","RCC PCAR",138, 0)
	5862	;
	5863	"RTN","RCC PCAR",139, 0)
	5864	TRANSMIT ; set up and send mail message - copied fr om RCCPCML
	5865	"RTN","RCC PCAR",140, 0)
	5866	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY
	5867	"RTN","RCC PCAR",141, 0)
	5868	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT ERROR R EPORT "_20 _$E(YEAR,2 ,3)_" TO C URRENT
	5869	DATE"
	5870	"RTN","RCC PCAR",142, 0)
	5871	S XMDUZ=" AR PACKAGE "
	5872	"RTN","RCC PCAR",143, 0)
	5873	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.RC CPC
	5874	STATEMENTS ")=""
	5875	"RTN","RCC PCAR",144, 0)
	5876	S XMDUZ=" AR PACKAGE "
	5877	"RTN","RCC PCAR",145, 0)
	5878	D XMZ^XMA 2
	5879	"RTN","RCC PCAR",146, 0)
	5880	I XMZ<1 S RTY=RTY+1 G TRANSMI T:RTY<4 S ERROR=5,NM =0 D ERROR Q
	5881	"RTN","RCC PCAR",147, 0)
	5882	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) I $ D(^TMP($J, "MSG",L(1) ,0)) S
	5883	L=L+1,^XMB (3.9,+XMZ, 2,L,0)=^TM P($J,"MSG" ,L(1),0)
	5884	"RTN","RCC PCAR",148, 0)
	5885	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	5886	"RTN","RCC PCAR",149, 0)
	5887	D ENT1^XM D
	5888	"RTN","RCC PCAR",150, 0)
	5889	D NOW^%DT C
	5890	"RTN","RCC PCAR",151, 0)
	5891	Q
	5892	"RTN","RCC PCAR",152, 0)
	5893	;
	5894	"RTN","RCC PCAR",153, 0)
	5895	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	5896	"RTN","RCC PCAR",154, 0)
	5897	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	5898	"RTN","RCC PCAR",155, 0)
	5899	Q
	5900	"RTN","RCC PCAR",156, 0)
	5901	;
	5902	"RTN","RCC PCAR",157, 0)
	5903	MANBLD ; Build and Transmit t he Annual Payment St atement Co nsistency Checker
	5904	"RTN","RCC PCAR",158, 0)
	5905	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5906	"RTN","RCC PCAR",159, 0)
	5907	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	5908	"RTN","RCC PCAR",160, 0)
	5909	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	5910	"RTN","RCC PCAR",161, 0)
	5911	. W !,"Tr y again la ter."
	5912	"RTN","RCC PCAR",162, 0)
	5913	; PRCA4. 5313 - Un lock prior to prepar ing and tr ansmitting
	5914	"RTN","RCC PCAR",163, 0)
	5915	L -^TMP($ J,"MSG"):D ILOCKTM
	5916	"RTN","RCC PCAR",164, 0)
	5917	;
	5918	"RTN","RCC PCAR",165, 0)
	5919	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T,%,%H
	5920	"RTN","RCC PCAR",166, 0)
	5921	S YEAR=20 _$E(DT,2,3 )
	5922	"RTN","RCC PCAR",167, 0)
	5923	S DIR(0)= "YAO"
	5924	"RTN","RCC PCAR",168, 0)
	5925	S DIR("B" )="N"
	5926	"RTN","RCC PCAR",169, 0)
	5927	S DIR("A" )="Do you want to Ru n and Tran smit the C onsistency Checker f or "_YEAR_ " to the c urrent
	5928	date? "
	5929	"RTN","RCC PCAR",170, 0)
	5930	S DIR("?? ")="^D MAN HLP^RCCPCA R"
	5931	"RTN","RCC PCAR",171, 0)
	5932	D ^DIR
	5933	"RTN","RCC PCAR",172, 0)
	5934	I $E(X)'= "Y" Q
	5935	"RTN","RCC PCAR",173, 0)
	5936	S ZTIO="" ,ZTRTN="EN ^RCCPCAR(" _$E(DT,1,3 )_")"
	5937	"RTN","RCC PCAR",174, 0)
	5938	S ZTDESC= "Annual Pa yment Stat ement File Consisten cy Checker "
	5939	"RTN","RCC PCAR",175, 0)
	5940	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	5941	"RTN","RCC PCAR",176, 0)
	5942	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	5943	"RTN","RCC PCAR",177, 0)
	5944	Q
	5945	"RTN","RCC PCAR",178, 0)
	5946	;
	5947	"RTN","RCC PCAR",179, 0)
	5948	MANHLP ; "??" Help for MANBLD
	5949	"RTN","RCC PCAR",180, 0)
	5950	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Run and Transmit t he Consist ency Check er."
	5951	"RTN","RCC PCAR",181, 0)
	5952	Q
	5953	"RTN","RCC PCAT")
	5954	0^22^B5227 0242^n/a
	5955	"RTN","RCC PCAT",1,0)
	5956	RCCPCAT ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT T RANSMIT ; 2/3/2016 1 1:30 am
	5957	"RTN","RCC PCAT",2,0)
	5958	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 131
	5959	"RTN","RCC PCAT",3,0)
	5960	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5961	"RTN","RCC PCAT",4,0)
	5962	EN(DTTIME) ;Schedul e the Tran smit
	5963	"RTN","RCC PCAT",5,0)
	5964	N ZTDESC, ZTASK,ZTDT H,ZTIO,ZTR TN
	5965	"RTN","RCC PCAT",6,0)
	5966	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	5967	"RTN","RCC PCAT",7,0)
	5968	S ZTDESC= "ANNUAL PA YMENT STAT EMENT TRAN SMISSION"
	5969	"RTN","RCC PCAT",8,0)
	5970	; Initial ize Transm it date an d time
	5971	"RTN","RCC PCAT",9,0)
	5972	I DTTIME= "" S DTTIM E=%H
	5973	"RTN","RCC PCAT",10,0 )
	5974	S ZTDTH=D TTIME
	5975	"RTN","RCC PCAT",11,0 )
	5976	D ^%ZTLOA D Q:$G(ZTS K)=""
	5977	"RTN","RCC PCAT",12,0 )
	5978	Q
	5979	"RTN","RCC PCAT",13,0 )
	5980	;
	5981	"RTN","RCC PCAT",14,0 )
	5982	TRANSMIT ; Send Ann ual Paymen t Statemen t Files to AITC from RCAP(349. 5
	5983	"RTN","RCC PCAT",15,0 )
	5984	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5985	"RTN","RCC PCAT",16,0 )
	5986	L +^RCAP( 349.5):DIL OCKTM I '$ T D Q
	5987	"RTN","RCC PCAT",17,0 )
	5988	. N YEAR
	5989	"RTN","RCC PCAT",18,0 )
	5990	. S YEAR= 20_$E($P(^ RCAP(349.5 ,1,0),U,2) ,2,3)
	5991	"RTN","RCC PCAT",19,0 )
	5992	. S ^TMP( $J,"MSG",1 ,0)="The T ransmit of the Annua l Payment File for " _YEAR_" ha s not comp leted."
	5993	"RTN","RCC PCAT",20,0 )
	5994	. D ERRMA IL^RCCPCAT
	5995	"RTN","RCC PCAT",21,0 )
	5996	;
	5997	"RTN","RCC PCAT",22,0 )
	5998	K ^TMP($J ,"MSG")
	5999	"RTN","RCC PCAT",23,0 )
	6000	N PSCNTR, %,%I,%H,YE AR
	6001	"RTN","RCC PCAT",24,0 )
	6002	S YEAR=20 _$E($P(^RC AP(349.5,1 ,0),U,2),2 ,3)
	6003	"RTN","RCC PCAT",25,0 )
	6004	S PSCNTR= 0
	6005	"RTN","RCC PCAT",26,0 )
	6006	F S PSCN TR=$O(^RCA P(349.5,PS CNTR)) Q:' PSCNTR D
	6007	"RTN","RCC PCAT",27,0 )
	6008	. ; Set T ransmit St art Date a nd Time
	6009	"RTN","RCC PCAT",28,0 )
	6010	. D NOW^% DTC
	6011	"RTN","RCC PCAT",29,0 )
	6012	. S $P(^R CAP(349.5, PSCNTR,0), U,5)=%
	6013	"RTN","RCC PCAT",30,0 )
	6014	. ; Merge all PS el ements int o TMP MSG file
	6015	"RTN","RCC PCAT",31,0 )
	6016	. M ^TMP( $J,"MSG")= ^RCAP(349. 5,PSCNTR,1 )
	6017	"RTN","RCC PCAT",32,0 )
	6018	. D MAIL
	6019	"RTN","RCC PCAT",33,0 )
	6020	. ; Set T ransmit En d Date and Time
	6021	"RTN","RCC PCAT",34,0 )
	6022	. D NOW^% DTC
	6023	"RTN","RCC PCAT",35,0 )
	6024	. S $P(^R CAP(349.5, PSCNTR,0), U,6)=%
	6025	"RTN","RCC PCAT",36,0 )
	6026	;
	6027	"RTN","RCC PCAT",37,0 )
	6028	; PRCA4. 5313 - Un lock prior to quit
	6029	"RTN","RCC PCAT",38,0 )
	6030	L -^RCAP( 349.5):DIL OCKTM
	6031	"RTN","RCC PCAT",39,0 )
	6032	Q
	6033	"RTN","RCC PCAT",40,0 )
	6034	;
	6035	"RTN","RCC PCAT",41,0 )
	6036	MAIL ;set up and sen d mail mes sage - cop ied from R CCPCML
	6037	"RTN","RCC PCAT",42,0 )
	6038	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	6039	"RTN","RCC PCAT",43,0 )
	6040	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT TRANSMI SSION "_YE AR
	6041	"RTN","RCC PCAT",44,0 )
	6042	S XMDUZ=" AR PACKAGE "
	6043	"RTN","RCC PCAT",45,0 )
	6044	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.RC CPC
	6045	STATEMENTS ")=""
	6046	"RTN","RCC PCAT",46,0 )
	6047	S X=$O(^R CT(349.1," B","PY",0) )
	6048	"RTN","RCC PCAT",47,0 )
	6049	I X,$P($G (^RCT(349. 1,+X,0)),U ,3) S X=$P ($G(^RCT(3 49.1,+X,3) ),U)_"@"_$ P($G(^RCT( 349.1,+X,3 )),U,3)
	6050	S:$P(X,"@" ,2)]"" XMY (X)=""
	6051	"RTN","RCC PCAT",48,0 )
	6052	I $P(X,"@ ",2)']"" D Q
	6053	"RTN","RCC PCAT",49,0 )
	6054	.S ERROR= 6,NM=0 D E RROR
	6055	"RTN","RCC PCAT",50,0 )
	6056	S XMDUZ=" AR PACKAGE "
	6057	"RTN","RCC PCAT",51,0 )
	6058	D XMZ^XMA 2
	6059	"RTN","RCC PCAT",52,0 )
	6060	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	6061	"RTN","RCC PCAT",53,0 )
	6062	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) I $ D(^TMP($J, "MSG",L(1) ,0)) S
	6063	L=L+1,^XMB (3.9,+XMZ, 2,L,0)=^TM P($J,"MSG" ,L(1),0)
	6064	"RTN","RCC PCAT",54,0 )
	6065	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	6066	"RTN","RCC PCAT",55,0 )
	6067	D ENT1^XM D
	6068	"RTN","RCC PCAT",56,0 )
	6069	D NOW^%DT C
	6070	"RTN","RCC PCAT",57,0 )
	6071	K ^TMP($J ,"MSG")
	6072	"RTN","RCC PCAT",58,0 )
	6073	Q
	6074	"RTN","RCC PCAT",59,0 )
	6075	;
	6076	"RTN","RCC PCAT",60,0 )
	6077	ERRMAIL ;s et up and send mail message fo r Locking issues
	6078	"RTN","RCC PCAT",61,0 )
	6079	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	6080	"RTN","RCC PCAT",62,0 )
	6081	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT NOT COM PLETED "_Y EAR
	6082	"RTN","RCC PCAT",63,0 )
	6083	S XMDUZ=" AR PACKAGE "
	6084	"RTN","RCC PCAT",64,0 )
	6085	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.RC CPC
	6086	STATEMENTS ")=""
	6087	"RTN","RCC PCAT",65,0 )
	6088	S XMDUZ=" AR PACKAGE "
	6089	"RTN","RCC PCAT",66,0 )
	6090	D XMZ^XMA 2
	6091	"RTN","RCC PCAT",67,0 )
	6092	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	6093	"RTN","RCC PCAT",68,0 )
	6094	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) I $ D(^TMP($J, "MSG",L(1) ,0)) S
	6095	L=L+1,^XMB (3.9,+XMZ, 2,L,0)=^TM P($J,"MSG" ,L(1),0)
	6096	"RTN","RCC PCAT",69,0 )
	6097	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	6098	"RTN","RCC PCAT",70,0 )
	6099	D ENT1^XM D
	6100	"RTN","RCC PCAT",71,0 )
	6101	D NOW^%DT C
	6102	"RTN","RCC PCAT",72,0 )
	6103	K ^TMP($J ,"MSG")
	6104	"RTN","RCC PCAT",73,0 )
	6105	Q
	6106	"RTN","RCC PCAT",74,0 )
	6107	;
	6108	"RTN","RCC PCAT",75,0 )
	6109	SCHED(SITE ) ; Deter mine the d ate and ti me for Tra nsmit base d upon Sit e Code and table AIT C provided
	6110	"RTN","RCC PCAT",76,0 )
	6111	; Time wi ll always be 2:00 AM
	6112	"RTN","RCC PCAT",77,0 )
	6113	I SITE>40 1&(SITE<52 0) S DTTIM E=$E(DT,1, 5)_"03.020 000" Q DTT IME
	6114	"RTN","RCC PCAT",78,0 )
	6115	I SITE>51 9&(SITE<54 1) S DTTIM E=$E(DT,1, 5)_"04.020 000" Q DTT IME
	6116	"RTN","RCC PCAT",79,0 )
	6117	I SITE>54 0&(SITE<55 9) S DTTIM E=$E(DT,1, 5)_"05.020 000" Q DTT IME
	6118	"RTN","RCC PCAT",80,0 )
	6119	I SITE>56 0&(SITE<58 1) S DTTIM E=$E(DT,1, 5)_"06.020 000" Q DTT IME
	6120	"RTN","RCC PCAT",81,0 )
	6121	I SITE>58 0&(SITE<59 9) S DTTIM E=$E(DT,1, 5)_"07.020 000" Q DTT IME
	6122	"RTN","RCC PCAT",82,0 )
	6123	I SITE>59 9&(SITE<62 0) S DTTIM E=$E(DT,1, 5)_"08.020 000" Q DTT IME
	6124	"RTN","RCC PCAT",83,0 )
	6125	I SITE>61 9&(SITE<64 1) S DTTIM E=$E(DT,1, 5)_"09.020 000" Q DTT IME
	6126	"RTN","RCC PCAT",84,0 )
	6127	I SITE>64 1&(SITE<65 8) S DTTIM E=$E(DT,1, 5)_"10.020 000" Q DTT IME
	6128	"RTN","RCC PCAT",85,0 )
	6129	I SITE>65 7&(SITE<67 5) S DTTIM E=$E(DT,1, 5)_"11.020 000" Q DTT IME
	6130	"RTN","RCC PCAT",86,0 )
	6131	I SITE>67 4&(SITE<75 8) S DTTIM E=$E(DT,1, 5)_"12.020 000" Q DTT IME
	6132	"RTN","RCC PCAT",87,0 )
	6133	S DTTIME= ""
	6134	"RTN","RCC PCAT",88,0 )
	6135	Q DTTIME
	6136	"RTN","RCC PCAT",89,0 )
	6137	;
	6138	"RTN","RCC PCAT",90,0 )
	6139	MANBLD ; Build and Transmit t he Annual Payment St atement af ter initia l yearly t ransmissio n
	6140	"RTN","RCC PCAT",91,0 )
	6141	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6142	"RTN","RCC PCAT",92,0 )
	6143	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	6144	"RTN","RCC PCAT",93,0 )
	6145	;
	6146	"RTN","RCC PCAT",94,0 )
	6147	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	6148	"RTN","RCC PCAT",95,0 )
	6149	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6150	"RTN","RCC PCAT",96,0 )
	6151	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	6152	"RTN","RCC PCAT",97,0 )
	6153	I YEAR="" S YEAR=$E (DT,1,3)-1
	6154	"RTN","RCC PCAT",98,0 )
	6155	S YEAR("E XT")=20_$E (YEAR,2,3)
	6156	"RTN","RCC PCAT",99,0 )
	6157	S DATE=+$ P($G(^RCAP (349.5,1,0 )),U,6)
	6158	"RTN","RCC PCAT",100, 0)
	6159	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	6160	"RTN","RCC PCAT",101, 0)
	6161	I 'DATE D L -^RCAP (349.5):DI LOCKTM Q
	6162	"RTN","RCC PCAT",102, 0)
	6163	. W !,"Th e Annual P ayment Fil e for "_YE AR("EXT")_ " has not been trans mitted."
	6164	"RTN","RCC PCAT",103, 0)
	6165	. W !,"Bu ild and Re transmit m ay not be manually r un until s cheduled j ob has com pleted.",!
	6166	"RTN","RCC PCAT",104, 0)
	6167	. N DIR
	6168	"RTN","RCC PCAT",105, 0)
	6169	. S DIR(0 )="E"
	6170	"RTN","RCC PCAT",106, 0)
	6171	. S DIR(" A")="Type <Enter> to return to the Menu. "
	6172	"RTN","RCC PCAT",107, 0)
	6173	. D ^DIR
	6174	"RTN","RCC PCAT",108, 0)
	6175	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	6176	"RTN","RCC PCAT",109, 0)
	6177	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_"."
	6178	"RTN","RCC PCAT",110, 0)
	6179	S DIR(0)= "YAO"
	6180	"RTN","RCC PCAT",111, 0)
	6181	S DIR("B" )="N"
	6182	"RTN","RCC PCAT",112, 0)
	6183	S DIR("A" )="Do you want to Bu ild and Tr ansmit the file for "_YEAR("EX T")_"? "
	6184	"RTN","RCC PCAT",113, 0)
	6185	S DIR("?? ")="^D MAN HLP^RCCPCA T"
	6186	"RTN","RCC PCAT",114, 0)
	6187	D ^DIR
	6188	"RTN","RCC PCAT",115, 0)
	6189	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC AP(349.5): DILOCKTM Q
	6190	"RTN","RCC PCAT",116, 0)
	6191	I $E(X)'= "Y" Q
	6192	"RTN","RCC PCAT",117, 0)
	6193	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	6194	"RTN","RCC PCAT",118, 0)
	6195	S ZTIO="" ,ZTRTN="EN ^RCCPCAP(" _YEAR_","_ """F"""_", "_""""""_" )"
	6196	"RTN","RCC PCAT",119, 0)
	6197	S ZTDESC= "Build Ann ual Paymen t Statemen t File"
	6198	"RTN","RCC PCAT",120, 0)
	6199	S ZTDTH=" "
	6200	"RTN","RCC PCAT",121, 0)
	6201	;
	6202	"RTN","RCC PCAT",122, 0)
	6203	; PRCA4. 5313 - Un lock prior to transm itting
	6204	"RTN","RCC PCAT",123, 0)
	6205	L -^RCAP( 349.5):DIL OCKTM
	6206	"RTN","RCC PCAT",124, 0)
	6207	;
	6208	"RTN","RCC PCAT",125, 0)
	6209	D ^%ZTLOA D Q:$G(ZTS K)=""
	6210	"RTN","RCC PCAT",126, 0)
	6211	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6212	"RTN","RCC PCAT",127, 0)
	6213	Q
	6214	"RTN","RCC PCAT",128, 0)
	6215	;
	6216	"RTN","RCC PCAT",129, 0)
	6217	RETRANS ; Retransmi t the exis ting file and allow user to se lect date and time
	6218	"RTN","RCC PCAT",130, 0)
	6219	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6220	"RTN","RCC PCAT",131, 0)
	6221	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	6222	"RTN","RCC PCAT",132, 0)
	6223	;
	6224	"RTN","RCC PCAT",133, 0)
	6225	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	6226	"RTN","RCC PCAT",134, 0)
	6227	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6228	"RTN","RCC PCAT",135, 0)
	6229	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	6230	"RTN","RCC PCAT",136, 0)
	6231	S YEAR("E XT")=20_$E (YEAR,2,3)
	6232	"RTN","RCC PCAT",137, 0)
	6233	S DATE=$P ($G(^RCAP( 349.5,1,0) ),U,6)
	6234	"RTN","RCC PCAT",138, 0)
	6235	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	6236	"RTN","RCC PCAT",139, 0)
	6237	I '$P($G( ^RCAP(349. 5,1,0)),U, 4) D L -^ RCAP(349.5 ):DILOCKTM Q
	6238	"RTN","RCC PCAT",140, 0)
	6239	. W !,"Th e Annual P ayment Fil e for "_YE AR("EXT")_ " has not been Built and canno t be trans mitted."
	6240	"RTN","RCC PCAT",141, 0)
	6241	. N DIR
	6242	"RTN","RCC PCAT",142, 0)
	6243	. S DIR(0 )="E"
	6244	"RTN","RCC PCAT",143, 0)
	6245	. S DIR(" A")="Type <Enter> to return to the menu. "
	6246	"RTN","RCC PCAT",144, 0)
	6247	. D ^DIR
	6248	"RTN","RCC PCAT",145, 0)
	6249	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	6250	"RTN","RCC PCAT",146, 0)
	6251	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_"."
	6252	"RTN","RCC PCAT",147, 0)
	6253	S DIR(0)= "YAO"
	6254	"RTN","RCC PCAT",148, 0)
	6255	S DIR("B" )="N"
	6256	"RTN","RCC PCAT",149, 0)
	6257	S DIR("A" )="Do you want to Re transmit t he existin g file for "_YEAR("E XT")_" aga in? "
	6258	"RTN","RCC PCAT",150, 0)
	6259	S DIR("?? ")="^D RET HLP^RCCPCA T"
	6260	"RTN","RCC PCAT",151, 0)
	6261	D ^DIR
	6262	"RTN","RCC PCAT",152, 0)
	6263	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC AP(349.5): DILOCKTM Q
	6264	"RTN","RCC PCAT",153, 0)
	6265	I $E(X)'= "Y" Q
	6266	"RTN","RCC PCAT",154, 0)
	6267	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	6268	"RTN","RCC PCAT",155, 0)
	6269	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	6270	"RTN","RCC PCAT",156, 0)
	6271	S ZTDESC= "Retransmi t Annual P ayment Sta tement Fil e"
	6272	"RTN","RCC PCAT",157, 0)
	6273	S ZTDTH=" "
	6274	"RTN","RCC PCAT",158, 0)
	6275	;
	6276	"RTN","RCC PCAT",159, 0)
	6277	; PRCA4. 5313 - Un lock prior to retran smitting
	6278	"RTN","RCC PCAT",160, 0)
	6279	L -^RCAP( 349.5):DIL OCKTM
	6280	"RTN","RCC PCAT",161, 0)
	6281	;
	6282	"RTN","RCC PCAT",162, 0)
	6283	D ^%ZTLOA D Q:$G(ZTS K)=""
	6284	"RTN","RCC PCAT",163, 0)
	6285	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6286	"RTN","RCC PCAT",164, 0)
	6287	Q
	6288	"RTN","RCC PCAT",165, 0)
	6289	;
	6290	"RTN","RCC PCAT",166, 0)
	6291	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	6292	"RTN","RCC PCAT",167, 0)
	6293	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	6294	"RTN","RCC PCAT",168, 0)
	6295	Q
	6296	"RTN","RCC PCAT",169, 0)
	6297	;
	6298	"RTN","RCC PCAT",170, 0)
	6299	MENUERR ; Print err or to scre en if Annu al Payment File has not comple ted for th is year
	6300	"RTN","RCC PCAT",171, 0)
	6301	N YEAR
	6302	"RTN","RCC PCAT",172, 0)
	6303	S YEAR=20 _$E(DT,2,3 )-1
	6304	"RTN","RCC PCAT",173, 0)
	6305	W !!,"The Build and Transmit of the Ann ual Paymen t File for "_YEAR_" has not co mpleted."
	6306	"RTN","RCC PCAT",174, 0)
	6307	W !,"You may not us e this opt ion until it complet es.",!
	6308	"RTN","RCC PCAT",175, 0)
	6309	D PAUSE^V ALM1
	6310	"RTN","RCC PCAT",176, 0)
	6311	Q
	6312	"RTN","RCC PCAT",177, 0)
	6313	;
	6314	"RTN","RCC PCAT",178, 0)
	6315	MANHLP ; "??" Help for MANBLD and RETRA NS
	6316	"RTN","RCC PCAT",179, 0)
	6317	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Build an d Retransm it file."
	6318	"RTN","RCC PCAT",180, 0)
	6319	Q
	6320	"RTN","RCC PCAT",181, 0)
	6321	;
	6322	"RTN","RCC PCAT",182, 0)
	6323	RETHLP ; "??" Help for MANBLD and RETRA NS
	6324	"RTN","RCC PCAT",183, 0)
	6325	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Retransm it file."
	6326	"RTN","RCC PCAT",184, 0)
	6327	Q
	6328	"RTN","RCC PCBJ")
	6329	0^5^B94409 06^B628849 1
	6330	"RTN","RCC PCBJ",1,0)
	6331	RCCPCBJ ;W ASH-ISC@AL TOONA,PA/N YB-Backgro und Driver for CCPC ;1/7/97 9 :42 AM
	6332	"RTN","RCC PCBJ",2,0)
	6333	;;4.5;Acc ounts Rece ivable;3 4,76,130,1 53,166,195 ,217,237,3 13;Mar 2 0, 1995;Bu ild 131
	6334	"RTN","RCC PCBJ",3,0)
	6335	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	6336	"RTN","RCC PCBJ",4,0)
	6337	EN ;Starts the backg round job for CCPC 5 days befo re stateme nt day
	6338	"RTN","RCC PCBJ",5,0)
	6339	N X,X1,X2 ,X3,ZTRTN, ZTIO,ZTDTH ,ZTSK,ZTDE SC,SDT,RCF ULL
	6340	"RTN","RCC PCBJ",6,0)
	6341	;D ACK P RCA4.531 3 - Moved into OPEN
	6342	"RTN","RCC PCBJ",7,0)
	6343	D ;run t he cbs nig htly accou nt update program ev eryday
	6344	"RTN","RCC PCBJ",8,0)
	6345	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	6346	"RTN","RCC PCBJ",9,0)
	6347	.S RCFULL =0 ;do not send the full debto r list
	6348	"RTN","RCC PCBJ",10,0 )
	6349	.S ZTIO=" ",ZTRTN="D EBTOR^PRCA CPS1"
	6350	"RTN","RCC PCBJ",11,0 )
	6351	.S ZTDESC ="CBS NIGH TLY ACCOUN T UPDATE P ROGRAM",ZT DTH=$H
	6352	"RTN","RCC PCBJ",12,0 )
	6353	.D ^%ZTLO AD
	6354	"RTN","RCC PCBJ",13,0 )
	6355	;
	6356	"RTN","RCC PCBJ",14,0 )
	6357	I $$DOW^X LFDT(DT,1) =3 D ;run the cbs a uto-correc tion progr am on Wedn esdays
	6358	"RTN","RCC PCBJ",15,0 )
	6359	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	6360	"RTN","RCC PCBJ",16,0 )
	6361	.S ZTIO=" ",ZTRTN="S TART^PRCAC PS",ZTSAVE ("RCFULL") =""
	6362	"RTN","RCC PCBJ",17,0 )
	6363	.S ZTDESC ="PATIENT STATEMENTS AUTO-CORR ECTION PRO GRAM",ZTDT H=$H
	6364	"RTN","RCC PCBJ",18,0 )
	6365	.D ^%ZTLO AD
	6366	"RTN","RCC PCBJ",19,0 )
	6367	;
	6368	"RTN","RCC PCBJ",20,0 )
	6369	; PRCA4. 5313 - Ru n the Annu al Payment Statement Build and Transmit
	6370	"RTN","RCC PCBJ",21,0 )
	6371	; on Janu ary 2nd of each year for the p revious ye ar
	6372	"RTN","RCC PCBJ",22,0 )
	6373	I $E(DT,4 ,7)="0102" D
	6374	"RTN","RCC PCBJ",23,0 )
	6375	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	6376	"RTN","RCC PCBJ",24,0 )
	6377	. S ZTIO= "",ZTRTN=" EN^RCCPCAP ",ZTDTH=$H
	6378	"RTN","RCC PCBJ",25,0 )
	6379	. S ZTDES C="ANNUAL PAYMENT ST ATEMENT BU ILD AND TR ANSMIT"
	6380	"RTN","RCC PCBJ",26,0 )
	6381	. D ^%ZTL OAD
	6382	"RTN","RCC PCBJ",27,0 )
	6383	;
	6384	"RTN","RCC PCBJ",28,0 )
	6385	; PRCA4. 5313 - Ru n the Annu al Payment Error Rep ort on Mar ch, June, September and
	6386	"RTN","RCC PCBJ",29,0 )
	6387	; Decembe r 15th
	6388	"RTN","RCC PCBJ",30,0 )
	6389	I $E(DT,4 ,5)="03"!( $E(DT,4,5) ="06")!($E (DT,4,5)=" 09")!($E(D T,4,5)=12) D
	6390	"RTN","RCC PCBJ",31,0 )
	6391	. I $E(DT ,6,7)'=15 Q
	6392	"RTN","RCC PCBJ",32,0 )
	6393	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	6394	"RTN","RCC PCBJ",33,0 )
	6395	. S ZTIO= "",ZTRTN=" EN^RCCPCAR ",ZTDTH=$H
	6396	"RTN","RCC PCBJ",34,0 )
	6397	. S ZTDES C="ANNUAL PAYMENT ER ROR REPORT "
	6398	"RTN","RCC PCBJ",35,0 )
	6399	. D ^%ZTL OAD
	6400	"RTN","RCC PCBJ",36,0 )
	6401	;
	6402	"RTN","RCC PCBJ",37,0 )
	6403	I DT'<$P( $G(^RC(342 ,1,30)),"^ ",1)&(DT'> $P($G(^RC( 342,1,30)) ,"^",2)) D ^RCEXINAD
	6404	"RTN","RCC PCBJ",38,0 )
	6405	;
	6406	"RTN","RCC PCBJ",39,0 )
	6407	; PRCA4. 5313 - Se t Statemen t Date to two days i n future a nd save fo r Job
	6408	"RTN","RCC PCBJ",40,0 )
	6409	S X1=DT,X 2=2 D C^%D TC S SDT=X
	6410	"RTN","RCC PCBJ",41,0 )
	6411	S ZTSAVE( "SDT")=SDT
	6412	"RTN","RCC PCBJ",42,0 )
	6413	S ZTIO="" ,ZTRTN="OP EN^RCCPCBJ ",ZTDESC=" CBSS PATIE NT STATEME NT"
	6414	"RTN","RCC PCBJ",43,0 )
	6415	S ZTDTH=$ H D ^%ZTLO AD
	6416	"RTN","RCC PCBJ",44,0 )
	6417	Q
	6418	"RTN","RCC PCBJ",45,0 )
	6419	OPEN ;Upda te Open st atus bills to Active or Cancel lation sta tus
	6420	"RTN","RCC PCBJ",46,0 )
	6421	N DAY,BN, DEBTOR,DA, DIE,DR,P,A MT,DATE
	6422	"RTN","RCC PCBJ",47,0 )
	6423	N ZTSAVE, ZTRTN,ZTDE SC,ZTASK,% ZIS,ZTDTH
	6424	"RTN","RCC PCBJ",48,0 )
	6425	; PRCA4. 5313 - Ch eck the ac knowledgem ent for pr evious mon th
	6426	"RTN","RCC PCBJ",49,0 )
	6427	D TRANCHK ^RCCPCSV1
	6428	"RTN","RCC PCBJ",50,0 )
	6429	; PRCA4. 5313 - Se t DATE and day of mo nth from S DT and pro cess that date's deb tors
	6430	"RTN","RCC PCBJ",51,0 )
	6431	S DATE=SD T,DAY=+$E( SDT,6,7),D EBTOR=""
	6432	"RTN","RCC PCBJ",52,0 )
	6433	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	6434	"RTN","RCC PCBJ",53,0 )
	6435	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'BN D
	6436	"RTN","RCC PCBJ",54,0 )
	6437	..S AMT=0 F P=1:1:5 S AMT=$P( $G(^PRCA(4 30,+BN,7)) ,"^",P)+AM T
	6438	"RTN","RCC PCBJ",55,0 )
	6439	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )),AMT Q
	6440	"RTN","RCC PCBJ",56,0 )
	6441	..S DIE=" ^PRCA(430, ",DA=+BN,D R="8////^S
	6442	X="_$S(AMT :$O(^PRCA( 430.3,"AC" ,102,0)),1 :$O(^PRCA( 430.3,"AC" ,111,0))) D ^DIE K D A,DIE,DR
	6443	"RTN","RCC PCBJ",57,0 )
	6444	..Q
	6445	"RTN","RCC PCBJ",58,0 )
	6446	.Q
	6447	"RTN","RCC PCBJ",59,0 )
	6448	;
	6449	"RTN","RCC PCBJ",60,0 )
	6450	; update patient a ccounts wi th interes t and admi n
	6451	"RTN","RCC PCBJ",61,0 )
	6452	N RCLASDA T
	6453	"RTN","RCC PCBJ",62,0 )
	6454	S RCLASDA T=DATE
	6455	"RTN","RCC PCBJ",63,0 )
	6456	I DT>3010 101 D FIRS TPTY^RCBEC HGS
	6457	"RTN","RCC PCBJ",64,0 )
	6458	; PRCA4. 5313 - Ad ded SDT to process a nd send
	6459	"RTN","RCC PCBJ",65,0 )
	6460	D EN^RCCP CPS(SDT)
	6461	"RTN","RCC PCBJ",66,0 )
	6462	D REFUND
	6463	"RTN","RCC PCBJ",67,0 )
	6464	D EN^RCCP CML(SDT)
	6465	"RTN","RCC PCBJ",68,0 )
	6466	Q
	6467	"RTN","RCC PCBJ",69,0 )
	6468	;
	6469	"RTN","RCC PCBJ",70,0 )
	6470	;
	6471	"RTN","RCC PCBJ",71,0 )
	6472	REFUND ;Up date Open status PRE PAYMENT bi lls to REF UND REVIEW
	6473	"RTN","RCC PCBJ",72,0 )
	6474	; PRCA4. 5313 - Ch anged DAY to stateme nt date
	6475	"RTN","RCC PCBJ",73,0 )
	6476	S DEBTOR= 0,DAY=SDT
	6477	"RTN","RCC PCBJ",74,0 )
	6478	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	6479	"RTN","RCC PCBJ",75,0 )
	6480	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'BN D
	6481	"RTN","RCC PCBJ",76,0 )
	6482	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )) S X=$$E N^PRCARFU( +BN)
	6483	"RTN","RCC PCBJ",77,0 )
	6484	..Q
	6485	"RTN","RCC PCBJ",78,0 )
	6486	.Q
	6487	"RTN","RCC PCBJ",79,0 )
	6488	Q
	6489	"RTN","RCC PCBJ",80,0 )
	6490	;
	6491	"RTN","RCC PCBJ",81,0 )
	6492	ACK ;CHECK FOR ACKNO WLEDGEMENT S PRCA4. 5313 - No longer us ed
	6493	"RTN","RCC PCBJ",82,0 )
	6494	N DEB,MSG ,NO,RCX,X, X1,X2
	6495	"RTN","RCC PCBJ",83,0 )
	6496	S X1=$$ST D^RCCPCFN, X2=DT D ^% DTC I X>3 D
	6497	"RTN","RCC PCBJ",84,0 )
	6498	. D TRANC HK^RCCPCSV 1
	6499	"RTN","RCC PCBJ",85,0 )
	6500	Q
	6501	"RTN","RCC PCFN1")
	6502	0^7^B71817 74^n/a
	6503	"RTN","RCC PCFN1",1,0 )
	6504	RCCPCFN1 ; ALB/TGH-Ad ditional F unction ca lls for CB SS ;12/31/ 96 9:27 A M
	6505	"RTN","RCC PCFN1",2,0 )
	6506	;;4.5;Acc ounts Rece ivable;3 13;Mar 3 1, 2016;Bu ild 131
	6507	"RTN","RCC PCFN1",3,0 )
	6508	;;Per VA Directive 6402, this routine s hould not be modifie d.
	6509	"RTN","RCC PCFN1",4,0 )
	6510	ACSET(NAME ) ; Deter mine the d ay of the month for each new d ebtor to h ave their patient st atement
	6511	sent
	6512	"RTN","RCC PCFN1",5,0 )
	6513	; by the site to CB SS for con solidation .
	6514	"RTN","RCC PCFN1",6,0 )
	6515	; Input: NAME = Pa tient's Na me
	6516	"RTN","RCC PCFN1",7,0 )
	6517	; Output: DAY/GROUP = day of month for patient st atement tr ansmission and group number
	6518	"RTN","RCC PCFN1",8,0 )
	6519	; 0 = if i nvalid fir st charact er of last name
	6520	"RTN","RCC PCFN1",9,0 )
	6521	;
	6522	"RTN","RCC PCFN1",10, 0)
	6523	N LTR,GRO UP,DAY,I
	6524	"RTN","RCC PCFN1",11, 0)
	6525	;
	6526	"RTN","RCC PCFN1",12, 0)
	6527	; Quit if the patie nt name is not cross -reference d in the P atient Fil e (#2) - r eturn 0
	6528	"RTN","RCC PCFN1",13, 0)
	6529	I $G(NAME )="" Q 0
	6530	"RTN","RCC PCFN1",14, 0)
	6531	I '$D(^DP T("B",NAME )) Q 0
	6532	"RTN","RCC PCFN1",15, 0)
	6533	;
	6534	"RTN","RCC PCFN1",16, 0)
	6535	F I=1,2 S LTR(I)=$E (NAME,I)
	6536	"RTN","RCC PCFN1",17, 0)
	6537	I "AB"[LT R(1) S GRO UP=1,DAY=$ $GRP1(.LTR ) Q DAY_" /"_GROUP
	6538	"RTN","RCC PCFN1",18, 0)
	6539	I "CD"[LT R(1) S GRO UP=2,DAY=$ $GRP2(.LTR ) Q DAY_" /"_GROUP
	6540	"RTN","RCC PCFN1",19, 0)
	6541	I "EFIQ"[ LTR(1) S G ROUP=3,DAY =$$GRP3(.L TR) Q DAY _"/"_GROUP
	6542	"RTN","RCC PCFN1",20, 0)
	6543	I "GH"[LT R(1) S GRO UP=4,DAY=$ $GRP4(.LTR ) Q DAY_" /"_GROUP
	6544	"RTN","RCC PCFN1",21, 0)
	6545	I "JK"[LT R(1) S GRO UP=5,DAY=$ $GRP5(.LTR ) Q DAY_" /"_GROUP
	6546	"RTN","RCC PCFN1",22, 0)
	6547	I "LO"[LT R(1) S GRO UP=6,DAY=$ $GRP6(.LTR ) Q DAY_" /"_GROUP
	6548	"RTN","RCC PCFN1",23, 0)
	6549	I "MN"[LT R(1) S GRO UP=7,DAY=$ $GRP7(.LTR ) Q DAY_" /"_GROUP
	6550	"RTN","RCC PCFN1",24, 0)
	6551	I "T"[LTR (1) S GROU P=8,DAY=$$ GRP8(.LTR) Q DAY_"/ "_GROUP
	6552	"RTN","RCC PCFN1",25, 0)
	6553	I "R"[LTR (1) S GROU P=9,DAY=$$ GRP9(.LTR) Q DAY_"/ "_GROUP
	6554	"RTN","RCC PCFN1",26, 0)
	6555	I "SV"[LT R(1) S GRO UP=10,DAY= $$GRP10(.L TR) Q DAY _"/"_GROUP
	6556	"RTN","RCC PCFN1",27, 0)
	6557	I "PUXYZ" [LTR(1) S GROUP=11,D AY=$$GRP11 (.LTR) Q DAY_"/"_GR OUP
	6558	"RTN","RCC PCFN1",28, 0)
	6559	I "W"[LTR (1) S GROU P=12,DAY=$ $GRP12(.LT R) Q DAY_ "/"_GROUP
	6560	"RTN","RCC PCFN1",29, 0)
	6561	;
	6562	"RTN","RCC PCFN1",30, 0)
	6563	Q 0
	6564	"RTN","RCC PCFN1",31, 0)
	6565	;
	6566	"RTN","RCC PCFN1",32, 0)
	6567	GRP1(LTR) ;AB
	6568	"RTN","RCC PCFN1",33, 0)
	6569	;
	6570	"RTN","RCC PCFN1",34, 0)
	6571	I LTR(1)= "A" S DAY= 1
	6572	"RTN","RCC PCFN1",35, 0)
	6573	I LTR(1)= "B" D
	6574	"RTN","RCC PCFN1",36, 0)
	6575	. I "AU"[ LTR(2) S D AY=1
	6576	"RTN","RCC PCFN1",37, 0)
	6577	. I "AU"' [LTR(2) S DAY=2
	6578	"RTN","RCC PCFN1",38, 0)
	6579	;
	6580	"RTN","RCC PCFN1",39, 0)
	6581	Q DAY
	6582	"RTN","RCC PCFN1",40, 0)
	6583	;
	6584	"RTN","RCC PCFN1",41, 0)
	6585	GRP2(LTR) ;CD
	6586	"RTN","RCC PCFN1",42, 0)
	6587	;
	6588	"RTN","RCC PCFN1",43, 0)
	6589	I LTR(1)= "D" S DAY= 4
	6590	"RTN","RCC PCFN1",44, 0)
	6591	I LTR(1)= "C" D
	6592	"RTN","RCC PCFN1",45, 0)
	6593	. I "IRU" [LTR(2) S DAY=4
	6594	"RTN","RCC PCFN1",46, 0)
	6595	. I "IRU" '[LTR(2) S DAY=6
	6596	"RTN","RCC PCFN1",47, 0)
	6597	;
	6598	"RTN","RCC PCFN1",48, 0)
	6599	Q DAY
	6600	"RTN","RCC PCFN1",49, 0)
	6601	;
	6602	"RTN","RCC PCFN1",50, 0)
	6603	GRP3(LTR) ;EFIQ
	6604	"RTN","RCC PCFN1",51, 0)
	6605	;
	6606	"RTN","RCC PCFN1",52, 0)
	6607	S DAY=7
	6608	"RTN","RCC PCFN1",53, 0)
	6609	;
	6610	"RTN","RCC PCFN1",54, 0)
	6611	Q DAY
	6612	"RTN","RCC PCFN1",55, 0)
	6613	;
	6614	"RTN","RCC PCFN1",56, 0)
	6615	GRP4(LTR) ;GH
	6616	"RTN","RCC PCFN1",57, 0)
	6617	;
	6618	"RTN","RCC PCFN1",58, 0)
	6619	I LTR(1)= "G" S DAY= 8
	6620	"RTN","RCC PCFN1",59, 0)
	6621	I LTR(1)= "H" D
	6622	"RTN","RCC PCFN1",60, 0)
	6623	. I "E"[L TR(2) S DA Y=8
	6624	"RTN","RCC PCFN1",61, 0)
	6625	. I "E"'[ LTR(2) S D AY=10
	6626	"RTN","RCC PCFN1",62, 0)
	6627	;
	6628	"RTN","RCC PCFN1",63, 0)
	6629	Q DAY
	6630	"RTN","RCC PCFN1",64, 0)
	6631	;
	6632	"RTN","RCC PCFN1",65, 0)
	6633	GRP5(LTR) ;JK
	6634	"RTN","RCC PCFN1",66, 0)
	6635	;
	6636	"RTN","RCC PCFN1",67, 0)
	6637	S DAY=12
	6638	"RTN","RCC PCFN1",68, 0)
	6639	;
	6640	"RTN","RCC PCFN1",69, 0)
	6641	Q DAY
	6642	"RTN","RCC PCFN1",70, 0)
	6643	;
	6644	"RTN","RCC PCFN1",71, 0)
	6645	GRP6(LTR) ;LO
	6646	"RTN","RCC PCFN1",72, 0)
	6647	;
	6648	"RTN","RCC PCFN1",73, 0)
	6649	S DAY=14
	6650	"RTN","RCC PCFN1",74, 0)
	6651	;
	6652	"RTN","RCC PCFN1",75, 0)
	6653	Q DAY
	6654	"RTN","RCC PCFN1",76, 0)
	6655	;
	6656	"RTN","RCC PCFN1",77, 0)
	6657	GRP7(LTR) ;MN
	6658	"RTN","RCC PCFN1",78, 0)
	6659	;
	6660	"RTN","RCC PCFN1",79, 0)
	6661	I LTR(1)= "N" S DAY= 17
	6662	"RTN","RCC PCFN1",80, 0)
	6663	I LTR(1)= "M" D
	6664	"RTN","RCC PCFN1",81, 0)
	6665	. I "CI"[ LTR(2) S D AY=17
	6666	"RTN","RCC PCFN1",82, 0)
	6667	. I "CI"' [LTR(2) S DAY=15
	6668	"RTN","RCC PCFN1",83, 0)
	6669	;
	6670	"RTN","RCC PCFN1",84, 0)
	6671	Q DAY
	6672	"RTN","RCC PCFN1",85, 0)
	6673	;
	6674	"RTN","RCC PCFN1",86, 0)
	6675	GRP8(LTR) ;T
	6676	"RTN","RCC PCFN1",87, 0)
	6677	;
	6678	"RTN","RCC PCFN1",88, 0)
	6679	I "ABCDE" [LTR(2) S DAY=19
	6680	"RTN","RCC PCFN1",89, 0)
	6681	I "FGH"[L TR(2) S DA Y=22
	6682	"RTN","RCC PCFN1",90, 0)
	6683	I "ABCDEF GH"'[LTR(2 ) S DAY=17
	6684	"RTN","RCC PCFN1",91, 0)
	6685	;
	6686	"RTN","RCC PCFN1",92, 0)
	6687	Q DAY
	6688	"RTN","RCC PCFN1",93, 0)
	6689	;
	6690	"RTN","RCC PCFN1",94, 0)
	6691	GRP9(LTR) ;R
	6692	"RTN","RCC PCFN1",95, 0)
	6693	;
	6694	"RTN","RCC PCFN1",96, 0)
	6695	S DAY=19
	6696	"RTN","RCC PCFN1",97, 0)
	6697	;
	6698	"RTN","RCC PCFN1",98, 0)
	6699	Q DAY
	6700	"RTN","RCC PCFN1",99, 0)
	6701	;
	6702	"RTN","RCC PCFN1",100 ,0)
	6703	GRP10(LTR) ;SV
	6704	"RTN","RCC PCFN1",101 ,0)
	6705	;
	6706	"RTN","RCC PCFN1",102 ,0)
	6707	I LTR(1)= "V" S DAY= 22
	6708	"RTN","RCC PCFN1",103 ,0)
	6709	I LTR(1)= "S" D
	6710	"RTN","RCC PCFN1",104 ,0)
	6711	. I "CHIM "[LTR(2) S DAY=22
	6712	"RTN","RCC PCFN1",105 ,0)
	6713	. I "CHIM "'[LTR(2) S DAY=21
	6714	"RTN","RCC PCFN1",106 ,0)
	6715	;
	6716	"RTN","RCC PCFN1",107 ,0)
	6717	Q DAY
	6718	"RTN","RCC PCFN1",108 ,0)
	6719	;
	6720	"RTN","RCC PCFN1",109 ,0)
	6721	GRP11(LTR) ;PUXYZ
	6722	"RTN","RCC PCFN1",110 ,0)
	6723	;
	6724	"RTN","RCC PCFN1",111 ,0)
	6725	S DAY=24
	6726	"RTN","RCC PCFN1",112 ,0)
	6727	;
	6728	"RTN","RCC PCFN1",113 ,0)
	6729	Q DAY
	6730	"RTN","RCC PCFN1",114 ,0)
	6731	;
	6732	"RTN","RCC PCFN1",115 ,0)
	6733	GRP12(LTR) ;W
	6734	"RTN","RCC PCFN1",116 ,0)
	6735	;
	6736	"RTN","RCC PCFN1",117 ,0)
	6737	S DAY=26
	6738	"RTN","RCC PCFN1",118 ,0)
	6739	;
	6740	"RTN","RCC PCFN1",119 ,0)
	6741	Q DAY
	6742	"RTN","RCC PCML")
	6743	0^8^B67061 934^B47881 024
	6744	"RTN","RCC PCML",1,0)
	6745	RCCPCML ;W ASH-ISC@AL TOONA,PA/L DB-Send CC PC transmi ssion ;12/ 19/96 4:1 6 PM
	6746	"RTN","RCC PCML",2,0)
	6747	V ;;4.5;Ac counts Rec eivable; 34,80,93,1 18,133,140 ,160,165,1 87,195,206 ,223,260,3 13;Mar 2 0,
	6748	1995;Build 131
	6749	"RTN","RCC PCML",3,0)
	6750	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	6751	"RTN","RCC PCML",4,0)
	6752	TRAN ;call from RCCP C TRANSMIT option to interacti vely allow transmiss ion of CCP C mesages
	6753	"RTN","RCC PCML",5,0)
	6754	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	6755	"RTN","RCC PCML",6,0)
	6756	N SDT,X,Y ,ZTRTN,ZTS AVE,ZTDESC ,ZTIO,IEN
	6757	"RTN","RCC PCML",7,0)
	6758	I '$D(^XU SEC("RCCPC TRANSMIT" ,DUZ)) W * 7,*7,!,"Yo u do not h ave access to do thi s." Q
	6759	"RTN","RCC PCML",8,0)
	6760	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6761	"RTN","RCC PCML",9,0)
	6762	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmit ted. Try again late r."
	6763	Q
	6764	"RTN","RCC PCML",10,0 )
	6765	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6766	"RTN","RCC PCML",11,0 )
	6767	S DIR(0)= "DAO^^K:'$ D(^RCPS(34 9.2,""STDT "",Y)) X"
	6768	"RTN","RCC PCML",12,0 )
	6769	S DIR("A" )="Enter s tatement d ate as it will appea r on these statement s: "
	6770	"RTN","RCC PCML",13,0 )
	6771	S DIR("?" )="Enter s tatement d ate as it will appea r on these statement s or ^ to exit."
	6772	"RTN","RCC PCML",14,0 )
	6773	D ^DIR
	6774	"RTN","RCC PCML",15,0 )
	6775	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	6776	"RTN","RCC PCML",16,0 )
	6777	; PRCA4. 5313 - Ch anged to a llow for s eparate da tes for st atements b ased upon last name
	6778	"RTN","RCC PCML",17,0 )
	6779	S SDT=Y
	6780	"RTN","RCC PCML",18,0 )
	6781	; PRCA4. 5313 - Un lock prior to quitti ng
	6782	"RTN","RCC PCML",19,0 )
	6783	;I '$D(^R CPS(349.2, "STDT",SDT )) W !,"Th ere is not a CCPC fi le for thi s date." L -^RCPS(34 9.2):DILOC KTM
	6784	Q
	6785	"RTN","RCC PCML",20,0 )
	6786	; PRCA4. 5313 - Un lock prior to quitti ng
	6787	"RTN","RCC PCML",21,0 )
	6788	S IEN=$O( ^RCPS(349. 2,"STDT",S DT,0)) I ' $P($P($G(^ RCPS(349.2 ,IEN,0))," ^",10),"." ) D Q
	6789	"RTN","RCC PCML",22,0 )
	6790	. W !,"Yo ur CBSS st atement fi le (349.2) is corrup ted. Pleas e rebuild it."
	6791	"RTN","RCC PCML",23,0 )
	6792	. L -^RCP S(349.2):D ILOCKTM
	6793	"RTN","RCC PCML",24,0 )
	6794	; PRCA4. 5313 - Un lock prior to jobbin g off
	6795	"RTN","RCC PCML",25,0 )
	6796	L -^RCPS( 349.2):DIL OCKTM
	6797	"RTN","RCC PCML",26,0 )
	6798	; PRCA4. 5313 - Al lows for m ultiple st atement da tes
	6799	"RTN","RCC PCML",27,0 )
	6800	S ZTSAVE( "SDT")=SDT ,ZTRTN="RE TRAN^RCCPC ML",ZTIO=" ",ZTDESC=" Re-transmi t CBSS pat ient
	6801	statements -user act ivated"
	6802	"RTN","RCC PCML",28,0 )
	6803	D ^%ZTLOA D
	6804	"RTN","RCC PCML",29,0 )
	6805	Q
	6806	"RTN","RCC PCML",30,0 )
	6807	;
	6808	"RTN","RCC PCML",31,0 )
	6809	EN(SDT) ;c alled from backgroun d job - PR CA4.5313 Added SDT for backg round job call
	6810	"RTN","RCC PCML",32,0 )
	6811	N DA,DIK, LPRINT
	6812	"RTN","RCC PCML",33,0 )
	6813	D NOW^%DT C
	6814	"RTN","RCC PCML",34,0 )
	6815	RETRAN N D A,DIK,ERRO R,RCT,X,X1 ,DEB
	6816	"RTN","RCC PCML",35,0 )
	6817	; PRCA4. 5313 - Pr ovides err or for inc omplete bu ild of 349 .2
	6818	"RTN","RCC PCML",36,0 )
	6819	S (ERROR, X)=0 F S X=$O(^RCPS (349.2,"ST DT",SDT,X) ) Q:'X I $G(^RCPS(3 49.2,X,6)) S ERROR=1 ,NM=0 D
	6820	ERROR Q
	6821	"RTN","RCC PCML",37,0 )
	6822	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with Error .
	6823	"RTN","RCC PCML",38,0 )
	6824	L +^RCPS( 349.2):DIL OCKTM I '$ T S ERROR= 11,NM=0 D ERROR
	6825	"RTN","RCC PCML",39,0 )
	6826	I $G(ERRO R) D EXIT Q
	6827	"RTN","RCC PCML",40,0 )
	6828	K ^TMP($J )
	6829	"RTN","RCC PCML",41,0 )
	6830	; PRCA4. 5313 - Re moves exis ting 349 f or this da te
	6831	"RTN","RCC PCML",42,0 )
	6832	S X1=0 F S X1=$O(^ RCT(349,"S DT",+$E(SD T,6,7),X1) ) Q:X1="" I $P($G(^ RCT(349,X1 ,0)),U,2)= "PS" S
	6833	DA=X1,DIK= "^RCT(349, " D ^DIK
	6834	"RTN","RCC PCML",43,0 )
	6835	F X="PA", "IS","IT" S RCT=$O(^ RCT(349.1, "B",X,0)) I RCT K ^R CT(349.1,+ RCT,4,+$E( SDT,6,7))
	6836	"RTN","RCC PCML",44,0 )
	6837	N
	6838	%,ADD,AMT, ERROR,L,LN ,M,MSG,MCT ,MPT1,MTOT ,NM,P,PD,P D0,PSN,PT, PT0,PHCT,R CM,RTY,TAM T,TMS
	6839	G,SZ,TRDES C
	6840	"RTN","RCC PCML",45,0 )
	6841	D DT^DICR W
	6842	"RTN","RCC PCML",46,0 )
	6843	S (ERROR, RTY)=0
	6844	"RTN","RCC PCML",47,0 )
	6845	S X=$O(^R CT(349.1," B","PS",0) )
	6846	"RTN","RCC PCML",48,0 )
	6847	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^",3)
	6848	"RTN","RCC PCML",49,0 )
	6849	I X']"" S ERROR=6,N M=0 D ERRO R,EXIT Q
	6850	"RTN","RCC PCML",50,0 )
	6851	D PHCT I 'PHCT S ER ROR=1,NM=0 D ERROR,E XIT Q
	6852	"RTN","RCC PCML",51,0 )
	6853	S MTOT=$O (^TMP($J," MCT",""),- 1)
	6854	"RTN","RCC PCML",52,0 )
	6855	; PRCA4. 5313 - Re set MTOT a nd MCT(1) for multip le dates o n one day
	6856	"RTN","RCC PCML",53,0 )
	6857	S MCT(1)= $O(^TMP($J ,"MCT","") )
	6858	"RTN","RCC PCML",54,0 )
	6859	S MTOT=MT OT-(MCT(1) -1)
	6860	"RTN","RCC PCML",55,0 )
	6861	S MCT(1)= 0
	6862	"RTN","RCC PCML",56,0 )
	6863	S MCT=0 F S MCT=$O (^TMP($J," MCT",MCT)) Q:'MCT D PS
	6864	"RTN","RCC PCML",57,0 )
	6865	EXIT D ERR ML^RCCPCML 1
	6866	"RTN","RCC PCML",58,0 )
	6867	K SDT,^TM P($J)
	6868	"RTN","RCC PCML",59,0 )
	6869	; PRCA4. 5313 - Un lock prior to exitin g
	6870	"RTN","RCC PCML",60,0 )
	6871	L -^RCPS( 349.2):DIL OCKTM
	6872	"RTN","RCC PCML",61,0 )
	6873	Q
	6874	"RTN","RCC PCML",62,0 )
	6875	;
	6876	"RTN","RCC PCML",63,0 )
	6877	F349 ;Get PS segment entry
	6878	"RTN","RCC PCML",64,0 )
	6879	N DA,D0,D IC,DLAYGO, X
	6880	"RTN","RCC PCML",65,0 )
	6881	S ERROR=0 K DD,DO S
	6882	DIC="^RCT( 349,",DIC( 0)="L",DLA YGO=349,X= "PS."_$TR( $$FMTE^XLF DT(DT,"2D" ),"/",".") _"."_RCM D
	6883	FILE^DICN
	6884	"RTN","RCC PCML",66,0 )
	6885	I Y<0 S R TY=RTY+1 G F349:RTY< 4 S ERROR= 2,NM=0 D E RROR Q
	6886	"RTN","RCC PCML",67,0 )
	6887	S PSN=+Y
	6888	"RTN","RCC PCML",68,0 )
	6889	Q
	6890	"RTN","RCC PCML",69,0 )
	6891	;
	6892	"RTN","RCC PCML",70,0 )
	6893	PS ;Build PS,PH,PD s egments an d messages
	6894	"RTN","RCC PCML",71,0 )
	6895	S PSN=$O( ^TMP($J,"M CT",MCT,0) )
	6896	"RTN","RCC PCML",72,0 )
	6897	; PRCA4. 5313 - In crement Co unter for internal s torage
	6898	"RTN","RCC PCML",73,0 )
	6899	S MCT(1)= MCT(1)+1
	6900	"RTN","RCC PCML",74,0 )
	6901	; PRCA4. 5313 - Up date to ne w formatti ng
	6902	"RTN","RCC PCML",75,0 )
	6903	S
	6904	$P(^RCT(34 9,+PSN,0), "^",3,10)= MCT(1)_"^" _MTOT_"^"_ $$SITE^RCM SITE()_"^" _$$FP^RCCP CFN_"^"_+^
	6905	TMP($J,"MC T",MCT)_"^ "_$P(^TMP( $J,"MCT",M CT),"^",2) _"^"_$$DAT ^RCCPCFN(S DT)_"^"_$$ DAT^RCCP
	6906	CFN(DT)
	6907	"RTN","RCC PCML",76,0 )
	6908	S LN=+PSN ,^TMP($J," MSG",LN)=$ P($G(^RCT( 349,+PSN,0 )),"^",2,1 0)_"^\|"
	6909	"RTN","RCC PCML",77,0 )
	6910	; Reforma t Statemen t Date to Internal F ormat
	6911	"RTN","RCC PCML",78,0 )
	6912	S $P(^RCT (349,+PSN, 0),"^",9)= SDT
	6913	"RTN","RCC PCML",79,0 )
	6914	S MPT1=$P (^TMP($J," MCT",MCT), "^",3)
	6915	"RTN","RCC PCML",80,0 )
	6916	; PRCA4. 5313 - Su btract num ber of rec ords from last recor d to find number bef ore file s tarting po int
	6917	"RTN","RCC PCML",81,0 )
	6918	S PT=MPT1 -$P(^TMP($ J,"MCT",MC T),"^",1)
	6919	"RTN","RCC PCML",82,0 )
	6920	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:PT=""
	6921	Q:PT=$O(^R CPS(349.2, +($P(^TMP( $J,"MCT",M CT),"^",3) ))) D
	6922	"RTN","RCC PCML",83,0 )
	6923	.Q:$D(^TM P($J,"ERRP T",+PT))
	6924	"RTN","RCC PCML",84,0 )
	6925	.S PT0=^R CPS(349.2, +PT,0)
	6926	"RTN","RCC PCML",85,0 )
	6927	. ; PRCA* 4.5*313 - Set DEB fr om PTO
	6928	"RTN","RCC PCML",86,0 )
	6929	. S DEB=$ P(PT0,"^")
	6930	"RTN","RCC PCML",87,0 )
	6931	.S LN=LN+ 1 S
	6932	^TMP($J,"M SG",LN)="P H^"_$$SITE ^RCMSITE_$ $KEY^RCCPC FN(+PT)_"^ "_$$NM^RCC PCFN(+PT)_ "^"
	6933	"RTN","RCC PCML",88,0 )
	6934	.S ADD=$G (^RCPS(349 .2,+PT,1))
	6935	"RTN","RCC PCML",89,0 )
	6936	.;
	6937	"RTN","RCC PCML",90,0 )
	6938	.;Remove special ch aracters c ausing pro blems (WIM -0402-2072 8)
	6939	"RTN","RCC PCML",91,0 )
	6940	.I ADD["~ " S ADD=$T R(ADD,"~", "") ;Remov e tilde
	6941	"RTN","RCC PCML",92,0 )
	6942	.I ADD["\| " S ADD=$T R(ADD,"\|", "") ;Remov e the pipe symbol
	6943	"RTN","RCC PCML",93,0 )
	6944	.;
	6945	"RTN","RCC PCML",94,0 )
	6946	.;Debtor needs larg e print (f ont) IF LP RINT=1
	6947	"RTN","RCC PCML",95,0 )
	6948	.S LPRINT =$G(^RCPS( 349.2,+PT, 7)) S:LPRI NT="" LPRI NT=0
	6949	"RTN","RCC PCML",96,0 )
	6950	.;
	6951	"RTN","RCC PCML",97,0 )
	6952	.F P=1:1: 7 S $P(^TM P($J,"MSG" ,LN),"^",P +5)=$S($P( ADD,"^",P) ]"":$P(ADD ,"^",P),1: "")
	6953	"RTN","RCC PCML",98,0 )
	6954	.S ^TMP($ J,"MSG",LN )=^TMP($J, "MSG",LN)_ "^"
	6955	"RTN","RCC PCML",99,0 )
	6956	.S LN=LN+ 1
	6957	"RTN","RCC PCML",100, 0)
	6958	.F X=4:1: 8 S $P(AMT ,"^",X-3)= $$HEX^RCCP CFN($P(PT0 ,"^",X))
	6959	"RTN","RCC PCML",101, 0)
	6960	.S
	6961	^TMP($J,"M SG",LN)=AM T_"^"_$G(^ RCPS(349.2 ,+PT,3))_" ^"_$G(^RCP S(349.2,+P T,4))_"^"_ $O(^RCPS(3 4
	6962	9.2,+PT,2, ""),-1)
	6963	"RTN","RCC PCML",102, 0)
	6964	.S LN=LN+ 1 I $P($G( ^RCD(340,+ DEB,0)),"; ") S
	6965	^TMP($J,"M SG",LN)="^ "_$$SITE^R CMSITE_$$R J^XLFSTR($ TR($P(^RCD (340,+DEB, 0),";"),". ",""),13,0 )
	6966	"RTN","RCC PCML",103, 0)
	6967	.; PRCA5 .4313 - S et ICN wit h Checksum , AR Flag, and Date of Latest Bill ino P H data
	6968	"RTN","RCC PCML",104, 0)
	6969	.N PT8 S PT8=$G(^RC PS(349.2,+ PT,8))
	6970	"RTN","RCC PCML",105, 0)
	6971	.S
	6972	^TMP($J,"M SG",LN)=$G (^TMP($J," MSG",LN))_ "^"_LPRINT _"^"_$P(PT 8,"^")_"V" _$P(PT8,"^ ",2,3)_"^" _$$
	6973	DAT^RCCPCF N($P(PT8," ^",4))_"^\| "
	6974	"RTN","RCC PCML",106, 0)
	6975	.S $P(^RC PS(349.2,+ PT,0),"^", 11)=+PSN
	6976	"RTN","RCC PCML",107, 0)
	6977	.S PD=0 F S PD=$O( ^RCPS(349. 2,+PT,2,PD )) Q:'PD I $D(^(PD, 0)) S PD0= ^(0) D
	6978	"RTN","RCC PCML",108, 0)
	6979	..S AMT(0 )=$$HEX^RC CPCFN($P(P D0,"^",3))
	6980	"RTN","RCC PCML",109, 0)
	6981	..;Replac e special characters causing p roblem (PR CA*260)
	6982	"RTN","RCC PCML",110, 0)
	6983	..S TRDES C=$P(PD0," ^",2)
	6984	"RTN","RCC PCML",111, 0)
	6985	..I TRDES C["~" S TR DESC=$TR(T RDESC,"~", " ") ;Rep lace tilde
	6986	"RTN","RCC PCML",112, 0)
	6987	..I TRDES C["\|" S TR DESC=$TR(T RDESC,"\|", " ") ;Rep lace the p ipe symbol
	6988	"RTN","RCC PCML",113, 0)
	6989	..S
	6990	LN=LN+1,^T MP($J,"MSG ",LN)="PD^ "_$$DAT^RC CPCFN(+PD0 )_"^"_TRDE SC_"^"_AMT (0)_"^"_$P (PD0,"^
	6991	",4)_"^\|"
	6992	"RTN","RCC PCML",114, 0)
	6993	S LN=LN+1 ,^TMP($J," MSG",LN)=" ~"
	6994	"RTN","RCC PCML",115, 0)
	6995	; PRCA4. 5313 - Se t all cros s-referenc es for Fil e
	6996	"RTN","RCC PCML",116, 0)
	6997	S DA=+PSN ,DIK="^RCT (349," D I X1^DIK
	6998	"RTN","RCC PCML",117, 0)
	6999	;
	7000	"RTN","RCC PCML",118, 0)
	7001	MAIL ;set up mail me ssage
	7002	"RTN","RCC PCML",119, 0)
	7003	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z
	7004	"RTN","RCC PCML",120, 0)
	7005	S XMSUB=$ $SITE^RCMS ITE()_" CB SS TRANSMI SSION "_SD T
	7006	"RTN","RCC PCML",121, 0)
	7007	S XMDUZ=" AR PACKAGE "
	7008	"RTN","RCC PCML",122, 0)
	7009	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),"^",12) S XMY("G. RCCPC
	7010	STATEMENTS ")=""
	7011	"RTN","RCC PCML",123, 0)
	7012	S X=$O(^R CT(349.1," B","PS",0) )
	7013	"RTN","RCC PCML",124, 0)
	7014	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S
	7015	X=$P($G(^R CT(349.1,+ X,3)),"^") _"@"_$P($G (^RCT(349. 1,+X,3))," ^",3) S:$P (X,"@",2)] "" XMY(X)= ""
	7016	"RTN","RCC PCML",125, 0)
	7017	I $P(X,"@ ",2)']"" D Q
	7018	"RTN","RCC PCML",126, 0)
	7019	.S ERROR= 6,NM=0 D E RROR
	7020	"RTN","RCC PCML",127, 0)
	7021	S XMDUZ=" AR PACKAGE "
	7022	"RTN","RCC PCML",128, 0)
	7023	D XMZ^XMA 2
	7024	"RTN","RCC PCML",129, 0)
	7025	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	7026	"RTN","RCC PCML",130, 0)
	7027	S $P(^RCT (349,+PSN, 0),"^",11, 12)=DT_"^" _XMZ
	7028	"RTN","RCC PCML",131, 0)
	7029	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) S
	7030	L=L+1,^XMB (3.9,+XMZ, 2,L,0)=^TM P($J,"MSG" ,L(1))
	7031	"RTN","RCC PCML",132, 0)
	7032	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_"^"_L_" ^"_DT
	7033	"RTN","RCC PCML",133, 0)
	7034	D ENT1^XM D
	7035	"RTN","RCC PCML",134, 0)
	7036	D NOW^%DT C
	7037	"RTN","RCC PCML",135, 0)
	7038	S $P(^RCT (349,+PSN, 0),"^",11, 12)=%_"^"_ XMZ
	7039	"RTN","RCC PCML",136, 0)
	7040	K ^TMP($J ,"MSG")
	7041	"RTN","RCC PCML",137, 0)
	7042	Q
	7043	"RTN","RCC PCML",138, 0)
	7044	;
	7045	"RTN","RCC PCML",139, 0)
	7046	PHCT ;PH c ount
	7047	"RTN","RCC PCML",140, 0)
	7048	S (ERROR, PT,PHCT,TA MT,SZ)=0,R CM=1
	7049	"RTN","RCC PCML",141, 0)
	7050	; PRCA4. 5313 - If last reco rd is for this date reset RCM to next va lue
	7051	"RTN","RCC PCML",142, 0)
	7052	N FINAL
	7053	"RTN","RCC PCML",143, 0)
	7054	S FINAL=$ O(^RCT(349 ,"@"),-1)
	7055	"RTN","RCC PCML",144, 0)
	7056	I FINAL,$ P($P(^RCT( 349,FINAL, 0),"^"),". ",2,4)=$TR ($$FMTE^XL FDT(DT,"2D "),"/","." ) S
	7057	RCM=$P($P( ^RCT(349,F INAL,0),"^ "),".",5)+ 1
	7058	"RTN","RCC PCML",145, 0)
	7059	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:'PT S E RROR=0 D I ERROR,(E RROR<3) Q
	7060	"RTN","RCC PCML",146, 0)
	7061	.; PRCA4 .5313 - S et DEB to Debtor num ber
	7062	"RTN","RCC PCML",147, 0)
	7063	.S DEB=$P ($G(^RCPS( 349.2,PT,0 )),"^")
	7064	"RTN","RCC PCML",148, 0)
	7065	.S SZ(1)= 0 D ERRCHK Q:ERROR
	7066	"RTN","RCC PCML",149, 0)
	7067	.S PT0=^R CPS(349.2, +PT,0)
	7068	"RTN","RCC PCML",150, 0)
	7069	.S PHCT=P HCT+1
	7070	"RTN","RCC PCML",151, 0)
	7071	.S SZ=550 +SZ,SZ(1)= 550
	7072	"RTN","RCC PCML",152, 0)
	7073	.S:$G(^RC PS(349.2,+ PT,1))]"" SZ=SZ+$L(^ (1)),SZ(1) =SZ(1)+$L( ^(1))
	7074	"RTN","RCC PCML",153, 0)
	7075	.S:$G(^RC PS(349.2,+ PT,3))]"" SZ=SZ+$L(^ (3))+1,SZ( 1)=SZ(1)+$ L(^(3))+1
	7076	"RTN","RCC PCML",154, 0)
	7077	.S:$G(^RC PS(349.2,+ PT,4))]"" SZ=SZ+$L(^ (4))+1,SZ( 1)=SZ(1)+$ L(^(4))+1
	7078	"RTN","RCC PCML",155, 0)
	7079	.S X=0 F S X=$O(^R CPS(349.2, +PT,2,X)) Q:'X I $D (^(X,0)) S SZ=$L(^(0 ))+SZ,SZ(1 )=SZ(1)+$L (^(0))
	7080	"RTN","RCC PCML",156, 0)
	7081	.S TAMT=T AMT+$P(^RC PS(349.2,+ PT,0),"^", 8)
	7082	"RTN","RCC PCML",157, 0)
	7083	.I SZ>270 00 D
	7084	"RTN","RCC PCML",158, 0)
	7085	..S RTY=0 D F349 Q: ERROR
	7086	"RTN","RCC PCML",159, 0)
	7087	..S TAMT= TAMT-$P(PT 0,"^",8)
	7088	"RTN","RCC PCML",160, 0)
	7089	..S TAMT= $$HEX^RCCP CFN(TAMT)
	7090	"RTN","RCC PCML",161, 0)
	7091	..S ^TMP( $J,"MCT",R CM)=(PHCT- 1)_"^"_TAM T_"^"_$O(^ RCPS(349.2 ,"STDT",SD T,PT),-1)_ "^"_(SZ-SZ (1))
	7092	"RTN","RCC PCML",162, 0)
	7093	..S ^TMP( $J,"MCT",R CM,+PSN)=" "
	7094	"RTN","RCC PCML",163, 0)
	7095	..S RCM=R CM+1,PHCT= 1
	7096	"RTN","RCC PCML",164, 0)
	7097	..S SZ=SZ (1)
	7098	"RTN","RCC PCML",165, 0)
	7099	..S TAMT= $P(PT0,"^" ,8)
	7100	"RTN","RCC PCML",166, 0)
	7101	I 'PT,$O( ^RCPS(349. 2,"STDT",S DT,0)) D
	7102	"RTN","RCC PCML",167, 0)
	7103	.S RTY=0 D F349 Q:E RROR S
	7104	^TMP($J,"M CT",RCM)=P HCT_"^"_$$ HEX^RCCPCF N(TAMT)_"^ "_$O(^RCPS (349.2,"ST DT",SDT,PT ),-1)
	7105	"RTN","RCC PCML",168, 0)
	7106	.S ^TMP($ J,"MCT",RC M,+PSN)=""
	7107	"RTN","RCC PCML",169, 0)
	7108	Q
	7109	"RTN","RCC PCML",170, 0)
	7110	;
	7111	"RTN","RCC PCML",171, 0)
	7112	ERROR ;ERR OR FILE
	7113	"RTN","RCC PCML",172, 0)
	7114	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	7115	"RTN","RCC PCML",173, 0)
	7116	N SSN
	7117	"RTN","RCC PCML",174, 0)
	7118	S SSN=$$S SN^RCFN01( +DEB)
	7119	"RTN","RCC PCML",175, 0)
	7120	I SSN'=-1 S ^TMP($J ,"ERROR",E RROR,NM,SS N)=""
	7121	"RTN","RCC PCML",176, 0)
	7122	Q
	7123	"RTN","RCC PCML",177, 0)
	7124	;
	7125	"RTN","RCC PCML",178, 0)
	7126	ERRCHK ;Er ror check
	7127	"RTN","RCC PCML",179, 0)
	7128	I '$D(^RC PS(349.2,+ PT,0)) S E RROR=1,NM= 0 D ERROR Q
	7129	"RTN","RCC PCML",180, 0)
	7130	S PT(1)=P T,PT=$O(^R CPS(349.2, "STDT",SDT ,0)) I '$P (^RCPS(349 .2,PT,0)," ^",18) S E RROR=1,NM= 0 D
	7131	ERROR S PT =PT(1) Q
	7132	"RTN","RCC PCML",181, 0)
	7133	S PT=PT(1 )
	7134	"RTN","RCC PCML",182, 0)
	7135	I $$KEY^R CCPCFN(+PT )']"" S ER ROR=4,NM=$ $NAM^RCFN0 1(+DEB) D ERROR S
	7136	^TMP($J,"E RRPT",+PT) ="" Q
	7137	"RTN","RCC PCML",183, 0)
	7138	I '$D(^RC PS(349.2," AKEY",$$KE Y^RCCPCFN( +PT))) S E RROR=4,NM= $$NAM^RCFN 01(+DEB) D ERROR S
	7139	^TMP($J,"E RRPT",+PT) ="" Q
	7140	"RTN","RCC PCML",184, 0)
	7141	S ADD=$G( ^RCPS(349. 2,+PT,1))
	7142	"RTN","RCC PCML",185, 0)
	7143	F P=1:1:7 S ADD(P)= $S($P(ADD, "^",P)]"": $P(ADD,"^" ,P),1:"")
	7144	"RTN","RCC PCML",186, 0)
	7145	I ADD(1)= "",ADD(2)= "",ADD(3)= "",ADD(4)= "",ADD(5)= "",ADD(6)= "" S
	7146	ERROR=8,NM =$$NAM^RCF N01(+DEB) D ERROR S ^TMP($J,"E RRPT",+PT) ="" Q
	7147	"RTN","RCC PCML",187, 0)
	7148	I ADD(1)= "",(ADD(2) =""),(ADD( 3)=""),(AD D(6)="") S ERROR=8,N M=$$NAM^RC FN01(+DEB) D ERROR S
	7149	^TMP($J,"E RRPT",+PT) ="" Q
	7150	"RTN","RCC PCML",188, 0)
	7151	I ADD(4)= ""!(ADD(5) ="")!(ADD( 6)="") S E RROR=8,NM= $$NAM^RCFN 01(+DEB) D ERROR S
	7152	^TMP($J,"E RRPT",+PT) =""
	7153	"RTN","RCC PCML",189, 0)
	7154	F ADD=1:1 :6 I ADD(A DD)'?.ANP S ERROR=10 ,NM=$$NAM^ RCFN01(+DE B),^TMP($J ,"ERRPT",+ PT)="" D
	7155	ERROR Q
	7156	"RTN","RCC PCML",190, 0)
	7157	I $P($G(^ RCD(340,+D EB,1)),"^" ,9) S ^TMP ($J,"ERRPT ",+PT)="", ERROR=9,NM =$$NAM^RCF N01(+DEB) D
	7158	ERROR
	7159	"RTN","RCC PCML",191, 0)
	7160	Q
	7161	"RTN","RCC PCML1")
	7162	0^13^B8980 051^B66823 35
	7163	"RTN","RCC PCML1",1,0 )
	7164	RCCPCML1 ; ALB@ALTOON A,PA/LDB - Send CCPC transmiss ion (cont. );8/25/00 4:16 PM
	7165	"RTN","RCC PCML1",2,0 )
	7166	V ;;4.5;Ac counts Rec eivable; 160,313; Mar 20, 19 95;Build 1 31
	7167	"RTN","RCC PCML1",3,0 )
	7168	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7169	"RTN","RCC PCML1",4,0 )
	7170	ERRML ;ERR OR MESSAGE S
	7171	"RTN","RCC PCML1",5,0 )
	7172	N CT,ERRO R,LN,PT,SP ,XMDUZ,XMT EXT,XMSUB, XMY
	7173	"RTN","RCC PCML1",6,0 )
	7174	K ^TMP($J ,"ERRMSG")
	7175	"RTN","RCC PCML1",7,0 )
	7176	S (ERROR, LN)=0 F S ERROR=$O( ^TMP($J,"E RROR",ERRO R)) Q:'ERR OR D
	7177	"RTN","RCC PCML1",8,0 )
	7178	. ; PRCA* 4.5*313 - Add header identifyi ng the Sta tement Dat e
	7179	"RTN","RCC PCML1",9,0 )
	7180	. I LN=0 S LN=LN+1 D
	7181	"RTN","RCC PCML1",10, 0)
	7182	. . N Y
	7183	"RTN","RCC PCML1",11, 0)
	7184	. . S Y=S DT X ^DD(" DD")
	7185	"RTN","RCC PCML1",12, 0)
	7186	. . S ^TM P($J,"ERRM SG",LN)="E RRORS FOR PATIENT ST ATEMENT DA TE: "_Y
	7187	"RTN","RCC PCML1",13, 0)
	7188	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	7189	"RTN","RCC PCML1",14, 0)
	7190	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=$P($T (ERRMSG+ER ROR),";;", 2)
	7191	"RTN","RCC PCML1",15, 0)
	7192	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	7193	"RTN","RCC PCML1",16, 0)
	7194	.S CT=0,P T="" F S PT=$O(^TMP ($J,"ERROR ",ERROR,PT )) Q:PT="" D
	7195	"RTN","RCC PCML1",17, 0)
	7196	..S CT=CT +1,LN=LN+1
	7197	"RTN","RCC PCML1",18, 0)
	7198	..I PT=0 S ^TMP($J, "ERRMSG",L N)=" " Q
	7199	"RTN","RCC PCML1",19, 0)
	7200	..N Y I P T'=0 D
	7201	"RTN","RCC PCML1",20, 0)
	7202	...S PT(1 )="" F S PT(1)=$O(^ TMP($J,"ER ROR",ERROR ,PT,PT(1)) ) Q:PT(1)= "" D
	7203	"RTN","RCC PCML1",21, 0)
	7204	....S ^TM P($J,"ERRM SG",LN)=$S ($L(CT)<2: " "_CT,1:C T)_". "
	7205	"RTN","RCC PCML1",22, 0)
	7206	....S SP= " ",Y=PT,Y= PT_$E(SP,$ L(PT),30)
	7207	"RTN","RCC PCML1",23, 0)
	7208	....S ^TM P($J,"ERRM SG",LN)=^T MP($J,"ERR MSG",LN)_Y _PT(1)
	7209	"RTN","RCC PCML1",24, 0)
	7210	S XMDUZ=" AR PACKAGE "
	7211	"RTN","RCC PCML1",25, 0)
	7212	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= ""
	7213	"RTN","RCC PCML1",26, 0)
	7214	E S XMY( $G(DUZ))=" "
	7215	"RTN","RCC PCML1",27, 0)
	7216	; PRCA4. 5313 - Ch ange CCPC to CBSS an d add Stat ement Date
	7217	"RTN","RCC PCML1",28, 0)
	7218	N Y S Y=S DT D DD^%D T S SDT=Y
	7219	"RTN","RCC PCML1",29, 0)
	7220	S XMSUB=" CBSS ERROR S FOUND DU RING TRANS MISSION"
	7221	"RTN","RCC PCML1",30, 0)
	7222	S XMTEXT= "^TMP($J," "ERRMSG"", "
	7223	"RTN","RCC PCML1",31, 0)
	7224	D ^XMD
	7225	"RTN","RCC PCML1",32, 0)
	7226	K ^TMP($J ,"ERRMSG")
	7227	"RTN","RCC PCML1",33, 0)
	7228	Q
	7229	"RTN","RCC PCML1",34, 0)
	7230	;
	7231	"RTN","RCC PCML1",35, 0)
	7232	ERRMSG ;E rror messa ges PRCA 4.5313 - Change CC PC to CBSS
	7233	"RTN","RCC PCML1",36, 0)
	7234	1 ;;CBSS t ransmissio n process found no r ecords or an incompl ete file. Contact IR M.
	7235	"RTN","RCC PCML1",37, 0)
	7236	2 ;;No CBS S transmis sion recor ds transmi tted. Chec k file 349 . Contact IRM.
	7237	"RTN","RCC PCML1",38, 0)
	7238	3 ;;Corrup ted PH seg ment has b een encoun tered for the follow ing patien t(s):
	7239	"RTN","RCC PCML1",39, 0)
	7240	4 ;;No key field in CBSS file for the fo llowing pa tient(s):
	7241	"RTN","RCC PCML1",40, 0)
	7242	5 ;;Mailma n message creation a borted. Pl ease conta ct IRM.
	7243	"RTN","RCC PCML1",41, 0)
	7244	6 ;;No tra nsmission sent. Defi ne REMOTE DOMAIN in AR TRANSMI SSION TYPE file (349 .1).
	7245	"RTN","RCC PCML1",42, 0)
	7246	7 ;;Print Acknowledg ements exi st. Transm ission can not be res ent.
	7247	"RTN","RCC PCML1",43, 0)
	7248	8 ;;Addres s informat ion is mis sing for t he followi ng patient (s):
	7249	"RTN","RCC PCML1",44, 0)
	7250	9 ;;Addres s is marke d as ADDRE SS UNKNOWN for the f ollowing p atient(s):
	7251	"RTN","RCC PCML1",45, 0)
	7252	10 ;;Corru pted Addre ss. Re-ent er address informati on for the following patient(s ):
	7253	"RTN","RCC PCML1",46, 0)
	7254	11 ;;File did not bu ild or tra nsmit due to another build or transmissi on running .
	7255	"RTN","RCC PCPS")
	7256	0^10^B1432 08369^B808 98915
	7257	"RTN","RCC PCPS",1,0)
	7258	RCCPCPS ;W ASH-ISC@AL TOONA,PA/N YB-Build P atient Sta tement Fil e ;12/19/9 6 4:14 PM
	7259	"RTN","RCC PCPS",2,0)
	7260	;;4.5;Acc ounts Rece ivable;3 4,70,80,48 ,104,116,1 49,170,181 ,190,223,2 37,219,265 ,301,313 ;Mar
	7261	20,1995;Bu ild 131
	7262	"RTN","RCC PCPS",3,0)
	7263	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	7264	"RTN","RCC PCPS",4,0)
	7265	EN(SDT) ; PRCA4.5 313 - For use when c alled by B ackground Job
	7266	"RTN","RCC PCPS",5,0)
	7267	;
	7268	"RTN","RCC PCPS",6,0)
	7269	EN1 ;FOR U SE WHEN BU ILDING PS FILE (SDT MUST BE AV AILABLE AS A LOCAL V ARIABLE)
	7270	"RTN","RCC PCPS",7,0)
	7271	; PRCA4. 5313 - Ve rify Patie nt Stateme nt days
	7272	"RTN","RCC PCPS",8,0)
	7273	D STDT
	7274	"RTN","RCC PCPS",9,0)
	7275	N
	7276	CCPC,CNT,D AT,DEB,DIK ,END,INADF L,LDT1,LDT 3,PCC,PRN, RCDATE,RCT ,SVADM,SVA MT,SVINT,S VOTH,SITE
	7277	,TXT,VAR,X ,%,REP,ERR OR,NM
	7278	"RTN","RCC PCPS",10,0 )
	7279	N RCINFUL L,RCINPART S COMM=0
	7280	"RTN","RCC PCPS",11,0 )
	7281	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	7282	"RTN","RCC PCPS",12,0 )
	7283	L +^RCPS( 349.2):DIL OCKTM I '$ T D Q
	7284	"RTN","RCC PCPS",13,0 )
	7285	. D NOW^% DTC S Y=% D DD^%DT
	7286	"RTN","RCC PCPS",14,0 )
	7287	. W Y W ! !,"Another date is b eing run o r transmit ted. Try again late r."
	7288	"RTN","RCC PCPS",15,0 )
	7289	. S ERROR =11,NM=0 D ERROR^RCC PCML,ERRML ^RCCPCML1
	7290	"RTN","RCC PCPS",16,0 )
	7291	; PRCA4. 5313 - Cl ear data f or date be ing create d
	7292	"RTN","RCC PCPS",17,0 )
	7293	D KILL^RC CPCPS1(SDT )
	7294	"RTN","RCC PCPS",18,0 )
	7295	; PRCA4. 5313 - Se t date to a month ag o and kill data for that date
	7296	"RTN","RCC PCPS",19,0 )
	7297	N OLDDT
	7298	"RTN","RCC PCPS",20,0 )
	7299	S OLDDT=$ $MONTHAGO^ RCCPCPS1(S DT)
	7300	"RTN","RCC PCPS",21,0 )
	7301	; PRCA4. 5313 - Mo ved to KIL L^RCCPCPS1
	7302	"RTN","RCC PCPS",22,0 )
	7303	D KILL^RC CPCPS1(OLD DT)
	7304	"RTN","RCC PCPS",23,0 )
	7305	;
	7306	"RTN","RCC PCPS",24,0 )
	7307	D DT^DICR W,SITE^PRC AGU
	7308	"RTN","RCC PCPS",25,0 )
	7309	I '$D(SIT E) W !!,"A R SITE PAR AMETER ENT RIES NOT D EFINED!",? 50 D Q
	7310	"RTN","RCC PCPS",26,0 )
	7311	. D NOW^% DTC S Y=% D DD^%DT W Y
	7312	"RTN","RCC PCPS",27,0 )
	7313	. W !!,"C OULD NOT P ROCESS AR PATIENT ST ATEMENTS"
	7314	"RTN","RCC PCPS",28,0 )
	7315	. ; PRCA* 4.5*313 - Unlock pri or to exit ing
	7316	"RTN","RCC PCPS",29,0 )
	7317	. L -^RCP S(349.2):D ILOCKTM
	7318	"RTN","RCC PCPS",30,0 )
	7319	;
	7320	"RTN","RCC PCPS",31,0 )
	7321	; PRCA4. 5313 - Cl ear ICN Er ror tempor ary storag e
	7322	"RTN","RCC PCPS",32,0 )
	7323	K ^TMP("I CNERROR",$ J)
	7324	"RTN","RCC PCPS",33,0 )
	7325	D NOW^%DT C S END=%
	7326	"RTN","RCC PCPS",34,0 )
	7327	S LDT1=$$ FPS^RCAMFN 01(DT,-1), RCDATE=DT
	7328	"RTN","RCC PCPS",35,0 )
	7329	S (CNT,DE B)=0,PRN=1
	7330	"RTN","RCC PCPS",36,0 )
	7331	F S DEB= $O(^RCD(34 0,"AC",+$E (SDT,6,7), DEB)) Q:DE B="" I $D (^RCD(340, "AB","DPT( ",DEB)) D
	7332	"RTN","RCC PCPS",37,0 )
	7333	. N AMT ,BBAL,BEG, BN,CAT,DES C,ETY,FC,N D,PAT,PBAL ,PC,PSIEN
	7334	"RTN","RCC PCPS",38,0 )
	7335	. N PDA T,PEND,ST, SVINT,SVAD M,SVOTH,AD DR,ARFLAG, DIC,FLBPD1 ,ICN
	7336	"RTN","RCC PCPS",39,0 )
	7337	. I $L( +$$SSN^RCF N01(DEB))< 5 Q
	7338	"RTN","RCC PCPS",40,0 )
	7339	. ;Chec k for Emer gency Resp onse Indic ator (ERI) Flag.
	7340	"RTN","RCC PCPS",41,0 )
	7341	. N RCD FN S RCDFN =+($P($G(^ RCD(340,DE B,0)),"^", 1)) I $$EM ERES^PRCAU TL(RCDFN)] "" Q
	7342	"RTN","RCC PCPS",42,0 )
	7343	. ; ini tialize va riables fo r CS - PRC A4.5301
	7344	"RTN","RCC PCPS",43,0 )
	7345	. N CSB B,CSTCH,CS TPC,CSPREV S (CSBB,C STCH,CSTPC )=0
	7346	"RTN","RCC PCPS",44,0 )
	7347	. ; PRC A^4.5*313 - If ICN i s null set to send e rror email
	7348	"RTN","RCC PCPS",45,0 )
	7349	. S ICN =$$GETICN^ MPIF001(RC DFN)
	7350	"RTN","RCC PCPS",46,0 )
	7351	. I $P( ICN,U)=-1 S ^TMP("IC NERROR",$J ,RCDFN)="" Q
	7352	"RTN","RCC PCPS",47,0 )
	7353	. S FLB PD1=$$FLBP D1
	7354	"RTN","RCC PCPS",48,0 )
	7355	. I FLB PD1="" Q
	7356	"RTN","RCC PCPS",49,0 )
	7357	. I $P( ^PRCA(430, FLBPD1,0), U,10)="" Q
	7358	"RTN","RCC PCPS",50,0 )
	7359	. S INA DFL=0
	7360	"RTN","RCC PCPS",51,0 )
	7361	. S (SV ADM,SVAMT, SVINT,SVOT H)=0
	7362	"RTN","RCC PCPS",52,0 )
	7363	. N REF ,SBAL,TBAL ,TN,TTY,X, Y
	7364	"RTN","RCC PCPS",53,0 )
	7365	. K ^TM P("PRCAGT" ,$J)
	7366	"RTN","RCC PCPS",54,0 )
	7367	. S BEG =+$$LST^RC FN01(DEB,2 )
	7368	"RTN","RCC PCPS",55,0 )
	7369	. S LDT 3=$S(BEG>0 :$$FPS^RCA MFN01($P(B EG,"."),-3 ),1:0)
	7370	"RTN","RCC PCPS",56,0 )
	7371	. I $P( BEG,".")'< $P(RCDATE, ".") Q
	7372	"RTN","RCC PCPS",57,0 )
	7373	. D NOW ^%DTC S EN D=%
	7374	"RTN","RCC PCPS",58,0 )
	7375	. I BEG <1 S PDAT= "",BEG=0,P BAL=0
	7376	"RTN","RCC PCPS",59,0 )
	7377	. I BEG S PDAT=BE G,BEG=9999 999.999999 -BEG,PBAL= 0 D PBAL^P RCAGU(DEB, .BEG,.PBAL ) ;get pre v bal
	7378	"RTN","RCC PCPS",60,0 )
	7379	. D EN^ PRCAGT(DEB ,BEG,.END)
	7380	"RTN","RCC PCPS",61,0 )
	7381	. S TBA L=0 D TBAL ^PRCAGT(DE B,.TBAL) ; get trans bal
	7382	"RTN","RCC PCPS",62,0 )
	7383	. S BBA L=0 D BBAL ^PRCAGU(DE B,.BBAL) ; get bill b al
	7384	"RTN","RCC PCPS",63,0 )
	7385	. ; ent ire accoun t has been referred to CS - PR CA4.5301
	7386	"RTN","RCC PCPS",64,0 )
	7387	. I CSB B,CSBB'<BB AL Q
	7388	"RTN","RCC PCPS",65,0 )
	7389	. S X=$ $PRE^PRCAG U(DEB) S P END=$P(X,U ,2),X=+X I X,BBAL D REF^PRCAGD (DEB,X,$G( REP)) Q
	7390	"RTN","RCC PCPS",66,0 )
	7391	. I BBA L=0,PEND,- PEND=PBAL+ TBAL Q
	7392	"RTN","RCC PCPS",67,0 )
	7393	. I BBA L'=(PBAL+T BAL) D EN^ PRCAGD(DEB ,BBAL,TBAL ,PBAL,BEG, $G(REP)) Q
	7394	"RTN","RCC PCPS",68,0 )
	7395	. I BBA L'>0,'$D(^ TMP("PRCAG T",$J,DEB) ) Q
	7396	"RTN","RCC PCPS",69,0 )
	7397	. I BBA L=0,$G(SIT E("ZERO")) Q
	7398	"RTN","RCC PCPS",70,0 )
	7399	. I BBA L<0,BBAL>- .99 Q
	7400	"RTN","RCC PCPS",71,0 )
	7401	. I BBA L'<0,'$D(^ XTMP("PRCA GU",$J,DEB )),'COMM Q ;third l etter prin ted,not co mment
	7402	"RTN","RCC PCPS",72,0 )
	7403	. S TBA L=TBAL+PBA L
	7404	"RTN","RCC PCPS",73,0 )
	7405	. ;adju st amounts to be fil ed in 349. 2 for CS b ills - PRC A4.5301
	7406	"RTN","RCC PCPS",74,0 )
	7407	. S TBA L=TBAL-CSB B ; reduce the total bill bala nce by CS balance
	7408	"RTN","RCC PCPS",75,0 )
	7409	. S CSP REV=CSBB-( CSTCH+CSTP C) ; compu te the CS previous b alance as the differ ence betwe en the bil l
	7410	balance an d the tran saction ba lance
	7411	"RTN","RCC PCPS",76,0 )
	7412	. S PBA L=PBAL-CSP REV ; redu ce the pre vious bala nce by the CS previo us balance
	7413	"RTN","RCC PCPS",77,0 )
	7414	. S TBA L("CH")=TB AL("CH")-C STCH ; red uce total charges by CS charge s
	7415	"RTN","RCC PCPS",78,0 )
	7416	. S TBA L("PC")=TB AL("PC")-C STPC ; red uce total credits by CS credit s
	7417	"RTN","RCC PCPS",79,0 )
	7418	. ;
	7419	"RTN","RCC PCPS",80,0 )
	7420	. I '$D (^RCPS(349 .2,0)) S ^ (0)="AR CB SS STATEME NTS^349.2I ^^"
	7421	"RTN","RCC PCPS",81,0 )
	7422	. S DIC ="^RCPS(34 9.2,",X=DE B,DA=.01,D IC(0)="" D FILE^DICN
	7423	"RTN","RCC PCPS",82,0 )
	7424	. S PSI EN=+Y
	7425	"RTN","RCC PCPS",83,0 )
	7426	. S ^RC PS(349.2,P SIEN,0)=DE B_"^"_$$SS N^RCFN01(D EB)_"^"
	7427	"RTN","RCC PCPS",84,0 )
	7428	. S ADD R=$$DADD^R CAMADD(DEB ,1) ;get p atient's a ddress, co nfidential if applic able
	7429	"RTN","RCC PCPS",85,0 )
	7430	. S ARF LAG="N" N X
	7431	"RTN","RCC PCPS",86,0 )
	7432	. S X=$ P($G(^RCD( 340,DEB,1) ),U,1,6) I ($P(X,U)' =""),($P(X ,U,4)'="") ,($P(X,U,5 )'=""),(($ P(X,U,6)'= "")) S
	7433	ARFLAG="Y"
	7434	"RTN","RCC PCPS",87,0 )
	7435	. S ^RC PS(349.2,P SIEN,1)=$P (ADDR,"^", 1,6)
	7436	"RTN","RCC PCPS",88,0 )
	7437	. S ST= $P(ADDR,"^ ",5)
	7438	"RTN","RCC PCPS",89,0 )
	7439	. S ^RC PS(349.2,P SIEN,7)=$P (^RCD(340, DEB,0),U,7 ) ;large p rint
	7440	"RTN","RCC PCPS",90,0 )
	7441	. ; PRC A4.5313 - Add four new eleme nts for CB SS
	7442	"RTN","RCC PCPS",91,0 )
	7443	. S $P( ^RCPS(349. 2,PSIEN,8) ,U)=$P(ICN ,"V")
	7444	"RTN","RCC PCPS",92,0 )
	7445	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,2)=$P(I CN,"V",2)
	7446	"RTN","RCC PCPS",93,0 )
	7447	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,3)=ARFL AG
	7448	"RTN","RCC PCPS",94,0 )
	7449	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,4)=""
	7450	"RTN","RCC PCPS",95,0 )
	7451	. I FLB PD1 S $P(^ RCPS(349.2 ,PSIEN,8), U,4)=$P(^P RCA(430,FL BPD1,0),U, 10)
	7452	"RTN","RCC PCPS",96,0 )
	7453	. I $G( ST)'="" S ST=$O(^DIC (5,"C",ST, 0))
	7454	"RTN","RCC PCPS",97,0 )
	7455	. I $G( ST)>90,'$P ($G(^DIC(5 ,ST,0)),"^ ",6) S FC= $P($G(^DIC (5,ST,0)), "^")
	7456	"RTN","RCC PCPS",98,0 )
	7457	. S $P( ^RCPS(349. 2,PSIEN,1) ,"^",7)=$G (FC) S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1) ,"^",5)="F X"
	7458	"RTN","RCC PCPS",99,0 )
	7459	. S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1) ,"^",6)=$P (ADDR,"^", 8)
	7460	"RTN","RCC PCPS",100, 0)
	7461	. D NOW ^%DTC S $P (^RCPS(349 .2,PSIEN,0 ),"^",10)= %
	7462	"RTN","RCC PCPS",101, 0)
	7463	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",3)=$$ NAM^RCFN01 (DEB)
	7464	"RTN","RCC PCPS",102, 0)
	7465	. S
	7466	$P(^RCPS(3 49.2,PSIEN ,0),"^",4, 7)=$S(TBAL '>0:0,1:TB AL)_"^"_PB AL_"^"_TBA L("CH")_"^ "_TBAL("PC "),$P(
	7467	^(0),"^",8 )=PBAL+TBA L("CH")+TB AL("PC")+T BAL("RF")
	7468	"RTN","RCC PCPS",103, 0)
	7469	. S
	7470	$P(^RCPS(3 49.2,PSIEN ,0),"^",13 ,17)=BBAL( "PB")_"^"_ BBAL("INT" )_"^"_BBAL ("ADM")_"^ "_BBAL("MF ")_
	7471	"^"_BBAL(" CT")
	7472	"RTN","RCC PCPS",104, 0)
	7473	. ;
	7474	"RTN","RCC PCPS",105, 0)
	7475	. N
	7476	RCBILLDA,R CDATA1,RCD EBTDA,RCDE SC,RCPSDA, RCTOTAL,RC TRANDA,RCT RDATE,VALU E,RCCOM1,R CCO
	7477	M2,RCCOM3
	7478	"RTN","RCC PCPS",106, 0)
	7479	. S RCD EBTDA=DEB
	7480	"RTN","RCC PCPS",107, 0)
	7481	. I '$D (^RCPS(349 .2,PSIEN,2 ,0)) S ^(0 )="^^^"
	7482	"RTN","RCC PCPS",108, 0)
	7483	. ;
	7484	"RTN","RCC PCPS",109, 0)
	7485	. S RCC OM1=$E($TR ($G(SITE(" COM1")),"~ \|^",""),1, 80),(RCCOM 2,RCCOM3)= ""
	7486	"RTN","RCC PCPS",110, 0)
	7487	. ; Add second co mment line for the G MT-reduced status
	7488	"RTN","RCC PCPS",111, 0)
	7489	. I $$G MT^PRCAGST (RCDEBTDA) S RCCOM2= "REDUCTION OF INPATI ENT COPAYM ENT DUE TO
	7490	GEOGRAPHIC MEANS TES T STATUS"
	7491	"RTN","RCC PCPS",112, 0)
	7492	. I TBA L'>0 S RCC OM3=" THI S IS NOT A BILL"
	7493	"RTN","RCC PCPS",113, 0)
	7494	. I RCC OM1'="",RC COM2'="" S $E(RCCOM1 ,80)=" " ; Make sure GMT messag e will be printed on
	7495	separate l ine.
	7496	"RTN","RCC PCPS",114, 0)
	7497	. S ^RC PS(349.2,P SIEN,3)=RC COM1_RCCOM 2_RCCOM3
	7498	"RTN","RCC PCPS",115, 0)
	7499	. ;
	7500	"RTN","RCC PCPS",116, 0)
	7501	. S RCP SDA=0 ; th is variabl e used to set the de scription on the PS segment
	7502	"RTN","RCC PCPS",117, 0)
	7503	. S RCT RDATE=0 F S RCTRDAT E=$O(^TMP( "PRCAGT",$ J,RCDEBTDA ,RCTRDATE) ) Q:'RCTRD ATE S
	7504	RCBILLDA=0 F S RCBI LLDA=$O(^T MP("PRCAGT ",$J,RCDEB TDA,RCTRDA TE,RCBILLD A)) Q:'RCB ILLDA D
	7505	"RTN","RCC PCPS",118, 0)
	7506	. . ; skip CS b ills/trans actions - PRCA4.53 01
	7507	"RTN","RCC PCPS",119, 0)
	7508	. . Q :$D(^PRCA( 430,"TCSP" ,RCBILLDA) )
	7509	"RTN","RCC PCPS",120, 0)
	7510	. . I $P($G(^RC PS(349.2,P SIEN,0))," ^",8)<0 S PC(75)=75
	7511	"RTN","RCC PCPS",121, 0)
	7512	. . I $P($G(^PR CA(430,RCB ILLDA,6)), "^",2)]"", ($P($G(^PR CA(430,RCB ILLDA,7)), "^")>0) S PC(1)="01"
	7513	"RTN","RCC PCPS",122, 0)
	7514	. . S CAT=$P($G (^PRCA(430 ,RCBILLDA, 0)),"^",2)
	7515	"RTN","RCC PCPS",123, 0)
	7516	. . S PC=$P($G( ^PRCA(430. 2,CAT,0)), "^",14)
	7517	"RTN","RCC PCPS",124, 0)
	7518	. . F X=1:1:100 I $P(PC," ,",X)'="" S PCC=$P(P C,",",X),P C(+PCC)=PC C Q:PCC=""
	7519	"RTN","RCC PCPS",125, 0)
	7520	. . S PC="",X=0 F S X=$O (PC(X)) Q: X="" I $G (PC(X))'=" " S PC=PC_ PC(X)
	7521	"RTN","RCC PCPS",126, 0)
	7522	. . S $P(^RCPS( 349.2,PSIE N,4),"^")= PC
	7523	"RTN","RCC PCPS",127, 0)
	7524	. . ;
	7525	"RTN","RCC PCPS",128, 0)
	7526	. . I $D(^TMP(" PRCAGT",$J ,RCDEBTDA, RCTRDATE,R CBILLDA,0) ) S AMT=+^ (0) I AMT D
	7527	"RTN","RCC PCPS",129, 0)
	7528	. . . ; get the descri ption for the bill
	7529	"RTN","RCC PCPS",130, 0)
	7530	. . . K RCDES C D BILLDE SC^RCCPCPS 1(RCBILLDA )
	7531	"RTN","RCC PCPS",131, 0)
	7532	. . . ;
	7533	"RTN","RCC PCPS",132, 0)
	7534	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	7535	"RTN","RCC PCPS",133, 0)
	7536	. . . S RCPSD A=RCPSDA+1
	7537	"RTN","RCC PCPS",134, 0)
	7538	. . . S
	7539	$P(^RCPS(3 49.2,PSIEN ,2,RCPSDA, 0),"^",1,4 )=$P(RCTRD ATE,".")_" ^"_$G(RCDE SC(1))_"^" _$G(AMT)_" ^"_$
	7540	P($G(^PRCA (430,RCBIL LDA,0)),"^ ")
	7541	"RTN","RCC PCPS",135, 0)
	7542	. . . F X=2:1 Q:$G(RCDE SC(X))="" S
	7543	RCPSDA=RCP SDA+1,^RCP S(349.2,PS IEN,2,RCPS DA,0)="^"_ RCDESC(X)_ "^^"
	7544	"RTN","RCC PCPS",136, 0)
	7545	. . ;
	7546	"RTN","RCC PCPS",137, 0)
	7547	. . S RCTRANDA= 0 F S
	7548	RCTRANDA=$ O(^TMP("PR CAGT",$J,R CDEBTDA,RC TRDATE,RCB ILLDA,RCTR ANDA)) D:' RCTRANDA N O
	7549	Q:'RCTRAND A D
	7550	"RTN","RCC PCPS",138, 0)
	7551	. . . ; get the descri ption for the transa ction
	7552	"RTN","RCC PCPS",139, 0)
	7553	. . . K RCDES C D TRANDE SC^RCCPCPS 1(RCTRANDA ),RCDESC
	7554	"RTN","RCC PCPS",140, 0)
	7555	. . . ; if i t is an in terest/adm in charge, summarize it below
	7556	"RTN","RCC PCPS",141, 0)
	7557	. . . I $G(RC DESC(1))[" INTEREST" Q
	7558	"RTN","RCC PCPS",142, 0)
	7559	. . . ; get the value of the tra nsaction f or the sta tement
	7560	"RTN","RCC PCPS",143, 0)
	7561	. . . S VALUE =$$TRANVAL U^RCDPBTLM (RCTRANDA)
	7562	"RTN","RCC PCPS",144, 0)
	7563	. . . S VALUE =$P(VALUE, "^",2)+$P( VALUE,"^", 3)+$P(VALU E,"^",4)+$ P(VALUE,"^ ",5)+$P(VA LUE,"^",6)
	7564	"RTN","RCC PCPS",145, 0)
	7565	. . . ; if i t is a sus pended (47 ) or unsus pended (46 ) transact ion, show value
	7566	"RTN","RCC PCPS",146, 0)
	7567	. . . ; make suspended charges a ppear as n egative
	7568	"RTN","RCC PCPS",147, 0)
	7569	. . . S RCDAT A1=$G(^PRC A(433,RCTR ANDA,1))
	7570	"RTN","RCC PCPS",148, 0)
	7571	. . . I $P(RC DATA1,"^", 2)=47!($P( RCDATA1,"^ ",2)=46) S VALUE=$P( RCDATA1,"^ ",5) I
	7572	$P(RCDATA1 ,"^",2)=47 S VALUE=- VALUE
	7573	"RTN","RCC PCPS",149, 0)
	7574	. . . ; if i t is an am ended bill , show val ue
	7575	"RTN","RCC PCPS",150, 0)
	7576	. . . I $P(RC DATA1,"^", 2)=33 S VA LUE=$P(RCD ATA1,"^",5 )
	7577	"RTN","RCC PCPS",151, 0)
	7578	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	7579	"RTN","RCC PCPS",152, 0)
	7580	. . . S RCPSD A=RCPSDA+1
	7581	"RTN","RCC PCPS",153, 0)
	7582	. . . S
	7583	$P(^RCPS(3 49.2,PSIEN ,2,RCPSDA, 0),"^",1,5 )=$P(RCTRD ATE,".")_" ^"_$G(RCDE SC(1))_"^" _VALUE_"^" _$P(
	7584	$G(^PRCA(4 30,RCBILLD A,0)),"^")
	7585	"RTN","RCC PCPS",154, 0)
	7586	. . . F X=2:1 Q:$G(RCDE SC(X))="" S
	7587	RCPSDA=RCP SDA+1,^RCP S(349.2,PS IEN,2,RCPS DA,0)="^"_ RCDESC(X)_ "^^"
	7588	"RTN","RCC PCPS",155, 0)
	7589	. . . ;
	7590	"RTN","RCC PCPS",156, 0)
	7591	. . . ; for comment tr ansaction ... not su re what th is is for ?
	7592	"RTN","RCC PCPS",157, 0)
	7593	. . . I $P(RC DATA1,"^", 2)=45,$P($ G(^PRCA(43 3,RCTRANDA ,5)),"^",2 )["your wa iver right s" S
	7594	^RCPS(349. 2,PSIEN,4) ="0150"
	7595	"RTN","RCC PCPS",158, 0)
	7596	. ;
	7597	"RTN","RCC PCPS",159, 0)
	7598	. ; if interest, admin, or other, ad d them her e
	7599	"RTN","RCC PCPS",160, 0)
	7600	. S X=$ G(RCTOTAL( "INT"))+$G (RCTOTAL(" ADM"))+$G( RCTOTAL("O TH"))
	7601	"RTN","RCC PCPS",161, 0)
	7602	. I X>0 D
	7603	"RTN","RCC PCPS",162, 0)
	7604	. . S RCDESC="I NTEREST/AD M. CHARGE (Int:"_$J( $G(RCTOTAL ("INT")),1 ,2)_"
	7605	Adm:"_$J($ G(RCTOTAL( "ADM")),1, 2)_" Other :"_$J($G(R CTOTAL("OT H")),1,2)_ ")"
	7606	"RTN","RCC PCPS",163, 0)
	7607	. . S RCPSDA=RC PSDA+1
	7608	"RTN","RCC PCPS",164, 0)
	7609	. . S ^RCPS(349 .2,PSIEN,2 ,RCPSDA,0) ="^"_RCDES C_"^"_$J(X ,1,2)
	7610	"RTN","RCC PCPS",165, 0)
	7611	. . S ^RCPS(349 .2,PSIEN,2 ,0)="^^"_R CPSDA_"^"_ RCPSDA
	7612	"RTN","RCC PCPS",166, 0)
	7613	. ;
	7614	"RTN","RCC PCPS",167, 0)
	7615	. ; PRC A4.5313 - Set stat ement date into cros s-referenc e
	7616	"RTN","RCC PCPS",168, 0)
	7617	. S $P( ^RCPS(349. 2,PSIEN,0) ,U,19)=SDT
	7618	"RTN","RCC PCPS",169, 0)
	7619	. ;
	7620	"RTN","RCC PCPS",170, 0)
	7621	. ; se t 0th node
	7622	"RTN","RCC PCPS",171, 0)
	7623	. I RCP SDA S ^RCP S(349.2,PS IEN,2,0)=" ^^"_RCPSDA _"^"_RCPSD A
	7624	"RTN","RCC PCPS",172, 0)
	7625	. ;
	7626	"RTN","RCC PCPS",173, 0)
	7627	. ; PRC A4.5313 - Set Cros s-Referenc es for thi s Debtor
	7628	"RTN","RCC PCPS",174, 0)
	7629	. S DA= PSIEN,DIK= "^RCPS(349 .2," D IX1 ^DIK
	7630	"RTN","RCC PCPS",175, 0)
	7631	. ;
	7632	"RTN","RCC PCPS",176, 0)
	7633	. ; PRC A4.5313 - Remove d ata for ea ch debtor
	7634	"RTN","RCC PCPS",177, 0)
	7635	. K ^XT MP("PRCAGU ",$J,DEB)
	7636	"RTN","RCC PCPS",178, 0)
	7637	. ;
	7638	"RTN","RCC PCPS",179, 0)
	7639	. I RCP SDA'<287 S ^XTMP("RC CPC",0)=DT ,(^XTMP("R CCPC",RCDE BTDA),^XTM P("RCCPC1" ,PSIEN))=" " Q
	7640	"RTN","RCC PCPS",180, 0)
	7641	. D NO
	7642	"RTN","RCC PCPS",181, 0)
	7643	;
	7644	"RTN","RCC PCPS",182, 0)
	7645	S PSIEN=0 S PSIEN=$ O(^RCPS(34 9.2,"STDT" ,SDT,PSIEN )) Q:PSIEN ="" S
	7646	$P(^RCPS(3 49.2,PSIEN ,0),"^",18 )=1
	7647	"RTN","RCC PCPS",183, 0)
	7648	;
	7649	"RTN","RCC PCPS",184, 0)
	7650	; PRCA4. 5313 - Se nd ICN Err or email i f necessar y
	7651	"RTN","RCC PCPS",185, 0)
	7652	I $D(^TMP ("ICNERROR ",$J)) D I CNERR^RCCP CPS1 K ^TM P("ICNERRO R",$J)
	7653	"RTN","RCC PCPS",186, 0)
	7654	;
	7655	"RTN","RCC PCPS",187, 0)
	7656	K COMM,TR ,TRNIEN
	7657	"RTN","RCC PCPS",188, 0)
	7658	;
	7659	"RTN","RCC PCPS",189, 0)
	7660	OSTM ;Proc ess old st atements
	7661	"RTN","RCC PCPS",190, 0)
	7662	S DIK="^R CPS(349.2, ",DA=0 F S DA=$O(^X TMP("RCCPC 1",DA)) Q: 'DA D ^DI K
	7663	"RTN","RCC PCPS",191, 0)
	7664	K DA,^XTM P("RCCPC1" )
	7665	"RTN","RCC PCPS",192, 0)
	7666	;
	7667	"RTN","RCC PCPS",193, 0)
	7668	STATMNT ;P rint patie nt stateme nts
	7669	"RTN","RCC PCPS",194, 0)
	7670	N IOP,ZTI O,ZTSAVE,Z TRTN,ZTDES C,ZTASK,%Z IS,ZTDTH,P RCADEV,POP
	7671	"RTN","RCC PCPS",195, 0)
	7672	S (IOP,PR CADEV)=$P( $G(^RC(342 ,1,0)),"^" ,8)
	7673	"RTN","RCC PCPS",196, 0)
	7674	I IOP]"" D
	7675	"RTN","RCC PCPS",197, 0)
	7676	.S ZTRTN= "STM^RCCPC STM",ZTDTH =$H,ZTDESC ="Print ol d AR State ments"
	7677	"RTN","RCC PCPS",198, 0)
	7678	.S %ZIS=" N0" D ^%ZI S Q:POP
	7679	"RTN","RCC PCPS",199, 0)
	7680	.S ZTSAVE ("PRCADEV" )="" D ^%Z TLOAD,^%ZI SC
	7681	"RTN","RCC PCPS",200, 0)
	7682	; PRCA4. 5313 - Un lock prior to exitin g
	7683	"RTN","RCC PCPS",201, 0)
	7684	L -^RCPS( 349.2):DIL OCKTM
	7685	"RTN","RCC PCPS",202, 0)
	7686	Q
	7687	"RTN","RCC PCPS",203, 0)
	7688	;
	7689	"RTN","RCC PCPS",204, 0)
	7690	NO ;If the re is no a ctivity
	7691	"RTN","RCC PCPS",205, 0)
	7692	I $G(^RCP S(349.2,PS IEN,4))["0 150" D
	7693	"RTN","RCC PCPS",206, 0)
	7694	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^NOTICE: Y ou now hav e delinque nt charges . Please^^ "
	7695	"RTN","RCC PCPS",207, 0)
	7696	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^review En forcement of Involun tary Colle ctions^^"
	7697	"RTN","RCC PCPS",208, 0)
	7698	.S ^RCPS( 349.2,PSIE N,2,3,0)=" ^on revers e.^^"
	7699	"RTN","RCC PCPS",209, 0)
	7700	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 3^3"
	7701	"RTN","RCC PCPS",210, 0)
	7702	I $G(^RCP S(349.2,PS IEN,2,1,0) )="" D
	7703	"RTN","RCC PCPS",211, 0)
	7704	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^No Activi ty in the Last 30 Da ys!^^"
	7705	"RTN","RCC PCPS",212, 0)
	7706	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^Please re fer to pre vious stat ement of r ights.^^"
	7707	"RTN","RCC PCPS",213, 0)
	7708	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 2^2"
	7709	"RTN","RCC PCPS",214, 0)
	7710	.I $G(^RC PS(349.2,P SIEN,4))=" " S ^(4)=" 90"
	7711	"RTN","RCC PCPS",215, 0)
	7712	Q
	7713	"RTN","RCC PCPS",216, 0)
	7714	BUILD ;Thi s is the e ntry point from the BUILD CCPC file opti on
	7715	"RTN","RCC PCPS",217, 0)
	7716	N TDT,QDT ,ZTDESC,ZT ASK,ZTSK,Z DTDTH,ZTIO ,ZTRTN,CNC L,%H,%DT,D IR,DTOUT
	7717	"RTN","RCC PCPS",218, 0)
	7718	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	7719	"RTN","RCC PCPS",219, 0)
	7720	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmit ted. Try again late r."
	7721	Q
	7722	"RTN","RCC PCPS",220, 0)
	7723	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	7724	"RTN","RCC PCPS",221, 0)
	7725	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7726	"RTN","RCC PCPS",222, 0)
	7727	S DIR(0)= "DAO^^D:"" ,1,2,4,6,7 ,8,10,12,1 4,15,17,19 ,21,22,24, 26,""'[("" ,""_+$E(Y, 6,7)_"","" )
	7728	BLDERR^RCC PCPS"
	7729	"RTN","RCC PCPS",223, 0)
	7730	S DIR("A" )="Enter a Patient S tatement d ate for th is build: "
	7731	"RTN","RCC PCPS",224, 0)
	7732	S DIR("?" )="Enter a Patient S tatement d ate for th is build o r ^ to exi t."
	7733	"RTN","RCC PCPS",225, 0)
	7734	D ^DIR
	7735	"RTN","RCC PCPS",226, 0)
	7736	; PRCA4. 5313 - Un lock prior to quitti ng
	7737	"RTN","RCC PCPS",227, 0)
	7738	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	7739	"RTN","RCC PCPS",228, 0)
	7740	S SDT=Y
	7741	"RTN","RCC PCPS",229, 0)
	7742	S TDT=$O( ^RCPS(349. 2,"STDT",S DT,0)) I T DT D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$D (DIROUT) Q
	7743	"RTN","RCC PCPS",230, 0)
	7744	.S TDT=$T R($$SLH^RC FN01(SDT), "/","")
	7745	"RTN","RCC PCPS",231, 0)
	7746	.W *7,!!, "The Patie nt Stateme nts for ", $E(TDT,1,2 )_"/"_$E(T DT,3,4)_"/ "_$E(TDT,5 ,8)
	7747	"RTN","RCC PCPS",232, 0)
	7748	.I $D(^RC T(349,"SDT ",+$E(SDT, 6,7))) D
	7749	"RTN","RCC PCPS",233, 0)
	7750	..S TDT=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",+ $E(SDT,6,7 ),0)),0)," ^",10)
	7751	"RTN","RCC PCPS",234, 0)
	7752	..S TDT=$ TR($$SLH^R CFN01(TDT) ,"/","")
	7753	"RTN","RCC PCPS",235, 0)
	7754	..W " wer e transmit ted on ",$ E(TDT,1,2) _"/"_$E(TD T,3,4)_"/" _$E(TDT,5, 8)_"."
	7755	"RTN","RCC PCPS",236, 0)
	7756	.E W " d o not have a transmi ssion date !"
	7757	"RTN","RCC PCPS",237, 0)
	7758	.W !!,">> PLEASE CO NTACT CUST OMER SUPPO RT BEFORE PROCEEDING <<",!!
	7759	"RTN","RCC PCPS",238, 0)
	7760	.N DIR,DT OUT,DUOUT, DIRUT,DIRO UT
	7761	"RTN","RCC PCPS",239, 0)
	7762	.S DIR(0) ="E",DIR(" A")=" Pres s ENTER to Continue with Build or ^ to E xit" D ^DI R
	7763	"RTN","RCC PCPS",240, 0)
	7764	.I $D(DTO UT)!$D(DUO UT)!$D(DIR UT)!$D(DIR OUT) L -^R CPS(349.2) :DILOCKTM Q
	7765	"RTN","RCC PCPS",241, 0)
	7766	; PRCA4. 5313 - Un lock prior to jobbin g off
	7767	"RTN","RCC PCPS",242, 0)
	7768	L -^RCPS( 349.2):DIL OCKTM
	7769	"RTN","RCC PCPS",243, 0)
	7770	I $D(DIRU T) K SDT Q
	7771	"RTN","RCC PCPS",244, 0)
	7772	TIME S ZTI O="",ZTRTN ="EN1^RCCP CPS",ZTDES C="Build C BSS Statem ent File"
	7773	"RTN","RCC PCPS",245, 0)
	7774	S ZTDTH=" ",ZTSAVE(" SDT")=SDT D ^%ZTLOAD Q:$G(ZTSK )=""
	7775	"RTN","RCC PCPS",246, 0)
	7776	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	7777	"RTN","RCC PCPS",247, 0)
	7778	; PRCA5. 4313 - Al low run an y time
	7779	"RTN","RCC PCPS",248, 0)
	7780	;I (QDT>D T_"."_0800 )&(QDT<(DT _"."_1801) ) D G TIM E
	7781	"RTN","RCC PCPS",249, 0)
	7782	;.W !!,*7 ,"You Can Not Queue this Job B etween 8:0 0am and 6: 00pm.",!
	7783	"RTN","RCC PCPS",250, 0)
	7784	;.D KILL^ %ZTLOAD
	7785	"RTN","RCC PCPS",251, 0)
	7786	W !,"Queu ed for Bui lding."
	7787	"RTN","RCC PCPS",252, 0)
	7788	; PRCA4. 5313 - Un lock prior to quitti ng
	7789	"RTN","RCC PCPS",253, 0)
	7790	L -^RCPS( 349.2):DIL OCKTM
	7791	"RTN","RCC PCPS",254, 0)
	7792	Q
	7793	"RTN","RCC PCPS",255, 0)
	7794	;
	7795	"RTN","RCC PCPS",256, 0)
	7796	RCDESC ;Re move "IN P ART" & "IN FULL" fro m the the bill descr iption
	7797	"RTN","RCC PCPS",257, 0)
	7798	QUIT:$G(R CDESC(1))= ""
	7799	"RTN","RCC PCPS",258, 0)
	7800	S RCINFUL L=" (IN FU LL)"
	7801	"RTN","RCC PCPS",259, 0)
	7802	S RCINPAR T=" (IN PA RT)"
	7803	"RTN","RCC PCPS",260, 0)
	7804	I RCDESC( 1)[RCINFUL L S RCDESC (1)=$P(RCD ESC(1),RCI NFULL)_$P( RCDESC(1), RCINFULL,2 )
	7805	"RTN","RCC PCPS",261, 0)
	7806	I RCDESC( 1)[RCINPAR T S RCDESC (1)=$P(RCD ESC(1),RCI NPART)_$P( RCDESC(1), RCINPART,2 )
	7807	"RTN","RCC PCPS",262, 0)
	7808	Q
	7809	"RTN","RCC PCPS",263, 0)
	7810	FLBPD1() ; PRCA4.5 313 - Retu rn last bi ll prep da te
	7811	"RTN","RCC PCPS",264, 0)
	7812	N X1,X2 S X1="" I ' $D(^PRCA(4 30,"ATD",R CDFN)) Q X 1
	7813	"RTN","RCC PCPS",265, 0)
	7814	S X2=$O(^ PRCA(430," ATD",RCDFN ,X1),-1)
	7815	"RTN","RCC PCPS",266, 0)
	7816	S X1=$O(^ PRCA(430," ATD",RCDFN ,X2,X1),-1 )
	7817	"RTN","RCC PCPS",267, 0)
	7818	Q X1
	7819	"RTN","RCC PCPS",268, 0)
	7820	BLDERR ; PRCA4.53 13 - Print Error and Kill X
	7821	"RTN","RCC PCPS",269, 0)
	7822	W !!,"INV ALID STATE MENT DATE"
	7823	"RTN","RCC PCPS",270, 0)
	7824	K X
	7825	"RTN","RCC PCPS",271, 0)
	7826	Q
	7827	"RTN","RCC PCPS",272, 0)
	7828	STDT ; En try point for PRCA4 .5313 ver ify Patien t Statemen t date dep endent upo n the Pati ent Last
	7829	Name
	7830	"RTN","RCC PCPS",273, 0)
	7831	N DEBT,DI E
	7832	"RTN","RCC PCPS",274, 0)
	7833	S DIE="^R CD(340,"
	7834	"RTN","RCC PCPS",275, 0)
	7835	S DEBT=""
	7836	"RTN","RCC PCPS",276, 0)
	7837	F S DEBT =$O(^RCD(3 40,"AB","D PT(",DEBT) ) Q:DEBT=" " D
	7838	"RTN","RCC PCPS",277, 0)
	7839	.N PAT,DP T,NAME,DA, DR
	7840	"RTN","RCC PCPS",278, 0)
	7841	.S PAT=$P ($G(^RCD(3 40,DEBT,0) ),U)
	7842	"RTN","RCC PCPS",279, 0)
	7843	.S DPT=$P (PAT,";",1 )
	7844	"RTN","RCC PCPS",280, 0)
	7845	.S NAME=$ P($G(^DPT( DPT,0)),U)
	7846	"RTN","RCC PCPS",281, 0)
	7847	.S DA=DEB T
	7848	"RTN","RCC PCPS",282, 0)
	7849	.S DR=".0 3////"_+$$ ACSET^RCCP CFN1(NAME)
	7850	"RTN","RCC PCPS",283, 0)
	7851	.I +$$ACS ET^RCCPCFN 1(NAME)'=$ P($G(^RCD( 340,DEBT,0 )),3) D ^D IE
	7852	"RTN","RCC PCPS",284, 0)
	7853	; Set cro ss-referen ce in AR E vent (341) if Patien t Statemen t date exi sts
	7854	"RTN","RCC PCPS",285, 0)
	7855	N DA,DIK
	7856	"RTN","RCC PCPS",286, 0)
	7857	S DIK="^R C(341,"
	7858	"RTN","RCC PCPS",287, 0)
	7859	S DA="" F S DA=$O( ^RC(341,DA )) Q:DA="" I $G(^RC (341,DA,6) )'="" D IX 1^DIK
	7860	"RTN","RCC PCPS",288, 0)
	7861	Q
	7862	"RTN","RCC PCPS1")
	7863	0^11^B6544 3378^B3737 0113
	7864	"RTN","RCC PCPS1",1,0 )
	7865	RCCPCPS1 ; WISC/RFJ-b uild descr iption for patient s tatement ; 08 Aug 200 1
	7866	"RTN","RCC PCPS1",2,0 )
	7867	;;4.5;Acc ounts Rece ivable;3 4,48,104,1 70,176,192 ,265,313 ;Mar 20, 1 995;Build 131
	7868	"RTN","RCC PCPS1",3,0 )
	7869	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7870	"RTN","RCC PCPS1",4,0 )
	7871	Q
	7872	"RTN","RCC PCPS1",5,0 )
	7873	;
	7874	"RTN","RCC PCPS1",6,0 )
	7875	;
	7876	"RTN","RCC PCPS1",7,0 )
	7877	TRANDESC(R CTRANDA,RC WIDTH) ; build the descriptio n array fo r a transa ction
	7878	"RTN","RCC PCPS1",8,0 )
	7879	;
	7880	"RTN","RCC PCPS1",9,0 )
	7881	; initia lize
	7882	"RTN","RCC PCPS1",10, 0)
	7883	N DESCRIP T,RCBILLDA ,RCCATEG,R CCATTXT,RC DATA0,RCDA TA1,RCDATA 3,RCLINE,T RANTYPE,X
	7884	"RTN","RCC PCPS1",11, 0)
	7885	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	7886	"RTN","RCC PCPS1",12, 0)
	7887	K RCDESC
	7888	"RTN","RCC PCPS1",13, 0)
	7889	S RCLINE= 1,RCDESC(1 )=""
	7890	"RTN","RCC PCPS1",14, 0)
	7891	;
	7892	"RTN","RCC PCPS1",15, 0)
	7893	S RCBILLD A=+$P($G(^ PRCA(433,R CTRANDA,0) ),"^",2) I 'RCBILLDA Q
	7894	"RTN","RCC PCPS1",16, 0)
	7895	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	7896	"RTN","RCC PCPS1",17, 0)
	7897	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	7898	"RTN","RCC PCPS1",18, 0)
	7899	S RCDATA1 =^PRCA(433 ,RCTRANDA, 1)
	7900	"RTN","RCC PCPS1",19, 0)
	7901	S TRANTYP E=$P(RCDAT A1,"^",2)
	7902	"RTN","RCC PCPS1",20, 0)
	7903	;
	7904	"RTN","RCC PCPS1",21, 0)
	7905	; build the first line descr iption
	7906	"RTN","RCC PCPS1",22, 0)
	7907	; if tra nsaction t ype is an increase o r decrease , set desc ription
	7908	"RTN","RCC PCPS1",23, 0)
	7909	I TRANTYP E=1!(TRANT YPE=35) D
	7910	"RTN","RCC PCPS1",24, 0)
	7911	. ; if c means t est, set d escription to catego ry for c m eans test
	7912	"RTN","RCC PCPS1",25, 0)
	7913	. I RCC ATEG=18 S
	7914	DESCRIPT=$ S($P(RCDAT A0,"^",16) :$P(^PRCA( 430.2,$P(R CDATA0,"^" ,16),0),"^ "),1:RCCAT TXT) Q
	7915	"RTN","RCC PCPS1",26, 0)
	7916	. ; ot herwise, s et to cate gory name
	7917	"RTN","RCC PCPS1",27, 0)
	7918	. S DES CRIPT=RCCA TTXT
	7919	"RTN","RCC PCPS1",28, 0)
	7920	;
	7921	"RTN","RCC PCPS1",29, 0)
	7922	; if the bill cate gory is a rx-copay a nd it is a n increase adjustmen t
	7923	"RTN","RCC PCPS1",30, 0)
	7924	; then s et the des cription t o copay
	7925	"RTN","RCC PCPS1",31, 0)
	7926	I RCCATEG =22!(RCCAT EG=23),TRA NTYPE=1 S DESCRIPT=" COPAY"
	7927	"RTN","RCC PCPS1",32, 0)
	7928	;
	7929	"RTN","RCC PCPS1",33, 0)
	7930	; if the bill cate gory is ad ult day he alth care, remove he alth
	7931	"RTN","RCC PCPS1",34, 0)
	7932	I RCCATEG =33 S DESC RIPT="ADUL T DAY CARE "
	7933	"RTN","RCC PCPS1",35, 0)
	7934	;
	7935	"RTN","RCC PCPS1",36, 0)
	7936	; if the bill cate gory is re spite or g eriatric e val,
	7937	"RTN","RCC PCPS1",37, 0)
	7938	; take t he 2nd pie ce removin g institut ional
	7939	"RTN","RCC PCPS1",38, 0)
	7940	I RCCATEG =35!(RCCAT EG=36)!(RC CATEG=37)! (RCCATEG=3 8) S DESCR IPT=$P(RCC ATTXT,"-
	7941	")_$S(RCCA TEG=35!(RC CATEG=37): " IN",1:" OUT")_"PAT IENT"
	7942	"RTN","RCC PCPS1",39, 0)
	7943	;
	7944	"RTN","RCC PCPS1",40, 0)
	7945	; if it is a comme nt transac tion
	7946	"RTN","RCC PCPS1",41, 0)
	7947	I TRANTYP E=45 S DES CRIPT="COM MENT: "_$P ($G(^PRCA( 433,RCTRAN DA,5)),"^" ,2)
	7948	"RTN","RCC PCPS1",42, 0)
	7949	;
	7950	"RTN","RCC PCPS1",43, 0)
	7951	; prepay ment bill (1=increas e, 35=decr ease, othe rwise refu nd)
	7952	"RTN","RCC PCPS1",44, 0)
	7953	I RCCATEG =26 S DESC RIPT=$S(TR ANTYPE=1:" OVERPAYMEN T CREDIT", TRANTYPE=3 5:"OVERPAY MENT
	7954	CREDIT DEC REASE",1:" OVERPAYMEN T REFUND")
	7955	"RTN","RCC PCPS1",45, 0)
	7956	;
	7957	"RTN","RCC PCPS1",46, 0)
	7958	; if the first lin e descript ion not se t (like pa yments), s et it
	7959	"RTN","RCC PCPS1",47, 0)
	7960	; to the type of t ransaction
	7961	"RTN","RCC PCPS1",48, 0)
	7962	I $G(DESC RIPT)="" S DESCRIPT= $P($G(^PRC A(430.3,+$ P(RCDATA1, "^",2),0)) ,"^")
	7963	"RTN","RCC PCPS1",49, 0)
	7964	;
	7965	"RTN","RCC PCPS1",50, 0)
	7966	; if the transacti on date is different from the process da te,
	7967	"RTN","RCC PCPS1",51, 0)
	7968	; show i t with the descripti on
	7969	"RTN","RCC PCPS1",52, 0)
	7970	I $P(RCDA TA1,"^"),$ P($P(RCDAT A1,"^"),". ")'=$P($P( RCDATA1,"^ ",9),".") S DESCRIPT =DESCRIPT_ "
	7971	("_$$DATE( $P($P(RCDA TA1,"^")," ."))_")"
	7972	"RTN","RCC PCPS1",53, 0)
	7973	;
	7974	"RTN","RCC PCPS1",54, 0)
	7975	; set th e first de scription line
	7976	"RTN","RCC PCPS1",55, 0)
	7977	D SETDESC (DESCRIPT)
	7978	"RTN","RCC PCPS1",56, 0)
	7979	;
	7980	"RTN","RCC PCPS1",57, 0)
	7981	; if it is a payme nt transac tion, show amount pa id interes t, admin, other
	7982	"RTN","RCC PCPS1",58, 0)
	7983	I TRANTYP E=2!(TRANT YPE=34) D
	7984	"RTN","RCC PCPS1",59, 0)
	7985	. S RCD ATA3=$G(^P RCA(433,RC TRANDA,3))
	7986	"RTN","RCC PCPS1",60, 0)
	7987	. ; if not inter est, admin , or other , quit
	7988	"RTN","RCC PCPS1",61, 0)
	7989	. I '$P (RCDATA3," ^",2),'$P( RCDATA3,"^ ",3),'$P(R CDATA3,"^" ,4),'$P(RC DATA3,"^", 5) Q
	7990	"RTN","RCC PCPS1",62, 0)
	7991	. ;
	7992	"RTN","RCC PCPS1",63, 0)
	7993	. S DES CRIPT=" ( Int:"_$J(+ $P(RCDATA3 ,"^",2),1, 2)_" Adm: "_$J(+$P(R CDATA3,"^" ,3),1,2)
	7994	"RTN","RCC PCPS1",64, 0)
	7995	. ; ca lculate ot her
	7996	"RTN","RCC PCPS1",65, 0)
	7997	. S X=$ P(RCDATA1, "^",5)-$P( RCDATA3,"^ ")-$P(RCDA TA3,"^",2) -$P(RCDATA 3,"^",3)
	7998	"RTN","RCC PCPS1",66, 0)
	7999	. S DES CRIPT=DESC RIPT_$S(X: " Other:"_ $J(X,1,2)_ ")",1:")")
	8000	"RTN","RCC PCPS1",67, 0)
	8001	. D SET DESC(DESCR IPT)
	8002	"RTN","RCC PCPS1",68, 0)
	8003	;
	8004	"RTN","RCC PCPS1",69, 0)
	8005	; if it is a admin cost or i nterest ch arge, tota l the amou nts
	8006	"RTN","RCC PCPS1",70, 0)
	8007	I TRANTYP E=13!(TRAN TYPE=12) D Q
	8008	"RTN","RCC PCPS1",71, 0)
	8009	. S X=$ G(^PRCA(43 3,RCTRANDA ,2)) I X=" " Q
	8010	"RTN","RCC PCPS1",72, 0)
	8011	. S RCT OTAL("INT" )=$G(RCTOT AL("INT")) +$P(X,"^", 7)
	8012	"RTN","RCC PCPS1",73, 0)
	8013	. S RCT OTAL("ADM" )=$G(RCTOT AL("ADM")) +$P(X,"^", 8)
	8014	"RTN","RCC PCPS1",74, 0)
	8015	. S RCT OTAL("OTH" )=$G(RCTOT AL("OTH")) +($P(RCDAT A1,"^",5)- $P(X,"^",7 )-$P(X,"^" ,8))
	8016	"RTN","RCC PCPS1",75, 0)
	8017	;
	8018	"RTN","RCC PCPS1",76, 0)
	8019	; if not an increa se adjustm ent, quit
	8020	"RTN","RCC PCPS1",77, 0)
	8021	I TRANTYP E'=1 Q
	8022	"RTN","RCC PCPS1",78, 0)
	8023	;
	8024	"RTN","RCC PCPS1",79, 0)
	8025	; increa se to c me ans test, ltc or rx- copay, get data from ib
	8026	"RTN","RCC PCPS1",80, 0)
	8027	I RCCATEG =18!(RCCAT EG=22)!(RC CATEG=23)! ((RCCATEG> 32)&(RCCAT EG<40)) D
	8028	"RTN","RCC PCPS1",81, 0)
	8029	. S X=" IBRFN1" X ^%ZOSF("TE ST") I '$T Q
	8030	"RTN","RCC PCPS1",82, 0)
	8031	. K ^TM P("IBRFN1" ,$J)
	8032	"RTN","RCC PCPS1",83, 0)
	8033	. D STM T^IBRFN1(R CTRANDA)
	8034	"RTN","RCC PCPS1",84, 0)
	8035	. D IBD ATA
	8036	"RTN","RCC PCPS1",85, 0)
	8037	Q
	8038	"RTN","RCC PCPS1",86, 0)
	8039	;
	8040	"RTN","RCC PCPS1",87, 0)
	8041	;
	8042	"RTN","RCC PCPS1",88, 0)
	8043	; Return s RCDESC(1 ..n) array of Bill D escription
	8044	"RTN","RCC PCPS1",89, 0)
	8045	BILLDESC(R CBILLDA,RC WIDTH) ;
	8046	"RTN","RCC PCPS1",90, 0)
	8047	; initia lize
	8048	"RTN","RCC PCPS1",91, 0)
	8049	N DESCRIP T,RCCATEG, RCCATTXT,R CDATA0,RCL INE,X
	8050	"RTN","RCC PCPS1",92, 0)
	8051	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	8052	"RTN","RCC PCPS1",93, 0)
	8053	K RCDESC
	8054	"RTN","RCC PCPS1",94, 0)
	8055	S RCLINE= 1,RCDESC(1 )=""
	8056	"RTN","RCC PCPS1",95, 0)
	8057	;
	8058	"RTN","RCC PCPS1",96, 0)
	8059	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	8060	"RTN","RCC PCPS1",97, 0)
	8061	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	8062	"RTN","RCC PCPS1",98, 0)
	8063	;
	8064	"RTN","RCC PCPS1",99, 0)
	8065	; if cat egory=c me ans test, set the de scription and quit
	8066	"RTN","RCC PCPS1",100 ,0)
	8067	I RCCATEG =18 S
	8068	DESCRIPT=$ S($P(RCDAT A0,"^",16) :$P(^PRCA( 430.2,$P(R CDATA0,"^" ,16),0),"^ "),1:RCCAT TXT) D
	8069	SETDESC(DE SCRIPT) Q
	8070	"RTN","RCC PCPS1",101 ,0)
	8071	;
	8072	"RTN","RCC PCPS1",102 ,0)
	8073	; set th e category descripti on
	8074	"RTN","RCC PCPS1",103 ,0)
	8075	D SETDESC (RCCATTXT)
	8076	"RTN","RCC PCPS1",104 ,0)
	8077	;
	8078	"RTN","RCC PCPS1",105 ,0)
	8079	; if cat egory not champva su bsitence a nd not tri care patie nt, quit
	8080	"RTN","RCC PCPS1",106 ,0)
	8081	I RCCATEG '=27,RCCAT EG'=31 Q
	8082	"RTN","RCC PCPS1",107 ,0)
	8083	;
	8084	"RTN","RCC PCPS1",108 ,0)
	8085	; build descriptio n for cham pva subsis tence and tricare pa tient bill s
	8086	"RTN","RCC PCPS1",109 ,0)
	8087	; get da ta from ib
	8088	"RTN","RCC PCPS1",110 ,0)
	8089	S X="IBRF N1" X ^%ZO SF("TEST") I '$T Q
	8090	"RTN","RCC PCPS1",111 ,0)
	8091	K ^TMP("I BRFN1",$J)
	8092	"RTN","RCC PCPS1",112 ,0)
	8093	D STMTB^I BRFN1($P(R CDATA0,"^" ))
	8094	"RTN","RCC PCPS1",113 ,0)
	8095	D IBDATA
	8096	"RTN","RCC PCPS1",114 ,0)
	8097	Q
	8098	"RTN","RCC PCPS1",115 ,0)
	8099	;
	8100	"RTN","RCC PCPS1",116 ,0)
	8101	;
	8102	"RTN","RCC PCPS1",117 ,0)
	8103	IBDATA ; get data f rom IB for descripti on
	8104	"RTN","RCC PCPS1",118 ,0)
	8105	N IBDATA, IBJ
	8106	"RTN","RCC PCPS1",119 ,0)
	8107	;
	8108	"RTN","RCC PCPS1",120 ,0)
	8109	; show I B data
	8110	"RTN","RCC PCPS1",121 ,0)
	8111	S IBJ=0 F S IBJ=$O (^TMP("IBR FN1",$J,IB J)) Q:'IBJ S IBDATA =^TMP("IBR FN1",$J,IB J) D
	8112	"RTN","RCC PCPS1",122 ,0)
	8113	. ;
	8114	"RTN","RCC PCPS1",123 ,0)
	8115	. ; if no drug o r bill dat e returned from IB, then it is outpatien t
	8116	"RTN","RCC PCPS1",124 ,0)
	8117	. I $P( IBDATA,"^" ,3)="" D:$ P(IBDATA," ^",2) SETD ESC("VISIT DATE: "_$ $DATE($P(I BDATA,"^", 2))) Q
	8118	"RTN","RCC PCPS1",125 ,0)
	8119	. ;
	8120	"RTN","RCC PCPS1",126 ,0)
	8121	. ; if no drug q uantity re turned fro m ib, then it is inp atient
	8122	"RTN","RCC PCPS1",127 ,0)
	8123	. I '$P (IBDATA,"^ ",6) D Q
	8124	"RTN","RCC PCPS1",128 ,0)
	8125	. . I $P(IBDATA ,"^",2) D SETDESC(" ADMISSION DATE: "_$ $DATE($P(I BDATA,"^", 2)))
	8126	"RTN","RCC PCPS1",129 ,0)
	8127	. . I $P(IBDATA ,"^",3) D SETDESC(" BEGINNING DATE OF B ILLING CYC LE: "_$$DA TE($P(IBDA TA,"^",3)) )
	8128	"RTN","RCC PCPS1",130 ,0)
	8129	. . I $P(IBDATA ,"^",4) D SETDESC(" ENDING DA TE OF BILL ING CYCLE: "_$$DATE( $P(IBDATA, "^",4)))
	8130	"RTN","RCC PCPS1",131 ,0)
	8131	. . I $P(IBDATA ,"^",5) D SETDESC(" DISCHARGE DATE: "_$ $DATE($P(I BDATA,"^", 5)))
	8132	"RTN","RCC PCPS1",132 ,0)
	8133	. ;
	8134	"RTN","RCC PCPS1",133 ,0)
	8135	. ; ph armacy
	8136	"RTN","RCC PCPS1",134 ,0)
	8137	. D:$P( IBDATA,"^" ,2) SETDES C("RX:"_$P (IBDATA,"^ ",2))
	8138	"RTN","RCC PCPS1",135 ,0)
	8139	. D:$P( IBDATA,"^" ,7) SETDES C("FD:"_$$ DATE($P(IB DATA,"^",7 )))
	8140	"RTN","RCC PCPS1",136 ,0)
	8141	. ;
	8142	"RTN","RCC PCPS1",137 ,0)
	8143	. ; if not patie nt stateme nt detail, quit
	8144	"RTN","RCC PCPS1",138 ,0)
	8145	. I $$D ET^RCFN01( $P(RCDATA0 ,"^",9))'= 2 Q
	8146	"RTN","RCC PCPS1",139 ,0)
	8147	. ;
	8148	"RTN","RCC PCPS1",140 ,0)
	8149	. ; re turn pharm acy detail
	8150	"RTN","RCC PCPS1",141 ,0)
	8151	. I $P( IBDATA,"^" ,3)'="" D SETDESC(" DRUG:"_$TR ($P(IBDATA ,"^",3),"\| ~"))
	8152	"RTN","RCC PCPS1",142 ,0)
	8153	. I $P( IBDATA,"^" ,4) D SETD ESC(" DAYS :"_$P(IBDA TA,"^",4))
	8154	"RTN","RCC PCPS1",143 ,0)
	8155	. I $P( IBDATA,"^" ,6) D SETD ESC(" QTY: "_$P(IBDAT A,"^",6))
	8156	"RTN","RCC PCPS1",144 ,0)
	8157	. I $P( IBDATA,"^" ,5)'="" D SETDESC(" PHY:"_$P(I BDATA,"^", 5))
	8158	"RTN","RCC PCPS1",145 ,0)
	8159	. I $P( IBDATA,"^" ,8) D SETD ESC(" CHG: $"_$J($P(I BDATA,"^", 8),0,2))
	8160	"RTN","RCC PCPS1",146 ,0)
	8161	;
	8162	"RTN","RCC PCPS1",147 ,0)
	8163	K ^TMP("I BRFN1",$J)
	8164	"RTN","RCC PCPS1",148 ,0)
	8165	Q
	8166	"RTN","RCC PCPS1",149 ,0)
	8167	;
	8168	"RTN","RCC PCPS1",150 ,0)
	8169	;
	8170	"RTN","RCC PCPS1",151 ,0)
	8171	; Add lin e to the d escription , not long er than RC WIDTH
	8172	"RTN","RCC PCPS1",152 ,0)
	8173	; Input: RCLINE,RCW IDTH
	8174	"RTN","RCC PCPS1",153 ,0)
	8175	; Output: RCDESC
	8176	"RTN","RCC PCPS1",154 ,0)
	8177	SETDESC(DE SCRIPT) N LENGTH
	8178	"RTN","RCC PCPS1",155 ,0)
	8179	; calcul ate the le ngth of th e descript ion
	8180	"RTN","RCC PCPS1",156 ,0)
	8181	S LENGTH= $L(RCDESC( RCLINE))+$ L(DESCRIPT )
	8182	"RTN","RCC PCPS1",157 ,0)
	8183	I RCDESC( RCLINE)'=" " S LENGTH =LENGTH+1
	8184	"RTN","RCC PCPS1",158 ,0)
	8185	;
	8186	"RTN","RCC PCPS1",159 ,0)
	8187	; the de scription line canno t go over RCWIDTH ch aracters
	8188	"RTN","RCC PCPS1",160 ,0)
	8189	I LENGTH< RCWIDTH S RCDESC(RCL INE)=RCDES C(RCLINE)_ $S(RCDESC( RCLINE)="" :"",1:" ") _DESCRIPT Q
	8190	"RTN","RCC PCPS1",161 ,0)
	8191	;
	8192	"RTN","RCC PCPS1",162 ,0)
	8193	; Descrip tion line to add is over RCWID TH
	8194	"RTN","RCC PCPS1",163 ,0)
	8195	; The giv en string will be sp litted _on ly_ if the limit is more than 44 charact ers.
	8196	"RTN","RCC PCPS1",164 ,0)
	8197	I $L(DESC RIPT)>RCWI DTH D Q
	8198	"RTN","RCC PCPS1",165 ,0)
	8199	. I RCD ESC(RCLINE )'="" S RC LINE=RCLIN E+1
	8200	"RTN","RCC PCPS1",166 ,0)
	8201	. S RCD ESC(RCLINE )=$E(DESCR IPT,1,RCWI DTH)
	8202	"RTN","RCC PCPS1",167 ,0)
	8203	. S RCL INE=RCLINE +1
	8204	"RTN","RCC PCPS1",168 ,0)
	8205	. S RCD ESC(RCLINE )=$E(DESCR IPT,RCWIDT H+1,2*RCWI DTH)
	8206	"RTN","RCC PCPS1",169 ,0)
	8207	;
	8208	"RTN","RCC PCPS1",170 ,0)
	8209	; over R CWIDTH cha racters, s tart new l ine
	8210	"RTN","RCC PCPS1",171 ,0)
	8211	I RCDESC( RCLINE)'=" " S RCLINE =RCLINE+1
	8212	"RTN","RCC PCPS1",172 ,0)
	8213	S RCDESC( RCLINE)=DE SCRIPT
	8214	"RTN","RCC PCPS1",173 ,0)
	8215	Q
	8216	"RTN","RCC PCPS1",174 ,0)
	8217	;
	8218	"RTN","RCC PCPS1",175 ,0)
	8219	DATE(FMDT) ; format date mm/d d/yyyy
	8220	"RTN","RCC PCPS1",176 ,0)
	8221	I 'FMDT Q ""
	8222	"RTN","RCC PCPS1",177 ,0)
	8223	N X,Y,%DT S %DT="TX ",X=FMDT D ^%DT Q:Y< 0 ""
	8224	"RTN","RCC PCPS1",178 ,0)
	8225	Q $E(FMDT ,4,5)_"/"_ $E(FMDT,6, 7)_"/"_(17 00+$E(FMDT ,1,3))
	8226	"RTN","RCC PCPS1",179 ,0)
	8227	;
	8228	"RTN","RCC PCPS1",180 ,0)
	8229	KILL(SDT) ; PRCA4 .5313 - k ill data p rior to re creating f or this da y of month
	8230	"RTN","RCC PCPS1",181 ,0)
	8231	;
	8232	"RTN","RCC PCPS1",182 ,0)
	8233	; Set dat e back one month
	8234	"RTN","RCC PCPS1",183 ,0)
	8235	N IEN,X,R CT,DA,DIK, ACK
	8236	"RTN","RCC PCPS1",184 ,0)
	8237	;
	8238	"RTN","RCC PCPS1",185 ,0)
	8239	S IEN=""
	8240	"RTN","RCC PCPS1",186 ,0)
	8241	F S IEN= $O(^RCPS(3 49.2,"STDT ",SDT,IEN) ) Q:IEN="" S DA=IEN ,DIK="^RCP S(349.2," D ^DIK
	8242	"RTN","RCC PCPS1",187 ,0)
	8243	;
	8244	"RTN","RCC PCPS1",188 ,0)
	8245	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T D
	8246	"RTN","RCC PCPS1",189 ,0)
	8247	. S ACK=" " F S ACK =$O(^RCT(3 49.1,RCT,4 ,"STDT4",S DT,ACK)) Q :ACK="" D
	8248	"RTN","RCC PCPS1",190 ,0)
	8249	. . S IEN =0 F S IE N=$O(^RCT( 349.1,RCT, 4,"STDT4", SDT,ACK,IE N)) Q:IEN= "" S
	8250	DA=IEN,DIK ="^RCT(349 .1,"_RCT_" ,4," D ^DI K K ^RCT(3 49.1,RCT,4 ,"STDT4",S DT,ACK,IEN )
	8251	"RTN","RCC PCPS1",191 ,0)
	8252	. S IEN=0 F S IEN= $O(^RCT(34 9.1,RCT,5, "STDT5",SD T,IEN)) Q: IEN="" S
	8253	DA=IEN,DIK ="^RCT(349 .1,"_RCT_" ,5," D ^DI K K ^RCT(3 49.1,RCT,5 ,"STDT5",S DT,IEN)
	8254	"RTN","RCC PCPS1",192 ,0)
	8255	;
	8256	"RTN","RCC PCPS1",193 ,0)
	8257	K ^XTMP(" RCCPC")
	8258	"RTN","RCC PCPS1",194 ,0)
	8259	;
	8260	"RTN","RCC PCPS1",195 ,0)
	8261	Q
	8262	"RTN","RCC PCPS1",196 ,0)
	8263	;
	8264	"RTN","RCC PCPS1",197 ,0)
	8265	MONTHAGO(S DT) ; PRC A4.5313 - Return d ate one mo nth prior to entered date - SD T is state ment
	8266	date
	8267	"RTN","RCC PCPS1",198 ,0)
	8268	; and Sta tement dat e cannot e xceed 26th day of th e month.
	8269	"RTN","RCC PCPS1",199 ,0)
	8270	; New OLD DT in call ing routin e
	8271	"RTN","RCC PCPS1",200 ,0)
	8272	S OLDDT=S DT-100
	8273	"RTN","RCC PCPS1",201 ,0)
	8274	I $E(SDT, 4,5)="01" S OLDDT=($ E(SDT,1,3) -1)_12_$E( SDT,6,7)
	8275	"RTN","RCC PCPS1",202 ,0)
	8276	Q OLDDT
	8277	"RTN","RCC PCPS1",203 ,0)
	8278	;
	8279	"RTN","RCC PCPS1",204 ,0)
	8280	ICNERR ; PRCA4.5 313 - Send email to RCCPC STAT EMENTS Mai l Group wi th all mis sing ICNs
	8281	"RTN","RCC PCPS1",205 ,0)
	8282	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ,XMY, DFN,CNT,I
	8283	"RTN","RCC PCPS1",206 ,0)
	8284	;
	8285	"RTN","RCC PCPS1",207 ,0)
	8286	; Create Message at MSG level of tempor ary storag e
	8287	"RTN","RCC PCPS1",208 ,0)
	8288	S CNT=1,^ TMP("ICNER ROR",$J,"M SG",CNT)=" The Patien t Statemen ts for the se patient s were not sent
	8289	to CBSS du e to a"
	8290	"RTN","RCC PCPS1",209 ,0)
	8291	S CNT=2,^ TMP("ICNER ROR",$J,"M SG",CNT)=" missing IC N."
	8292	"RTN","RCC PCPS1",210 ,0)
	8293	S CNT=3,^ TMP("ICNER ROR",$J,"M SG",CNT)=" NAME SSN"
	8294	"RTN","RCC PCPS1",211 ,0)
	8295	S CNT=4,^ TMP("ICNER ROR",$J,"M SG",CNT)=" ========== ========== ========== ========== ======"
	8296	"RTN","RCC PCPS1",212 ,0)
	8297	S DFN="" F S DFN=$ O(^TMP("IC NERROR",$J ,DFN)) Q:D FN="" Q:D FN="MSG" D
	8298	"RTN","RCC PCPS1",213 ,0)
	8299	. N DPTDA TA,NAME
	8300	"RTN","RCC PCPS1",214 ,0)
	8301	. S DPTDA TA=$G(^DPT (DFN,0))
	8302	"RTN","RCC PCPS1",215 ,0)
	8303	. I DPTDA TA="" Q
	8304	"RTN","RCC PCPS1",216 ,0)
	8305	. S NAME= $P(DPTDATA ,U)
	8306	"RTN","RCC PCPS1",217 ,0)
	8307	. I $L(NA ME)<35 S $ E(NAME,35) =" "
	8308	"RTN","RCC PCPS1",218 ,0)
	8309	. S CNT=C NT+1
	8310	"RTN","RCC PCPS1",219 ,0)
	8311	. S ^TMP( "ICNERROR" ,$J,"MSG", CNT)=NAME_ $P(DPTDATA ,U,9)
	8312	"RTN","RCC PCPS1",220 ,0)
	8313	;
	8314	"RTN","RCC PCPS1",221 ,0)
	8315	S XMDUZ=D UZ
	8316	"RTN","RCC PCPS1",222 ,0)
	8317	S XMTO(DU Z)=""
	8318	"RTN","RCC PCPS1",223 ,0)
	8319	S XMTO("G .RCCPC STA TEMENTS")= ""
	8320	"RTN","RCC PCPS1",224 ,0)
	8321	S XMSUBJ= "PATIENTS WITH MISSI NG ICNS"
	8322	"RTN","RCC PCPS1",225 ,0)
	8323	S XMBODY= "^TMP(""IC NERROR"",$ J,""MSG"") "
	8324	"RTN","RCC PCPS1",226 ,0)
	8325	S XMINSTR ("FLAGS")= "X"
	8326	"RTN","RCC PCPS1",227 ,0)
	8327	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	8328	"RTN","RCC PCPS1",228 ,0)
	8329	Q
	8330	"RTN","RCC PCSE")
	8331	0^14^B1650 7603^B5810 439
	8332	"RTN","RCC PCSE",1,0)
	8333	RCCPCSE ;W ASH-ISC@AL TOONA,PA/L DB - CCPC Statements Errors;5/ 30/96 10: 20 AM ;10/ 16/96 8:4 2
	8334	AM
	8335	"RTN","RCC PCSE",2,0)
	8336	V ;;4.5;Ac counts Rec eivable; 34,313;M ar 20, 199 5;Build 13 1
	8337	"RTN","RCC PCSE",3,0)
	8338	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8339	"RTN","RCC PCSE",4,0)
	8340	;
	8341	"RTN","RCC PCSE",5,0)
	8342	K ^TMP($J )
	8343	"RTN","RCC PCSE",6,0)
	8344	N ADD,DIR ,DIRUT,ERR ,ERROR,HDR ,LINE,LN,P G,POP,PT,X ,X1,Y,%ZIS ,Z,ZTRTN,Z TDESC,%,%Y ,ZTSAVE
	8345	"RTN","RCC PCSE",7,0)
	8346	I '$O(^RC PS(349.2," AD","E",0) ) W !,"THE RE ARE NO CBSS PATIE NT STATEME NT ERRORS" Q
	8347	"RTN","RCC PCSE",8,0)
	8348	E W !,"C BSS PATIEN T STATEMEN T ERROR RE PORT"
	8349	"RTN","RCC PCSE",9,0)
	8350	N IEN,%D, DTOUT,SDT, SDAT,TMPQ, ALL,DTPT
	8351	"RTN","RCC PCSE",10,0 )
	8352	S (TMPQ,A LL)=0
	8353	"RTN","RCC PCSE",11,0 )
	8354	S IEN="" F S IEN=$ O(^RCPS(34 9.2,"AD"," E",IEN)) Q :IEN="" I $G(^RCPS( 349.2,IEN, 5))'="" D
	8355	"RTN","RCC PCSE",12,0 )
	8356	. S SDT=$ P(^RCPS(34 9.2,IEN,0) ,U,19)
	8357	"RTN","RCC PCSE",13,0 )
	8358	. S DTPT( SDT,IEN)=" "
	8359	"RTN","RCC PCSE",14,0 )
	8360	. S DTPT( SDT)=$G(DT PT(SDT))+1
	8361	"RTN","RCC PCSE",15,0 )
	8362	; PRCA4. 5313 - As k about al l dates or specific
	8363	"RTN","RCC PCSE",16,0 )
	8364	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8365	"RTN","RCC PCSE",17,0 )
	8366	S DIR(0)= "YAO"
	8367	"RTN","RCC PCSE",18,0 )
	8368	S DIR("B" )="Y"
	8369	"RTN","RCC PCSE",19,0 )
	8370	S DIR("A" )="Do you want to pr int errors for all d ates avail able? "
	8371	"RTN","RCC PCSE",20,0 )
	8372	D ^DIR
	8373	"RTN","RCC PCSE",21,0 )
	8374	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8375	"RTN","RCC PCSE",22,0 )
	8376	I Y=1 S A LL=1 D PRI NT Q
	8377	"RTN","RCC PCSE",23,0 )
	8378	; PRCA4. 5313 - Ad d date pro mpts
	8379	"RTN","RCC PCSE",24,0 )
	8380	W !,"The following dates have errors to print:"
	8381	"RTN","RCC PCSE",25,0 )
	8382	S SDT="" F S SDT=$ O(DTPT(SDT )) Q:SDT= "" W !,$$ DATE^RCCPC PS1(SDT)
	8383	"RTN","RCC PCSE",26,0 )
	8384	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8385	"RTN","RCC PCSE",27,0 )
	8386	S DIR(0)= "DAO^^K:'$ D(DTPT(Y)) X"
	8387	"RTN","RCC PCSE",28,0 )
	8388	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	8389	"RTN","RCC PCSE",29,0 )
	8390	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	8391	"RTN","RCC PCSE",30,0 )
	8392	D ^DIR
	8393	"RTN","RCC PCSE",31,0 )
	8394	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8395	"RTN","RCC PCSE",32,0 )
	8396	S SDT=Y
	8397	"RTN","RCC PCSE",33,0 )
	8398	D PRINT
	8399	"RTN","RCC PCSE",34,0 )
	8400	Q
	8401	"RTN","RCC PCSE",35,0 )
	8402	PRINT ; P RCA4.531 3 Determin e print de vice then enter Sort
	8403	"RTN","RCC PCSE",36,0 )
	8404	D HOME^%Z IS S %ZIS= "QN" D ^%Z IS Q:POP
	8405	"RTN","RCC PCSE",37,0 )
	8406	I $D(IO(" Q")) D Q
	8407	"RTN","RCC PCSE",38,0 )
	8408	.S ZTRTN= "SORT^RCCP CSE",ZTDES C="CBSS PA TIENT STAT EMENT ERRO R REPORT"
	8409	"RTN","RCC PCSE",39,0 )
	8410	. S TMPQ= 1,(ZTSAVE( "DTPT("),Z TSAVE("SDT "),ZTSAVE( "ALL"),ZTS AVE("TMPQ" ))=""
	8411	"RTN","RCC PCSE",40,0 )
	8412	.D ^%ZTLO AD
	8413	"RTN","RCC PCSE",41,0 )
	8414	SORT ; PR CA4.5313 - Rewritt en to prin t by date
	8415	"RTN","RCC PCSE",42,0 )
	8416	S HDR="CB SS PATIENT STATEMENT ERROR REP ORT",LINE= "",$P(LINE ,"=",79)=" ",PG=1
	8417	"RTN","RCC PCSE",43,0 )
	8418	I 'ALL D SORT1,PRNT Q
	8419	"RTN","RCC PCSE",44,0 )
	8420	I ALL S S DT=""
	8421	"RTN","RCC PCSE",45,0 )
	8422	F S SDT= $O(DTPT(SD T)) Q:SDT= "" D SORT 1
	8423	"RTN","RCC PCSE",46,0 )
	8424	D PRNT
	8425	"RTN","RCC PCSE",47,0 )
	8426	; PRCA4. 5313 - Re move TMP s torage
	8427	"RTN","RCC PCSE",48,0 )
	8428	K ^TMP($J )
	8429	"RTN","RCC PCSE",49,0 )
	8430	Q
	8431	"RTN","RCC PCSE",50,0 )
	8432	SORT1 ;PR CA4.5313 Print a d ay of erro rs
	8433	"RTN","RCC PCSE",51,0 )
	8434	N IEN
	8435	"RTN","RCC PCSE",52,0 )
	8436	S IEN="" F S IEN=$ O(DTPT(SDT ,IEN)) Q:I EN="" D
	8437	"RTN","RCC PCSE",53,0 )
	8438	.S ERR=$G (^RCPS(349 .2,IEN,5))
	8439	"RTN","RCC PCSE",54,0 )
	8440	.S ^TMP($ J,"ERR",SD T,IEN)=$P( $G(^RCPS(3 49.2,IEN,0 )),"^",3)_ "^"_$P(^(0 ),"^",2)
	8441	"RTN","RCC PCSE",55,0 )
	8442	.S ADD=$G (^RCPS(349 .2,IEN,1))
	8443	"RTN","RCC PCSE",56,0 )
	8444	.F X=1:1: 6 S ADD(X) =$P(ADD,"^ ",X),^TMP( $J,"ERR",S DT,IEN,1+X )=ADD(X)
	8445	"RTN","RCC PCSE",57,0 )
	8446	.F X=1:5 S X1=X+4,E RROR=$E(ER R,X,X1) Q: ERROR="" D
	8447	"RTN","RCC PCSE",58,0 )
	8448	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=ERROR
	8449	"RTN","RCC PCSE",59,0 )
	8450	..S ERROR =$O(^RCPSE (349.7,"B" ,$E(ERROR, 1,5),""))
	8451	"RTN","RCC PCSE",60,0 )
	8452	..S ERROR =$P($G(^RC PSE(349.7, +ERROR,0)) ,"^",4)
	8453	"RTN","RCC PCSE",61,0 )
	8454	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=^TMP($J ,"ERR",SDT ,IEN,X+10) _"^"_ERROR
	8455	"RTN","RCC PCSE",62,0 )
	8456	;
	8457	"RTN","RCC PCSE",63,0 )
	8458	K ADD
	8459	"RTN","RCC PCSE",64,0 )
	8460	Q
	8461	"RTN","RCC PCSE",65,0 )
	8462	PRNT ; PR CA4.5313 - Print b ased upon statement date
	8463	"RTN","RCC PCSE",66,0 )
	8464	K DIRUT
	8465	"RTN","RCC PCSE",67,0 )
	8466	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8467	"RTN","RCC PCSE",68,0 )
	8468	S (SDT,IE N)=""
	8469	"RTN","RCC PCSE",69,0 )
	8470	F S SDT= $O(^TMP($J ,"ERR",SDT )) Q:SDT=" " D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$D (DIROUT) Q
	8471	"RTN","RCC PCSE",70,0 )
	8472	. W @IOF, ?25,HDR,?7 5,PG,!,LIN E S PG=PG+ 1
	8473	"RTN","RCC PCSE",71,0 )
	8474	. W !,?20 ,"Patient Statement Date: "_$$ DATE^RCCPC PS1(SDT),! ,LINE
	8475	"RTN","RCC PCSE",72,0 )
	8476	. F S IE N=$O(^TMP( $J,"ERR",S DT,IEN)) Q :IEN="" D PRNT1 I
	8477	$D(DTOUT)! $D(DUOUT)! $D(DIRUT)! $D(DIROUT) Q
	8478	"RTN","RCC PCSE",73,0 )
	8479	. I 'TMPQ S DIR(0)= "E" D ^DIR I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8480	"RTN","RCC PCSE",74,0 )
	8481	Q
	8482	"RTN","RCC PCSE",75,0 )
	8483	PRNT1 ; P RCA4.531 3 - Print based upon statement date
	8484	"RTN","RCC PCSE",76,0 )
	8485	I ($Y+12) >IOSL D
	8486	"RTN","RCC PCSE",77,0 )
	8487	.I 'TMPQ S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	8488	"RTN","RCC PCSE",78,0 )
	8489	.W @IOF,? 25,HDR,?75 ,PG S PG=P G+1
	8490	"RTN","RCC PCSE",79,0 )
	8491	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8492	"RTN","RCC PCSE",80,0 )
	8493	W !!,$E($ P(^TMP($J, "ERR",SDT, IEN),"^"), 1,25),?37, "ERROR COD ES",!,$P(^ (IEN),"^", 2),?30,$E( LINE,1,48)
	8494	"RTN","RCC PCSE",81,0 )
	8495	F X=2:1:4 S:$G(^TMP ($J,"ERR", SDT,IEN,X) )]"" ADD(X )=^(X)
	8496	"RTN","RCC PCSE",82,0 )
	8497	S ADD(5)= $G(^TMP($J ,"ERR",SDT ,IEN,5))_" , "_$G(^(6 ))_" "_$G( ^(7))
	8498	"RTN","RCC PCSE",83,0 )
	8499	S X=7 F S X=$O(^TM P($J,"ERR" ,SDT,IEN,X )) Q:'X S ERR(X-1)= ^(X)
	8500	"RTN","RCC PCSE",84,0 )
	8501	S (Z,Y)=0 F D Q:Y =""&(Z="")
	8502	"RTN","RCC PCSE",85,0 )
	8503	.W !
	8504	"RTN","RCC PCSE",86,0 )
	8505	.I Z'="" S Z=$O(ADD (Z)) I Z'= "",(ADD(Z) ]"") W ADD (Z)
	8506	"RTN","RCC PCSE",87,0 )
	8507	.I Y'="" S Y=$O(ERR (Y)) I Y'= "" W ?30,$ P(ERR(Y)," ^"),?40,$P (ERR(Y),"^ ",2)
	8508	"RTN","RCC PCSE",88,0 )
	8509	W !,LINE
	8510	"RTN","RCC PCSE",89,0 )
	8511	Q
	8512	"RTN","RCC PCSV")
	8513	0^9^B11825 361^B51994 90
	8514	"RTN","RCC PCSV",1,0)
	8515	RCCPCSV ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 11: 36 AM
	8516	"RTN","RCC PCSV",2,0)
	8517	V ;;4.5;Ac counts Rec eivable; 34,70,87,3 13;Mar 2 0, 1995;Bu ild 131
	8518	"RTN","RCC PCSV",3,0)
	8519	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8520	"RTN","RCC PCSV",4,0)
	8521	;
	8522	"RTN","RCC PCSV",5,0)
	8523	EN ;INPUT FROM MESSA GE
	8524	"RTN","RCC PCSV",6,0)
	8525	RREC ;READ INCOMING MESSAGE
	8526	"RTN","RCC PCSV",7,0)
	8527	N
	8528	DAT,DEB,EN D,ERR,ERRO R,EVN,KEY, LABEL,LN,M SG,P,RCMSG ,RCTR,RCX, RCX1,RE,SB AL,STOT,TR ,TR0,TR1,T
	8529	XT
	8530	"RTN","RCC PCSV",8,0)
	8531	N SDT,NOE RR,X,Y,DA
	8532	"RTN","RCC PCSV",9,0)
	8533	K ^TMP($J )
	8534	"RTN","RCC PCSV",10,0 )
	8535	S (LN,MSG ,RCX,RE)=0
	8536	"RTN","RCC PCSV",11,0 )
	8537	S TXT=0 F X XMREC Q:XMER<0!( XMRG="") S TXT=TXT+ 1,^TMP($J, "MSG",TXT) =XMRG
	8538	"RTN","RCC PCSV",12,0 )
	8539	S (DA(1), NOERR)=""
	8540	"RTN","RCC PCSV",13,0 )
	8541	S TXT=1 F S TXT=$O (^TMP($J," MSG",TXT)) Q:'TXT D
	8542	"RTN","RCC PCSV",14,0 )
	8543	. S:^TMP( $J,"MSG",T XT)?1"PA^" .E DA(1)=4 S:^TMP($J ,"MSG",TXT )?1"IS".E DA(1)=3
	8544	"RTN","RCC PCSV",15,0 )
	8545	. ; PRCA* 4.5*313 - Set Statem ent date f rom PA or IS records
	8546	"RTN","RCC PCSV",16,0 )
	8547	. I "PAIS "[$E(^TMP( $J,"MSG",T XT),1,2) S X=$P(^TMP ($J,"MSG", TXT),"^",7 ) D ^%DT S SDT=Y
	8548	"RTN","RCC PCSV",17,0 )
	8549	. ; PRCA* 4.5*313 - If the dat e and sequ ence numbe r have alr eady been processed quit after setting a n
	8550	error
	8551	"RTN","RCC PCSV",18,0 )
	8552	. I "PAIS "[$P(^TMP( $J,"MSG",T XT),U) I
	8553	($D(^RCT(3 49.1,DA(1) ,4,"STDT4" ,SDT,$P(^T MP($J,"MSG ",TXT),U,2 )))) D Q
	8554	"RTN","RCC PCSV",19,0 )
	8555	. . S ERR ="Duplicat e file was received for Patien t Statemen t Date: "_ $P(^TMP($J ,"MSG",TXT ),U,7) D
	8556	ERRMSG
	8557	"RTN","RCC PCSV",20,0 )
	8558	. . S ERR ="Last Mes sage Ackno wledgement Number: " _$P(^TMP($ J,"MSG",TX T),U,2) D ERRMSG
	8559	"RTN","RCC PCSV",21,0 )
	8560	. . S SDT =$P(^TMP($ J,"MSG",TX T),U,7)
	8561	"RTN","RCC PCSV",22,0 )
	8562	. ; PRCA* 4.5*313 - If IT is r eceived it always pr ocesses
	8563	"RTN","RCC PCSV",23,0 )
	8564	. I $P(^T MP($J,"MSG ",TXT),U)= "IT" S SDT =$P(^TMP($ J,"MSG",TX T),"^",6), NOERR=1 Q
	8565	"RTN","RCC PCSV",24,0 )
	8566	. I $G(XM Z)=""!('DA (1))!($D(E RR)) Q
	8567	"RTN","RCC PCSV",25,0 )
	8568	. S RCX=R CX+1
	8569	"RTN","RCC PCSV",26,0 )
	8570	. I "PAIS ADID"[$E(^ TMP($J,"MS G",TXT),1, 2) D
	8571	"RTN","RCC PCSV",27,0 )
	8572	. . ; PRC A4.5313 - Add Stat ement Date to 349.1, five leve l for PA, IS, AD, an d ID recor ds
	8573	"RTN","RCC PCSV",28,0 )
	8574	. . N DIN UM,DIC,X
	8575	"RTN","RCC PCSV",29,0 )
	8576	. . S DIN UM=+$G(XMZ )_RCX
	8577	"RTN","RCC PCSV",30,0 )
	8578	. . S DIC ="^RCT(349 .1,DA(1),5 ,"
	8579	"RTN","RCC PCSV",31,0 )
	8580	. . S X=$ P(^TMP($J, "MSG",TXT) ,"^",2)
	8581	"RTN","RCC PCSV",32,0 )
	8582	. . S DIC (0)="L"
	8583	"RTN","RCC PCSV",33,0 )
	8584	. . S DIC ("DR")=".0 2////"_$P( ^TMP($J,"M SG",TXT)," ^",3)_";.0 3////"_$G( XMZ)_";.04 ////"_SDT
	8585	"RTN","RCC PCSV",34,0 )
	8586	. . D FIL E^DICN
	8587	"RTN","RCC PCSV",35,0 )
	8588	. ; PRCA* 4.5*313 - If process ing has oc curred
	8589	"RTN","RCC PCSV",36,0 )
	8590	. S NOERR =1
	8591	"RTN","RCC PCSV",37,0 )
	8592	;
	8593	"RTN","RCC PCSV",38,0 )
	8594	K DA(1)
	8595	"RTN","RCC PCSV",39,0 )
	8596	I NOERR D SEG,KILL^ XM
	8597	"RTN","RCC PCSV",40,0 )
	8598	I $O(^TMP ($J,"ERR", 0)) D
	8599	"RTN","RCC PCSV",41,0 )
	8600	. ; PRCA* 4.5*313 - Change CCP C to CBSS and add da te
	8601	"RTN","RCC PCSV",42,0 )
	8602	. S XMSUB ="CBSS ERR OR MESSAGE TO STATIO N FOR "_SD T
	8603	"RTN","RCC PCSV",43,0 )
	8604	. S XMDUZ ="AR PACKA GE"
	8605	"RTN","RCC PCSV",44,0 )
	8606	. S XMTEX T="^TMP($J ,"_"""ERR" ","
	8607	"RTN","RCC PCSV",45,0 )
	8608	. I $O(^X MB(3.8,"B" ,"RCCPC ST ATEMENTS", 0)) S XMY( "G.RCCPC S TATEMENTS" )=""
	8609	"RTN","RCC PCSV",46,0 )
	8610	. D ^XMD
	8611	"RTN","RCC PCSV",47,0 )
	8612	. K ^TMP( $J)
	8613	"RTN","RCC PCSV",48,0 )
	8614	. ; PRCA* 4.5*313 - Change to send SDT f or resend
	8615	"RTN","RCC PCSV",49,0 )
	8616	. D:$G(RE )="R"&($G( SDT)'="") EN^RCCPCML (SDT)
	8617	"RTN","RCC PCSV",50,0 )
	8618	E S XMZ= XQMSG,XMSE R="S."_XQS OP D REMSB MSG^XMA1C
	8619	"RTN","RCC PCSV",51,0 )
	8620	Q
	8621	"RTN","RCC PCSV",52,0 )
	8622	;
	8623	"RTN","RCC PCSV",53,0 )
	8624	SEG S RCMS G=1 S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) D
	8625	"RTN","RCC PCSV",54,0 )
	8626	.S RCTR=^ TMP($J,"MS G",RCMSG)
	8627	"RTN","RCC PCSV",55,0 )
	8628	.S LABEL= $S(($P(RCT R,"^")]"") &($T(@($P( RCTR,"^")) )]""):$P(R CTR,"^"),1 :"ERROR")
	8629	"RTN","RCC PCSV",56,0 )
	8630	.D @(LABE L)
	8631	"RTN","RCC PCSV",57,0 )
	8632	Q
	8633	"RTN","RCC PCSV",58,0 )
	8634	;
	8635	"RTN","RCC PCSV",59,0 )
	8636	ERROR ;SEN D ERROR ME SSAGE TO M AIL GROUP
	8637	"RTN","RCC PCSV",60,0 )
	8638	;
	8639	"RTN","RCC PCSV",61,0 )
	8640	; PRCA4. 5313 - Ch ange CCPC to CBSS
	8641	"RTN","RCC PCSV",62,0 )
	8642	S ERR="CB SS ERROR - CANNOT RE AD MESSAGE FROM CBSS " D ERRMSG
	8643	"RTN","RCC PCSV",63,0 )
	8644	S ERR="An error has occurred in reading a message from the CBSS."
	8645	"RTN","RCC PCSV",64,0 )
	8646	D ERRMSG
	8647	"RTN","RCC PCSV",65,0 )
	8648	S ERR="Pl ease conta ct your IR M for assi stance."
	8649	"RTN","RCC PCSV",66,0 )
	8650	D ERRMSG
	8651	"RTN","RCC PCSV",67,0 )
	8652	S ERR="Th e MESSAGE WAS AS FOL LOWS:"
	8653	"RTN","RCC PCSV",68,0 )
	8654	D ERRMSG
	8655	"RTN","RCC PCSV",69,0 )
	8656	S ERR=^TM P($J,"MSG" ,RCMSG)
	8657	"RTN","RCC PCSV",70,0 )
	8658	D ERRMSG
	8659	"RTN","RCC PCSV",71,0 )
	8660	Q
	8661	"RTN","RCC PCSV",72,0 )
	8662	;
	8663	"RTN","RCC PCSV",73,0 )
	8664	IS ;INVALI D STATEMEN T
	8665	"RTN","RCC PCSV",74,0 )
	8666	D IS^RCCP CSV1
	8667	"RTN","RCC PCSV",75,0 )
	8668	Q
	8669	"RTN","RCC PCSV",76,0 )
	8670	;
	8671	"RTN","RCC PCSV",77,0 )
	8672	PA ;STATEM ENT ACKNOW LEDGEMENT
	8673	"RTN","RCC PCSV",78,0 )
	8674	D PA^RCCP CSV1
	8675	"RTN","RCC PCSV",79,0 )
	8676	Q
	8677	"RTN","RCC PCSV",80,0 )
	8678	;
	8679	"RTN","RCC PCSV",81,0 )
	8680	IT ;INVALI D TRANSMIS SION
	8681	"RTN","RCC PCSV",82,0 )
	8682	D IT^RCCP CSV1
	8683	"RTN","RCC PCSV",83,0 )
	8684	Q
	8685	"RTN","RCC PCSV",84,0 )
	8686	;
	8687	"RTN","RCC PCSV",85,0 )
	8688	ERRMSG ;ER ROR MESSAG E
	8689	"RTN","RCC PCSV",86,0 )
	8690	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	8691	"RTN","RCC PCSV",87,0 )
	8692	Q
	8693	"RTN","RCC PCSV1")
	8694	0^12^B4331 3841^B3201 7096
	8695	"RTN","RCC PCSV1",1,0 )
	8696	RCCPCSV1 ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 2:5 4 PM
	8697	"RTN","RCC PCSV1",2,0 )
	8698	;;4.5;Acc ounts Rece ivable;*3 4,70,76,13 0,153,313 *;Mar 20, 1995;Build 131
	8699	"RTN","RCC PCSV1",3,0 )
	8700	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8701	"RTN","RCC PCSV1",4,0 )
	8702	;
	8703	"RTN","RCC PCSV1",5,0 )
	8704	IS ;INVALI D STATEMEN T
	8705	"RTN","RCC PCSV1",6,0 )
	8706	; PRCA4. 5313 - Ad d SDT for Patient St atement Da te
	8707	"RTN","RCC PCSV1",7,0 )
	8708	N SDAT,SD T,X,Y,ERR
	8709	"RTN","RCC PCSV1",8,0 )
	8710	S SDAT=$P (RCTR,"^", 7) S (X,SD T)=SDAT D ^%DT S SDA T=Y
	8711	"RTN","RCC PCSV1",9,0 )
	8712	D CHKTRAN (LABEL)
	8713	"RTN","RCC PCSV1",10, 0)
	8714	S ERR="Th e followin g statemen ts did not print due to errors :" D ERRMS G
	8715	"RTN","RCC PCSV1",11, 0)
	8716	S ERR=" " D ERRMSG
	8717	"RTN","RCC PCSV1",12, 0)
	8718	S ERR=" KEY ER ROR" D ERR MSG S ERR= " " D ERRM SG
	8719	"RTN","RCC PCSV1",13, 0)
	8720	D ID
	8721	"RTN","RCC PCSV1",14, 0)
	8722	S ERR="If these err ors are co rrected, t hese state ments will not print until" D ERRMSG S E RR="the ne xt
	8723	billing cy cle." D ER RMSG
	8724	"RTN","RCC PCSV1",15, 0)
	8725	Q
	8726	"RTN","RCC PCSV1",16, 0)
	8727	;
	8728	"RTN","RCC PCSV1",17, 0)
	8729	ID ;INVALI D STATEMEN T DETAIL E RROR
	8730	"RTN","RCC PCSV1",18, 0)
	8731	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	8732	"RTN","RCC PCSV1",19, 0)
	8733	.; PRCA4 .5313 - C lean up va riables
	8734	"RTN","RCC PCSV1",20, 0)
	8735	.N KEY,DE B,ERROR,RC X,RCX1,ERR ,LN
	8736	"RTN","RCC PCSV1",21, 0)
	8737	.I $P(^TM P($J,"MSG" ,RCMSG),"^ ")'="ID" S ERR="ERRO R IN READI NG CBSS ER ROR RECORD " D ERRMSG
	8738	Q
	8739	"RTN","RCC PCSV1",22, 0)
	8740	.S KEY=$P (^TMP($J," MSG",RCMSG ),"^",2),K EY=$TR(KEY ,"
	8741	",""),KEY= $E(KEY,$F( KEY,$$SITE ^RCMSITE), 999)
	8742	"RTN","RCC PCSV1",23, 0)
	8743	.I KEY']" " D KEYERR Q
	8744	"RTN","RCC PCSV1",24, 0)
	8745	.S DEB=$O (^RCPS(349 .2,"AKEY", KEY,0)) I 'DEB D KEY ERR Q
	8746	"RTN","RCC PCSV1",25, 0)
	8747	.S ERROR= $P(^TMP($J ,"MSG",RCM SG),"^",3) ,^RCPS(349 .2,+DEB,5) =ERROR
	8748	"RTN","RCC PCSV1",26, 0)
	8749	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERR(0)=$E( ERROR,RCX, RCX1) Q:ER R(0)="" D
	8750	"RTN","RCC PCSV1",27, 0)
	8751	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERR(0)," "))
	8752	"RTN","RCC PCSV1",28, 0)
	8753	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RR(0)
	8754	"RTN","RCC PCSV1",29, 0)
	8755	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 )
	8756	"RTN","RCC PCSV1",30, 0)
	8757	..S ERR=K EY_" "_ERR (0)_" "_ER R
	8758	"RTN","RCC PCSV1",31, 0)
	8759	..D ERRMS G
	8760	"RTN","RCC PCSV1",32, 0)
	8761	..S ERR=" " D ERRMS G
	8762	"RTN","RCC PCSV1",33, 0)
	8763	.S ^RCPS( 349.2,+DEB ,5)=$P(^TM P($J,"MSG" ,RCMSG),"^ ",3)
	8764	"RTN","RCC PCSV1",34, 0)
	8765	.S ^RCPS( 349.2,"AD" ,"E",+DEB) =""
	8766	"RTN","RCC PCSV1",35, 0)
	8767	Q
	8768	"RTN","RCC PCSV1",36, 0)
	8769	;
	8770	"RTN","RCC PCSV1",37, 0)
	8771	;
	8772	"RTN","RCC PCSV1",38, 0)
	8773	KEYERR ;SE ND MESSAGE TO MAIL G ROUP INDIC ATING NO K EY
	8774	"RTN","RCC PCSV1",39, 0)
	8775	S ERR="CB SS ERROR M ESSAGE - N O AR KEY I D FOR CBSS KEY: "_KE Y D ERRMSG
	8776	"RTN","RCC PCSV1",40, 0)
	8777	S ERR="Th is patient record is corrupted . Please c ontact IRM ." D ERRMS G
	8778	"RTN","RCC PCSV1",41, 0)
	8779	S ERR=" " D ERRMSG
	8780	"RTN","RCC PCSV1",42, 0)
	8781	Q
	8782	"RTN","RCC PCSV1",43, 0)
	8783	;
	8784	"RTN","RCC PCSV1",44, 0)
	8785	PA ;STATEM ENT ACKNOW LEDGEMENT
	8786	"RTN","RCC PCSV1",45, 0)
	8787	N STDT,SS TDT,SDAT,S DT,IEN,DEB ,X,Y,STOT, SEQ,KEY,EN D,SBAL,EVN ,DA,DIK
	8788	"RTN","RCC PCSV1",46, 0)
	8789	Q:$P(RCTR ,"^")'="PA "
	8790	"RTN","RCC PCSV1",47, 0)
	8791	; D CHKTR AN(LABEL)
	8792	"RTN","RCC PCSV1",48, 0)
	8793	S (X,SDT) =$P(RCTR," ^",7) D ^% DT S SDAT= Y
	8794	"RTN","RCC PCSV1",49, 0)
	8795	D CHKTRAN (LABEL)
	8796	"RTN","RCC PCSV1",50, 0)
	8797	S STOT=+$ P(RCTR,"^" ,6)
	8798	"RTN","RCC PCSV1",51, 0)
	8799	S SEQ=+$P (RCTR,"^", 3)
	8800	"RTN","RCC PCSV1",52, 0)
	8801	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	8802	"RTN","RCC PCSV1",53, 0)
	8803	.N P
	8804	"RTN","RCC PCSV1",54, 0)
	8805	.S RCTR=^ TMP($J,"MS G",RCMSG)
	8806	"RTN","RCC PCSV1",55, 0)
	8807	.Q:$P(RCT R,"^")'="A D"
	8808	"RTN","RCC PCSV1",56, 0)
	8809	.S KEY=$P (RCTR,"^", 2),KEY=$TR (KEY," "," "),KEY=$E( KEY,$F(KEY ,$$SITE^RC MSITE),999 )
	8810	"RTN","RCC PCSV1",57, 0)
	8811	.I KEY']" " D KEYERR Q
	8812	"RTN","RCC PCSV1",58, 0)
	8813	.;PRCA4. 5313 - Fi nd Debtor using IEN from 349.2
	8814	"RTN","RCC PCSV1",59, 0)
	8815	.S IEN=$O (^RCPS(349 .2,"AKEY", KEY,0))
	8816	"RTN","RCC PCSV1",60, 0)
	8817	.I '$G(IE N) D KEYER R Q
	8818	"RTN","RCC PCSV1",61, 0)
	8819	.S DEB=$P ($G(^RCPS( 349.2,IEN, 0)),U)
	8820	"RTN","RCC PCSV1",62, 0)
	8821	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	8822	"RTN","RCC PCSV1",63, 0)
	8823	.I IEN S END=$P(^RC PS(349.2,+ IEN,0),"^" ,10)
	8824	"RTN","RCC PCSV1",64, 0)
	8825	.S:'$G(EN D) END=$O( ^RCPS(349. 2,"STDT",S DAT,0)),EN D=$P($G(^( +END,0))," ^",10)
	8826	"RTN","RCC PCSV1",65, 0)
	8827	.F P=13:1 :17 S SBAL (P)=$P(^RC PS(349.2,+ IEN,0),"^" ,P)
	8828	"RTN","RCC PCSV1",66, 0)
	8829	.;update patient st atement da te in 341 to end pro cess time
	8830	"RTN","RCC PCSV1",67, 0)
	8831	.D
	8832	OPEN^RCEVD RV1(2,$P(^ RCD(340,DE B,0),U),EN D,DUZ,$$SI TE^RCMSITE ,.ERR,.EVN ,SBAL(13)_ U_SBAL(14)
	8833	_U_SBAL(15 )_U_SBAL(1 6)_U_SBAL( 17))
	8834	"RTN","RCC PCSV1",68, 0)
	8835	.I EVN S DR=".07/// /"_END_";. 11////"_1, DA=+EVN,DI E="^RC(341 ," D ^DIE K DIE,DR,D A
	8836	"RTN","RCC PCSV1",69, 0)
	8837	.; PRCA4 .5313 - A dd cross-r eference f or File
	8838	"RTN","RCC PCSV1",70, 0)
	8839	.I EVN S $P(^RC(341 ,+EVN,6)," ^")=$G(SDA T) D
	8840	"RTN","RCC PCSV1",71, 0)
	8841	. .S DA=+ EVN,DIK="^ RC(341," D IX1^DIK
	8842	"RTN","RCC PCSV1",72, 0)
	8843	.;update bill file 430 letter fields
	8844	"RTN","RCC PCSV1",73, 0)
	8845	.NEW BN,D A,DIC,DIE, DR,II,LET, NOT,X,Y
	8846	"RTN","RCC PCSV1",74, 0)
	8847	.S DIE="^ PRCA(430," ,NOT=0,BN= 0
	8848	"RTN","RCC PCSV1",75, 0)
	8849	.F S BN= $O(^PRCA(4 30,"AS",DE B,16,BN)) Q:'BN S D A=BN D
	8850	"RTN","RCC PCSV1",76, 0)
	8851	..S LET=$ G(^PRCA(43 0,BN,6))
	8852	"RTN","RCC PCSV1",77, 0)
	8853	..I $P(LE T,"^",21)> END Q
	8854	"RTN","RCC PCSV1",78, 0)
	8855	..S END=$ G(SDAT)
	8856	"RTN","RCC PCSV1",79, 0)
	8857	..F II=1: 1:4 Q:$P(L ET,U,II)=E ND I $P(L ET,U,II)=" " S DR=$S( II=1:61,II =2:62,II=3 :63,1:68)_ "////^S
	8858	X="_END_"; 68.1////^S X="_END D ^DIE Q
	8859	"RTN","RCC PCSV1",80, 0)
	8860	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	8861	"RTN","RCC PCSV1",81, 0)
	8862	.S ^RCPS( 349.2,+IEN ,6)=1
	8863	"RTN","RCC PCSV1",82, 0)
	8864	PAMAIL ;
	8865	"RTN","RCC PCSV1",83, 0)
	8866	N XMSUB,X MY,XMDUZ,X MTEXT,MSG
	8867	"RTN","RCC PCSV1",84, 0)
	8868	; PRCA4. 5313 - Ch ange to CB SS
	8869	"RTN","RCC PCSV1",85, 0)
	8870	S XMSUB=" Patient Ac knowledgem ents recei ved from C BSS."
	8871	"RTN","RCC PCSV1",86, 0)
	8872	S XMY("G. RCCPC STAT EMENTS")=" ",XMDUZ="A R PACKAGE" ,XMTEXT="M SG("
	8873	"RTN","RCC PCSV1",87, 0)
	8874	; PRCA4. 5313 - Ad d Patient Statement Date and r enumber ot her lines
	8875	"RTN","RCC PCSV1",88, 0)
	8876	S MSG(1)= "For Patie nt Stateme nt Date of "_SDT_"."
	8877	"RTN","RCC PCSV1",89, 0)
	8878	S MSG(2)= "Patient a cknowledge ment messa ge "_$G(XM Z)_" recei ved."
	8879	"RTN","RCC PCSV1",90, 0)
	8880	S MSG(3)= "This mean s that CBS S has prin ted patien t statemen ts for thi s statemen t period."
	8881	"RTN","RCC PCSV1",91, 0)
	8882	D ^XMD
	8883	"RTN","RCC PCSV1",92, 0)
	8884	Q
	8885	"RTN","RCC PCSV1",93, 0)
	8886	;
	8887	"RTN","RCC PCSV1",94, 0)
	8888	CHKTRAN(LA BEL) ;Chec k for inco mplete mes sage from CCPC
	8889	"RTN","RCC PCSV1",95, 0)
	8890	; PRCA4. 5313 - Ad d multiple entries b ased upon date to fo ur level
	8891	"RTN","RCC PCSV1",96, 0)
	8892	Q:$G(LABE L)']""
	8893	"RTN","RCC PCSV1",97, 0)
	8894	N PSIEN,D A,DIK,DO,D IC,X
	8895	"RTN","RCC PCSV1",98, 0)
	8896	S LABEL(1 )=+$O(^RCT (349.1,"B" ,LABEL,0))
	8897	"RTN","RCC PCSV1",99, 0)
	8898	; PRCA4. 5313 - Ad d Patient Statement Date to fo ur level
	8899	"RTN","RCC PCSV1",100 ,0)
	8900	I LABEL(1 ),$P(^TMP( $J,"MSG",R CMSG),"^", 2)=$P(^TMP ($J,"MSG", RCMSG),"^" ,3) D
	8901	"RTN","RCC PCSV1",101 ,0)
	8902	. S DIC=" ^RCT(349.1 ,LABEL(1), 4,"
	8903	"RTN","RCC PCSV1",102 ,0)
	8904	. S X=$P( ^TMP($J,"M SG",RCMSG) ,"^",2)
	8905	"RTN","RCC PCSV1",103 ,0)
	8906	. S DA(1) =LABEL(1), DIC(0)="L"
	8907	"RTN","RCC PCSV1",104 ,0)
	8908	. S DIC(" DR")=".02/ ///"_$P(^T MP($J,"MSG ",RCMSG)," ^",3)_";.0 3////"_$G( XMZ)_";.04 ////"_SDAT
	8909	"RTN","RCC PCSV1",105 ,0)
	8910	. D FILE^ DICN
	8911	"RTN","RCC PCSV1",106 ,0)
	8912	Q
	8913	"RTN","RCC PCSV1",107 ,0)
	8914	;
	8915	"RTN","RCC PCSV1",108 ,0)
	8916	TRANCHK ;C heck for c omplete AC K transmis sion
	8917	"RTN","RCC PCSV1",109 ,0)
	8918	; PRCA4. 5313 - Ch eck for st atement da tes five t o seven da ys in past since bui ld and tra nsmit.
	8919	"RTN","RCC PCSV1",110 ,0)
	8920	N X,Y,DAT E,SDT,I,X1 ,X2
	8921	"RTN","RCC PCSV1",111 ,0)
	8922	F I=-3:-1 :-5 S X1=D T,X2=I D C ^%DTC S (Y ,SDT)=X D DD^%DT S D ATE=Y D TR ANCHK1
	8923	"RTN","RCC PCSV1",112 ,0)
	8924	Q
	8925	"RTN","RCC PCSV1",113 ,0)
	8926	;
	8927	"RTN","RCC PCSV1",114 ,0)
	8928	TRANCHK1 ; PRCA4.5 313 - Vali date trans mission co mpleteness for date provided.
	8929	"RTN","RCC PCSV1",115 ,0)
	8930	N MSG,RCT ,SEG,SEQ,C NT,IEN,XMD UZ,XMSUB,X MTEXT,XMY
	8931	"RTN","RCC PCSV1",116 ,0)
	8932	F RCT=3,4 S CNT=$O( ^RCT(349.1 ,RCT,4,"ST DT4",SDT,0 )) I CNT'= "" D
	8933	"RTN","RCC PCSV1",117 ,0)
	8934	.S IEN=$O (^RCT(349. 1,RCT,4,"S TDT4",SDT, CNT,0)) D
	8935	"RTN","RCC PCSV1",118 ,0)
	8936	..I IEN'= "",$P($G(^ RCT(349.1, +RCT,4,IEN ,0)),"^")' =$P($G(^RC T(349.1,+R CT,4,IEN,0 )),"^",2) D TRANSEND
	8937	"RTN","RCC PCSV1",119 ,0)
	8938	Q
	8939	"RTN","RCC PCSV1",120 ,0)
	8940	;
	8941	"RTN","RCC PCSV1",121 ,0)
	8942	TRANSEND ; PRCA4.5 313 Send Transmissi on
	8943	"RTN","RCC PCSV1",122 ,0)
	8944	S XMDUZ=" AR PACKAGE "
	8945	"RTN","RCC PCSV1",123 ,0)
	8946	; PRCA4. 5313 - Ch ange CCPC to CBSS
	8947	"RTN","RCC PCSV1",124 ,0)
	8948	S XMSUB=" CBSS ACKNO WLEDGEMENT TRANSMISS ION(S) INC OMPLETE"
	8949	"RTN","RCC PCSV1",125 ,0)
	8950	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= "" E S XM Y(.5)=""
	8951	"RTN","RCC PCSV1",126 ,0)
	8952	S XMTEXT= "MSG("
	8953	"RTN","RCC PCSV1",127 ,0)
	8954	S SEG=$S( RCT=3:"IS" ,1:"PA")
	8955	"RTN","RCC PCSV1",128 ,0)
	8956	S SEG(1)= $P(^RCT(34 9.1,+RCT,4 ,IEN,0),"^ ",2)
	8957	"RTN","RCC PCSV1",129 ,0)
	8958	; PRCA4. 5313 - Ad d line ide ntifying P atient Sta tement Dat e that err ored
	8959	"RTN","RCC PCSV1",130 ,0)
	8960	S MSG(2)= "For Patie nt Stateme nt Date of "_DATE_". "
	8961	"RTN","RCC PCSV1",131 ,0)
	8962	; PRCA4. 5313 - Ch ange CCPC to CBSS
	8963	"RTN","RCC PCSV1",132 ,0)
	8964	S MSG(3)= "The last "_SEG_" se gment mess age receiv ed from CB SS was num bered "_SE G(1)_"."
	8965	"RTN","RCC PCSV1",133 ,0)
	8966	S MSG(4)= "This was not labele d the fina l message in that se gment type transmiss ion."
	8967	"RTN","RCC PCSV1",134 ,0)
	8968	S MSG(5)= "This may cause pati ent statem ent inform ation to b e missing. "
	8969	"RTN","RCC PCSV1",135 ,0)
	8970	S MSG(6)= "The last message nu mber recei ved was "_ $P($G(^RCT (349.1,RCT ,4,IEN,0)) ,"^",3)_". "
	8971	"RTN","RCC PCSV1",136 ,0)
	8972	; PRCA4 .5313 - C hange CCPC to CBSS
	8973	"RTN","RCC PCSV1",137 ,0)
	8974	S MSG(7)= "Please co ntact the CBSS in Au stin."
	8975	"RTN","RCC PCSV1",138 ,0)
	8976	D ^XMD
	8977	"RTN","RCC PCSV1",139 ,0)
	8978	Q
	8979	"RTN","RCC PCSV1",140 ,0)
	8980	;
	8981	"RTN","RCC PCSV1",141 ,0)
	8982	;
	8983	"RTN","RCC PCSV1",142 ,0)
	8984	IT ;INVALI D TRANSMIS SION
	8985	"RTN","RCC PCSV1",143 ,0)
	8986	; PRCA4. 5313 - Ch ange messa ge from CC PC to CBSS
	8987	"RTN","RCC PCSV1",144 ,0)
	8988	N SDT,ERR ,MSG,RCX,R CX1,ERROR, RE
	8989	"RTN","RCC PCSV1",145 ,0)
	8990	S ERR="Th e CBSS pat ient state ment messa ges were n ot accepte d by CBSS" D ERRMSG
	8991	"RTN","RCC PCSV1",146 ,0)
	8992	; PRCA4. 5313 - Ad d statemen t date to error mess age
	8993	"RTN","RCC PCSV1",147 ,0)
	8994	S SDT=$P( ^TMP($J,"M SG",RCMSG) ,"^",6)
	8995	"RTN","RCC PCSV1",148 ,0)
	8996	S ERR="fo r "_SDT_" due to the following error(s): " D ERRMSG
	8997	"RTN","RCC PCSV1",149 ,0)
	8998	S ERR=" " D ERRMSG
	8999	"RTN","RCC PCSV1",150 ,0)
	9000	S RCMSG=1 F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	9001	"RTN","RCC PCSV1",151 ,0)
	9002	.S MSG=^T MP($J,"MSG ",RCMSG)
	9003	"RTN","RCC PCSV1",152 ,0)
	9004	.S MSG=$P (MSG,"^",8 )
	9005	"RTN","RCC PCSV1",153 ,0)
	9006	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERROR=$E(M SG,RCX,RCX 1) Q:ERROR ="" D
	9007	"RTN","RCC PCSV1",154 ,0)
	9008	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERROR,"" ))
	9009	"RTN","RCC PCSV1",155 ,0)
	9010	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RROR
	9011	"RTN","RCC PCSV1",156 ,0)
	9012	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 ),ERR=ERRO R_" "_ERR
	9013	"RTN","RCC PCSV1",157 ,0)
	9014	..I ERR(1 ) S:$P(^RC PSE(349.7, +ERR(1),0) ,"^",3)="R " RE=1
	9015	"RTN","RCC PCSV1",158 ,0)
	9016	..D ERRMS G
	9017	"RTN","RCC PCSV1",159 ,0)
	9018	S ERR=" " D ERRMSG
	9019	"RTN","RCC PCSV1",160 ,0)
	9020	S ERR="Pl ease conta ct IRM."
	9021	"RTN","RCC PCSV1",161 ,0)
	9022	D ERRMSG
	9023	"RTN","RCC PCSV1",162 ,0)
	9024	Q
	9025	"RTN","RCC PCSV1",163 ,0)
	9026	;
	9027	"RTN","RCC PCSV1",164 ,0)
	9028	ERRMSG ;ER ROR MESSAG E
	9029	"RTN","RCC PCSV1",165 ,0)
	9030	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	9031	"RTN","RCC PCSV1",166 ,0)
	9032	Q
	9033	"RTN","RCC PCT")
	9034	0^15^B2933 0001^B2489 697
	9035	"RTN","RCC PCT",1,0)
	9036	RCCPCT ;WA SH-ISC@ALT OONA,PA/LD B - CCPC P atient Sta tement mes sage total s ;11/7/96 10:53 AM
	9037	"RTN","RCC PCT",2,0)
	9038	;;4.5;Acc ounts Rece ivable;3 4,313;Ma r 20, 1995 ;Build 131
	9039	"RTN","RCC PCT",3,0)
	9040	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9041	"RTN","RCC PCT",4,0)
	9042	EN ;
	9043	"RTN","RCC PCT",5,0)
	9044	D GO
	9045	"RTN","RCC PCT",6,0)
	9046	K TDT,TDT 1,TDT2,TDT 3,DATE,PTO T,TTOT,L,X ,Y,Y1,Y2,D ,IEN,POP,Q ,%,%DT,%ZI S,%Y,FIRST ,LAST
	9047	"RTN","RCC PCT",7,0)
	9048	Q
	9049	"RTN","RCC PCT",8,0)
	9050	GO ;
	9051	"RTN","RCC PCT",9,0)
	9052	W @IOF W !,"This re port will print the total Pati ent Statem ents sent to CBSS an d the"
	9053	"RTN","RCC PCT",10,0)
	9054	W !,"tota l acknowle dged as ha ving been printed wi th three d ifferent r eport"
	9055	"RTN","RCC PCT",11,0)
	9056	W !,"form ats availa ble."
	9057	"RTN","RCC PCT",12,0)
	9058	W !!,"The first for mat is jus t a single summary t otal repor t of all S tatement"
	9059	"RTN","RCC PCT",13,0)
	9060	W !,"Date s."
	9061	"RTN","RCC PCT",14,0)
	9062	W !!,"The second fo rmat is al l Statemen t Dates pr inted indi vidually w ith totals "
	9063	"RTN","RCC PCT",15,0)
	9064	W !,"and a summary total at t he end."
	9065	"RTN","RCC PCT",16,0)
	9066	W !!,"The third for mat is pri nting the totals for a single Statement Date selec ted.",!
	9067	"RTN","RCC PCT",17,0)
	9068	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9069	"RTN","RCC PCT",18,0)
	9070	S DIR(0)= "E" D ^DIR
	9071	"RTN","RCC PCT",19,0)
	9072	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9073	"RTN","RCC PCT",20,0)
	9074	S IEN="" F S IEN=$ O(^RCT(349 ,"SDT",IEN )) Q:IEN=" " S TDT(I EN)=""
	9075	"RTN","RCC PCT",21,0)
	9076	W @IOF W !!,"The fo llowing Pa tient Stat ement Date s are avai lable for the Totals Report:", !
	9077	"RTN","RCC PCT",22,0)
	9078	S (TDT1,F IRST,LAST) ="" F S T DT1=$O(TDT (TDT1)) Q: TDT1="" D
	9079	"RTN","RCC PCT",23,0)
	9080	.S TDT3=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",T DT1,0)),0) ,"^",9) W !,$$DATE^R CCPCPS1(TD T3)
	9081	"RTN","RCC PCT",24,0)
	9082	.I TDT3<F IRST S FIR ST=TDT3
	9083	"RTN","RCC PCT",25,0)
	9084	.I TDT3>L AST S LAST =TDT3
	9085	"RTN","RCC PCT",26,0)
	9086	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9087	"RTN","RCC PCT",27,0)
	9088	S DIR(0)= "YAO"
	9089	"RTN","RCC PCT",28,0)
	9090	S DIR("B" )="Y"
	9091	"RTN","RCC PCT",29,0)
	9092	S DIR("A" )="Do you want to pr int a sing le total f or ALL the available dates? "
	9093	"RTN","RCC PCT",30,0)
	9094	D ^DIR
	9095	"RTN","RCC PCT",31,0)
	9096	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9097	"RTN","RCC PCT",32,0)
	9098	I Y=1 D Q
	9099	"RTN","RCC PCT",33,0)
	9100	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	9101	"RTN","RCC PCT",34,0)
	9102	.I $D(IO( "Q")) D Q
	9103	"RTN","RCC PCT",35,0)
	9104	..S Q=1
	9105	"RTN","RCC PCT",36,0)
	9106	..S ZTRTN ="STARTS^R CCPCT",ZTD ESC="CBSS ALL PATIEN T STATEMEN TS TOTAL R EPORT"
	9107	"RTN","RCC PCT",37,0)
	9108	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	9109	"RTN","RCC PCT",38,0)
	9110	..D ^%ZTL OAD
	9111	"RTN","RCC PCT",39,0)
	9112	..K ZTRTN ,ZTDESC,ZT SAVE
	9113	"RTN","RCC PCT",40,0)
	9114	.E D STA RTS Q
	9115	"RTN","RCC PCT",41,0)
	9116	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9117	"RTN","RCC PCT",42,0)
	9118	S DIR(0)= "YAO"
	9119	"RTN","RCC PCT",43,0)
	9120	S DIR("B" )="Y"
	9121	"RTN","RCC PCT",44,0)
	9122	S DIR("A" )="Do you want to pr int separa te totals for ALL th e availabl e dates? "
	9123	"RTN","RCC PCT",45,0)
	9124	D ^DIR
	9125	"RTN","RCC PCT",46,0)
	9126	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9127	"RTN","RCC PCT",47,0)
	9128	I Y=1 D Q
	9129	"RTN","RCC PCT",48,0)
	9130	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	9131	"RTN","RCC PCT",49,0)
	9132	.I $D(IO( "Q")) D Q
	9133	"RTN","RCC PCT",50,0)
	9134	..S Q=1
	9135	"RTN","RCC PCT",51,0)
	9136	..S ZTRTN ="START^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	9137	"RTN","RCC PCT",52,0)
	9138	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	9139	"RTN","RCC PCT",53,0)
	9140	..D ^%ZTL OAD
	9141	"RTN","RCC PCT",54,0)
	9142	..K ZTRTN ,ZTDESC,ZT SAVE
	9143	"RTN","RCC PCT",55,0)
	9144	.E D STA RT Q
	9145	"RTN","RCC PCT",56,0)
	9146	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9147	"RTN","RCC PCT",57,0)
	9148	S DIR(0)= "DAO^"_FIR ST_":"_LAS T_":EX^K:' $D(TDT(+$E (Y,6,7))) X"
	9149	"RTN","RCC PCT",58,0)
	9150	S DIR("A" )="Enter a single Pa tient Stat ement date from list above: "
	9151	"RTN","RCC PCT",59,0)
	9152	S DIR("?" )="Enter a single Pa tient Stat ement date from list above or ^ to exit. "
	9153	"RTN","RCC PCT",60,0)
	9154	D ^DIR
	9155	"RTN","RCC PCT",61,0)
	9156	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9157	"RTN","RCC PCT",62,0)
	9158	S Y1=+$E( Y,6,7),Y2= Y
	9159	"RTN","RCC PCT",63,0)
	9160	;I '$D(TD T(Y1)) W ! ,"There ar e no recor ds for tha t date." Q
	9161	"RTN","RCC PCT",64,0)
	9162	D HOME^%Z IS S %ZIS= "AEQ" D ^% ZIS Q:POP
	9163	"RTN","RCC PCT",65,0)
	9164	I $D(IO(" Q")) D Q
	9165	"RTN","RCC PCT",66,0)
	9166	.S Q=1
	9167	"RTN","RCC PCT",67,0)
	9168	.S ZTRTN= "START1^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	9169	"RTN","RCC PCT",68,0)
	9170	.S ZTSAVE ("Q")="",Z TSAVE("Y1" )="",ZTSAV E("Y2")=""
	9171	"RTN","RCC PCT",69,0)
	9172	.D ^%ZTLO AD
	9173	"RTN","RCC PCT",70,0)
	9174	.K ZTRTN, ZTDESC,ZTS AVE
	9175	"RTN","RCC PCT",71,0)
	9176	START1 ;Th is will pr int a summ ary total for a sing le date
	9177	"RTN","RCC PCT",72,0)
	9178	N PTOT,TT OT,X,D
	9179	"RTN","RCC PCT",73,0)
	9180	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9181	"RTN","RCC PCT",74,0)
	9182	U IO S (T TOT,X)=0 F S X=$O(^ RCT(349,"S DT",Y1,X)) Q:'X I $ D(^RCT(349 ,X,0)) S
	9183	TTOT=$P(^R CT(349,X,0 ),"^",7)+T TOT
	9184	"RTN","RCC PCT",75,0)
	9185	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,"STD T",Y2,X)) Q:'X I $G (^RCPS(349 .2,X,6)) S PTOT=PTOT +1
	9186	"RTN","RCC PCT",76,0)
	9187	I IOST?1" C".E W @IO F
	9188	"RTN","RCC PCT",77,0)
	9189	W !,?10," CBSS Messa ge Totals for ",$$DA TE^RCCPCPS 1(Y2),!!
	9190	"RTN","RCC PCT",78,0)
	9191	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	9192	"RTN","RCC PCT",79,0)
	9193	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	9194	"RTN","RCC PCT",80,0)
	9195	W !,"==== ========== ========== ======="
	9196	"RTN","RCC PCT",81,0)
	9197	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	9198	"RTN","RCC PCT",82,0)
	9199	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	9200	"RTN","RCC PCT",83,0)
	9201	Q
	9202	"RTN","RCC PCT",84,0)
	9203	START ;Thi s will pri nt separat e totals f or all ava ilable sta tement dat es
	9204	"RTN","RCC PCT",85,0)
	9205	N PTOT,TT OT,X,X1,DA TE
	9206	"RTN","RCC PCT",86,0)
	9207	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9208	"RTN","RCC PCT",87,0)
	9209	S (TTOT,P TOT,X,X1)= 0 S DATE=" "
	9210	"RTN","RCC PCT",88,0)
	9211	U IO S (T DT1,TDT2)= ""
	9212	"RTN","RCC PCT",89,0)
	9213	I IOST?1" C".E W @IO F
	9214	"RTN","RCC PCT",90,0)
	9215	F S TDT1 =$O(TDT(TD T1)) Q:TDT 1="" D I $D(DTOUT) !$D(DUOUT) !$D(DIRUT) !$D(DIROUT ) Q
	9216	"RTN","RCC PCT",91,0)
	9217	.I X="^" Q
	9218	"RTN","RCC PCT",92,0)
	9219	.S TTOT=0
	9220	"RTN","RCC PCT",93,0)
	9221	.F S TDT 2=$O(^RCT( 349,"SDT", TDT1,TDT2) ) Q:TDT2=" " D
	9222	"RTN","RCC PCT",94,0)
	9223	..S Y=$P( ^RCT(349,T DT2,0),"^" ,9)
	9224	"RTN","RCC PCT",95,0)
	9225	..S Y1=+$ E(Y,3,4),D ATE=$$DATE ^RCCPCPS1( Y)
	9226	"RTN","RCC PCT",96,0)
	9227	..S X=Y D ^%DT
	9228	"RTN","RCC PCT",97,0)
	9229	..I $D(^R CT(349,TDT 2,0)) S TT OT=$P(^RCT (349,TDT2, 0),"^",7)+ TTOT
	9230	"RTN","RCC PCT",98,0)
	9231	..S PTOT= 0,X1="" I $D(^RCPS(3 49.2,"STDT ",Y)) F S X1=$O(^RC PS(349.2," STDT",Y,X1 )) Q:'X1 I
	9232	$G(^RCPS(3 49.2,X1,6) ) S PTOT=P TOT+1
	9233	"RTN","RCC PCT",99,0)
	9234	.W !,?10, "CBSS Mess age Totals for ",DAT E,!!
	9235	"RTN","RCC PCT",100,0 )
	9236	.W "Trans mission St atement To tal : ",$ J(TTOT,9)
	9237	"RTN","RCC PCT",101,0 )
	9238	.W !,"CBS S Statemen ts Printed Total : " ,$J(PTOT,9 )
	9239	"RTN","RCC PCT",102,0 )
	9240	.W !,"=== ========== ========== ========"
	9241	"RTN","RCC PCT",103,0 )
	9242	.W !,"Tot al Not Pri nted : " ,$J(TTOT-P TOT,9),!
	9243	"RTN","RCC PCT",104,0 )
	9244	.I '$D(Q) I $Y+4>IO SL D
	9245	"RTN","RCC PCT",105,0 )
	9246	..S DIR(0 )="E" D ^D IR I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	9247	"RTN","RCC PCT",106,0 )
	9248	..W @IOF
	9249	"RTN","RCC PCT",107,0 )
	9250	I X="^" Q
	9251	"RTN","RCC PCT",108,0 )
	9252	W !!!," ****** ****** ****** ****** ******** *"
	9253	"RTN","RCC PCT",109,0 )
	9254	STARTS ; T his will p rint the s ummary tot al for ALL available statement s
	9255	"RTN","RCC PCT",110,0 )
	9256	N DATE,PT OT,TTOT,X, D
	9257	"RTN","RCC PCT",111,0 )
	9258	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9259	"RTN","RCC PCT",112,0 )
	9260	U IO S (T TOT,D)=0 F S D=$O(T DT(D)) Q:D ="" S X=0 F S X=$O (^RCT(349, "SDT",D,X) ) Q:X="" I
	9261	$D(^RCT(34 9,X,0)) S TTOT=$P(^R CT(349,X,0 ),"^",7)+T TOT
	9262	"RTN","RCC PCT",113,0 )
	9263	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,X)) Q:'X I $G (^(X,6)) S PTOT=PTOT +1
	9264	"RTN","RCC PCT",114,0 )
	9265	W !!,?10, "CBSS Mess age Totals for ALL a vailable d ates ",!!
	9266	"RTN","RCC PCT",115,0 )
	9267	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	9268	"RTN","RCC PCT",116,0 )
	9269	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	9270	"RTN","RCC PCT",117,0 )
	9271	W !,"==== ========== ========== ======="
	9272	"RTN","RCC PCT",118,0 )
	9273	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	9274	"RTN","RCC PCT",119,0 )
	9275	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	9276	"RTN","RCD PBTLM")
	9277	0^26^B5884 9422^B4947 6140
	9278	"RTN","RCD PBTLM",1,0 )
	9279	RCDPBTLM ; WISC/RFJ - bill tran sactions L ist Manage r top rout ine ;1 Jun 99
	9280	"RTN","RCD PBTLM",2,0 )
	9281	;;4.5;Acc ounts Rece ivable;1 14,148,153 ,168,169,1 98,247,271 ,276,315,3 13;Mar 2 0, 1995;Bu ild 131
	9282	"RTN","RCD PBTLM",3,0 )
	9283	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9284	"RTN","RCD PBTLM",4,0 )
	9285	;
	9286	"RTN","RCD PBTLM",5,0 )
	9287	; Referen ce to $$RE C^IBRFN su pported by DBIA 2031
	9288	"RTN","RCD PBTLM",6,0 )
	9289	;
	9290	"RTN","RCD PBTLM",7,0 )
	9291	; called from menu option (1 9)
	9292	"RTN","RCD PBTLM",8,0 )
	9293	;
	9294	"RTN","RCD PBTLM",9,0 )
	9295	N RCBILLD A,RCDPFXIT
	9296	"RTN","RCD PBTLM",10, 0)
	9297	;
	9298	"RTN","RCD PBTLM",11, 0)
	9299	F D Q:' RCBILLDA
	9300	"RTN","RCD PBTLM",12, 0)
	9301	. W !! S RCBILLDA =$$SELBILL
	9302	"RTN","RCD PBTLM",13, 0)
	9303	. I RCB ILLDA<1 S RCBILLDA=0 Q
	9304	"RTN","RCD PBTLM",14, 0)
	9305	. D EN^ VALM("RCDP TRANSACTI ONS LIST")
	9306	"RTN","RCD PBTLM",15, 0)
	9307	. ; fa st exit
	9308	"RTN","RCD PBTLM",16, 0)
	9309	. I $G( RCDPFXIT) S RCBILLDA =0
	9310	"RTN","RCD PBTLM",17, 0)
	9311	Q
	9312	"RTN","RCD PBTLM",18, 0)
	9313	;
	9314	"RTN","RCD PBTLM",19, 0)
	9315	;
	9316	"RTN","RCD PBTLM",20, 0)
	9317	INIT ; in itializati on for lis t manager list
	9318	"RTN","RCD PBTLM",21, 0)
	9319	; requir es rcbilld a
	9320	"RTN","RCD PBTLM",22, 0)
	9321	; PRCA3 .5315 - R eplaced "^ " with VA Standard V ariable U throughout
	9322	"RTN","RCD PBTLM",23, 0)
	9323	N ADMIN,D ATE,RCLINE ,RCLIST,RC TOTAL,RCTR AN,RCTRAND A
	9324	"RTN","RCD PBTLM",24, 0)
	9325	K ^TMP("R CDPBTLM",$ J),^TMP("V ALM VIDEO" ,$J)
	9326	"RTN","RCD PBTLM",25, 0)
	9327	;
	9328	"RTN","RCD PBTLM",26, 0)
	9329	; fast e xit
	9330	"RTN","RCD PBTLM",27, 0)
	9331	I $G(RCDP FXIT) S VA LMQUIT=1 Q
	9332	"RTN","RCD PBTLM",28, 0)
	9333	;
	9334	"RTN","RCD PBTLM",29, 0)
	9335	; set th e List Man ager line number
	9336	"RTN","RCD PBTLM",30, 0)
	9337	S RCLINE= 0
	9338	"RTN","RCD PBTLM",31, 0)
	9339	; set th e List Man ager trans action num ber
	9340	"RTN","RCD PBTLM",32, 0)
	9341	S RCTRAN= 0
	9342	"RTN","RCD PBTLM",33, 0)
	9343	;
	9344	"RTN","RCD PBTLM",34, 0)
	9345	; get tr ansactions and balan ce for bil l
	9346	"RTN","RCD PBTLM",35, 0)
	9347	S RCTOTAL =$$GETTRAN S(RCBILLDA )
	9348	"RTN","RCD PBTLM",36, 0)
	9349	;
	9350	"RTN","RCD PBTLM",37, 0)
	9351	S DATE="" F S DATE =$O(RCLIST (DATE)) Q: 'DATE D
	9352	"RTN","RCD PBTLM",38, 0)
	9353	. S RCT RANDA="" F S RCTRAN DA=$O(RCLI ST(DATE,RC TRANDA)) Q :RCTRANDA= "" D
	9354	"RTN","RCD PBTLM",39, 0)
	9355	. . S RCLINE=RC LINE+1
	9356	"RTN","RCD PBTLM",40, 0)
	9357	. . ;
	9358	"RTN","RCD PBTLM",41, 0)
	9359	. . ; create a n index ar ray for tr ansaction lookup in list
	9360	"RTN","RCD PBTLM",42, 0)
	9361	. . I RCTRANDA D
	9362	"RTN","RCD PBTLM",43, 0)
	9363	. . . S RCTRA N=RCTRAN+1
	9364	"RTN","RCD PBTLM",44, 0)
	9365	. . . S ^TMP( "RCDPBTLM" ,$J,"IDX", RCTRAN,RCT RAN)=RCTRA NDA
	9366	"RTN","RCD PBTLM",45, 0)
	9367	. . . D SET^R CDPAPLI(RC TRAN,RCLIN E,1,80,0,I ORVON,IORV OFF)
	9368	"RTN","RCD PBTLM",46, 0)
	9369	. . ;
	9370	"RTN","RCD PBTLM",47, 0)
	9371	. . D SET^RCDPA PLI($S(RCT RANDA:RCTR ANDA,1:" " ),RCLINE,6 ,80) ; PRC A4.5315 Incr left margin
	9372	"RTN","RCD PBTLM",48, 0)
	9373	. . D SET^RCDPA PLI($E(DAT E,4,5)_"/" _$E(DATE,6 ,7)_"/"_$E (DATE,2,3) ,RCLINE,13 ,21)
	9374	"RTN","RCD PBTLM",49, 0)
	9375	. . D
	9376	SET^RCDPAP LI($TR($P( RCLIST(DAT E,RCTRANDA ),U),"ABCD EFGHIJKLMN OPQRSTUVWX YZ","abcde fghijkl
	9377	mnopqrstuv wxyz"),RCL INE,25,50)
	9378	"RTN","RCD PBTLM",50, 0)
	9379	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),U,2),9,2 ),RCLINE,5 3,62)
	9380	"RTN","RCD PBTLM",51, 0)
	9381	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),U,3),9,2 ),RCLINE,6 2,71)
	9382	"RTN","RCD PBTLM",52, 0)
	9383	. . ; add mars hal fee an d court co st to crea te admin d ollars
	9384	"RTN","RCD PBTLM",53, 0)
	9385	. . S
	9386	ADMIN=$P(R CLIST(DATE ,RCTRANDA) ,U,4)+$P(R CLIST(DATE ,RCTRANDA) ,U,5)+$P(R CLIST(DATE ,RCTRAND
	9387	A),U,6)
	9388	"RTN","RCD PBTLM",54, 0)
	9389	. . D SET^RCDPA PLI($J(ADM IN,9,2),RC LINE,71,80 )
	9390	"RTN","RCD PBTLM",55, 0)
	9391	;
	9392	"RTN","RCD PBTLM",56, 0)
	9393	; show t otals
	9394	"RTN","RCD PBTLM",57, 0)
	9395	S RCLINE= RCLINE+1
	9396	"RTN","RCD PBTLM",58, 0)
	9397	D SET^RCD PAPLI(" - -------- - ------- -- ------",RC LINE,1,80)
	9398	"RTN","RCD PBTLM",59, 0)
	9399	S RCLINE= RCLINE+1
	9400	"RTN","RCD PBTLM",60, 0)
	9401	D SET^RCD PAPLI(" TOTAL BALA NCE FOR BI LL",RCLINE ,1,80)
	9402	"RTN","RCD PBTLM",61, 0)
	9403	D SET^RCD PAPLI($J($ P(RCTOTAL, U,1),9,2), RCLINE,53, 62)
	9404	"RTN","RCD PBTLM",62, 0)
	9405	D SET^RCD PAPLI($J($ P(RCTOTAL, U,2),9,2), RCLINE,62, 71)
	9406	"RTN","RCD PBTLM",63, 0)
	9407	D SET^RCD PAPLI($J($ P(RCTOTAL, U,3)+$P(RC TOTAL,U,4) +$P(RCTOTA L,U,5),9,2 ),RCLINE,7 1,80)
	9408	"RTN","RCD PBTLM",64, 0)
	9409	;
	9410	"RTN","RCD PBTLM",65, 0)
	9411	; compar e totals t o what is stored in the file
	9412	"RTN","RCD PBTLM",66, 0)
	9413	N RCDATA7 ,RCFOUT
	9414	"RTN","RCD PBTLM",67, 0)
	9415	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
	9416	"RTN","RCD PBTLM",68, 0)
	9417	; for a write-off bill, the balance sh ould equal all zeros , for
	9418	"RTN","RCD PBTLM",69, 0)
	9419	; these bills, nod e 7 is the write-off amount, s o for the out of
	9420	"RTN","RCD PBTLM",70, 0)
	9421	; balanc e check to work, nod e 7 needs to be adju sted to al l zeros
	9422	"RTN","RCD PBTLM",71, 0)
	9423	I $P(^PRC A(430,RCBI LLDA,0),U, 8)=23 S RC DATA7="0^0 ^0^0^0"
	9424	"RTN","RCD PBTLM",72, 0)
	9425	I +$P(RCD ATA7,U,1)' =+$P(RCTOT AL,U,1) S RCFOUT=1
	9426	"RTN","RCD PBTLM",73, 0)
	9427	I +$P(RCD ATA7,U,2)' =+$P(RCTOT AL,U,2) S RCFOUT=1
	9428	"RTN","RCD PBTLM",74, 0)
	9429	I ($P(RCD ATA7,U,3)+ $P(RCDATA7 ,U,4)+$P(R CDATA7,U,5 ))'=+$P(RC TOTAL,U,3) S RCFOUT= 1
	9430	"RTN","RCD PBTLM",75, 0)
	9431	I $G(RCFO UT) D
	9432	"RTN","RCD PBTLM",76, 0)
	9433	. S RCL INE=RCLINE +1
	9434	"RTN","RCD PBTLM",77, 0)
	9435	. D SET ^RCDPAPLI( " ",RCLINE ,1,80)
	9436	"RTN","RCD PBTLM",78, 0)
	9437	. S RCL INE=RCLINE +1
	9438	"RTN","RCD PBTLM",79, 0)
	9439	. D SET ^RCDPAPLI( " STORED BALANCE FO R BILL ( INCORRECT )",RCLI NE,1,80)
	9440	"RTN","RCD PBTLM",80, 0)
	9441	. D SET ^RCDPAPLI( $J($P(RCDA TA7,U,1),9 ,2),RCLINE ,53,62)
	9442	"RTN","RCD PBTLM",81, 0)
	9443	. D SET ^RCDPAPLI( $J($P(RCDA TA7,U,2),9 ,2),RCLINE ,62,71)
	9444	"RTN","RCD PBTLM",82, 0)
	9445	. D SET ^RCDPAPLI( $J($P(RCDA TA7,U,3)+$ P(RCDATA7, U,4)+$P(RC DATA7,U,5) ,9,2),RCLI NE,71,80)
	9446	"RTN","RCD PBTLM",83, 0)
	9447	;
	9448	"RTN","RCD PBTLM",84, 0)
	9449	; set va lmcnt to n umber of l ines in th e list
	9450	"RTN","RCD PBTLM",85, 0)
	9451	S VALMCNT =RCLINE
	9452	"RTN","RCD PBTLM",86, 0)
	9453	D HDR
	9454	"RTN","RCD PBTLM",87, 0)
	9455	Q
	9456	"RTN","RCD PBTLM",88, 0)
	9457	;
	9458	"RTN","RCD PBTLM",89, 0)
	9459	;
	9460	"RTN","RCD PBTLM",90, 0)
	9461	HDR ; hea der code f or list ma nager disp lay
	9462	"RTN","RCD PBTLM",91, 0)
	9463	; requir es rcbilld a
	9464	"RTN","RCD PBTLM",92, 0)
	9465	N %,DATA, RCDEBTDA,R CDPDATA
	9466	"RTN","RCD PBTLM",93, 0)
	9467	;
	9468	"RTN","RCD PBTLM",94, 0)
	9469	D DIQ430^ RCDPBPLM(R CBILLDA,". 01;8;")
	9470	"RTN","RCD PBTLM",95, 0)
	9471	;
	9472	"RTN","RCD PBTLM",96, 0)
	9473	S RCDEBTD A=$P(^PRCA (430,RCBIL LDA,0),U,9 )
	9474	"RTN","RCD PBTLM",97, 0)
	9475	S DATA=$$ ACCNTHDR^R CDPAPLM(RC DEBTDA)
	9476	"RTN","RCD PBTLM",98, 0)
	9477	;
	9478	"RTN","RCD PBTLM",99, 0)
	9479	S %="",$P (%," ",80) =""
	9480	"RTN","RCD PBTLM",100 ,0)
	9481	; PRCA4. 5276 - ge t EEOB ind icator for 1st/3rd p arty payme nt and att ach to bil l when app licable
	9482	"RTN","RCD PBTLM",101 ,0)
	9483	S PRCOUT= $$COMP3^PR CAAPR(RCBI LLDA)
	9484	"RTN","RCD PBTLM",102 ,0)
	9485	I PRCOUT' ="%" S PRC OUT=$$IBEE OBCK^PRCAA PR1(RCBILL DA)
	9486	"RTN","RCD PBTLM",103 ,0)
	9487	S VALMHDR (1)=$E("Bi ll #: "_$G (PRCOUT)_$ G(RCDPDATA (430,RCBIL LDA,.01,"E "))_%,1,25 )_"Account :
	9488	"_$P(DATA, U)_$P(DATA ,U,2)
	9489	"RTN","RCD PBTLM",104 ,0)
	9490	S VALMHDR (2)=$E("St atus: "_$G (RCDPDATA( 430,RCBILL DA,8,"E")) _%,1,25)_$ E(" Addr :
	9491	"_$P(DATA, U,4)_", "_ $P(DATA,U, 7)_", "_$P (DATA,U,8) _" "_$P(D ATA,U,9)_% ,1,55)
	9492	"RTN","RCD PBTLM",105 ,0)
	9493	; PRCA4. 5276 - sh ow caption for user
	9494	"RTN","RCD PBTLM",106 ,0)
	9495	S VALMSG= "\|% EEOB \| Enter ?? for more a ctions \|" ; PRCA4.5 276
	9496	"RTN","RCD PBTLM",107 ,0)
	9497	Q
	9498	"RTN","RCD PBTLM",108 ,0)
	9499	S VALMHDR (3)=" "_I ORVON_$E(" Bill Balan ce:
	9500	"_$J($P(RC TOTAL,U)+$ P(RCTOTAL, U,2)+$P(RC TOTAL,U,3) +$P(RCTOTA L,U,4)+$P( RCTOTAL,U, 5),0,2)_%, 1,
	9501	23)_IORVOF F_" Phone : "_$P(DAT A,U,10)
	9502	"RTN","RCD PBTLM",109 ,0)
	9503	Q
	9504	"RTN","RCD PBTLM",110 ,0)
	9505	;
	9506	"RTN","RCD PBTLM",111 ,0)
	9507	;
	9508	"RTN","RCD PBTLM",112 ,0)
	9509	EXIT ; ex it list ma nager opti on and cle an up
	9510	"RTN","RCD PBTLM",113 ,0)
	9511	K ^TMP("R CDPBTLM",$ J),^TMP("R CDPBTLMX", $J)
	9512	"RTN","RCD PBTLM",114 ,0)
	9513	Q
	9514	"RTN","RCD PBTLM",115 ,0)
	9515	;
	9516	"RTN","RCD PBTLM",116 ,0)
	9517	;
	9518	"RTN","RCD PBTLM",117 ,0)
	9519	SELBILL() ; select a bill
	9520	"RTN","RCD PBTLM",118 ,0)
	9521	; return s -1 for t imeout or ^, 0 for n o selectio n, or ien of bill
	9522	"RTN","RCD PBTLM",119 ,0)
	9523	N %,%Y,C, DIC,DTOUT, DUOUT,RCBE FLUP,X,Y
	9524	"RTN","RCD PBTLM",120 ,0)
	9525	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	9526	"RTN","RCD PBTLM",121 ,0)
	9527	N RCY,DIR ,DIRUT
	9528	"RTN","RCD PBTLM",122 ,0)
	9529	; allow u ser to get the recor d using bi ll# or ECM E#
	9530	"RTN","RCD PBTLM",123 ,0)
	9531	S DIR("A" )="Select (B)ILL or (E)CME#: "
	9532	"RTN","RCD PBTLM",124 ,0)
	9533	S DIR(0)= "SA^B:BILL NUMBER;E: ECME#"
	9534	"RTN","RCD PBTLM",125 ,0)
	9535	S DIR("B" )="B"
	9536	"RTN","RCD PBTLM",126 ,0)
	9537	D ^DIR K DIR I $D(D IRUT) Q 0
	9538	"RTN","RCD PBTLM",127 ,0)
	9539	S RCY=Y
	9540	"RTN","RCD PBTLM",128 ,0)
	9541	I RCY="E" Q $$SELEC ME
	9542	"RTN","RCD PBTLM",129 ,0)
	9543	S DIC="^P RCA(430,", DIC(0)="QE AM",DIC("A ")="Select BILL: "
	9544	"RTN","RCD PBTLM",130 ,0)
	9545	S DIC("W" )="D DICW^ RCBEUBI1"
	9546	"RTN","RCD PBTLM",131 ,0)
	9547	; specia l lookup o n input
	9548	"RTN","RCD PBTLM",132 ,0)
	9549	S RCBEFLU P=1
	9550	"RTN","RCD PBTLM",133 ,0)
	9551	D ^DIC
	9552	"RTN","RCD PBTLM",134 ,0)
	9553	I Y<0,'$G (DUOUT),'$ G(DTOUT) S Y=0
	9554	"RTN","RCD PBTLM",135 ,0)
	9555	Q +Y
	9556	"RTN","RCD PBTLM",136 ,0)
	9557	;
	9558	"RTN","RCD PBTLM",137 ,0)
	9559	;
	9560	"RTN","RCD PBTLM",138 ,0)
	9561	GETTRANS(B ILLDA) ; original a mount goes first for bill
	9562	"RTN","RCD PBTLM",139 ,0)
	9563	; return s list of transactio ns in
	9564	"RTN","RCD PBTLM",140 ,0)
	9565	; rclist (date,tran da)=tranty pe ^ princ iple ^ int erest ^ ad min
	9566	"RTN","RCD PBTLM",141 ,0)
	9567	; return s principl e balance ^ interest balance ^ admin bal ance
	9568	"RTN","RCD PBTLM",142 ,0)
	9569	; ^ marshall fee balan ce ^ court cost bala nce
	9570	"RTN","RCD PBTLM",143 ,0)
	9571	N
	9572	%,ADMBAL,A MTDISP,CCB AL,DATA0,D ATA1,DATA9 ,DATE,INTB AL,MFBAL,P RINBAL,RCD PDATA,RCUS ER,TR
	9573	ANDA,VALUE
	9574	"RTN","RCD PBTLM",144 ,0)
	9575	;
	9576	"RTN","RCD PBTLM",145 ,0)
	9577	D DIQ430^ RCDPBPLM(B ILLDA,"3;6 0;")
	9578	"RTN","RCD PBTLM",146 ,0)
	9579	;
	9580	"RTN","RCD PBTLM",147 ,0)
	9581	K RCLIST
	9582	"RTN","RCD PBTLM",148 ,0)
	9583	S (ADMBAL ,CCBAL,INT BAL,MFBAL, PRINBAL)=0
	9584	"RTN","RCD PBTLM",149 ,0)
	9585	S PRINBAL =RCDPDATA( 430,BILLDA ,3,"I")
	9586	"RTN","RCD PBTLM",150 ,0)
	9587	; loop t ransaction and add t o list
	9588	"RTN","RCD PBTLM",151 ,0)
	9589	S TRANDA= 0 F S TRA NDA=$O(^PR CA(433,"C" ,BILLDA,TR ANDA)) Q:' TRANDA D
	9590	"RTN","RCD PBTLM",152 ,0)
	9591	. S DAT A0=$G(^PRC A(433,TRAN DA,0)) ;P RCA4.531 5 Needed f or User ID
	9592	"RTN","RCD PBTLM",153 ,0)
	9593	. S RCU SER=$P(DAT A0,U,9) ; PRCA4.53 15
	9594	"RTN","RCD PBTLM",154 ,0)
	9595	. S RCU SER=$$GET1 ^DIQ(200,R CUSER_",", 1) ;PRCA* 4.5*315
	9596	"RTN","RCD PBTLM",155 ,0)
	9597	. S DAT A1=$G(^PRC A(433,TRAN DA,1))
	9598	"RTN","RCD PBTLM",156 ,0)
	9599	. S DAT E=$P(DATA1 ,U,9) I 'D ATE Q
	9600	"RTN","RCD PBTLM",157 ,0)
	9601	. ;
	9602	"RTN","RCD PBTLM",158 ,0)
	9603	. ; Don 't include transacti ons that h ave the IN COMPLETE T RANSACTION FLAG (#10 ) set to Y ES and
	9604	"RTN","RCD PBTLM",159 ,0)
	9605	. ; thi s transact ion was pr eviously u sed by the auto-corr ect progra m to corre ct an earl ier issue.
	9606	PRCA4.53 13
	9607	"RTN","RCD PBTLM",160 ,0)
	9608	. S DAT A9=$G(^PRC A(433,TRAN DA,9))
	9609	"RTN","RCD PBTLM",161 ,0)
	9610	. ; Che ck for Inc omplete an d previous ly fixed b y auto-cor rect
	9611	"RTN","RCD PBTLM",162 ,0)
	9612	. I $P( DATA0,U,10 ),($P(DATA 9,U,4)) S VALUE="" Q
	9613	"RTN","RCD PBTLM",163 ,0)
	9614	. ;
	9615	"RTN","RCD PBTLM",164 ,0)
	9616	. S VAL UE=$$TRANV ALU(TRANDA ) ;PRCA4 .5315 (wa s I VALUE= "" Q)
	9617	"RTN","RCD PBTLM",165 ,0)
	9618	. S RCL IST($P(DAT E,"."),TRA NDA)=$P($G (^PRCA(430 .3,+$P(DAT A1,U,2),0) ),U)_VALUE
	9619	"RTN","RCD PBTLM",166 ,0)
	9620	. S $P( RCLIST($P( DATE,"."), TRANDA),U, 7)=RCUSER ;PRCA4.5 315
	9621	"RTN","RCD PBTLM",167 ,0)
	9622	. ;
	9623	"RTN","RCD PBTLM",168 ,0)
	9624	. ; ca lculate bi ll's balan ce
	9625	"RTN","RCD PBTLM",169 ,0)
	9626	. S PRI NBAL=PRINB AL+$P(VALU E,U,2)
	9627	"RTN","RCD PBTLM",170 ,0)
	9628	. S INT BAL=INTBAL +$P(VALUE, U,3)
	9629	"RTN","RCD PBTLM",171 ,0)
	9630	. S ADM BAL=ADMBAL +$P(VALUE, U,4)
	9631	"RTN","RCD PBTLM",172 ,0)
	9632	. S MFB AL=MFBAL+$ P(VALUE,U, 5)
	9633	"RTN","RCD PBTLM",173 ,0)
	9634	. S CCB AL=CCBAL+$ P(VALUE,U, 6)
	9635	"RTN","RCD PBTLM",174 ,0)
	9636	;
	9637	"RTN","RCD PBTLM",175 ,0)
	9638	S DATE=$G (RCDPDATA( 430,BILLDA ,60,"I"))
	9639	"RTN","RCD PBTLM",176 ,0)
	9640	; check to make su re activat ion date i s not grea ter than f irst trans action
	9641	"RTN","RCD PBTLM",177 ,0)
	9642	S %=$O(RC LIST(0)) I DATE>% S DATE=%
	9643	"RTN","RCD PBTLM",178 ,0)
	9644	S RCLIST( +$P(DATE," ."),0)="or iginal amo unt^"_RCDP DATA(430,B ILLDA,3,"I ")
	9645	"RTN","RCD PBTLM",179 ,0)
	9646	;
	9647	"RTN","RCD PBTLM",180 ,0)
	9648	Q PRINBAL _U_INTBAL_ U_ADMBAL_U _MFBAL_U_C CBAL
	9649	"RTN","RCD PBTLM",181 ,0)
	9650	;
	9651	"RTN","RCD PBTLM",182 ,0)
	9652	;
	9653	"RTN","RCD PBTLM",183 ,0)
	9654	TRANVALU(T RANDA) ; return the transacti on value a s displaye d (with + or - sign)
	9655	"RTN","RCD PBTLM",184 ,0)
	9656	N TYPE,VA LUE
	9657	"RTN","RCD PBTLM",185 ,0)
	9658	S VALUE=$ $TRANBAL^R CRJRCOT(TR ANDA)
	9659	"RTN","RCD PBTLM",186 ,0)
	9660	; no dol lars on tr ansaction
	9661	"RTN","RCD PBTLM",187 ,0)
	9662	I '$P(VAL UE,U),'$P( VALUE,U,2) ,'$P(VALUE ,U,3),'$P( VALUE,U,4) ,'$P(VALUE ,U,5) Q ""
	9663	"RTN","RCD PBTLM",188 ,0)
	9664	; check type for p ayments, e tc, make v alues (-) to subtrac t
	9665	"RTN","RCD PBTLM",189 ,0)
	9666	S TYPE=$P ($G(^PRCA( 433,TRANDA ,1)),U,2)
	9667	"RTN","RCD PBTLM",190 ,0)
	9668	I TYPE=2! (TYPE=8)!( TYPE=9)!(T YPE=10)!(T YPE=11)!(T YPE=14)!(T YPE=29)!(T YPE=34)!(T YPE=35)!(T YPE=41)
	9669	D
	9670	"RTN","RCD PBTLM",191 ,0)
	9671	. S $P( VALUE,U,1) =-$P(VALUE ,U,1)
	9672	"RTN","RCD PBTLM",192 ,0)
	9673	. S $P( VALUE,U,2) =-$P(VALUE ,U,2)
	9674	"RTN","RCD PBTLM",193 ,0)
	9675	. S $P( VALUE,U,3) =-$P(VALUE ,U,3)
	9676	"RTN","RCD PBTLM",194 ,0)
	9677	. S $P( VALUE,U,4) =-$P(VALUE ,U,4)
	9678	"RTN","RCD PBTLM",195 ,0)
	9679	. S $P( VALUE,U,5) =-$P(VALUE ,U,5)
	9680	"RTN","RCD PBTLM",196 ,0)
	9681	;
	9682	"RTN","RCD PBTLM",197 ,0)
	9683	; the fo llowing tr ansaction types shou ld not cha nge the bi lls balanc e
	9684	"RTN","RCD PBTLM",198 ,0)
	9685	; return the amoun t displaye d in the d escription and 0 for value
	9686	"RTN","RCD PBTLM",199 ,0)
	9687	; refe r to RC 3, refer to DOJ 4, ree stablish 5 , returned 6 and 32
	9688	"RTN","RCD PBTLM",200 ,0)
	9689	; repa yment plan 25, amend ed 33, sus pended 47, unsuspend ed 46
	9690	"RTN","RCD PBTLM",201 ,0)
	9691	K AMTDISP
	9692	"RTN","RCD PBTLM",202 ,0)
	9693	I TYPE=3! (TYPE=4)!( TYPE=5)!(T YPE=6)!(TY PE=25)!(TY PE=32)!(TY PE=33)!(TY PE=46)!(TY PE=47) D
	9694	"RTN","RCD PBTLM",203 ,0)
	9695	. S AMT DISP="
	9696	($"_$J($P( VALUE,U)+$ P(VALUE,U, 2)+$P(VALU E,U,3)+$P( VALUE,U,4) +$P(VALUE, U,5),0,2)_ ")"
	9697	"RTN","RCD PBTLM",204 ,0)
	9698	. S VAL UE=""
	9699	"RTN","RCD PBTLM",205 ,0)
	9700	Q $G(AMTD ISP)_U_VAL UE
	9701	"RTN","RCD PBTLM",206 ,0)
	9702	;
	9703	"RTN","RCD PBTLM",207 ,0)
	9704	SELECME() ;
	9705	"RTN","RCD PBTLM",208 ,0)
	9706	; functio n takes th e user inp ut of the ECME # to return a v alid ien o f file 430
	9707	"RTN","RCD PBTLM",209 ,0)
	9708	; if an i nvalid ECM E is evalu ated then the proces s keeps as king the u ser for EC ME #
	9709	"RTN","RCD PBTLM",210 ,0)
	9710	; until a valid ECM E# is ente red or unt il the use r enters a U or null value
	9711	"RTN","RCD PBTLM",211 ,0)
	9712	; output - returns the IEN of the recor d entry in the ACCOU NT RECEIVA BLE file ( #430) or " ??"
	9713	"RTN","RCD PBTLM",212 ,0)
	9714	N RCECME, RCBILL,DIR ,DIRUT,Y
	9715	"RTN","RCD PBTLM",213 ,0)
	9716	S DIR(0)= "FO^1:12^I X'?1.12N W !!,""Can not contai n alpha ch aracters"" K X"
	9717	"RTN","RCD PBTLM",214 ,0)
	9718	S DIR("A" )="Select ECME#"
	9719	"RTN","RCD PBTLM",215 ,0)
	9720	RET D ^DIR I $D(DIRU T) Q 0
	9721	"RTN","RCD PBTLM",216 ,0)
	9722	S RCECME= $S(+Y>0:Y, 1:0)
	9723	"RTN","RCD PBTLM",217 ,0)
	9724	S RCBILL= $$REC^IBRF N(RCECME) ; IA 20 31
	9725	"RTN","RCD PBTLM",218 ,0)
	9726	I RCBILL< 0 W !!,"?? " G RET
	9727	"RTN","RCD PBTLM",219 ,0)
	9728	E W !!,$ P($G(^PRCA (430,+RCBI LL,0)),U), " "
	9729	"RTN","RCD PBTLM",220 ,0)
	9730	Q RCBILL
	9731	"RTN","RCD PBTLM",221 ,0)
	9732	;RCDPBTLM
	9733	"VER")
	9734	8.0^22.2
	9735	"^DD",340, 340,.01,0)
	9736	DEBTOR^RV^ ^0;1^
	9737	"^DD",340, 340,.01,1, 0)
	9738	^.1
	9739	"^DD",340, 340,.01,1, 1,0)
	9740	340^B
	9741	"^DD",340, 340,.01,1, 1,1)
	9742	S ^RCD(340 ,"B",$E(X, 1,30),DA)= ""
	9743	"^DD",340, 340,.01,1, 1,2)
	9744	K ^RCD(340 ,"B",$E(X, 1,30),DA)
	9745	"^DD",340, 340,.01,1, 1,3)
	9746	Needed for look-up o f informat ion by Deb tor
	9747	"^DD",340, 340,.01,1, 1,"%D",0)
	9748	^^2^2^2931 014^^^^
	9749	"^DD",340, 340,.01,1, 1,"%D",1,0 )
	9750	This is th e regular FileMan 'B ' cross-re ference an d is used throughout the
	9751	"^DD",340, 340,.01,1, 1,"%D",2,0 )
	9752	AR package for users to look u p informat ion by deb tor.
	9753	"^DD",340, 340,.01,1, 2,0)
	9754	^^TRIGGER^ 340^.03
	9755	"^DD",340, 340,.01,1, 2,1)
	9756	X ^DD(340, .01,1,2,1. 3) I X S X =DIV S Y(1 )=$S($D(^R CD(340,D0, 0)):^(0),1 :"") S X=$ P(Y(1),U,3 ),X=X S DI U=X
	9757	K Y X ^DD( 340,.01,1, 2,1.1) X ^ DD(340,.01 ,1,2,1.4)
	9758	"^DD",340, 340,.01,1, 2,1.1)
	9759	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),";"),0), U)) S:X X= +X
	9760	"^DD",340, 340,.01,1, 2,1.3)
	9761	K DIV S DI V=X,D0=DA, DIV(0)=D0 S Y(0)=X S Y(1)=$S($ D(^RCD(340 ,D0,0)):^( 0),1:"") S
	9762	X=$P(Y(1), U,3)="",Y( 2)=X,Y(3)= X S X=Y(0) ,X=X S X=X [";DPT(",Y =X,X=Y(2), X=X&Y
	9763	"^DD",340, 340,.01,1, 2,1.4)
	9764	S DIH=$S($ D(^RCD(340 ,DIV(0),0) ):^(0),1:" "),DIV=X S $P(^(0),U ,3)=DIV,DI H=340,DIG= .03 D
	9765	^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	9766	"^DD",340, 340,.01,1, 2,2)
	9767	Q
	9768	"^DD",340, 340,.01,1, 2,3)
	9769	Needed for assigning statement days for patients
	9770	"^DD",340, 340,.01,1, 2,"%D",0)
	9771	^.101^2^2^ 3160502^^^
	9772	"^DD",340, 340,.01,1, 2,"%D",1,0 )
	9773	This cross -reference sets the statement day for ne w patients as determ ined
	9774	"^DD",340, 340,.01,1, 2,"%D",2,0 )
	9775	by the fir st two let ters of th e patient' s last nam e.
	9776	"^DD",340, 340,.01,1, 2,"CREATE CONDITION" )
	9777	STATEMENT DAY=""&(IN TERNAL(DEB TOR)[";DPT (")
	9778	"^DD",340, 340,.01,1, 2,"CREATE VALUE")
	9779	S X=$$ACSE T^RCCPCFN1 ($P(^DPT($ P($P(^RCD( 340,D0,0) ,U),";"),0 ),U) S:X X =+X
	9780	"^DD",340, 340,.01,1, 2,"DELETE VALUE")
	9781	NO EFFECT
	9782	"^DD",340, 340,.01,1, 2,"DT")
	9783	2961010
	9784	"^DD",340, 340,.01,1, 2,"FIELD")
	9785	STATEMENT DAY
	9786	"^DD",340, 340,.01,1, 3,0)
	9787	340^AB^MUM PS
	9788	"^DD",340, 340,.01,1, 3,1)
	9789	S ^RCD(340 ,"AB",$P(X ,";",2),DA )=""
	9790	"^DD",340, 340,.01,1, 3,2)
	9791	K ^RCD(340 ,"AB",$P(X ,";",2),DA )
	9792	"^DD",340, 340,.01,1, 3,3)
	9793	Needed to cross-refe rence debt or file by 'type' of debtor
	9794	"^DD",340, 340,.01,1, 3,"%D",0)
	9795	^^5^5^2931 014^^^^
	9796	"^DD",340, 340,.01,1, 3,"%D",1,0 )
	9797	This cross -reference allows ra pid look-u p of debto rs in the debtor fil e
	9798	"^DD",340, 340,.01,1, 3,"%D",2,0 )
	9799	by the 'ty pe' of deb tor. Ther e are five types of debtors (P atient,
	9800	"^DD",340, 340,.01,1, 3,"%D",3,0 )
	9801	Insurance Company, I nstitution , Vendor, and Person ). This a llows
	9802	"^DD",340, 340,.01,1, 3,"%D",4,0 )
	9803	the AR sof tware to s can the fi le for onl y a specif ic type of debtor
	9804	"^DD",340, 340,.01,1, 3,"%D",5,0 )
	9805	rather tha n having t o look at each entry .
	9806	"^DD",340, 340,.01,1, 3,"DT")
	9807	2930526
	9808	"^DD",340, 340,.01,1. 1)
	9809	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),"";""),0 ),U) S:X X =+X
	9810	"^DD",340, 340,.01,3)
	9811	Enter Debt or Informa tion
	9812	"^DD",340, 340,.01,7. 5)
	9813	S:$D(PRCAB T) DIC("V" )="I +Y(0) ="_$P("440 !(+Y(0)=4) ^440!(+Y(0 )=4)^440!( +Y(0)=200) ",U,PRCABT )
	9814	S:$D(PRCAT ) DIC("V") ="I
	9815	+Y(0)="_$S ("CP"[PRCA T:2,"FV"[P RCAT:440," T"[PRCAT:3 6,"N"[PRCA T:4,"O"[PR CAT:200,1: "200!(+Y(0 )=44
	9816	0)")
	9817	"^DD",340, 340,.01,21 ,0)
	9818	^^5^5^2970 219^^^^
	9819	"^DD",340, 340,.01,21 ,1,0)
	9820	This field contains the debtor to which this accou nt belongs to. An
	9821	"^DD",340, 340,.01,21 ,2,0)
	9822	account ca n belong t o an insur ance compa ny, vendor , institut ion, perso n,
	9823	"^DD",340, 340,.01,21 ,3,0)
	9824	or patient . Account s can be s et up for Medical Ca re Cost Re covery cha rges
	9825	"^DD",340, 340,.01,21 ,4,0)
	9826	and also f or non-ben efit debts , such as: Employee bills, Ex- employee b ills,
	9827	"^DD",340, 340,.01,21 ,5,0)
	9828	and Vendor bills.
	9829	"^DD",340, 340,.01,"D T")
	9830	3160428
	9831	"^DD",340, 340,.01,"V ",0)
	9832	^.12P^5^5
	9833	"^DD",340, 340,.01,"V ",1,0)
	9834	2^PATIENT^ 1^P^n^n
	9835	"^DD",340, 340,.01,"V ",1,1)
	9836
	9837	"^DD",340, 340,.01,"V ",1,2)
	9838
	9839	"^DD",340, 340,.01,"V ",2,0)
	9840	200^OTHER (PERSON)^2 ^O^n^y
	9841	"^DD",340, 340,.01,"V ",3,0)
	9842	36^3RD PAR TY^4^I^n^n
	9843	"^DD",340, 340,.01,"V ",4,0)
	9844	4^INSTITUT ION^5^N^n^ n
	9845	"^DD",340, 340,.01,"V ",5,0)
	9846	440^VENDOR ^3^V^n^n
	9847	"^DD",340, 340,.03,0)
	9848	STATEMENT DAY^NJ2,0^ ^0;3^K:+X' =X!(X>28)! (X<1)!(X?. E1"."1N.N) X
	9849	"^DD",340, 340,.03,1, 0)
	9850	^.1
	9851	"^DD",340, 340,.03,1, 1,0)
	9852	340^AC
	9853	"^DD",340, 340,.03,1, 1,1)
	9854	S ^RCD(340 ,"AC",$E(X ,1,30),DA) =""
	9855	"^DD",340, 340,.03,1, 1,2)
	9856	K ^RCD(340 ,"AC",$E(X ,1,30),DA)
	9857	"^DD",340, 340,.03,1, 1,3)
	9858	Needed for printing of patient statement s and foll ow-up lett ers
	9859	"^DD",340, 340,.03,1, 1,"%D",0)
	9860	^^4^4^2931 014^^^^
	9861	"^DD",340, 340,.03,1, 1,"%D",1,0 )
	9862	This cross -reference is used t o print pa tient stat ements and Vendor, P erson,
	9863	"^DD",340, 340,.03,1, 1,"%D",2,0 )
	9864	and Instit ution foll ow-up lett ers. Sinc e these ty pe of debt ors get no tified
	9865	"^DD",340, 340,.03,1, 1,"%D",3,0 )
	9866	based on t heir state ment day, this cross -reference allows ra pid look-u p
	9867	"^DD",340, 340,.03,1, 1,"%D",4,0 )
	9868	of which d ebtor is d ue a notif ication on a particu lar day.
	9869	"^DD",340, 340,.03,1, 1,"DT")
	9870	2930309
	9871	"^DD",340, 340,.03,3)
	9872	Type a Num ber betwee n 1 and 28 , 0 Decima l Digits
	9873	"^DD",340, 340,.03,5, 1,0)
	9874	340^.01^2
	9875	"^DD",340, 340,.03,21 ,0)
	9876	^^19^19^31 60428^
	9877	"^DD",340, 340,.03,21 ,1,0)
	9878	A statemen t day is a ssigned to all types of debtor s, except insurance
	9879	"^DD",340, 340,.03,21 ,2,0)
	9880	companies. A statem ent day is the day t hat a stat ement is g enerated o r a
	9881	"^DD",340, 340,.03,21 ,3,0)
	9882	follow-up letter is generated for non-be nefit debt s. Except for
	9883	"^DD",340, 340,.03,21 ,4,0)
	9884	Patient St atements w hich are g enerated t wo days pr ior to thi s day.
	9885	"^DD",340, 340,.03,21 ,5,0)
	9886	The AR pac kage will hold 'noti fications' from bein g sent unt il the
	9887	"^DD",340, 340,.03,21 ,6,0)
	9888	debtor's ' statement day' arriv es. This allows all activity since the
	9889	"^DD",340, 340,.03,21 ,7,0)
	9890	previous s tatement t o print an d update t he debtor on the acc ount
	9891	"^DD",340, 340,.03,21 ,8,0)
	9892	activity.
	9893	"^DD",340, 340,.03,21 ,9,0)
	9894
	9895	"^DD",340, 340,.03,21 ,10,0)
	9896	Patient st atement da ys never c hange, but Instituti on, Person , and Vend or
	9897	"^DD",340, 340,.03,21 ,11,0)
	9898	statement days are c hanged by the AR sof tware. Wh en these t ype debtor s
	9899	"^DD",340, 340,.03,21 ,12,0)
	9900	have a new active bi ll, the da te the new active bi ll is crea ted become s
	9901	"^DD",340, 340,.03,21 ,13,0)
	9902	their 'sta tement day '. This s tatement d ay remains in effect until no
	9903	"^DD",340, 340,.03,21 ,14,0)
	9904	active bil ls exist f or the deb tor, at wh ich time t he stateme nt day
	9905	"^DD",340, 340,.03,21 ,15,0)
	9906	is 'delete d'.
	9907	"^DD",340, 340,.03,21 ,16,0)
	9908
	9909	"^DD",340, 340,.03,21 ,17,0)
	9910	Insurance companies are notifi ed based o n a bill-s pecific da te.
	9911	"^DD",340, 340,.03,21 ,18,0)
	9912	Since insu rance comp anies have much more activity, they are notified
	9913	"^DD",340, 340,.03,21 ,19,0)
	9914	on a const ant basis depending on each in dividual b ill 'due-d ate'.
	9915	"^DD",340, 340,.03,"D T")
	9916	3160428
	9917	"^DD",340, 340,7.06,0 )
	9918	CURRENT CB S DEBT AMO UNT^NJ9,2^ ^7;6^S:X[" $" X=$P(X, "$",2) K:X '?."-".N.1 ".".2N!(X> 999999)!(X <-
	9919	999999) X
	9920	"^DD",340, 340,7.06,3 )
	9921	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	9922	"^DD",340, 340,7.06,2 1,0)
	9923	^^7^7^3160 401^
	9924	"^DD",340, 340,7.06,2 1,1,0)
	9925	This field stores th e debt amo unt curren tly
	9926	"^DD",340, 340,7.06,2 1,2,0)
	9927	updated to the Conso lidated Bi lling Stat ement Syst em
	9928	"^DD",340, 340,7.06,2 1,3,0)
	9929	CBSS. Thi s field is used to c ompare the current
	9930	"^DD",340, 340,7.06,2 1,4,0)
	9931	amount at the CBSS w ith the am ount curre ntly
	9932	"^DD",340, 340,7.06,2 1,5,0)
	9933	available for receiv ing paymen t. For in creases
	9934	"^DD",340, 340,7.06,2 1,6,0)
	9935	or decreas es, the de bt amount is forward ed to
	9936	"^DD",340, 340,7.06,2 1,7,0)
	9937	CBSS.
	9938	"^DD",340, 340,7.06," DT")
	9939	3160401
	9940	"^DD",341, 341,6.01,0 )
	9941	CCPC STATE MENT DATE^ D^^6;1^S % DT="EX" D ^%DT S X=Y K:X<1 X
	9942	"^DD",341, 341,6.01,1 ,0)
	9943	^.1
	9944	"^DD",341, 341,6.01,1 ,1,0)
	9945	341^STDT
	9946	"^DD",341, 341,6.01,1 ,1,1)
	9947	S ^RC(341, "STDT",$E( X,1,30),DA )=""
	9948	"^DD",341, 341,6.01,1 ,1,2)
	9949	K ^RC(341, "STDT",$E( X,1,30),DA )
	9950	"^DD",341, 341,6.01,1 ,1,"%D",0)
	9951	^.101^2^2^ 3160809^^
	9952	"^DD",341, 341,6.01,1 ,1,"%D",1, 0)
	9953	This cross reference is used t o sort and print eve nts by the ir Patient
	9954	"^DD",341, 341,6.01,1 ,1,"%D",2, 0)
	9955	Statement date.
	9956	"^DD",341, 341,6.01,1 ,1,"DT")
	9957	3160803
	9958	"^DD",341, 341,6.01,3 )
	9959	Enter date of Patien t Statemen t.
	9960	"^DD",341, 341,6.01,2 1,0)
	9961	^^1^1^3160 921^
	9962	"^DD",341, 341,6.01,2 1,1,0)
	9963	This is th e date of the Patien t Statemen t from CBS S.
	9964	"^DD",341, 341,6.01," DT")
	9965	3160921
	9966	"^DD",349, 349,.09,0)
	9967	STATEMENT DATE^D^^0; 9^S %DT="E X" D ^%DT S X=Y K:X< 1 X
	9968	"^DD",349, 349,.09,3)
	9969	Enter the statement date.
	9970	"^DD",349, 349,.09,21 ,0)
	9971	^^1^1^3161 019^
	9972	"^DD",349, 349,.09,21 ,1,0)
	9973	This is th e patient statement date.
	9974	"^DD",349, 349,.09,"D T")
	9975	3161103
	9976	"^DD",349. 1,349.1,0)
	9977	FIELD^^40^ 14
	9978	"^DD",349. 1,349.1,0, "DDA")
	9979	N
	9980	"^DD",349. 1,349.1,0, "DT")
	9981	3170919
	9982	"^DD",349. 1,349.1,0, "IX","B",3 49.1,.01)
	9983
	9984	"^DD",349. 1,349.1,0, "NM","AR T RANSMISSIO N TYPE")
	9985
	9986	"^DD",349. 1,349.1,0, "PT",349.9 ,.01)
	9987
	9988	"^DD",349. 1,349.1,0, "VRPK")
	9989	PRCA
	9990	"^DD",349. 1,349.1,.0 1,0)
	9991	CODE^RF^^0 ;1^K:$L(X) >10!($L(X) <2)!'(X'?1 P.E) X
	9992	"^DD",349. 1,349.1,.0 1,1,0)
	9993	^.1
	9994	"^DD",349. 1,349.1,.0 1,1,1,0)
	9995	349.1^B
	9996	"^DD",349. 1,349.1,.0 1,1,1,1)
	9997	S ^RCT(349 .1,"B",$E( X,1,30),DA )=""
	9998	"^DD",349. 1,349.1,.0 1,1,1,2)
	9999	K ^RCT(349 .1,"B",$E( X,1,30),DA )
	10000	"^DD",349. 1,349.1,.0 1,3)
	10001	Answer mus t be 2-10 characters in length .
	10002	"^DD",349. 1,349.1,.0 1,21,0)
	10003	^.001^1^1^ 3040601^^^
	10004	"^DD",349. 1,349.1,.0 1,21,1,0)
	10005	This field will hold the uniqu e codes fo r the tran smission t ypes.
	10006	"^DD",349. 1,349.1,.0 1,23,0)
	10007	^^1^1^3040 601^
	10008	"^DD",349. 1,349.1,.0 1,23,1,0)
	10009
	10010	"^DD",349. 1,349.1,.0 1,"DT")
	10011	2960216
	10012	"^DD",349. 1,349.1,.0 2,0)
	10013	EXPANDED N AME^F^^0;2 ^K:$L(X)>3 0!($L(X)<3 ) X
	10014	"^DD",349. 1,349.1,.0 2,3)
	10015	Answer mus t be 3-30 characters in length .
	10016	"^DD",349. 1,349.1,.0 2,21,0)
	10017	^^1^1^2960 216^^
	10018	"^DD",349. 1,349.1,.0 2,21,1,0)
	10019	This is th e expanded name of t he transmi ssion type .
	10020	"^DD",349. 1,349.1,.0 2,"DT")
	10021	2960216
	10022	"^DD",349. 1,349.1,.0 3,0)
	10023	ACTIVE^S^0 :NO;1:YES; ^0;3^Q
	10024	"^DD",349. 1,349.1,.0 3,21,0)
	10025	^^1^1^2960 216^
	10026	"^DD",349. 1,349.1,.0 3,21,1,0)
	10027	This field will indi cate if th e transmis sion type is being u sed.
	10028	"^DD",349. 1,349.1,.0 3,"DT")
	10029	2960216
	10030	"^DD",349. 1,349.1,.0 4,0)
	10031	PURGE FREQ UENCY^NJ4, 0^^0;4^K:+ X'=X!(X>36 50)!(X<30) !(X?.E1"." 1N.N) X
	10032	"^DD",349. 1,349.1,.0 4,3)
	10033	Type a Num ber betwee n 30 and 3 650, 0 Dec imal Digit s
	10034	"^DD",349. 1,349.1,.0 4,21,0)
	10035	^^2^2^2960 216^^
	10036	"^DD",349. 1,349.1,.0 4,21,1,0)
	10037	This field indicates if and wh en a purge of the en tries will take
	10038	"^DD",349. 1,349.1,.0 4,21,2,0)
	10039	place.
	10040	"^DD",349. 1,349.1,.0 4,23,0)
	10041	^^2^2^2960 216^
	10042	"^DD",349. 1,349.1,.0 4,23,1,0)
	10043	Number of days that transmissi on records are on-li ne before
	10044	"^DD",349. 1,349.1,.0 4,23,2,0)
	10045	purging oc curs.
	10046	"^DD",349. 1,349.1,.0 4,"DT")
	10047	2960216
	10048	"^DD",349. 1,349.1,1, 0)
	10049	LOCAL ADDR ESSEE^349. 11P^^1;0
	10050	"^DD",349. 1,349.1,2, 0)
	10051	LOCAL MAIL GROUP^349. 12P^^2;0
	10052	"^DD",349. 1,349.1,31 ,0)
	10053	REMOTE ADD RESSEE^F^^ 3;1^K:$L(X )>30!($L(X )<1)!'(X?. A) X
	10054	"^DD",349. 1,349.1,31 ,3)
	10055	Answer mus t be 1-30 characters in length .
	10056	"^DD",349. 1,349.1,31 ,21,0)
	10057	^^1^1^2960 430^^^
	10058	"^DD",349. 1,349.1,31 ,21,1,0)
	10059	This is th e addresse e name at the remote domain.
	10060	"^DD",349. 1,349.1,31 ,"DT")
	10061	2960430
	10062	"^DD",349. 1,349.1,32 ,0)
	10063	REMOTE DOM AIN^P4.2'^ DIC(4.2,^3 ;2^Q
	10064	"^DD",349. 1,349.1,32 ,1,0)
	10065	^.1
	10066	"^DD",349. 1,349.1,32 ,1,1,0)
	10067	^^TRIGGER^ 349.1^33
	10068	"^DD",349. 1,349.1,32 ,1,1,1)
	10069	K DIV S DI V=X,D0=DA, DIV(0)=D0 S Y(1)=$S( $D(^RCT(34 9.1,D0,3)) :^(3),1:"" ) S X=$P(Y (1),U,3),X =X S DIU=X
	10070	K Y X ^DD( 349.1,32,1 ,1,1.1) X ^DD(349.1, 32,1,1,1.4 )
	10071	"^DD",349. 1,349.1,32 ,1,1,1.1)
	10072	S X=DIV S I(0,0)=$S( $D(D0):D0, 1:""),D0=D IV S:'$D(^ DIC(4.2,+D 0,0)) D0=- 1 S
	10073	Y(101)=$S( $D(^DIC(4. 2,D0,0)):^ (0),1:"") S X=$P(Y(1 01),U,1) S D0=I(0,0)
	10074	"^DD",349. 1,349.1,32 ,1,1,1.4)
	10075	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1, DIG=33 D
	10076	^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	10077	"^DD",349. 1,349.1,32 ,1,1,2)
	10078	K DIV S DI V=X,D0=DA, DIV(0)=D0 S Y(1)=$S( $D(^RCT(34 9.1,D0,3)) :^(3),1:"" ) S X=$P(Y (1),U,3),X =X S DIU=X
	10079	K Y S X="" X ^DD(349 .1,32,1,1, 2.4)
	10080	"^DD",349. 1,349.1,32 ,1,1,2.4)
	10081	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1, DIG=33 D
	10082	^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	10083	"^DD",349. 1,349.1,32 ,1,1,"CREA TE VALUE")
	10084	REMOTE DOM AIN:.01
	10085	"^DD",349. 1,349.1,32 ,1,1,"DELE TE VALUE")
	10086	@
	10087	"^DD",349. 1,349.1,32 ,1,1,"FIEL D")
	10088	DOMAIN NAM E
	10089	"^DD",349. 1,349.1,32 ,21,0)
	10090	^.001^2^2^ 3000524^^^
	10091	"^DD",349. 1,349.1,32 ,21,1,0)
	10092	This is th e remote d omain wher e the tran smission r ecord is b eing
	10093	"^DD",349. 1,349.1,32 ,21,2,0)
	10094	sent.
	10095	"^DD",349. 1,349.1,32 ,"DT")
	10096	2960902
	10097	"^DD",349. 1,349.1,33 ,0)
	10098	DOMAIN NAM E^F^^3;3^K :$L(X)>30! ($L(X)<3) X
	10099	"^DD",349. 1,349.1,33 ,3)
	10100	Answer mus t be 3-30 characters in length .
	10101	"^DD",349. 1,349.1,33 ,5,1,0)
	10102	349.1^32^1
	10103	"^DD",349. 1,349.1,33 ,9)
	10104	^
	10105	"^DD",349. 1,349.1,33 ,21,0)
	10106	^^1^1^2960 902^
	10107	"^DD",349. 1,349.1,33 ,21,1,0)
	10108	This is th e name of the DOMAIN from file 4.2 DOMAI N.
	10109	"^DD",349. 1,349.1,33 ,"DT")
	10110	2960902
	10111	"^DD",349. 1,349.1,34 ,0)
	10112	RC MAIL AD DRESS^RFX^ ^3;4^K:$L( X)>30!($L( X)<3) X
	10113	"^DD",349. 1,349.1,34 ,3)
	10114	Answer mus t be 3-30 characters in length .
	10115	"^DD",349. 1,349.1,34 ,4)
	10116	D MAILADD^ RCRCXMS
	10117	"^DD",349. 1,349.1,34 ,21,0)
	10118	^.001^2^2^ 3040429^^^ ^
	10119	"^DD",349. 1,349.1,34 ,21,1,0)
	10120	This field will cont ain the Re gional Cou nsel mail address fo r the
	10121	"^DD",349. 1,349.1,34 ,21,2,0)
	10122	primary si te. It wi ll be the default ma il address .
	10123	"^DD",349. 1,349.1,34 ,23,0)
	10124	^.001^1^1^ 3040429^^^ ^
	10125	"^DD",349. 1,349.1,34 ,23,1,0)
	10126
	10127	"^DD",349. 1,349.1,34 ,"DT")
	10128	3040407
	10129	"^DD",349. 1,349.1,35 ,0)
	10130	RC DEATH N OTIFICATIO N ADDRESS^ RF^^3;5^K: $L(X)>40!( $L(X)<2) X
	10131	"^DD",349. 1,349.1,35 ,3)
	10132	Answer mus t be 2-40 characters in length .
	10133	"^DD",349. 1,349.1,35 ,4)
	10134	D DEATHADD ^RCRCXMS
	10135	"^DD",349. 1,349.1,35 ,21,0)
	10136	^.001^3^3^ 3040429^^^ ^
	10137	"^DD",349. 1,349.1,35 ,21,1,0)
	10138	This field contains the Region al Counsel mail addr ess for de ath
	10139	"^DD",349. 1,349.1,35 ,21,2,0)
	10140	notificati ons for th e primary site. Thi s will be the defaul t for deat h
	10141	"^DD",349. 1,349.1,35 ,21,3,0)
	10142	notificati ons.
	10143	"^DD",349. 1,349.1,35 ,23,0)
	10144	^.001^1^1^ 3040429^^^ ^
	10145	"^DD",349. 1,349.1,35 ,23,1,0)
	10146
	10147	"^DD",349. 1,349.1,35 ,"DT")
	10148	3040428
	10149	"^DD",349. 1,349.1,40 ,0)
	10150	MESSAGE AC KNOWLEDGEM ENT^349.14 1A^^4;0
	10151	"^DD",349. 1,349.1,40 ,21,0)
	10152	^^5^5^3160 429^
	10153	"^DD",349. 1,349.1,40 ,21,1,0)
	10154	Message Ac knowledgem ents conta in the top level of data for m essages
	10155	"^DD",349. 1,349.1,40 ,21,2,0)
	10156	received f rom Austin .
	10157	"^DD",349. 1,349.1,40 ,21,3,0)
	10158
	10159	"^DD",349. 1,349.1,40 ,21,4,0)
	10160	The IEN fo r the mult iple Messa ge Acknowl edgements is set in the code t o
	10161	"^DD",349. 1,349.1,40 ,21,5,0)
	10162	the day of the month for the P atient Sta tement.
	10163	"^DD",349. 1,349.1,51 ,0)
	10164	ACK MESSAG ES^349.151 A^^5;0
	10165	"^DD",349. 1,349.1,51 ,21,0)
	10166	^^1^1^3161 006^
	10167	"^DD",349. 1,349.1,51 ,21,1,0)
	10168	Acknowledg ement Mess ages recei ved from e xternal so urces.
	10169	"^DD",349. 1,349.1,61 ,0)
	10170	DIVISION O F CARE^349 .161PA^^6; 0
	10171	"^DD",349. 1,349.1,61 ,21,0)
	10172	^.001^4^4^ 3040517^^^ ^
	10173	"^DD",349. 1,349.1,61 ,21,1,0)
	10174	This field is a mult iple that allows div isions to be entered if their
	10175	"^DD",349. 1,349.1,61 ,21,2,0)
	10176	Regional C ounsel mai l addresse s and deat h notifica tion addre sses are
	10177	"^DD",349. 1,349.1,61 ,21,3,0)
	10178	different from the p rimary add resses.
	10179	"^DD",349. 1,349.1,61 ,21,4,0)
	10180
	10181	"^DD",349. 1,349.1,61 ,23,0)
	10182	^.001^1^1^ 3040517^^^ ^
	10183	"^DD",349. 1,349.1,61 ,23,1,0)
	10184
	10185	"^DD",349. 1,349.1,61 ,"DT")
	10186	3040514
	10187	"^DD",349. 1,349.11,0 )
	10188	LOCAL ADDR ESSEE SUB- FIELD^^.01 ^1
	10189	"^DD",349. 1,349.11,0 ,"DT")
	10190	2960216
	10191	"^DD",349. 1,349.11,0 ,"IX","B", 349.11,.01 )
	10192
	10193	"^DD",349. 1,349.11,0 ,"NM","LOC AL ADDRESS EE")
	10194
	10195	"^DD",349. 1,349.11,0 ,"UP")
	10196	349.1
	10197	"^DD",349. 1,349.11,. 01,0)
	10198	LOCAL ADDR ESSEE^MP20 0'^VA(200, ^0;1^Q
	10199	"^DD",349. 1,349.11,. 01,1,0)
	10200	^.1
	10201	"^DD",349. 1,349.11,. 01,1,1,0)
	10202	349.11^B
	10203	"^DD",349. 1,349.11,. 01,1,1,1)
	10204	S ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)= ""
	10205	"^DD",349. 1,349.11,. 01,1,1,2)
	10206	K ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)
	10207	"^DD",349. 1,349.11,. 01,21,0)
	10208	^^2^2^3171 005^
	10209	"^DD",349. 1,349.11,. 01,21,1,0)
	10210	The local users who wish to be recipient s of the t ransmissio n messages
	10211	"^DD",349. 1,349.11,. 01,21,2,0)
	10212	will named in this f ield.
	10213	"^DD",349. 1,349.11,. 01,"DT")
	10214	3171005
	10215	"^DD",349. 1,349.12,0 )
	10216	LOCAL MAIL GROUP SUB- FIELD^^.01 ^1
	10217	"^DD",349. 1,349.12,0 ,"DT")
	10218	2960216
	10219	"^DD",349. 1,349.12,0 ,"IX","B", 349.12,.01 )
	10220
	10221	"^DD",349. 1,349.12,0 ,"NM","LOC AL MAILGRO UP")
	10222
	10223	"^DD",349. 1,349.12,0 ,"UP")
	10224	349.1
	10225	"^DD",349. 1,349.12,. 01,0)
	10226	LOCAL MAIL GROUP^MP3. 8'^XMB(3.8 ,^0;1^Q
	10227	"^DD",349. 1,349.12,. 01,1,0)
	10228	^.1
	10229	"^DD",349. 1,349.12,. 01,1,1,0)
	10230	349.12^B
	10231	"^DD",349. 1,349.12,. 01,1,1,1)
	10232	S ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)= ""
	10233	"^DD",349. 1,349.12,. 01,1,1,2)
	10234	K ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)
	10235	"^DD",349. 1,349.12,. 01,21,0)
	10236	^^2^2^2960 216^
	10237	"^DD",349. 1,349.12,. 01,21,1,0)
	10238	This field is used t o define a ny mailgro ups which should rec eive the
	10239	"^DD",349. 1,349.12,. 01,21,2,0)
	10240	transmissi on message s.
	10241	"^DD",349. 1,349.12,. 01,"DT")
	10242	2960216
	10243	"^DD",349. 1,349.141, 0)
	10244	MESSAGE AC KNOWLEDGEM ENT SUB-FI ELD^^.04^4
	10245	"^DD",349. 1,349.141, 0,"DT")
	10246	3160425
	10247	"^DD",349. 1,349.141, 0,"NM","ME SSAGE ACKN OWLEDGEMEN T")
	10248
	10249	"^DD",349. 1,349.141, 0,"UP")
	10250	349.1
	10251	"^DD",349. 1,349.141, .01,0)
	10252	LAST MESSA GE ACK^NJ3 ,0X^^0;1^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	10253	"^DD",349. 1,349.141, .01,1,0)
	10254	^.1^^0
	10255	"^DD",349. 1,349.141, .01,3)
	10256	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	10257	"^DD",349. 1,349.141, .01,21,0)
	10258	^^1^1^3160 425^
	10259	"^DD",349. 1,349.141, .01,21,1,0 )
	10260	Number of last messa ge type se nt from CB SS.
	10261	"^DD",349. 1,349.141, .01,"DT")
	10262	3161007
	10263	"^DD",349. 1,349.141, .02,0)
	10264	FINAL MESS AGE ACK^NJ 3,0^^0;2^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	10265	"^DD",349. 1,349.141, .02,3)
	10266	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	10267	"^DD",349. 1,349.141, .02,21,0)
	10268	^^1^1^3160 425^
	10269	"^DD",349. 1,349.141, .02,21,1,0 )
	10270	Final mess age number of this t ype from C BSS.
	10271	"^DD",349. 1,349.141, .02,"DT")
	10272	3160425
	10273	"^DD",349. 1,349.141, .03,0)
	10274	LAST MESSA GE NUMBER^ NJ8,0^^0;3 ^K:+X'=X!( X>99999999 )!(X<1)!(X ?.E1"."1.N ) X
	10275	"^DD",349. 1,349.141, .03,3)
	10276	Type a num ber betwee n 1 and 99 999999, 0 decimal di gits.
	10277	"^DD",349. 1,349.141, .03,21,0)
	10278	^^2^2^3160 425^
	10279	"^DD",349. 1,349.141, .03,21,1,0 )
	10280	This is th e last mes sage numbe r of this type for t he last tr ansmission
	10281	"^DD",349. 1,349.141, .03,21,2,0 )
	10282	from CBSS.
	10283	"^DD",349. 1,349.141, .03,"DT")
	10284	3160425
	10285	"^DD",349. 1,349.141, .04,0)
	10286	PATIENT ST ATEMENT DA TE^DX^^0;4 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	10287	"^DD",349. 1,349.141, .04,1,0)
	10288	^.1^^0
	10289	"^DD",349. 1,349.141, .04,3)
	10290	Enter date of Patien t Statemen t.
	10291	"^DD",349. 1,349.141, .04,21,0)
	10292	^^1^1^3161 025^
	10293	"^DD",349. 1,349.141, .04,21,1,0 )
	10294	This is th e Patient Statement Date.
	10295	"^DD",349. 1,349.141, .04,"DT")
	10296	3161025
	10297	"^DD",349. 1,349.151, 0)
	10298	ACK MESSAG ES SUB-FIE LD^^.04^4
	10299	"^DD",349. 1,349.151, 0,"DT")
	10300	3161103
	10301	"^DD",349. 1,349.151, 0,"NM","AC K MESSAGES ")
	10302
	10303	"^DD",349. 1,349.151, 0,"UP")
	10304	349.1
	10305	"^DD",349. 1,349.151, .01,0)
	10306	ACK MESSAG ES^F^^0;1^ K:$L(X)>80 !($L(X)<3) X
	10307	"^DD",349. 1,349.151, .01,1,0)
	10308	^.1^^0
	10309	"^DD",349. 1,349.151, .01,3)
	10310	Answer mus t be 3-80 characters in length .
	10311	"^DD",349. 1,349.151, .01,21,0)
	10312	^^1^1^3171 005^
	10313	"^DD",349. 1,349.151, .01,21,1,0 )
	10314	This multi ple will s tore the A cknowledgm ent messag es from Au stin.
	10315	"^DD",349. 1,349.151, .01,"DT")
	10316	3171005
	10317	"^DD",349. 1,349.151, .02,0)
	10318	ACCOUNT/SE G ID^F^^0; 2^K:$L(X)> 25!($L(X)< 3) X
	10319	"^DD",349. 1,349.151, .02,3)
	10320	Answer mus t be 3-25 characters in length .
	10321	"^DD",349. 1,349.151, .02,21,0)
	10322	^^1^1^2961 114^
	10323	"^DD",349. 1,349.151, .02,21,1,0 )
	10324	This field stores th e account id for the record.
	10325	"^DD",349. 1,349.151, .02,"DT")
	10326	2961205
	10327	"^DD",349. 1,349.151, .03,0)
	10328	ACCOUNT/SE G INFO^F^^ 0;3^K:$L(X )>40!($L(X )<3) X
	10329	"^DD",349. 1,349.151, .03,3)
	10330	Answer mus t be 3-40 characters in length .
	10331	"^DD",349. 1,349.151, .03,21,0)
	10332	^^1^1^2961 114^
	10333	"^DD",349. 1,349.151, .03,21,1,0 )
	10334	This field will stor e the deta iled infor mation abo ut the rec ord if any .
	10335	"^DD",349. 1,349.151, .03,"DT")
	10336	2961205
	10337	"^DD",349. 1,349.151, .04,0)
	10338	PATIENT ST ATEMENT DA TE^D^^0;4^ S %DT="EX" D ^%DT S X=Y K:X<1 X
	10339	"^DD",349. 1,349.151, .04,3)
	10340	Enter date of Patien t Statemen t.
	10341	"^DD",349. 1,349.151, .04,21,0)
	10342	^^1^1^3161 006^
	10343	"^DD",349. 1,349.151, .04,21,1,0 )
	10344	The Patien t Statemen t date for Acknowled gement Mes sages.
	10345	"^DD",349. 1,349.151, .04,"DT")
	10346	3161103
	10347	"^DD",349. 1,349.161, 0)
	10348	DIVISION O F CARE SUB -FIELD^^.0 4^4
	10349	"^DD",349. 1,349.161, 0,"DT")
	10350	3040429
	10351	"^DD",349. 1,349.161, 0,"IX","B" ,349.161,. 01)
	10352
	10353	"^DD",349. 1,349.161, 0,"NM","DI VISION OF CARE")
	10354
	10355	"^DD",349. 1,349.161, 0,"UP")
	10356	349.1
	10357	"^DD",349. 1,349.161, .01,0)
	10358	DIVISION O F CARE^P40 .8'^DG(40. 8,^0;1^Q
	10359	"^DD",349. 1,349.161, .01,1,0)
	10360	^.1
	10361	"^DD",349. 1,349.161, .01,1,1,0)
	10362	349.161^B
	10363	"^DD",349. 1,349.161, .01,1,1,1)
	10364	S ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)= ""
	10365	"^DD",349. 1,349.161, .01,1,1,2)
	10366	K ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)
	10367	"^DD",349. 1,349.161, .01,21,0)
	10368	^.001^1^1^ 3040517^^^ ^
	10369	"^DD",349. 1,349.161, .01,21,1,0 )
	10370	Enter divi sions of c are where bill charg es origina te for thi s site.
	10371	"^DD",349. 1,349.161, .01,"DT")
	10372	3000524
	10373	"^DD",349. 1,349.161, .02,0)
	10374	REMOTE DOM AIN^P4.2'^ DIC(4.2,^0 ;2^Q
	10375	"^DD",349. 1,349.161, .02,3)
	10376
	10377	"^DD",349. 1,349.161, .02,21,0)
	10378	^.001^1^1^ 3000524^^
	10379	"^DD",349. 1,349.161, .02,21,1,0 )
	10380	This is th e Remote D omain addr ess where transmissi ons will b e sent for this divi sion.
	10381	"^DD",349. 1,349.161, .02,"DT")
	10382	3000524
	10383	"^DD",349. 1,349.161, .03,0)
	10384	RC MAIL AD DRESS^F^^0 ;3^K:$L(X) >30!($L(X) <3) X
	10385	"^DD",349. 1,349.161, .03,3)
	10386	Answer mus t be 3-30 characters in length .
	10387	"^DD",349. 1,349.161, .03,4)
	10388	D MAILADD^ RCRCXMS
	10389	"^DD",349. 1,349.161, .03,21,0)
	10390	^.001^4^4^ 3040429^^
	10391	"^DD",349. 1,349.161, .03,21,1,0 )
	10392	This field will cont ain the na me of the Regional C ounsel mai l address
	10393	"^DD",349. 1,349.161, .03,21,2,0 )
	10394	that trans actions fr om the ass ociated Di vision of Care will be sent.
	10395	"^DD",349. 1,349.161, .03,21,3,0 )
	10396	This field s address will be di fferent fr om the pri mary divis ion's
	10397	"^DD",349. 1,349.161, .03,21,4,0 )
	10398	RC mail ad dress.
	10399	"^DD",349. 1,349.161, .03,23,0)
	10400	^^1^1^3040 429^
	10401	"^DD",349. 1,349.161, .03,23,1,0 )
	10402
	10403	"^DD",349. 1,349.161, .03,"DT")
	10404	3040325
	10405	"^DD",349. 1,349.161, .04,0)
	10406	RC DEATH N OTIFICATIO N ADDRESS^ F^^0;4^K:$ L(X)>40!($ L(X)<3) X
	10407	"^DD",349. 1,349.161, .04,3)
	10408	Answer mus t be 3-40 characters in length .
	10409	"^DD",349. 1,349.161, .04,4)
	10410	D DEATHADD ^RCRCXMS
	10411	"^DD",349. 1,349.161, .04,21,0)
	10412	^.001^4^4^ 3040429^^^
	10413	"^DD",349. 1,349.161, .04,21,1,0 )
	10414	This field will cont ain the na me of the RC death n otificatio ns address
	10415	"^DD",349. 1,349.161, .04,21,2,0 )
	10416	that death notices f rom the as sociated D ivision of Care will be sent.
	10417	"^DD",349. 1,349.161, .04,21,3,0 )
	10418	This field s address will be di fferent fr om the pri mary divis ion's
	10419	"^DD",349. 1,349.161, .04,21,4,0 )
	10420	RC death n otificatio n address.
	10421	"^DD",349. 1,349.161, .04,23,0)
	10422	^.001^1^1^ 3040429^^
	10423	"^DD",349. 1,349.161, .04,23,1,0 )
	10424
	10425	"^DD",349. 1,349.161, .04,"DT")
	10426	3040429
	10427	"^DD",349. 2,349.2,.0 1,0)
	10428	PATIENT^RP 340'X^RCD( 340,^0;1^Q
	10429	"^DD",349. 2,349.2,.0 1,1,0)
	10430	^.1^^0
	10431	"^DD",349. 2,349.2,.0 1,3)
	10432	Enter the Debtor Num ber for th e Patient Statement.
	10433	"^DD",349. 2,349.2,.0 1,21,0)
	10434	^^2^2^3161 011^^
	10435	"^DD",349. 2,349.2,.0 1,21,1,0)
	10436	This is th e Debtor n umber to r eceive the Patient S tatement a ssociated
	10437	"^DD",349. 2,349.2,.0 1,21,2,0)
	10438	with the s pecific Pa tient.
	10439	"^DD",349. 2,349.2,.0 1,"DT")
	10440	3161011
	10441	"^DD",349. 2,349.2,.0 2,0)
	10442	SSN^RFXO^^ 0;2^K:$L(X )>10!($L(X )<9) X S X =$$SSN^RCF N01(+DA)
	10443	"^DD",349. 2,349.2,.0 2,1,0)
	10444	^.1
	10445	"^DD",349. 2,349.2,.0 2,1,1,0)
	10446	349.2^AKEY 1^MUMPS
	10447	"^DD",349. 2,349.2,.0 2,1,1,1)
	10448	I $P(^RCPS (349.2,+DA ,0),"^",3) ]"" S
	10449	^RCPS(349. 2,"AKEY",$ E(X,1,9)_$ TR($E($P($ P(^RCPS(34 9.2,+DA,0) ,"^",3),", "),1,5)," ",""),DA)= ""
	10450	"^DD",349. 2,349.2,.0 2,1,1,2)
	10451	K ^RCPS(34 9.2,"AKEY" ,$E(X,1,9) _$TR($E($P ($P(^RCPS( 349.2,+DA, 0),"^",3), ","),1,5), " ",""))
	10452	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,0)
	10453	^.101^1^1^ 3160427^^
	10454	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,1,0)
	10455	This cross -reference is used t o key the statements for CBSS.
	10456	"^DD",349. 2,349.2,.0 2,1,1,"DT" )
	10457	2960924
	10458	"^DD",349. 2,349.2,.0 2,2)
	10459	S Y(0)=Y S Y=Y
	10460	"^DD",349. 2,349.2,.0 2,2.1)
	10461	S Y=Y
	10462	"^DD",349. 2,349.2,.0 2,3)
	10463	Answer mus t be 9-10 characters in length .
	10464	"^DD",349. 2,349.2,.0 2,21,0)
	10465	^^1^1^2960 418^^
	10466	"^DD",349. 2,349.2,.0 2,21,1,0)
	10467	This is th e SSN for the patien t.
	10468	"^DD",349. 2,349.2,.0 2,"DT")
	10469	2960924
	10470	"^DD",349. 2,349.2,.0 3,0)
	10471	PATIENT NA ME^RFX^^0; 3^K:$L(X)> 44!($L(X)< 3) X S X=$ $NAM^RCFN0 1(+DA)
	10472	"^DD",349. 2,349.2,.0 3,1,0)
	10473	^.1
	10474	"^DD",349. 2,349.2,.0 3,1,1,0)
	10475	349.2^AKEY 2^MUMPS
	10476	"^DD",349. 2,349.2,.0 3,1,1,1)
	10477	I $$KEY^RC CPCFN(+DA) ]"" S ^RCP S(349.2,"A KEY",$$KEY ^RCCPCFN(+ DA),DA)=""
	10478	"^DD",349. 2,349.2,.0 3,1,1,2)
	10479	I $P(^RCPS (349.2,+DA ,0),"^",2) >1 K
	10480	^RCPS(349. 2,"AKEY",$ E($P(^RCPS (349.2,+DA ,0),"^",2) ,1,9)_$TR( $E($P(X,", "),1,5)," ",""))
	10481	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,0)
	10482	^^1^1^3160 427^
	10483	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,1,0)
	10484	This cross -reference is used t o key the statements for CBSS.
	10485	"^DD",349. 2,349.2,.0 3,1,1,"DT" )
	10486	2960924
	10487	"^DD",349. 2,349.2,.0 3,3)
	10488	Answer mus t be 3-44 characters in length .
	10489	"^DD",349. 2,349.2,.0 3,21,0)
	10490	^^1^1^2960 418^^^^
	10491	"^DD",349. 2,349.2,.0 3,21,1,0)
	10492	This is th e patient name as it appears o n the stat ement.
	10493	"^DD",349. 2,349.2,.0 3,"DT")
	10494	2960924
	10495	"^DD",349. 2,349.2,.1 2,0)
	10496	INVALID ST ATEMENT ER ROR^P349.7 '^RCPSE(34 9.7,^0;12^ Q
	10497	"^DD",349. 2,349.2,.1 2,3)
	10498	Enter the error code for the r ecord that was not a ccepted by CBSS.
	10499	"^DD",349. 2,349.2,.1 2,21,0)
	10500	^^1^1^3160 427^
	10501	"^DD",349. 2,349.2,.1 2,21,1,0)
	10502	This is th e error co de for the record th at was not accepted by CBSS.
	10503	"^DD",349. 2,349.2,.1 2,"DT")
	10504	3160909
	10505	"^DD",349. 2,349.2,.1 8,0)
	10506	CBSS FILE BUILT^S^0: NOT BUILT; 1:BUILT;^0 ;18^Q
	10507	"^DD",349. 2,349.2,.1 8,3)
	10508	Enter a '1 ' when the CBSS PATI ENT STATEM ENTS file is complet e.
	10509	"^DD",349. 2,349.2,.1 8,21,0)
	10510	^^2^2^3160 909^^
	10511	"^DD",349. 2,349.2,.1 8,21,1,0)
	10512	This field will stor e a marker that the CBSS PATIE NT STATEME NTS file
	10513	"^DD",349. 2,349.2,.1 8,21,2,0)
	10514	(349.2) is a complet e file for that stat ement day.
	10515	"^DD",349. 2,349.2,.1 8,"DT")
	10516	3160921
	10517	"^DD",349. 2,349.2,.1 9,0)
	10518	PATIENT ST ATEMENT DA TE^D^^0;19 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	10519	"^DD",349. 2,349.2,.1 9,3)
	10520	Enter the date of th e Patient Statement.
	10521	"^DD",349. 2,349.2,.1 9,21,0)
	10522	^^2^2^3161 019^
	10523	"^DD",349. 2,349.2,.1 9,21,1,0)
	10524	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	10525	"^DD",349. 2,349.2,.1 9,21,2,0)
	10526	standardly two days after the statement is transmi tted
	10527	"^DD",349. 2,349.2,.1 9,"DT")
	10528	3161103
	10529	"^DD",349. 2,349.2,51 ,0)
	10530	ERROR CODE (S)^F^^5;1 ^K:$L(X)>3 0!($L(X)<5 ) X
	10531	"^DD",349. 2,349.2,51 ,1,0)
	10532	^.1^^0
	10533	"^DD",349. 2,349.2,51 ,3)
	10534	Answer mus t be 5-30 characters in length .
	10535	"^DD",349. 2,349.2,51 ,21,0)
	10536	^^2^2^3161 007^
	10537	"^DD",349. 2,349.2,51 ,21,1,0)
	10538	These are the error codes sent back by C BSS when a statement cannot be
	10539	"^DD",349. 2,349.2,51 ,21,2,0)
	10540	printed.
	10541	"^DD",349. 2,349.2,51 ,"DT")
	10542	3161007
	10543	"^DD",349. 2,349.2,61 ,0)
	10544	CBSS PRINT ED^S^1:Y;0 :N;^6;1^Q
	10545	"^DD",349. 2,349.2,61 ,3)
	10546	Enter whet her the pa tient stat ement for this patie nt printed at the CB SS.
	10547	"^DD",349. 2,349.2,61 ,21,0)
	10548	^^2^2^3160 909^^
	10549	"^DD",349. 2,349.2,61 ,21,1,0)
	10550	This field indicates whether t he patient statement for this patient pr inted
	10551	"^DD",349. 2,349.2,61 ,21,2,0)
	10552	at the CCP C or not.
	10553	"^DD",349. 2,349.2,61 ,"DT")
	10554	3160921
	10555	"^DD",349. 2,349.2,81 ,0)
	10556	INTEGRATIO N CONTROL NUMBER^NJ1 2,0^^8;1^K :+X'=X!(X> 9999999999 99)!(X<0)! (X?.E1"."1 .N) X
	10557	"^DD",349. 2,349.2,81 ,3)
	10558	Enter the ICN, a num ber betwee n 0 and 99 9999999999 with no d ecimal dig its.
	10559	"^DD",349. 2,349.2,81 ,21,0)
	10560	^^2^2^3160 909^
	10561	"^DD",349. 2,349.2,81 ,21,1,0)
	10562	Machine to machine i dentifier for a pati ent. This field can only be
	10563	"^DD",349. 2,349.2,81 ,21,2,0)
	10564	edited by CIRN.
	10565	"^DD",349. 2,349.2,81 ,"DT")
	10566	3160921
	10567	"^DD",349. 2,349.2,82 ,0)
	10568	ICN CHECKS UM^F^^8;2^ K:$L(X)>6! ($L(X)<6) X
	10569	"^DD",349. 2,349.2,82 ,3)
	10570	Answer mus t be 6 cha racters in length.
	10571	"^DD",349. 2,349.2,82 ,21,0)
	10572	^^2^2^3160 428^
	10573	"^DD",349. 2,349.2,82 ,21,1,0)
	10574	This check sum is the calculate d checksum for the I ntegration Control
	10575	"^DD",349. 2,349.2,82 ,21,2,0)
	10576	Number. I t verifies the integ rity of th e ICN.
	10577	"^DD",349. 2,349.2,82 ,"DT")
	10578	3160428
	10579	"^DD",349. 2,349.2,83 ,0)
	10580	AR FLAG^S^ T:TRUE;F:F ALSE;^8;3^ Q
	10581	"^DD",349. 2,349.2,83 ,3)
	10582	Enter T fo r 'TRUE' o r F for 'F alse', for whether t he patient address w as obtaine d from AR storage.
	10583	"^DD",349. 2,349.2,83 ,21,0)
	10584	^^2^2^3160 428^
	10585	"^DD",349. 2,349.2,83 ,21,1,0)
	10586	This is a set of cod e, indicat ing whethe r or not t he address was taken
	10587	"^DD",349. 2,349.2,83 ,21,2,0)
	10588	from the A R DEBTOR ( #340).
	10589	"^DD",349. 2,349.2,83 ,"DT")
	10590	3160921
	10591	"^DD",349. 2,349.2,84 ,0)
	10592	DATE OF LA TEST BILL^ DX^^8;4^S %DT="EX" D ^%DT S X= Y K:X<1 X
	10593	"^DD",349. 2,349.2,84 ,3)
	10594	Enter the date on wh ich the la test bill was establ ished.
	10595	"^DD",349. 2,349.2,84 ,21,0)
	10596	^^1^1^3160 428^^
	10597	"^DD",349. 2,349.2,84 ,21,1,0)
	10598	The date t he latest bill was p repared. Time is no t allowed.
	10599	"^DD",349. 2,349.2,84 ,"DT")
	10600	3160921
	10601	"^DD",349. 5,349.5,0)
	10602	FIELD^^1^7
	10603	"^DD",349. 5,349.5,0, "DT")
	10604	3170919
	10605	"^DD",349. 5,349.5,0, "IX","B",3 49.5,.01)
	10606
	10607	"^DD",349. 5,349.5,0, "NM","AR A NNUAL PAYM ENT STATEM ENT")
	10608
	10609	"^DD",349. 5,349.5,0, "VRPK")
	10610	PRCA
	10611	"^DD",349. 5,349.5,.0 1,0)
	10612	PS SEGMENT NUMBER^RN J4,0^^0;1^ K:+X'=X!(X >9999)!(X< 1)!(X?.E1" ."1.N) X
	10613	"^DD",349. 5,349.5,.0 1,1,0)
	10614	^.1
	10615	"^DD",349. 5,349.5,.0 1,1,1,0)
	10616	349.5^B
	10617	"^DD",349. 5,349.5,.0 1,1,1,1)
	10618	S ^RCAP(34 9.5,"B",$E (X,1,30),D A)=""
	10619	"^DD",349. 5,349.5,.0 1,1,1,2)
	10620	K ^RCAP(34 9.5,"B",$E (X,1,30),D A)
	10621	"^DD",349. 5,349.5,.0 1,3)
	10622	Enter the PS Segment Number (a number be tween 1 an d 9999).
	10623	"^DD",349. 5,349.5,.0 1,21,0)
	10624	^^1^1^3170 223^
	10625	"^DD",349. 5,349.5,.0 1,21,1,0)
	10626	This is th e Segment Number for the "PS" Record Ide ntifier.
	10627	"^DD",349. 5,349.5,.0 1,"DT")
	10628	3170224
	10629	"^DD",349. 5,349.5,.0 2,0)
	10630	YEAR^NJ3,0 ^^0;2^K:+X '=X!(X>400 )!(X<300)! (X?.E1"."1 .N) X
	10631	"^DD",349. 5,349.5,.0 2,3)
	10632	Enter the Year for t his segmen t in Inter nal FileMa n Format ( a number b etween 300 and 400).
	10633	"^DD",349. 5,349.5,.0 2,21,0)
	10634	^^1^1^3170 223^
	10635	"^DD",349. 5,349.5,.0 2,21,1,0)
	10636	This is th e Annual P ayment Fil e Year to be process ed.
	10637	"^DD",349. 5,349.5,.0 2,"DT")
	10638	3170224
	10639	"^DD",349. 5,349.5,.0 3,0)
	10640	DATE/TIME BUILD STAR TED^D^^0;3 ^S %DT="ES TXR" D ^%D T S X=Y K: 3170101>X X
	10641	"^DD",349. 5,349.5,.0 3,3)
	10642	Enter the Date and T ime Build Started.
	10643	"^DD",349. 5,349.5,.0 3,21,0)
	10644	^^1^1^3170 223^
	10645	"^DD",349. 5,349.5,.0 3,21,1,0)
	10646	This is th e Date and Time that the Build for this file start ed.
	10647	"^DD",349. 5,349.5,.0 3,"DT")
	10648	3170224
	10649	"^DD",349. 5,349.5,.0 4,0)
	10650	DATE/TIME BUILD ENDE D^D^^0;4^S %DT="ESTX R" D ^%DT S X=Y K:31 70101>X X
	10651	"^DD",349. 5,349.5,.0 4,3)
	10652	Enter the Date and T ime Build Ended.
	10653	"^DD",349. 5,349.5,.0 4,21,0)
	10654	^^1^1^3170 223^
	10655	"^DD",349. 5,349.5,.0 4,21,1,0)
	10656	This is th e Date and Time that the Build for this file ended .
	10657	"^DD",349. 5,349.5,.0 4,"DT")
	10658	3170224
	10659	"^DD",349. 5,349.5,.0 5,0)
	10660	DATE/TIME TRANSMIT S TARTED^D^^ 0;5^S %DT= "ESTXR" D ^%DT S X=Y K:3170101 >X X
	10661	"^DD",349. 5,349.5,.0 5,3)
	10662	Enter the Date and T ime Transm it Started .
	10663	"^DD",349. 5,349.5,.0 5,21,0)
	10664	^^1^1^3170 223^
	10665	"^DD",349. 5,349.5,.0 5,21,1,0)
	10666	This is th e Date and Time that the Trans mit for th is file st arted.
	10667	"^DD",349. 5,349.5,.0 5,"DT")
	10668	3170224
	10669	"^DD",349. 5,349.5,.0 6,0)
	10670	DATE/TIME TRANSMIT E NDED^D^^0; 6^S %DT="E STXR" D ^% DT S X=Y K :3170101>X X
	10671	"^DD",349. 5,349.5,.0 6,3)
	10672	Enter Date /Time Tran smit Ended .
	10673	"^DD",349. 5,349.5,.0 6,21,0)
	10674	^^1^1^3170 223^
	10675	"^DD",349. 5,349.5,.0 6,21,1,0)
	10676	This is th e Date and Time that the Trans mit for th is file en ded.
	10677	"^DD",349. 5,349.5,.0 6,"DT")
	10678	3170224
	10679	"^DD",349. 5,349.5,1, 0)
	10680	STATEMENT FILE LINES ^349.51^^1 ;0
	10681	"^DD",349. 5,349.5,1, 21,0)
	10682	^^1^1^3170 224^^
	10683	"^DD",349. 5,349.5,1, 21,1,0)
	10684	This is th e multiple for the A nnual Paym ent Statem ent file l ines.
	10685	"^DD",349. 5,349.51,0 )
	10686	STATEMENT FILE LINES SUB-FIELD ^^.01^1
	10687	"^DD",349. 5,349.51,0 ,"DT")
	10688	3170224
	10689	"^DD",349. 5,349.51,0 ,"NM","STA TEMENT FIL E LINES")
	10690
	10691	"^DD",349. 5,349.51,0 ,"UP")
	10692	349.5
	10693	"^DD",349. 5,349.51,. 01,0)
	10694	STATEMENT FILE LINES ^MFJ342^^0 ;1^K:$L(X) >342!($L(X )<1) X
	10695	"^DD",349. 5,349.51,. 01,1,0)
	10696	^.1^^0
	10697	"^DD",349. 5,349.51,. 01,3)
	10698	Enter File Lines for Annual Pa yment Stat ement (1 t o 342 char acters).
	10699	"^DD",349. 5,349.51,. 01,21,0)
	10700	^^1^1^3170 224^
	10701	"^DD",349. 5,349.51,. 01,21,1,0)
	10702	These are the File L ines for A nnual Paym ent Statem ent.
	10703	"^DD",349. 5,349.51,. 01,"DT")
	10704	3170224
	10705	"^DD",433, 433,94,0)
	10706	AUTO-CORRE CTION DATE ^D^^9;4^S %DT="EX" D ^%DT S X= Y K:Y<1 X
	10707	"^DD",433, 433,94,3)
	10708	Type the d ate that t he stateme nt discrep ancy was c orrected.
	10709	"^DD",433, 433,94,21, 0)
	10710	^^2^2^3160 428^
	10711	"^DD",433, 433,94,21, 1,0)
	10712	The is the date that the auto- correction program c orrected t he
	10713	"^DD",433, 433,94,21, 2,0)
	10714	statement discrepanc y for this transacti on.
	10715	"^DD",433, 433,94,"DT ")
	10716	3160920
	10717	"^DD",433, 433,95,0)
	10718	AUTO-CORRE CTION TRAN S. AMOUNT^ NJ9,2^^9;5 ^S:X["$" X =$P(X,"$", 2) K:X'?." -
	10719	".N.1".".2 N!(X>99999 9)!(X<-999 999) X
	10720	"^DD",433, 433,95,3)
	10721	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	10722	"^DD",433, 433,95,21, 0)
	10723	^.001^1^1^ 3160428^^
	10724	"^DD",433, 433,95,21, 1,0)
	10725	This is th e transact ion amount associate d with the statement discrepan cy.
	10726	"^DD",433, 433,95,"DT ")
	10727	3160428
	10728	"^DD",433, 433,96,0)
	10729	AUTO-CORRE CTION TYPE OF ERROR^ S^I:INCOMP LETE FLAG ERROR;D:DU PLICATE TR ANSACTION; N:NULL
	10730	TRANSACTIO N AMOUNT;X :NOT FIXAB LE;^9;6^Q
	10731	"^DD",433, 433,96,3)
	10732	Type the k ind of sta tement dis crepancy e rror that was correc ted.
	10733	"^DD",433, 433,96,21, 0)
	10734	^^5^5^3161 004^
	10735	"^DD",433, 433,96,21, 1,0)
	10736	This field stores th e type of error that was corre cted
	10737	"^DD",433, 433,96,21, 2,0)
	10738	for the st atement di screpancy. The erro rs are thr ee
	10739	"^DD",433, 433,96,21, 3,0)
	10740	types: inc omplete fl ag error, a duplicat e transact ion,
	10741	"^DD",433, 433,96,21, 4,0)
	10742	a null tra nsaction a mount, or not fixabl e for all other
	10743	"^DD",433, 433,96,21, 5,0)
	10744	errors.
	10745	"^DD",433, 433,96,"DT ")
	10746	3161004
	10747	"^DD",433, 433,97,0)
	10748	AUTO-CORRE CTION TICK ET FLAG^S^ 1:YES;0:NO ;^9;7^Q
	10749	"^DD",433, 433,97,3)
	10750	Enter Yes if this tr ansaction will need to be manu ally revie wed and co rrected.
	10751	"^DD",433, 433,97,21, 0)
	10752	^^2^2^3161 027^
	10753	"^DD",433, 433,97,21, 1,0)
	10754	Flag notin g that thi s transact ion will n eed to be manually r eviewed an d
	10755	"^DD",433, 433,97,21, 2,0)
	10756	corrected.
	10757	"^DD",433, 433,97,"DT ")
	10758	3161027
	10759	"^DIC",349 .1,349.1,0 )
	10760	AR TRANSMI SSION TYPE ^349.1
	10761	"^DIC",349 .1,349.1,0 ,"GL")
	10762	^RCT(349.1 ,
	10763	"^DIC",349 .1,349.1," %D",0)
	10764	^1.001^2^2 ^3160422^^ ^^
	10765	"^DIC",349 .1,349.1," %D",1,0)
	10766	This file stores the transmiss ion types used in fi le 349
	10767	"^DIC",349 .1,349.1," %D",2,0)
	10768	AR TRANSMI SSION RECO RDS.
	10769	"^DIC",349 .1,"B","AR TRANSMISS ION TYPE", 349.1)
	10770
	10771	"^DIC",349 .5,349.5,0 )
	10772	AR ANNUAL PAYMENT ST ATEMENT^34 9.5
	10773	"^DIC",349 .5,349.5,0 ,"GL")
	10774	^RCAP(349. 5,
	10775	"^DIC",349 .5,349.5," %",0)
	10776	^1.005^^0
	10777	"^DIC",349 .5,349.5," %D",0)
	10778	^^3^3^3170 223^
	10779	"^DIC",349 .5,349.5," %D",1,0)
	10780	This file will hold all of the previous year's pat ient payme nt data fo r
	10781	"^DIC",349 .5,349.5," %D",2,0)
	10782	that calen dar year a nd persist for only one year t o then be deleted an d
	10783	"^DIC",349 .5,349.5," %D",3,0)
	10784	replaced a t the begi nning of t he next ca lendar yea r.
	10785	"^DIC",349 .5,"B","AR ANNUAL PA YMENT STAT EMENT",349 .5)
	10786
	10787	"BLD",1011 1,6)
	10788	15^
	10789	$END KID P RCA4.531 3